diff options
| author | Bastien Guerry <bzg@gnu.org> | 2012-09-30 17:14:59 +0200 |
|---|---|---|
| committer | Bastien Guerry <bzg@gnu.org> | 2012-09-30 17:14:59 +0200 |
| commit | 8223b1d23361b74ede10bac47974ce7803804380 (patch) | |
| tree | 3a2491c5193fed1bef14acd45092c0b9736fa5d6 | |
| parent | 163227893c97b5b41039ea9d5ceadb7e5b2d570c (diff) | |
Sync Org 7.9.2 from the commit tagged "release_7.9.2" in Org's Git repo.
110 files changed, 21039 insertions, 9192 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 8ecaf97a84..2e48b61def 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,207 @@ +2012-09-30 Achim Gratz <Stromeko@Stromeko.DE> + + * org.texi: Add description of ORG_ADD_CONTRIB to info + documentation. Add link to Worg for more details. + + * org.texi: Clarify installation procedure. Provide link to the + build system description on Worg. + + * org.texi: Remove reference to utils/, x11idle.c is now in + contrib/scripts. + + * org.texi: Re-normalize to "Org mode" in manual. + + * org.texi (Installation): Adapt documentation to new build + system. Mention GNU ELPA (since it needs to be handled like Emacs + built-in Org). + + * org.texi: Include "org-version.inc" instead of + "git-describe.texi". + + * org.texi: Remove @set for VERSION and DATE and do an @include + git-describe.texi instead. + +2012-09-30 Adam Spiers <orgmode@adamspiers.org> (tiny change) + + * org.texi: Fix typo in description of the 'Hooks' section. + + * org.texi: Add ID to the list of special properties. + +2012-09-30 Andrew Hyatt <ahyatt@gmail.com> (tiny change) + + * org.texi (Moving subtrees): Document the ability to archive to a + datetree. + +2012-09-30 Bastien Guerry <bzg@altern.org> + + * org.texi (Installation, Feedback, Batch execution): Use + (add-to-list 'load-path ... t) for the contrib dir. + + * org.texi (results): Update documentation for ":results drawer" + and ":results org". + + * org.texi (Column width and alignment): Fix typo. + + * org.texi (Activation): Point to the "Conflicts" section. + + * org.texi (Conflicts): Mention filladapt.el in the list of + conflicting packages. + + * org.texi (Activation): Adding org-mode to `auto-mode-alist' is + not needed for versions of Emacs > 22.1. + + * org.texi (History and Acknowledgments): Fix typo. + + * org.texi (History and Acknowledgments): Add my own + acknowledgments. + + * org.texi (Agenda commands): Document the new command and the new + option. + + * org.texi (Agenda commands): Delete `org-agenda-action' section. + (Agenda commands): Reorder. Document `*' to toggle persistent + marks. + + * org.texi (Agenda dispatcher): Mention + `org-toggle-agenda-sticky'. + (Agenda commands, Exporting Agenda Views): Fix typo. + + * org.texi (Templates in contexts, Setting Options): Update to + reflect changes in how contexts options are processed. + + * org.texi (Templates in contexts): Document the new structure of + the variables `org-agenda-custom-commands-contexts' and + `org-capture-templates-contexts'. + + * org.texi (Templates in contexts): Document the new option + `org-capture-templates-contexts'. + (Storing searches): Document the new option + `org-agenda-custom-commands-contexts'. + + * org.texi (Formula syntax for Lisp): Reformat. + + * org.texi (Special properties, Column attributes) + (Agenda column view): Document the new special property + CLOCKSUM_T. + + * org.texi (Template expansion): Document the new %l template. + + * org.texi (Fast access to TODO states): Fix documentation about + allowed characters for fast todo selection. + + * org.texi (Weekly/daily agenda): Mention APPT_WARNTIME and its + use in `org-agenda-to-appt'. + + * org.texi (Comment lines): Update wrt comments. + + * org.texi (Resolving idle time): Document new keybinding. + + * org.texi (Clocking commands): Document the use of S-M-<up/down> + on clock timestamps. + + * org.texi (Fast access to TODO states): Explicitely says only + letters are supported as fast TODO selection keys. + + * org.texi (Link abbreviations): Illustrate the use of the "%h" + specifier. Document the new "%(my-function)" specifier. + + * org.texi (Clocking commands): New cindex. + (Clocking commands): Update documentation for `org-clock-in'. + Document `org-clock-in-last'. Mention `org-clock-out' and + `org-clock-in-last' as commands that can be globally bound. + (Resolving idle time): Document continuous clocking. + + * org.texi (Top, Introduction): Fix formatting. + (Activation): Add index entries. + (Conventions): Update section. + (Embedded @LaTeX{}): Fix formatting. + + * org.texi (Visibility cycling): Document `show-children'. + + * org.texi (Using capture): Mention the `org-capture-last-stored' + bookmark as a way to jump to the last stored capture. + + * org.texi (Uploading files): Fix typo. + + * org.texi (Using capture): Document `C-0' as a prefix argument + for `org-capture'. + + * org.texi (Agenda commands): Document persistent marks. + + * org.texi (Template expansion): Update doc to reflect change. + + * org.texi (Radio tables): Document the :no-escape parameter. + + * org.texi (Repeated tasks): Document repeat cookies for years, + months, weeks, days and hours. + + * org.texi (Export options): State that you can use the d: option + by specifying a list of drawers. + + * org.texi (HTML preamble and postamble): Small doc improvement. + +2012-09-30 Brian van den Broek <vanden@gmail.com> (tiny change) + + * org.texi: The sections in the Exporting section of the manual + left out articles in the description of the org-export-as-* + commands, among other places. This patch adds them, adds a few + missing prepositions, and switches instances of "an HTML" to "a + html" for internal consistency. + + * org.texi: Alter several examples of headings with timestamps in + them to include the timestamps in the body instead of the heading. + +2012-09-30 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Agenda dispatcher): Document sticky agenda views and + the new key for them. + +2012-09-30 Charles <millarc@verizon.net> (tiny change) + + * org.texi (Advanced features): Fix error in table. + +2012-09-30 Feng Shu <tumashu@gmail.com> + + * org.texi (@LaTeX{} fragments): Document imagemagick as an + alternative to dvipng. + +2012-09-30 François Allisson <francois@allisson.co> (tiny change) + + * org.texi: Remove extra curly bracket. + +2012-09-30 Giovanni Ridolfi <giovanni.ridolfi@yahoo.it> (tiny change) + + * org.texi (org-clock-in-last and org-clock-cancel): Update the + defkeys. + +2012-09-30 Ippei FURUHASHI <top.tuna+orgmode@gmail.com> (tiny change) + + * org.texi (Agenda commands): Fix two typos by giving + corresponding function names, according to + `org-agenda-view-mode-dispatch'. + +2012-09-30 Jan Bäcker <jan.boecker@jboecker.de> + + * org.texi (The spreadsheet): Fix typo. + +2012-09-30 Memnon Anon <gegendosenfleisch@gmail.com> (tiny change) + + * org.texi (Tracking your habits): Point to the "Tracking TODO + state changes" section. + +2012-09-30 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.texi (Literal examples): Remove reference to unknown + `org-export-latex-minted' variable. Also simplify footnote since + `org-export-latex-listings' documentation is exhaustive already. + + * org.texi (Plain lists): Remove reference to now hard-coded + `bullet' automatic rule. + +2012-09-30 Toby S. Cubitt <tsc25@cantab.net> + + * org.texi: Updated documentation accordingly. + 2012-09-13 Paul Eggert <eggert@cs.ucla.edu> * texinfo.tex: Merge from gnulib. diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 575b9cbebe..227af8faf1 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -1,11 +1,8 @@ - \input texinfo @c %**start of header @setfilename ../../info/org @settitle The Org Manual - -@set VERSION 7.8.11 -@set DATE May 2012 +@set VERSION 7.9.2 (GNU Emacs 24.3) @c Use proper quote and backtick for code sections in PDF output @c Cf. Texinfo manual 14.2 @@ -347,7 +344,7 @@ Introduction * Installation:: How to install a downloaded version of Org * Activation:: How to activate Org for certain buffers * Feedback:: Bug reports, ideas, patches etc. -* Conventions:: Type-setting conventions in the manual +* Conventions:: Typesetting conventions in the manual Document structure @@ -495,6 +492,7 @@ Capture templates * Template elements:: What is needed for a complete template entry * Template expansion:: Filling in information about time and context +* Templates in contexts:: Only show a template in a specific context Archiving @@ -560,7 +558,7 @@ Embedded @LaTeX{} * Special symbols:: Greek letters and other symbols * Subscripts and superscripts:: Simple syntax for raising/lowering text -* @LaTeX{} fragments:: Complex formulas made easy +* @LaTeX{} fragments:: Complex formulas made easy * Previewing @LaTeX{} fragments:: What will this snippet look like? * CDLaTeX mode:: Speed up entering of formulas @@ -695,6 +693,7 @@ Specific header arguments * results:: Specify the type of results and how they will be collected and handled * file:: Specify a path for file output +* file-desc:: Specify a description for file results * dir:: Specify the default (possibly remote) directory for code block execution * exports:: Export code and/or results @@ -718,6 +717,7 @@ Specific header arguments * rownames:: Handle row names in tables * shebang:: Make tangled files executable * eval:: Limit evaluation of specific code blocks +* wrap:: Mark source block evaluation results Miscellaneous @@ -740,7 +740,7 @@ Interaction with other packages Hacking -* Hooks:: Who to reach into Org's internals +* Hooks:: How to reach into Org's internals * Add-on packages:: Available extensions * Adding hyperlink types:: New custom link types * Context-sensitive commands:: How to add functionality to such commands @@ -776,7 +776,7 @@ MobileOrg * Installation:: How to install a downloaded version of Org * Activation:: How to activate Org for certain buffers * Feedback:: Bug reports, ideas, patches etc. -* Conventions:: Type-setting conventions in the manual +* Conventions:: Typesetting conventions in the manual @end menu @node Summary, Installation, Introduction, Introduction @@ -854,61 +854,111 @@ Theory Ltd.} @cindex installation @cindex XEmacs -@b{Important:} @i{If you are using a version of Org that is part of the Emacs -distribution or an XEmacs package, please skip this section and go directly -to @ref{Activation}. To see what version of Org (if any) is part of your -Emacs distribution, type @kbd{M-x load-library RET org} and then @kbd{M-x -org-version}.} +@b{Important:} @i{If you the version of Org that comes with Emacs or as a +XEmacs package, please skip this section and go directly to @ref{Activation}. +If you downloaded Org as an ELPA package, please read the instructions on the +@uref{http://orgmode.org/elpa/, Org ELPA page}. To see what version of Org +(if any) is part of your Emacs distribution, type @kbd{M-x org-version} (if +your Emacs distribution does not come with Org, this function will not be +defined).} -If you have downloaded Org from the Web, either as a distribution @file{.zip} -or @file{.tar} file, or as a Git archive, you must take the following steps -to install it: go into the unpacked Org distribution directory and edit the -top section of the file @file{Makefile}. You must set the name of the Emacs -binary (likely either @file{emacs} or @file{xemacs}), and the paths to the -directories where local Lisp and Info files are kept. If you don't have -access to the system-wide directories, you can simply run Org directly from -the distribution directory by adding the @file{lisp} subdirectory to the -Emacs load path. To do this, add the following line to @file{.emacs}: +Installation of Org mode uses a build system, which is described in more +detail on @uref{http://orgmode.org/worg/dev/org-build-system.html, Worg}. -@example -(setq load-path (cons "~/path/to/orgdir/lisp" load-path)) -@end example +If you have downloaded Org from the Web as a distribution @file{.zip} or +@file{.tar.gz} archive, take the following steps to install it: -@noindent -If you plan to use code from the @file{contrib} subdirectory, do a similar -step for this directory: +@itemize @bullet +@item Unpack the distribution archive. +@item Change into (@code{cd}) the Org directory. +@item Run @code{make help config} +and then check and edit the file @file{local.mk} if the default configuration +does not match your system. Set the name of the Emacs binary (likely either +@file{emacs} or @file{xemacs}), and the paths to the directories where local +Lisp and Info files will be installed. If the Emacs binary is not in your +path, give the full path to the executable. Avoid spaces in any path names. +@item Run @code{make config} +again to check the configuration. +@item Optionally run @code{make test} +to build Org mode and then run the full testsuite. +@item Run @code{make install} or @code{sudo make install} +to build and install Org mode on your system. +@end itemize -@example -(setq load-path (cons "~/path/to/orgdir/contrib/lisp" load-path)) -@end example +If you use a cloned Git repository, then the procedure is slightly different. +The following description assumes that you are using the @code{master} branch +(where the development is done). You could also use the @code{maint} branch +instead, where the release versions are published, just replace @code{master} +with @code{maint} in the description below. -@noindent Now byte-compile the Lisp files with the shell command: +@itemize @bullet +@item Change into (@code{cd}) the Org repository. +@item Run @code{git checkout master} +to switch to the @code{master} branch of the Org repository. +@item Run @code{make help} +and then check and edit the file @file{local.mk}. You must set the name of +the Emacs binary (likely either @file{emacs} or @file{xemacs}), and the paths +to the directories where local Lisp and Info files will be installed. If the +Emacs binary is not in your path, you must give the full path to the +executable. Avoid spaces in any path names. +@item Run @code{make config} +to check the configuration. +@item Run @code{make update2} or @code{make up2} +to update the Git repository and build and install Org mode. The latter +invocation runs the complete test suite before installation and installs only +if the build passes all tests. +@end itemize + +If you don't have access to the system-wide directories and you don't want to +install somewhere into your home directory, you can run Org directly from the +distribution directory or Org repository by compiling Org mode in place: + +@itemize @bullet +@item Change into (@code{cd}) the Org repository. +@item Run @code{git checkout master} +to switch to the @code{master} branch of the Org repository. +@item Run @code{make compile} +@end itemize + +Last but not least you can also run Org mode directly from an Org repository +without any compilation. Simply replace the last step in the recipe above +with @code{make uncompiled}. + +Then add the following line to @file{.emacs}: @example -make +(add-to-list 'load-path "~/path/to/orgdir/lisp") @end example -@noindent If you are running Org from the distribution directory, this is -all. If you want to install Org into the system directories, use (as -administrator) +@noindent +If you plan to use code from the @file{contrib} subdirectory without +compiling them, do a similar step for this directory: @example -make install +(add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t) @end example +If you want to include those files with the build and install, please +customize the variable @code{ORG_ADD_CONTRIB} instead in your @code{local.mk} +file, for more details please see this +@uref{http://orgmode.org/worg/dev/org-build-system.html#sec-4-1-2, +description on Worg}. + Installing Info files is system dependent, because of differences in the -@file{install-info} program. The following should correctly install the Info -files on most systems, please send a bug report if not@footnote{The output -from install-info (if any) is also system dependent. In particular Debian -and its derivatives use two different versions of install-info and you may -see the message: +@file{install-info} program. The Info documentation is installed together +with the rest of Org mode. If you don't install Org mode, it is possible to +install the Info documentation seperately (you need to have +install-info@footnote{The output from install-info (if any) is system +dependent. In particular Debian and its derivatives use two different +versions of install-info and you may see the message: @example This is not dpkg install-info anymore, but GNU install-info See the man page for ginstall-info for command line arguments @end example -@noindent which can be safely ignored.}. +@noindent which can be safely ignored.} +on your system). @example make install-info @@ -928,17 +978,28 @@ Do not forget to activate Org as described in the following section. @section Activation @cindex activation @cindex autoload +@cindex ELPA @cindex global key bindings @cindex key bindings, global +@findex org-agenda +@findex org-capture +@findex org-store-link +@findex org-iswitchb + +Since Emacs 22.2, files with the @file{.org} extension use Org mode by +default. If you are using an earlier version of Emacs, add this line to your +@file{.emacs} file: -To make sure files with extension @file{.org} use Org mode, add the following -line to your @file{.emacs} file. @lisp (add-to-list 'auto-mode-alist '("\\.org\\'" . org-mode)) @end lisp -@noindent Org mode buffers need font-lock to be turned on - this is the -default in Emacs@footnote{If you don't use font-lock globally, turn it on in -Org buffer with @code{(add-hook 'org-mode-hook 'turn-on-font-lock)}}. + +Org mode buffers need font-lock to be turned on - this is the default in +Emacs@footnote{If you don't use font-lock globally, turn it on in Org buffer +with @code{(add-hook 'org-mode-hook 'turn-on-font-lock)}}. + +There are compatibility issues between Org mode and some other Elisp +packages, please take the time to check the list (@pxref{Conflicts}). The four Org commands @command{org-store-link}, @command{org-capture}, @command{org-agenda}, and @command{org-iswitchb} should be accessible through @@ -1016,8 +1077,9 @@ $ emacs -Q -l /path/to/minimal-org.el @end example However if you are using Org mode as distributed with Emacs, a minimal setup -is not necessary. In that case it is sufficient to start Emacs as @code{emacs --Q}. The @code{minimal-org.el} setup file can have contents as shown below. +is not necessary. In that case it is sufficient to start Emacs as +@code{emacs -Q}. The @code{minimal-org.el} setup file can have contents as +shown below. @example ;;; Minimal setup to load latest `org-mode' @@ -1029,7 +1091,7 @@ is not necessary. In that case it is sufficient to start Emacs as @code{emacs ;; add latest org-mode to load path (add-to-list 'load-path (expand-file-name "/path/to/org-mode/lisp")) -(add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp")) +(add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp" t)) ;; activate org (require 'org-install) @@ -1081,7 +1143,9 @@ attach it to your bug report. @node Conventions, , Feedback, Introduction @section Typesetting conventions used in this manual -Org uses three types of keywords: TODO keywords, tags, and property +@subsubheading TODO keywords, tags, properties, etc. + +Org mainly uses three types of keywords: TODO keywords, tags and property names. In this manual we use the following conventions: @table @code @@ -1099,17 +1163,33 @@ User-defined properties are capitalized; built-in properties with special meaning are written with all capitals. @end table -The manual lists both the keys and the corresponding commands for accessing -functionality. Org mode often uses the same key for different functions, -depending on context. The command that is bound to such keys has a generic -name, like @code{org-metaright}. In the manual we will, wherever possible, -give the function that is internally called by the generic command. For -example, in the chapter on document structure, @kbd{M-@key{right}} will be -listed to call @code{org-do-demote}, while in the chapter on tables, it will -be listed to call org-table-move-column-right. - -If you prefer, you can compile the manual without the command names by -unsetting the flag @code{cmdnames} in @file{org.texi}. +Moreover, Org uses @i{option keywords} (like @code{#+TITLE} to set the title) +and @i{environment keywords} (like @code{#+BEGIN_HTML} to start a @code{HTML} +environment). They are written in uppercase in the manual to enhance its +readability, but you can use lowercase in your Org files@footnote{Easy +templates insert lowercase keywords and Babel dynamically inserts +@code{#+results}.} + +@subsubheading Keybindings and commands +@kindex C-c a +@findex org-agenda +@kindex C-c c +@findex org-capture + +The manual suggests two global keybindings: @kbd{C-c a} for @code{org-agenda} +and @kbd{C-c c} for @code{org-capture}. These are only suggestions, but the +rest of the manual assumes that you are using these keybindings. + +Also, the manual lists both the keys and the corresponding commands for +accessing a functionality. Org mode often uses the same key for different +functions, depending on context. The command that is bound to such keys has +a generic name, like @code{org-metaright}. In the manual we will, wherever +possible, give the function that is internally called by the generic command. +For example, in the chapter on document structure, @kbd{M-@key{right}} will +be listed to call @code{org-do-demote}, while in the chapter on tables, it +will be listed to call @code{org-table-move-column-right}. If you prefer, +you can compile the manual without the command names by unsetting the flag +@code{cmdnames} in @file{org.texi}. @node Document Structure, Tables, Introduction, Top @chapter Document structure @@ -1159,7 +1239,8 @@ Headlines define the structure of an outline tree. The headlines in Org start with one or more stars, on the left margin@footnote{See the variables @code{org-special-ctrl-a/e}, @code{org-special-ctrl-k}, and @code{org-ctrl-k-protect-subtree} to configure special behavior of @kbd{C-a}, -@kbd{C-e}, and @kbd{C-k} in headlines.}. For example: +@kbd{C-e}, and @kbd{C-k} in headlines.} @footnote{Clocking only works with +headings indented less then 30 stars.}. For example: @example * Top level headline @@ -1239,6 +1320,7 @@ tables, @kbd{S-@key{TAB}} jumps to the previous field. @cindex show all, command @orgcmd{C-u C-u C-u @key{TAB},show-all} Show all, including drawers. +@cindex revealing context @orgcmd{C-c C-r,org-reveal} Reveal context around point, showing the current entry, the following heading and the hierarchy above. Useful for working near a location that has been @@ -1246,8 +1328,13 @@ exposed by a sparse tree command (@pxref{Sparse trees}) or an agenda command (@pxref{Agenda commands}). With a prefix argument show, on each level, all sibling headings. With a double prefix argument, also show the entire subtree of the parent. +@cindex show branches, command @orgcmd{C-c C-k,show-branches} Expose all the headings of the subtree, CONTENT view for just one subtree. +@cindex show children, command +@orgcmd{C-c @key{TAB},show-children} +Expose all direct children of the subtree. With a numeric prefix argument N, +expose all children down to level N. @orgcmd{C-c C-x b,org-tree-to-indirect-buffer} Show the current subtree in an indirect buffer@footnote{The indirect buffer @@ -1429,7 +1516,7 @@ more details, see the docstring of the command @code{org-clone-subtree-with-time-shift}. @orgcmd{C-c C-w,org-refile} Refile entry or region to a different location. @xref{Refiling notes}. -@orgcmd{C-c ^,org-sort-entries-or-items} +@orgcmd{C-c ^,org-sort} Sort same-level entries. When there is an active region, all entries in the region will be sorted. Otherwise the children of the current headline are sorted. The command prompts for the sorting method, which can be @@ -1714,19 +1801,16 @@ state of the checkbox. In any case, verify bullets and indentation consistency in the whole list. @kindex C-c - @vindex org-plain-list-ordered-item-terminator -@vindex org-list-automatic-rules @item C-c - Cycle the entire list level through the different itemize/enumerate bullets (@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}) or a subset of them, depending on @code{org-plain-list-ordered-item-terminator}, the type of list, -and its position@footnote{See @code{bullet} rule in -@code{org-list-automatic-rules} for more information.}. With a numeric -prefix argument N, select the Nth bullet from this list. If there is an -active region when calling this, selected text will be changed into an item. -With a prefix argument, all lines will be converted to list items. If the -first line already was a list item, any item marker will be removed from the -list. Finally, even without an active region, a normal line will be -converted into a list item. +and its indentation. With a numeric prefix argument N, select the Nth bullet +from this list. If there is an active region when calling this, selected +text will be changed into an item. With a prefix argument, all lines will be +converted to list items. If the first line already was a list item, any item +marker will be removed from the list. Finally, even without an active +region, a normal line will be converted into a list item. @kindex C-c * @item C-c * Turn a plain list item into a headline (so that it becomes a subheading at @@ -1756,11 +1840,13 @@ numerically, alphabetically, by time, or by custom function. @cindex visibility cycling, drawers @vindex org-drawers +@cindex org-insert-drawer +@kindex C-c C-x d Sometimes you want to keep information associated with an entry, but you normally don't want to see it. For this, Org mode has @emph{drawers}. Drawers need to be configured with the variable -@code{org-drawers}@footnote{You can define drawers on a per-file basis -with a line like @code{#+DRAWERS: HIDDEN PROPERTIES STATE}}. Drawers +@code{org-drawers}@footnote{You can define additional drawers on a +per-file basis with a line like @code{#+DRAWERS: HIDDEN STATE}}. Drawers look like this: @example @@ -1772,6 +1858,13 @@ look like this: After the drawer. @end example +You can interactively insert drawers at point by calling +@code{org-insert-drawer}, which is bound to @key{C-c C-x d}. With an active +region, this command will put the region inside the drawer. With a prefix +argument, this command calls @code{org-insert-property-drawer} and add a +property drawer right below the current headline. Completion over drawer +keywords is also possible using @key{M-TAB}. + Visibility cycling (@pxref{Visibility cycling}) on the headline will hide and show the entry, but keep the drawer collapsed to a single line. In order to look inside the drawer, you need to move the cursor to the drawer line and @@ -2226,7 +2319,7 @@ on a per-file basis with: If you would like to overrule the automatic alignment of number-rich columns to the right and of string-rich column to the left, you can use @samp{<r>}, -@samp{c}@footnote{Centering does not work inside Emacs, but it does have an +@samp{<c>}@footnote{Centering does not work inside Emacs, but it does have an effect when exporting to HTML.} or @samp{<l>} in a similar fashion. You may also combine alignment and field width like this: @samp{<l10>}. @@ -2577,23 +2670,28 @@ durations computations @ref{Durations and time values}. @subsection Emacs Lisp forms as formulas @cindex Lisp forms, as table formulas -It is also possible to write a formula in Emacs Lisp; this can be useful for -string manipulation and control structures, if Calc's functionality is not -enough. If a formula starts with a single-quote followed by an opening -parenthesis, then it is evaluated as a Lisp form. The evaluation should -return either a string or a number. Just as with @file{calc} formulas, you -can specify modes and a printf format after a semicolon. With Emacs Lisp -forms, you need to be conscious about the way field references are -interpolated into the form. By default, a reference will be interpolated as -a Lisp string (in double-quotes) containing the field. If you provide the -@samp{N} mode switch, all referenced elements will be numbers (non-number -fields will be zero) and interpolated as Lisp numbers, without quotes. If -you provide the @samp{L} flag, all fields will be interpolated literally, -without quotes. I.e., if you want a reference to be interpreted as a string -by the Lisp form, enclose the reference operator itself in double-quotes, -like @code{"$3"}. Ranges are inserted as space-separated fields, so you can -embed them in list or vector syntax. Here are a few examples---note how the -@samp{N} mode is used when we do computations in Lisp: +It is also possible to write a formula in Emacs Lisp. This can be useful +for string manipulation and control structures, if Calc's functionality is +not enough. + +If a formula starts with a single-quote followed by an opening parenthesis, +then it is evaluated as a Lisp form. The evaluation should return either a +string or a number. Just as with @file{calc} formulas, you can specify modes +and a printf format after a semicolon. + +With Emacs Lisp forms, you need to be conscious about the way field +references are interpolated into the form. By default, a reference will be +interpolated as a Lisp string (in double-quotes) containing the field. If +you provide the @samp{N} mode switch, all referenced elements will be numbers +(non-number fields will be zero) and interpolated as Lisp numbers, without +quotes. If you provide the @samp{L} flag, all fields will be interpolated +literally, without quotes. I.e., if you want a reference to be interpreted +as a string by the Lisp form, enclose the reference operator itself in +double-quotes, like @code{"$3"}. Ranges are inserted as space-separated +fields, so you can embed them in list or vector syntax. + +Here are a few examples---note how the @samp{N} mode is used when we do +computations in Lisp: @example @r{Swap the first two characters of the content of column 1} @@ -2657,7 +2755,7 @@ modified in order to still reference the same field. To avoid this from happening, in particular in range references, anchor ranges at the table borders (using @code{@@<}, @code{@@>}, @code{$<}, @code{$>}), or at hlines using the @code{@@I} notation. Automatic adaptation of field references does -of cause not happen if you edit the table structure with normal editing +of course not happen if you edit the table structure with normal editing commands---then you must fix the equations yourself. Instead of typing an equation into the field, you may also use the following @@ -2899,7 +2997,7 @@ makes use of these features: | # | Peter | 10 | 8 | 23 | 41 | 8.2 | | # | Sam | 2 | 4 | 3 | 9 | 1.8 | |---+---------+--------+--------+--------+-------+------| -| | Average | | | | 29.7 | | +| | Average | | | | 25.0 | | | ^ | | | | | at | | | $ | max=50 | | | | | | |---+---------+--------+--------+--------+-------+------| @@ -3227,6 +3325,8 @@ mailto:adent@@galaxy.net @r{Mail link} vm:folder @r{VM folder link} vm:folder#id @r{VM message link} vm://myself@@some.where.org/folder#id @r{VM on remote machine} +vm-imap:account:folder @r{VM IMAP folder link} +vm-imap:account:folder#id @r{VM IMAP message link} wl:folder @r{WANDERLUST folder link} wl:folder#id @r{WANDERLUST message link} mhe:folder @r{MH-E folder link} @@ -3498,18 +3598,26 @@ that relates the linkwords to replacement text. Here is an example: @smalllisp @group (setq org-link-abbrev-alist - '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=") - ("google" . "http://www.google.com/search?q=") - ("gmap" . "http://maps.google.com/maps?q=%s") - ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1") - ("ads" . "http://adsabs.harvard.edu/cgi-bin/nph-abs_connect?author=%s&db_key=AST"))) + '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=") + ("url-to-ja" . "http://translate.google.fr/translate?sl=en&tl=ja&u=%h") + ("google" . "http://www.google.com/search?q=") + ("gmap" . "http://maps.google.com/maps?q=%s") + ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1") + ("ads" . "http://adsabs.harvard.edu/cgi-bin/nph-abs_connect?author=%s&db_key=AST"))) @end group @end smalllisp If the replacement text contains the string @samp{%s}, it will be -replaced with the tag. Otherwise the tag will be appended to the string -in order to create the link. You may also specify a function that will -be called with the tag as the only argument to create the link. +replaced with the tag. Using @samp{%h} instead of @samp{%s} will +url-encode the tag (see the example above, where we need to encode +the URL parameter.) Using @samp{%(my-function)} will pass the tag +to a custom function, and replace it by the resulting string. + +If the replacement text don't contain any specifier, it will simply +be appended to the string in order to create the link. + +Instead of a string, you may also specify a function that will be +called with the tag as the only argument to create the link. With the above setting, you could link to a specific bug with @code{[[bugzilla:129]]}, search the web for @samp{OrgMode} with @@ -3567,7 +3675,7 @@ Jump to line 255. Search for a link target @samp{<<My Target>>}, or do a text search for @samp{my target}, similar to the search in internal links, see @ref{Internal links}. In HTML export (@pxref{HTML export}), such a file -link will become an HTML reference to the corresponding named anchor in +link will become a HTML reference to the corresponding named anchor in the linked file. @item *My Target In an Org file, restrict search to headlines. @@ -3844,9 +3952,10 @@ from @code{DONE} to @code{REPORT} in the example above. See also @subsection Fast access to TODO states If you would like to quickly change an entry to an arbitrary TODO state -instead of cycling through the states, you can set up keys for -single-letter access to the states. This is done by adding the section -key after each keyword, in parentheses. For example: +instead of cycling through the states, you can set up keys for single-letter +access to the states. This is done by adding the selection character after +each keyword, in parentheses@footnote{All characters are allowed except +@code{@@^!}, which have a special meaning here.}. For example: @lisp (setq org-todo-keywords @@ -4065,9 +4174,11 @@ time-stamped note for a change. These records will be inserted after the headline as an itemized list, newest first@footnote{See the variable @code{org-log-states-order-reversed}}. When taking a lot of notes, you might want to get the notes out of the way into a drawer (@pxref{Drawers}). -Customize the variable @code{org-log-into-drawer} to get this -behavior---the recommended drawer for this is called @code{LOGBOOK}. You can -also overrule the setting of this variable for a subtree by setting a +Customize the variable @code{org-log-into-drawer} to get this behavior---the +recommended drawer for this is called @code{LOGBOOK}@footnote{Note that the +@code{LOGBOOK} drawer is unfolded when pressing @key{SPC} in the agenda to +show an entry---use @key{C-u SPC} to keep it folded here}. You can also +overrule the setting of this variable for a subtree by setting a @code{LOG_INTO_DRAWER} property. Since it is normally too much to record a note for every state, Org mode @@ -4157,10 +4268,10 @@ The TODO may also have minimum and maximum ranges specified by using the syntax @samp{.+2d/3d}, which says that you want to do the task at least every three days, but at most every two days. @item -You must also have state logging for the @code{DONE} state enabled, in order -for historical data to be represented in the consistency graph. If it is not -enabled it is not an error, but the consistency graphs will be largely -meaningless. +You must also have state logging for the @code{DONE} state enabled +(@pxref{Tracking TODO state changes}), in order for historical data to be +represented in the consistency graph. If it is not enabled it is not an +error, but the consistency graphs will be largely meaningless. @end enumerate To give you an idea of what the above rules look like in action, here's an @@ -4872,8 +4983,8 @@ in the current file will be offered as possible completions. @orgcmd{C-c C-x p,org-set-property} Set a property. This prompts for a property name and a value. If necessary, the property drawer is created as well. -@item M-x org-insert-property-drawer -@findex org-insert-property-drawer +@item C-u M-x org-insert-drawer +@cindex org-insert-drawer Insert a property drawer into the current entry. The drawer will be inserted early in the entry, but after the lines with planning information like deadlines. @@ -4904,6 +5015,7 @@ column view (@pxref{Column view}), or to use them in queries. The following property names are special and (except for @code{:CATEGORY:}) should not be used as keys in the properties drawer: +@cindex property, special, ID @cindex property, special, TODO @cindex property, special, TAGS @cindex property, special, ALLTAGS @@ -4915,11 +5027,14 @@ used as keys in the properties drawer: @cindex property, special, TIMESTAMP @cindex property, special, TIMESTAMP_IA @cindex property, special, CLOCKSUM +@cindex property, special, CLOCKSUM_T @cindex property, special, BLOCKED @c guessing that ITEM is needed in this area; also, should this list be sorted? @cindex property, special, ITEM @cindex property, special, FILE @example +ID @r{A globally unique ID used for synchronization during} + @r{iCalendar or MobileOrg export.} TODO @r{The TODO keyword of the entry.} TAGS @r{The tags defined directly in the headline.} ALLTAGS @r{All tags, including inherited ones.} @@ -4932,8 +5047,11 @@ TIMESTAMP @r{The first keyword-less timestamp in the entry.} TIMESTAMP_IA @r{The first inactive timestamp in the entry.} CLOCKSUM @r{The sum of CLOCK intervals in the subtree. @code{org-clock-sum}} @r{must be run first to compute the values in the current buffer.} +CLOCKSUM_T @r{The sum of CLOCK intervals in the subtree for today.} + @r{@code{org-clock-sum-today} must be run first to compute the} + @r{values in the current buffer.} BLOCKED @r{"t" if task is currently blocked by children or siblings} -ITEM @r{The content of the entry.} +ITEM @r{The headline of the entry.} FILE @r{The filename the entry is located in.} @end example @@ -5149,7 +5267,7 @@ values. @example :COLUMNS: %25ITEM %9Approved(Approved?)@{X@} %Owner %11Status \@footnote{Please note that the COLUMNS definition must be on a single line---it is wrapped here only because of formatting constraints.} - %10Time_Estimate@{:@} %CLOCKSUM + %10Time_Estimate@{:@} %CLOCKSUM %CLOCKSUM_T :Owner_ALL: Tammy Mark Karl Lisa Don :Status_ALL: "In progress" "Not started yet" "Finished" "" :Approved_ALL: "[ ]" "[X]" @@ -5168,8 +5286,9 @@ modified title (@samp{Approved?}, with a question mark). Summaries will be created for the @samp{Time_Estimate} column by adding time duration expressions like HH:MM, and for the @samp{Approved} column, by providing an @samp{[X]} status if all children have been checked. The -@samp{CLOCKSUM} column is special, it lists the sum of CLOCK intervals -in the subtree. +@samp{CLOCKSUM} and @samp{CLOCKSUM_T} columns are special, they lists the +sums of CLOCK intervals in the subtree, either for all clocks or just for +today. @node Using column view, Capturing column view, Defining columns, Column view @subsection Using column view @@ -5370,8 +5489,10 @@ timeline and agenda displays, the headline of an entry associated with a plain timestamp will be shown exactly on that date. @example -* Meet Peter at the movies <2006-11-01 Wed 19:15> -* Discussion on climate change <2006-11-02 Thu 20:00-22:00> +* Meet Peter at the movies + <2006-11-01 Wed 19:15> +* Discussion on climate change + <2006-11-02 Thu 20:00-22:00> @end example @item Timestamp with repeater interval @@ -5382,7 +5503,8 @@ interval of N days (d), weeks (w), months (m), or years (y). The following will show up in the agenda every Wednesday: @example -* Pick up Sam at school <2007-05-16 Wed 12:30 +1w> +* Pick up Sam at school + <2007-05-16 Wed 12:30 +1w> @end example @item Diary-style sexp entries @@ -5426,7 +5548,8 @@ angular ones. These timestamps are inactive in the sense that they do @emph{not} trigger an entry to show up in the agenda. @example -* Gillian comes late for the fifth time [2006-11-01 Wed] +* Gillian comes late for the fifth time + [2006-11-01 Wed] @end example @end table @@ -5825,9 +5948,10 @@ or plain timestamp. In the following example @noindent the @code{+1m} is a repeater; the intended interpretation is that the task has a deadline on <2005-10-01> and repeats itself every (one) month starting -from that time. If you need both a repeater and a special warning period in -a deadline entry, the repeater should come first and the warning period last: -@code{DEADLINE: <2005-10-01 Sat +1m -3d>}. +from that time. You can use yearly, monthly, weekly, daily and hourly repeat +cookies by using the @code{y/w/m/d/h} letters. If you need both a repeater +and a special warning period in a deadline entry, the repeater should come +first and the warning period last: @code{DEADLINE: <2005-10-01 Sat +1m -3d>}. @vindex org-todo-repeat-to-state Deadlines and scheduled items produce entries in the agenda when they are @@ -5898,12 +6022,14 @@ created for this purpose, it is described in @ref{Structure editing}. @cindex time clocking Org mode allows you to clock the time you spend on specific tasks in a -project. When you start working on an item, you can start the clock. -When you stop working on that task, or when you mark the task done, the -clock is stopped and the corresponding time interval is recorded. It -also computes the total time spent on each subtree of a project. And it -remembers a history or tasks recently clocked, to that you can jump quickly -between a number of tasks absorbing your time. +project. When you start working on an item, you can start the clock. When +you stop working on that task, or when you mark the task done, the clock is +stopped and the corresponding time interval is recorded. It also computes +the total time spent on each subtree@footnote{Clocking only works if all +headings are indented with less than 30 stars. This is a hardcoded +limitation of `lmax' in `org-clock-sum'.} of a project. And it remembers a +history or tasks recently clocked, to that you can jump quickly between a +number of tasks absorbing your time. To save the clock history across Emacs sessions, use @lisp @@ -5928,6 +6054,7 @@ what to do with it. @table @kbd @orgcmd{C-c C-x C-i,org-clock-in} @vindex org-clock-into-drawer +@vindex org-clock-continuously @cindex property, LOG_INTO_DRAWER Start the clock on the current item (clock-in). This inserts the CLOCK keyword together with a timestamp. If this is not the first clocking of @@ -5938,9 +6065,10 @@ the setting of this variable for a subtree by setting a @code{CLOCK_INTO_DRAWER} or @code{LOG_INTO_DRAWER} property. When called with a @kbd{C-u} prefix argument, select the task from a list of recently clocked tasks. With two @kbd{C-u -C-u} prefixes, clock into the task at point and mark it as the default task. -The default task will always be available when selecting a clocking task, -with letter @kbd{d}.@* +C-u} prefixes, clock into the task at point and mark it as the default task; +the default task will then always be available with letter @kbd{d} when +selecting a clocking task. With three @kbd{C-u C-u C-u} prefixes, force +continuous clocking by starting the clock when the last clock stopped.@* @cindex property: CLOCK_MODELINE_TOTAL @cindex property: LAST_REPEAT @vindex org-clock-modeline-total @@ -5970,6 +6098,12 @@ HH:MM}. See the variable @code{org-log-note-clock-out} for the possibility to record an additional note together with the clock-out timestamp@footnote{The corresponding in-buffer setting is: @code{#+STARTUP: lognoteclock-out}}. +@orgcmd{C-c C-x C-x,org-clock-in-last} +@vindex org-clock-continuously +Reclock the last clocked task. With one @kbd{C-u} prefix argument, +select the task from the clock history. With two @kbd{C-u} prefixes, +force continuous clocking by starting the clock when the last clock +stopped. @orgcmd{C-c C-x C-e,org-clock-modify-effort-estimate} Update the effort estimate for the current clock task. @kindex C-c C-y @@ -5979,12 +6113,18 @@ Recompute the time interval after changing one of the timestamps. This is only necessary if you edit the timestamps directly. If you change them with @kbd{S-@key{cursor}} keys, the update is automatic. @orgcmd{C-S-@key{up/down},org-clock-timestamps-up/down} -On @code{CLOCK} log lines, increase/decrease both timestamps at the same -time so that duration keeps the same. +On @code{CLOCK} log lines, increase/decrease both timestamps so that the +clock duration keeps the same. +@orgcmd{S-M-@key{up/down},org-timestamp-up/down} +On @code{CLOCK} log lines, increase/decrease the timestamp at point and +the one of the previous (or the next clock) timestamp by the same duration. +For example, if you hit @kbd{S-M-@key{up}} to increase a clocked-out timestamp +by five minutes, then the clocked-in timestamp of the next clock will be +increased by five minutes. @orgcmd{C-c C-t,org-todo} Changing the TODO state of an item to DONE automatically stops the clock if it is running in this same item. -@orgcmd{C-c C-x C-x,org-clock-cancel} +@orgcmd{C-c C-x C-q,org-clock-cancel} Cancel the current clock. This is useful if a clock was started by mistake, or if you ended up working on something else. @orgcmd{C-c C-x C-j,org-clock-goto} @@ -6004,6 +6144,10 @@ 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. +@strong{Important:} note that both @code{org-clock-out} and +@code{org-clock-in-last} can have a global keybinding and will not +modify the window disposition. + @node The clock table, Resolving idle time, Clocking commands, Clocking work time @subsection The clock table @cindex clocktable, dynamic block @@ -6141,7 +6285,9 @@ would be @end example @node Resolving idle time, , The clock table, Clocking work time -@subsection Resolving idle time +@subsection Resolving idle time and continuous clocking + +@subsubheading Resolving idle time @cindex resolve idle time @cindex idle, resolve, dangling @@ -6156,12 +6302,12 @@ as 10 or 15, Emacs can alert you when you get back to your computer after being idle for that many minutes@footnote{On computers using Mac OS X, idleness is based on actual user idleness, not just Emacs' idle time. For X11, you can install a utility program @file{x11idle.c}, available in the -UTILITIES directory of the Org git distribution, to get the same general -treatment of idleness. On other systems, idle time refers to Emacs idle time -only.}, and ask what you want to do with the idle time. There will be a -question waiting for you when you get back, indicating how much idle time has -passed (constantly updated with the current amount), as well as a set of -choices to correct the discrepancy: +@code{contrib/scripts} directory of the Org git distribution, to get the same +general treatment of idleness. On other systems, idle time refers to Emacs +idle time only.}, and ask what you want to do with the idle time. There will +be a question waiting for you when you get back, indicating how much idle +time has passed (constantly updated with the current amount), as well as a +set of choices to correct the discrepancy: @table @kbd @item k @@ -6206,7 +6352,19 @@ identical to dealing with away time due to idleness; it is just happening due to a recovery event rather than a set amount of idle time. You can also check all the files visited by your Org agenda for dangling -clocks at any time using @kbd{M-x org-resolve-clocks}. +clocks at any time using @kbd{M-x org-resolve-clocks RET} (or @kbd{C-c C-x C-z}). + +@subsubheading Continuous clocking +@cindex continuous clocking +@vindex org-clock-continuously + +You may want to start clocking from the time when you clocked out the +previous task. To enable this systematically, set @code{org-clock-continuously} +to @code{t}. Each time you clock in, Org retrieves the clock-out time of the +last clocked entry for this session, and start the new clock from there. + +If you only want this from time to time, use three universal prefix arguments +with @code{org-clock-in} and two @kbd{C-u C-u} with @code{org-clock-in-last}. @node Effort estimates, Relative timer, Clocking work time, Dates and Times @section Effort estimates @@ -6436,6 +6594,15 @@ template in the usual way. Visit the last stored capture item in its buffer. @end table +@vindex org-capture-bookmark +@cindex org-capture-last-stored +You can also jump to the bookmark @code{org-capture-last-stored}, which will +automatically be created unless you set @code{org-capture-bookmark} to +@code{nil}. + +To insert the capture at point in an Org buffer, call @code{org-capture} with +a @code{C-0} prefix argument. + @node Capture templates, , Using capture, Capture @subsection Capture templates @cindex templates, for Capture @@ -6490,6 +6657,7 @@ like this: @menu * Template elements:: What is needed for a complete template entry * Template expansion:: Filling in information about time and context +* Templates in contexts:: Only show a template in a specific context @end menu @node Template elements, Template expansion, Capture templates, Capture templates @@ -6633,36 +6801,38 @@ buffer again after capture is completed. @end table @end table -@node Template expansion, , Template elements, Capture templates +@node Template expansion, Templates in contexts, Template elements, Capture templates @subsubsection Template expansion In the template itself, special @kbd{%}-escapes@footnote{If you need one of -these sequences literally, escape the @kbd{%} with a backslash.} allow +these sequences literally, escape the @kbd{%} with a backslash.} allow dynamic insertion of content. The templates are expanded in the order given here: @smallexample -%[@var{file}] @r{insert the contents of the file given by @var{file}.} -%(@var{sexp}) @r{evaluate Elisp @var{sexp} and replace with the result.} -%<...> @r{the result of format-time-string on the ... format specification.} -%t @r{timestamp, date only.} -%T @r{timestamp with date and time.} -%u, %U @r{like the above, but inactive timestamps.} -%a @r{annotation, normally the link created with @code{org-store-link}.} -%i @r{initial content, the region when capture is called while the} +%[@var{file}] @r{Insert the contents of the file given by @var{file}.} +%(@var{sexp}) @r{Evaluate Elisp @var{sexp} and replace with the result.} + @r{The sexp must return a string.} +%<...> @r{The result of format-time-string on the ... format specification.} +%t @r{Timestamp, date only.} +%T @r{Timestamp, with date and time.} +%u, %U @r{Like the above, but inactive timestamps.} +%i @r{Initial content, the region when capture is called while the} @r{region is active.} @r{The entire text will be indented like @code{%i} itself.} -%A @r{like @code{%a}, but prompt for the description part.} +%a @r{Annotation, normally the link created with @code{org-store-link}.} +%A @r{Like @code{%a}, but prompt for the description part.} +%l @r{Like %a, but only insert the literal link.} %c @r{Current kill ring head.} %x @r{Content of the X clipboard.} -%k @r{title of the currently clocked task.} -%K @r{link to the currently clocked task.} -%n @r{user name (taken from @code{user-full-name}).} -%f @r{file visited by current buffer when org-capture was called.} -%F @r{full path of the file or directory visited by current buffer.} -%:keyword @r{specific information for certain link types, see below.} -%^g @r{prompt for tags, with completion on tags in target file.} -%^G @r{prompt for tags, with completion all tags in all agenda files.} -%^t @r{like @code{%t}, but prompt for date. Similarly @code{%^T}, @code{%^u}, @code{%^U}.} +%k @r{Title of the currently clocked task.} +%K @r{Link to the currently clocked task.} +%n @r{User name (taken from @code{user-full-name}).} +%f @r{File visited by current buffer when org-capture was called.} +%F @r{Full path of the file or directory visited by current buffer.} +%:keyword @r{Specific information for certain link types, see below.} +%^g @r{Prompt for tags, with completion on tags in target file.} +%^G @r{Prompt for tags, with completion all tags in all agenda files.} +%^t @r{Like @code{%t}, but prompt for date. Similarly @code{%^T}, @code{%^u}, @code{%^U}.} @r{You may define a prompt like @code{%^@{Birthday@}t}.} %^C @r{Interactive selection of which kill or clip to use.} %^L @r{Like @code{%^C}, but insert as link.} @@ -6671,6 +6841,9 @@ dynamic insertion of content. The templates are expanded in the order given her @r{You may specify a default value and a completion table with} @r{%^@{prompt|default|completion2|completion3...@}.} @r{The arrow keys access a prompt-specific history.} +%\n @r{Insert the text entered at the nth %^@{@var{prompt}@}, where @code{n} is} + @r{a number, starting from 1.} +%? @r{After completing the template, position cursor here.} @end smallexample @noindent @@ -6682,21 +6855,21 @@ similar way.}: @vindex org-from-is-user-regexp @smallexample -Link type | Available keywords -------------------------+---------------------------------------------- -bbdb | %:name %:company -irc | %:server %:port %:nick -vm, wl, mh, mew, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:date @r{(message date header field)} - | %:date-timestamp @r{(date as active timestamp)} - | %:date-timestamp-inactive @r{(date as inactive timestamp)} - | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}} -gnus | %:group, @r{for messages also all email fields} -w3, w3m | %:url -info | %:file %:node -calendar | %:date +Link type | Available keywords +---------------------------------+---------------------------------------------- +bbdb | %:name %:company +irc | %:server %:port %:nick +vm, vm-imap, wl, mh, mew, rmail | %:type %:subject %:message-id + | %:from %:fromname %:fromaddress + | %:to %:toname %:toaddress + | %:date @r{(message date header field)} + | %:date-timestamp @r{(date as active timestamp)} + | %:date-timestamp-inactive @r{(date as inactive timestamp)} + | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}} +gnus | %:group, @r{for messages also all email fields} +w3, w3m | %:url +info | %:file %:node +calendar | %:date @end smallexample @noindent @@ -6706,6 +6879,29 @@ To place the cursor after template expansion use: %? @r{After completing the template, position cursor here.} @end smallexample +@node Templates in contexts, , Template expansion, Capture templates +@subsubsection Templates in contexts + +@vindex org-capture-templates-contexts +To control whether a capture template should be accessible from a specific +context, you can customize @var{org-capture-templates-contexts}. Let's say +for example that you have a capture template @code{"p"} for storing Gnus +emails containing patches. Then you would configure this option like this: + +@example +(setq org-capture-templates-contexts + '(("p" (in-mode . "message-mode")))) +@end example + +You can also tell that the command key @code{"p"} should refer to another +template. In that case, add this command key like this: + +@example +(setq org-capture-templates-contexts + '(("p" "q" (in-mode . "message-mode")))) +@end example + +See the docstring of the variable for more information. @node Attachments, RSS Feeds, Capture, Capture - Refile - Archive @section Attachments @@ -6947,16 +7143,20 @@ is invoked, the level 1 trees will be checked. @cindex archive locations The default archive location is a file in the same directory as the current file, with the name derived by appending @file{_archive} to the -current file name. For information and examples on how to change this, +current file name. You can also choose what heading to file archived +items under, with the possibility to add them to a datetree in a file. +For information and examples on how to specify the file and the heading, see the documentation string of the variable -@code{org-archive-location}. There is also an in-buffer option for -setting this variable, for example@footnote{For backward compatibility, -the following also works: If there are several such lines in a file, -each specifies the archive location for the text below it. The first -such line also applies to any text before its definition. However, -using this method is @emph{strongly} deprecated as it is incompatible -with the outline structure of the document. The correct method for -setting multiple archive locations in a buffer is using properties.}: +@code{org-archive-location}. + +There is also an in-buffer option for setting this variable, for +example@footnote{For backward compatibility, the following also works: +If there are several such lines in a file, each specifies the archive +location for the text below it. The first such line also applies to any +text before its definition. However, using this method is +@emph{strongly} deprecated as it is incompatible with the outline +structure of the document. The correct method for setting multiple +archive locations in a buffer is using properties.}: @cindex #+ARCHIVE @example @@ -7220,6 +7420,17 @@ the region. Otherwise, restrict it to the current subtree@footnote{For backward compatibility, you can also press @kbd{0} to restrict to the current region/subtree.}. After pressing @kbd{< <}, you still need to press the character selecting the command. + +@item * +@vindex org-agenda-sticky +Toggle sticky agenda views. By default, Org maintains only a single agenda +buffer and rebuilds it each time you change the view, to make sure everything +is always up to date. If you switch between views often and the build time +bothers you, you can turn on sticky agenda buffers (make this the default by +customizing the variable @code{org-agenda-sticky}). With sticky agendas, the +dispatcher only switches to the selected view, you need to update it by hand +with @kbd{r} or @kbd{g}. You can toggle sticky agenda view any time with +@code{org-toggle-sticky-agenda}. @end table You can also define custom commands that will be accessible through the @@ -7368,11 +7579,13 @@ in an Org or Diary file. @cindex appointment @cindex reminders -Org can interact with Emacs appointments notification facility. To add all -the appointments of your agenda files, use the command -@code{org-agenda-to-appt}. This command also lets you filter through the -list of your appointments and add only those belonging to a specific category -or matching a regular expression. See the docstring for details. +Org can interact with Emacs appointments notification facility. To add the +appointments of your agenda files, use the command @code{org-agenda-to-appt}. +This command lets you filter through the list of your appointments and add +only those belonging to a specific category or matching a regular expression. +It also reads a @code{APPT_WARNTIME} property which will then override the +value of @code{appt-message-warning-time} for this appointment. See the +docstring for details. @node Global TODO list, Matching tags and properties, Weekly/daily agenda, Built-in agenda views @subsection The global TODO list @@ -7511,6 +7724,9 @@ So a search @samp{+LEVEL=3+boss-TODO="DONE"} lists all level three headlines that have the tag @samp{boss} and are @emph{not} marked with the TODO keyword DONE. In buffers with @code{org-odd-levels-only} set, @samp{LEVEL} does not count the number of stars, but @samp{LEVEL=2} will correspond to 3 stars etc. +The ITEM special property cannot currently be used in tags/property +searches@footnote{But @pxref{x-agenda-skip-entry-regexp, +,skipping entries based on regexp}.}. Here are more examples: @table @samp @@ -8218,21 +8434,6 @@ Schedule this item. With prefix arg remove the scheduling timestamp @orgcmd{C-c C-d,org-agenda-deadline} Set a deadline for this item. With prefix arg remove the deadline. @c -@orgcmd{k,org-agenda-action} -Agenda actions, to set dates for selected items to the cursor date. -This command also works in the calendar! The command prompts for an -additional key: -@example -m @r{Mark the entry at point for action. You can also make entries} - @r{in Org files with @kbd{C-c C-x C-k}.} -d @r{Set the deadline of the marked entry to the date at point.} -s @r{Schedule the marked entry at the date at point.} -r @r{Call @code{org-capture} with the cursor date as default date.} -@end example -@noindent -Press @kbd{r} afterward to refresh the agenda and see the effect of the -command. -@c @orgcmd{S-@key{right},org-agenda-do-date-later} Change the timestamp associated with the current line by one day into the future. If the date is in the past, the first call to this command will move @@ -8265,9 +8466,18 @@ Cancel the currently running clock. @c @orgcmd{J,org-agenda-clock-goto} Jump to the running clock in another window. +@c +@orgcmd{k,org-agenda-capture} +Like @code{org-capture}, but use the date at point as the default date for +the capture template. See @var{org-capture-use-agenda-date} to make this +the default behavior of @code{org-capture}. +@cindex capturing, from agenda +@vindex org-capture-use-agenda-date @tsubheading{Bulk remote editing selected entries} @cindex remote editing, bulk, from agenda +@vindex org-agenda-bulk-persistent-marks +@vindex org-agenda-bulk-custom-functions @orgcmd{m,org-agenda-bulk-mark} Mark the entry at point for bulk action. With prefix arg, mark that many @@ -8286,10 +8496,12 @@ Unmark all marked entries for bulk action. Bulk action: act on all marked entries in the agenda. This will prompt for another key to select the action to be applied. The prefix arg to @kbd{B} will be passed through to the @kbd{s} and @kbd{d} commands, to bulk-remove -these special timestamps. +these special timestamps. By default, marks are removed after the bulk. If +you want them to persist, set @code{org-agenda-bulk-persistent-marks} to +@code{t} or hit @kbd{p} at the prompt. + @example -r @r{Prompt for a single refile target and move all entries. The entries} - @r{will no longer be in the agenda; refresh (@kbd{g}) to bring them back.} +* @r{Toggle persistent marks.} $ @r{Archive all selected entries.} A @r{Archive entries by moving them to their respective archive siblings.} t @r{Change TODO state. This prompts for a single TODO keyword and} @@ -8300,10 +8512,12 @@ t @r{Change TODO state. This prompts for a single TODO keyword and} s @r{Schedule all items to a new date. To shift existing schedule dates} @r{by a fixed number of days, use something starting with double plus} @r{at the prompt, for example @samp{++8d} or @samp{++2w}.} +d @r{Set deadline to a specific date.} +r @r{Prompt for a single refile target and move all entries. The entries} + @r{will no longer be in the agenda; refresh (@kbd{g}) to bring them back.} S @r{Reschedule randomly into the coming N days. N will be prompted for.} @r{With prefix arg (@kbd{C-u B S}), scatter only across weekdays.} -d @r{Set deadline to a specific date.} -f @r{Apply a function to marked entries.} +f @r{Apply a function@footnote{You can also create persistent custom functions through@code{org-agenda-bulk-custom-functions}.} to marked entries.} @r{For example, the function below sets the CATEGORY property of the} @r{entries to web.} @r{(defun set-category ()} @@ -8371,7 +8585,7 @@ Export a single iCalendar file containing entries from all agenda files. This is a globally available command, and also available in the agenda menu. @tsubheading{Exporting to a file} -@orgcmd{C-x C-w,org-write-agenda} +@orgcmd{C-x C-w,org-agenda-write} @cindex exporting agenda views @cindex agenda views, exporting @vindex org-agenda-exporter-settings @@ -8420,11 +8634,12 @@ buffer, or a sparse tree (the latter covering of course only the current buffer). @kindex C-c a C @vindex org-agenda-custom-commands + Custom commands are configured in the variable @code{org-agenda-custom-commands}. You can customize this variable, for -example by pressing @kbd{C-c a C}. You can also directly set it with -Emacs Lisp in @file{.emacs}. The following example contains all valid -search types: +example by pressing @kbd{C-c a C}. You can also directly set it with Emacs +Lisp in @file{.emacs}. The following example contains all valid search +types: @lisp @group @@ -8584,6 +8799,27 @@ this interface, the @emph{values} are just Lisp expressions. So if the value is a string, you need to add the double-quotes around the value yourself. +@vindex org-agenda-custom-commands-contexts +To control whether an agenda command should be accessible from a specific +context, you can customize @var{org-agenda-custom-commands-contexts}. Let's +say for example that you have an agenda commands @code{"o"} displaying a view +that you only need when reading emails. Then you would configure this option +like this: + +@example +(setq org-agenda-custom-commands-contexts + '(("o" (in-mode . "message-mode")))) +@end example + +You can also tell that the command key @code{"o"} should refer to another +command key @code{"r"}. In that case, add this command key like this: + +@example +(setq org-agenda-custom-commands-contexts + '(("o" "r" (in-mode . "message-mode")))) +@end example + +See the docstring of the variable for more information. @node Exporting Agenda Views, Agenda column view, Custom agenda views, Agenda Views @section Exporting Agenda Views @@ -8598,7 +8834,7 @@ a PDF file will also create the postscript file.}, and iCalendar files. If you want to do this only occasionally, use the command @table @kbd -@orgcmd{C-x C-w,org-write-agenda} +@orgcmd{C-x C-w,org-agenda-write} @cindex exporting agenda views @cindex agenda views, exporting @vindex org-agenda-exporter-settings @@ -8777,6 +9013,14 @@ a column listing the planned total effort for a task---one of the major applications for column view in the agenda. If you want information about clocked time in the displayed period use clock table mode (press @kbd{R} in the agenda). + +@item +@cindex property, special, CLOCKSUM_T +When the column view in the agenda shows the @code{CLOCKSUM_T}, that is +always today's clocked time for this item. So even in the weekly agenda, +the clocksum listed in column view only originates from today. This lets +you compare the time you spent on a task for today, with the time already +spent (via @code{CLOCKSUM}) and with the planned total effort for it. @end enumerate @@ -8988,11 +9232,11 @@ a horizontal line (@samp{<hr/>} in HTML and @code{\hrule} in @LaTeX{}). @cindex exporting, not @cindex #+BEGIN_COMMENT -Lines starting with @samp{#} in column zero are treated as comments and will -never be exported. If you want an indented line to be treated as a comment, -start it with @samp{#+ }. Also entire subtrees starting with the word -@samp{COMMENT} will never be exported. Finally, regions surrounded by -@samp{#+BEGIN_COMMENT} ... @samp{#+END_COMMENT} will not be exported. +Lines starting with zero or more whitespace characters followed by @samp{#} +are treated as comments and will never be exported. Also entire subtrees +starting with the word @samp{COMMENT} will never be exported. Finally, +regions surrounded by @samp{#+BEGIN_COMMENT} ... @samp{#+END_COMMENT} will +not be exported. @table @kbd @kindex C-c ; @@ -9016,7 +9260,7 @@ the object with @code{\ref@{tab:basic-data@}}: @example #+CAPTION: This is the caption for the next table (or link) -#+LABEL: tbl:basic-data +#+LABEL: tab:basic-data | ... | ...| |-----|----| @end example @@ -9080,23 +9324,14 @@ look like the fontified Emacs buffer@footnote{This works automatically for the HTML backend (it requires version 1.34 of the @file{htmlize.el} package, which is distributed with Org). Fontified code chunks in @LaTeX{} can be achieved using either the listings or the -@url{http://code.google.com/p/minted, minted,} package. To use listings, turn -on the variable @code{org-export-latex-listings} and ensure that the listings -package is included by the @LaTeX{} header (e.g.@: by configuring -@code{org-export-latex-packages-alist}). See the listings documentation for -configuration options, including obtaining colored output. For minted it is -necessary to install the program @url{http://pygments.org, pygments}, in -addition to setting @code{org-export-latex-minted}, ensuring that the minted -package is included by the @LaTeX{} header, and ensuring that the -@code{-shell-escape} option is passed to @file{pdflatex} (see -@code{org-latex-to-pdf-process}). See the documentation of the variables -@code{org-export-latex-listings} and @code{org-export-latex-minted} for -further details.}. This is done with the @samp{src} block, where you also -need to specify the name of the major mode that should be used to fontify the -example@footnote{Code in @samp{src} blocks may also be evaluated either -interactively or on export. See @pxref{Working With Source Code} for more -information on evaluating code blocks.}, see @ref{Easy Templates} for -shortcuts to easily insert code blocks. +@url{http://code.google.com/p/minted, minted,} package. Refer to +@code{org-export-latex-listings} documentation for details.}. This is done +with the @samp{src} block, where you also need to specify the name of the +major mode that should be used to fontify the example@footnote{Code in +@samp{src} blocks may also be evaluated either interactively or on export. +See @pxref{Working With Source Code} for more information on evaluating code +blocks.}, see @ref{Easy Templates} for shortcuts to easily insert code +blocks. @cindex #+BEGIN_SRC @example @@ -9276,7 +9511,7 @@ readily processed to produce pretty output for a number of export backends. @menu * Special symbols:: Greek letters and other symbols * Subscripts and superscripts:: Simple syntax for raising/lowering text -* @LaTeX{} fragments:: Complex formulas made easy +* @LaTeX{} fragments:: Complex formulas made easy * Previewing @LaTeX{} fragments:: What will this snippet look like? * CDLaTeX mode:: Speed up entering of formulas @end menu @@ -9382,10 +9617,11 @@ this regularly or on pages with significant page views, you should install server in order to limit the load of our server.}. Finally, it can also process the mathematical expressions into images@footnote{For this to work you need to be on a system with a working @LaTeX{} installation. You also -need the @file{dvipng} program, available at -@url{http://sourceforge.net/projects/dvipng/}. The @LaTeX{} header that will -be used when processing a fragment can be configured with the variable -@code{org-format-latex-header}.} that can be displayed in a browser or in +need the @file{dvipng} program or the @file{convert}, respectively available +at @url{http://sourceforge.net/projects/dvipng/} and from the +@file{imagemagick} suite. The @LaTeX{} header that will be used when +processing a fragment can be configured with the variable +@code{org-format-latex-header}.} that can be displayed in a browser or in DocBook documents. @LaTeX{} fragments don't need any special marking at all. The following @@ -9630,7 +9866,7 @@ Insert template with export options, see example below. @cindex #+EXPORT_SELECT_TAGS @cindex #+EXPORT_EXCLUDE_TAGS @cindex #+XSLT -@cindex #+LATEX_HEADER +@cindex #+LaTeX_HEADER @vindex user-full-name @vindex user-mail-address @vindex org-export-default-language @@ -9650,7 +9886,7 @@ Insert template with export options, see example below. @r{You need to confirm using these, or configure @code{org-export-allow-BIND}} #+LINK_UP: the ``up'' link of an exported page #+LINK_HOME: the ``home'' link of an exported page -#+LATEX_HEADER: extra line(s) for the @LaTeX{} header, like \usepackage@{xyz@} +#+LaTeX_HEADER: extra line(s) for the @LaTeX{} header, like \usepackage@{xyz@} #+EXPORT_SELECT_TAGS: Tags that select a tree for export #+EXPORT_EXCLUDE_TAGS: Tags that exclude a tree from export #+XSLT: the XSLT stylesheet used by DocBook exporter to generate FO file @@ -9707,7 +9943,7 @@ author: @r{turn on/off inclusion of author name/email into exported file} email: @r{turn on/off inclusion of author email into exported file} creator: @r{turn on/off inclusion of creator info into exported file} timestamp: @r{turn on/off inclusion creation time into exported file} -d: @r{turn on/off inclusion of drawers} +d: @r{turn on/off inclusion of drawers, or list drawers to include} @end example @noindent These options take effect in both the HTML and @LaTeX{} export, except for @@ -9770,7 +10006,7 @@ with special characters and symbols available in these encodings. @table @kbd @orgcmd{C-c C-e a,org-export-as-ascii} @cindex property, EXPORT_FILE_NAME -Export as ASCII file. For an Org file, @file{myfile.org}, the ASCII file +Export as an ASCII file. For an Org file, @file{myfile.org}, the ASCII file will be @file{myfile.txt}. The file will be overwritten without warning. If there is an active region@footnote{This requires @code{transient-mark-mode} be turned on.}, only the region will be @@ -9802,13 +10038,13 @@ at a different level, specify it with a prefix argument. For example, @end example @noindent -creates only top level headlines and does the rest as items. When +creates only top level headlines and exports the rest as items. When headlines are converted to items, the indentation of the text following the headline is changed to fit nicely under the item. This is done with the assumption that the first body line indicates the base indentation of the body text. Any indentation larger than this is adjusted to preserve the layout relative to the first line. Should there be lines with less -indentation than the first, these are left alone. +indentation than the first one, these are left alone. @vindex org-export-ascii-links-to-notes Links will be exported in a footnote-like style, with the descriptive part in @@ -9819,7 +10055,7 @@ the text and the link in a note before the next heading. See the variable @section HTML export @cindex HTML export -Org mode contains an HTML (XHTML 1.0 strict) exporter with extensive +Org mode contains a HTML (XHTML 1.0 strict) exporter with extensive HTML formatting, in ways similar to John Gruber's @emph{markdown} language, but with additional support for tables. @@ -9845,7 +10081,7 @@ language, but with additional support for tables. @table @kbd @orgcmd{C-c C-e h,org-export-as-html} @cindex property, EXPORT_FILE_NAME -Export as HTML file. For an Org file @file{myfile.org}, +Export as a HTML file. For an Org file @file{myfile.org}, the HTML file will be @file{myfile.html}. The file will be overwritten without warning. If there is an active region@footnote{This requires @code{transient-mark-mode} be turned on.}, only the region will be @@ -9854,7 +10090,7 @@ current subtree, use @kbd{C-c @@}.}, the tree head will become the document title. If the tree head entry has, or inherits, an @code{EXPORT_FILE_NAME} property, that name will be used for the export. @orgcmd{C-c C-e b,org-export-as-html-and-open} -Export as HTML file and immediately open it with a browser. +Export as a HTML file and immediately open it with a browser. @orgcmd{C-c C-e H,org-export-as-html-to-buffer} Export to a temporary buffer. Do not create a file. @orgcmd{C-c C-e R,org-export-region-as-html} @@ -9864,7 +10100,7 @@ the region. This is good for cut-and-paste operations. @item C-c C-e v h/b/H/R Export only the visible part of the document. @item M-x org-export-region-as-html -Convert the region to HTML under the assumption that it was Org mode +Convert the region to HTML under the assumption that it was in Org mode syntax before. This is a global command that can be invoked in any buffer. @item M-x org-replace-region-by-HTML @@ -9901,11 +10137,11 @@ creates two levels of headings and does the rest as items. The HTML exporter lets you define a preamble and a postamble. The default value for @code{org-export-html-preamble} is @code{t}, which -means that the preamble is inserted depending on the relevant formatting -string in @code{org-export-html-preamble-format}. +means that the preamble is inserted depending on the relevant format string +in @code{org-export-html-preamble-format}. Setting @code{org-export-html-preamble} to a string will override the default -formatting string. Setting it to a function, will insert the output of the +format string. Setting it to a function, will insert the output of the function, which must be a string; such a function takes no argument but you can check against the value of @code{opt-plist}, which contains the list of publishing properties for the current file. Setting to @code{nil} will not @@ -9917,7 +10153,7 @@ means that the HTML exporter will look for the value of @code{org-export-creator-info} and @code{org-export-time-stamp-file}, @code{org-export-html-validation-link} and build the postamble from these values. Setting @code{org-export-html-postamble} to @code{t} will insert the -postamble from the relevant formatting string found in +postamble from the relevant format string found in @code{org-export-html-postamble-format}. Setting it to @code{nil} will not insert any postamble. @@ -9958,7 +10194,7 @@ includes automatic links created by radio targets (@pxref{Radio targets}). Links to external files will still work if the target file is on the same @i{relative} path as the published Org file. Links to other @file{.org} files will be translated into HTML links under the assumption -that an HTML version also exists of the linked file, at the same relative +that a HTML version also exists of the linked file, at the same relative path. @samp{id:} links can then be used to jump to specific entries across files. For information related to linking files while publishing them to a publishing directory see @ref{Publishing links}. @@ -10199,7 +10435,7 @@ viewing options: path: @r{The path to the script. The default is to grab the script from} @r{@url{http://orgmode.org/org-info.js}, but you might want to have} @r{a local copy and use a path like @samp{../scripts/org-info.js}.} -view: @r{Initial view when website is first shown. Possible values are:} +view: @r{Initial view when the website is first shown. Possible values are:} info @r{Info-like interface with one section per page.} overview @r{Folding interface, initially showing only top-level.} content @r{Folding interface, starting with all headlines visible.} @@ -10265,7 +10501,7 @@ sections. @table @kbd @orgcmd{C-c C-e l,org-export-as-latex} @cindex property EXPORT_FILE_NAME -Export as @LaTeX{} file. For an Org file +Export as a @LaTeX{} file. For an Org file @file{myfile.org}, the @LaTeX{} file will be @file{myfile.tex}. The file will be overwritten without warning. If there is an active region@footnote{This requires @code{transient-mark-mode} be turned on.}, only the region will be @@ -10278,7 +10514,7 @@ Export to a temporary buffer. Do not create a file. @item C-c C-e v l/L Export only the visible part of the document. @item M-x org-export-region-as-latex -Convert the region to @LaTeX{} under the assumption that it was Org mode +Convert the region to @LaTeX{} under the assumption that it was in Org mode syntax before. This is a global command that can be invoked in any buffer. @item M-x org-replace-region-by-latex @@ -10322,11 +10558,11 @@ By default, the @LaTeX{} output uses the class @code{article}. @vindex org-export-latex-classes @vindex org-export-latex-default-packages-alist @vindex org-export-latex-packages-alist -@cindex #+LATEX_HEADER -@cindex #+LATEX_CLASS -@cindex #+LATEX_CLASS_OPTIONS -@cindex property, LATEX_CLASS -@cindex property, LATEX_CLASS_OPTIONS +@cindex #+LaTeX_HEADER +@cindex #+LaTeX_CLASS +@cindex #+LaTeX_CLASS_OPTIONS +@cindex property, LaTeX_CLASS +@cindex property, LaTeX_CLASS_OPTIONS You can change this globally by setting a different value for @code{org-export-latex-default-class} or locally by adding an option like @code{#+LaTeX_CLASS: myclass} in your file, or with a @code{:LaTeX_CLASS:} @@ -10336,11 +10572,22 @@ defines a header template for each class@footnote{Into which the values of @code{org-export-latex-default-packages-alist} and @code{org-export-latex-packages-alist} are spliced.}, and allows you to define the sectioning structure for each class. You can also define your own -classes there. @code{#+LaTeX_CLASS_OPTIONS} or a @code{LaTeX_CLASS_OPTIONS} -property can specify the options for the @code{\documentclass} macro. You -can also use @code{#+LATEX_HEADER: \usepackage@{xyz@}} to add lines to the -header. See the docstring of @code{org-export-latex-classes} for more -information. +classes there. @code{#+LaTeX_CLASS_OPTIONS} or a @code{:LaTeX_CLASS_OPTIONS:} +property can specify the options for the @code{\documentclass} macro. The +options to documentclass have to be provided, as expected by @LaTeX{}, within +square brackets. You can also use @code{#+LaTeX_HEADER: \usepackage@{xyz@}} +to add lines to the header. See the docstring of +@code{org-export-latex-classes} for more information. An example is shown +below. + +@example +#+LaTeX_CLASS: article +#+LaTeX_CLASS_OPTIONS: [a4paper] +#+LaTeX_HEADER: \usepackage@{xyz@} + +* Headline 1 + some text +@end example @node Quoting @LaTeX{} code, Tables in @LaTeX{} export, Header and sectioning, @LaTeX{} and PDF export @subsection Quoting @LaTeX{} code @@ -10424,9 +10671,7 @@ add something like @samp{placement=[h!]} to the attributes. It is to be noted this option can be used with tables as well@footnote{One can also take advantage of this option to pass other, unrelated options into the figure or table environment. For an example see the section ``Exporting org files'' in -@url{http://orgmode.org/worg/org-hacks.html}}. For example the -@code{#+ATTR_LaTeX:} line below is exported as the @code{figure} environment -below it. +@url{http://orgmode.org/worg/org-hacks.html}}. If you would like to let text flow around the image, add the word @samp{wrap} to the @code{#+ATTR_LaTeX:} line, which will make the figure occupy the left @@ -10513,7 +10758,7 @@ transitions. Frames will automatically receive a @code{fragile} option if they contain source code that uses the verbatim environment. Special @file{beamer} specific code can be inserted using @code{#+BEAMER:} and -@code{#+BEGIN_beamer...#+end_beamer} constructs, similar to other export +@code{#+BEGIN_BEAMER...#+END_BEAMER} constructs, similar to other export backends, but with the difference that @code{#+LaTeX:} stuff will be included in the presentation as well. @@ -10613,7 +10858,7 @@ Currently DocBook exporter only supports DocBook V5.0. @table @kbd @orgcmd{C-c C-e D,org-export-as-docbook} @cindex property EXPORT_FILE_NAME -Export as DocBook file. For an Org file, @file{myfile.org}, the DocBook XML +Export as a DocBook file. For an Org file, @file{myfile.org}, the DocBook XML file will be @file{myfile.xml}. The file will be overwritten without warning. If there is an active region@footnote{This requires @code{transient-mark-mode} to be turned on}, only the region will be @@ -10622,12 +10867,12 @@ current subtree, use @kbd{C-c @@}.}, the tree head will become the document title. If the tree head entry has, or inherits, an @code{EXPORT_FILE_NAME} property, that name will be used for the export. @orgcmd{C-c C-e V,org-export-as-docbook-pdf-and-open} -Export as DocBook file, process to PDF, then open the resulting PDF file. +Export as a DocBook file, process to PDF, then open the resulting PDF file. @vindex org-export-docbook-xslt-proc-command @vindex org-export-docbook-xsl-fo-proc-command -Note that, in order to produce PDF output based on exported DocBook file, you -need to have XSLT processor and XSL-FO processor software installed on your +Note that, in order to produce PDF output based on an exported DocBook file, +you need to have XSLT processor and XSL-FO processor software installed on your system. Check variables @code{org-export-docbook-xslt-proc-command} and @code{org-export-docbook-xsl-fo-proc-command}. @@ -10791,7 +11036,7 @@ special characters included in XHTML entities: @cindex org-odt.el @cindex org-modules -Orgmode@footnote{Versions 7.8 or later} supports export to OpenDocument Text +Org Mode@footnote{Versions 7.8 or later} supports export to OpenDocument Text (ODT) format using the @file{org-odt.el} module. Documents created by this exporter use the @cite{OpenDocument-v1.2 specification}@footnote{@url{http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html, @@ -10848,7 +11093,7 @@ inherits, an @code{EXPORT_FILE_NAME} property, that name will be used for the export. @orgcmd{C-c C-e O,org-export-as-odt-and-open} -Export as OpenDocument Text file and open the resulting file. +Export as an OpenDocument Text file and open the resulting file. @vindex org-export-odt-preferred-output-format If @code{org-export-odt-preferred-output-format} is specified, open the @@ -11180,11 +11425,11 @@ the @LaTeX{}-to-MathML converter. @table @kbd @item M-x org-export-as-odf -Convert a @LaTeX{} math snippet to OpenDocument formula (@file{.odf}) file. +Convert a @LaTeX{} math snippet to an OpenDocument formula (@file{.odf}) file. @item M-x org-export-as-odf-and-open -Convert a @LaTeX{} math snippet to OpenDocument formula (@file{.odf}) file and -open the formula file with the system-registered application. +Convert a @LaTeX{} math snippet to an OpenDocument formula (@file{.odf}) file +and open the formula file with the system-registered application. @end table @cindex dvipng @@ -11720,10 +11965,10 @@ all the nodes. @table @kbd @orgcmd{C-c C-e j,org-export-as-taskjuggler} -Export as TaskJuggler file. +Export as a TaskJuggler file. @orgcmd{C-c C-e J,org-export-as-taskjuggler-and-open} -Export as TaskJuggler file and then open the file with TaskJugglerUI. +Export as a TaskJuggler file and then open the file with TaskJugglerUI. @end table @subsection Tasks @@ -11833,7 +12078,7 @@ The Freemind exporter was written by Lennart Borgman. @table @kbd @orgcmd{C-c C-e m,org-export-as-freemind} -Export as Freemind mind map. For an Org file @file{myfile.org}, the Freemind +Export as a Freemind mind map. For an Org file @file{myfile.org}, the Freemind file will be @file{myfile.mm}. @end table @@ -11847,7 +12092,7 @@ does not interpret any additional Org mode features. @table @kbd @orgcmd{C-c C-e x,org-export-as-xoxo} -Export as XOXO file. For an Org file @file{myfile.org}, the XOXO file will be +Export as an XOXO file. For an Org file @file{myfile.org}, the XOXO file will be @file{myfile.html}. @orgkey{C-c C-e v x} Export only the visible part of the document. @@ -12318,7 +12563,7 @@ publish it as @file{theindex.html}. @end multitable The file will be created when first publishing a project with the -@code{:makeindex} set. The file only contains a statement @code{#+include: +@code{:makeindex} set. The file only contains a statement @code{#+INCLUDE: "theindex.inc"}. You can then build around this include statement by adding a title, style information, etc. @@ -12352,7 +12597,7 @@ Publishing to a local directory is also much faster than to a remote one, so that you can afford more easily to republish entire projects. If you set @code{org-publish-use-timestamps-flag} to @code{nil}, you gain the main benefit of re-including any changed external files such as source example -files you might include with @code{#+INCLUDE}. The timestamp mechanism in +files you might include with @code{#+INCLUDE:}. The timestamp mechanism in Org is not smart enough to detect if included files have been modified. @node Sample configuration, Triggering publication, Uploading files, Publishing @@ -12709,7 +12954,7 @@ and/or the name of the evaluated code block. The default value of @code{org-babel-results-keyword}. By default, the evaluation facility is only enabled for Lisp code blocks -specified as @code{emacs-lisp}. However, source code blocks in many languages +specified as @code{emacs-lisp}. However, source code blocks in many languages can be evaluated within Org mode (see @ref{Languages} for a list of supported languages and @ref{Structure of code blocks} for information on the syntax used to define a code block). @@ -12723,8 +12968,8 @@ evaluation from the @kbd{C-c C-c} key binding.}. This will call the its results into the Org mode buffer. @cindex #+CALL -It is also possible to evaluate named code blocks from anywhere in an -Org mode buffer or an Org mode table. Live code blocks located in the current +It is also possible to evaluate named code blocks from anywhere in an Org +mode buffer or an Org mode table. Live code blocks located in the current Org mode buffer or in the ``Library of Babel'' (see @ref{Library of Babel}) can be executed. Named code blocks can be executed with a separate @code{#+CALL:} line or inline within a block of text. @@ -12826,7 +13071,7 @@ Code blocks in the following languages are supported. Language-specific documentation is available for some languages. If available, it can be found at -@uref{http://orgmode.org/worg/org-contrib/babel/languages}. +@uref{http://orgmode.org/worg/org-contrib/babel/languages.html}. The @code{org-babel-load-languages} controls which languages are enabled for evaluation (by default only @code{emacs-lisp} is enabled). This variable can @@ -13018,7 +13263,7 @@ Multi-line header arguments on an un-named code block: (message "data1:%S, data2:%S" data1 data2) #+END_SRC - #+results: + #+RESULTS: : data1:1, data2:2 @end example @@ -13030,7 +13275,7 @@ Multi-line header arguments on a named code block: (message "data:%S" data) #+END_SRC - #+results: named-block + #+RESULTS: named-block : data:2 @end example @@ -13065,6 +13310,7 @@ argument in lowercase letters. The following header arguments are defined: * results:: Specify the type of results and how they will be collected and handled * file:: Specify a path for file output +* file-desc:: Specify a description for file results * dir:: Specify the default (possibly remote) directory for code block execution * exports:: Export code and/or results @@ -13088,6 +13334,7 @@ argument in lowercase letters. The following header arguments are defined: * rownames:: Handle row names in tables * shebang:: Make tangled files executable * eval:: Limit evaluation of specific code blocks +* wrap:: Mark source block evaluation results @end menu Additional header arguments are defined on a language-specific basis, see @@ -13102,7 +13349,7 @@ syntax used to specify arguments is the same across all languages. In every case, variables require a default value when they are declared. The values passed to arguments can either be literal values, references, or -Emacs Lisp code (see @ref{var, Emacs Lisp evaluation of variables}). References +Emacs Lisp code (see @ref{var, Emacs Lisp evaluation of variables}). References include anything in the Org mode file that takes a @code{#+NAME:}, @code{#+TBLNAME:}, or @code{#+RESULTS:} line. This includes tables, lists, @code{#+BEGIN_EXAMPLE} blocks, other code blocks, and the results of other @@ -13141,7 +13388,7 @@ an Org mode table named with either a @code{#+NAME:} or @code{#+TBLNAME:} line (length table) #+END_SRC -#+results: table-length +#+RESULTS: table-length : 4 @end example @@ -13160,7 +13407,7 @@ carried through to the source code block) (print x) #+END_SRC -#+results: +#+RESULTS: | simple | list | @end example @@ -13173,7 +13420,7 @@ optionally followed by parentheses (* 2 length) #+END_SRC -#+results: +#+RESULTS: : 8 @end example @@ -13188,7 +13435,7 @@ code block name using standard function call syntax (* 2 input) #+END_SRC -#+results: double +#+RESULTS: double : 16 #+NAME: squared @@ -13196,7 +13443,7 @@ code block name using standard function call syntax (* input input) #+END_SRC -#+results: squared +#+RESULTS: squared : 4 @end example @@ -13215,7 +13462,7 @@ on two lines (concatenate 'string x " for you.") #+END_SRC -#+results: read-literal-example +#+RESULTS: read-literal-example : A literal example : on two lines for you. @@ -13257,7 +13504,7 @@ following example assigns the last cell of the first row the table data #+END_SRC -#+results: +#+RESULTS: : a @end example @@ -13278,7 +13525,7 @@ to @code{data}. data #+END_SRC -#+results: +#+RESULTS: | 2 | b | | 3 | c | | 4 | d | @@ -13300,7 +13547,7 @@ column is referenced. data #+END_SRC -#+results: +#+RESULTS: | 1 | 2 | 3 | 4 | @end example @@ -13320,7 +13567,7 @@ another by commas, as shown in the following example. data #+END_SRC -#+results: +#+RESULTS: | 11 | 14 | 17 | @end example @@ -13353,7 +13600,7 @@ Emacs Lisp, as shown in the following example. $data #+END_SRC -#+results: +#+RESULTS: : (a b c) @end example @@ -13414,15 +13661,19 @@ buffer as quoted text. E.g., @code{:results value verbatim}. @item @code{file} The results will be interpreted as the path to a file, and will be inserted into the Org mode buffer as a file link. E.g., @code{:results value file}. -@item @code{raw}, @code{org} +@item @code{raw} The results are interpreted as raw Org mode code and are inserted directly into the buffer. If the results look like a table they will be aligned as such by Org mode. E.g., @code{:results value raw}. +@item @code{org} +The results are will be enclosed in a @code{BEGIN_SRC org} block. +They are not comma-escaped by default but they will be if you hit @kbd{TAB} +in the block and/or if you export the file. E.g., @code{:results value org}. @item @code{html} -Results are assumed to be HTML and will be enclosed in a @code{begin_html} +Results are assumed to be HTML and will be enclosed in a @code{BEGIN_HTML} block. E.g., @code{:results value html}. @item @code{latex} -Results assumed to be @LaTeX{} and are enclosed in a @code{begin_latex} block. +Results assumed to be @LaTeX{} and are enclosed in a @code{BEGIN_LaTeX} block. E.g., @code{:results value latex}. @item @code{code} Result are assumed to be parsable code and are enclosed in a code block. @@ -13431,7 +13682,7 @@ E.g., @code{:results value code}. The result is converted to pretty-printed code and is enclosed in a code block. This option currently supports Emacs Lisp, Python, and Ruby. E.g., @code{:results value pp}. -@item @code{wrap} +@item @code{drawer} The result is wrapped in a RESULTS drawer. This can be useful for inserting @code{raw} or @code{org} syntax results in such a way that their extent is known and they can be automatically removed or replaced. @@ -13459,7 +13710,7 @@ be prepended to the existing results. Otherwise the new results will be inserted as with @code{replace}. @end itemize -@node file, dir, results, Specific header arguments +@node file, file-desc, results, Specific header arguments @subsubsection @code{:file} The header argument @code{:file} is used to specify an external file in which @@ -13475,7 +13726,16 @@ The argument to @code{:file} should be either a string specifying the path to a file, or a list of two strings in which case the first element of the list should be the path to a file and the second a description for the link. -@node dir, exports, file, Specific header arguments +@node file-desc, dir, file, Specific header arguments +@subsubsection @code{:file-desc} + +The value of the @code{:file-desc} header argument is used to provide a +description for file code block results which are inserted as Org mode links +(see @ref{Link format}). If the @code{:file-desc} header argument is given +with no value the link path will be placed in both the ``link'' and the +``description'' portion of the Org mode link. + +@node dir, exports, file-desc, Specific header arguments @subsubsection @code{:dir} and remote execution While the @code{:file} header argument can be used to specify the path to the @@ -13655,21 +13915,34 @@ interpreted language. @node noweb, noweb-ref, session, Specific header arguments @subsubsection @code{:noweb} -The @code{:noweb} header argument controls expansion of ``noweb'' style (see -@ref{Noweb reference syntax}) references in a code block. This header -argument can have one of three values: @code{yes}, @code{no}, or @code{tangle}. +The @code{:noweb} header argument controls expansion of ``noweb'' syntax +references (see @ref{Noweb reference syntax}) when the code block is +evaluated, tangled, or exported. The @code{:noweb} header argument can have +one of the five values: @code{no}, @code{yes}, @code{tangle}, or +@code{no-export} @code{strip-export}. @itemize @bullet -@item @code{yes} -All ``noweb'' syntax references in the body of the code block will be -expanded before the block is evaluated, tangled or exported. @item @code{no} -The default. No ``noweb'' syntax specific action is taken when the code -block is evaluated, tangled or exported. +The default. ``Noweb'' syntax references in the body of the code block will +not be expanded before the code block is evaluated, tangled or exported. +@item @code{yes} +``Noweb'' syntax references in the body of the code block will be +expanded before the code block is evaluated, tangled or exported. @item @code{tangle} -All ``noweb'' syntax references in the body of the code block will be -expanded before the block is tangled, however ``noweb'' references will not -be expanded when the block is evaluated or exported. +``Noweb'' syntax references in the body of the code block will be expanded +before the code block is tangled. However, ``noweb'' syntax references will +not be expanded when the code block is evaluated or exported. +@item @code{no-export} +``Noweb'' syntax references in the body of the code block will be expanded +before the block is evaluated or tangled. However, ``noweb'' syntax +references will not be expanded when the code block is exported. +@item @code{strip-export} +``Noweb'' syntax references in the body of the code block will be expanded +before the block is evaluated or tangled. However, ``noweb'' syntax +references will not be removed when the code block is exported. +@item @code{eval} +``Noweb'' syntax references in the body of the code block will only be +expanded before the block is evaluated. @end itemize @subsubheading Noweb prefix lines @@ -13760,7 +14033,7 @@ the results of evaluating code blocks. It can be used to avoid re-evaluating unchanged code blocks. Note that the @code{:cache} header argument will not attempt to cache results when the @code{:session} header argument is used, because the results of the code block execution may be stored in the session -outside of the Org-mode buffer. The @code{:cache} header argument can have +outside of the Org mode buffer. The @code{:cache} header argument can have one of two values: @code{yes} or @code{no}. @itemize @bullet @@ -13770,7 +14043,7 @@ every time it is called. @item @code{yes} Every time the code block is run a SHA1 hash of the code and arguments passed to the block will be generated. This hash is packed into the -@code{#+results:} line and will be checked on subsequent +@code{#+RESULTS:} line and will be checked on subsequent executions of the code block. If the code block has not changed since the last time it was evaluated, it will not be re-evaluated. @end itemize @@ -13787,7 +14060,7 @@ changed since it was last run. runif(1) #+END_SRC - #+results[a2a72cd647ad44515fab62e144796432793d68e1]: random + #+RESULTS[a2a72cd647ad44515fab62e144796432793d68e1]: random 0.4659510825295 #+NAME: caller @@ -13795,7 +14068,7 @@ changed since it was last run. x #+END_SRC - #+results[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller + #+RESULTS[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller 0.254227238707244 @end example @@ -13839,7 +14112,7 @@ default value yields the following results. return tab #+END_SRC -#+results: echo-table +#+RESULTS: echo-table | a | b | c | | d | e | f | | g | h | i | @@ -13861,7 +14134,7 @@ Leaves hlines in the table. Setting @code{:hlines yes} has this effect. return tab #+END_SRC -#+results: echo-table +#+RESULTS: echo-table | a | b | c | |---+---+---| | d | e | f | @@ -13899,7 +14172,7 @@ processing, then reapplied to the results. return [[val + '*' for val in row] for row in tab] #+END_SRC -#+results: echo-table-again +#+RESULTS: echo-table-again | a | |----| | b* | @@ -13942,7 +14215,7 @@ and is then reapplied to the results. return [[val + 10 for val in row] for row in tab] #+END_SRC -#+results: echo-table-once-again +#+RESULTS: echo-table-once-again | one | 11 | 12 | 13 | 14 | 15 | | two | 16 | 17 | 18 | 19 | 20 | @end example @@ -13960,7 +14233,7 @@ Setting the @code{:shebang} header argument to a string value first line of any tangled file holding the code block, and the file permissions of the tangled file are set to make it executable. -@node eval, , shebang, Specific header arguments +@node eval, wrap, shebang, Specific header arguments @subsubsection @code{:eval} The @code{:eval} header argument can be used to limit the evaluation of specific code blocks. The @code{:eval} header argument can be useful for @@ -13985,6 +14258,14 @@ If this header argument is not set then evaluation is determined by the value of the @code{org-confirm-babel-evaluate} variable see @ref{Code evaluation security}. +@node wrap, , eval, Specific header arguments +@subsubsection @code{:wrap} +The @code{:wrap} header argument is used to mark the results of source block +evaluation. The header argument can be passed a string that will be appended +to @code{#+BEGIN_} and @code{#+END_}, which will then be used to wrap the +results. If not string is specified then the results will be wrapped in a +@code{#+BEGIN/END_RESULTS} block. + @node Results of evaluation, Noweb reference syntax, Header arguments, Working With Source Code @section Results of evaluation @cindex code block, results of evaluation @@ -14054,7 +14335,7 @@ process. For example, compare the following two blocks: print "bye" #+END_SRC -#+results: +#+RESULTS: : hello : bye @end example @@ -14067,7 +14348,7 @@ In non-session mode, the `2' is not printed and does not appear. print "bye" #+END_SRC -#+results: +#+RESULTS: : hello : 2 : bye @@ -14112,7 +14393,7 @@ correct code is not broken in a language, such as Ruby, where syntactically valid in languages that you use, then please consider setting the default value. -Note: if noweb tangling is slow in large Org-mode files consider setting the +Note: if noweb tangling is slow in large Org mode files consider setting the @code{*org-babel-use-quick-and-dirty-noweb-expansion*} variable to true. This will result in faster noweb reference resolution at the expense of not correctly resolving inherited values of the @code{:noweb-ref} header @@ -14252,7 +14533,7 @@ done emacs -Q --batch -l $ORGINSTALL \ --eval "(progn (add-to-list 'load-path (expand-file-name \"~/src/org/lisp/\")) -(add-to-list 'load-path (expand-file-name \"~/src/org/contrib/lisp/\")) +(add-to-list 'load-path (expand-file-name \"~/src/org/contrib/lisp/\" t)) (require 'org)(require 'org-exp)(require 'ob)(require 'ob-tangle) (mapc (lambda (file) (find-file (expand-file-name file \"$DIR\")) @@ -14358,19 +14639,19 @@ keystrokes are typed on a line by itself. The following template selectors are currently supported. @multitable @columnfractions 0.1 0.9 -@item @kbd{s} @tab @code{#+begin_src ... #+end_src} -@item @kbd{e} @tab @code{#+begin_example ... #+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{l} @tab @code{#+begin_latex ... #+end_latex} -@item @kbd{L} @tab @code{#+latex:} -@item @kbd{h} @tab @code{#+begin_html ... #+end_html} -@item @kbd{H} @tab @code{#+html:} -@item @kbd{a} @tab @code{#+begin_ascii ... #+end_ascii} -@item @kbd{A} @tab @code{#+ascii:} -@item @kbd{i} @tab @code{#+index:} line -@item @kbd{I} @tab @code{#+include:} line +@item @kbd{s} @tab @code{#+BEGIN_SRC ... #+END_SRC} +@item @kbd{e} @tab @code{#+BEGIN_EXAMPLE ... #+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{l} @tab @code{#+BEGIN_LaTeX ... #+END_LaTeX} +@item @kbd{L} @tab @code{#+LaTeX:} +@item @kbd{h} @tab @code{#+BEGIN_HTML ... #+END_HTML} +@item @kbd{H} @tab @code{#+HTML:} +@item @kbd{a} @tab @code{#+BEGIN_ASCII ... #+END_ASCII} +@item @kbd{A} @tab @code{#+ASCII:} +@item @kbd{i} @tab @code{#+INDEX:} line +@item @kbd{I} @tab @code{#+INCLUDE:} line @end multitable For example, on an empty line, typing "<e" and then pressing TAB, will expand @@ -14464,7 +14745,7 @@ either by the @i{calc} interpreter, or by the @i{Emacs Lisp} interpreter. @cindex options, for customization @cindex variables, for customization -There are more than 180 variables that can be used to customize +There are more than 500 variables that can be used to customize Org. For the sake of compactness of the manual, I am not describing the variables here. A structured overview of customization variables is available with @kbd{M-x org-customize}. Or select @@ -14515,8 +14796,8 @@ Set tags that can be inherited by any entry in the file, including the top-level entries. @item #+DRAWERS: NAME1 ..... @vindex org-drawers -Set the file-local set of drawers. The corresponding global variable is -@code{org-drawers}. +Set the file-local set of additional drawers. The corresponding global +variable is @code{org-drawers}. @item #+LINK: linkword replace @vindex org-link-abbrev-alist These lines (several are allowed) specify link abbreviations. @@ -14727,7 +15008,7 @@ This line contains the formulas for the table directly above the line. @item #+TITLE:, #+AUTHOR:, #+EMAIL:, #+LANGUAGE:, #+TEXT:, #+DATE:, @itemx #+OPTIONS:, #+BIND:, #+XSLT:, @itemx #+DESCRIPTION:, #+KEYWORDS:, -@itemx #+LATEX_HEADER:, #+STYLE:, #+LINK_UP:, #+LINK_HOME:, +@itemx #+LaTeX_HEADER:, #+STYLE:, #+LINK_UP:, #+LINK_HOME:, @itemx #+EXPORT_SELECT_TAGS:, #+EXPORT_EXCLUDE_TAGS: These lines provide settings for exporting files. For more details see @ref{Export options}. @@ -15100,6 +15381,18 @@ Yes, these are unfortunately more difficult to remember. If you want to have other replacement keys, look at the variable @code{org-disputed-keys}. +@item @file{filladapt.el} by Kyle Jones +@cindex @file{filladapt.el} + +Org mode tries to do the right thing when filling paragraphs, list items and +other elements. Many users reported they had problems using both +@file{filladapt.el} and Org mode, so a safe thing to do is to disable it like +this: + +@lisp +(add-hook 'org-mode-hook 'turn-off-filladapt-mode) +@end lisp + @item @file{yasnippet.el} @cindex @file{yasnippet.el} The way Org mode binds the TAB key (binding to @code{[tab]} instead of @@ -15210,7 +15503,7 @@ This appendix covers some aspects where users can extend the functionality of Org. @menu -* Hooks:: Who to reach into Org's internals +* Hooks:: How to reach into Org's internals * Add-on packages:: Available extensions * Adding hyperlink types:: New custom link types * Context-sensitive commands:: How to add functionality to such commands @@ -15463,6 +15756,10 @@ calculation marks, that column is automatically discarded as well. Please note that the translator function sees the table @emph{after} the removal of these columns, the function never knows that there have been additional columns. + +@item :no-escape t +When non-nil, do not escape special characters @code{&%#_^} when exporting +the table. The default value is nil. @end table @noindent @@ -15862,9 +16159,10 @@ Skip current entry if the TODO keyword is TODO or WAITING. Skip current entry if the TODO keyword marks a DONE state. @item (org-agenda-skip-entry-if 'timestamp) Skip current entry if it has any timestamp, may also be deadline or scheduled. -@item (org-agenda-skip-entry 'regexp "regular expression") +@anchor{x-agenda-skip-entry-regexp} +@item (org-agenda-skip-entry-if 'regexp "regular expression") Skip current entry if the regular expression matches in the entry. -@item (org-agenda-skip-entry 'notregexp "regular expression") +@item (org-agenda-skip-entry-if 'notregexp "regular expression") Skip current entry unless the regular expression matches. @item (org-agenda-skip-subtree-if 'regexp "regular expression") Same as above, but check and skip the entire subtree. @@ -16003,6 +16301,7 @@ If WHICH is nil or `all', get all properties. If WHICH is `special' or `standard', only get that subclass. @end defun @vindex org-use-property-inheritance +@findex org-insert-property-drawer @defun org-entry-get pom property &optional inherit Get value of PROPERTY for entry at point-or-marker POM. By default, this only looks at properties defined locally in the entry. If INHERIT @@ -16025,7 +16324,7 @@ Get all property keys in the current buffer. @end defun @defun org-insert-property-drawer -Insert a property drawer at point. +Insert a property drawer for the current entry. Also @end defun @defun org-entry-put-multivalued-property pom property &rest values @@ -16178,13 +16477,16 @@ The following example counts the number of entries with TODO keyword @cindex iPhone @cindex MobileOrg -@uref{http://mobileorg.ncogni.to/, MobileOrg} is an application for the -@i{iPhone/iPod Touch} series of devices, developed by Richard Moreland. -@i{MobileOrg} offers offline viewing and capture support for an Org mode -system rooted on a ``real'' computer. It does also allow you to record -changes to existing entries. Android users should check out +@i{MobileOrg} is the name of the mobile companion app for Org mode, currently +available for iOS and for Android. @i{MobileOrg} offers offline viewing and +capture support for an Org mode system rooted on a ``real'' computer. It +does also allow you to record changes to existing entries. +The @uref{http://mobileorg.ncogni.to/, iOS implementation} for the +@i{iPhone/iPod Touch/iPad} series of devices, was developed by Richard +Moreland. Android users should check out @uref{http://wiki.github.com/matburt/mobileorg-android/, MobileOrg Android} -by Matt Jones. +by Matt Jones. The two implementations are not identical but offer similar +features. This appendix describes the support Org has for creating agenda views in a format that can be displayed by @i{MobileOrg}, and for integrating notes @@ -16254,8 +16556,8 @@ rely on outline paths, in the hope that these will be unique enough.}. Finally, Org writes the file @file{index.org}, containing links to all other files. @i{MobileOrg} first reads this file from the server, and then downloads all agendas and Org files listed in it. To speed up the download, -MobileOrg will only read files whose checksums@footnote{stored automatically -in the file @file{checksums.dat}} have changed. +MobileOrg will only read files whose checksums@footnote{Checksums are stored +automatically in the file @file{checksums.dat}} have changed. @node Pulling from MobileOrg, , Pushing to MobileOrg, MobileOrg @section Pulling from MobileOrg @@ -16316,6 +16618,8 @@ the current agenda files will be searched.} using @kbd{C-c a ?}. @cindex history @cindex thanks +@section From Carsten + Org was born in 2003, out of frustration over the user interface of the Emacs Outline mode. I was trying to organize my notes and projects, and using Emacs seemed to be the natural way to go. However, having to remember eleven @@ -16349,7 +16653,7 @@ Bastien has written a large number of extensions to Org (most of them integrated into the core by now), including the @LaTeX{} exporter and the plain list parser. His support during the early days, when he basically acted as co-maintainer, was central to the success of this project. Bastien also -invented Worg, helped establishing the Web presence of Org, and sponsors +invented Worg, helped establishing the Web presence of Org, and sponsored hosting costs for the orgmode.org website. @item Eric Schulte and Dan Davison Eric and Dan are jointly responsible for the Org-babel system, which turns @@ -16370,8 +16674,57 @@ webpages derived from Org using an Info-like or a folding interface with single-key navigation. @end table -@noindent OK, now to the full list of contributions! Again, please let me -know what I am missing here! +@noindent See below for the full list of contributions! Again, please +let me know what I am missing here! + +@section From Bastien + +I (Bastien) have been maintaining Org since January 2011. This appendix +would not be complete without adding a few more acknowledgements and thanks +to Carsten's ones above. + +I am first grateful to Carsten for his trust while handing me over the +maintainership of Org. His support as been great since day one of this new +adventure, and it helped a lot. + +When I took over maintainership, I knew I would have to make Org more +collaborative than ever, as I would have to rely on people that are more +knowledgeable than I am on many parts of the code. Here is a list of the +persons I could rely on, they should really be considered co-maintainers, +either of the code or the community: + +@table @i +@item Eric Schulte +Eric is maintaining the Babel parts of Org. His reactivity here kept me away +from worrying about possible bugs here and let me focus on other parts. + +@item Nicolas Goaziou +Nicolas is maintaining the consistency of the deepest parts of Org. His work +on @file{org-element.el} and @file{org-export.el} has been outstanding, and +opened the doors for many new ideas and features. + +@item Jambunathan K +Jambunathan contributed the ODT exporter, definitly a killer feature of +Org mode. He also contributed the new HTML exporter, which is another core +feature of Org. Here too, I knew I could rely on him to fix bugs in these +areas and to patiently explain the users what was the problems and solutions. + +@item Achim Gratz +Achim rewrote the building process of Org, turning some @emph{ad hoc} tools +into a flexible and conceptually clean process. He patiently coped with the +many hicups that such a change can create for users. + +@item Nick Dokos +The Org mode mailing list would not be such a nice place without Nick, who +patiently helped users so many times. It is impossible to overestimate such +a great help, and the list would not be so active without him. +@end table + +I received support from so many users that it is clearly impossible to be +fair when shortlisting a few of them -- but Org's history would not be +complete if the ones above were not mentioned in this manual. + +@section List of contributions @itemize @bullet @@ -16599,7 +16952,6 @@ work on a tty. @item @i{Piotr Zielinski} wrote @file{org-mouse.el}, proposed agenda blocks and contributed various ideas and code snippets. -@item @end itemize diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index a5b88d3f45..35aab7a0ee 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -5,267 +5,894 @@ See the end of the file for license conditions. Please send Org bug reports to emacs-orgmode@gnu.org. -* Incompatible changes - -** New keys for TODO sparse trees - :PROPERTIES: - :OrgVersion: 7.01 - :END: - - The key =C-c C-v= is now reserved for Org Babel action. TODO sparse - trees can still be made with =C-c / t= (all not-done states) and =C-c / - T= (specific states). - -** The Agenda =org-agenda-ndays= is now obsolete - :PROPERTIES: - :OrgVersion: 7.4 - :END: - - The variable =org-agenda-ndays= is obsolete - please use - =org-agenda-span= instead. - - Thanks to Julien Danjou for this. - -** Changes to the intended use of =org-export-latex-classes= - :PROPERTIES: - :OrgVersion: 6.35 - :END: - - So far this variable has been used to specify the complete header of the - LaTeX document, including all the =\usepackage= calls necessary for the - document. This setup makes it difficult to maintain the list of - packages that Org itself would like to call, for example for the special - symbol support it needs. - - First of all, you can *opt out of this change* in the following way: You - can say: /I want to have full control over headers, and I will take - responsibility to include the packages Org needs/. If that is what you - want, add this to your configuration and skip the rest of this section - (except maybe for the description of the =[EXTRA]= place holder): - - #+begin_src emacs-lisp - (setq org-export-latex-default-packages-alist nil - org-export-latex-packages-alist nil) - #+end_src - - /Continue to read here if you want to go along with the modified setup./ - - There are now two variables that should be used to list the LaTeX - packages that need to be included in all classes. The header definition - in =org-export-latex-classes= should then not contain the corresponding - =\usepackage= calls (see below). - - The two new variables are: - - 1. =org-export-latex-default-packages-alist= :: This is the variable - where Org-mode itself puts the packages it needs. Normally you - should not change this variable. The only reason to change it - anyway is when one of these packages causes a conflict with another - package you want to use. Then you can remove that packages and - hope that you are not using Org-mode functionality that needs it. - - 2. =org-export-latex-packages-alist= :: This is the variable where you - can put the packages that you'd like to use across all classes. - - The sequence how these customizations will show up in the LaTeX - document are: - - 1. Header from =org-export-latex-classes= - 2. =org-export-latex-default-packages-alist= - 3. =org-export-latex-packages-alist= - 4. Buffer-specific things set with =#+LaTeX_HEADER:= - - If you want more control about which segment is placed where, or if you - want, for a specific class, have full control over the header and - exclude some of the automatic building blocks, you can put the following - macro-like place holders into the header: - - #+begin_example - [DEFAULT-PACKAGES] \usepackage statements for default packages - [NO-DEFAULT-PACKAGES] do not include any of the default packages - [PACKAGES] \usepackage statements for packages - [NO-PACKAGES] do not include the packages - [EXTRA] the stuff from #+LaTeX_HEADER - [NO-EXTRA] do not include #+LaTeX_HEADER stuff - #+end_example - - If you have currently customized =org-export-latex-classes=, you should - revise that customization and remove any package calls that are covered - by =org-export-latex-default-packages-alist=. This applies to the - following packages: - - - inputenc - - fontenc - - fixltx2e - - graphicx - - longtable - - float - - wrapfig - - soul - - t1enc - - textcomp - - marvosym - - wasysym - - latexsym - - amssymb - - hyperref - - If one of these packages creates a conflict with another package you are - using, you can remove it from =org-export-latex-default-packages-alist=. - But then you risk that some of the advertised export features of Org - will not work properly. - - You can also consider moving packages that you use in all classes to - =org-export-latex-packages-alist=. If necessary, put the place holders - so that the packages get loaded in the right sequence. As said above, - for backward compatibility, if you omit the place holders, all the - variables will dump their content at the end of the header. - -** The constant =org-html-entities= is obsolete - :PROPERTIES: - :OrgVersion: 6.35 - :END: - - Its content is now part of the new constant =org-entities=, which is - defined in the file org-entities.el. =org-html-entities= was an internal - variable, but it is possible that some users did write code using it. - -** `org-bbdb-anniversary-format-alist' has changed - :PROPERTIES: - :OrgVersion: 7.5 - :END: - - Please check the docstring and update your settings accordingly. - -** Deleted =org-mode-p= - :PROPERTIES: - :OrgVersion: 7.8 - :END: - - This function has been deleted: please update your code. - -* Important new features - -** New Org to ODT exporter - :PROPERTIES: - :OrgVersion: 7.8 - :END: - - Jambunathan's Org to ODT exporter is now part of Org. - - To use it, it `C-c C-e o' in an Org file. See the documentation for more - information on how to customize it. - -** org-capture.el is now the default capture system - :PROPERTIES: - :OrgVersion: 7.01 - :END: - - This replaces the earlier system org-remember. The manual only describes - org-capture, but for people who prefer to continue to use org-remember, - we keep a static copy of the former manual section [[http://orgmode.org/org-remember.pdf][chapter about - remember]]. - - The new system has a technically cleaner implementation and more - possibilities for capturing different types of data. See [[http://thread.gmane.org/gmane.emacs.orgmode/26441/focus%3D26441][Carsten's - announcement]] for more details. - - To switch over to the new system: - - 1. Run - - : M-x org-capture-import-remember-templates RET - - to get a translated version of your remember templates into the - new variable =org-capture-templates=. This will "mostly" work, - but maybe not for all cases. At least it will give you a good - place to modify your templates. After running this command, - enter the customize buffer for this variable with - - : M-x customize-variable RET org-capture-templates RET +* Version 7.9.2 - and convince yourself that everything is OK. Then save the - customization. +** New ELPA repository for Org packages - 2. Bind the command =org-capture= to a key, similar to what you did - with org-remember: +You can now add the Org ELPA repository like this: - : (define-key global-map "\C-cc" 'org-capture) +#+BEGIN_SRC emacs-lisp +(add-to-list 'package-archives '("org" . "http://orgmode.org/elpa/") t) +#+END_SRC - If your fingers prefer =C-c r=, you can also use this key once - you have decided to move over completely to the new - implementation. During a test time, there is nothing wrong - with using both system in parallel. +It contains both the =org-*.tar= package (the core Org distribution, also +available through http://elpa.gnu.org) and the =org-plus*.tar= package (the +extended Org distribution, with non-GNU packages from the =contrib/= +directory.) -* New libraries +See http://orgmode.org/elpa/ -** New Org libraries -*** org-eshell.el (Konrad Hinsen) - :PROPERTIES: - :OrgVersion: 7.8 - :END: +** Overview of the new keybindings - Implement links to eshell buffers. + | Keybinding | Speedy | Command | + |-----------------+--------+-----------------------------| + | =C-c C-x C-z= | | [[doc::org-clock-resolve][org-clock-resolve]] | + | =C-c C-x C-q= | | [[doc::org-clock-cancel][org-clock-cancel]] | + | =C-c C-x C-x= | | [[doc::org-clock-in-last][org-clock-in-last]] | + | =M-h= | | [[doc::org-mark-element][org-mark-element]] | + | =*= | | [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] | + | =C-c C-M-l= | | [[doc::org-insert-all-links][org-insert-all-links]] | + | =C-c C-x C-M-v= | | [[doc::org-redisplay-inline-images][org-redisplay-inline-images]] | + | =C-c C-x E= | =E= | [[doc::org-inc-effort][org-inc-effort]] | + | | =#= | [[doc::org-toggle-comment][org-toggle-comment]] | + | | =:= | [[doc::org-columns][org-columns]] | + | | =W= | Set =APPT_WARNTIME= | + | =k= | | [[doc::org-agenda-capture][org-agenda-capture]] | + | C-c , | , | [[doc::org-priority][org-priority]] | -*** org-special-blocks (Carsten Dominik) - :PROPERTIES: - :OrgVersion: 7.8 - :END: +** New package and Babel langage -This package generalizes the #+begin_foo and #+end_foo tokens. +*** =org-eshell.el= by Konrad Hinsen is now in Org -To use, put the following in your init file: + =org-eshell.el= allows you to create links from [[http://www.gnu.org/software/emacs/manual/html_node/eshell/index.html][Eshell]]. -#+BEGIN_EXAMPLE +*** Support for execution of Scala code blocks (see ob-scala.el) +*** Support for execution of IO code blocks (see ob-io.el) + +** Incompatible changes + + - If your code relies on =org-write-agenda=, please use + [[doc::org-agenda-write][org-agenda-write]] from now on. + + - If your code relies on =org-make-link=, please use =concat= + instead. + + - =org-link-to-org-use-id= has been renamed to + =org-id-link-to-org-use-id= and its default value is nil. The + previous default was =create-if-interactive-and-no-custom-id=. + +** New features and user-visible changes + +*** Org Element + + =org-element.el= is a toolbox for parsing and analysing "elements" + in an Org-mode buffer. This has been written by Nicolas Goaziou + and has been tested for quite some time. It is now part of Org's + core and many core functions rely on this package. + + Two functions might be particularily handy for users: + =org-element-at-point= and =org-element-context=. + + See the docstrings for more details. + + Below is a list of editing and navigating commands that now rely + on =org-element.el=. + +**** [[doc::org-fill-paragraph][org-fill-paragraph]] has been completely rewritten + + The filling mechanisms now rely on org-element, trying to do the + right thing on each element in various contexts. E.g. filling in + a list item will preserve indentation; filling in message-mode + will fall back on the relevant filling functions; etc. + +**** [[doc::org-metaup][org-metaup]] and [[doc::org-metadown][org-metadown]] will drag the element backward/forward + + If you want to get the old behavior (i.e. moving a line up and + down), you can first select the line as an active region, then + =org-metaup= or =org-metadown= to move the region backward or + forward. This also works with regions bigger than just one line. + +**** [[doc::org-up-element][org-up-element]] and [[doc::org-down-element][org-down-element]] (respectively =C-c C-^= and =C-c C-_=) + + This will move the point up/down in the hierarchy of elements. + +**** [[doc::org-backward-element][org-backward-element]] and [[doc::org-forward-element][org-forward-element]] (respectively =M-{= and =M-}=) + + This will move the point backward/forward in the hierarchy of + elements. + +**** [[doc::org-narrow-to-element][org-narrow-to-element]] will narrow to the element at point +**** [[doc::org-mark-element][org-mark-element]] will mark the element at point + + This command is bound to =M-h= and will mark the element at + point. If the point is at a paragraph, it will mark the + paragraph. If the point is at a list item, it will mark the list + item. Etc. + + Note that if point is at the beginning of a list, it will mark + the whole list. + + To mark a subtree, you can either use =M-h= on the headline + (since there is no ambiguity about the element you're at) or + [[doc::org-mark-subtree][org-mark-subtree]] (=C-c @=) anywhere in the subtree. + + Invoking [[doc::org-mark-element][org-mark-element]] repeatedly will try to mark the next + element on top of the previous one(s). E.g. hitting =M-h= twice + on a headline will mark the current subtree and the next one on + the same level. + +*** Org Agenda + +**** New option [[doc::org-agenda-sticky][org-agenda-sticky]] + + There is a new option =org-agenda-sticky= which enables "sticky" + agendas. Sticky agendas remain opened in the background so that + you don't need to regenerate them each time you hit the + corresponding keystroke. This is a big time saver. + + When [[doc::org-agenda-sticky][org-agenda-sticky]] is =non-nil=, the agenda buffer will be + named using the agenda key and its description. In sticky + agendas, the =q= key will just bury the agenda buffers and + further agenda commands will show existing buffer instead of + generating new ones. + + If [[doc::org-agenda-sticky][org-agenda-sticky]] is set to =nil=, =q= will kill the single + agenda buffer. + +**** New option [[doc::org-agenda-custom-commands-contexts][org-agenda-custom-commands-contexts]] + + Setting this option allows you to define specific context where + agenda commands should be available from. For example, when set + to this value + + #+BEGIN_SRC emacs-lisp + (setq org-agenda-custom-commands-contexts + '(("p" (in-file . "\\.txt")))) +#+END_SRC + + then the =p= agenda command will only be available from buffers + visiting *.txt files. See the docstring and the manual for more + details on how to use this. + +**** Changes in bulk actions + + The set of commands starting with =k ...= as been deleted and the + features have been merged into the "bulk action" feature. + + After you marked some entries in the agenda, if you call =B s=, + the agenda entries will be rescheduled using the date at point if + on a date header. If you are on an entry with a timestamp, you + will be prompted for a date to reschedule your marked entries to, + using the timestamp at point as the default prompt. + + You can now use =k= to capture the marked entry and use the date + at point as an overriding date for the capture template. + + To bind this behavior to =M-x org-capture RET= (or its + keybinding), set the new option [[doc::org-capture-use-agenda-date][org-capture-use-agenda-date]] to + =t=. + +**** =N= and =P= in the agenda will move to the next/previous item + +**** New command [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] to mark all items + + This new command is bound to =*= in agenda mode. + + There is also a new option [[doc::org-agenda-bulk-mark-char][org-agenda-bulk-mark-char]] to set the + character to use as a mark for bulk actions. + +**** New option [[doc::org-agenda-persistent-marks][org-agenda-persistent-marks]] + + When set to =non-nil=, marks will remain visible after a bulk + action. You can temporarily toggle this by pressing =p= when + invoking [[doc::org-agenda-bulk-action][org-agenda-bulk-action]]. Marks are deleted if your + rebuild the agenda buffer or move to another date/span (e.g. with + =f= or =w=). + +**** New option [[doc::org-agenda-skip-timestamp-if-deadline-is-shown][org-agenda-skip-timestamp-if-deadline-is-shown]] + + =Non-nil= means skip timestamp line if same entry shows because + of deadline. + + In the agenda of today, an entry can show up multiple times + because it has both a plain timestamp and has a nearby deadline. + When this variable is t, then only the deadline is shown and the + fact that the entry has a timestamp for or including today is not + shown. When this variable is =nil=, the entry will be shown + several times. + +**** New =todo-unblocked= and =nottodo-unblocked= skip conditions + + See the [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3Df426da][git commit]] for more explanations. + +**** Allow category filtering in the agenda + + You can now filter the agenda by category. Pressing "<" will + filter by the category of the item on the current line, and + pressing "<" again will remove the filter. You can combine tag + filters and category filters. + + You can use =org-agenda-category-filter= in your custom agenda + views and =org-agenda-category-filter-preset= in your main + configuration. + + See also the new command [[doc::org-agenda-filter-by-top-category][org-agenda-filter-by-top-category]]: + hitting =^= will filter by "Top" category: only show entries that + are of the same category than the Top category of the entry at + point. + +*** Org Links + +**** Inserting links + + When inserting links through [[doc::org-insert-link][org-insert-link]], the description is + now displayed first, followed by the literal link, as the + description is often more useful when you look for the link you + want to insert. + + Completion now complete both literal links and description. If + you complete a description, the literal link and its description + will be inserted directly, whereas when you complete the literal + link, you will be prompted for a description (as with Org 7.8.) + + In the completion buffer, links to the current buffer are now + highlighted. + +**** New templates =%h= and =%(sexp)= for abbreviated links + + On top of =%s= template, which is replaced by the link tag in + abbreviated links, you can now use =%h= (which does the same than =%s= + but does not hexify the tag) and =%(sexp)= (which can run a function + that takes the tag as its own argument.) + +**** New link type =help= + + You can now create links from =help= buffers. + + For example, if you request help for the command [[doc::org-agenda][org-agenda]] with + =C-h f org-agenda RET=, creating a link from this buffer will let + you go back to the same buffer. + +**** New command [[doc::org-insert-all-links][org-insert-all-links]] + + This will insert all links as list items. With a universal + prefix argument, links will not be deleted from the variable + =org-stored-links=. + + This new command is bound to =C-c C-M-l=. + +**** New option [[doc::org-url-hexify-p][org-url-hexify-p]] + + When set to =nil=, the =URL= part of a link will not be hexified. + +**** Org can now open multiple shell links + +**** New option [[doc::org-doi-server-url][org-doi-server-url]] to specify an alternate DOI server + +**** RET now follows time stamps links + +*** Org Editing + +**** [[doc::org-todo][org-todo]] and =org-archive-*= can now loop in the active region + + When [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is =non-nil=, using + [[doc::org-todo][org-todo]] or =org-archive-*= commands in the active region will + loop over headlines. This is handy if you want to set the TODO + keyword for several items, or archive them quickly. + +**** You can now set tags for headlines in a region + + If [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is =non-nil=, then + selecting the region and hitting =C-c C-q= will set the tags for + all headlines in the region. + +**** New command [[doc::org-insert-drawer][org-insert-drawer]] to insert a drawer interactively + +**** Comments start with "^[ \t]*# " anywhere on a line + + Note that the space after the hashtag is mandatory. Comments + with "^#+" are not supported anymore. + +**** New speed key =#= to toggle the COMMENT cookie on a headline + +**** =indent-region-function= is now set to [[doc::org-indent-region][org-indent-region]] + + =C-M-\= should now produce useful results. + + You can unindent the buffer with [[doc::org-unindent-buffer][org-unindent-buffer]]. + +**** New option [[doc::org-allow-promoting-top-level-subtree][org-allow-promoting-top-level-subtree]] + + When =non-nil=, =S-M-<left>= will promote level-1 subtrees + containing other subtrees. The level-1 headline will be + commented out. You can revert to the previous state with =M-x + undo RET=. + +*** Org Clock + +**** New keybinding =C-c C-x C-z= for [[doc::org-clock-resolve][org-clock-resolve]] + +**** New keybinding =C-c C-x C-q= for [[doc::org-clock-cancel][org-clock-cancel]] + +**** New command [[doc::org-clock-in-last][org-clock-in-last]] to clock in the last clocked item + + This command is bound to =C-c C-x C-x= and will clock in the last + clocked entry, if any. + +**** =C-u M-x= [[doc::org-clock-out][org-clock-out]] =RET= now prompts for a state to switch to + +**** =S-M-<up/down>= on a clock timestamps adjusts the previous/next clock + +**** New option [[doc::org-clock-continuously][org-clock-continuously]] + + When set to =nil=, clocking in a task will first try to find the + last clocked out task and restart from when that task was clocked + out. + + You can temporarily activate continuous clocking with =C-u C-u + C-u M-x= [[doc::org-clock-in][org-clock-in]] =RET= (three universal prefix arguments) + and =C-u C-u M-x= [[org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix + arguments). + + +**** New option [[doc::org-clock-frame-title-format][org-clock-frame-title-format]] + + This option sets the value of =frame-title-format= when clocking + in. + +**** New options for controlling the clockreport display + + [[doc::org-clock-file-time-cell-format][org-clock-file-time-cell-format]]: Format string for the file time + cells in clockreport. + + [[doc::org-clock-total-time-cell-format][org-clock-total-time-cell-format]]: Format string for the total + time cells in clockreport. + + +**** New options for controlling the clock/timer display + + [[doc::org-clock-clocked-in-display][org-clock-clocked-in-display]]: control whether the current clock + is displayed in the mode line and/or frame title. + + [[doc::org-timer-display][org-timer-display]]: control whether the current timer is displayed + in the mode line and/or frame title. + + This allows the clock and timer to be displayed in the frame + title instead of, or as well as, the mode line. This is useful + for people with limited space in the mode line but with ample + space in the frame title. + +*** Org Appearance + +**** New option [[doc::org-custom-properties][org-custom-properties]] + + The visibility of properties listed in this options can be turn + on/off with [[doc::org-toggle-custom-properties-visibility][org-toggle-custom-properties-visibility]]. This might + be useful for properties used by third-part tools or that you + don't want to see temporarily. + +**** New command [[doc::org-redisplay-inline-images][org-redisplay-inline-images]] + + This will redisplay all images. It is bound to =C-c C-x C-M-v=. + +**** New entities in =org-entities.el= + + There are these new entities: + + : ("tilde" "\\~{}" nil "˜" "~" "~" "~") + : ("slash" "/" nil "/" "/" "/" "/") + : ("plus" "+" nil "+" "+" "+" "+") + : ("under" "\\_" nil "_" "_" "_" "_") + : ("equal" "=" nil "=" "=" "=" "=") + : ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^") + +**** New face =org-list-dt= for definition terms +**** New face =org-date-selected= for the selected calendar day +**** New face value for =org-document-title= + + The face is back to a normal height. + +*** Org Columns + +**** New speed command =:= to activate the column view +**** New special property =CLOCKSUM_T= to display today's clocked time + + You can use =CLOCKSUM_T= the same way you use =CLOCKSUM=. It + will display the time spent on tasks for today only. + +**** Use the =:COLUMNS:= property in columnview dynamic blocks + + If the =:COLUMNS:= is set in a subtree, the columnview dynamic + block will use its value as the column format. + +**** Consider inline tasks when computing a sum + +*** Org Dates and Time Stamps + +**** Enhanced [[doc::org-sparse-tree][org-sparse-tree]] + + =C-c /= can now check for time ranges. + + When checking for dates with =C-c /= it is useful to change the + type of dates that you are interested in. You can now do this + interactively with =c= after =C-c /= and/or by setting + [[doc::org-sparse-tree-default-date-type][org-sparse-tree-default-date-type]] to the default value you want. + +**** Support for hourly repeat cookies + + You can now use + + : SCHEDULED: <2012-08-20 lun. 08:00 +1h> + + if you want to add an hourly repeater to an entry. + +**** =C-u C-u C-c .= inserts a time-stamp with no prompt + +**** When (setq [[doc::org-read-date-prefer-future][org-read-date-prefer-future]] 'time), accept days in the prompt + + "8am Wed" and "Wed 8am" are now acceptable values when entering a + date from the prompt. If [[doc::org-read-date-prefer-future][org-read-date-prefer-future]] is set to + =time=, this will produce the expected prompt indication. + +**** New option [[doc::org-datetree-add-timestamp][org-datetree-add-timestamp]] + + When set to =non-nil=, datetree entries will also have a + timestamp. This is useful if you want to see these entries in a + sparse tree with =C-c /=. + +*** Org Capture + +**** New command [[doc::org-capture-string][org-capture-string]] + + M-x [[doc::org-capture-string][org-capture-string]] RET will prompt for a string and a capture + template. The string will be used as an annotation for the + template. This is useful when capturing in batch mode as it lets + you define the content of the template without being in Emacs. + +**** New option [[doc::org-capture-templates-contexts][org-capture-templates-contexts]] + + Setting this option allows you to define specific context where + capture templates should be available from. For example, when + set to this value + + #+BEGIN_SRC emacs-lisp + (setq org-capture-templates-contexts + '(("c" (in-mode . "message-mode")))) +#+END_SRC + + then the =c= capture template will only be available from + =message-mode= buffers. See the docstring and the manual for + more details on how to use this. + +**** New =%l= template to insert the literal link +**** New option [[doc::org-capture-bookmark][org-capture-bookmark]] + + Org used to automatically add a bookmark with capture a note. + You can now turn this on by setting [[doc::org-capture-bookmark][org-capture-bookmark]] to + =nil=. + +**** Expand =%<num>= escape sequences into text entered for <num>'th =%^{PROMPT}= escape + + See the manual for more explanations. + +**** More control over empty lines + + You can use =:empty-lines-before= and =:empty-lines-after= to + control the insertion of empty lines. Check the manual for more + explanations. + +**** New hook [[doc::org-capture-prepare-finalize-hook][org-capture-prepare-finalize-hook]] + + This new hook runs before the finalization process starts. + +*** Org Export + +**** New functions =orgtbl-to-table.el= and =orgtbl-to-unicode= + + =orgtbl-to-table.el= convert the table to a =table.el= table, and + =orgtbl-to-unicode= will use =ascii-art-to-unicode.el= (when + available) to print beautiful tables. + +**** [[doc::org-table-export][org-table-export]] now a bit clever about the target format + + When you specify a file name like =table.csv=, [[doc::org-table-export][org-table-export]] + will now suggest =orgtbl-to-csv= the default method for exporting + the table. + +**** New option [[doc::org-export-date-timestamp-format][org-export-date-timestamp-format]] + + The option allows to set a time string format for Org timestamps + in the #+DATE option. + +**** LaTeX: New options for exporting table rules :tstart, :hline and :tend + + See [[doc::org-export-latex-tables-hline][org-export-latex-tables-hline]] and [[doc::org-export-latex-tables-tend][org-export-latex-tables-tend]]. + +**** LaTeX: You can now set =:hfmt= from =#+ATTR_LaTeX= +**** Beamer: Add support and keybinding for the =exampleblock= environment + + Add support for these languages in [[doc::org-export-language-setup][org-export-language-setup]]. + More languages are always welcome. + +**** Beamer: New option [[doc::org-beamer-inherited-properties][org-beamer-inherited-properties]] + + This option allows Beamer export to inherit some properties. + Thanks to Carsten for implementing this. + +**** ODT: Add support for ODT export in org-bbdb.el +**** ODT: Add support for indented tables (see [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3De9fd33][this commit]] for details) +**** ODT: Improve the conversion from ODT to other formats +**** ASCII: Swap the level-1/level-2 characters to underline the headlines +**** Support for Chinese, simplified Chinese, Russian, Ukrainian and Japanese +**** HTML: New option [[doc::org-export-html-date-format-string][org-export-html-date-format-string]] + + Format string to format the date and time in HTML export. Thanks + to Sébastien Vauban for this patch. + +*** Org Babel + +**** New =:results drawer= parameter + +=:results drawer= replaces =:results wrap=, which is deprecated but still +supported. + +**** =:results org= now put results in a =#+BEGIN_SRC org= block + +=:results org= used to put results in a =#+BEGIN_ORG= block but it now puts +results in a =#+BEGIN_SRC org= block, wich comma-escaped lines. + +=#+BEGIN_ORG= blocks are obsolete. + +**** Exporting =#+BEGIN_SRC org= blocks exports the code + +It used to exports the results of the code. + +*** Miscellaneous + +**** New menu entry for [[doc::org-refile][org-refile]] +**** Allow capturing to encrypted entries + +If you capture to an encrypted entry, it will be decrpyted before +inserting the template then re-encrypted after finalizing the capture. + +**** Inactive timestamps are now handled in tables + +Calc can do computation on active time-stamps like <2012-09-29 sat.>. +Inactive time-stamps in a table's cell are now internally deactivated so +that Calc formulas can operate on them. + +**** [[doc::org-table-number-regexp][org-table-number-regexp]] can now accept comma as decimal mark +**** Org allows a new property =APPT_WARNTIME= + + You can set it with the =W= speedy key or set it manually. When + set, exporting to iCalendar and [[doc::org-agenda-to-appt][org-agenda-to-appt]] will use the + value of this property as the number of minutes for the warning + alarm. + +**** New command [[doc::org-inc-effort][org-inc-effort]] + + This will increment the effort value. + + It is bound to =C-c C-x E= and to =E= as a speedy command. + +**** Attach: Add support for creating symbolic links + + =org-attach-method= now supports a new method =lns=, allowing to + attach symbolic links. + +**** Archive: you can now archive to a datetree + +**** New option [[doc::org-inlinetask-show-first-star][org-inlinetask-show-first-star]] + + =Non-nil= means display the first star of an inline task as + additional marker. When =nil=, the first star is not shown. + +**** New option [[doc::org-latex-preview-ltxpng-directory][org-latex-preview-ltxpng-directory]] + + This lets you define the path for the =ltxpng/= directory. + +**** You can now use imagemagick instead of dvipng to preview LaTeX fragments +**** You can now turn off [[doc::orgstruct++-mode][orgstruct++-mode]] safely +**** =C-u C-c C-c= on list items to add check boxes + + =C-u C-c C-c= will add an empty check box on a list item. + + When hit from the top of the list, it will add check boxes for + all top level list items. + +**** =org-list-ending-method= and =org-list-end-regexp= are now obsolete + + Fall back on using =org-list-end-re= only, which see. + +**** org-feed.el now expands =%(sexp)= templates +**** New option [[doc::org-protocol-data-separator][org-protocol-data-separator]] + +**** New option [[doc::org-ditaa-jar-option][org-ditaa-jar-option]] to specify the ditaa jar file + +**** New possible value for [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] + + When [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is set to + =start-level=, the command will loop over the active region but + will only act upon entries that are of the same level than the + first headline in the region. + +**** New option [[doc::org-habit-show-all-today][org-habit-show-all-today]] + + When set to =t=, show all (even unscheduled) habits on today's + agenda. + +** Important bug fixes + +*** M-TAB on options keywords perform completion correctly again + + If you hit =M-TAB= on keywords like =#+TITLE=, Org will try to + perform completion with meaningful values. + +*** Add licenses to javascript embedded and external code snippets + + Embedded javascript code produced when exporting an Org file to + HTML is now licensed under GPLv3 (or later), and the copyright is + owned by the Free Software Foundation, Inc. + + The javascript code for embedding MathJax in the browser mentions + the MathJax copyright and the Apache 2.0 license. + + The javascript code for embedding =org-injo.js= in the browser + mentions the copyright of Sebastian Rose and the GPLv3 (or later) + license. + + =org-export-html-scripts= is now a variable, so that you can adapt + the code and the license to your needs. + + See http://www.gnu.org/philosophy/javascript-trap.html for + explanations on why these changes were necessary. + +* Version 7.8.11 + +** Incompatible changes + +*** Emacs 21 support has been dropped + + Do not use Org mode 7.xx with Emacs 21, use [[http://orgmode.org/org-6.36c.zip][version 6.36c]] instead. + +*** XEmacs support requires the XEmacs development version + + To use Org mode 7.xx with XEmacs, you need to run the developer + version of XEmacs. We were about to drop XEmacs support entirely, + but Michael Sperber stepped in and made changes to XEmacs that + made it easier to keep the support. Thanks to Michael for this + last-minute save. + +*** New keys for TODO sparse trees + + The key =C-c C-v= is now reserved for Org Babel action. TODO + sparse trees can still be made with =C-c / t= (all not-done + states) and =C-c / T= (specific states). + +*** The Agenda =org-agenda-ndays= is now obsolete + + The variable =org-agenda-ndays= is obsolete - please use + =org-agenda-span= instead. + + Thanks to Julien Danjou for this. + +*** Changes to the intended use of =org-export-latex-classes= + + So far this variable has been used to specify the complete header + of the LaTeX document, including all the =\usepackage= calls + necessary for the document. This setup makes it difficult to + maintain the list of packages that Org itself would like to call, + for example for the special symbol support it needs. + + First of all, you can *opt out of this change* in the following + way: You can say: /I want to have full control over headers, and I + will take responsibility to include the packages Org needs/. If + that is what you want, add this to your configuration and skip the + rest of this section (except maybe for the description of the + =[EXTRA]= place holder): + + #+begin_src emacs-lisp + (setq org-export-latex-default-packages-alist nil + org-export-latex-packages-alist nil) + #+end_src + + /Continue to read here if you want to go along with the modified + setup./ + + There are now two variables that should be used to list the LaTeX + packages that need to be included in all classes. The header + definition in =org-export-latex-classes= should then not contain + the corresponding =\usepackage= calls (see below). + + The two new variables are: + + 1. =org-export-latex-default-packages-alist= :: This is the + variable where Org-mode itself puts the packages it needs. + Normally you should not change this variable. The only + reason to change it anyway is when one of these packages + causes a conflict with another package you want to use. Then + you can remove that packages and hope that you are not using + Org-mode functionality that needs it. + + 2. =org-export-latex-packages-alist= :: This is the variable where + you can put the packages that you'd like to use across all + classes. + + The sequence how these customizations will show up in the LaTeX + document are: + + 1. Header from =org-export-latex-classes= + 2. =org-export-latex-default-packages-alist= + 3. =org-export-latex-packages-alist= + 4. Buffer-specific things set with =#+LaTeX_HEADER:= + + If you want more control about which segment is placed where, or + if you want, for a specific class, have full control over the + header and exclude some of the automatic building blocks, you can + put the following macro-like place holders into the header: + + #+begin_example + [DEFAULT-PACKAGES] \usepackage statements for default packages + [NO-DEFAULT-PACKAGES] do not include any of the default packages + [PACKAGES] \usepackage statements for packages + [NO-PACKAGES] do not include the packages + [EXTRA] the stuff from #+LaTeX_HEADER + [NO-EXTRA] do not include #+LaTeX_HEADER stuff + #+end_example + + If you have currently customized =org-export-latex-classes=, you + should revise that customization and remove any package calls that + are covered by =org-export-latex-default-packages-alist=. This + applies to the following packages: + + - inputenc + - fontenc + - fixltx2e + - graphicx + - longtable + - float + - wrapfig + - soul + - t1enc + - textcomp + - marvosym + - wasysym + - latexsym + - amssymb + - hyperref + + If one of these packages creates a conflict with another package + you are using, you can remove it from + =org-export-latex-default-packages-alist=. But then you risk that + some of the advertised export features of Org will not work + properly. + + You can also consider moving packages that you use in all classes + to =org-export-latex-packages-alist=. If necessary, put the place + holders so that the packages get loaded in the right sequence. As + said above, for backward compatibility, if you omit the place + holders, all the variables will dump their content at the end of + the header. + +*** The constant =org-html-entities= is obsolete + + Its content is now part of the new constant =org-entities=, which + is defined in the file org-entities.el. =org-html-entities= was + an internal variable, but it is possible that some users did write + code using it. + +*** =org-bbdb-anniversary-format-alist= has changed + + Please check the docstring and update your settings accordingly. + +*** Deleted =org-mode-p= + + This function has been deleted: please update your code. + +** Important new features + +*** New Org to ODT exporter + + Jambunathan's Org to ODT exporter is now part of Org. + + To use it, it `C-c C-e o' in an Org file. See the documentation + for more information on how to customize it. + +*** org-capture.el is now the default capture system + + This replaces the earlier system org-remember. The manual only + describes org-capture, but for people who prefer to continue to + use org-remember, we keep a static copy of the former manual + section [[http://orgmode.org/org-remember.pdf][chapter about remember]]. + + The new system has a technically cleaner implementation and more + possibilities for capturing different types of data. See + [[http://thread.gmane.org/gmane.emacs.orgmode/26441/focus%3D26441][Carsten's announcement]] for more details. + + To switch over to the new system: + + 1. Run + + : M-x org-capture-import-remember-templates RET + + to get a translated version of your remember templates into the + new variable =org-capture-templates=. This will "mostly" work, + but maybe not for all cases. At least it will give you a good + place to modify your templates. After running this command, + enter the customize buffer for this variable with + + : M-x customize-variable RET org-capture-templates RET + + and convince yourself that everything is OK. Then save the + customization. + + 2. Bind the command =org-capture= to a key, similar to what you did + with org-remember: + + : (define-key global-map "\C-cc" 'org-capture) + + If your fingers prefer =C-c r=, you can also use this key once + you have decided to move over completely to the new + implementation. During a test time, there is nothing wrong + with using both system in parallel. + +** New libraries + +*** New Org libraries +**** org-eshell.el (Konrad Hinsen) + + Implement links to eshell buffers. + +**** org-special-blocks (Carsten Dominik) + + This package generalizes the #+begin_foo and #+end_foo tokens. + + To use, put the following in your init file: + + #+BEGIN_EXAMPLE (require 'org-special-blocks) #+END_EXAMPLE -The tokens #+begin_center, #+begin_verse, etc. existed previously. This -package generalizes them (at least for the LaTeX and html exporters). When -a #+begin_foo token is encountered by the LaTeX exporter, it is expanded -into \begin{foo}. The text inside the environment is not protected, as -text inside environments generally is. When #+begin_foo is encountered by -the html exporter, a div with class foo is inserted into the HTML file. It -is up to the user to add this class to his or her stylesheet if this div is -to mean anything. + The tokens #+begin_center, #+begin_verse, etc. existed + previously. This package generalizes them (at least for the + LaTeX and html exporters). When a #+begin_foo token is + encountered by the LaTeX exporter, it is expanded + into \begin{foo}. The text inside the environment is not + protected, as text inside environments generally is. + When #+begin_foo is encountered by the html exporter, a div with + class foo is inserted into the HTML file. It is up to the user + to add this class to his or her stylesheet if this div is to mean + anything. -*** org-taskjuggler.el (Christian Egli) - :PROPERTIES: - :OrgVersion: 7.01 - :END: +**** org-taskjuggler.el (Christian Egli) - Christian Egli's /org-taskjuggler.el/ module is now part of Org. He - also wrote a [[http://orgmode.org/worg/org-tutorials/org-taskjuggler.php][tutorial]] for it. + Christian Egli's /org-taskjuggler.el/ module is now part of Org. + He also wrote a [[http://orgmode.org/worg/org-tutorials/org-taskjuggler.php][tutorial]] for it. -*** org-ctags.el (Paul Sexton) - :PROPERTIES: - :OrgVersion: 6.34 - :END: +**** org-ctags.el (Paul Sexton) - Targets like =<<my target>>= can now be found by Emacs' etag - functionality, and Org-mode links can be used to to link to etags, also - in non-Org-mode files. For details, see the file /org-ctags.el/. + Targets like =<<my target>>= can now be found by Emacs' etag + functionality, and Org-mode links can be used to to link to + etags, also in non-Org-mode files. For details, see the file + /org-ctags.el/. - This feature uses a new hook =org-open-link-functions= which will call - function to do something special with text links. + This feature uses a new hook =org-open-link-functions= which will + call function to do something special with text links. - Thanks to Paul Sexton for this contribution. + Thanks to Paul Sexton for this contribution. -*** org-docview.el (Jan Böcker) - :PROPERTIES: - :OrgVersion: 6.34 - :END: +**** org-docview.el (Jan Böcker) - This new module allows links to various file types using docview, where - Emacs displays images of document pages. Docview link types can point - to a specific page in a document, for example to page 131 of the - Org-mode manual: + This new module allows links to various file types using docview, where + Emacs displays images of document pages. Docview link types can point + to a specific page in a document, for example to page 131 of the + Org-mode manual: - : [[docview:~/.elisp/org/doc/org.pdf::131][Org-Mode Manual]] + : [[docview:~/.elisp/org/doc/org.pdf::131][Org-Mode Manual]] - Thanks to Jan Böcker for this contribution. + Thanks to Jan Böcker for this contribution. -** New Babel libraries +*** New Babel libraries - ob-picolisp.el (Thorsten Jolitz) - ob-fortran.el (Sergey Litvinov) @@ -275,674 +902,531 @@ to mean anything. - ob-lilypond.el (Martyn Jago) - ob-awk.el (Eric Schulte) -* Other new features and various enhancements +** Other new features and various enhancements -** Hyperlinks +*** Hyperlinks -*** Org-Bibtex -- major improvements - :PROPERTIES: - :OrgVersion: 7.6 - :END: +**** Org-Bibtex -- major improvements - Provides support for managing bibtex bibliographical references - data in headline properties. Each headline corresponds to a - single reference and the relevant bibliographic meta-data is - stored in headline properties, leaving the body of the headline - free to hold notes and comments. Org-bibtex is aware of all - standard bibtex reference types and fields. + Provides support for managing bibtex bibliographical references + data in headline properties. Each headline corresponds to a + single reference and the relevant bibliographic meta-data is + stored in headline properties, leaving the body of the headline + free to hold notes and comments. Org-bibtex is aware of all + standard bibtex reference types and fields. - The key new functions are + The key new functions are -- org-bibtex-check :: queries the user to flesh out all required - (and with prefix argument optional) bibtex fields available - for the specific reference =type= of the current headline. + - org-bibtex-check :: queries the user to flesh out all required + (and with prefix argument optional) bibtex fields available + for the specific reference =type= of the current headline. -- org-bibtex-create :: Create a new entry at the given level, - using org-bibtex-check to flesh out the relevant fields. + - org-bibtex-create :: Create a new entry at the given level, + using org-bibtex-check to flesh out the relevant fields. -- org-bibtex-yank :: Yank a bibtex entry on the kill ring as a - formatted Org-mode headline into the current buffer + - org-bibtex-yank :: Yank a bibtex entry on the kill ring as a + formatted Org-mode headline into the current buffer -- org-bibtex-export-to-kill-ring :: Export the current headline - to the kill ring as a formatted bibtex entry. + - org-bibtex-export-to-kill-ring :: Export the current headline + to the kill ring as a formatted bibtex entry. +**** org-gnus.el now allows link creation from messages + You can now create links from messages. This is particularily + useful when the user wants to stored messages that he sends, for + later check. Thanks to Ulf Stegemann for the patch. -*** org-gnus.el now allows link creation from messages - :PROPERTIES: - :OrgVersion: 7.5 - :END: +**** Modified link escaping - You can now create links from messages. This is particularly - useful when the user wants to stored messages that he sends, for - later check. Thanks to Ulf Stegemann for the patch. + David Maus worked on `org-link-escape'. See [[http://article.gmane.org/gmane.emacs.orgmode/37888][his message]]: + : Percent escaping is used in Org mode to escape certain characters + : in links that would either break the parser (e.g. square brackets + : in link target oder description) or are not allowed to appear in + : a particular link type (e.g. non-ascii characters in a http: + : link). + : + : With this change in place Org will apply percent escaping and + : unescaping more consistently especially for non-ascii characters. + : Additionally some of the outstanding bugs or glitches concerning + : percent escaped links are solved. + Thanks a lot to David for this work. -*** Modified link escaping - :PROPERTIES: - :OrgVersion: 7.5 - :END: +**** Make =org-store-link= point to directory in a dired buffer - David Maus worked on `org-link-escape'. See [[http://article.gmane.org/gmane.emacs.orgmode/37888][his message]]: + When, in a dired buffer, the cursor is not in a line listing a + file, `org-store-link' will store a link to the directory. -: Percent escaping is used in Org mode to escape certain characters -: in links that would either break the parser (e.g. square brackets -: in link target or description) or are not allowed to appear in -: a particular link type (e.g. non-ascii characters in a http: -: link). -: -: With this change in place Org will apply percent escaping and -: unescaping more consistently especially for non-ascii characters. -: Additionally some of the outstanding bugs or glitches concerning -: percent escaped links are solved. + Patch by Stephen Eglen. - Thanks a lot to David for this work. +**** Allow regexps in =org-file-apps= to capture link parameters + The way extension regexps in =org-file-apps= are handled has + changed. Instead of matching against the file name, the regexps + are now matched against the whole link, and you can use grouping + to extract link parameters which you can then use in a command + string to be executed. + For example, to allow linking to PDF files using the syntax + =file:/doc.pdf::<page number>=, you can add the following entry + to org-file-apps: -*** Make =org-store-link= point to directory in a dired buffer - :PROPERTIES: - :OrgVersion: 6.35 - :END: + #+begin_example + Extension: \.pdf::\([0-9]+\)\' + Command: evince "%s" -p %1 + #+end_example - When, in a dired buffer, the cursor is not in a line listing a - file, `org-store-link' will store a link to the directory. + Thanks to Jan Böcker for a patch to this effect. - Patch by Stephen Eglen. +*** Dates and time +**** Allow relative time when scheduling/adding a deadline + You can now use relative duration strings like "-2d" or "++3w" + when calling =org-schedule= or =org-deadline=: it will schedule + (or set the deadline for) the item respectively two days before + today and three weeks after the current timestamp, if any. -*** Allow regexps in =org-file-apps= to capture link parameters - :PROPERTIES: - :OrgVersion: 6.35 - :END: + You can use this programmatically: =(org-schedule nil "+2d")= + will work on the current entry. - The way extension regexps in =org-file-apps= are handled has - changed. Instead of matching against the file name, the regexps - are now matched against the whole link, and you can use grouping - to extract link parameters which you can then use in a command - string to be executed. + You can also use this while (bulk-)rescheduling and + (bulk-)resetting the deadline of (several) items from the agenda. - For example, to allow linking to PDF files using the syntax - =file:/doc.pdf::<page number>=, you can add the following entry to - org-file-apps: + Thanks to Memnon Anon for a heads up about this! - #+begin_example - Extension: \.pdf::\([0-9]+\)\' - Command: evince "%s" -p %1 - #+end_example +**** American-style dates are now understood by =org-read-date= - Thanks to Jan Böcker for a patch to this effect. + So when you are prompted for a date, you can now answer like this -** Dates and time + #+begin_example + 2/5/3 --> 2003-02-05 + 2/5 --> <CURRENT-YEAR>-02-05 + #+end_example -*** Allow relative time when scheduling/adding a deadline - :PROPERTIES: - :OrgVersion: 7.7 - :END: +*** Agenda - You can now use relative duration strings like "-2d" or "++3w" - when calling =org-schedule= or =org-deadline=: it will schedule - (or set the deadline for) the item respectively two days before - today and three weeks after the current timestamp, if any. +**** =org-agenda-custom-commands= has a default value - You can use this programmatically: =(org-schedule nil "+2d")= - will work on the current entry. + This option used to be `nil' by default. This now has a default + value, displaying an agenda and all TODOs. See the docstring for + details. Thanks to Carsten for this. - You can also use this while (bulk-)rescheduling and - (bulk-)resetting the deadline of (several) items from the agenda. +**** Improved filtering through =org-agenda-to-appt= - Thanks to Memnon Anon for a heads up about this! + The new function allows the user to refine the scope of entries + to pass to =org-agenda-get-day-entries= and allows to filter out + entries using a function. + Thanks to Peter Münster for raising a related issue and to + Tassilo Horn for this idea. Also thanks to Peter Münster for + [[git:68ffb7a7][fixing a small bug]] in the final implementation. +**** Allow ap/pm times in agenda time grid + Times in the agenda can now be displayed in am/pm format. See + the new variable =org-agenda-timegrid-use-ampm=. Thanks to + C. A. Webber for a patch to this effect. -*** American-style dates are now understood by =org-read-date= - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Agenda: Added a bulk "scattering" command - So when you are prompted for a date, you can now answer like this + =B S= in the agenda buffer will cause tasks to be rescheduled a + random number of days into the future, with 7 as the default. + This is useful if you've got a ton of tasks scheduled for today, + you realize you'll never deal with them all, and you just want + them to be distributed across the next N days. When called with + a prefix arg, rescheduling will avoid weekend days. - #+begin_example - 2/5/3 --> 2003-02-05 - 2/5 --> <CURRENT-YEAR>-02-05 - #+end_example + Thanks to John Wiegley for this. -** Agenda +*** Exporting -*** =org-agenda-custom-commands= has a default value - :PROPERTIES: - :OrgVersion: 7.8 - :END: +**** Simplification of org-export-html-preamble/postamble - This option used to be `nil' by default. This now has a default - value, displaying an agenda and all TODOs. See the docstring for - details. Thanks to Carsten for this. + When set to `t', export the preamble/postamble as usual, honoring + the =org-export-email/author/creator-info= variables. + When set to a formatting string, insert this string. See the + docstring of these variable for details about available + %-sequences. -*** Improved filtering through =org-agenda-to-appt= - :PROPERTIES: - :OrgVersion: 7.8 - :END: + You can set =:html-preamble= in publishing project in the same + way: `t' means to honor =:email/creator/author-info=, and a + formatting string will insert a string. - The new function allows the user to refine the scope of entries - to pass to =org-agenda-get-day-entries= and allows to filter out - entries using a function. +**** New exporters to Latin-1 and UTF-8 - Thanks to Peter Münster for raising a related issue and to - Tassilo Horn for this idea. Also thanks to Peter Münster for - [[git:68ffb7a7][fixing a small bug]] in the final implementation. + While Ulf Stegemann was going through the entities list to + improve the LaTeX export, he had the great idea to provide + representations for many of the entities in Latin-1, and for all + of them in UTF-8. This means that we can now export files rich + in special symbols to Latin-1 and to UTF-8 files. These new + exporters can be reached with the commands =C-c C-e n= and =C-c + C-e u=, respectively. + When there is no representation for a given symbol in the + targeted coding system, you can choose to keep the TeX-macro-like + representation, or to get an "explanatory" representation. For + example, =\simeq= could be represented as "[approx. equal to]". + Please use the variable =org-entities-ascii-explanatory= to state + your preference. +**** HTML export: Add class to outline containers using property -*** Allow ap/pm times in agenda time grid - :PROPERTIES: - :OrgVersion: 7.4 - :END: + The =HTML_CONTAINER_CLASS= property can now be used to add a + class name to the outline container of a node in HTML export. - Times in the agenda can now be displayed in am/pm format. See the new - variable =org-agenda-timegrid-use-ampm=. Thanks to C. A. Webber for - a patch to this effect. +**** Throw an error when creating an image from a LaTeX snippet fails + This behavior can be configured with the new option variable + =org-format-latex-signal-error=. +**** Support for creating BEAMER presentations from Org-mode documents -*** Agenda: Added a bulk "scattering" command - :PROPERTIES: - :OrgVersion: 7.4 - :END: + Org-mode documents or subtrees can now be converted directly in + to BEAMER presentation. Turning a tree into a simple + presentations is straight forward, and there is also quite some + support to make richer presentations as well. See the [[http://orgmode.org/manual/Beamer-class-export.html#Beamer-class-export][BEAMER + section]] in the manual for more details. - =B S= in the agenda buffer will cause tasks to be rescheduled a random - number of days into the future, with 7 as the default. This is useful - if you've got a ton of tasks scheduled for today, you realize you'll - never deal with them all, and you just want them to be distributed - across the next N days. When called with a prefix arg, rescheduling - will avoid weekend days. + Thanks to everyone who has contributed to the discussion about + BEAMER support and how it should work. This was a great example + for how this community can achieve a much better result than any + individual could. - Thanks to John Wiegley for this. +*** Refiling -** Exporting +**** Refile targets can now be cached -*** Simplification of org-export-html-preamble/postamble - :PROPERTIES: - :OrgVersion: 7.5 - :END: + You can turn on caching of refile targets by setting the variable + =org-refile-use-cache=. This should speed up refiling if you + have many eligible targets in many files. If you need to update + the cache because Org misses a newly created entry or still + offers a deleted one, press =C-0 C-c C-w=. - When set to `t', export the preamble/postamble as usual, honoring the - =org-export-email/author/creator-info= variables. +**** New logging support for refiling - When set to a formatting string, insert this string. See the docstring - of these variable for details about available %-sequences. + Whenever you refile an item, a time stamp and even a note can be + added to this entry. For details, see the new option + =org-log-refile=. - You can set =:html-preamble= in publishing project in the same way: `t' - means to honor =:email/creator/author-info=, and a formatting string - will insert a string. + Thanks to Charles Cave for this idea. -*** New exporters to Latin-1 and UTF-8 - :PROPERTIES: - :OrgVersion: 6.35 - :END: +*** Completion - While Ulf Stegemann was going through the entities list to improve the - LaTeX export, he had the great idea to provide representations for many - of the entities in Latin-1, and for all of them in UTF-8. This means - that we can now export files rich in special symbols to Latin-1 and to - UTF-8 files. These new exporters can be reached with the commands =C-c - C-e n= and =C-c C-e u=, respectively. +**** In-buffer completion is now done using John Wiegleys pcomplete.el - When there is no representation for a given symbol in the targeted - coding system, you can choose to keep the TeX-macro-like - representation, or to get an "explanatory" representation. For - example, =\simeq= could be represented as "[approx. equal to]". Please - use the variable =org-entities-ascii-explanatory= to state your - preference. + Thanks to John Wiegley for much of this code. -*** HTML export: Add class to outline containers using property - :PROPERTIES: - :OrgVersion: 6.35 - :END: +*** Tables - The =HTML_CONTAINER_CLASS= property can now be used to add a class name - to the outline container of a node in HTML export. +**** New command =org-table-transpose-table-at-point= -*** Throw an error when creating an image from a LaTeX snippet fails - :PROPERTIES: - :OrgVersion: 6.35 - :END: + See the docstring. This hack from Juan Pechiar is now part of + Org's core. Thanks to Juan! - This behavior can be configured with the new option variable - =org-format-latex-signal-error=. +**** Display field's coordinates when editing it with =C-c `= -*** Support for creating BEAMER presentations from Org-mode documents - :PROPERTIES: - :OrgVersion: 6.34 - :END: + When editing a field with =C-c `=, the field's coordinate will + the displayed in the buffer. - Org-mode documents or subtrees can now be converted directly in to - BEAMER presentation. Turning a tree into a simple presentations is - straight forward, and there is also quite some support to make richer - presentations as well. See the [[http://orgmode.org/manual/Beamer-class-export.html#Beamer-class-export][BEAMER section]] in the manual for more - details. + Thanks to Michael Brand for a patch to this effect. - Thanks to everyone who has contributed to the discussion about BEAMER - support and how it should work. This was a great example for how this - community can achieve a much better result than any individual could. +**** Spreadsheet computation of durations and time values -** Refiling + If you want to compute time values use the =T= flag, either in + Calc formulas or Elisp formulas: -*** Refile targets can now be cached - :PROPERTIES: - :OrgVersion: 7.01 - :END: + | Task 1 | Task 2 | Total | + |--------+--------+---------| + | 35:00 | 35:00 | 1:10:00 | + #+TBLFM: @2$3=$1+$2;T - You can turn on caching of refile targets by setting the variable - =org-refile-use-cache=. This should speed up refiling if you have many - eligible targets in many files. If you need to update the cache - because Org misses a newly created entry or still offers a deleted one, - press =C-0 C-c C-w=. + Values must be of the form =[HH:]MM:SS=, where hours are + optional. -*** New logging support for refiling - :PROPERTIES: - :OrgVersion: 6.35 - :END: + Thanks to Martin Halder, Eric Schulte and Carsten for code and + feedback on this. - Whenever you refile an item, a time stamp and even a note can be added - to this entry. For details, see the new option =org-log-refile=. +**** Implement formulas applying to field ranges - Thanks to Charles Cave for this idea. + Carsten implemented this field-ranges formulas. -** Completion + : A frequently requested feature for tables has been to be able to define + : row formulas in a way similar to column formulas. The patch below allows + : things like + : + : @3= + : @2$2..@5$7= + : @I$2..@II$4= + : + : as the left hand side for table formulas in order to write a formula that + : is valid for an entire column or for a rectangular section in a + : table. -*** In-buffer completion is now done using John Wiegley's pcomplete.el - :PROPERTIES: - :OrgVersion: 7.4 - :END: + Thanks a lot to Carsten for this. - Thanks to John Wiegley for much of this code. +**** Sending radio tables from org buffers is now allowed -** Tables + Org radio tables can no also be sent inside Org buffers. Also, + there is a new hook which get called after a table has been sent. -*** New command =org-table-transpose-table-at-point= - :PROPERTIES: - :OrgVersion: 7.8 - :END: + Thanks to Seweryn Kokot. - See the docstring. This hack from Juan Pechiar is now part of Org's - core. Thanks to Juan! +*** Lists -*** Display field's coordinates when editing it with =C-c `= - :PROPERTIES: - :OrgVersion: 7.7 - :END: +**** Improved handling of lists - When editing a field with =C-c `=, the field's coordinate will the - displayed in the buffer. + Nicolas Goaziou extended and improved the way Org handles lists. - Thanks to Michael Brand for a patch to this effect. + 1. Indentation of text determines again end of items in + lists. So, some text less indented than the previous item + doesn't close the whole list anymore, only all items more + indented than it. -*** Spreadsheet computation of durations and time values - :PROPERTIES: - :OrgVersion: 7.6 - :END: + 2. Alphabetical bullets are implemented, through the use of the + variable `org-alphabetical-lists'. This also adds alphabetical + counters like [@c] or [@W]. - If you want to compute time values use the =T= flag, either in Calc - formulas or Elisp formulas: + 3. Lists can now safely contain drawers, inline tasks, or various + blocks, themselves containing lists. Two variables are + controlling this: `org-list-forbidden-blocks', and + `org-list-export-context'. - | Task 1 | Task 2 | Total | - |--------+--------+---------| - | 35:00 | 35:00 | 1:10:00 | - #+TBLFM: @2$3=$1+$2;T + 4. Improve `newline-and-indent' (C-j): used in an item, it will + keep text from moving at column 0. This allows to split text + and make paragraphs and still not break the list. - Values must be of the form =[HH:]MM:SS=, where hours are optional. + 5. Improve `org-toggle-item' (C-c -): used on a region with + standard text, it will change the region into one item. With a + prefix argument, it will fallback to the previous behavior and + make every line in region an item. It permits to easily + integrate paragraphs inside a list. - Thanks to Martin Halder, Eric Schulte and Carsten for code and feedback - on this. + 6. `fill-paragraph' (M-q) now understands lists. It can freely be + used inside items, or on text just after a list, even with no + blank line around, without breaking list structure. -*** Implement formulas applying to field ranges - :PROPERTIES: - :OrgVersion: 7.5 - :END: + Thanks a lot to Nicolas for all this! - Carsten implemented this field-ranges formulas. +*** Inline display of linked images - : A frequently requested feature for tables has been to be able to define - : row formulas in a way similar to column formulas. The patch below allows - : things like - : - : @3= - : @2$2..@5$7= - : @I$2..@II$4= - : - : as the left hand side for table formulas in order to write a formula that - : is valid for an entire column or for a rectangular section in a - : table. + Images can now be displayed inline. The key C-c C-x C-v does + toggle the display of such images. Note that only image links + that have no description part will be inlined. - Thanks a lot to Carsten for this. +*** Implement offsets for ordered lists -*** Sending radio tables from org buffers is now allowed - :PROPERTIES: - :OrgVersion: 7.4 - :END: + If you want to start an ordered plain list with a number different + from 1, you can now do it like this: - Org radio tables can no also be sent inside Org buffers. Also, there - is a new hook which get called after a table has been sent. + : 1. [@start:12] will star a lit a number 12 - Thanks to Seweryn Kokot. +*** Babel: code block body expansion for table and preview -** Lists + In org-babel, code is "expanded" prior to evaluation. I.e. the + code that is actually evaluated comprises the code block contents, + augmented with the extra code which assigns the referenced data to + variables. It is now possible to preview expanded contents, and + also to expand code during during tangling. This expansion takes + into account all header arguments, and variables. -*** Improved handling of lists - :PROPERTIES: - :OrgVersion: 7.5 - :END: + A new keybinding `C-c M-b p' bound to `org-babel-expand-src-block' + can be used from inside of a source code block to preview its + expanded contents (which can be very useful for debugging). + tangling - Nicolas Goaziou extended and improved the way Org handles lists. + The expanded body can now be tangled, this includes variable + values which may be the results of other source-code blocks, or + stored in headline properties or tables. One possible use for this + is to allow those using org-babel for their emacs initialization + to store values (e.g. usernames, passwords, etc...) in headline + properties or in tables. - 1. Indentation of text determines again end of items in lists. So, some - text less indented than the previous item doesn't close the whole - list anymore, only all items more indented than it. + Org-babel now supports three new header arguments, and new default + behavior for handling horizontal lines in tables (hlines), column + names, and rownames across all languages. - 2. Alphabetical bullets are implemented, through the use of the - variable `org-alphabetical-lists'. This also adds alphabetical - counters like [@c] or [@W]. +*** Editing Convenience and Appearance - 3. Lists can now safely contain drawers, inline tasks, or various - blocks, themselves containing lists. Two variables are controlling - this: `org-list-forbidden-blocks', and `org-list-export-context'. +**** New command =org-copy-visible= (=C-c C-x v=) - 4. Improve `newline-and-indent' (C-j): used in an item, it will keep - text from moving at column 0. This allows to split text and make - paragraphs and still not break the list. + This command will copy the visible text in the region into the + kill ring. Thanks to Florian Beck for this function and to + Carsten for adding it to org.el and documenting it! - 5. Improve `org-toggle-item' (C-c -): used on a region with standard - text, it will change the region into one item. With a prefix - argument, it will fallback to the previous behavior and make every - line in region an item. It permits to easily integrate paragraphs - inside a list. +**** Make it possible to protect hidden subtrees from being killed by =C-k= - 6. `fill-paragraph' (M-q) now understands lists. It can freely be used - inside items, or on text just after a list, even with no blank line - around, without breaking list structure. + See the new variable =org-ctrl-k-protect-subtree=. This was a + request by Scott Otterson. - Thanks a lot to Nicolas for all this! +**** Implement pretty display of entities, sub-, and superscripts. -** Inline display of linked images - :PROPERTIES: - :OrgVersion: 6.36 - :END: - - Images can now be displayed inline. The key C-c C-x C-v does toggle the - display of such images. Note that only image links that have no - description part will be inlined. + The command =C-c C-x \= toggles the display of Org's special + entities like =\alpha= as pretty unicode characters. Also, sub + and superscripts are displayed in a pretty way (raised/lower + display, in a smaller font). If you want to exclude sub- and + superscripts, see the variable + =org-pretty-entities-include-sub-superscripts=. -** Implement offsets for ordered lists - :PROPERTIES: - :OrgVersion: 6.36 - :END: - - If you want to start an ordered plain list with a number different from - 1, you can now do it like this: - - : 1. [@start:12] will star a lit a number 12 + Thanks to Eric Schulte and Ulf Stegeman for making this possible. -** Babel: code block body expansion for table and preview - :PROPERTIES: - :OrgVersion: 6.36 - :END: - - In org-babel, code is "expanded" prior to evaluation. I.e. the code that - is actually evaluated comprises the code block contents, augmented with - the extra code which assigns the referenced data to variables. It is now - possible to preview expanded contents, and also to expand code during - during tangling. This expansion takes into account all header arguments, - and variables. - - A new key-binding `C-c M-b p' bound to `org-babel-expand-src-block' can - be used from inside of a source code block to preview its expanded - contents (which can be very useful for debugging). tangling - - The expanded body can now be tangled, this includes variable values - which may be the results of other source-code blocks, or stored in - headline properties or tables. One possible use for this is to allow - those using org-babel for their emacs initialization to store values - (e.g. usernames, passwords, etc...) in headline properties or in tables. - - Org-babel now supports three new header arguments, and new default - behavior for handling horizontal lines in tables (hlines), column names, - and rownames across all languages. - -** Editing Convenience and Appearance +**** New faces for title, date, author and email address lines -*** New command =org-copy-visible= (=C-c C-x v=) - :PROPERTIES: - :OrgVersion: 7.7 - :END: + The keywords in these lines are now dimmed out, and the title is + displayed in a larger font, and a special font is also used for + author, date, and email information. This is implemented by the + following new faces: - This command will copy the visible text in the region into the kill - ring. Thanks to Florian Beck for this function and to Carsten for - adding it to org.el and documenting it! + =org-document-title= + =org-document-info= + =org-document-info-keyword= -*** Make it possible to protect hidden subtrees from being killed by =C-k= - :PROPERTIES: - :OrgVersion: 7.01 - :END: + In addition, the variable =org-hidden-keywords= can be used to + make the corresponding keywords disappear. - See the new variable =org-ctrl-k-protect-subtree=. This was a request - by Scott Otterson. + Thanks to Dan Davison for this feature. -*** Implement pretty display of entities, sub-, and superscripts. - :PROPERTIES: - :OrgVersion: 7.01 - :END: +**** Simpler way to specify faces for tags and todo keywords - The command =C-c C-x \= toggles the display of Org's special entities - like =\alpha= as pretty unicode characters. Also, sub and superscripts - are displayed in a pretty way (raised/lower display, in a smaller - font). If you want to exclude sub- and superscripts, see the variable - =org-pretty-entities-include-sub-superscripts=. - - Thanks to Eric Schulte and Ulf Stegeman for making this possible. - -*** New faces for title, date, author and email address lines - :PROPERTIES: - :OrgVersion: 6.35 - :END: - - The keywords in these lines are now dimmed out, and the title is - displayed in a larger font, and a special font is also used for author, - date, and email information. This is implemented by the following new - faces: - - =org-document-title= - =org-document-info= - =org-document-info-keyword= - - In addition, the variable =org-hidden-keywords= can be used to make the - corresponding keywords disappear. + The variables =org-todo-keyword-faces=, =org-tag-faces=, and + =org-priority-faces= now accept simple color names as + specifications. The colors will be used as either foreground or + background color for the corresponding keyword. See also the + variable =org-faces-easy-properties=, which governs which face + property is affected by this setting. - Thanks to Dan Davison for this feature. - -*** Simpler way to specify faces for tags and todo keywords - :PROPERTIES: - :OrgVersion: 6.35 - :END: - - The variables =org-todo-keyword-faces=, =org-tag-faces=, and - =org-priority-faces= now accept simple color names as specifications. - The colors will be used as either foreground or background color for - the corresponding keyword. See also the variable - =org-faces-easy-properties=, which governs which face property is - affected by this setting. + This is really a great simplification for setting keyword faces. + The change is based on an idea and patch by Ryan Thompson. - This is really a great simplification for setting keyword faces. The - change is based on an idea and patch by Ryan Thompson. - -*** <N> in tables now means fixed width, not maximum width - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** <N> in tables now means fixed width, not maximum width - Requested by Michael Brand. + Requested by Michael Brand. -*** Better level cycling function - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Better level cycling function - =TAB= in an empty headline cycles the level of that headline through - likely states. Ryan Thompson implemented an improved version of this - function, which does not depend upon when exactly this command is used. - Thanks to Ryan for this improvement. + =TAB= in an empty headline cycles the level of that headline + through likely states. Ryan Thompson implemented an improved + version of this function, which does not depend upon when exactly + this command is used. Thanks to Ryan for this improvement. -*** Adaptive filling - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Adaptive filling - For paragraph text, =org-adaptive-fill-function= did not handle the - base case of regular text which needed to be filled. This is now - fixed. Among other things, it allows email-style ">" comments to be - filled correctly. + For paragraph text, =org-adaptive-fill-function= did not handle + the base case of regular text which needed to be filled. This is + now fixed. Among other things, it allows email-style ">" + comments to be filled correctly. - Thanks to Dan Hackney for this patch. + Thanks to Dan Hackney for this patch. -*** `org-reveal' (=C-c C-r=) also decrypts encrypted entries (org-crypt.el) - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** `org-reveal' (=C-c C-r=) also decrypts encrypted entries (org-crypt.el) - Thanks to Richard Riley for triggering this change. + Thanks to Richard Riley for triggering this change. -*** Better automatic letter selection for TODO keywords - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Better automatic letter selection for TODO keywords - When all first letters of keywords have been used, Org now assigns more - meaningful characters based on the keywords. + When all first letters of keywords have been used, Org now + assigns more meaningful characters based on the keywords. - Thanks to Mikael Fornius for this patch. + Thanks to Mikael Fornius for this patch. -** Clocking +*** Clocking -*** Clock: Allow synchronous update of timestamps in CLOCK log - :PROPERTIES: - :OrgVersion: 7.7 - :END: +**** Clock: Allow synchronous update of timestamps in CLOCK log - Using =S-M-<up/down>= on CLOCK log timestamps will increase/decrease - the two timestamps on this line so that duration will keep the same. - Note that duration can still be slightly modified in case a timestamp - needs some rounding. + Using =S-M-<up/down>= on CLOCK log timestamps will + increase/decrease the two timestamps on this line so that + duration will keep the same. Note that duration can still be + slightly modified in case a timestamp needs some rounding. - Thanks to Rainer Stengele for this idea. + Thanks to Rainer Stengele for this idea. -*** Localized clock tables - :PROPERTIES: - :OrgVersion: 7.5 - :END: +**** Localized clock tables - Clock tables now support a new new =:lang= parameter, allowing the user - to customize the localization of the table headers. See the variable - =org-clock-clocktable-language-setup= which controls available - translated strings. + Clock tables now support a new new =:lang= parameter, allowing + the user to customize the localization of the table headers. See + the variable =org-clock-clocktable-language-setup= which controls + available translated strings. -*** Show clock overruns in mode line - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Show clock overruns in mode line - When clocking an item with a planned effort, overrunning the planned - time is now made visible in the mode line, for example using the new - face =org-mode-line-clock-overrun=, or by adding an extra string given - by =org-task-overrun-text=. + When clocking an item with a planned effort, overrunning the + planned time is now made visible in the mode line, for example + using the new face =org-mode-line-clock-overrun=, or by adding an + extra string given by =org-task-overrun-text=. - Thanks to Richard Riley for a patch to this effect. + Thanks to Richard Riley for a patch to this effect. -*** Clock reports can now include the running, incomplete clock - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Clock reports can now include the running, incomplete clock - If you have a clock running, and the entry being clocked falls into the - scope when creating a clock table, the time so far spent can be added - to the total. This behavior depends on the setting of - =org-clock-report-include-clocking-task=. The default is =nil=. + If you have a clock running, and the entry being clocked falls + into the scope when creating a clock table, the time so far spent + can be added to the total. This behavior depends on the setting + of =org-clock-report-include-clocking-task=. The default is + =nil=. - Thanks to Bernt Hansen for this useful addition. + Thanks to Bernt Hansen for this useful addition. -** Misc +*** Misc -*** Improvements with inline tasks and indentation - :PROPERTIES: - :OrgVersion: 7.4 - :END: +**** Improvements with inline tasks and indentation - There is now a configurable way on how to export inline tasks. See the - new variable =org-inlinetask-export-templates=. + There is now a configurable way on how to export inline tasks. + See the new variable =org-inlinetask-export-templates=. - Thanks to Nicolas Goaziou for coding these changes. + Thanks to Nicolas Goaziou for coding these changes. -*** A property value of "nil" now means to unset a property - :PROPERTIES: - :OrgVersion: 7.01 - :END: +**** A property value of "nil" now means to unset a property - This can be useful in particular with property inheritance, if some - upper level has the property, and some grandchild of it would like to - have the default settings (i.e. not overruled by a property) back. + This can be useful in particular with property inheritance, if + some upper level has the property, and some grandchild of it + would like to have the default settings (i.e. not overruled by a + property) back. - Thanks to Robert Goldman and Bernt Hansen for suggesting this change. + Thanks to Robert Goldman and Bernt Hansen for suggesting this + change. -*** New helper functions in org-table.el - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** New helper functions in org-table.el - There are new functions to access and write to a specific table field. - This is for hackers, and maybe for the org-babel people. + There are new functions to access and write to a specific table field. + This is for hackers, and maybe for the org-babel people. - #+begin_example - org-table-get - org-table-put - org-table-current-line - org-table-goto-line - #+end_example + #+begin_example + org-table-get + org-table-put + org-table-current-line + org-table-goto-line + #+end_example -*** Archiving: Allow to reverse order in target node - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Archiving: Allow to reverse order in target node - The new option =org-archive-reversed-order= allows to have archived - entries inserted in a last-on-top fashion in the target node. + The new option =org-archive-reversed-order= allows to have + archived entries inserted in a last-on-top fashion in the target + node. - This was requested by Tom. + This was requested by Tom. -*** Org-reveal: Double prefix arg shows the entire subtree of the parent - :PROPERTIES: - :OrgVersion: 6.35 - :END: +**** Org-reveal: Double prefix arg shows the entire subtree of the parent - This can help to get out of an inconsistent state produced for example - by viewing from the agenda. + This can help to get out of an inconsistent state produced for + example by viewing from the agenda. - This was a request by Matt Lundin. + This was a request by Matt Lundin. * License -This file is part of GNU Emacs. + This file is part of GNU Emacs. -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. + GNU Emacs is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. + GNU Emacs is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + You should have received a copy of the GNU General Public License + along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. diff --git a/etc/org/OrgOdtContentTemplate.xml b/etc/org/OrgOdtContentTemplate.xml index cd7ff0e156..55e1b78706 100644 --- a/etc/org/OrgOdtContentTemplate.xml +++ b/etc/org/OrgOdtContentTemplate.xml @@ -256,6 +256,7 @@ <text:sequence-decl text:display-outline-level="0" text:name="Drawing"/> <text:sequence-decl text:display-outline-level="0" text:name="Equation"/> <text:sequence-decl text:display-outline-level="0" text:name="Figure"/> + <text:sequence-decl text:display-outline-level="0" text:name="Listing"/> </text:sequence-decls> </office:text> </office:body> diff --git a/etc/org/OrgOdtStyles.xml b/etc/org/OrgOdtStyles.xml index 84125c96d8..5dfcfa8389 100644 --- a/etc/org/OrgOdtStyles.xml +++ b/etc/org/OrgOdtStyles.xml @@ -319,6 +319,11 @@ <style:style style:name="Table" style:family="paragraph" style:parent-style-name="Caption" style:class="extra"> <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/> </style:style> + <style:style style:name="Listing" style:family="paragraph" style:parent-style-name="Caption" style:class="extra"> + <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false" fo:keep-with-next="always"> + <style:tab-stops/> + </style:paragraph-properties> + </style:style> <style:style style:name="Horizontal_20_Line" style:display-name="Horizontal Line" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="html"> <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.499cm" style:border-line-width-bottom="0.002cm 0.035cm 0.002cm" fo:padding="0cm" fo:border-left="none" fo:border-right="none" fo:border-top="none" fo:border-bottom="0.039cm double #808080" text:number-lines="false" text:line-number="0" style:join-border="false"/> <style:text-properties fo:font-size="6pt" style:font-size-asian="6pt" style:font-size-complex="6pt"/> diff --git a/etc/refcards/orgcard.pdf b/etc/refcards/orgcard.pdf Binary files differindex 2b474bf4e9..2f00441844 100644 --- a/etc/refcards/orgcard.pdf +++ b/etc/refcards/orgcard.pdf diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 60e81f36d3..bf97d93bf0 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{7.8.11} +\def\orgversionnumber{7.9} \def\versionyear{2012} % latest update \input emacsver.tex diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 152af5f43e..e33b87c76c 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,3033 @@ +2012-09-30 Abdó Roig-Maranges <abdo.roig@gmail.com> + + * org-html.el (org-export-html-preprocess) + (org-export-html-format-image): Use + `org-latex-preview-ltxpng-directory'. + + * org-odt.el (org-export-odt-do-preprocess-latex-fragments): + Ditto. + + * org.el (org-latex-preview-ltxpng-directory): New option. + (org-preview-latex-fragment): Store LaTeX preview images in + `org-latex-preview-ltxpng-directory'. + +2012-09-30 Achim Gratz <Stromeko@Stromeko.DE> + + * ob-R.el (org-babel-R-initiate-session): Protect against use of + unbound variable `ess-ask-for-ess-directory´. The default for this + variable is true, so act accordingly if it is found unbound. + + * ob-R.el: Remove initialization with `nil´ from + `ess-ask-for-ess-directory´ and `ess-local-process-name´. Remove + second declaration for `ess-local-process-name´. + + * org-id.el: Do not use (random t), we just want a new random + number, not a re-seeding of the PRNG for which (random t) doesn't + provide enough entropy anyway. Even if (random) would always + produce the same sequence, the other components going into the MD5 + hash ensure that the result will be unique. + + * org-gnus.el: Add a missing require for gnus-util. + + * org-compat.el: Rename utils to make throughout. + + * org.el: Move check for outline-mode-keymap after (require + 'outline). + + * org-element.el: New file. Do not (require 'org). + + * org-agenda.el: Remove duplicate requires. + + * org.el (org-mode-map): Add keybindings to + `org-element-transpose' and `org-narrow-to-element'. + (org-metaup): Fall back on `org-element-drag-backward'. + (org-metadown): Fall back on `org-element-drag-forward'. Also + move chunks of declarations and require statements to get rid of + compiler warnings. + + * org-exp-blocks.el (org): Don't require org. Add declarations. + + * org-clock.el (org): Don't require org. + + * ob-exp.el (org-list-forbidden-blocks): Add declarations. + + * ob.el (org-babel-exeext): New defconst to hold extension for + executables or nil if none. Should be ".exe" for both Windows and + Cygwin. + + * ob-C.el (org-babel-C-execute): Use org-babel-exeext when + constructing the target file name for the compiled executable. + + * ob-fortran.el (org-babel-execute:fortran): Add org-babel-exeext + when constructing the target file name for the compiled + executable. + + * org-version.el: New file. + + * org-compat.el (org-check-version): New macro. Check if + org-version.el exists and provide autoloads to that. Otherwise + check if org-fixup.el exists and use it to provide definitions. + Finally if nothing worked, complain about a botched installation + and provide fallback definitions. + + * org.el: Use org-check-version. + + * org.el: Fix a subtle error resulting in version functions + sometimes not being defined and byte-compiling failing. Always + compile in fallback definitions into org.elc -- org-fixup either + provides re-definitions at compile-time or checks org-version.el + and then the git work tree when run uncompiled. So the fallback + definitions will only come into effect when org-fixup is not + available. + + * org.el (org-version): Make org-version more robust, e.g. when + byte-compiling single files with 'make compile-dirty'. + + * org.el (org-reload): Revert an undesirable change in org-reload. + Do not prepend org-dir to babel-files, which prevents the files + from being found in load-path. + + * org.el (org-version): Add optional parameters 'full and 'message + to optionally return the full version string and echo to message + area in non-interactive calls. + + * org.el (org-submit-bug-report): Add optional parameter 'full to + call of (org-version) so that the bug report has all version + information. + + * org.el (org-reload): Simplify file-re (orgtbl-*.el files do not + exist anymore). Keep org-*.el at the end of the files list. + Explicitely load org-version.el (since it doesn't provide feature + 'org-version) at the very end, but ignore errors when it doesn't + exist. Add parameters 'full and 'message to the call of + (org-version) so that after reload the full version information is + displayed in the message area again. + + * org-agenda.el: Replace with-no-warnings with org-no-warnings + (defined in org-macs.el). + + * org-bbdb.el: Replace with-no-warnings with org-no-warnings + (defined in org-macs.el). + + * org-clock.el: Replace with-no-warnings with org-no-warnings + (defined in org-macs.el). + + * org.el: Replace with-no-warnings with org-no-warnings (defined + in org-macs.el). + + * org.el: Add with-not-warnings around call of (org-fixup). + + * org-compat.el (org-find-library-dir): Rename + org-find-library-name (misleading) and implement with a function + that exists identically in Emacs/XEmacs. + + * org-exp-blocks.el: Change calls to org-find-library-dir. + + * org.el: change calls to org-find-library-dir. Make require for + noutline fail silently because it is missing from XEmacs. + + * org.el (org-version): Use functions instead of global variables + to get the version strings and remove the defvaralias to + org-version. Warn when encountering a mixed installation (org and + org-install.el should be found in the same directory). + + * org.el: Add with-no-warning to defvar for two unprefixed global + variables from calendar.el (there's nothing else we can do inside + org until it is fixed in calendar.el). + + * org.el: Require find-func and remove declare-function for + find-library-name, otherwise autoloaded org-version doesn't show + all info correctly. + + * org.el (org-version): Show the full path to org-install.el in + the version string to avoid confusion if multiple installations + exist or a previously loaded org-install.el has already defined a + version string that is now out of date. + + * org.el (org-version): Remove determination of version + information, show "N/A" if the information is not provided via + org-install.el. + + * org.el (org-git-version): Placeholder for recording the Git + version of org during install + + * org.el (org-version): Initialize local git-version with + placeholder and fall through using it when org is not installed in + a Git repository + +2012-09-30 Adam Spiers <orgmode@adamspiers.org> (tiny change) + + * org-html.el: Add hyperlink to http://orgmode.org/ from export + footer. + + * org-clock.el (org-clock-modify-effort-estimate): Display a + message when no clock is currently active. + +2012-09-30 Andrew Hyatt <ahyatt@gmail.com> (tiny change) + + * org-archive.el (org-archive-subtree): Allow archiving to a + datetree. + + * org.el (org-archive-location): Ditto. + +2012-09-30 Bastien Guerry <bzg@gnu.org> + + * ob-io.el: New file. + + * ob-scala.el: New file. + + * org.el (org-url-hexify-p, org-doi-server-url) + (org-latex-preview-ltxpng-directory, org-custom-properties) + (org-sparse-tree-default-date-type): Add :version "24.3". + + * org-agenda.el (org-agenda-sticky) + (org-agenda-custom-commands-contexts): Ditto. + + * org-capture.el (org-capture-bookmark) + (org-capture-templates-contexts) (org-capture-use-agenda-date): + Ditto. + + * org-latex.el (org-export-latex-hyperref-options-format) + (org-export-latex-link-with-unknown-path-format): Ditto. + + * org-id.el (org-id-link-to-org-use-id): Ditto. + + * org-datetree.el (org-datetree-add-timestamp): Ditto. + + * org.el (org-make-link-description-function): Enhance docstring. + (org-insert-link): Fall back on interactive prompt when + `org-make-link-description-function' fails. + + * org-agenda.el (org-todo-list): Fix redoing of todo agenda when + `org-agenda-sticky' is non-nil. + + * org-agenda.el (org-agenda-quit): Delete last indirect buffer. + (org-agenda-pre-follow-window-conf): New variable. + (org-agenda-tree-to-indirect-buffer): Fix bug: don't split agenda + window when there an indirect buffer is already displayed. + + * org-agenda.el (org-agenda-manipulate-query) + (org-agenda-goto-date, org-agenda-goto-today) + (org-agenda-find-same-or-today-or-agenda, ) + (org-agenda-later, org-agenda-change-time-span) + (org-agenda-change-all-lines) + (org-agenda-execute-calendar-command) + (org-agenda-goto-calendar, org-agenda-convert-date): Make sure to + get a property from (1- (point-max)), not (point-max)). + + * ob-dot.el (org-babel-execute:dot): Throw an error when there is + no :file parameter. + + * org-table.el (org-table-eval-formula): Convert time-stamps to + inactive time-stamp so that Calc can handle them correctly. + + * org-table.el (org-table-fix-formulas): Warn with a message when + formulas have been updated. + + * org-publish.el (org-publish-cache-ctime-of-src): Delete the + base-dir argument and use (file-name-directory file) to get the + file's directory. + (org-publish-update-timestamp) + (org-publish-cache-file-needs-publishing): Call + `org-publish-cache-ctime-of-src' with only one argument. + + * org.el (org-follow-timestamp-link): Fix bug when using sticky + agenda. Add a docstring. + + * org-agenda.el (org-agenda-sticky): Don't use a function to set. + Add a :version string. + + * org.el (org-priority): Use a new argument to show priority + instead of setting it. + (org-show-priority): New function to show priority both in normal + Org buffers and in Org Agenda buffers. + (org-speed-commands-default): Use "," as a speed command for + setting priority. + + * org-agenda.el (org-agenda-mode-map): Bind `org-agenda-priority' + to `C-c ,' as it was before. + (org-agenda-show-priority): Delete. + (org-agenda-priority): Use a new argument to show priority instead + of setting it. + + * org.el (org-font-lock-hook, org-set-font-lock-defaults): Add a + docstring. + (org-display-inline-remove-overlay): Rename from + `org-display-inline-modification-hook'. + (org-speed-command-activate): Rename from + `org-speed-command-default-hook'. + (org-babel-speed-command-hook): Rename from + `org-babel-speed-command-activate'. + + * org-agenda.el (org-agenda-update-agenda-type): Rename from + `org-agenda-post-command-hook'. + (org-agenda-mode): Use the new name. + (org-agenda-post-command-hook): Define as obsolete function. + + * org-lparse.el (org-lparse): Temporarily activate the hooks + needed for the ODT conversion. + (org-lparse-preprocess-after-blockquote): Rename from + `org-lparse-preprocess-after-blockquote-hook'. + (org-lparse-strip-experimental-blocks-maybe): Rename from + `org-lparse-strip-experimental-blocks-maybe'. + (org-lparse-preprocess-after-blockquote-hook) + (org-lparse-strip-experimental-blocks-maybe-hook): Define as + obsolete functions. + + * ob.el (org-babel-insert-result): Comma-escape results inserted + with ":results org". + + * org-src.el (org-edit-src-code, org-edit-src-exit): Fix bug about + saving the source editing window with the default value for + `org-src-window-setup' (i.e. 'reorganize-frame). + + * org-src.el (org-src-font-lock-fontify-block): Fix bug: don't + fontify the last character. + + * org.el (org-open-at-point): Don't follow timestamp within + bracket links. + + * org-capture.el (org-capture-templates): Fix typo in docstring. + + * org-agenda.el (org-agenda-skip): Skip information retrieved from + a source block. + + * ob.el (org-babel-common-header-args-w-values) + (org-babel-insert-result): Reintroduce ":results org" but using + "#+BEGIN_SRC org", not "#+BEGIN_ORG". + + * ob.el (org-babel-common-header-args-w-values): Remove "org" the + list of predefined values for the ":results" parameter. + + * ob.el (org-babel-insert-result): Remove support for ":results + org". + + * ob.el (org-babel-common-header-args-w-values) + (org-babel-insert-result): Deprecate ":results wrap" in favor of + ":results drawer". + + * org-crypt.el (org-at-encrypted-entry-p): Fix bug when the check + happens before the first headline. + + * org-capture.el (org-at-encrypted-entry-p) + (org-encrypt-entry, org-decrypt-entry): Declare. + (org-capture-set-target-location): Check whether `org-crypt' has + been loaded. + + * org-agenda.el (org-agenda-todo-custom-ignore-p): Fix typo in + docstring. + + * org-capture.el (org-capture-finalize): Maybe re-encrypt the + target headline if it was decrypted. + (org-capture-set-target-location): Maybe decrypt the target + headline. + + * org-crypt.el (org-at-encrypted-entry-p): New function. + + * org.el (org-options-keywords): Add "STYLE:". + + * org-agenda.el (org-agenda-ndays): Don't make an alias, as + `org-agenda-span' is defined separately. + + * org.el (org-in-subtree-not-table-p): New utility function for + building the menu. + (org-org-menu): Add an item for refiling. Check more contexts + when activating items. + (org-tree-to-indirect-buffer): Use `org-up-heading-safe'. + + * org-agenda.el (org-agenda-tree-to-indirect-buffer) + (org-agenda-do-tree-to-indirect-buffer): Use argument `arg'. + + * org-capture.el (org-capture-set-target-location): Set a correct + time value when storing a note in a datetree and prompting the + user for a date. + + * org-capture.el (org-capture-mode): Fix bug: don't run the mode's + hook twice. + + * org-agenda.el (org-agenda-menu-two-column) + (org-finalize-agenda-hook, org-agenda-ndays): Use + `define-obsolete-variable-alias' instead of + `make-obsolete-variable'. + + * org.el (org-link-to-org-use-id): Move to org-id.el. + + * org-id.el (org-id-link-to-org-use-id): Rename from + `org-link-to-org-use-id'. Use `nil' as the default value. + (org-link-to-org-use-id): Alias and define as obsolete. + + * org-agenda.el (org-search-view, org-agenda-get-todos) + (org-agenda-get-timestamps, org-agenda-get-blocks): Use the dotime + parameter of `org-agenda-format-item' so that 'time-up and + 'time-down agenda sorting strategies are handled correctly. + + * org-capture.el (org-capture-fill-template): Fix checking of + protected template entries. + + * org.el (org-cycle-global-at-bob): Fix typo in docstring. + + * org.el (org-insert-drawer): Deactivate the mark before trying to + indent the :END: of the drawer. + + * org-agenda.el (org-agenda-export-html-style): Default to nil as + any string value will replace the htmlize style. + + * org.el (org-cycle-hook): Fix tiny typo in docstring. + + * org.el (org-time-string-to-time) + (org-time-string-to-seconds, org-end-of-subtree): Add a dosctring. + + * org-freemind.el (org-freemind-write-node): Enhance links + conversion in nodes. + + * org-freemind.el (org-freemind-write-node): Convert links in + nodes. + + * org.el (org-link-to-org-use-id, org-directory) + (org-default-notes-file, org-reverse-note-order) + (org-extend-today-until, org-finish-function) + (org-store-link-functions): Use "capture" instead of "remember" in + docstrings. Also use the `org-capture' group when it makes sense. + + * org-agenda.el (org-agenda-tree-to-indirect-buffer): Find the + correct agenda buffer. Don't split the agenda window when the + indirect buffer is displayed in another frame. + + * org.el (org-mode): Try to set the org-hide face correctly. + + * org-exp.el (org-export): Set the mark correctly when exporting a + subtree. + + * org-agenda.el (org-agenda-get-restriction-and-command): Fix the + display of the number of commands for block agendas. + + * org-agenda.el (org-agenda-before-write-hook) + (org-agenda-add-entry-text-maxlines): Enhance phrasing. + (org-agenda-finalize-hook, org-agenda-mode-hook): Tell that the + buffer is writable when the hook is called. + (org-agenda-finalize): Allow org-agenda-finalize-hook to modify + the buffer. + + * org-agenda.el (org-habit-show-all-today): Only use defvar to + silent the byte-compiler. + (org-agenda-get-scheduled): Check whether some org-habit.el + options have been defined. + + * org-capture.el (org-capture-entry): New variable. + (org-capture-string, org-capture): Use it to possibly skip the + interactive prompt for a capture template. + + * org.el (org-activate-plain-links): Don't try to check if we are + in a bracket link already. + + * org.el (org-read-date-analyze): Fix bug introduced in commit + cc5f9f: adding a time should not prevent relative answers to be + parsed correctly. + + * org-agenda.el (org-agenda-bulk-action): Always read the date + through `org-read-date'. When possible, use the date at point as + the default date. + + * org-agenda.el (org-agenda-bulk-action): Fix bug when + bulk-shifting timestamps. + + * org.el (org-version): New constant. + + * org-compat.el (org-random): New compatibility function. + + * org-id.el (org-id-uuid): Use it. + + * org-capture.el (org-capture-use-agenda-date): New option. + (org-capture): Use it. + + * org-agenda.el (org-agenda-capture): New command. + (org-agenda-mode-map): Bind it to `k'. + (org-agenda-menu): Add it to the menu. + + * org-capture.el (org-capture): Update docstring. + + * org-capture.el (org-capture): When called from an agenda buffer, + use the cursor date at the default date. + + * org-agenda.el (org-agenda-bulk-action): Use the let-bound + `entries' instead the variable. + + * org-agenda.el (org-agenda-bulk-action): Fix bug: don't remove + persistent marks too early. + + * org-agenda.el (org-agenda-bulk-action): Possibly use the day at + point to reset the scheduled or deadline cookie. On date headers, + use it without prompting the user. On an item, use the item's + date as the default prompt for `org-read-date'. + + * org.el (org-read-date): Docstring fix. + + * org-agenda.el (org-agenda-bulk-action): Reorder possible actions + in the message. + + * org-agenda.el (org-agenda-action, org-agenda-do-action): Delete. + (org-agenda-mode-map): Delete related keys. + + * org-agenda.el (org-agenda-menu): Fix a keybinding. + + * org-colview.el (org-columns-goto-top-level): Correctly move the + marker `org-columns-top-level-marker'. + (org-agenda-columns): Don't set + `org-agenda-overriding-columns-format' as a buffer variable, as we + only need it dynamically. + (org-agenda-colview-summarize): Fix a bug in returning the match + string. + + * org-agenda.el (org-agenda-span-to-ndays): Make the second + argument `starting-day' optional. + (org-agenda-goto-date): Keep parameters of custom agendas. + + * org-agenda.el (org-agenda-list): Allow setting the agenda buffer + name through a temporary variable. + (org-agenda-buffer-tmp-name): New variable to temporary store the + agenda buffer name. + + * org-agenda.el (org-agenda-goto-date): Fix behavior when using + sticky agendas. + + * org-agenda.el (org-diary): Don't check whether there is an + agenda buffer when trying to compile the prefix format. + (org-compile-prefix-format): Check if there is an agenda buffer. + If not, use the current buffer. + + * org-agenda.el (org-agenda-get-day-entries): Set the agenda + buffer inconditionnally. + + * ob.el (org-babel-named-src-block-regexp-for-name): Generate a + more general regexp. + + * ob.el (org-babel-where-is-src-block-head): Find a src block head + correctly when #+header(s) is before #+name. + + * org-agenda.el (org-agenda-finalize-hook) + (org-agenda-finalize, org-agenda-finalize-entries): Rename from + org-finalize-agenda-*. + (org-agenda-run-series, org-agenda-finalize, org-timeline) + (org-agenda-list, org-search-view, org-todo-list) + (org-tags-view, org-diary, org-agenda-finalize-entries) + (org-agenda-change-all-lines): Use the new names. + + * org-agenda.el (org-agenda-local-vars): Remove + ̀org-agenda-last-arguments' from the list of local variables. + (org-agenda-mode-map): `g' does the same than `r' in buffers with + only one agenda view, but its behavior differs when there are + several views. In manually appended agendas (with `A'), `g' + displays only the agenda under the point. With multiple agenda + blocks, `g' reinitializes the view by discarding any temporary + changes (e.g. with ̀f' or `w'), while ̀r' keeps those temporary + changes for the agenda view under the point. + (org-agenda-run-series, org-agenda-redo): Implement the above + changes. + (org-agenda-mark-header-line): Don't set useless properties. + (org-agenda-list, org-todo-only, org-search-view) + (org-todo-list, org-tags-view, org-agenda-list-stuck-projects) + (org-agenda-manipulate-query, org-agenda-goto-today) + (org-agenda-later, org-agenda-change-time-span): Use text + properties for storing the last command and the last arguments for + each agenda block. + (org-unhighlight-once): Delete. + + * org-agenda.el (org-agenda-append-agenda): Fit agenda window to + buffer. + + * org-agenda.el (org-agenda-append-agenda): Bugfix: correctly + check whether we are in org-agenda-mode. + + * org-agenda.el (org-agenda-pre-window-conf): Rename from + `org-pre-agenda-window-conf'. + (org-agenda-local-vars, org-agenda-prepare-window) + (org-agenda-Quit, org-agenda-quit): Use the new name. + + * org-agenda.el (org-keys, org-match): New variable, dynamically + scoped in `org-agenda'. + (org-agenda, org-agenda-list, org-search-view, org-todo-list) + (org-tags-view): Use the new variables. + (org-batch-store-agenda-views): Let-bind `match'. + + * org-agenda.el (org-search-view, org-todo-list) + (org-tags-view): Do not let `org-agenda-sticky' prevent the use of + these functions programmatically. Also use the sticky agenda + function correctly. + + * org-agenda.el (org-agenda): Set `org-agenda-buffer-name' + correctly with sticky agendas and non-custom commands. + + * org-agenda.el (org-agenda-fit-window-to-buffer): Rename from + `org-fit-agenda-window'. + (org-agenda-run-series, org-agenda-prepare, org-agenda-list) + (org-search-view, org-todo-list, org-tags-view): Use the new name. + + * org-agenda.el (org-agenda-prepare): Let `throw' display an + error. + + * org-agenda.el (org-agenda-list): Fix bug: don't throw an error + when called from programs as (org-agenda-list). + + * org-agenda.el (org-todo-list): Make arg optional. + + * org.el (org-agenda-prepare-buffers): Rename from + `org-prepare-agenda-buffers'. + (org-match-sparse-tree, org-map-entries): Use the new names. + + * org-agenda.el (org-agenda-prepare-window): Rename from + `org-prepare-agenda-window'. + (org-agenda-prepare): Rename from `org-prepare-agenda'. + (org-agenda-run-series, org-agenda-prepare, org-timeline) + (org-agenda-list, org-search-view, org-todo-list) + (org-tags-view, org-agenda-list-stuck-projects, org-diary) + (org-agenda-to-appt): Use the new names. + + * org-mobile.el (org-mobile-create-index-file): Ditto. + + * org-icalendar.el (org-export-icalendar): Ditto. + + * org-clock.el (org-dblock-write:clocktable) + (org-dblock-write:clocktable): Ditto. + + * org2rem.el (org2rem): Ditto. + + * org-agenda.el (org-agenda): In sticky agendas, use the current + command's match to set the buffer name. This gives more + information to the user and allows to distinguish various agendas + triggered by the same key. + (org-batch-store-agenda-views): Handle the new sticky agenda + buffer name. + + * org-agenda.el (org-agenda) + (org-agenda-get-restriction-and-command): Use `S' as a key for + searching words in TODO-only entries. + + * org-agenda.el (org-prepare-agenda): Fit agenda window when + displaying a sticky agenda. + + * org-table.el (org-table-number-regexp): Allow the user to set it + to a new regexp, which allows commas as decimal mark. The default + is to not use this setting, but the one before commit 7ff8c1, + which has ben reverted. + + * org-agenda.el (org-agenda-overriding-cmd) + (org-agenda-multi-current-cmd) + (org-agenda-multi-overriding-arguments): New variables. + (org-agenda-run-series): `org-agenda-overriding-arguments' + defaults to the last agenda block arguments, so don't use it + globally. + (org-agenda-mark-header-line): Add properties needed so that + `org-agenda-overriding-arguments', `org-agenda-current-span' and + `org-agenda-last-arguments' can be set to their correct contextual + value. + (org-agenda-multi-back-to-pos): New variable. + (org-agenda-later): Retrieve `org-agenda-current-span' and + `org-agenda-overriding-arguments' from text properties. Also + handle numeric span. + (org-agenda-later, org-agenda-change-time-span): Set + `org-agenda-overriding-cmd' so that we to take overriding + arguments into account for this command only. + + * org-agenda.el (org-agenda-kill, org-agenda-archive-with): Fix + bug when called with a non-nil value of `org-agenda-stick'. + + * org-agenda.el (org-agenda-refile): Fix bug when refiling an + entry from a sticky agenda. + + * org-agenda.el (org-prepare-agenda-window): Use + `org-pre-agenda-window-conf' if already set. + (org-agenda-Quit): Set `org-pre-agenda-window-conf' to nil when + quitting. + (org-agenda-quit): Ditto. + + * org-capture.el (org-capture-fill-template): Protect the text + used for replacement from being further replaced. + + * org.el (org-contextualize-validate-key): Fix the check against a + function. + + * org.el (org-contextualize-keys): Rename from + `org-contextualize-agenda-or-capture'. Fix normalization to + handle empty key replacement string. + (org-contextualize-validate-key): Rename from + `org-contexts-validate'. Allow checking against a custom + function. + + * org-agenda.el (org-agenda-custom-commands-contexts): Update. + (org-agenda): Use `org-contextualize-keys'. + + * org-capture.el (org-capture-templates-contexts): Ditto. + + * org.el (org-contextualize-agenda-or-capture): Normalize + contexts. + + * org.el (org-contextualize-agenda-or-capture): Handle key + replacement depending on the contexts. + + * org-capture.el (org-capture-templates-contexts): Allow to use + the context as a way to replace one capture template by another + one. + + * org-agenda.el (org-agenda-custom-commands-contexts): Allow to + use the context as a way to replace one agenda custom command by + another one. + + * org.el (org-contextualize-agenda-or-capture) + (org-rule-validate): New functions, implement context filtering + for agenda commands and capture templates. + + * org-agenda.el (org-agenda-custom-commands-contexts): New option. + (org-agenda): Use it. + + * org-capture.el (org-capture-templates-contexts): New option. + (org-capture-select-template): Use it. + + * org.el (org-beginning-of-defun, org-end-of-defun): Delete. + (org-mode): Set `beginning-of-defun-function' and + `end-of-defun-function' directly. + + * org.el (org-insert-link): Fix bug: include links abbreviations + when completing. + + * org-icalendar.el (org-icalendar-print-entries): Fix bug: when + `org-icalendar-use-plain-timestamp' is nil, scheduled and deadline + items should not be ignored. + + * org.el (org-ds-keyword-length, org-make-tags-matcher): Docstring + clean-up. + + * org-freemind.el (org-freemind-convert-links-from-org): Replace + literally to prevent errors when replacing with string containing + backslashes. + + * org-pcomplete.el (org-thing-at-point): Allow to match (and then + complete) a "thing" containing dashes. + + * org-table.el (org-table-toggle-coordinate-overlays): Better + message when interactively toggling. + + * org-table.el (org-table-number-regexp): Update the docstring to + show an example of a decimal number using the comma as a + separation mark. + + * org-agenda.el (org-prepare-agenda): Minor code clean-up. + (org-agenda-filter-by-category): Filtering must be turned off only + when a category filter has been set and this filter is not empty. + + * org-agenda.el (org-search-view, org-agenda-get-todos) + (org-agenda-get-timestamps, org-agenda-get-sexps) + (org-agenda-get-progress, org-agenda-get-deadlines) + (org-agenda-get-scheduled, org-agenda-get-blocks): Use + `category-pos' instead of `org-category-pos'. + + * ob-fortran.el (org-babel-fortran-transform-list): Rename from + `ob-fortran-transform-list'. + (org-babel-fortran-var-to-fortran): Use the new function's name. + + * ob-calc.el (org-babel-calc-maybe-resolve-var): Rename from + `ob-calc-maybe-resolve-var'. + (org-babel-execute:calc): Use the new function's name. + + * org-jsinfo.el (org-infojs-template): Add a license. + (org-infojs-handle-options): Replace all template elements. + + * org-html.el (org-export-html-scripts): Add a license. + (org-export-html-mathjax-config): Replace all template elements. + (org-export-html-mathjax-template): Add a license. + (org-export-as-html): Minor code clean-up. + + * org.el (org-options-keywords): Add "#+MATHJAX" and + "#+INFOJS_OPT" to the list of keywords for completion. + + * org.el (org-src-prevent-auto-filling): Remove unused and useless + option. + + * org.el (org-element-at-point): Autoload. + (org-element-up): Remove useless declaration. + (org-fill-context-prefix, org-fill-paragraph) + (org-mark-element, org-narrow-to-element) + (org-transpose-element, org-unindent-buffer): Do not require + org-element. + + * org.el (org-fill-paragraph): Require org-element. + + * org-agenda.el (org-agenda-persistent-marks): Minor docstring + enhancement. + + * org.el (org-create-math-formula): Use the compatibility function + `org-region-active-p'. + + * org-odt.el (org-export-as-odf): Ditto. + + * ob.el (org-babel-demarcate-block): Ditto. + + * org.el (org-mark-subtree): Maybe call `org-mark-element' + interactively. + (org-mark-element): Only mark further elements when called + interactively. + + * org.el (org-mark-element, org-narrow-to-element) + (org-transpose-element): Require org-element. + + * org-agenda.el (org-agenda-get-timestamps) + (org-agenda-get-sexps, org-agenda-get-deadlines) + (org-agenda-get-scheduled): Add the 'warntime as a text property, + getting its value from the APPT_WARNTIME property. + (org-agenda-to-appt): Use the 'warntime text property. + + * org-capture.el (org-capture-place-table-line): Fix bug. + + * org.el (org-activate-plain-links): Don't activate a plain link + when it is part of a bracketed link, unless bracketed links are + not enlisted in `org-activate-links'. + (org-open-at-point): Don't consider the text immediately after a + bracketed link is part of a plain link. + + * org.el (org-compute-latex-and-specials-regexp) + (org-paste-subtree, org-sort-entries, org-store-link) + (org-open-at-point, org-file-remote-p, org-add-log-setup) + (org-set-tags-to, org-fast-tag-selection) + (org-diary-sexp-entry): Ditto. + + * org-agenda.el (org-agenda-get-blocks, org-cmp-priority) + (org-cmp-effort, org-cmp-todo-state, org-cmp-alpha) + (org-cmp-tag, org-cmp-time): Remove useless (t nil) sexps at the + end of (cond ...) constructs. + + * org-mobile.el (org-mobile-create-index-file): Ditto. + + * org-lparse.el (org-lparse-format-table-row): Ditto. + + * org-list.el (org-sort-list): Ditto. + + * org-id.el (org-id-get): Ditto. + + * org-html.el (org-export-html-preprocess): Ditto. + + * org-exp.el (org-default-export-plist) + (org-table-clean-before-export): Ditto. + + * org.el (org-options-keywords): Add "TODO". + (org-make-options-regexp): Make the hashtag mandatory for options + and don't allow whitespaces between the hashtag and the plus sign. + + * org.el (org-refresh-category-properties) + (org-find-dblock, org-dblock-start-re, org-dblock-end-re): Allow + lowercase "#+category" and "#+begin:" dynamic blocks. + + * org.el (org-context): Use case-folding when trying to match + clocktables and source blocks contexts. + + * org-clock.el (org-clock-put-overlay): Put the overlay on the + whole headline, not only on the last character. This fixes a bug + with overlays on headlines ending with a bracketed link. + + * org-html.el (org-export-as-html): Make sure we always process a + string. + + * org-exp.el (org-export-cleanup-toc-line): Always return a + string. + + * org.el (org-fontify-meta-lines-and-blocks-1): Correctly handle + metalines with #+results[...]:. + + * org-exp.el (org-export-handle-metalines): Rename from + `org-export-handle-table-metalines'. Now also handle source block + metalines. + (org-export-res/src-name-cleanup): Delete. + (org-export-preprocess-string): Use `org-export-handle-metalines'. + Don't use `org-export-res/src-name-cleanup' anymore. + + * org-html.el (org-format-org-table-html): Don't include the + caption tag for empty captions in HTML export. Keep it in the + DocBook export so that it produces valid DocBook XML. + + * org.el (org-read-date-analyze): Allow both "8am Wed" and "Wed + 8am" to be parsed correctly with respect to possible values of + `org-read-date-prefer-future'. + (org-read-date-prefer-future): Update docstring to remove the + restriction about inserting only the time. The user can now + insert the time and the day. + + * org-icalendar.el (org-icalendar-print-entries): Rename from + `org-print-icalendar-entries'. + (org-icalendar-start-file): Rename from + `org-start-icalendar-file'. + (org-icalendar-finish-file): Rename from + `org-finish-icalendar-file'. + (org-icalendar-ts-to-string): Rename from `org-ical-ts-to-string'. + (org-export-icalendar): Use the correct functions. + + * ob-ref.el (org-babel-ref-index-list): Fix bug introduced by + commit e85479. + + * org.el (org-fill-context-prefix): Require org-element. + (org-timestamp-change): Fix bug by saving excursion when adjusting + another clock. + + * org.el (org-read-date-prefer-future): Fix docstring formatting. + (org-read-date-analyze): Fix the interpretation of + `org-read-date-prefer-future'. + + * org-agenda.el (org-agenda-menu-two-column): Rename to + `org-agenda-menu-two-columns'. + + * ob.el (org-babel-sha1-hash, org-babel-noweb-p): Replace + `org-labels' by `let*'. + + * org-bibtex.el (org-bibtex-headline): Ditto. + + * org-compat.el: Delete `org-labels'. + + * ob.el (org-babel-get-src-block-info) + (org-babel-check-src-block, org-babel-current-result-hash) + (org-babel-parse-src-block-match, org-babel-read-link) + (org-babel-insert-result, org-babel-clean-text-properties): Use + ̀org-no-properties' instead of `org-babel-clean-text-properties'. + (org-babel-clean-text-properties): Delete redundant function + `org-babel-clean-text-properties'. + + * ob-tangle.el (org-babel-tangle-collect-blocks) + (org-babel-tangle-comment-links): Ditto. + + * ob-table.el (sbe): Ditto. + + * ob-lob.el (org-babel-lob-get-info) + (org-babel-lob-execute): Ditto. + + * ob-exp.el (org-babel-exp-non-block-elements): Ditto. + + * org-macs.el (org-no-properties): Allow a new parameter + `restricted' to restrict the properties removal to those in + `org-rm-props'. The default is now to remove all properties. + + * org-compat.el (org-substring-no-properties): Remove unused + defun. + + * org-remember.el (org-remember-apply-template): Remove redundant + removal of text properties. + (org-remember-apply-template): Use `org-no-properties'. + + * org-capture.el (org-capture-fill-template): Remove redundant + removal of text properties. + (org-capture-fill-template): Use `org-no-properties'. + + * org-gnus.el (org-gnus-open, org-gnus-follow-link): Use + `org-no-properties'. + + * org-colview.el (org-columns-display-here): Ditto. + + * org-table.el (org-table-eval-formula): Ditto. + + * org.el (org-entry-properties): Ditto. + + * org-icalendar.el (org-print-icalendar-entries): Fix bug about + handling `alarm-time'. + + * ob-R.el (org-babel-edit-prep:R): Don't set the session. + + * org.el (org-store-log-note): Only skip comments starting with "# + " when storing a note. + + * org.el (org-custom-properties): New option. + (org-custom-properties-overlays): New variable. + (org-toggle-custom-properties-visibility): New command to toggle + the visibility of custom properties. + (org-check-before-invisible-edit): Also prevent errors when trying + to edit invisible properties. + + * org-datetree.el (org-datetree-add-timestamp): New option. + (org-datetree-insert-line): Use it. + + * org.el (org-fill-template): Fix bug when filling template for a + key associated to the nil value. + + * org-agenda.el (org-diary): Fix tiny typo. + + * org.el (message-in-body-p): Move declaration up to fix compiler + warning. + + * org.el (org-fill-context-prefix): Fix auto-filling in + `message-mode'. + + * org.el (org-fill-paragraph): Correctly fill paragraph in + message-mode. + (org-indent-line): Correctly indent according to mode when + `orgstruct++-mode' is on. + (orgstruct++-mode): Add `fill-prefix' to the variable temporarily + stored in `org-fb-vars'. + + * org.el (org-fill-paragraph): Make a command. Fix bug about + filling message headers and citations. + + * org.el (org-redisplay-inline-images): New command. + (org-mode-map): Bind it to C-c C-x C-M-v. + + * org-colview.el (org-columns-get-format-and-top-level): Fix bug. + (org-columns-get-format): Fix compiler warning. + + * org-feed.el: Add declarations. + + * org-agenda.el (org-agenda-get-sexps): Use `org-get-tags-at' to + allow tag inheritance. + + * org-capture.el (org-capture): Fix bug introduced by commit + 1737d3. + + * org-publish.el (org-publish-needed-p) + (org-publish-update-timestamp, org-publish-file) + (org-publish-cache-file-needs-publishing): New argument + `base-dir'. + (org-publish-cache-ctime-of-src): Use the new argument to make + sure we find the file according to :base-directory. + + * org-capture.el (org-capture-string): New command to prompt for + the interactive text interactively. This can also be used in + Elisp programs to use ̀org-capture' with some initial text. + (org-capture-initial): New variable to store the initial text. + (org-capture): Use `org-capture-initial'. + + * org.el (org-emph-re): Tiny docstring formatting fix. + + * org-compat.el (org-labels): Remove. + + * org-bibtex.el (org-bibtex-headline): Don't use `org-labels'. + + * ob.el (org-babel-sha1-hash, org-babel-noweb-p): Ditto. + + * org.el (org-emph-re): Tiny formatting fix. + + * org.el (orgstruct-setup): Require `org-element'. + + * org.el (org-store-link, org-open-at-point): New link type + "help". + + * org-compat.el (org-flet): Remove alias. + + * ob.el (org-babel-edit-distance, org-babel-sha1-hash) + (org-babel-get-rownames, org-babel-insert-result) + (org-babel-merge-params) + (org-babel-expand-noweb-references): Don't use `org-flet'. Also + indent some functions correctly. + + * ob.el (org-babel-execute-src-block) + (org-babel-join-splits-near-ch, org-babel-format-result) + (org-babel-examplize-region): Don't use `org-flet'. + (org-babel-tramp-handle-call-process-region): Fix typo. + + * ob-awk.el (org-babel-awk-var-to-awk): Don't use `org-flet'. + + * ob-sh.el (org-babel-sh-var-to-string): Ditto. + + * ob-tangle.el (org-babel-tangle, org-babel-spec-to-string): Don't + use `org-flet'. + + * org-pcomplete.el (org-compat): Require. + + * ob-tangle.el (org-babel-load-file): Don't use `org-flet'. + + * org-bibtex.el (org-bibtex-write): Use let*. + + * org-plot.el (org-plot/gnuplot-script): Don't use `org-flet'. + + * org-bibtex.el (org-bibtex-headline, org-bibtex-fleshout) + (org-bibtex-read, org-bibtex-write): Don't use `org-flet'. + + * org-clock.el (org-clock-cancel): Use `org-looking-back'. + + * org-pcomplete.el (org-thing-at-point): Ditto. + + * org.el (org-timestamp-change): Ditto. + + * org-mouse.el (org-mouse-timestamp-today) + (org-mouse-set-priority, org-mouse-popup-global-menu) + (org-mouse-context-menu): Don't use ̀org-flet'. + + * org.el (org-priority): Fix docstring. + + * org-publish.el (org-publish-write-cache-file) + (org-publish-initialize-cache) + (org-publish-cache-file-needs-publishing) + (org-publish-cache-get): Small code clean-up. + + * org-publish.el (org-publish-cache-ctime-of-src): Simplify. + + * org-agenda.el (org-agenda-get-sexps): Add a 'tags property for + agenda entries created from sexps. + + * org-capture.el (org-capture-templates): Docstring clean up. + (org-capture-place-entry, org-capture-place-item) + (org-capture-place-plain-text, org-capture-place-table-line): + Ensure to always position the point according to %?. + + * org-table.el (org-table-convert-refs-to-rc): Fix bug when + converting remote table references. + + * org-agenda.el (org-agenda-switch-to): Run hooks in + ̀org-agenda-after-show-hook'. + + * ob-ref.el (org-babel-ref-index-list): Use let* and rename the + variable `length' to `lgth'. + + * org-plot.el (org-plot/gnuplot-to-grid-data): Don't use + ̀org-flet'. + + * org-exp.el (org-export-format-source-code-or-example): Ditto. + + * org-exp-blocks.el (org-export-blocks-preprocess): Ditto. + + * ob.el (org-babel-view-src-block-info) + (org-babel-execute-src-block, org-babel-edit-distance) + (org-babel-switch-to-session-with-code) + (org-babel-balanced-split, org-babel-insert-result): Ditto. + + * ob-ref.el (org-babel-ref-index-list): Ditto. + + * ob-python.el (org-babel-python-evaluate-session): Ditto. + + * ob-lob.el (org-babel-lob-get-info): Ditto. + + * ob-gnuplot.el (org-babel-expand-body:gnuplot): Ditto. + + * ob-exp.el (org-babel-exp-do-export): Ditto. + + * org-table.el (orgtbl-to-generic): Fix docstring. + + * org-clock.el (org-clock-in): Call `org-clock-out' with the new + argument `switch-to-state' set to nil. Fix docstring. + (org-clock-in-last): Prompt for a todo state to switch to when + called with three universal prefix arguments. Don't display a + message when the clock is already running. Update docstring. + (org-clock-out): New argument `switch-to-state'. When this + argument is non-nil, prompt for a state to switch the clocked out + task to, overriding `org-clock-out-switch-to-state'. + + * org.el (org-entry-get): Don't use `org-flet'. + + * org.el (org-forward-heading-same-level): Rename from + `org-forward-same-level'. + (org-backward-heading-same-level): Rename from + `org-backward-same-level'. + + * org.el (org-forward-element): Rename from `org-element-forward'. + (org-backward-element): Rename from `org-element-backward'. + (org-up-element): Rename from `org-element-up'. + (org-down-element): Rename from `org-element-down'. + (org-drag-element-backward): Rename from + `org-element-drag-backward'. + (org-drag-element-forward): Rename from + `org-element-drag-forward'. + (org-mark-element): Rename from `org-element-mark-element'. + (org-transpose-element): Rename from `org-element-transpose'. + (org-unindent-buffer): Rename from `org-element-unindent-buffer'. + (org-mode-map): Update the names of a commands. Remove useless + declarations. + + * org-element.el (org-element-forward, org-element-backward) + (org-element-up, org-element-down) + (org-element-drag-backward, org-element-drag-forward) + (org-element-mark-element, org-narrow-to-element) + (org-element-transpose, org-element-unindent-buffer): Move to + org.el. + + * org.el (org-forward-same-level): Fix typo in docstring. + + * org-agenda.el (org-agenda-mode-map): Bind + `org-agenda-show-priority' to `C-c,' instead of `P'. + (org-agenda-next-item, org-agenda-previous-item): New commands to + move by one item down/up in the agenda. + (org-agenda-mode-map): Bind `org-agenda-next-item' and + `org-agenda-previous-item' to `N' and `P' respectively. + + * org-rmail.el (org-rmail-store-link, org-rmail-follow-link): + Toggle headers when necessary. + + * org-element.el (org-narrow-to-element): Autoload. + + * org.el (org-mode-map): Use `M-h' for `org-element-mark-element'. + (org-mark-subtree): Allow a numeric prefix argument to move up + into the hierarchy of headlines. + + * org-element.el (org-element-up, org-element-down): Autoload. + + * org.el: Declare functions and don't require org-element. + + * org-element.el (org-element-at-point, org-element-forward) + (org-element-backward, org-element-drag-backward) + (org-element-drag-forward, org-element-mark-element) + (org-element-transpose, org-element-unindent-buffer): Autoload. + Require 'org and remove all declarations. + + * org.el (org-outline-regexp-bol, org-heading-regexp): Use + variables instead of constants. + + * org-archive.el (org-datetree-find-date-create): Declare. + + * org.el (org-open-at-point): Only set + `clean-buffer-list-kill-buffer-names' when the feature 'midnight + has been loaded. + + * org-icalendar.el (org-print-icalendar-entries): Let + APPT_WARNTIME take precedence over ̀org-icalendar-alarm-time'. + + * org.el (org-special-properties): New special property + CLOCKSUM_T. + (org-entry-properties): Handle the new special property. + + * org-colview.el (org-columns): Handle a new special property + CLOCKSUM_T. + (org-agenda-colview-summarize, org-agenda-colview-compute): Ditto. + + * org-clock.el (org-clock-sum-today): New function. + (org-clock-sum): New argument PROPNAME to set a custom text + property instead of :org-clock-minutes. + + * org-agenda.el (org-agenda-check-type): Throw a more appropriate + error message when no agenda is currently being displayed. + + * org.el (org-get-property-block): Find blocks before the first + headline. + (org-entry-properties): Minor code cleanup. + (org-entry-get, org-entry-get-with-inheritance): Get property + before the first headline. + + * org-mobile.el (org-mobile-create-index-file): Use `files-alist'. + + * org.el (org-make-link): Delete. + (org-store-link, org-insert-link) + (org-file-complete-link): Don't use `org-make-link'. + + * org-wl.el (org-wl-store-link-folder) + (org-wl-store-link-message): Ditto. + + * org-vm.el (org-vm-store-link): Ditto. + + * org-rmail.el (org-rmail-store-link): Ditto. + + * org-mhe.el (org-mhe-store-link): Ditto. + + * org-mew.el (org-mew-store-link): Ditto. + + * org-irc.el (org-irc-erc-store-link): Ditto. + + * org-info.el (org-info-store-link): Ditto. + + * org-id.el (org-id-store-link): Ditto. + + * org-gnus.el (org-gnus-group-link, org-gnus-article-link): Ditto. + + * org-eshell.el (org-eshell-store-link): Ditto. + + * org-bbdb.el (org-bbdb-store-link): Ditto. + + * org.el (org-url-hexify-p): New option. When non-nil (the + default), hexify URLs when creating a link. + + * org.el (org-insert-link): Make sure point is at the beginning of + the buffer. + + * org.el (clean-buffer-list-kill-buffer-names): Declare. + (org-open-at-point): Allow opening multiple shell links by + creating a new output buffer for each shell process. The new + buffer is added to `clean-buffer-list-kill-buffer-names'. + + * org-mobile.el (org-mobile-create-index-file): Use + `org-global-tags-completion-table' instead of + `org-tag-alist-for-agenda' to get the tags for the index file. + + * org.el (org-global-tags-completion-table): Fix typo in + docstring. + + * org.el (org-link-to-org-use-id): Use `org-capture' instead of + `org-remember' in the docstring. + (org-link-fontify-links-to-this-file): New function to fontify + links to the current buffer in `org-stored-links'. + (org-store-link): Small code simplification. + (org-link-prettify): Enclose literal links into <...> instead of + [[...]]. + (org-insert-link): Use `org-link-fontify-links-to-this-file'. + Also allow completion over links' descriptions, as well as links + destinations. When the user uses the description for completion, + don't prompt again for a description. + + * org-capture.el (org-capture-templates): Fix docstring by adding + Gnus to the list of mail clients. + + * org.el (org-log-repeat): Enhance docstring. + + * org.el (org-mode-map): Don't bind C-<up> and C-<down> to + `org-element-backward/forward' as these functions stops when there + is no element of the same type before/after point. It is useful + to navigate with `forward/backward-paragraph' with no stop in most + cases. + + * org-capture.el (org-capture-templates): New template %l to + insert the literal link pointing at the current buffer. + + * org.el (org-todo-keywords): Ditto. + + * org.el (org-fill-paragraph): Falls back on + `message-fill-paragraph' if required in `message-mode'. + + * org-pcomplete.el (pcomplete/org-mode/file-option/x): New macro. + (pcomplete/org-mode/file-option/options) + (pcomplete/org-mode/file-option/title) + (pcomplete/org-mode/file-option/author) + (pcomplete/org-mode/file-option/email) + (pcomplete/org-mode/file-option/date): Use the new macro to offer + completion over default values for #+OPTIONS, #+TITLE, #+AUTHOR, + #+EMAIL and #+DATE. + + * org-agenda.el (org-agenda-write): Fix bug when writing agenda to + an external file while `org-agenda-sticky' is non-nil. + + * org.el (org-speed-commands-default): New speedy command to + quickly add the :APPT_WARNTIME: property. + + * org-agenda.el (org-agenda-to-appt): Use the :APPT_WARNTIME: + property to override `appt-message-warning-time' when adding an + appointment from an entry. + + * org.el (org-version): Improve docstring. + (org-self-insert-cluster-for-undo): The default value should be + nil for Emacs >=24.1. See bug#11774. + + * org.el (org-fontify-meta-lines-and-blocks-1): Fix previous + commit. + + * org.el (org-options-keywords): New constant. + (org-additional-option-like-keywords): Remove duplicates with + keywords in the new constant. + (org-additional-option-like-keywords-for-flyspell): Use the new + constant. + (org-mode-flyspell-verify): Exclude keywords from the new + constant. + + * org-pcomplete.el (pcomplete/org-mode/file-option): Use + `org-options-keywords'. + + * org.el (org-toggle-heading): Bugfix: use + `org-element-mark-element' instead of `org-mark-list'. + + * org-list.el (org-mark-list): Delete. + + * org.el: Update a few keybindings. + + * org-element.el (org-element-down): Throw an error when the + element has no content. + + * org-table.el (orgtbl-radio-table-templates): Add a template for + org-mode. + (orgtbl-to-orgtbl): Complete and align the table created with + orgtbl-to-orgtbl, in case the user use the function for radio + tables. + (orgtbl-to-table.el): New function to export a table to another + one using the table.el format. + (orgtbl-to-unicode): New function to export a table using unicode + characters. + + * org-exp.el (org-export-language-setup): Use "Sommaire" for the + french translation of "Table of contents", to avoid a possible bug + when exporting to ODT. + + * org.el (org-additional-option-like-keywords): Add keywords. + (org-additional-option-like-keywords-for-flyspell): New constant + to use with flyspell. + (org-mode-flyspell-verify): Use the dedicated constant and don't + check `org-startup-options'. + + * org-agenda.el (org-batch-store-agenda-views): Use the sticky + agenda buffer name, if required. + (org-agenda-write): New parameter `agenda-bufname' to allow + setting the agenda buffer name. + + * org.el (org-mode-map): Add keybindings for + `org-element-forward', `org-element-backward', `org-element-up' + and `org-element-down'. + + * org.el (org-auto-fill-function): Don't call `do-auto-fill' + within (org-let org-fb-vars ...) as `do-auto-fill' should do the + right thing whether orgstruct++-mode is turned on or off. + + * org.el (org-sparse-tree-default-date-type): New option. + (org-ts-type): New variable. + (org-sparse-tree): New argument `type'. Use the new option + `org-sparse-tree-default-date-type' as the default value for + `type'. Fix docstring. + (org-re-timestamp): New function. + (org-check-before-date, org-check-after-date) + (org-check-dates-range): Use `org-ts-type' and `org-re-timestamp' + to tell compute the date regexp. + + * org.el (orgstruct++-mode, org-get-local-variables): Also set + `normal-auto-fill-function' when turning on/off orgstruct++-mode. + + * org-agenda.el (org-agenda-start-with-log-mode): Add relevant + customization types. + + * org-faces.el (org-document-title): Use the normal height. + + * org-clock.el (org-x11idle-exists-p): New variable. + (org-user-idle-seconds): Use it. + + * org.el (org-mode-map): Rebind `org-insert-all-links' to `C-c + C-M-l'. + + * org.el (org-insert-all-links): New command. + (org-insert-link): `org-keep-stored-link-after-insertion' is now + checked when the link to insert has been defined, regardless on + how it has been defined. Also don't read the description + interactively when the `default-description' parameter was given. + (org-mode-map): Bind `org-insert-all-links' to `C-c C-L'. + + * org.el (org-inc-effort): New command to increment the effort + property. + (org-set-effort): Use it. + (org-mode-map): Bind it to `C-c C-x E'. + (org-speed-commands-default): Use `E' as a speed command for it. + + * org.el (org-re-property-keyword): New function. + (org-entry-put): Use it to fix a bug with respect to setting the + value of a property when a property line with no value already + exists. + + * org.el (org-timestamp-change): Adjust clock in other org files + correctly. + + * org-clock.el (org-user-idle-seconds): Simplify. + + * org.el (org-mode-map): Bind `org-resolve-clocks' to `C-c C-x + C-z'. + + * org.el (org-mode-map): Add keybindings to + `org-element-transpose' and `org-narrow-to-element'. + (org-metaup): Fall back on `org-element-drag-backward'. + (org-metadown): Fall back on `org-element-drag-forward'. Also + move chunks of declarations and require statements to get rid of + compiler warnings. + + * org-exp-blocks.el (org): Don't require org. Add declarations. + + * org-clock.el (org): Don't require org. + + * ob-exp.el (org-list-forbidden-blocks): Add declarations. + + * org.el (org-timestamp-change): Don't use the `position'. + + * org.el (org-clock-history, org-clock-adjust-closest): New + variables. + (org-timestamp-change): Maybe adjust the next or previous clock in + `org-clock-history'. + (org-shiftmetaup, org-shiftmetadown): On clock logs, update the + timestamp at point and adjust the next or previous clock in + `org-clock-history', when possible. + + * org-clock.el (org-clock-in): Set the marker for + `org-clock-history' at a safer position. + + * org-timer.el (org-timer-pause-or-continue, org-timer-stop): + Autoload. + + * org-mobile.el (org-mobile-post-pull-hook): Fix docstring. + + * org.el (org-indent-line): Fix indentation of a property line + starting at the beginning of a line. + + * org-odt.el (org-odt-cleanup-xml-buffers): Use the new alias. + + * org-compat.el: Alias `org-condition-case-unless-debug' to + `condition-case-unless-debug' or `condition-case-no-debug'. + + * org.el (org-todo-keywords): Ditto. + + * org.el (org-use-fast-todo-selection): Reformat docstring. + + * org.el (org-flag-drawer): Add a docstring. + (org-mode-map): Bind ̀org-clock-cancel' to "C-cC-xC-q" and + `org-clock-in-last' to "C-cC-xC-x". This fixes a bug in the + previous keybinding for `org-clock-in-last', which would override + the one for `org-clock-in'. + + * org-clock.el (org-clock-in-last): Prevent errors when there is + no clocking history. + (org-clock-cancel): Fix bug when checking against a clock log in a + folded drawer. + + * org.el (org-link-expand-abbrev): Implement "%(my-function)" as a + new specifier. Update the docstring. + + * org.el (org-startup-options): Fix docstring formatting. + + * org.el (org-use-sub-superscripts): Fix typo in docstring. + + * org.el (org-refile): Fix bug: prevent looping when calling + `org-set-tags' internally. + + * org.el (org-mode-map): Add `C-c C-x C-I' as a keybinding for + `org-clock-in-last'. + + * org-clock.el (org-clock-continuously): New option. + (org-clock-in): Three universal prefix arguments set + `org-clock-continuously' to `t' temporarily. + (org-clock-in-last): Fix call to `org-clock-select-task' and + support continuous clocking. + (org-clock-out-time): New variable. + (org-clock-out): Set `org-clock-out-time' when clocking out. + Small docstring rewriting. + (org-clock-remove-empty-clock-drawer): Fix "invalid search bound" + bug when trying to delete empty logbook drawer. + (org-clock-cancel): If the clock log is gone, send a warning + instead of deleting the region that is supposed to contain it. + + * org.el (org-move-line-down, org-move-line-up): Remove. + (org-metaup, org-metadown): When the region is active, move it + up/down by one line, with no regard to the context. + + * org-odt.el (org-odt-cleanup-xml-buffers): Use the new alias. + + * org-compat.el: Alias `org-condition-case-unless-debug' to + `condition-case-unless-debug' or `condition-case-no-debug'. + + * org-pcomplete.el (org-thing-at-point): Ignore trailing + whitespaces while looking-back at properties. + + * org.el (org-mode): Set `indent-region-function'. + (org-indent-region): New function. + (org-fill-paragraph): When in a src block, use `indent-region' to + indent the whole source code instead of falling back on + `fill-paragraph', as this function messes up the code. + + * org-src.el (org-edit-src-code): Fix docstring formatting. + + * ob.el (org-babel-do-key-sequence-in-edit-buffer): Ditto. + + * org.el (org-mode, org-add-log-setup) + (org-get-property-block, org-entry-put) + (org-property-next-allowed-value, org-return) + (org-indent-line): Rename `org-indent-line-function' to + `org-indent-line'. + + * org-timer.el (org-timer-item): Ditto. + + * org-table.el (org-table-store-formulas): Ditto. + + * org-clock.el (org-clock-in, org-clock-find-position): Ditto. + + * org-src.el (org-src-font-lock-fontify-block) + (org-src-strip-leading-and-trailing-blank-lines) + (org-src-ask-before-returning-to-edit-buffer) + (org-edit-src-code, org-edit-src-continue) + (org-edit-fixed-width-region) + (org-src-do-key-sequence-at-code-block) + (org-src-font-lock-fontify-block, org-src-fontify-buffer): Fix + typos in docstrings. + + * org-docbook.el (org-export-docbook-emphasis-alist): Fix typo: + use "format string" instead of "formatting string". + + * org-latex.el (org-export-latex-emphasis-alist) + (org-export-latex-title-command, org-export-latex-tables): Ditto. + + * org-html.el (org-export-html-postamble): Ditto. + + * org-latex.el (org-export-latex-hyperref-options-format): New + option. + (org-export-latex-make-header): Use it. + + * ob.el (org-babel-confirm-evaluate): Prevent errors when + `org-current-export-file' is void. + + * org-table.el (org-table-export): Use the file name extension to + suggest the right conversion format. Also amend the docstring. + + * org.el (org-speed-commands-default): Two new speed commands. + Use `:' for `org-columns' and ̀#' for `org-toggle-comment'. + + * org.el (org-time-stamp): With two universal arguments, insert an + active timestamp with the current time without prompting the user. + + * org-clock.el (org-clock-in-last): New command. + + * org-clock.el (org-clock-in): Fix typo in docstring. + + * org-mobile.el (org-mobile-edit): Fix reference to a free + variable. + + * org.el (org-doi-server-url): Update :group. + + * ob-lob.el (org-babel-lob-execute): Fix reference to non-existent + variable. + + * org.el (org-doi-server-url): New option. + (org-open-at-point): Use it. + + * org.el (org-at-comment-p): New function. + (org-toggle-heading): Use `org-at-comment-p' to skip comments. + + * org-html.el (org-export-as-html): Add links to the Org mode and + GNU Emacs websites When :html-postamble is set to 't. + + * org-export.el (org-export-creator-string): Add links to the Org + mode and GNU Emacs websites. + + * org-special-blocks.el + (org-special-blocks-convert-html-special-cookies): Prevent errors + by first checking `org-line' is not nil. + + * org-clock.el (org-clock-string-limit) + (org-clock-modeline-total, org-clock-task-overrun-text) + (org-clock-mode-line-entry): Doc fix, "modeline" -> "mode line". + + * org.el (org-at-timestamp-p): Set ̀org-ts-what' to 'after when the + point is right after the timestamp. `org-at-timestamp-p' still + returns `t' in this case, as this is more practical. + (org-return): Check against ̀org-ts-what' to verify that point is + really within the timestamp (if any). + + * org.el (org-return): Follow time-stamp links when point is an a + time-stamp. + + * org-capture.el (org-capture-bookmark): New option. + (org-capture-finalize): Use it. + + * org-publish.el (org-publish-cache-file-needs-publishing): Make + the column mandatory after #+include:. + + * org-exp.el (org-export-handle-include-files): Ditto. + + * org-bibtex.el (org-bibtex-entries): Rename from + (org-bibtex-read, org-bibtex-write): Use the new name. + + * org-exp.el (org-export-handle-include-files): Allow to use + #+include with no column. + + * org-publish.el (org-publish-cache-file-needs-publishing): Make + quotes mandatory around the file name and allow spaces in it. + + * org-html.el (org-export-as-html): Add link to Org's and Emacs's + websites. + + * org-latex.el + (org-export-latex-link-with-unknown-path-format): New option. + (org-export-latex-links): Use it. + + * org-agenda.el (org-agenda-get-timestamps): Remove any active + timestamp from the headline text, not only those for the current + date. + + * org.el (org-set-tags): Allow setting tags for headlines in the + region when `org-loop-over-headlines-in-active-region' is non-nil. + + * org.el (org-allow-promoting-top-level-subtree): New option to + allow promoting a top-level subtree. + (org-called-with-limited-levels): New variable, dynamically bound + within the `org-with-limited-levels' macro. + (org-promote): Use the new option to allow promoting a top-level + subtree. + + * org-macs.el (org-with-limited-levels): Let-bind + `org-called-interactively-p' to t. + + * org.el (org-create-formula-image-with-dvipng) + (org-create-formula-image-with-imagemagick): Make sure a file + exists before trying to delete it. + + * org.el (org-scan-tags): Correctly match TODO keywords. + + * org-agenda.el (org-agenda-bulk-action): Fix bug: use + `org-agenda-bulk-unmark-all'. + + * org.el (orgstruct++-mode): Fix docstring. + (org-fill-paragraph): Use the 'justify parameter when falling back + on `fill-paragraph'. + + * org.el (org-indent-line-function): Use `org-let' instead of + `orgstruct++-ignore-org-filling'. + (org-fill-paragraph, org-auto-fill-function): Ditto. + + * org-macs.el (orgstruct++-ignore-org-filling): Delete. + + * org-table.el (org-table-time-string-to-seconds): Return the + empty string if provided. + (org-table-eval-formula): When assigning a duration string, handle + it correctly -- i.e. don't make any computation on it, except the + one to insert it using the correct duration format. + + * org.el (org-indent-line-function): Fix bug. + + * org-clock.el (org-frame-title-format-backup): New variable to + store the value of `frame-title-format' before `org-clock' might + replace it by `org-clock-frame-title-format'. + (org-clock-frame-title-format): New option. + (org-frame-title-string): Delete. + (org-clock-update-mode-line): Minor code reformatting. + (org-clock-in, org-clock-out, org-clock-cancel): Use + `org-clock-frame-title-format'. + + * org-clock.el (org-clock-get-clock-string): Add a space. + + * org-list.el (org-mark-list): Return an error when there is no + list at point. + + * org.el (org-toggle-heading): Allow `C-u C-c *' to mark the list + at point before converting items to headings. With a simple + universal-argument, set `current-prefix-arg' to 1, otherwise keep + the numeric value. + + * org-agenda.el (org-agenda-view-mode-dispatch): Make the message + more readable. + + * org-agenda.el (org-agenda-mode-map): New keybinding ̀*' to mark + all entries for bulk action. + (org-agenda-menu): New menu item for marking all entries. + (org-agenda-bulk-mark-all): New function to mark all entries. + (org-agenda-bulk-mark-regexp): Minor docstring fix. + (org-agenda-bulk-unmark): With a prefix argument, unmark all. + Also send a better message. + (org-agenda-bulk-remove-all-marks): Rename to + `org-agenda-bulk-unmark-all'. Check against + `org-agenda-bulk-marked-entries' before trying to unmark entries. + Minor docstring fix. + (org-agenda-bulk-unmark-all): Renamed from + ̀org-agenda-bulk-remove-all-marks'. + + * org-agenda.el (org-agenda-bulk-mark-char): New option. + (org-agenda-bulk-mark): Use the new option. + + * org.el (org-src-prevent-auto-filling): New option to prevent + auto-filling in src blocks. This defaults to nil to avoid people + being surprised that no auto-fill occurs in Org buffers where they + use `auto-fill-mode'. + (org-auto-fill-function): Use the new option. + + * org.el (org-properties-postprocess-alist): Better customization + type. + (org-set-property): Fix the check against + `org-properties-postprocess-alist'. + + * org-macs.el (orgstruct++-ignore-org-filling): Set + `def-edebug-spec' correctly. + + * org-colview.el (org-columns-string-to-number): When computing + the values for the colview, match durations and convert them to + HH:MM values. + + * org.el (org-duration-string-to-minutes): Match non-round + numbers. Add a new optional parameter to allow returning the + output as a string. + + * org.el (org-auto-fill-fallback-function) + (org-indent-line-fallback-function) + (org-fill-paragraph-fallback-function) + (org-auto-fill-fallback-function) + (org-indent-line-fallback-function) + (org-fill-paragraph-fallback-function): Remove. + (org-fb-vars): New buffer-local variable. + (orgstruct++-mode): Use the fallback variable `org-fb-vars' to + store, use and restore variables if needed. + (org-fill-paragraph): Ignore `orgstruct++-mode' filling variables + when needed. + (org-auto-fill-function, org-indent-line-function): Ditto. + + * org-macs.el (orgstruct++-ignore-org-filling): New macro. + + * org-exp-block.el: Use `org-find-library-name' instead of + `find-library-name'. + + * org-compat.el (org-find-library-name): Convert into a macro to + avoid compilation of a function from XEmacs in Emacs and vice + versa. + + * org-table.el (org-table-store-formulas): Fix typo. + (org-table-maybe-eval-formula): Fix the regexp to only match + formulas, which never end with the `=' character. If the field + only contain this character, don't eval either. + + * org.el (org-set-property): Perform the correct check against + `org-properties-postprocess-alist'. + + * org-bbdb.el (org-bbdb-anniversary-format-alist): Update the + customization type. + (name): Suppress (defvar 'name) as name is not eval'ed when + setting `org-bbdb-anniversary-format-alist'. + + * org.el (org-version): When called non-interactively, insert the + short version string, otherwise send a message with the complete + version string. + + * org-odt.el (org-odt-update-meta-file): Use (org-version) and + delegate checking whether `org-version' is known as a variable + there. + + * org-html.el (org-export-as-html): Use (org-version). + + * org-docbook.el (org-export-as-docbook): Ditto. + + * org-latex.el (org-export-latex-make-header): Ditto. + + * org-clock.el (org-clocktable-write-default): Temporarily disable + `delete-active-region' so that we don't accidently delete an + active region when exporting a subtree/region. + + * org-clock.el (org-program-exists): Remove. + (org-show-notification, org-clock-play-sound): Use + `executable-find' instead of `org-program-exists'. + + * org-agenda.el (org-diary): Prevent failure from + `org-compile-prefix-format' when there is no agenda buffer. + + * org-agenda.el (org-agenda-mode): Replace obsolete variable + `buffer-substring-filters'. + + * org-indent.el (org-indent-mode): Ditto. + + * org-compat.el (org-find-library-name): Silent the byte-compiler + about a warning related to XEmacs support. + + * org-special-blocks.el + (org-special-blocks-convert-html-special-cookies): Use `org-line' + instead of `line'. + + * org-html.el (org-html-handle-links, org-export-as-html) + (org-format-org-table-html, org-format-table-table-html) + (org-html-export-list-line): Use `org-line' instead of `line' as + the free variable name. + + * org-latex.el (org-export-latex-tables): Let-bind `hfmt'. + + * org-faces.el (org-list-dt): New face. + + * org.el (org-set-font-lock-defaults): Use `org-list-dt' as the + face for definition terms in definition lists. + + * org.el (org-fill-paragraph): Pass the `justify' argument to + `org-fill-paragraph-fallback-function'. + + * org.el (org-eval-in-calendar): Fix docstring to mention the + KEEPDATE parameter. + + * org.el (org-refresh-category-properties): Let-bind + `inhibit-read-only' to t. + + * org.el (org-auto-fill-fallback-function) + (org-indent-line-fallback-function) + (org-fill-paragraph-fallback-function): New variables to store + some fall-back functions when turning `orgstruct++-mode' on. + (orgstruct++-mode): Set the new variables. + (org-indent-line-function, org-fill-paragraph) + (org-auto-fill-function): Use them. + + * org.el (org-read-date): Bugfix: call `org-eval-in-calendar' with + the 'keepdate parameter set to t when setting the cursor type. + + * org-agenda.el (org-agenda-persistent-marks): New option to keep + marks after a bulk action. The option defaults to nil. + (org-agenda-bulk-action): Use the new option. + + * org-capture.el (org-capture-fill-template): Use %\n instead of + %n as a template element to be replaced with the nth prompted + string. + (org-capture-templates): Update docstring. + + * org.el (org-goto): Fix docstring and document what C-u does. + + * org-publish.el (org-publish-cache-file-needs-publishing): Use + (case-fold-search t) when looking for #+INCLUDE:. + + * org.el: Use (case-fold-search t). + (org-edit-special, org-ctrl-c-ctrl-c): Ditto. + + * org-table.el: + (org-table-store-formulas, org-table-get-stored-formulas) + (org-table-fix-formulas, org-table-edit-formulas) + (org-old-auto-fill-inhibit-regexp, orgtbl-ctrl-c-ctrl-c) + (orgtbl-toggle-comment, org-table-get-remote-range): Ditto. + + * org-footnote.el: + (org-footnote-goto-local-insertion-point): Ditto. + + * org-exp.el: Ditto. + + * org-colview.el: + (org-dblock-write:columnview, org-dblock-write:columnview): Ditto. + + * org-clock.el (org-clocktable-write-default): Ditto. + + * org-capture.el (org-capture-place-table-line): Ditto. + + * ob.el (org-babel-data-names, org-babel-goto-named-src-block) + (org-babel-src-block-names) + (org-babel-where-is-src-block-result, org-babel-result-end) + (org-babel-where-is-src-block-head) + (org-babel-find-named-result, org-babel-result-names): Ditto. + + * org-table.el (orgtbl-send-table): Escape special characters. + Introduce a new parameter :no-escape to prevent escaping. + + * org-agenda.el (org-toggle-sticky-agenda): Only shout a message + when called interactively. + (org-agenda-get-restriction-and-command): Call + `org-toggle-sticky-agenda' interactively. + + * org-agenda.el (org-agenda-top-category-filter): New variable for + storing the current top-category filter. + (org-agenda-redo): Apply a top-category filter, if any. + (org-agenda-filter-by-top-category) + (org-agenda-filter-top-category-apply): Set + `org-agenda-top-category-filter' to the right value. + + * org-clock.el (org-clock-out, org-clock-cancel) + (org-clock-in): Don't modify `frame-title-format' if it is a + string. + + * org-latex.el (org-export-latex-special-chars): Fix bug when + escaping special characters in a table. + + * org.el (org-read-date): Set cursor-type to nil in the calendar. + + * org-faces.el (org-date-selected): Use inverse video. Don't + explicitely set bold to nil as it causes `customize-face' to show + the weight property and thus encourage the user to change it. + Warn in the docstring that using bold might cause problems when + displaying the calendar. + + * org-id.el (org-id-update-id-locations): New parameter to silent + `org-id-find'. + (org-id-find): Use the new parameter. + + * org.el (org-show-hierarchy-above, org-cycle) + (org-global-cycle, org-files-list, org-store-link) + (org-link-search, org-open-file, org-display-outline-path) + (org-refile-get-location, org-update-all-dblocks) + (org-change-tag-in-region, org-entry-properties) + (org-save-all-org-buffers, org-revert-all-org-buffers) + (org-buffer-list, org-cdlatex-mode) + (org-install-agenda-files-menu, org-end-of-subtree) + (org-speedbar-set-agenda-restriction): Use (derived-mode-p + 'org-mode) instead of (eq major-mode 'org-mode). + + * org-timer.el (org-timer-set-timer): Ditto. + + * org-table.el (orgtbl-mode, org-table-align, orgtbl-mode): Ditto. + + * org-src.el (org-edit-src-exit, org-edit-src-code) + (org-edit-fixed-width-region, org-edit-src-exit): Ditto. + + * org-remember.el (org-remember-handler): Ditto. + + * org-mouse.el (dnd-open-file, org-mouse-insert-item): Ditto. + + * org-macs.el (org-get-limited-outline-regexp): Ditto. + + * org-lparse.el (org-replace-region-by): Ditto. + + * org-latex.el (org-latex-to-pdf-process) + (org-replace-region-by-latex): Ditto. + + * org-indent.el (org-indent-indent-buffer): Ditto. + + * org-id.el (org-id-store-link, org-id-update-id-locations) + (org-id-store-link): Ditto. + + * org-html.el (org-export-html-preprocess) + (org-replace-region-by-html): Ditto. + + * org-footnote.el (org-footnote-normalize) + (org-footnote-goto-definition) + (org-footnote-create-definition, org-footnote-normalize): Ditto. + + * org-docbook.el (org-replace-region-by-docbook): Ditto. + + * org-ctags.el (find-tag): Ditto. + + * org-colview.el (org-columns-redo) + (org-columns-display-here, org-columns-edit-value) + (org-columns-redo): Ditto. + + * org-capture.el (org-capture-insert-template-here) + (org-capture, org-capture-finalize) + (org-capture-set-target-location) + (org-capture-insert-template-here): Ditto. + + * org-ascii.el (org-replace-region-by-ascii): Ditto. + + * org-archive.el (org-archive-subtree): Ditto. + + * org-agenda.el (org-agenda) + (org-agenda-get-restriction-and-command) + (org-agenda-get-some-entry-text, org-search-view) + (org-tags-view, org-agenda-get-day-entries) + (org-agenda-format-item, org-agenda-goto, org-agenda-kill) + (org-agenda-archive-with, org-agenda-switch-to): Ditto. + + * org.el (org-repeat-re) + (org-clone-subtree-with-time-shift, org-auto-repeat-maybe) + (org-deadline, org-schedule, org-matcher-time) + (org-time-stamp, org-read-date, org-read-date-get-relative) + (org-display-custom-time, org-get-wdays) + (org-time-string-to-absolute, org-closest-date) + (org-timestamp-change): Allow to set hourly repeat cookie. Send + an error when an hourly repeat cookie is set and no hour is + specified in the timestamp. + + * org-icalendar.el (org-print-icalendar-entries): Handle hourly + repeat cookies. + + * org-clock.el (org-program-exists): Fix docstring. + + * org-clock.el (org-clock-file-time-cell-format): New option. + (org-clocktable-write-default): Use it. + + * org-faces.el (org-date-selected): New face. + + * org.el (org-date-ovl): Use `org-date-selected'. + + * org.el (org-mode): Don't use `buffer-face-mode' by default. + + * org-agenda.el (org-agenda-mode-map): Bind `^' to + `org-agenda-filter-by-top-category'. + + * org-ascii.el (org-export-ascii-underline): Change the default + underlining characters for headlines of level 1 and 2. Also + introduce \. as the underline character for headlines of level 5. + + * org-table.el (org-table-recalculate-buffer-tables) + (org-table-iterate-buffer-tables): Add autoload cookie. + + * org.el (org-table-map-tables): Exclude tables in src and example + blocks. + + * org.el (org-fill-paragraph): Leave scheduled/deadline lines + untouched when filling an adjacent paragraph. + + * org-html.el (org-export-html-preamble-format) + (org-export-html-postamble-format): Improve the docstring. + + * org.el (org-todo): Fix regression: rename `state' to + `org-state'. + + * org-clock.el (org-show-notification): Use `fboundp' instead of + `featurep' and the additional `require'. + + * org-clock.el (org-clock-in-prepare-hook): New option to format + the total time cells. + (org-clocktable-write-default): Use the new option. + + * org.el (org-open-at-point): Allow to open the agenda from an + active or inactive timestamp in a headline. + + * org-html.el (org-export-html-date-format-string): Make a + defcustom. + + * org-latex.el (org-export-as-latex): Fix TeX-master declaration. + +2012-09-30 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-expand-lhs-ranges): Allow hline + references to be expanded correctly in LHS of formulas. + + * org-beamer.el (org-beamer-inherited-properties): New option. + (org-beamer-after-initial-vars): Use new option to look for + inherited properties. + + * org.el (org-ts-regexp0): Allow time stamps without name of day. + + * org-agenda.el (org-toggle-sticky-agenda): + (org-agenda-sticky): Improve :set property. + + * org-agenda.el (org-agenda-local-vars): Clean up the variable + list. + (org-agenda-get-restriction-and-command): Add a key for toggling + sticky agenda views. + + * org-agenda.el (org-agenda-local-vars): Final decisions about + global/local + + * org-agenda.el (org-agenda-force-single-file): Variable removed. + (org-prepare-agenda-window): Store pre-agenda window config + locally. + (org-timeline): Introduce a scoped version of + `org-agenda-show-log'. + (org-agenda-list): Introduce a scoped version of + `org-agenda-show-log'. + (org-agenda-get-progress): Use the scoped version of + `org-agenda-show-log'. + (org-agenda-local-vars): Write the analysis result as a comment - + to be cleaned up in the next iteration. + + * org-agenda.el (org-toggle-sticky-agenda): Kill all agenda + buffers when toggling sticky-agendas. + (org-agenda-get-restriction-and-command): Add `C-c a C-k' as a key + to explicitly kill all agenda buffers. + (org-agenda-run-series): Remove any old agenda markers in the + buffer that is going to take the new block agenda. + (org-prepare-agenda): Reset markers before erasing the buffer anc + running `org-agenda-mode', because after that hte local variable + `org-agenda-markers' will have gone away. + (org-agenda-Quit): + (org-finalize-agenda): Install the marker resetter into the + `kill-buffer-hook'. + (org-agenda-save-markers-for-cut-and-paste): Look for markers in + all agenda buffers. + (org-agenda-kill-all-agenda-buffers): New function. + +2012-09-30 Chris Gray <chrismgray@gmail.com> + + * org-html.el (org-export-as-html): Remove the check for body-only + in the code for generating tables of contents. + +2012-09-30 Christoph Dittmann <github@christoph-d.de> (tiny change) + + * org-beamer.el (org-beamer-auto-fragile-frames): Make + [fragile] work with overlay specifications. + +2012-09-30 Christophe Junke <christophe.junke@inria.fr> (tiny change) + + * org-agenda.el (org-agenda-list): Ensures that the list returned + by `org-agenda-add-time-grid-maybe' is appended to ̀rtnall' before + checking if the latter is emtpy. + +2012-09-30 Christophe Junke <junke.christophe@gmail.com> (tiny change) + + * org-agenda.el (org-agenda-list): Ensure that the list returned + by `org-agenda-add-time-grid-maybe' is appended to `rtnall' before + checking if the latter is emtpy. + +2012-09-30 Christophe Rhodes <csr21@cantab.net> (tiny change) + + * org-latex.el (org-export-latex-tables): Support setting the + :hfmt parameter from #+ATTR_LaTeX. + +2012-09-30 Daniel Dehennin <daniel.dehennin@baby-gnu.org> (tiny change) + + * org-exp.el (org-export-handle-include-files) + (org-get-file-contents): Handle new parameter :addlevel. + +2012-09-30 Dave Abrahams <dave@boostpro.com> (tiny change) + + * org.el (org-link-prettify): New function to prettify links while + displaying them with `org-insert-link'. + (org-insert-link): Use the new function. + +2012-09-30 David Maus <dmaus@ictsoc.de> + + * org-exp.el (org-export-language-setup): Use numeric character + entities for proper rendering of non-UTF8 documents. + + * org-exp.el (org-export-language-setup): Add japanese + translation. + +2012-09-30 Eric Schulte <eric.schulte@gmx.com> + + * ob-sh.el (org-babel-sh-evaluate): Don't could 0-length shebangs. + + * ob.el (org-babel-insert-result): Replace key sequence with + function call. Use a more informative flag to the local function. + (org-add-protective-commas): Declare a new external function. + + * org-src.el (org-add-protective-commas): This should be its own + function. + (org-edit-src-exit): Use the new function. + + * org-compat.el (org-labels): Remove. + + * org-bibtex.el (org-bibtex-headline): Don't use `org-labels'. + + * ob.el (org-babel-sha1-hash, org-babel-noweb-p): Ditto. + + * ob.el (org-babel-string-read): Don't automatically evaluate code + block results which look like elisp. + (org-babel-import-elisp-from-file): Raise a warning message when + the process of reading code block results raises an error. + + * ob-tangle.el (org-babel-with-temp-filebuffer): Don't execute + macro argument multiple times. + + * org.el (org-compat): Require org-compat before we first use one + of its functions (a macro actually). + + * ob-comint.el (org-babel-comint-with-output): Don't name the + filter function, but rather pass through the anonymous lambda + directly. + + * org.el (org-babel-load-languages): Common lisp should be + mentioned as a supported babel language. + + * org-clock.el (org-clock-special-range): "concat 'string" -> + "concat" + (org-clocktable-shift): "concat 'string" -> "concat" + + * org-bibtex.el (org-bibtex-headline): Replacing org-flet with + org-labels. + + * ob-calc.el (org-babel-execute:calc): Strip single quotes from + calc internal representations. + + * org-clock.el (org-clock-special-range): Replacing cl concatenate + with concat. + (org-clocktable-shift): Replacing cl concatenate with concat. + + * ob.el (org-babel-edit-distance): Remove use of map at runtime. + + * org-compat.el (org-flet): Compatibility function now that flet + has been removed from cl-macs. + (org-labels): Compatibility function now that labels has been + removed from cl-macs. + + * ob-R.el (org-compat): Require org-compat. + + * ob-comint.el: Require org-compat. + + * ob-exp.el (org-babel-exp-do-export): Switch to compatibility + function. + + * ob-gnuplot.el (org-babel-expand-body:gnuplot): Switch to + compatibility function. + + * ob-lob.el (org-babel-lob-get-info): Switch to compatibility + function. + (org-babel-lob-execute): Switch to compatibility function. + + * ob-python.el (org-babel-python-evaluate-session): Switch to + compatibility function. + + * ob-ref.el (org-babel-ref-index-list): Switch to compatibility + function. + + * ob-sh.el (org-babel-sh-var-to-string): Switch to compatibility + function. + + * ob-tangle.el (org-babel-load-file): Switch to compatibility + function. + (org-babel-tangle): Switch to compatibility function. + (org-babel-spec-to-string): Switch to compatibility function. + + * ob.el (org-babel-view-src-block-info): Switch to compatibility + function. + (org-babel-execute-src-block): Switch to compatibility function. + (org-babel-edit-distance): Switch to compatibility function. + (org-babel-switch-to-session-with-code): Switch to compatibility + function. + (org-babel-sha1-hash): Switch to compatibility function. + (org-babel-balanced-split): Switch to compatibility function. + (org-babel-join-splits-near-ch): Switch to compatibility function. + (org-babel-get-rownames): Switch to compatibility function. + (org-babel-format-result): Switch to compatibility function. + (org-babel-insert-result): Switch to compatibility function. + (org-babel-examplize-region): Switch to compatibility function. + (org-babel-merge-params): Switch to compatibility function. + (org-babel-noweb-p): Switch to compatibility function. + (org-babel-expand-noweb-references): Switch to compatibility + function. + + * org-bibtex.el (org-bibtex-headline): Switch to compatibility + function. + (org-bibtex-fleshout): Switch to compatibility function. + (org-bibtex-read): Switch to compatibility function. + (org-bibtex-write): Switch to compatibility function. + + * org-exp-blocks.el (org-export-blocks-preprocess): Switch to + compatibility function. + + * org-exp.el (org-export-format-source-code-or-example): Switch to + compatibility function. + + * org-macs.el (org-called-interactively-p): Indentation fix. + + * org-mouse.el (org-mouse-timestamp-today): Switch to + compatibility function. + (org-mouse-set-priority): Switch to compatibility function. + (org-mouse-popup-global-menu): Switch to compatibility function. + (org-mouse-context-menu): Switch to compatibility function. + + * org-plot.el (org-plot/gnuplot-to-grid-data): Switch to + compatibility function. + (org-plot/gnuplot-script): Switch to compatibility function. + + * org.el (org-entry-get): Switch to compatibility function. + (org-fill-paragraph): Switch to compatibility function. + (org-auto-fill-function): Switch to compatibility function. + + * ob-lob.el (org-babel-lob-execute): Only try to insert extant + hashes. + + * ob-R.el (org-babel-R-command): From a defvar to a defcustom. + + * ob.el (org-babel-set-current-result-hash): Change the hash of + the results for the current code block. + (org-babel-current-result-hash): Fix documentation. + + * ob-lob.el (org-babel-lob-execute): Don't re-execute the called + function if the current call line hash matches that in its + results. + + * ob-R.el (org-babel-R-assign-elisp): Can't assume every entry in + a table is a sequence. + + * ob-R.el (org-babel-R-assign-elisp): Clean up the code + implementing reads of irregular data into R. + + * ob.el (org-babel-header-arg-expand): In new buffers + (char-before) may return nil so use equal rather than =. + + * ob-R.el (org-babel-header-args:R): Adding values. + + * ob-clojure.el (org-babel-header-args:clojure): Adding values. + + * ob-lisp.el (org-babel-header-args:lisp): Adding values. + + * ob-sql.el (org-babel-header-args:sql): Adding values. + + * ob-sqlite.el (org-babel-header-args:sqlite): Adding values. + + * ob.el (org-babel-combine-header-arg-lists): Combine lists of + arguments and values. + (org-babel-insert-header-arg): Use new combined header argument + lists. + (org-babel-header-arg-expand): Add support for completing-read + insertion of header arguments after ":" + (org-babel-enter-header-arg-w-completion): Completing read + insertion of header arguments + (org-tab-first-hook): Adding header argument completion. + (org-babel-params-from-properties): Combining header argument + lists. + + * ob-exp.el (org-babel-exp-results): Ensure noweb expanded body is + used on export. + + * ob.el (org-babel-result-to-file): New optional description + argument. + (org-babel-insert-result): Moved description logic to another + function. + + * ob.el (org-babel-insert-result): Change name of filelinkdescr to + file-desc. + (org-babel-common-header-args-w-values): Change name of + filelinkdescr to file-desc. + + * ob-C.el (org-babel-C-execute): Add .exe to the end of compiled C + files on windows. + + * ob-exp.el (org-babel-exp-code): Escape all lines when exporting + Org-mode blocks. + + * ob.el (org-babel-parse-src-block-match): Make use of the new + language argument to org-babel-strip-protective-commas. + (org-babel-parse-inline-src-block-match): Make use of the new + language argument to org-babel-strip-protective-commas. + (org-babel-strip-protective-commas): Now accepts a language + argument. + +2012-09-30 Fabrice Niessen <fniessen-TA4HMoP+1wHrZ44/DZwexQ@public.gmane.org> (tiny change) + + * org-agenda.el (org-agenda-write-buffer-name): Remove the test + for the presence of <style> tag. + +2012-09-30 Feng Shu <tumashu@gmail.com> + + * org.el (org-create-formula-image-with-imagemagick): Use + 'call-process to launch latex so that no shell output buffer will + be shown when previewing formulas. + + * org.el (org-create-formula-image-with-imagemagick): Fix typo. + + * org.el (org-latex-create-formula-image-program): New option to + use either dvipng or imagemagick to convert and preview LaTeX + fragments. + (org-preview-latex-fragment, org-format-latex): Handle the new + option. + (org-create-formula-image-with-dvipng): Rename from + `org-create-formula-image'. + (org-create-formula-image-with-imagemagick): New defun to handle + LaTeX preview with imagemagick. + (org-latex-color, org-latex-color-format): New defuns to handle + color conversions. + + * org-latex.el (org-latex-to-pdf-process, org-export-as-pdf): + Allow to use imagemagick to convert LaTeX fragments. + + * org-html.el (org-export-html-preprocess): Ditto. + + * org-exp.el (org-export-with-LaTeX-fragments): Ditto. + +2012-09-30 George Kettleborough <g.kettleborough@member.fsf.org> + + * org-clock.el: New option `org-clock-clocked-in-display' to + control whether the current clock is displayed in the mode line + and/or frame title. + + * org-timer.el: New option `org-timer-display' to control whether + the current timer is displayed in the mode line and/or frame + title. + +2012-09-30 Hans-Peter Deifel <hpdeifel@gmx.de> (tiny change) + + * ob.el (org-babel-execute-src-block): Allow the :dir header + argument to take relative file names. + +2012-09-30 Harri Kiiskinen <harri@pp-kaitue.(none)> (tiny change) + + * org-protocol.el: New option. + (org-protocol-store-link, org-protocol-do-capture): Use it. + +2012-09-30 Henning Weiss <hdweiss@gmail.com> + + * org-mobile.el (org-mobile-edit): Added handling of addheading, + refile, archive, archive-sibling and delete edit nodes. + (org-mobile-locate-entry): Olp links containing only a file are + now be located correctly. + (org-mobile-apply): Instead of finding the location of all target + headings for edit nodes in a separate loop, they will be found + immediately before applying edits. + + * org-mobile.el (org-mobile-sumo-agenda-command): Use a shorter + title. + +2012-09-30 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change) + + * org.el (org-parse-time-string): Allow strings supported by + tags/properties matcher (eg <now>, <yesterday>, <-7d>) if the time + starts with < and ends with >. This means that e.g. in the + clocktable parameters you can specify :tstart "<-1w>" :tend + "<now>". + +2012-09-30 Ippei FURUHASHI <top.tuna+orgmode@gmail.com> (tiny change) + + * org-colview.el (org-columns): New argument `columns-fmt-string'. + + * org-colview.el (org-columns-get-format-end-top-level): Split + into `org-columns-get-format' and `org-columns-goto-top-level'. + + * org-colview.el (org-dblock-write:columnview): Add a new + parameter :format which specifies the column view format for the + output of the columnview dynamic block. + +2012-09-30 Jambunathan K <kjambunathan@gmail.com> + + * org-lparse.el (org-lparse-and-open) + (org-lparse-do-convert): Open exported files with system-specific + application. + + * org-odt.el: Don't meddle with `org-file-apps'. + + * org-compat.el (org-condition-case-unless-debug): Alias to + `condition-case' when both `condition-case-no-debug' and + `condition-case-unless-debug' is unavailable. + + * org-odt.el (org-odt-do-image-size): Replace `flet' with + equivalent construct. + + * org-odt.el (org-odt-cleanup-xml-buffers): Use + `condition-case-no-debug' instead of + `condition-case-unless-debug'. This ensures backward + compatibility with Emacs versions < 24.1. + + * org-odt.el (org-odt-zip-dir) + (org-odt-cleanup-xml-buffers): New. + (org-export-as-odt-and-open, org-export-as-odt) + (org-odt-init-outfile, org-odt-save-as-outfile) + (org-export-as-odf, org-export-as-odf-and-open): Use + `org-odt-cleanup-xml-buffers'. + + * org-odt.el (org-export-odt-default-org-styles-alist): Add + default character style. + + * org-odt.el (org-export-odt-default-org-styles-alist): Add + default character style. + + * org-lparse.el (org-do-lparse): Remove stray call to + `org-export-html-after-blockquotes-hook'. + + * org-bbdb.el (org-bbdb-export): Add support for ODT format. + + * org-odt.el (org-odt-update-meta-file): Check for `org-version' + is bound before accessing it. + + * org-odt.el (org-odt-schema-dir-list): OD Schema files have been + moved away from $(git-root)/contrib/odt/etc/schema/ to + $(git-root)/etc/schema/. + + * org-odt.el (org-odt-format-org-link): Pay no heed to whether the + internal links destined for headlines provide a description or + not. In fact, the `org-store-link' and `org-insert-link' create + internal links which do have a description. + + * org-lparse.el (org-lparse-insert-org-table): Consider short + caption as plain text and not as org text. + + * org-odt.el (org-export-odt-format-formula) + (org-export-odt-format-image): Ditto. + + * org-odt.el (org-odt-begin-table) + (org-export-odt-format-formula, org-export-odt-format-image) + (org-odt-format-entity): Handle short caption. + + * org-lparse.el (org-lparse-insert-org-table) + (org-lparse-insert-list-table, org-lparse-insert-table-table): + Ditto. + +2012-09-30 Jay McCarthy <jay.mccarthy@gmail.com> (tiny change) + + * org-colview.el (org-columns-new-overlay): Make sure to add a + face to a string that has no face. + +2012-09-30 Jérémie Courrèges-Anglas <jca@wxcvbn.org> (tiny change) + + * org-latex.el: Ensure a final newline is appended to the export + buffer. + +2012-09-30 Levin Du <zslevin@gmail.com> (tiny change) + + * org-clock.el (org-clock-in): Fix bug in setting the clock + heading. + +2012-09-30 Madan Ramakrishnan <madanr79@gmail.com> (tiny change) + + * org-agenda.el (org-agenda-bulk-mark): Truly make arg optional as + advertised by the function. + +2012-09-30 Mark E. Shoulson <mark@kli.org> (tiny change) + + * org.el (org-fontify-entities): Hide {} when prettifying + entities. + +2012-09-30 Mark Shoulson <mark@kli.org> (tiny change) + + * org-entities.el (org-entities): Add new entities for characters + which could cause formatting changes if typed directly. + + * org-entities.el (org-entities): Added \asciicirc entity for ^; + also fixed \circ expansion in latex. + + * org.el (org-fontify-entities): Fix bug: The entities \sup[123] + and \there4 were not "prettified" when org-pretty-entities was + enabled. + +2012-09-30 Mats Lidell <matsl@xemacs.org> (tiny change) + + * org-element.el (org-element-paragraph-separate): Remove + redundant and misplaced t clause in case. + +2012-09-30 Matt Lundin <mdl@imapmail.org> + + * org-datetree.el: Fix regexp to allow datetree to find headings + with trailing whitespace. This fixes a bug in which an existing + datetree heading (e.g., "* 2012 ") would not be found by + org-datetree-find-year-create if it had trailing whitespace. This + can cause problems, for instance, if one is using column view on + the date tree, since editing subheadings with column view adds + whitespace at the end of the top heading. + + * org-footnote.el (org-footnote-new): Don't call + org-footnote-unique-label if org-footnote-auto-label is set to + random. + + * org-gnus.el: (org-gnus-follow-link): Fix argument to + gnus-group-read-group so that following a link does not result in + unread article being selected. + + * org-bbdb.el (org-bbdb-anniv-extract-date) + (org-bbdb-make-anniv-hash): Fix org-bbdb anniversary functionality + to accommodate BBDB 3.x. There are two major changes in BBDB 3.x + that need to be taken into account. The first is that + `bbdb-split' reverses the order of its parameters in 3.x. The + second is that `bbdb-record-getprop' is replaced by + bbdb-record-note in 3.x. + +2012-09-30 Max Mikhanosha <max@openchat.com> + + * org-agenda.el (org-agenda-change-all-lines): Speedup refresh of + a single line of agenda by narrowing the agenda buffer to just + that line before calling `org-agenda-finalize'. + + * org.el (org-mode): Don't set org-hide's foreground to + "invisible-bg". + (org-find-invisible-foreground): New function. + + * org-agenda.el (defvar org-habit-show-all-today): New variable + (org-agenda-get-scheduled): Show all habits if user wants it + + * org-habit.el (defcustom org-habit-show-all-today): New variable + + * org-agenda.el (org-agenda-quit): Copy the code for optionally + restoring window configuration after burying the sticky agenda + buffer. + + * org-agenda.el (org-agenda-new-marker): Check for NIL + org-agenda-buffer + (org-agenda-to-appt): Bind org-agenda-buffer to NIL + + * org-agenda.el (org-agenda-change-all-lines): Move accessing of + 'extra text property outside of with-current-buffer for original + buffer + + * org-agenda.el (defvar org-habit-show-habits-only-for-today): + initialize to nil + +2012-09-30 Michael Brand <michael.ch.brand@gmail.com> + + * org-id.el (org-id-link-to-org-use-id): Align the doc string to + the changed default. + + * ob-tangle.el (org-babel-tangle-collect-blocks): Use dummy string + when heading has no text. + + * org-capture.el (org-capture-inside-embedded-elisp-p): Improve + parsing. + + * org-feed.el (org-feed-format-entry): Require `org-capture'. + Expand Elisp %(...) templates. + (org-feed-default-template): Update docstring. + + * org-capture.el (org-capture-expand-embedded-elisp): New + function. + (org-capture-fill-template): Use it. + (org-capture-inside-embedded-elisp-p): New function to tell if we + are within an Elisp %(...) template. + + * org-list.el (org-at-item-description-p) + (org-list-item-body-column): Make the inline regexp more + consistent with `org-list-full-item-re', the inline regexp + "Description list items" from `org-set-font-lock-defaults and + others'. + +2012-09-30 Mike Sperber <sperber@deinprogramm.de> + + * org.el (org-fill-paragraph): Pass optional argument to + `fill-paragraph' to fix compatibility with XEmacs. + + * org.el (org-self-insert-cluster-for-undo): Default + `org-self-insert-cluster-for-undo' also on XEmacs. + + * org.el (org-kill-line): Access `visual-line-mode' only if it's + bound. + +2012-09-30 Muchenxuan Tong <demon386@gmail.com> (tiny change) + + * org-timer.el (org-timer-set-mode-line): Check + `org-timer-display' when value is 'off. + +2012-09-30 Nicolas Calderon Asselin <nicolas.calderon.asselin@gmail.com> (tiny change) + + * org-clock.el (org-clock-idle-time): Org-mode assumed that + x11idle was an available command, and returned an idle time of 0 + if it was not + (never idle). Added checks so that org-idle-time will come from + emacs' own current-idle-time if x11idle cannot be found or if it + cannot retrieve the idle time from X11 + +2012-09-30 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-element.el: Properly remove COMMENT and QUOTE keywords from + title in parser. + + * org-element.el (org-element-headline-parser): Fix parsing for + headlines with a single COMMENT or QUOTE keyword. + + * ob-org.el (org-babel-default-header-args:org): By default, + export code from Org src blocks. + + * org-element.el (org-element-inline-src-block-successor): Fix + inline-src-block parsing at the beginning of an item. + + * org-element.el (org-element--collect-affiliated-keywords): Fix + caption parsing. + + * org-element.el (org-element--current-element): At the very + beginning of a footnote definition or an item, next element is + always a paragraph. + + * org-element.el (org-element-headline-parser): Handle nil titles. + (org-element-inlinetask-parser): Add :raw-value property. Also + handle nil titles. + + * org.el (org-set-regexps-and-options): Don't consider tags as a + replacement for a missing title in an headline. + + * org.el (org-setup-filling): Remove duplicate code. + + * org.el (org-adaptive-fill-function): Make sure fill prefix is + computed from beginning of line. + + * org-element.el (org-element-section-parser): Make sure section + cannot contain an headline. + (org-element--current-element): Fix bug requiring to parse a quote + section even when point is at an headline. + + * org.el (org-adaptive-fill-function): Remove occasional spurious + space character when auto-filling. + + * org.el (org-mode): Call external initalizers. Now both filling + code and comments code have their own independant part in org.el. + (org-setup-filling): Renamed from `org-set-autofill-regexps'. + (org-setup-comments-handling): New function. + + * org.el (org-fill-paragraph): Refine filling in comments and in + paragraphs. Allow commented blank lines. Take into consideration + the indentation of the second line of the paragraph being filled. + (org-comment-or-uncomment-region): Rewrite function. Now comment + region at a fixed column: the minimal indentation of the region. + (org-fill-context-prefix): Rename function into + `org-adaptive-fill-function'. Also, In a paragraph, choose the + same prefix as the current line. + + * org-exp.el (org-export-handle-comments): Also remove comments at + column 0. + + * org-exp.el (org-export-handle-comments): Handle inline comments + with new syntax. + + * org.el (org-structure-template-alist): Add missing colon to + #+INCLUDE. + + * org.el (org-backward-element): When called at the beginning of + first element in section, the function shouldn't return an error + but move point to headline or point-min instead. + + * org-element.el (org-element-paragraph-parser): Tiny refactoring. + + * org-element.el (org-element-paragraph-parser): Remove trailing + code comments. + + * org.el (org-fill-context-prefix): Fix incorrect output when + called at the beginning of a plain list with an affiliated + keyword. + (org-fill-paragraph): Remove useless variable. + + * org-element.el (org-element-paragraph-parser): Fix parsing of + paragraph at the beginning of an item. + + * org.el (org-mode): Set back comment-start-skip so comment-dwin + can tell a keyword from a comment. + + * org.el (org-set-autofill-regexps): Install new comment line + break function. + (org-comment-line-break-function): New function. + (org-mode): Remove unnecessary line. + + * org.el (org-fill-context-prefix, org-fill-paragraph): Do not + fill verse blocks contents. Verse blocks can be used to format + free-form poetry, so filling has to be done manually. + + * org.el (org-fill-paragraph-separate-nobreak-p): New function. + (org-set-autofill-regexps): Introduce new predicate. + (org-fill-item-nobreak-p): Remove function. + + * org-element.el (org-element-paragraph-separate): Since this + variable is meant to be searched forward, \end{...} shouldn't + trigger the end of a paragraph before checking if it is the end of + a complete environment. + (org-element-latex-environment-parser): Slight change to the + regexp matching the beginning of a latex environment. + (org-element-paragraph-parser): Paragraphs don't end at incomplete + latex environments. + (org-element-latex-or-entity-successor): Remove paragraph + environments from latex fragment search. + + * org-table.el (org-table-number-regexp): By default, accept comma + as a decimal mark to represent numbers. + + * org-element.el (org-element-map): Fix comment typo. + + * org.el (org-fill-paragraph): Add a `save-excursion' to avoid + returning funny results. + + * org.el (org-fill-paragraph): Try not to include message header + and citation lines in a paragraph when filling it. + + * org.el (org-fill-paragraph): Fix filling in a narrowed buffer. + (org-fill-context-prefix): Fill prefix doesn't depend on current + narrowing. + + * org.el (org-mode): Line with a single hash sign on it is a + comment. + + * org.el (org-set-font-lock-defaults): Fix comment fontification. + + * org-element.el (org-element-item-parser): Do not remove tag from + body if list isn't descriptive. + + * org-list.el (org-insert-item): Only ask about a term for + descriptive lists. + (org-list-struct, org-list-insert-item): Do not recognize a tag in + an ordered list. + + * org-element.el (org-element-set-element): Rewrite function. + (org-element-adopt-elements): New function. + (org-element-adopt-element): Removed function. + (org-element--parse-elements, org-element--parse-objects): Use new + function. + + * org-list.el (org-list-automatic-rules): Remove `bullet' rule, + which is now hard-coded. + (org-cycle-list-bullet): Hard code `bullet' rule. + (org-list-get-list-type): Make sure a list with numbered bullets + cannot have `descriptive' type. + + * org-element.el (org-element-paragraph-parser): Fix previous + patch. + + * org.el (org-fill-paragraph): No need to use + `org-element-paragraph-separate' in a verse block since blank + lines only can end a "paragraph". + + * org-element.el (org-element-paragraph-separate): Apply changes + to comments. + (org-element-paragraph-parser): Correctly find end of paragraphs. + (org-element--current-element): Require colons for Babel calls. + (org-element-center-block-parser) + (org-element-dynamic-block-parser, org-element-quote-block-parser) + (org-element-special-block-parser) + (org-element-comment-block-parser) + (org-element-example-block-parser) + (org-element-export-block-parser, org-element-src-block-parser) + (org-element-verse-block-parser): Fall-back to paragraph parsing + when incomplete or ill-formed. + + * org-element.el (org-element-swap-A-B): Small refactoring. + + * org-element.el (org-element-text-markup-successor): Fix typo in + docstring. + + * org-element.el (org-element-at-point): Return consistent value + when function is called on a blank line within a plain list. + + * org-element.el (org-element-paragraph-separate): Fix comments in + paragraph separator regexp. Optimize it. + + * org-element.el: Update code commets. + + * org.el (org-mark-subtree): Fix bug when marking subtree with + point on an inlinetask. Refactor code. + + * org.el (org-mark-subtree): Do not make a special case for + inlinetasks when marking a subtree. These are handled by + `org-element-mark-element'. + + * org-element.el (org-element-comment-parser): Consider first "+" + as a comment when parsing an ill-defined keyword. + + * org-element.el (org-element-item-interpreter): Simplify bullet + creation. + (org-element-plain-list-interpreter): Fix wrong bullets, if + needed. + + * org-element.el (org-element-comment-parser): Fix parsing when a + keyword follows the commented line. + + * org.el (org-fill-context-prefix): Auto-fill first paragraph in + footnote definitions. + + * org.el (org-mode): Define new comment syntax. + (org-fontify-meta-lines-and-blocks-1, org-strip-protective-commas) + (org-fill-context-prefix, org-insert-comment) + (org-comment-or-uncomment-region): Use new comment syntax. + + * org-element.el (org-element-comment-parser) + (org-element-comment-interpreter, org-element--current-element): + Use new comment syntax. + + * org.el (org-fill-paragraph): When at an item or a footnote + definition, fill first paragraph instead. + + * org.el (org-fill-paragraph): Fix filling when point is at the + very end of a paragraph. + + * org.el (org-mode): Set comments related variables. + (org-insert-comment, org-comment-or-uncomment-region): New + functions. + + * org.el (org-fill-context-prefix): Small refactoring. + (org-fill-paragraph): Add code comments. + + * org-element.el (org-element-at-point): Add :parent property to + output. + (org-element-context): Add :parent property to output. Also + return a single element or object instead of a list of parents. + (org-element-forward, org-element-up): Apply changes. + + * org.el (org-fill-context-prefix): New function. + (org-fill-paragraph, org-auto-fill-function): Use new function. + Also handle comments. + (org-adaptive-fill-function): Remove function. + (org-get-local-variables, orgstruct++-mode): Don't store now + unused adaptive-fill* functions. + + * org-element.el (org-element-at-point): Fix function when buffer + starts with an inlinetask. Also fix it when called on the last + element in a greater element or the buffer. + + * org-element.el (org-element-center-block-parser) + (org-element-dynamic-block-parser) + (org-element-footnote-definition-parser) + (org-element-headline-parser, org-element-inlinetask-parser) + (org-element-quote-block-parser, org-element-special-block-parser) + (org-element-plain-list-parser): Refactor code. + (org-element-drawer-parser): Fall-back to paragraph parser when + drawer is incomplete. + + * org-macs.el (org-with-limited-levels): Fix typo. + + * org-element.el (org-element-paragraph-separate): Refactor. + (org-element-paragraph-parser): Fix paragraph parsing. + + * org.el (org-fill-paragraph): Rewrite function using + `org-element-at-point'. + + * org-element.el (org-element-fill-paragraph): Remove function. + + * org.el (org-planning-or-clock-line-re): Make it a defconst. + It's no use to make it a buffer-local variable since variables on + which it depends are not buffer-local anyway. + + * org.el (org-drawer-regexp): Provide default value for + `org-drawer-regexp' in non-Org buffers. + + * org-entities.el (org-entities-create-table): Function chokes + when CAR of `org-entities' is a string. + + * org-list.el (org-list-automatic-rules): Allow check-boxes in + description lists. + (org-list-struct-apply-struct, org-insert-item): Remove rule + check. + + * org-footnote.el (org-footnote-normalize): Fix positionning in + HTML export without a footnote section. + + * org-list.el (org-list-struct-indent): Follow + `org-list-demote-modify-bullet' specifications for ordered + bullets. + (org-list-indent-item-generic, org-indent-item-tree) + (org-outdent-item-tree): Fix bug when operating on a region. + (org-outdent-item, org-indent-item): Allow to operate on a region. + + * org.el (org-shiftmetaleft, org-shiftmetaright): Allow to operate + on a region. + + * org-footnote.el (org-footnote-delete-definitions): Remove blank + lines before the footnote definition instead of removing those + after it. + + * org-footnote.el (org-footnote-at-definition-p): Don't grab + trailing blank lines in a footnote definition. + (org-footnote-delete-definitions): Remove both footnote definition + and trailing blank lines. + +2012-09-30 Rick Frankel <rick@rickster.com> + + * ob-sql.el: Add dbi engine type and pre/post processing. + +2012-09-30 Sean O'Halpin <sean.ohalpin@gmail.com> (tiny change) + + * ob.el (org-babel-expand-noweb-references): Capture current noweb + start and end patterns then use to set buffer locals in + (with-temp-buffer) form. + +2012-09-30 Sebastien Vauban <sva@mygooglest.com> (tiny change) + + * org.el (org-update-all-dblocks): Autoload function. + +2012-09-30 Simon Thum <simon.thum@gmx.de> (tiny change) + + * ob-maxima.el (org-babel-execute:maxima): Let cmdline always + return a string. + +2012-09-30 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk> (tiny change) + + * org-icalendar.el (org-icalendar-timezone): Fix typo and clarify + meaning. + +2012-09-30 Stuart Hickinbottom <stuart@hickinbottom.com> (tiny change) + + * org-clock.el (org-x11idle-exists-p): Only shell out when running + on X. + +2012-09-30 Suhail Shergill <suhailshergill@gmail.com> (tiny change) + + * org-html.el (org-export-as-html): If possible, use the + :CUSTOM_ID: property to assign unique ids to footnotes. + +2012-09-30 T.F. Torrey <tftorrey@tftorrey.com> (tiny change) + + * org-exp.el (org-export-remember-html-container-classes): Allow + exporting a single subtree with HTML_CONTAINER_CLASS property. + + * org-rmail.el (org-rmail-follow-link): Use `rmail-widen' instead + of `widen' and don't toggle header as `rmail-widen' already takes + care of this. + +2012-09-30 Tim Howe <vsync@quadium.net> (tiny change) + + * org-clock.el (org-clocktable-defaults): Revert extra layer of + quoting. + +2012-09-30 Toby S. Cubitt <tsc25@cantab.net> + + * org-capture.el (org-capture-fill-template): Expand %<num> escape + sequences into text entered for <num>'th %^{PROMPT} escape. + + * org-capture.el (org-capture-fill-template): Fixed regexp for + %<n> expandos to match any positive integer. + (org-capture-templates): Updated docstring accordingly. + + * org-agenda.el (org-agenda-skip-timestamp-if-deadline-is-shown): + Skip timestamp items in agenda view if item is already shown as a + deadline item. + (org-agenda-skip-dealine-if-done): Pass deadline results to + org-agenda-get-timestamps. + (org-agenda-get-timestamps): Optionally take list of deadline + results, so that timestamp results can be skipped if already + included in deadline results. + + * org-agenda.el (org-agenda-diary-sexp-prefix): Regexp matching + deadline/scheduling information to be displayed in diary sexp + agenda items. + (org-agenda-get-sexps): Extract deadline/scheduling information + from diary sexp entries. + + * org-capture.el (org-capture-place-entry): Place captured entry + immediately after last subheading of target, instead of just + before next heading at same level as target. + + * org-capture.el (org-capture-templates): Document new capture + template properties. + + * org-capture.el (org-capture-place-entry) + (org-capture-empty-lines-before): Make new :empty-lines-before + property override :empty-lines when inserting empty lines before + captured captured entry. + + * org-capture.el (org-capture-finalize) + (org-capture-empty-lines-after): Make new :empty-lines-after + property override :empty-lines when inserting empty lines after + captured captured entry. + + * org-agenda.el (org-agenda-skip-if, org-agenda-skip-if-todo): Add + new todo-unblocked and nottodo-unblocked skip conditions. These + match as for todo and nottodo, but only for unblocked todo items. + +2012-09-30 Zachary Kanfer <zkanfer@gmail.com> (tiny change) + + * org.el (org-read-date-display): Fix bug when displaying the + overlay. + +2012-09-30 Niels Giesen <niels.giesen@gmail.com> + + * org-table.el (orgtbl-to-generic): Add check for :skipheadrule. + When present, the :hline following the head will be skipped. This + is necessary to avoid doubling of horizontal rules in LaTeX + longtable environments and consequent width problems. + + * org-latex.el (org-export-latex-tables-tstart) + (org-export-latex-tables-hline) + (org-export-latex-tables-tend): New options. + (org-export-latex-tables): Use the new options. + +2012-09-30 tumashu <tumashu@gmail.com> (tiny change) + + * org-exp.el (org-export-language-setup): Add simplified chinese + translation. + 2012-09-01 Paul Eggert <eggert@cs.ucla.edu> Better seed support for (random). diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index 583510ac61..ba50722e32 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -61,7 +61,7 @@ is currently being evaluated.") (org-babel-execute:C++ body params)) (defun org-babel-execute:C++ (body params) - "Execute a block of C++ code with org-babel. This function is + "Execute a block of C++ code with org-babel. This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) @@ -88,9 +88,7 @@ or `org-babel-execute:C++'." (cond ((equal org-babel-c-variant 'c) ".c") ((equal org-babel-c-variant 'cpp) ".cpp")))) - (tmp-bin-file (org-babel-temp-file - "C-bin-" - (if (equal system-type 'windows-nt) ".exe" ""))) + (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext)) (cmdline (cdr (assoc :cmdline params))) (flags (cdr (assoc :flags params))) (full-body (org-babel-C-expand body params)) @@ -118,8 +116,8 @@ or `org-babel-execute:C++'." (org-babel-pick-name (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) (defun org-babel-C-expand (body params) "Expand a block of C or C++ code with org-babel according to @@ -131,22 +129,22 @@ it's header arguments." (defines (org-babel-read (or (cdr (assoc :defines params)) (org-babel-read (org-entry-get nil "defines" t)))))) - (mapconcat 'identity - (list - ;; includes - (mapconcat - (lambda (inc) (format "#include %s" inc)) - (if (listp includes) includes (list includes)) "\n") - ;; defines - (mapconcat - (lambda (inc) (format "#define %s" inc)) - (if (listp defines) defines (list defines)) "\n") - ;; variables - (mapconcat 'org-babel-C-var-to-C vars "\n") - ;; body - (if main-p - (org-babel-C-ensure-main-wrap body) - body) "\n") "\n"))) + (mapconcat 'identity + (list + ;; includes + (mapconcat + (lambda (inc) (format "#include %s" inc)) + (if (listp includes) includes (list includes)) "\n") + ;; defines + (mapconcat + (lambda (inc) (format "#define %s" inc)) + (if (listp defines) defines (list defines)) "\n") + ;; variables + (mapconcat 'org-babel-C-var-to-C vars "\n") + ;; body + (if main-p + (org-babel-C-ensure-main-wrap body) + body) "\n") "\n"))) (defun org-babel-C-ensure-main-wrap (body) "Wrap body in a \"main\" function call if none exists." diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index 49a8a85cf6..3dedb39365 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -39,24 +39,48 @@ (declare-function ess-make-buffer-current "ext:ess-inf" ()) (declare-function ess-eval-buffer "ext:ess-inf" (vis)) (declare-function org-number-sequence "org-compat" (from &optional to inc)) - -(defconst org-babel-header-arg-names:R - '(width height bg units pointsize antialias quality compression - res type family title fonts version paper encoding - pagecentre colormodel useDingbats horizontal) +(declare-function org-remove-if-not "org" (predicate seq)) + +(defconst org-babel-header-args:R + '((width . :any) + (height . :any) + (bg . :any) + (units . :any) + (pointsize . :any) + (antialias . :any) + (quality . :any) + (compression . :any) + (res . :any) + (type . :any) + (family . :any) + (title . :any) + (fonts . :any) + (version . :any) + (paper . :any) + (encoding . :any) + (pagecentre . :any) + (colormodel . :any) + (useDingbats . :any) + (horizontal . :any) + (results . ((file list vector table scalar verbatim) + (raw org html latex code pp wrap) + (replace silent append prepend) + (output value graphics)))) "R-specific header arguments.") (defvar org-babel-default-header-args:R '()) -(defvar org-babel-R-command "R --slave --no-save" - "Name of command to use for executing R code.") +(defcustom org-babel-R-command "R --slave --no-save" + "Name of command to use for executing R code." + :group 'org-babel + :version "24.1" + :type 'string) -(defvar ess-local-process-name) +(defvar ess-local-process-name) ; dynamically scoped (defun org-babel-edit-prep:R (info) (let ((session (cdr (assoc :session (nth 2 info))))) (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) - (save-match-data (org-babel-R-initiate-session session nil)) - (setq ess-local-process-name (match-string 1 session))))) + (save-match-data (org-babel-R-initiate-session session nil))))) (defun org-babel-expand-body:R (body params &optional graphics-file) "Expand BODY according to PARAMS, return the expanded body." @@ -120,7 +144,7 @@ This function is called by `org-babel-execute-src-block'." ;; helper functions (defun org-babel-variable-assignments:R (params) - "Return list of R statements assigning the block's variables" + "Return list of R statements assigning the block's variables." (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) (mapcar (lambda (pair) @@ -146,25 +170,45 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-R-assign-elisp (name value colnames-p rownames-p) "Construct R code assigning the elisp VALUE to a variable named NAME." (if (listp value) - (let ((transition-file (org-babel-temp-file "R-import-"))) + (let ((max (apply #'max (mapcar #'length (org-remove-if-not + #'sequencep value)))) + (min (apply #'min (mapcar #'length (org-remove-if-not + #'sequencep value)))) + (transition-file (org-babel-temp-file "R-import-"))) ;; ensure VALUE has an orgtbl structure (depth of at least 2) (unless (listp (car value)) (setq value (list value))) (with-temp-file transition-file - (insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))) - (insert "\n")) - (format "%s <- read.table(\"%s\", header=%s, row.names=%s, sep=\"\\t\", as.is=TRUE)" - name (org-babel-process-file-name transition-file 'noquote) - (if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE") - (if rownames-p "1" "NULL"))) + (insert + (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)) + "\n")) + (let ((file (org-babel-process-file-name transition-file 'noquote)) + (header (if (or (eq (nth 1 value) 'hline) colnames-p) + "TRUE" "FALSE")) + (row-names (if rownames-p "1" "NULL"))) + (if (= max min) + (format "%s <- read.table(\"%s\", + header=%s, + row.names=%s, + sep=\"\\t\", + as.is=TRUE)" name file header row-names) + (format "%s <- read.table(\"%s\", + header=%s, + row.names=%s, + sep=\"\\t\", + as.is=TRUE, + fill=TRUE, + col.names = paste(\"V\", seq_len(%d), sep =\"\"))" + name file header row-names max)))) (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) -(defvar ess-ask-for-ess-directory nil) +(defvar ess-ask-for-ess-directory) ; dynamically scoped (defun org-babel-R-initiate-session (session params) "If there is not a current R process then create one." (unless (string= session "none") (let ((session (or session "*R*")) (ess-ask-for-ess-directory - (and ess-ask-for-ess-directory (not (cdr (assoc :dir params)))))) + (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory) + (not (cdr (assoc :dir params)))))) (if (org-babel-comint-buffer-livep session) session (save-window-excursion @@ -177,7 +221,6 @@ This function is called by `org-babel-execute-src-block'." (buffer-name)))) (current-buffer)))))) -(defvar ess-local-process-name nil) (defun org-babel-R-associate-session (session) "Associate R code buffer with an R session. Make SESSION be the inferior ESS process associated with the @@ -219,7 +262,7 @@ current code buffer." (setq args (mapconcat (lambda (pair) (if (member (car pair) allowed-args) - (format ",%s=%s" + (format ",%s=%S" (substring (symbol-name (car pair)) 1) (cdr pair)) "")) params "")) @@ -245,7 +288,7 @@ current code buffer." (body result-type result-params column-names-p row-names-p) "Evaluate BODY in external R process. If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (case result-type (value @@ -272,7 +315,7 @@ last statement in BODY, as elisp." (session body result-type result-params column-names-p row-names-p) "Evaluate BODY in SESSION. If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (case result-type (value diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el index d95829c7f7..a3c5e3db95 100644 --- a/lisp/org/ob-asymptote.el +++ b/lisp/org/ob-asymptote.el @@ -88,7 +88,7 @@ Asymptote does not support sessions" (error "Asymptote does not support sessions")) (defun org-babel-variable-assignments:asymptote (params) - "Return list of asymptote statements assigning the block's variables" + "Return list of asymptote statements assigning the block's variables." (mapcar #'org-babel-asymptote-var-to-asymptote (mapcar #'cdr (org-babel-get-header params :var)))) @@ -128,7 +128,7 @@ a variable of the same value." DATA is a list. Return type as a symbol. The type is `string' if any element in DATA is -a string. Otherwise, it is either `real', if some elements are +a string. Otherwise, it is either `real', if some elements are floats, or `int'." (let* ((type 'int) find-type ; for byte-compiler diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el index 682d802c11..6e139966ee 100644 --- a/lisp/org/ob-awk.el +++ b/lisp/org/ob-awk.el @@ -33,6 +33,7 @@ ;;; Code: (require 'ob) (require 'ob-eval) +(require 'org-compat) (eval-when-compile (require 'cl)) (declare-function org-babel-ref-resolve "ob-ref" (ref)) @@ -96,13 +97,13 @@ called by `org-babel-execute-src-block'" (defun org-babel-awk-var-to-awk (var &optional sep) "Return a printed value of VAR suitable for parsing with awk." - (flet ((echo-var (v) (if (stringp v) v (format "%S" v)))) + (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) (cond ((and (listp var) (listp (car var))) - (orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var))) + (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) ((listp var) - (mapconcat #'echo-var var "\n")) - (t (echo-var var))))) + (mapconcat echo-var var "\n")) + (t (funcall echo-var var))))) (defun org-babel-awk-table-or-string (results) "If the results look like a table, then convert them into an diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el index f8ad7e3374..c79d0b5d1b 100644 --- a/lisp/org/ob-calc.el +++ b/lisp/org/ob-calc.el @@ -71,16 +71,16 @@ (cond ((numberp res) res) ((math-read-number res) (math-read-number res)) - ((listp res) (error "calc error \"%s\" on input \"%s\"" + ((listp res) (error "Calc error \"%s\" on input \"%s\"" (cadr res) line)) (t (replace-regexp-in-string - "'\\[" "[" + "'" "" (calc-eval (math-evaluate-expr ;; resolve user variables, calc built in ;; variables are handled automatically ;; upstream by calc - (mapcar #'ob-calc-maybe-resolve-var + (mapcar #'org-babel-calc-maybe-resolve-var ;; parse line into calc objects (car (math-read-exprs line))))))))) (calc-eval line)))))))) @@ -91,14 +91,14 @@ (calc-eval (calc-top 1))))) (defvar var-syms) ; Dynamically scoped from org-babel-execute:calc -(defun ob-calc-maybe-resolve-var (el) +(defun org-babel-calc-maybe-resolve-var (el) (if (consp el) (if (and (equal 'var (car el)) (member (cadr el) var-syms)) (progn (calc-recall (cadr el)) (prog1 (calc-top 1) (calc-pop 1))) - (mapcar #'ob-calc-maybe-resolve-var el)) + (mapcar #'org-babel-calc-maybe-resolve-var el)) el)) (provide 'ob-calc) diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index 69d3db86de..f3894047c7 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -45,7 +45,7 @@ (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) (defvar org-babel-default-header-args:clojure '()) -(defvar org-babel-header-arg-names:clojure '(package)) +(defvar org-babel-header-args:clojure '((package . :any))) (defun org-babel-expand-body:clojure (body params) "Expand BODY according to PARAMS, return the expanded body." diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index a0712b90f3..ba3b99d5d7 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -31,6 +31,7 @@ ;;; Code: (require 'ob) +(require 'org-compat) (require 'comint) (eval-when-compile (require 'cl)) (declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) @@ -50,7 +51,7 @@ executed inside the protection of `save-excursion' and `(save-excursion (save-match-data (unless (org-babel-comint-buffer-livep ,buffer) - (error "buffer %s doesn't exist or has no process" ,buffer)) + (error "Buffer %s does not exist or has no process" ,buffer)) (set-buffer ,buffer) ,@body))) (def-edebug-spec org-babel-comint-in-buffer (form body)) @@ -74,39 +75,40 @@ or user `keyboard-quit' during execution of body." (full-body (cadr (cdr (cdr meta))))) `(org-babel-comint-in-buffer ,buffer (let ((string-buffer "") dangling-text raw) - (flet ((my-filt (text) - (setq string-buffer (concat string-buffer text)))) - ;; setup filter - (add-hook 'comint-output-filter-functions 'my-filt) - (unwind-protect - (progn - ;; got located, and save dangling text - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (let ((start (point)) - (end (point-max))) - (setq dangling-text (buffer-substring start end)) - (delete-region start end)) - ;; pass FULL-BODY to process - ,@body - ;; wait for end-of-evaluation indicator - (while (progn - (goto-char comint-last-input-end) - (not (save-excursion - (and (re-search-forward - (regexp-quote ,eoe-indicator) nil t) - (re-search-forward - comint-prompt-regexp nil t))))) - (accept-process-output (get-buffer-process (current-buffer))) - ;; thought the following this would allow async - ;; background running, but I was wrong... - ;; (run-with-timer .5 .5 'accept-process-output - ;; (get-buffer-process (current-buffer))) - ) - ;; replace cut dangling text - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert dangling-text)) - ;; remove filter - (remove-hook 'comint-output-filter-functions 'my-filt))) + ;; setup filter + (setq comint-output-filter-functions + (cons (lambda (text) (setq string-buffer (concat string-buffer text))) + comint-output-filter-functions)) + (unwind-protect + (progn + ;; got located, and save dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (let ((start (point)) + (end (point-max))) + (setq dangling-text (buffer-substring start end)) + (delete-region start end)) + ;; pass FULL-BODY to process + ,@body + ;; wait for end-of-evaluation indicator + (while (progn + (goto-char comint-last-input-end) + (not (save-excursion + (and (re-search-forward + (regexp-quote ,eoe-indicator) nil t) + (re-search-forward + comint-prompt-regexp nil t))))) + (accept-process-output (get-buffer-process (current-buffer))) + ;; thought the following this would allow async + ;; background running, but I was wrong... + ;; (run-with-timer .5 .5 'accept-process-output + ;; (get-buffer-process (current-buffer))) + ) + ;; replace cut dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert dangling-text)) + ;; remove filter + (setq comint-output-filter-functions + (cdr comint-output-filter-functions))) ;; remove echo'd FULL-BODY from input (if (and ,remove-echo ,full-body (string-match @@ -142,10 +144,10 @@ statement (not large blocks of code)." (defun org-babel-comint-eval-invisibly-and-wait-for-file (buffer file string &optional period) "Evaluate STRING in BUFFER invisibly. -Don't return until FILE exists. Code in STRING must ensure that +Don't return until FILE exists. Code in STRING must ensure that FILE exists at end of evaluation." (unless (org-babel-comint-buffer-livep buffer) - (error "buffer %s doesn't exist or has no process" buffer)) + (error "Buffer %s does not exist or has no process" buffer)) (if (file-exists-p file) (delete-file file)) (process-send-string (get-buffer-process buffer) @@ -154,7 +156,7 @@ FILE exists at end of evaluation." (if (file-remote-p default-directory) (let (v) (with-parsed-tramp-file-name default-directory nil - (tramp-flush-directory-property v "")))) + (tramp-flush-directory-property v "")))) (while (not (file-exists-p file)) (sit-for (or period 0.25)))) (provide 'ob-comint) diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el index a9ac1cfa20..6259ebc0c2 100644 --- a/lisp/org/ob-css.el +++ b/lisp/org/ob-css.el @@ -34,7 +34,7 @@ (defun org-babel-execute:css (body params) "Execute a block of CSS code. This function is called by `org-babel-execute-src-block'." - body) + body) (defun org-babel-prep-session:css (session params) "Return an error if the :session header argument is set. diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el index 57ae4b9475..ae7794b659 100644 --- a/lisp/org/ob-ditaa.el +++ b/lisp/org/ob-ditaa.el @@ -34,15 +34,28 @@ ;; 3) we are adding the "file" and "cmdline" header arguments ;; ;; 4) there are no variables (at least for now) +;; +;; 5) it depends on a variable defined in org-exp-blocks (namely +;; `org-ditaa-jar-path') so be sure you have org-exp-blocks loaded ;;; Code: (require 'ob) +(defvar org-ditaa-jar-path) ;; provided by org-exp-blocks + (defvar org-babel-default-header-args:ditaa - '((:results . "file") (:exports . "results") (:java . "-Dfile.encoding=UTF-8")) + '((:results . "file") + (:exports . "results") + (:java . "-Dfile.encoding=UTF-8")) "Default arguments for evaluating a ditaa source block.") -(defvar org-ditaa-jar-path) +(defcustom org-ditaa-jar-option "-jar" + "Option for the ditaa jar file. +Do not leave leading or trailing spaces in this string." + :group 'org-babel + :version "24.1" + :type 'string) + (defun org-babel-execute:ditaa (body params) "Execute a block of Ditaa code with org-babel. This function is called by `org-babel-execute-src-block'." @@ -55,7 +68,7 @@ This function is called by `org-babel-execute-src-block'." (cmdline (cdr (assoc :cmdline params))) (java (cdr (assoc :java params))) (in-file (org-babel-temp-file "ditaa-")) - (cmd (concat "java " java " -jar " + (cmd (concat "java " java " " org-ditaa-jar-option " " (shell-quote-argument (expand-file-name org-ditaa-jar-path)) " " cmdline diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el index 1d4b7da7e1..99748b0a95 100644 --- a/lisp/org/ob-dot.el +++ b/lisp/org/ob-dot.el @@ -64,7 +64,8 @@ "Execute a block of Dot code with org-babel. This function is called by `org-babel-execute-src-block'." (let* ((result-params (cdr (assoc :result-params params))) - (out-file (cdr (assoc :file params))) + (out-file (cdr (or (assoc :file params) + (error "You need to specify a :file parameter")))) (cmdline (or (cdr (assoc :cmdline params)) (format "-T%s" (file-name-extension out-file)))) (cmd (or (cdr (assoc :cmd params)) "dot")) diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index c8af606200..d83ca246a8 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -41,12 +41,12 @@ (result-params (cdr (assoc :result-params params))) (print-level nil) (print-length nil) (body (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) - (format "%S" (print `(,(car var) ',(cdr var))))) - vars "\n ") - ")\n" body "\n)") + (concat "(let (" + (mapconcat + (lambda (var) + (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body "\n)") (concat body "\n")))) (if (or (member "code" result-params) (member "pp" result-params)) diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el index 0ac6ab004b..ddad067a56 100644 --- a/lisp/org/ob-eval.el +++ b/lisp/org/ob-eval.el @@ -64,8 +64,8 @@ STDERR with `org-babel-eval-error-notify'." (buffer-string))) (defun org-babel-shell-command-on-region (start end command - &optional output-buffer replace - error-buffer display-error-buffer) + &optional output-buffer replace + error-buffer display-error-buffer) "Execute COMMAND in an inferior shell with region as input. Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region' diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 0f0cca3d94..d17fd3475a 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -32,10 +32,18 @@ (defvar org-current-export-file) (defvar org-babel-lob-one-liner-regexp) (defvar org-babel-ref-split-regexp) +(defvar org-list-forbidden-blocks) + (declare-function org-babel-lob-get-info "ob-lob" ()) (declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) -(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements)) +(declare-function org-heading-components "org" ()) +(declare-function org-link-search "org" (s &optional type avoid-pos stealth)) +(declare-function org-fill-template "org" (template alist)) +(declare-function org-in-verbatim-emphasis "org" ()) +(declare-function org-in-block-p "org" (names)) +(declare-function org-between-regexps-p "org" (start-re end-re &optional lim-up lim-down)) +(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements)) (org-export-blocks-add-block '(src org-babel-exp-src-block nil)) (defcustom org-export-babel-evaluate t @@ -47,28 +55,33 @@ process." :type 'boolean) (put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) +(defun org-babel-exp-get-export-buffer () + "Return the current export buffer if possible." + (cond + ((bufferp org-current-export-file) org-current-export-file) + (org-current-export-file (get-file-buffer org-current-export-file)) + ('otherwise + (error "Requested export buffer when `org-current-export-file' is nil")))) + (defmacro org-babel-exp-in-export-file (lang &rest body) (declare (indent 1)) `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang))) (heading (nth 4 (ignore-errors (org-heading-components)))) - (link (when org-current-export-file - (org-make-link-string - (if heading - (concat org-current-export-file "::" heading) - org-current-export-file)))) - (export-buffer (current-buffer)) results) - (when link + (export-buffer (current-buffer)) + (original-buffer (org-babel-exp-get-export-buffer)) results) + (when original-buffer ;; resolve parameters in the original file so that ;; headline and file-wide parameters are included, attempt ;; to go to the same heading in the original file - (set-buffer (get-file-buffer org-current-export-file)) + (set-buffer original-buffer) (save-restriction - (condition-case nil - (let ((org-link-search-inhibit-query t)) - (org-open-link-from-string link)) - (error (when heading - (goto-char (point-min)) - (re-search-forward (regexp-quote heading) nil t)))) + (when heading + (condition-case nil + (let ((org-link-search-inhibit-query t)) + (org-link-search heading)) + (error (when heading + (goto-char (point-min)) + (re-search-forward (regexp-quote heading) nil t))))) (setq results ,@body)) (set-buffer export-buffer) results))) @@ -108,15 +121,25 @@ none ----- do not display either code or results upon export" (if (boundp lang-headers) (eval lang-headers) nil) raw-params)))) (setf hash (org-babel-sha1-hash info))) - ;; expand noweb references in the original file - (setf (nth 1 info) - (if (and (cdr (assoc :noweb (nth 2 info))) - (string= "yes" (cdr (assoc :noweb (nth 2 info))))) - (org-babel-expand-noweb-references - info (get-file-buffer org-current-export-file)) - (nth 1 info))) (org-babel-exp-do-export info 'block hash))))) +(defcustom org-babel-exp-call-line-template + "" + "Template used to export call lines. +This template may be customized to include the call line name +with any export markup. The template is filled out using +`org-fill-template', and the following %keys may be used. + + line --- call line + +An example value would be \"\\n: call: %line\" to export the call line +wrapped in a verbatim environment. + +Note: the results are inserted separately after the contents of +this template." + :group 'org-babel + :type 'string) + (defvar org-babel-default-lob-header-args) (defun org-babel-exp-non-block-elements (start end) "Process inline source and call lines between START and END for export." @@ -147,7 +170,7 @@ none ----- do not display either code or results upon export" (if (and (cdr (assoc :noweb params)) (string= "yes" (cdr (assoc :noweb params)))) (org-babel-expand-noweb-references - info (get-file-buffer org-current-export-file)) + info (org-babel-exp-get-export-buffer)) (nth 1 info))) (let ((code-replacement (save-match-data (org-babel-exp-do-export @@ -163,22 +186,24 @@ none ----- do not display either code or results upon export" (inlinep (match-string 11)) (inline-start (match-end 11)) (inline-end (match-end 0)) - (rep (let ((lob-info (org-babel-lob-get-info))) - (save-match-data - (org-babel-exp-do-export - (list "emacs-lisp" "results" - (org-babel-merge-params - org-babel-default-header-args - org-babel-default-lob-header-args - (org-babel-params-from-properties) - (org-babel-parse-header-arguments - (org-babel-clean-text-properties - (concat ":var results=" - (mapconcat #'identity - (butlast lob-info) - " "))))) - "" nil (car (last lob-info))) - 'lob))))) + (results (save-match-data + (org-babel-exp-do-export + (list "emacs-lisp" "results" + (org-babel-merge-params + org-babel-default-header-args + org-babel-default-lob-header-args + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-no-properties + (concat ":var results=" + (mapconcat #'identity + (butlast lob-info) + " "))))) + "" nil (car (last lob-info))) + 'lob))) + (rep (org-fill-template + org-babel-exp-call-line-template + `(("line" . ,(nth 0 lob-info)))))) (if inlinep (save-excursion (goto-char inline-start) @@ -202,26 +227,58 @@ org-mode text." (defun org-babel-exp-do-export (info type &optional hash) "Return a string with the exported content of a code block. The function respects the value of the :exports header argument." - (flet ((silently () (let ((session (cdr (assoc :session (nth 2 info))))) - (when (not (and session (equal "none" session))) - (org-babel-exp-results info type 'silent)))) - (clean () (unless (eq type 'inline) (org-babel-remove-result info)))) + (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info))))) + (when (not (and session (equal "none" session))) + (org-babel-exp-results info type 'silent))))) + (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info))))) (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) - ('none (silently) (clean) "") - ('code (silently) (clean) (org-babel-exp-code info)) + ('none (funcall silently) (funcall clean) "") + ('code (funcall silently) (funcall clean) (org-babel-exp-code info)) ('results (org-babel-exp-results info type nil hash) "") ('both (org-babel-exp-results info type nil hash) (org-babel-exp-code info))))) +(defcustom org-babel-exp-code-template + "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC" + "Template used to export the body of code blocks. +This template may be customized to include additional information +such as the code block name, or the values of particular header +arguments. The template is filled out using `org-fill-template', +and the following %keys may be used. + + lang ------ the language of the code block + name ------ the name of the code block + body ------ the body of the code block + flags ----- the flags passed to the code block + +In addition to the keys mentioned above, every header argument +defined for the code block may be used as a key and will be +replaced with its value." + :group 'org-babel + :type 'string) + (defun org-babel-exp-code (info) "Return the original code block formatted for export." + (setf (nth 1 info) + (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info)))) + (replace-regexp-in-string + (org-babel-noweb-wrap) "" (nth 1 info)) + (if (org-babel-noweb-p (nth 2 info) :export) + (org-babel-expand-noweb-references + info (org-babel-exp-get-export-buffer)) + (nth 1 info)))) (org-fill-template - "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC" + org-babel-exp-code-template `(("lang" . ,(nth 0 info)) - ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info))) ("body" . ,(if (string= (nth 0 info) "org") (replace-regexp-in-string "^" "," (nth 1 info)) - (nth 1 info)))))) + (nth 1 info))) + ,@(mapcar (lambda (pair) + (cons (substring (symbol-name (car pair)) 1) + (format "%S" (cdr pair)))) + (nth 2 info)) + ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info))) + ("name" . ,(or (nth 4 info) ""))))) (defun org-babel-exp-results (info type &optional silent hash) "Evaluate and return the results of the current code block for export. @@ -232,11 +289,16 @@ inhibit insertion of results into the buffer." (when (and org-export-babel-evaluate (not (and hash (equal hash (org-babel-current-result-hash))))) (let ((lang (nth 0 info)) - (body (nth 1 info))) + (body (if (org-babel-noweb-p (nth 2 info) :eval) + (org-babel-expand-noweb-references + info (org-babel-exp-get-export-buffer)) + (nth 1 info))) + (info (copy-sequence info))) ;; skip code blocks which we can't evaluate (when (fboundp (intern (concat "org-babel-execute:" lang))) (org-babel-eval-wipe-error-buffer) (prog1 nil + (setf (nth 1 info) body) (setf (nth 2 info) (org-babel-exp-in-export-file lang (org-babel-process-params diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el index fe38edbce1..7f2d1a8054 100644 --- a/lisp/org/ob-fortran.el +++ b/lisp/org/ob-fortran.el @@ -8,7 +8,7 @@ ;; Homepage: http://orgmode.org ;; This file is part of GNU Emacs. - +;; ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or @@ -46,7 +46,7 @@ (defun org-babel-execute:fortran (body params) "This function should only be called by `org-babel-execute:fortran'" (let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90")) - (tmp-bin-file (org-babel-temp-file "fortran-bin-")) + (tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext)) (cmdline (cdr (assoc :cmdline params))) (flags (cdr (assoc :flags params))) (full-body (org-babel-expand-body:fortran body params)) @@ -72,8 +72,8 @@ (org-babel-pick-name (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) (defun org-babel-expand-body:fortran (body params) "Expand a block of fortran or fortran code with org-babel according to @@ -85,42 +85,42 @@ it's header arguments." (defines (org-babel-read (or (cdr (assoc :defines params)) (org-babel-read (org-entry-get nil "defines" t)))))) - (mapconcat 'identity - (list - ;; includes - (mapconcat - (lambda (inc) (format "#include %s" inc)) - (if (listp includes) includes (list includes)) "\n") - ;; defines - (mapconcat - (lambda (inc) (format "#define %s" inc)) - (if (listp defines) defines (list defines)) "\n") - ;; body - (if main-p - (org-babel-fortran-ensure-main-wrap - (concat - ;; variables - (mapconcat 'org-babel-fortran-var-to-fortran vars "\n") - body) params) - body) "\n") "\n"))) + (mapconcat 'identity + (list + ;; includes + (mapconcat + (lambda (inc) (format "#include %s" inc)) + (if (listp includes) includes (list includes)) "\n") + ;; defines + (mapconcat + (lambda (inc) (format "#define %s" inc)) + (if (listp defines) defines (list defines)) "\n") + ;; body + (if main-p + (org-babel-fortran-ensure-main-wrap + (concat + ;; variables + (mapconcat 'org-babel-fortran-var-to-fortran vars "\n") + body) params) + body) "\n") "\n"))) (defun org-babel-fortran-ensure-main-wrap (body params) "Wrap body in a \"program ... end program\" block if none exists." (if (string-match "^[ \t]*program[ \t]*.*" (capitalize body)) - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (if vars (error "cannot use :vars if 'program' statement is present")) - body) + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (if vars (error "Cannot use :vars if 'program' statement is present")) + body) (format "program main\n%s\nend program main\n" body))) (defun org-babel-prep-session:fortran (session params) "This function does nothing as fortran is a compiled language with no support for sessions" - (error "fortran is a compiled languages -- no support for sessions")) + (error "Fortran is a compiled languages -- no support for sessions")) (defun org-babel-load-session:fortran (session body params) "This function does nothing as fortran is a compiled language with no support for sessions" - (error "fortran is a compiled languages -- no support for sessions")) + (error "Fortran is a compiled languages -- no support for sessions")) ;; helper functions @@ -146,15 +146,15 @@ of the same value." (length val) var val)) ((listp val) (format "real, parameter :: %S(%d) = %s\n" - var (length val) (ob-fortran-transform-list val))) + var (length val) (org-babel-fortran-transform-list val))) (t (error (format "the type of parameter %s is not supported by ob-fortran" var)))))) -(defun ob-fortran-transform-list (val) +(defun org-babel-fortran-transform-list (val) "Return a fortran representation of enclose syntactic lists." (if (listp val) - (concat "(/" (mapconcat #'ob-fortran-transform-list val ", ") "/)") + (concat "(/" (mapconcat #'org-babel-fortran-transform-list val ", ") "/)") (format "%S" val))) (provide 'ob-fortran) diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index 5d07366e77..55c415320d 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -87,46 +87,45 @@ code." (timefmt (plist-get params :timefmt)) (time-ind (or (plist-get params :timeind) (when timefmt 1))) + (add-to-body (lambda (text) (setq body (concat text "\n" body)))) output) - (flet ((add-to-body (text) - (setq body (concat text "\n" body)))) - ;; append header argument settings to body - (when title (add-to-body (format "set title '%s'" title))) ;; title - (when lines (mapc (lambda (el) (add-to-body el)) lines)) ;; line - (when sets - (mapc (lambda (el) (add-to-body (format "set %s" el))) sets)) - (when x-labels - (add-to-body - (format "set xtics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) - x-labels ", ")))) - (when y-labels - (add-to-body - (format "set ytics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) - y-labels ", ")))) - (when time-ind - (add-to-body "set xdata time") - (add-to-body (concat "set timefmt \"" - (or timefmt - "%Y-%m-%d-%H:%M:%S") "\""))) - (when out-file (add-to-body (format "set output \"%s\"" out-file))) - (when term (add-to-body (format "set term %s" term))) - ;; insert variables into code body: this should happen last - ;; placing the variables at the *top* of the code in case their - ;; values are used later - (add-to-body (mapconcat #'identity - (org-babel-variable-assignments:gnuplot params) - "\n")) - ;; replace any variable names preceded by '$' with the actual - ;; value of the variable - (mapc (lambda (pair) - (setq body (replace-regexp-in-string - (format "\\$%s" (car pair)) (cdr pair) body))) - vars)) - body))) + ;; append header argument settings to body + (when title (funcall add-to-body (format "set title '%s'" title))) ;; title + (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) ;; line + (when sets + (mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets)) + (when x-labels + (funcall add-to-body + (format "set xtics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + x-labels ", ")))) + (when y-labels + (funcall add-to-body + (format "set ytics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + y-labels ", ")))) + (when time-ind + (funcall add-to-body "set xdata time") + (funcall add-to-body (concat "set timefmt \"" + (or timefmt + "%Y-%m-%d-%H:%M:%S") "\""))) + (when out-file (funcall add-to-body (format "set output \"%s\"" out-file))) + (when term (funcall add-to-body (format "set term %s" term))) + ;; insert variables into code body: this should happen last + ;; placing the variables at the *top* of the code in case their + ;; values are used later + (funcall add-to-body (mapconcat #'identity + (org-babel-variable-assignments:gnuplot params) + "\n")) + ;; replace any variable names preceded by '$' with the actual + ;; value of the variable + (mapc (lambda (pair) + (setq body (replace-regexp-in-string + (format "\\$%s" (car pair)) (cdr pair) body))) + vars)) + body)) (defun org-babel-execute:gnuplot (body params) "Execute a block of Gnuplot code. @@ -183,7 +182,7 @@ This function is called by `org-babel-execute-src-block'." buffer))) (defun org-babel-variable-assignments:gnuplot (params) - "Return list of gnuplot statements assigning the block's variables" + "Return list of gnuplot statements assigning the block's variables." (mapcar (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) (org-babel-gnuplot-process-vars params))) diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index 53c5532975..1588f99f1e 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -125,12 +125,12 @@ then create one. Return the initialized session." (current-buffer)))) (defun org-babel-variable-assignments:haskell (params) - "Return list of haskell statements assigning the block's variables" + "Return list of haskell statements assigning the block's variables." (mapcar (lambda (pair) (format "let %s = %s" (car pair) (org-babel-haskell-var-to-haskell (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (mapcar #'cdr (org-babel-get-header params :var)))) (defun org-babel-haskell-table-or-string (results) "Convert RESULTS to an Emacs-lisp table or string. diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el new file mode 100644 index 0000000000..2064826605 --- /dev/null +++ b/lisp/org/ob-io.el @@ -0,0 +1,122 @@ +;;; ob-io.el --- org-babel functions for Io evaluation + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Andrzej Lichnerowicz +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; Currently only supports the external execution. No session support yet. +;; :results output -- runs in scripting mode +;; :results output repl -- runs in repl mode + +;;; Requirements: +;; - Io language :: http://iolanguage.org/ +;; - Io major mode :: Can be installed from Io sources +;; https://github.com/stevedekorte/io/blob/master/extras/SyntaxHighlighters/Emacs/io-mode.el + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(add-to-list 'org-babel-tangle-lang-exts '("io" . "io")) +(defvar org-babel-default-header-args:io '()) +(defvar org-babel-io-command "io" + "Name of the command to use for executing Io code.") + + +(defun org-babel-execute:io (body params) + "Execute a block of Io code with org-babel. This function is +called by `org-babel-execute-src-block'" + (message "executing Io source code block") + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-io-initiate-session (nth 0 processed-params))) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params)) + (result (org-babel-io-evaluate + session full-body result-type result-params))) + + (org-babel-reassemble-table + result + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + + +(defun org-babel-io-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + + +(defvar org-babel-io-wrapper-method + "( +%s +) asString print +") + + +(defun org-babel-io-evaluate (session body &optional result-type result-params) + "Evaluate BODY in external Io process. +If RESULT-TYPE equals 'output then return standard output as a string. +If RESULT-TYPE equals 'value then return the value of the last statement +in BODY as elisp." + (when session (error "Sessions are not (yet) supported for Io")) + (case result-type + (output + (if (member "repl" result-params) + (org-babel-eval org-babel-io-command body) + (let ((src-file (org-babel-temp-file "io-"))) + (progn (with-temp-file src-file (insert body)) + (org-babel-eval + (concat org-babel-io-command " " src-file) ""))))) + (value (let* ((src-file (org-babel-temp-file "io-")) + (wrapper (format org-babel-io-wrapper-method body))) + (with-temp-file src-file (insert wrapper)) + ((lambda (raw) + (if (member "code" result-params) + raw + (org-babel-io-table-or-string raw))) + (org-babel-eval + (concat org-babel-io-command " " src-file) "")))))) + + +(defun org-babel-prep-session:io (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "Sessions are not (yet) supported for Io")) + +(defun org-babel-io-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session. Sessions are not +supported in Io." + nil) + +(provide 'ob-io) + + + +;;; ob-io.el ends here diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index 20cad4e6b4..21381725cb 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -130,7 +130,7 @@ specifying a variable of the same value." session)) (defun org-babel-variable-assignments:js (params) - "Return list of Javascript statements assigning the block's variables" + "Return list of Javascript statements assigning the block's variables." (mapcar (lambda (pair) (format "var %s=%s;" (car pair) (org-babel-js-var-to-js (cdr pair)))) @@ -152,9 +152,9 @@ then create. Return the initialized session." (sit-for .5) (org-babel-js-initiate-session session)))) ((string= "node" org-babel-js-cmd ) - (error "session evaluation with node.js is not supported")) + (error "Session evaluation with node.js is not supported")) (t - (error "sessions are only supported with mozrepl add \":cmd mozrepl\""))))) + (error "Sessions are only supported with mozrepl add \":cmd mozrepl\""))))) (provide 'ob-js) diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el index 23e8d91fec..43f673edf5 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -132,7 +132,7 @@ This function is called by `org-babel-execute-src-block'." (when (file-exists-p transient-pdf-file) (delete-file transient-pdf-file)))))) ((string-match "\\.\\([^\\.]+\\)$" out-file) - (error "can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" + (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" (match-string 1 out-file)))) nil) ;; signal that output has already been written to file body)) diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el index a454d51e39..2635730a93 100644 --- a/lisp/org/ob-ledger.el +++ b/lisp/org/ob-ledger.el @@ -52,8 +52,8 @@ called by `org-babel-execute-src-block'." (out-file (org-babel-temp-file "ledger-output-"))) (with-temp-file in-file (insert body)) (message "%s" (concat "ledger" - " -f " (org-babel-process-file-name in-file) - " " cmdline)) + " -f " (org-babel-process-file-name in-file) + " " cmdline)) (with-output-to-string (shell-command (concat "ledger" " -f " (org-babel-process-file-name in-file) diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el index b3e77f32e5..e19b0c34c6 100644 --- a/lisp/org/ob-lilypond.el +++ b/lisp/org/ob-lilypond.el @@ -23,10 +23,14 @@ ;;; Commentary: -;; Installation / usage info, and examples are available at -;; https://github.com/mjago/ob-lilypond +;; Installation, ob-lilypond documentation, and examples are available at +;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html +;; +;; Lilypond documentation can be found at +;; http://lilypond.org/manuals.html ;;; Code: + (require 'ob) (require 'ob-eval) (require 'ob-tangle) @@ -36,7 +40,9 @@ (add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly")) (defvar org-babel-default-header-args:lilypond '() - "Default header arguments for js code blocks.") + "Default header arguments for lilypond code blocks. +NOTE: The arguments are determined at lilypond compile time. +See (ly-set-header-args)") (defvar ly-compile-post-tangle t "Following the org-babel-tangle (C-c C-v t) command, @@ -48,14 +54,14 @@ Default value is t") (defvar ly-display-pdf-post-tangle t "Following a successful LilyPond compilation ly-display-pdf-post-tangle determines whether to automate the -drawing / redrawing of the resultant pdf. If the value is nil, -the pdf is not automatically redrawn. Default value is t") +drawing / redrawing of the resultant pdf. If the value is nil, +the pdf is not automatically redrawn. Default value is t") (defvar ly-play-midi-post-tangle t "Following a successful LilyPond compilation ly-play-midi-post-tangle determines whether to automate the -playing of the resultant midi file. If the value is nil, -the midi file is not automatically played. Default value is t") +playing of the resultant midi file. If the value is nil, +the midi file is not automatically played. Default value is t") (defvar ly-OSX-ly-path "/Applications/lilypond.app/Contents/Resources/bin/lilypond") @@ -71,24 +77,28 @@ the midi file is not automatically played. Default value is t") (defvar ly-w32-midi-path "") (defvar ly-gen-png nil -"Image generation (png) can be turned on by default by setting + "Image generation (png) can be turned on by default by setting LY-GEN-PNG to t") (defvar ly-gen-svg nil -"Image generation (SVG) can be turned on by default by setting + "Image generation (SVG) can be turned on by default by setting LY-GEN-SVG to t") (defvar ly-gen-html nil -"HTML generation can be turned on by default by setting + "HTML generation can be turned on by default by setting LY-GEN-HTML to t") +(defvar ly-gen-pdf nil + "PDF generation can be turned on by default by setting +LY-GEN-PDF to t") + (defvar ly-use-eps nil -"You can force the compiler to use the EPS backend by setting + "You can force the compiler to use the EPS backend by setting LY-USE-EPS to t") (defvar ly-arrange-mode nil "Arrange mode is turned on by setting LY-ARRANGE-MODE -to t. In Arrange mode the following settings are altered +to t. In Arrange mode the following settings are altered from default... :tangle yes, :noweb yes :results silent :comments yes. @@ -97,7 +107,6 @@ blocks") (defun org-babel-expand-body:lilypond (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) (mapc (lambda (pair) @@ -117,7 +126,6 @@ Depending on whether we are in arrange mode either: 1. Attempt to execute lilypond block according to header settings (This is the default basic mode) 2. Tangle all lilypond blocks and process the result (arrange mode)" - (ly-set-header-args ly-arrange-mode) (if ly-arrange-mode (ly-tangle) @@ -125,16 +133,14 @@ Depending on whether we are in arrange mode either: (defun ly-tangle () "ob-lilypond specific tangle, attempts to invoke -=ly-execute-tangled-ly= if tangle is successful. Also passes +=ly-execute-tangled-ly= if tangle is successful. Also passes specific arguments to =org-babel-tangle=" - (interactive) (if (org-babel-tangle nil "yes" "lilypond") (ly-execute-tangled-ly) nil)) (defun ly-process-basic (body params) - "Execute a lilypond block in basic mode" - + "Execute a lilypond block in basic mode." (let* ((result-params (cdr (assoc :result-params params))) (out-file (cdr (assoc :file params))) (cmdline (or (cdr (assoc :cmdline params)) @@ -143,7 +149,6 @@ specific arguments to =org-babel-tangle=" (with-temp-file in-file (insert (org-babel-expand-body:generic body params))) - (org-babel-eval (concat (ly-determine-ly-path) @@ -155,18 +160,15 @@ specific arguments to =org-babel-tangle=" (file-name-sans-extension out-file) " " cmdline - in-file) "") - ) nil) + in-file) "")) nil) (defun org-babel-prep-session:lilypond (session params) "Return an error because LilyPond exporter does not support sessions." - (error "Sorry, LilyPond does not currently support sessions!")) (defun ly-execute-tangled-ly () "Compile result of block tangle with lilypond. If error in compilation, attempt to mark the error in lilypond org file" - (when ly-compile-post-tangle (let ((ly-tangled-file (ly-switch-extension (buffer-file-name) ".lilypond")) @@ -193,24 +195,25 @@ If error in compilation, attempt to mark the error in lilypond org file" (defun ly-compile-lilyfile (file-name &optional test) "Compile lilypond file and check for compile errors FILE-NAME is full path to lilypond (.ly) file" - (message "Compiling LilyPond...") (let ((arg-1 (ly-determine-ly-path)) ;program (arg-2 nil) ;infile (arg-3 "*lilypond*") ;buffer (arg-4 t) ;display - (arg-5 (if ly-gen-png "--png" "")) ;&rest... - (arg-6 (if ly-gen-html "--html" "")) - (arg-7 (if ly-use-eps "-dbackend=eps" "")) - (arg-8 (if ly-gen-svg "-dbackend=svg" "")) - (arg-9 (concat "--output=" (file-name-sans-extension file-name))) - (arg-10 file-name)) + (arg-4 t) ;display + (arg-5 (if ly-gen-png "--png" "")) ;&rest... + (arg-6 (if ly-gen-html "--html" "")) + (arg-7 (if ly-gen-pdf "--pdf" "")) + (arg-8 (if ly-use-eps "-dbackend=eps" "")) + (arg-9 (if ly-gen-svg "-dbackend=svg" "")) + (arg-10 (concat "--output=" (file-name-sans-extension file-name))) + (arg-11 file-name)) (if test - `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 - ,arg-6 ,arg-7 ,arg-8 ,arg-9 ,arg-10) + `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6 + ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11) (call-process - arg-1 arg-2 arg-3 arg-4 arg-5 - arg-6 arg-7 arg-8 arg-9 arg-10)))) + arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 + arg-7 arg-8 arg-9 arg-10 arg-11)))) (defun ly-check-for-compile-error (file-name &optional test) "Check for compile error. @@ -229,7 +232,6 @@ nil as file-name since it is unused in this context" (defun ly-process-compile-error (file-name) "Process the compilation error that has occurred. FILE-NAME is full path to lilypond file" - (let ((line-num (ly-parse-line-num))) (let ((error-lines (ly-parse-error-line file-name line-num))) (ly-mark-error-line file-name error-lines) @@ -239,7 +241,6 @@ FILE-NAME is full path to lilypond file" "Mark the erroneous lines in the lilypond org buffer. FILE-NAME is full path to lilypond file. LINE is the erroneous line" - (switch-to-buffer-other-window (concat (file-name-nondirectory (ly-switch-extension file-name ".org")))) @@ -255,7 +256,6 @@ LINE is the erroneous line" (defun ly-parse-line-num (&optional buffer) "Extract error line number." - (when buffer (set-buffer buffer)) (let ((start @@ -280,7 +280,6 @@ LINE is the erroneous line" "Extract the erroneous line from the tangled .ly file FILE-NAME is full path to lilypond file. LINENO is the number of the erroneous line" - (with-temp-buffer (insert-file-contents (ly-switch-extension file-name ".ly") nil nil nil t) @@ -295,7 +294,6 @@ LINENO is the number of the erroneous line" "Attempt to display the generated pdf file FILE-NAME is full path to lilypond file If TEST is non-nil, the shell command is returned and is not run" - (when ly-display-pdf-post-tangle (let ((pdf-file (ly-switch-extension file-name ".pdf"))) (if (file-exists-p pdf-file) @@ -303,14 +301,17 @@ If TEST is non-nil, the shell command is returned and is not run" (concat (ly-determine-pdf-path) " " pdf-file))) (if test cmd-string - (shell-command cmd-string))) - (message "No pdf file generated so can't display!"))))) + (start-process + "\"Audition pdf\"" + "*lilypond*" + (ly-determine-pdf-path) + pdf-file))) + (message "No pdf file generated so can't display!"))))) (defun ly-attempt-to-play-midi (file-name &optional test) "Attempt to play the generated MIDI file FILE-NAME is full path to lilypond file If TEST is non-nil, the shell command is returned and is not run" - (when ly-play-midi-post-tangle (let ((midi-file (ly-switch-extension file-name ".midi"))) (if (file-exists-p midi-file) @@ -318,13 +319,16 @@ If TEST is non-nil, the shell command is returned and is not run" (concat (ly-determine-midi-path) " " midi-file))) (if test cmd-string - (shell-command cmd-string))) + (start-process + "\"Audition midi\"" + "*lilypond*" + (ly-determine-midi-path) + midi-file))) (message "No midi file generated so can't play!"))))) (defun ly-determine-ly-path (&optional test) "Return correct path to ly binary depending on OS If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type (or test system-type))) (cond ((string= sys-type "darwin") @@ -336,7 +340,6 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" (defun ly-determine-pdf-path (&optional test) "Return correct path to pdf viewer depending on OS If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type (or test system-type))) (cond ((string= sys-type "darwin") @@ -348,7 +351,6 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" (defun ly-determine-midi-path (&optional test) "Return correct path to midi player depending on OS If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type (or test test system-type))) (cond ((string= sys-type "darwin") @@ -358,8 +360,7 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" (t ly-nix-midi-path)))) (defun ly-toggle-midi-play () - "Toggle whether midi will be played following a successful compilation" - + "Toggle whether midi will be played following a successful compilation." (interactive) (setq ly-play-midi-post-tangle (not ly-play-midi-post-tangle)) @@ -368,8 +369,7 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" "ENABLED." "DISABLED.")))) (defun ly-toggle-pdf-display () - "Toggle whether pdf will be displayed following a successful compilation" - + "Toggle whether pdf will be displayed following a successful compilation." (interactive) (setq ly-display-pdf-post-tangle (not ly-display-pdf-post-tangle)) @@ -378,26 +378,28 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" "ENABLED." "DISABLED.")))) (defun ly-toggle-png-generation () - "Toggle whether png image will be generated by compilation" - + "Toggle whether png image will be generated by compilation." (interactive) - (setq ly-gen-png - (not ly-gen-png)) + (setq ly-gen-png (not ly-gen-png)) (message (concat "PNG image generation has been " (if ly-gen-png "ENABLED." "DISABLED.")))) (defun ly-toggle-html-generation () - "Toggle whether html will be generated by compilation" - + "Toggle whether html will be generated by compilation." (interactive) - (setq ly-gen-html - (not ly-gen-html)) + (setq ly-gen-html (not ly-gen-html)) (message (concat "HTML generation has been " (if ly-gen-html "ENABLED." "DISABLED.")))) -(defun ly-toggle-arrange-mode () - "Toggle whether in Arrange mode or Basic mode" +(defun ly-toggle-pdf-generation () + "Toggle whether pdf will be generated by compilation." + (interactive) + (setq ly-gen-pdf (not ly-gen-pdf)) + (message (concat "PDF generation has been " + (if ly-gen-pdf "ENABLED." "DISABLED.")))) +(defun ly-toggle-arrange-mode () + "Toggle whether in Arrange mode or Basic mode." (interactive) (setq ly-arrange-mode (not ly-arrange-mode)) @@ -406,18 +408,18 @@ If TEST is non-nil, it contains a simulation of the OS for test purposes" (defun ly-switch-extension (file-name ext) "Utility command to swap current FILE-NAME extension with EXT" - (concat (file-name-sans-extension file-name) ext)) (defun ly-get-header-args (mode) "Default arguments to use when evaluating a lilypond -source block. These depend upon whether we are in arrange -mode i.e. ARRANGE-MODE is t" +source block. These depend upon whether we are in arrange +mode i.e. ARRANGE-MODE is t" (cond (mode '((:tangle . "yes") (:noweb . "yes") (:results . "silent") + (:cache . "yes") (:comments . "yes"))) (t '((:results . "file") @@ -431,6 +433,4 @@ dependent on LY-ARRANGE-MODE" (provide 'ob-lilypond) - - ;;; ob-lilypond.el ends here diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index 8fb6721969..71e80bdf9e 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -41,7 +41,7 @@ (add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp")) (defvar org-babel-default-header-args:lisp '()) -(defvar org-babel-header-arg-names:lisp '(package)) +(defvar org-babel-header-args:lisp '((package . :any))) (defcustom org-babel-lisp-dir-fmt "(let ((*default-pathname-defaults* #P%S)) %%s)" @@ -85,8 +85,8 @@ current directory string." (insert (org-babel-expand-body:lisp body params)) (slime-eval `(swank:eval-and-grab-output ,(let ((dir (if (assoc :dir params) - (cdr (assoc :dir params)) - default-directory))) + (cdr (assoc :dir params)) + default-directory))) (format (if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)") (buffer-substring-no-properties diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index 7828f1d51c..6aafe34dcd 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -97,38 +97,49 @@ if so then run the appropriate source block from the Library." ;;;###autoload (defun org-babel-lob-get-info () "Return a Library of Babel function call as a string." - (flet ((nonempty (a b) - (let ((it (match-string a))) - (if (= (length it) 0) (match-string b) it)))) - (let ((case-fold-search t)) - (save-excursion - (beginning-of-line 1) - (when (looking-at org-babel-lob-one-liner-regexp) - (append - (mapcar #'org-babel-clean-text-properties - (list - (format "%s%s(%s)%s" - (nonempty 3 12) - (if (not (= 0 (length (nonempty 5 14)))) - (concat "[" (nonempty 5 14) "]") "") - (or (nonempty 7 16) "") - (or (nonempty 8 19) "")) - (nonempty 9 18))) - (list (length (if (= (length (match-string 12)) 0) - (match-string 2) (match-string 11)))))))))) + (let ((case-fold-search t) + (nonempty (lambda (a b) + (let ((it (match-string a))) + (if (= (length it) 0) (match-string b) it))))) + (save-excursion + (beginning-of-line 1) + (when (looking-at org-babel-lob-one-liner-regexp) + (append + (mapcar #'org-no-properties + (list + (format "%s%s(%s)%s" + (funcall nonempty 3 12) + (if (not (= 0 (length (funcall nonempty 5 14)))) + (concat "[" (funcall nonempty 5 14) "]") "") + (or (funcall nonempty 7 16) "") + (or (funcall nonempty 8 19) "")) + (funcall nonempty 9 18))) + (list (length (if (= (length (match-string 12)) 0) + (match-string 2) (match-string 11))))))))) (defun org-babel-lob-execute (info) "Execute the lob call specified by INFO." - (let ((params (org-babel-process-params - (org-babel-merge-params - org-babel-default-header-args - (org-babel-params-from-properties) - (org-babel-parse-header-arguments - (org-babel-clean-text-properties - (concat ":var results=" - (mapconcat #'identity (butlast info) " ")))))))) - (org-babel-execute-src-block - nil (list "emacs-lisp" "results" params nil nil (nth 2 info))))) + (let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info)))) + (pre-params (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-no-properties + (concat ":var results=" + (mapconcat #'identity (butlast info) " ")))))) + (pre-info (funcall mkinfo pre-params)) + (cache? (and (cdr (assoc :cache pre-params)) + (string= "yes" (cdr (assoc :cache pre-params))))) + (new-hash (when cache? (org-babel-sha1-hash pre-info))) + (old-hash (when cache? (org-babel-current-result-hash)))) + (if (and cache? (equal new-hash old-hash)) + (save-excursion (goto-char (org-babel-where-is-src-block-result)) + (forward-line 1) + (message "%S" (org-babel-read-result))) + (prog1 (org-babel-execute-src-block + nil (funcall mkinfo (org-babel-process-params pre-params))) + ;; update the hash + (when new-hash (org-babel-set-current-result-hash new-hash)))))) (provide 'ob-lob) diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el index b092e1330e..06fa3cfe88 100644 --- a/lisp/org/ob-maxima.el +++ b/lisp/org/ob-maxima.el @@ -48,21 +48,21 @@ (defun org-babel-maxima-expand (body params) "Expand a block of Maxima code according to its header arguments." (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (mapconcat 'identity - (list - ;; graphic output - (let ((graphic-file (org-babel-maxima-graphical-output-file params))) - (if graphic-file - (format - "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);" - graphic-file) - "")) - ;; variables - (mapconcat 'org-babel-maxima-var-to-maxima vars "\n") - ;; body - body - "gnuplot_close ()$") - "\n"))) + (mapconcat 'identity + (list + ;; graphic output + (let ((graphic-file (org-babel-maxima-graphical-output-file params))) + (if graphic-file + (format + "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);" + graphic-file) + "")) + ;; variables + (mapconcat 'org-babel-maxima-var-to-maxima vars "\n") + ;; body + body + "gnuplot_close ()$") + "\n"))) (defun org-babel-execute:maxima (body params) "Execute a block of Maxima entries with org-babel. This function is @@ -70,7 +70,7 @@ called by `org-babel-execute-src-block'." (message "executing Maxima source code block") (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) (result - (let* ((cmdline (cdr (assoc :cmdline params))) + (let* ((cmdline (or (cdr (assoc :cmdline params)) "")) (in-file (org-babel-temp-file "maxima-" ".max")) (cmd (format "%s --very-quiet -r 'batchload(%S)$' %s" org-babel-maxima-command in-file cmdline))) @@ -110,8 +110,8 @@ of the same value." (setq val (symbol-name val)) (when (= (length val) 1) (setq val (string-to-char val)))) - (format "%S: %s$" var - (org-babel-maxima-elisp-to-maxima val)))) + (format "%S: %s$" var + (org-babel-maxima-elisp-to-maxima val)))) (defun org-babel-maxima-graphical-output-file (params) "Name of file to which maxima should send graphical output." diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el index b40f9a39ce..64d35457b6 100644 --- a/lisp/org/ob-mscgen.el +++ b/lisp/org/ob-mscgen.el @@ -24,7 +24,7 @@ ;;; Commentary: ;; ;; This software provides EMACS org-babel export support for message -;; sequence charts. The mscgen utility is used for processing the +;; sequence charts. The mscgen utility is used for processing the ;; sequence definition, and must therefore be installed in the system. ;; ;; Mscgen is available and documented at @@ -64,13 +64,13 @@ (defun org-babel-execute:mscgen (body params) "Execute a block of Mscgen code with Babel. This function is called by `org-babel-execute-src-block'. -Default filetype is png. Modify by setting :filetype parameter to +Default filetype is png. Modify by setting :filetype parameter to mscgen supported formats." (let* ((out-file (or (cdr (assoc :file params)) "output.png" )) (filetype (or (cdr (assoc :filetype params)) "png" ))) (unless (cdr (assoc :file params)) (error " -ERROR: no output file specified. Add \":file name.png\" to the src header")) +ERROR: no output file specified. Add \":file name.png\" to the src header")) (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) nil)) ;; signal that output has already been written to file diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el index 8d61ff37e6..d2bf36636a 100644 --- a/lisp/org/ob-ocaml.el +++ b/lisp/org/ob-ocaml.el @@ -72,7 +72,7 @@ (progn (setq out nil) line) (when (string-match re line) (progn (setq out t) nil)))) - (mapcar #'org-babel-trim (reverse raw)))))))) + (mapcar #'org-babel-trim (reverse raw)))))))) (org-babel-reassemble-table (org-babel-ocaml-parse-output (org-babel-trim clean)) (org-babel-pick-name @@ -93,7 +93,7 @@ (get-buffer tuareg-interactive-buffer-name)))) (defun org-babel-variable-assignments:ocaml (params) - "Return list of ocaml statements assigning the block's variables" + "Return list of ocaml statements assigning the block's variables." (mapcar (lambda (pair) (format "let %s = %s;;" (car pair) (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) @@ -131,11 +131,11 @@ Emacs-lisp table, otherwise return the results as a string." "Convert RESULTS into an elisp table or string. If the results look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape - (replace-regexp-in-string - "\\[|" "[" (replace-regexp-in-string - "|\\]" "]" (replace-regexp-in-string - "; " "," results))))) + (org-babel-script-escape + (replace-regexp-in-string + "\\[|" "[" (replace-regexp-in-string + "|\\]" "]" (replace-regexp-in-string + "; " "," results))))) (provide 'ob-ocaml) diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index 9e8575768d..73f25eca15 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -52,7 +52,7 @@ to a non-nil value.") (defvar org-babel-matlab-emacs-link-wrapper-method - "%s + "%s if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); else, save -ascii %s ans end @@ -110,7 +110,7 @@ end") (org-babel-prep-session:octave session params 'matlab)) (defun org-babel-variable-assignments:octave (params) - "Return list of octave statements assigning the block's variables" + "Return list of octave statements assigning the block's variables." (mapcar (lambda (pair) (format "%s=%s;" @@ -147,13 +147,13 @@ specifying a variable of the same value." (defun org-babel-matlab-initiate-session (&optional session params) "Create a matlab inferior process buffer. If there is not a current inferior-process-buffer in SESSION then -create. Return the initialized session." +create. Return the initialized session." (org-babel-octave-initiate-session session params 'matlab)) (defun org-babel-octave-initiate-session (&optional session params matlabp) "Create an octave inferior process buffer. If there is not a current inferior-process-buffer in SESSION then -create. Return the initialized session." +create. Return the initialized session." (if matlabp (require 'matlab) (require 'octave-inf)) (unless (string= session "none") (let ((session (or session @@ -225,9 +225,9 @@ value of the last statement in BODY, as elisp." (message "Waiting for Matlab Emacs Link") (while (file-exists-p wait-file) (sit-for 0.01)) "")) ;; matlab-shell-run-region doesn't seem to - ;; make *matlab* buffer contents easily - ;; available, so :results output currently - ;; won't work + ;; make *matlab* buffer contents easily + ;; available, so :results output currently + ;; won't work (org-babel-comint-with-output (session (if matlabp @@ -265,7 +265,7 @@ This removes initial blank and comment lines and then calls (org-babel-import-elisp-from-file temp-file '(16)))) (defun org-babel-octave-read-string (string) - "Strip \\\"s from around octave string" + "Strip \\\"s from around octave string." (if (string-match "^\"\\([^\000]+\\)\"$" string) (match-string 1 string) string)) diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el index d57f8b506d..64de4b2ce4 100644 --- a/lisp/org/ob-org.el +++ b/lisp/org/ob-org.el @@ -32,7 +32,7 @@ (declare-function org-export-string "org-exp" (string fmt &optional dir)) (defvar org-babel-default-header-args:org - '((:results . "raw silent") (:exports . "results")) + '((:results . "raw silent") (:exports . "code")) "Default arguments for evaluating a org source block.") (defvar org-babel-org-default-header diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el index 71e02b0505..abf0ed637d 100644 --- a/lisp/org/ob-perl.el +++ b/lisp/org/ob-perl.el @@ -47,7 +47,7 @@ This function is called by `org-babel-execute-src-block'." (result-type (cdr (assoc :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:perl params))) - (session (org-babel-perl-initiate-session session))) + (session (org-babel-perl-initiate-session session))) (org-babel-reassemble-table (org-babel-perl-evaluate session full-body result-type) (org-babel-pick-name @@ -57,10 +57,10 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-prep-session:perl (session params) "Prepare SESSION according to the header arguments in PARAMS." - (error "Sessions are not supported for Perl.")) + (error "Sessions are not supported for Perl")) (defun org-babel-variable-assignments:perl (params) - "Return list of perl statements assigning the block's variables" + "Return list of perl statements assigning the block's variables." (mapcar (lambda (pair) (format "$%s=%s;" @@ -81,8 +81,8 @@ specifying a var of the same value." (defvar org-babel-perl-buffers '(:default . nil)) (defun org-babel-perl-initiate-session (&optional session params) - "Return nil because sessions are not supported by perl" -nil) + "Return nil because sessions are not supported by perl." + nil) (defvar org-babel-perl-wrapper-method " @@ -101,7 +101,7 @@ print o join(\"\\n\", @r), \"\\n\"") If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (when session (error "Sessions are not supported for Perl.")) + (when session (error "Sessions are not supported for Perl")) (case result-type (output (org-babel-eval org-babel-perl-command body)) (value (let ((tmp-file (org-babel-temp-file "perl-"))) diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el index 06c9ab8df6..dd0704fc14 100644 --- a/lisp/org/ob-picolisp.el +++ b/lisp/org/ob-picolisp.el @@ -25,16 +25,16 @@ ;;; Commentary: ;; This library enables the use of PicoLisp in the multi-language -;; programming framework Org-Babel. PicoLisp is a minimal yet +;; programming framework Org-Babel. PicoLisp is a minimal yet ;; fascinating lisp dialect and a highly productive application ;; framework for web-based client-server applications on top of -;; object-oriented databases. A good way to learn PicoLisp is to first +;; object-oriented databases. A good way to learn PicoLisp is to first ;; read Paul Grahams essay "The hundred year language" ;; (http://www.paulgraham.com/hundred.html) and then study the various ;; documents and essays published in the PicoLisp wiki ;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some ;; GNU/Linux Distributions, and can be downloaded here: -;; http://software-lab.de/down.html. It ships with a picolisp-mode and +;; http://software-lab.de/down.html. It ships with a picolisp-mode and ;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/ ;; directory). diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el index 7da689393a..37d8b7d1ee 100644 --- a/lisp/org/ob-plantuml.el +++ b/lisp/org/ob-plantuml.el @@ -52,7 +52,7 @@ This function is called by `org-babel-execute-src-block'." (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) (out-file (or (cdr (assoc :file params)) - (error "plantuml requires a \":file\" header argument"))) + (error "PlantUML requires a \":file\" header argument"))) (cmdline (cdr (assoc :cmdline params))) (in-file (org-babel-temp-file "plantuml-")) (java (or (cdr (assoc :java params)) "")) diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index 348248f35c..71adf73073 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -44,7 +44,7 @@ (defvar org-babel-default-header-args:python '()) (defvar org-babel-python-command "python" - "Name of command for executing python code.") + "Name of command for executing Python code.") (defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python) "Preferred python mode for use in running python interactively. @@ -99,7 +99,7 @@ VARS contains resolved variable references" ;; helper functions (defun org-babel-variable-assignments:python (params) - "Return list of python statements assigning the block's variables" + "Return a list of Python statements assigning the block's variables." (mapcar (lambda (pair) (format "%s=%s" @@ -160,7 +160,7 @@ then create. Return the initialized session." (py-shell) (setq python-buffer (concat "*" bufname "*")))) (t - (error "No function available for running an inferior python."))) + (error "No function available for running an inferior Python"))) (setq org-babel-python-buffers (cons (cons session python-buffer) (assq-delete-all session org-babel-python-buffers))) @@ -190,7 +190,7 @@ open('%s', 'w').write( pprint.pformat(main()) )") (defun org-babel-python-evaluate (session body &optional result-type result-params preamble) - "Evaluate BODY as python code." + "Evaluate BODY as Python code." (if session (org-babel-python-evaluate-session session body result-type result-params) @@ -201,7 +201,7 @@ open('%s', 'w').write( pprint.pformat(main()) )") (body &optional result-type result-params preamble) "Evaluate BODY in external python process. If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." ((lambda (raw) (if (or (member "code" result-params) @@ -236,24 +236,25 @@ last statement in BODY, as elisp." (session body &optional result-type result-params) "Pass BODY to the Python process in SESSION. If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (flet ((send-wait () (comint-send-input nil t) (sleep-for 0 5)) + (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5))) (dump-last-value - (tmp-file pp) - (mapc - (lambda (statement) (insert statement) (send-wait)) - (if pp - (list - "import pprint" - (format "open('%s', 'w').write(pprint.pformat(_))" - (org-babel-process-file-name tmp-file 'noquote))) - (list (format "open('%s', 'w').write(str(_))" - (org-babel-process-file-name tmp-file 'noquote)))))) - (input-body (body) - (mapc (lambda (line) (insert line) (send-wait)) - (split-string body "[\r\n]")) - (send-wait))) + (lambda + (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (funcall send-wait)) + (if pp + (list + "import pprint" + (format "open('%s', 'w').write(pprint.pformat(_))" + (org-babel-process-file-name tmp-file 'noquote))) + (list (format "open('%s', 'w').write(str(_))" + (org-babel-process-file-name tmp-file 'noquote))))))) + (input-body (lambda (body) + (mapc (lambda (line) (insert line) (funcall send-wait)) + (split-string body "[\r\n]")) + (funcall send-wait)))) ((lambda (results) (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results) (if (or (member "code" result-params) @@ -269,25 +270,25 @@ last statement in BODY, as elisp." (butlast (org-babel-comint-with-output (session org-babel-python-eoe-indicator t body) - (input-body body) - (send-wait) (send-wait) + (funcall input-body body) + (funcall send-wait) (funcall send-wait) (insert org-babel-python-eoe-indicator) - (send-wait)) + (funcall send-wait)) 2) "\n")) (value (let ((tmp-file (org-babel-temp-file "python-"))) (org-babel-comint-with-output (session org-babel-python-eoe-indicator nil body) (let ((comint-process-echoes nil)) - (input-body body) - (dump-last-value tmp-file (member "pp" result-params)) - (send-wait) (send-wait) + (funcall input-body body) + (funcall dump-last-value tmp-file (member "pp" result-params)) + (funcall send-wait) (funcall send-wait) (insert org-babel-python-eoe-indicator) - (send-wait))) + (funcall send-wait))) (org-babel-eval-read-file tmp-file))))))) (defun org-babel-python-read-string (string) - "Strip 's from around python string" + "Strip 's from around Python string." (if (string-match "^'\\([^\000]+\\)'$" string) (match-string 1 string) string)) diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 08cb4e3a25..79861f1b78 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -120,89 +120,89 @@ the variable." (defun org-babel-ref-resolve (ref) "Resolve the reference REF and return its value." (save-window-excursion - (save-excursion - (let ((case-fold-search t) - type args new-refere new-header-args new-referent result - lob-info split-file split-ref index index-row index-col id) - ;; if ref is indexed grab the indices -- beware nested indices - (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) - (let ((str (substring ref 0 (match-beginning 0)))) - (= (org-count ?( str) (org-count ?) str)))) - (setq index (match-string 1 ref)) - (setq ref (substring ref 0 (match-beginning 0)))) - ;; assign any arguments to pass to source block - (when (string-match - "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref) - (setq new-refere (match-string 1 ref)) - (setq new-header-args (match-string 3 ref)) - (setq new-referent (match-string 5 ref)) - (when (> (length new-refere) 0) - (when (> (length new-referent) 0) - (setq args (mapcar (lambda (ref) (cons :var ref)) - (org-babel-ref-split-args new-referent)))) - (when (> (length new-header-args) 0) - (setq args (append (org-babel-parse-header-arguments - new-header-args) args))) - (setq ref new-refere))) - (when (string-match "^\\(.+\\):\\(.+\\)$" ref) - (setq split-file (match-string 1 ref)) - (setq split-ref (match-string 2 ref)) - (find-file split-file) (setq ref split-ref)) - (save-restriction - (widen) - (goto-char (point-min)) - (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref)) - (res-rx (org-babel-named-data-regexp-for-name ref))) - ;; goto ref in the current buffer - (or - ;; check for code blocks - (re-search-forward src-rx nil t) - ;; check for named data - (re-search-forward res-rx nil t) - ;; check for local or global headlines by id - (setq id (org-babel-ref-goto-headline-id ref)) - ;; check the Library of Babel - (setq lob-info (cdr (assoc (intern ref) - org-babel-library-of-babel))))) - (unless (or lob-info id) (goto-char (match-beginning 0))) - ;; ;; TODO: allow searching for names in other buffers - ;; (setq id-loc (org-id-find ref 'marker) - ;; buffer (marker-buffer id-loc) - ;; loc (marker-position id-loc)) - ;; (move-marker id-loc nil) - (error "reference '%s' not found in this buffer" ref)) - (cond - (lob-info (setq type 'lob)) - (id (setq type 'id)) - ((and (looking-at org-babel-src-name-regexp) - (save-excursion - (forward-line 1) - (or (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp)))) - (setq type 'source-block)) - (t (while (not (setq type (org-babel-ref-at-ref-p))) - (forward-line 1) - (beginning-of-line) - (if (or (= (point) (point-min)) (= (point) (point-max))) - (error "reference not found"))))) - (let ((params (append args '((:results . "silent"))))) - (setq result - (case type - (results-line (org-babel-read-result)) - (table (org-babel-read-table)) - (list (org-babel-read-list)) - (file (org-babel-read-link)) - (source-block (org-babel-execute-src-block - nil nil (if org-babel-update-intermediate - nil params))) - (lob (org-babel-execute-src-block - nil lob-info params)) - (id (org-babel-ref-headline-body))))) - (if (symbolp result) - (format "%S" result) - (if (and index (listp result)) - (org-babel-ref-index-list index result) - result))))))) + (save-excursion + (let ((case-fold-search t) + type args new-refere new-header-args new-referent result + lob-info split-file split-ref index index-row index-col id) + ;; if ref is indexed grab the indices -- beware nested indices + (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) + (let ((str (substring ref 0 (match-beginning 0)))) + (= (org-count ?( str) (org-count ?) str)))) + (setq index (match-string 1 ref)) + (setq ref (substring ref 0 (match-beginning 0)))) + ;; assign any arguments to pass to source block + (when (string-match + "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref) + (setq new-refere (match-string 1 ref)) + (setq new-header-args (match-string 3 ref)) + (setq new-referent (match-string 5 ref)) + (when (> (length new-refere) 0) + (when (> (length new-referent) 0) + (setq args (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args new-referent)))) + (when (> (length new-header-args) 0) + (setq args (append (org-babel-parse-header-arguments + new-header-args) args))) + (setq ref new-refere))) + (when (string-match "^\\(.+\\):\\(.+\\)$" ref) + (setq split-file (match-string 1 ref)) + (setq split-ref (match-string 2 ref)) + (find-file split-file) (setq ref split-ref)) + (save-restriction + (widen) + (goto-char (point-min)) + (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref)) + (res-rx (org-babel-named-data-regexp-for-name ref))) + ;; goto ref in the current buffer + (or + ;; check for code blocks + (re-search-forward src-rx nil t) + ;; check for named data + (re-search-forward res-rx nil t) + ;; check for local or global headlines by id + (setq id (org-babel-ref-goto-headline-id ref)) + ;; check the Library of Babel + (setq lob-info (cdr (assoc (intern ref) + org-babel-library-of-babel))))) + (unless (or lob-info id) (goto-char (match-beginning 0))) + ;; ;; TODO: allow searching for names in other buffers + ;; (setq id-loc (org-id-find ref 'marker) + ;; buffer (marker-buffer id-loc) + ;; loc (marker-position id-loc)) + ;; (move-marker id-loc nil) + (error "Reference '%s' not found in this buffer" ref)) + (cond + (lob-info (setq type 'lob)) + (id (setq type 'id)) + ((and (looking-at org-babel-src-name-regexp) + (save-excursion + (forward-line 1) + (or (looking-at org-babel-src-block-regexp) + (looking-at org-babel-multi-line-header-regexp)))) + (setq type 'source-block)) + (t (while (not (setq type (org-babel-ref-at-ref-p))) + (forward-line 1) + (beginning-of-line) + (if (or (= (point) (point-min)) (= (point) (point-max))) + (error "Reference not found"))))) + (let ((params (append args '((:results . "silent"))))) + (setq result + (case type + (results-line (org-babel-read-result)) + (table (org-babel-read-table)) + (list (org-babel-read-list)) + (file (org-babel-read-link)) + (source-block (org-babel-execute-src-block + nil nil (if org-babel-update-intermediate + nil params))) + (lob (org-babel-execute-src-block + nil lob-info params)) + (id (org-babel-ref-headline-body))))) + (if (symbolp result) + (format "%S" result) + (if (and index (listp result)) + (org-babel-ref-index-list index result) + result))))))) (defun org-babel-ref-index-list (index lis) "Return the subset of LIS indexed by INDEX. @@ -218,28 +218,29 @@ returned, or an empty string or \"*\" both of which are interpreted to mean the entire range and as such are equivalent to \"0:-1\"." (if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index)) - (let ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)") - (length (length lis)) - (portion (match-string 1 index)) - (remainder (substring index (match-end 0)))) - (flet ((wrap (num) (if (< num 0) (+ length num) num)) - (open (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls))) - (open - (mapcar - (lambda (sub-lis) - (if (listp sub-lis) - (org-babel-ref-index-list remainder sub-lis) - sub-lis)) - (if (or (= 0 (length portion)) (string-match ind-re portion)) - (mapcar - (lambda (n) (nth n lis)) - (apply 'org-number-sequence - (if (and (> (length portion) 0) (match-string 2 portion)) - (list - (wrap (string-to-number (match-string 2 portion))) - (wrap (string-to-number (match-string 3 portion)))) - (list (wrap 0) (wrap -1))))) - (list (nth (wrap (string-to-number portion)) lis))))))) + (let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)") + (lgth (length lis)) + (portion (match-string 1 index)) + (remainder (substring index (match-end 0))) + (wrap (lambda (num) (if (< num 0) (+ lgth num) num))) + (open (lambda (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls)))) + (funcall + open + (mapcar + (lambda (sub-lis) + (if (listp sub-lis) + (org-babel-ref-index-list remainder sub-lis) + sub-lis)) + (if (or (= 0 (length portion)) (string-match ind-re portion)) + (mapcar + (lambda (n) (nth n lis)) + (apply 'org-number-sequence + (if (and (> (length portion) 0) (match-string 2 portion)) + (list + (funcall wrap (string-to-number (match-string 2 portion))) + (funcall wrap (string-to-number (match-string 3 portion)))) + (list (funcall wrap 0) (funcall wrap -1))))) + (list (nth (funcall wrap (string-to-number portion)) lis)))))) lis)) (defun org-babel-ref-split-args (arg-string) diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index 19cce58d82..54077d0d68 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -64,12 +64,12 @@ This function is called by `org-babel-execute-src-block'." body params (org-babel-variable-assignments:ruby params))) (result (if (member "xmp" result-params) (with-temp-buffer - (require 'rcodetools) - (insert full-body) - (xmp (cdr (assoc :xmp-option params))) - (buffer-string)) + (require 'rcodetools) + (insert full-body) + (xmp (cdr (assoc :xmp-option params))) + (buffer-string)) (org-babel-ruby-evaluate - session full-body result-type result-params)))) + session full-body result-type result-params)))) (org-babel-reassemble-table result (org-babel-pick-name (cdr (assoc :colname-names params)) @@ -102,7 +102,7 @@ This function is called by `org-babel-execute-src-block'." ;; helper functions (defun org-babel-variable-assignments:ruby (params) - "Return list of ruby statements assigning the block's variables" + "Return list of ruby statements assigning the block's variables." (mapcar (lambda (pair) (format "%s=%s" diff --git a/lisp/org/ob-scala.el b/lisp/org/ob-scala.el new file mode 100644 index 0000000000..b5eb18484b --- /dev/null +++ b/lisp/org/ob-scala.el @@ -0,0 +1,120 @@ +;;; ob-scala.el --- org-babel functions for Scala evaluation + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Andrzej Lichnerowicz +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; Currently only supports the external execution. No session support yet. + +;;; Requirements: +;; - Scala language :: http://www.scala-lang.org/ +;; - Scala major mode :: Can be installed from Scala sources +;; https://github.com/scala/scala-dist/blob/master/tool-support/src/emacs/scala-mode.el + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala")) +(defvar org-babel-default-header-args:scala '()) +(defvar org-babel-scala-command "scala" + "Name of the command to use for executing Scala code.") + + +(defun org-babel-execute:scala (body params) + "Execute a block of Scala code with org-babel. This function is +called by `org-babel-execute-src-block'" + (message "executing Scala source code block") + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-scala-initiate-session (nth 0 processed-params))) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params)) + (result (org-babel-scala-evaluate + session full-body result-type result-params))) + + (org-babel-reassemble-table + result + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + + +(defun org-babel-scala-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + + +(defvar org-babel-scala-wrapper-method + "( +%s +) asString print +") + + +(defun org-babel-scala-evaluate + (session body &optional result-type result-params) + "Evaluate BODY in external Scala process. +If RESULT-TYPE equals 'output then return standard output as a string. +If RESULT-TYPE equals 'value then return the value of the last statement +in BODY as elisp." + (when session (error "Sessions are not (yet) supported for Scala")) + (case result-type + (output + (let ((src-file (org-babel-temp-file "scala-"))) + (progn (with-temp-file src-file (insert body)) + (org-babel-eval + (concat org-babel-scala-command " " src-file) "")))) + (value + (let* ((src-file (org-babel-temp-file "scala-")) + (wrapper (format org-babel-scala-wrapper-method body))) + (with-temp-file src-file (insert wrapper)) + ((lambda (raw) + (if (member "code" result-params) + raw + (org-babel-scala-table-or-string raw))) + (org-babel-eval + (concat org-babel-scala-command " " src-file) "")))))) + + +(defun org-babel-prep-session:scala (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "Sessions are not (yet) supported for Scala")) + +(defun org-babel-scala-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session. Sessions are not +supported in Scala." + nil) + +(provide 'ob-scala) + + + +;;; ob-scala.el ends here diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index 37cdb28690..c628892423 100644 --- a/lisp/org/ob-screen.el +++ b/lisp/org/ob-screen.el @@ -23,7 +23,7 @@ ;;; Commentary: -;; Org-Babel support for interactive terminals. Mostly shell scripts. +;; Org-Babel support for interactive terminals. Mostly shell scripts. ;; Heavily inspired by 'eev' from Eduardo Ochs ;; ;; Adding :cmd and :terminal as header arguments @@ -64,8 +64,8 @@ In case you want to use a different screen than one selected by your $PATH") (process-name (concat "org-babel: terminal (" session ")"))) (apply 'start-process process-name "*Messages*" terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location - "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) - ,cmd)) + "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) + ,cmd)) ;; XXX: Is there a better way than the following? (while (not (org-babel-screen-session-socketname session)) ;; wait until screen session is available before returning @@ -81,8 +81,8 @@ In case you want to use a different screen than one selected by your $PATH") (apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*" org-babel-screen-location `("-S" ,socket "-X" "eval" "msgwait 0" - ,(concat "readreg z " tmpfile) - "paste z")))))) + ,(concat "readreg z " tmpfile) + "paste z")))))) (defun org-babel-screen-session-socketname (session) "Check if SESSION exists by parsing output of \"screen -ls\"." @@ -137,7 +137,7 @@ The terminal should shortly flicker." (message (concat "org-babel-screen: Setup " (if (string-match random-string tmp-string) "WORKS." - "DOESN'T work."))))) + "DOESN'T work."))))) (provide 'ob-screen) diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el index 6f4cb4ffdf..1cb607f148 100644 --- a/lisp/org/ob-sh.el +++ b/lisp/org/ob-sh.el @@ -56,14 +56,13 @@ This will be passed to `shell-command-on-region'") This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-sh-initiate-session (cdr (assoc :session params)))) - (result-params (cdr (assoc :result-params params))) (stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string - (org-babel-ref-resolve stdin)))) + (org-babel-ref-resolve stdin)))) (cdr (assoc :stdin params)))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:sh params)))) (org-babel-reassemble-table - (org-babel-sh-evaluate session full-body result-params stdin) + (org-babel-sh-evaluate session full-body params stdin) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name @@ -91,7 +90,7 @@ This function is called by `org-babel-execute-src-block'." ;; helper functions (defun org-babel-variable-assignments:sh (params) - "Return list of shell statements assigning the block's variables" + "Return list of shell statements assigning the block's variables." (let ((sep (cdr (assoc :separator params)))) (mapcar (lambda (pair) @@ -108,13 +107,13 @@ var of the same value." (defun org-babel-sh-var-to-string (var &optional sep) "Convert an elisp value to a string." - (flet ((echo-var (v) (if (stringp v) v (format "%S" v)))) + (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) (cond ((and (listp var) (listp (car var))) - (orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var))) + (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) ((listp var) - (mapconcat #'echo-var var "\n")) - (t (echo-var var))))) + (mapconcat echo-var var "\n")) + (t (funcall echo-var var))))) (defun org-babel-sh-table-or-results (results) "Convert RESULTS to an appropriate elisp value. @@ -134,29 +133,38 @@ Emacs-lisp table, otherwise return the results as a string." (defvar org-babel-sh-eoe-output "org_babel_sh_eoe" "String to indicate that evaluation has completed.") -(defun org-babel-sh-evaluate (session body &optional result-params stdin) +(defun org-babel-sh-evaluate (session body &optional params stdin) "Pass BODY to the Shell process in BUFFER. If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY." ((lambda (results) (when results - (if (or (member "scalar" result-params) - (member "verbatim" result-params) - (member "output" result-params)) - results - (let ((tmp-file (org-babel-temp-file "sh-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))))) + (let ((result-params (cdr (assoc :result-params params)))) + (if (or (member "scalar" result-params) + (member "verbatim" result-params) + (member "output" result-params)) + results + (let ((tmp-file (org-babel-temp-file "sh-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file)))))) (cond (stdin ; external shell script w/STDIN (let ((script-file (org-babel-temp-file "sh-script-")) - (stdin-file (org-babel-temp-file "sh-stdin-"))) - (with-temp-file script-file (insert body)) + (stdin-file (org-babel-temp-file "sh-stdin-")) + (shebang (cdr (assoc :shebang params))) + (padline (not (string= "no" (cdr (assoc :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) (with-temp-file stdin-file (insert stdin)) (with-temp-buffer (call-process-shell-command - (format "%s %s" org-babel-sh-command script-file) + (if shebang + script-file + (format "%s %s" org-babel-sh-command script-file)) stdin-file (current-buffer)) (buffer-string)))) @@ -182,7 +190,18 @@ return the value of the last statement in BODY." (list org-babel-sh-eoe-indicator)))) 2)) "\n")) ('otherwise ; external shell script - (org-babel-eval org-babel-sh-command (org-babel-trim body)))))) + (if (and (cdr (assoc :shebang params)) + (> (length (cdr (assoc :shebang params))) 0)) + (let ((script-file (org-babel-temp-file "sh-script-")) + (shebang (cdr (assoc :shebang params))) + (padline (not (string= "no" (cdr (assoc :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) + (org-babel-eval script-file "")) + (org-babel-eval org-babel-sh-command (org-babel-trim body))))))) (defun org-babel-sh-strip-weird-long-prompt (string) "Remove prompt cruft from a string of shell output." diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 68bd95af9f..ad7b1e29a9 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -51,8 +51,9 @@ (defvar org-babel-default-header-args:sql '()) -(defvar org-babel-header-arg-names:sql - '(engine out-file)) +(defvar org-babel-header-args:sql + '((engine . :any) + (out-file . :any))) (defun org-babel-expand-body:sql (body params) "Expand BODY according to the values of PARAMS." @@ -70,6 +71,15 @@ This function is called by `org-babel-execute-src-block'." (org-babel-temp-file "sql-out-"))) (header-delim "") (command (case (intern engine) + ('dbi (format "dbish --batch '%s' < %s | sed '%s' > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + "/^+/d;s/^\|//;$d" + (org-babel-process-file-name out-file))) + ('monetdb (format "mclient -f tab %s < %s > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) ('msosql (format "osql %s -s \"\t\" -i %s -o %s" (or cmdline "") (org-babel-process-file-name in-file) @@ -80,12 +90,16 @@ This function is called by `org-babel-execute-src-block'." (org-babel-process-file-name out-file))) ('postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) - (t (error "no support for the %s sql engine" engine))))) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) + (t (error "No support for the %s SQL engine" engine))))) (with-temp-file in-file - (insert (org-babel-expand-body:sql body params))) + (insert + (case (intern engine) + ('dbi "/format partbox\n") + (t "")) + (org-babel-expand-body:sql body params))) (message command) (shell-command command) (if (or (member "scalar" result-params) @@ -134,8 +148,8 @@ This function is called by `org-babel-execute-src-block'." (with-temp-file data-file (insert (orgtbl-to-csv val '(:fmt (lambda (el) (if (stringp el) - el - (format "%S" el))))))) + el + (format "%S" el))))))) data-file) (org-babel-temp-file "sql-data-")) (if (stringp val) val (format "%S" val)))) @@ -146,7 +160,7 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-prep-session:sql (session params) "Raise an error because Sql sessions aren't implemented." - (error "sql sessions not yet implemented")) + (error "SQL sessions not yet implemented")) (provide 'ob-sql) diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el index 84d6bb26ba..24a7dd58c2 100644 --- a/lisp/org/ob-sqlite.el +++ b/lisp/org/ob-sqlite.el @@ -37,8 +37,18 @@ (defvar org-babel-default-header-args:sqlite '()) -(defvar org-babel-header-arg-names:sqlite - '(db header echo bail csv column html line list separator nullvalue) +(defvar org-babel-header-args:sqlite + '((db . :any) + (header . :any) + (echo . :any) + (bail . :any) + (csv . :any) + (column . :any) + (html . :any) + (line . :any) + (list . :any) + (separator . :any) + (nullvalue . :any)) "Sqlite specific header args.") (defun org-babel-expand-body:sqlite (body params) @@ -61,7 +71,7 @@ This function is called by `org-babel-execute-src-block'." (list :header :echo :bail :column :csv :html :line :list)))) exit-code) - (unless db (error "ob-sqlite: can't evaluate without a database.")) + (unless db (error "ob-sqlite: can't evaluate without a database")) (with-temp-buffer (insert (org-babel-eval @@ -118,8 +128,8 @@ This function is called by `org-babel-execute-src-block'." (with-temp-file data-file (insert (orgtbl-to-csv val '(:fmt (lambda (el) (if (stringp el) - el - (format "%S" el))))))) + el + (format "%S" el))))))) data-file) (org-babel-temp-file "sqlite-data-")) (if (stringp val) val (format "%S" val)))) @@ -145,9 +155,9 @@ This function is called by `org-babel-execute-src-block'." table)) (defun org-babel-prep-session:sqlite (session params) - "Raise an error because support for sqlite sessions isn't implemented. + "Raise an error because support for SQLite sessions isn't implemented. Prepare SESSION according to the header arguments specified in PARAMS." - (error "sqlite sessions not yet implemented")) + (error "SQLite sessions not yet implemented")) (provide 'ob-sqlite) diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el index f636415d98..242ddf0902 100644 --- a/lisp/org/ob-table.el +++ b/lisp/org/ob-table.el @@ -99,7 +99,7 @@ as shown in the example below. (prog1 nil (setq quote t)) (prog1 (if quote (format "\"%s\"" el) - (org-babel-clean-text-properties el)) + (org-no-properties el)) (setq quote nil)))) (cdr var))))) variables))) diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index db4721b70b..7077a1571e 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -122,13 +122,15 @@ represented in the file." `progn', then kill the FILE buffer returning the result of evaluating BODY." (declare (indent 1)) - (let ((temp-result (make-symbol "temp-result")) + (let ((temp-path (make-symbol "temp-path")) + (temp-result (make-symbol "temp-result")) (temp-file (make-symbol "temp-file")) (visited-p (make-symbol "visited-p"))) - `(let (,temp-result ,temp-file - (,visited-p (get-file-buffer ,file))) - (org-babel-find-file-noselect-refresh ,file) - (setf ,temp-file (get-file-buffer ,file)) + `(let* ((,temp-path ,file) + (,visited-p (get-file-buffer ,temp-path)) + ,temp-result ,temp-file) + (org-babel-find-file-noselect-refresh ,temp-path) + (setf ,temp-file (get-file-buffer ,temp-path)) (with-current-buffer ,temp-file (setf ,temp-result (progn ,@body))) (unless ,visited-p (kill-buffer ,temp-file)) @@ -142,19 +144,19 @@ This function exports the source code using `org-babel-tangle' and then loads the resulting file using `load-file'." (interactive "fFile to load: ") - (flet ((age (file) - (float-time - (time-subtract (current-time) - (nth 5 (or (file-attributes (file-truename file)) - (file-attributes file))))))) - (let* ((base-name (file-name-sans-extension file)) - (exported-file (concat base-name ".el"))) - ;; tangle if the org-mode file is newer than the elisp file - (unless (and (file-exists-p exported-file) - (> (age file) (age exported-file))) - (org-babel-tangle-file file exported-file "emacs-lisp")) - (load-file exported-file) - (message "loaded %s" exported-file)))) + (let* ((age (lambda (file) + (float-time + (time-subtract (current-time) + (nth 5 (or (file-attributes (file-truename file)) + (file-attributes file))))))) + (base-name (file-name-sans-extension file)) + (exported-file (concat base-name ".el"))) + ;; tangle if the org-mode file is newer than the elisp file + (unless (and (file-exists-p exported-file) + (> (funcall age file) (funcall age exported-file))) + (org-babel-tangle-file file exported-file "emacs-lisp")) + (load-file exported-file) + (message "Loaded %s" exported-file))) ;;;###autoload (defun org-babel-tangle-file (file &optional target-file lang) @@ -189,96 +191,95 @@ exported source code blocks by language." (run-hooks 'org-babel-pre-tangle-hook) ;; possibly restrict the buffer to the current code block (save-restriction - (when only-this-block - (unless (org-babel-where-is-src-block-head) - (error "Point is not currently inside of a code block")) - (save-match-data - (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info)))) - target-file) - (setq target-file - (read-from-minibuffer "Tangle to: " (buffer-file-name))))) - (narrow-to-region (match-beginning 0) (match-end 0))) - (save-excursion - (let ((block-counter 0) - (org-babel-default-header-args - (if target-file - (org-babel-merge-params org-babel-default-header-args - (list (cons :tangle target-file))) - org-babel-default-header-args)) - path-collector) - (mapc ;; map over all languages - (lambda (by-lang) - (let* ((lang (car by-lang)) - (specs (cdr by-lang)) - (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang)) - (lang-f (intern - (concat - (or (and (cdr (assoc lang org-src-lang-modes)) - (symbol-name - (cdr (assoc lang org-src-lang-modes)))) - lang) - "-mode"))) - she-banged) - (mapc - (lambda (spec) - (flet ((get-spec (name) - (cdr (assoc name (nth 4 spec))))) - (let* ((tangle (get-spec :tangle)) - (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) - (get-spec :shebang))) - (base-name (cond - ((string= "yes" tangle) - (file-name-sans-extension - (buffer-file-name))) - ((string= "no" tangle) nil) - ((> (length tangle) 0) tangle))) - (file-name (when base-name - ;; decide if we want to add ext to base-name - (if (and ext (string= "yes" tangle)) - (concat base-name "." ext) base-name)))) - (when file-name - ;; possibly create the parent directories for file - (when ((lambda (m) (and m (not (string= m "no")))) - (get-spec :mkdirp)) - (make-directory (file-name-directory file-name) 'parents)) - ;; delete any old versions of file - (when (and (file-exists-p file-name) - (not (member file-name path-collector))) - (delete-file file-name)) - ;; drop source-block to file - (with-temp-buffer - (when (fboundp lang-f) (ignore-errors (funcall lang-f))) - (when (and she-bang (not (member file-name she-banged))) - (insert (concat she-bang "\n")) - (setq she-banged (cons file-name she-banged))) - (org-babel-spec-to-string spec) - ;; We avoid append-to-file as it does not work with tramp. - (let ((content (buffer-string))) - (with-temp-buffer - (if (file-exists-p file-name) - (insert-file-contents file-name)) - (goto-char (point-max)) - (insert content) - (write-region nil nil file-name)))) - ;; if files contain she-bangs, then make the executable - (when she-bang (set-file-modes file-name #o755)) - ;; update counter - (setq block-counter (+ 1 block-counter)) - (add-to-list 'path-collector file-name))))) - specs))) - (org-babel-tangle-collect-blocks lang)) - (message "tangled %d code block%s from %s" block-counter - (if (= block-counter 1) "" "s") - (file-name-nondirectory - (buffer-file-name (or (buffer-base-buffer) (current-buffer))))) - ;; run `org-babel-post-tangle-hook' in all tangled files - (when org-babel-post-tangle-hook - (mapc - (lambda (file) - (org-babel-with-temp-filebuffer file - (run-hooks 'org-babel-post-tangle-hook))) - path-collector)) - path-collector)))) + (when only-this-block + (unless (org-babel-where-is-src-block-head) + (error "Point is not currently inside of a code block")) + (save-match-data + (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info)))) + target-file) + (setq target-file + (read-from-minibuffer "Tangle to: " (buffer-file-name))))) + (narrow-to-region (match-beginning 0) (match-end 0))) + (save-excursion + (let ((block-counter 0) + (org-babel-default-header-args + (if target-file + (org-babel-merge-params org-babel-default-header-args + (list (cons :tangle target-file))) + org-babel-default-header-args)) + path-collector) + (mapc ;; map over all languages + (lambda (by-lang) + (let* ((lang (car by-lang)) + (specs (cdr by-lang)) + (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang)) + (lang-f (intern + (concat + (or (and (cdr (assoc lang org-src-lang-modes)) + (symbol-name + (cdr (assoc lang org-src-lang-modes)))) + lang) + "-mode"))) + she-banged) + (mapc + (lambda (spec) + (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec)))))) + (let* ((tangle (funcall get-spec :tangle)) + (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) + (funcall get-spec :shebang))) + (base-name (cond + ((string= "yes" tangle) + (file-name-sans-extension + (buffer-file-name))) + ((string= "no" tangle) nil) + ((> (length tangle) 0) tangle))) + (file-name (when base-name + ;; decide if we want to add ext to base-name + (if (and ext (string= "yes" tangle)) + (concat base-name "." ext) base-name)))) + (when file-name + ;; possibly create the parent directories for file + (when ((lambda (m) (and m (not (string= m "no")))) + (funcall get-spec :mkdirp)) + (make-directory (file-name-directory file-name) 'parents)) + ;; delete any old versions of file + (when (and (file-exists-p file-name) + (not (member file-name path-collector))) + (delete-file file-name)) + ;; drop source-block to file + (with-temp-buffer + (when (fboundp lang-f) (ignore-errors (funcall lang-f))) + (when (and she-bang (not (member file-name she-banged))) + (insert (concat she-bang "\n")) + (setq she-banged (cons file-name she-banged))) + (org-babel-spec-to-string spec) + ;; We avoid append-to-file as it does not work with tramp. + (let ((content (buffer-string))) + (with-temp-buffer + (if (file-exists-p file-name) + (insert-file-contents file-name)) + (goto-char (point-max)) + (insert content) + (write-region nil nil file-name)))) + ;; if files contain she-bangs, then make the executable + (when she-bang (set-file-modes file-name #o755)) + ;; update counter + (setq block-counter (+ 1 block-counter)) + (add-to-list 'path-collector file-name))))) + specs))) + (org-babel-tangle-collect-blocks lang)) + (message "Tangled %d code block%s from %s" block-counter + (if (= block-counter 1) "" "s") + (file-name-nondirectory + (buffer-file-name (or (buffer-base-buffer) (current-buffer))))) + ;; run `org-babel-post-tangle-hook' in all tangled files + (when org-babel-post-tangle-hook + (mapc + (lambda (file) + (org-babel-with-temp-filebuffer file + (run-hooks 'org-babel-post-tangle-hook))) + path-collector)) + path-collector)))) (defun org-babel-tangle-clean () "Remove comments inserted by `org-babel-tangle'. @@ -290,12 +291,59 @@ references." (interactive) (goto-char (point-min)) (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t) - (re-search-forward "<<[^[:space:]]*>>" nil t)) + (re-search-forward (org-babel-noweb-wrap) nil t)) (delete-region (save-excursion (beginning-of-line 1) (point)) (save-excursion (end-of-line 1) (forward-char 1) (point))))) (defvar org-stored-links) (defvar org-bracket-link-regexp) +(defun org-babel-spec-to-string (spec) + "Insert SPEC into the current file. +Insert the source-code specified by SPEC into the current +source code file. This function uses `comment-region' which +assumes that the appropriate major-mode is set. SPEC has the +form + + (start-line file link source-name params body comment)" + (let* ((start-line (nth 0 spec)) + (file (nth 1 spec)) + (link (nth 2 spec)) + (source-name (nth 3 spec)) + (body (nth 5 spec)) + (comment (nth 6 spec)) + (comments (cdr (assoc :comments (nth 4 spec)))) + (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec)))))) + (link-p (or (string= comments "both") (string= comments "link") + (string= comments "yes") (string= comments "noweb"))) + (link-data (mapcar (lambda (el) + (cons (symbol-name el) + ((lambda (le) + (if (stringp le) le (format "%S" le))) + (eval el)))) + '(start-line file link source-name))) + (insert-comment (lambda (text) + (when (and comments (not (string= comments "no")) + (> (length text) 0)) + (when padline (insert "\n")) + (comment-region (point) (progn (insert text) (point))) + (end-of-line nil) (insert "\n"))))) + (when comment (funcall insert-comment comment)) + (when link-p + (funcall + insert-comment + (org-fill-template org-babel-tangle-comment-format-beg link-data))) + (when padline (insert "\n")) + (insert + (format + "%s\n" + (replace-regexp-in-string + "^," "" + (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) + (when link-p + (funcall + insert-comment + (org-fill-template org-babel-tangle-comment-format-end link-data))))) + (defun org-babel-tangle-collect-blocks (&optional language) "Collect source blocks in the current Org-mode file. Return an association list of source-code block specifications of @@ -312,7 +360,8 @@ code blocks by language." (setq block-counter (+ 1 block-counter)))) (replace-regexp-in-string "[ \t]" "-" (condition-case nil - (nth 4 (org-heading-components)) + (or (nth 4 (org-heading-components)) + "(dummy for heading without text)") (error (buffer-file-name))))) (let* ((start-line (save-restriction (widen) (+ 1 (line-number-at-pos (point))))) @@ -326,7 +375,7 @@ code blocks by language." (link ((lambda (link) (and (string-match org-bracket-link-regexp link) (match-string 1 link))) - (org-babel-clean-text-properties + (org-no-properties (org-store-link nil)))) (source-name (intern (or (nth 4 info) @@ -351,11 +400,7 @@ code blocks by language." body params (and (fboundp assignments-cmd) (funcall assignments-cmd params)))))) - (if (and (cdr (assoc :noweb params)) ;; expand noweb refs - (let ((nowebs (split-string - (cdr (assoc :noweb params))))) - (or (member "yes" nowebs) - (member "tangle" nowebs)))) + (if (org-babel-noweb-p params :tangle) (org-babel-expand-noweb-references info) (nth 1 info))))) (comment @@ -392,57 +437,12 @@ code blocks by language." blocks)) blocks)) -(defun org-babel-spec-to-string (spec) - "Insert SPEC into the current file. -Insert the source-code specified by SPEC into the current -source code file. This function uses `comment-region' which -assumes that the appropriate major-mode is set. SPEC has the -form - - (start-line file link source-name params body comment)" - (let* ((start-line (nth 0 spec)) - (file (nth 1 spec)) - (link (nth 2 spec)) - (source-name (nth 3 spec)) - (body (nth 5 spec)) - (comment (nth 6 spec)) - (comments (cdr (assoc :comments (nth 4 spec)))) - (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec)))))) - (link-p (or (string= comments "both") (string= comments "link") - (string= comments "yes") (string= comments "noweb"))) - (link-data (mapcar (lambda (el) - (cons (symbol-name el) - ((lambda (le) - (if (stringp le) le (format "%S" le))) - (eval el)))) - '(start-line file link source-name)))) - (flet ((insert-comment (text) - (when (and comments (not (string= comments "no")) - (> (length text) 0)) - (when padline (insert "\n")) - (comment-region (point) (progn (insert text) (point))) - (end-of-line nil) (insert "\n")))) - (when comment (insert-comment comment)) - (when link-p - (insert-comment - (org-fill-template org-babel-tangle-comment-format-beg link-data))) - (when padline (insert "\n")) - (insert - (format - "%s\n" - (replace-regexp-in-string - "^," "" - (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) - (when link-p - (insert-comment - (org-fill-template org-babel-tangle-comment-format-end link-data)))))) - (defun org-babel-tangle-comment-links ( &optional info) "Return a list of begin and end link comments for the code block at point." (let* ((start-line (org-babel-where-is-src-block-head)) (file (buffer-file-name)) (link (org-link-escape (progn (call-interactively 'org-store-link) - (org-babel-clean-text-properties + (org-no-properties (car (pop org-stored-links)))))) (source-name (nth 4 (or info (org-babel-get-src-block-info 'light)))) (link-data (mapcar (lambda (el) @@ -475,7 +475,7 @@ which enable the original code blocks to be found." (org-babel-update-block-body new-body))) (setq counter (+ 1 counter))) (goto-char end)) - (prog1 counter (message "detangled %d code blocks" counter))))) + (prog1 counter (message "Detangled %d code blocks" counter))))) (defun org-babel-tangle-jump-to-org () "Jump from a tangled code file to the related Org-mode file." @@ -498,7 +498,7 @@ which enable the original code blocks to be found." " ends here") nil t) (setq end (point-at-bol)))))))) (unless (and start (< start mid) (< mid end)) - (error "not in tangled code")) + (error "Not in tangled code")) (setq body (org-babel-trim (buffer-substring start end)))) (when (string-match "::" path) (setq path (substring path 0 (match-beginning 0)))) diff --git a/lisp/org/ob.el b/lisp/org/ob.el index 0512248758..f15457d68e 100644 --- a/lisp/org/ob.el +++ b/lisp/org/ob.el @@ -27,12 +27,19 @@ (require 'cl)) (require 'ob-eval) (require 'org-macs) +(require 'org-compat) +(defconst org-babel-exeext + (if (memq system-type '(windows-nt cygwin)) + ".exe" + nil)) (defvar org-babel-call-process-region-original) (defvar org-src-lang-modes) (defvar org-babel-library-of-babel) (declare-function show-all "outline" ()) (declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) +(declare-function org-mark-ring-push "org" (&optional pos buffer)) +(declare-function org-strip-protective-commas "org" (beg end)) (declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag)) (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) @@ -44,7 +51,7 @@ (&optional context code edit-buffer-name quietp)) (declare-function org-edit-src-exit "org-src" (&optional context)) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) -(declare-function org-save-outline-visibility "org" (use-markers &rest body)) +(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body)) (declare-function org-outline-overlay-data "org" (&optional use-markers)) (declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-narrow-to-subtree "org" ()) @@ -57,6 +64,7 @@ (declare-function org-cycle "org" (&optional arg)) (declare-function org-uniquify "org" (list)) (declare-function org-current-level "org" ()) +(declare-function org-strip-protective-commas "org" (beg end)) (declare-function org-table-import "org-table" (file arg)) (declare-function org-add-hook "org-compat" (hook function &optional append local)) @@ -80,6 +88,9 @@ (declare-function org-list-prevs-alist "org-list" (struct)) (declare-function org-list-get-list-end "org-list" (item struct prevs)) (declare-function org-strip-protective-commas "org" (beg end)) +(declare-function org-remove-if "org" (predicate seq)) +(declare-function org-completing-read "org" (&rest args)) +(declare-function org-add-protective-commas "org-src" (beg end)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -104,9 +115,9 @@ remove code block execution from C-c C-c as further protection against accidental code block evaluation. The `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to remove code block execution from the C-c C-c keybinding." - :group 'org-babel - :version "24.1" - :type '(choice boolean function)) + :group 'org-babel + :version "24.1" + :type '(choice boolean function)) ;; don't allow this variable to be changed through file settings (put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) @@ -123,6 +134,23 @@ be used." :group 'org-babel :type 'string) +(defcustom org-babel-noweb-wrap-start "<<" + "String used to begin a noweb reference in a code block. +See also `org-babel-noweb-wrap-end'." + :group 'org-babel + :type 'string) + +(defcustom org-babel-noweb-wrap-end ">>" + "String used to end a noweb reference in a code block. +See also `org-babel-noweb-wrap-start'." + :group 'org-babel + :type 'string) + +(defun org-babel-noweb-wrap (&optional regexp) + (concat org-babel-noweb-wrap-start + (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") + org-babel-noweb-wrap-end)) + (defvar org-babel-src-name-regexp "^[ \t]*#\\+name:[ \t]*" "Regular expression used to match a source name line.") @@ -227,7 +255,7 @@ Returns a list (nth 2 info) (org-babel-parse-header-arguments (match-string 1))))) (when (looking-at org-babel-src-name-w-name-regexp) - (setq name (org-babel-clean-text-properties (match-string 3))) + (setq name (org-no-properties (match-string 3))) (when (and (match-string 5) (> (length (match-string 5)) 0)) (setf (nth 2 info) ;; merge functional-syntax vars and header-args (org-babel-merge-params @@ -263,15 +291,18 @@ of potentially harmful code." (let* ((eval (or (cdr (assoc :eval (nth 2 info))) (when (assoc :noeval (nth 2 info)) "no"))) (query (cond ((equal eval "query") t) - ((and org-current-export-file + ((and (boundp 'org-current-export-file) + org-current-export-file (equal eval "query-export")) t) ((functionp org-confirm-babel-evaluate) (funcall org-confirm-babel-evaluate (nth 0 info) (nth 1 info))) (t org-confirm-babel-evaluate)))) (if (or (equal eval "never") (equal eval "no") - (and org-current-export-file (or (equal eval "no-export") - (equal eval "never-export"))) + (and (boundp 'org-current-export-file) + org-current-export-file + (or (equal eval "no-export") + (equal eval "never-export"))) (and query (not (yes-or-no-p (format "Evaluate this%scode block%son your system? " @@ -314,27 +345,27 @@ then run `org-babel-execute-src-block'." This includes header arguments, language and name, and is largely a window into the `org-babel-get-src-block-info' function." (interactive) - (let ((info (org-babel-get-src-block-info 'light))) - (flet ((full (it) (> (length it) 0)) - (printf (fmt &rest args) (princ (apply #'format fmt args)))) - (when info - (with-help-window (help-buffer) - (let ((name (nth 4 info)) - (lang (nth 0 info)) - (switches (nth 3 info)) - (header-args (nth 2 info))) - (when name (printf "Name: %s\n" name)) - (when lang (printf "Lang: %s\n" lang)) - (when (full switches) (printf "Switches: %s\n" switches)) - (printf "Header Arguments:\n") - (dolist (pair (sort header-args - (lambda (a b) (string< (symbol-name (car a)) - (symbol-name (car b)))))) - (when (full (cdr pair)) - (printf "\t%S%s\t%s\n" - (car pair) - (if (> (length (format "%S" (car pair))) 7) "" "\t") - (cdr pair)))))))))) + (let ((info (org-babel-get-src-block-info 'light)) + (full (lambda (it) (> (length it) 0))) + (printf (lambda (fmt &rest args) (princ (apply #'format fmt args))))) + (when info + (with-help-window (help-buffer) + (let ((name (nth 4 info)) + (lang (nth 0 info)) + (switches (nth 3 info)) + (header-args (nth 2 info))) + (when name (funcall printf "Name: %s\n" name)) + (when lang (funcall printf "Lang: %s\n" lang)) + (when (funcall full switches) (funcall printf "Switches: %s\n" switches)) + (funcall printf "Header Arguments:\n") + (dolist (pair (sort header-args + (lambda (a b) (string< (symbol-name (car a)) + (symbol-name (car b)))))) + (when (funcall full (cdr pair)) + (funcall printf "\t%S%s\t%s\n" + (car pair) + (if (> (length (format "%S" (car pair))) 7) "" "\t") + (cdr pair))))))))) ;;;###autoload (defun org-babel-expand-src-block-maybe () @@ -380,24 +411,26 @@ then run `org-babel-pop-to-session'." (eval . ((never query))) (exports . ((code results both none))) (file . :any) + (file-desc . :any) (hlines . ((no yes))) (mkdirp . ((yes no))) (no-expand) (noeval) - (noweb . ((yes no tangle))) + (noweb . ((yes no tangle no-export strip-export))) (noweb-ref . :any) (noweb-sep . :any) (padline . ((yes no))) (results . ((file list vector table scalar verbatim) - (raw org html latex code pp wrap) - (replace silent append prepend) - (output value))) + (raw html latex org code pp drawer) + (replace silent append prepend) + (output value))) (rownames . ((no yes))) (sep . :any) (session . :any) (shebang . :any) (tangle . ((tangle yes no :any))) - (var . :any))) + (var . :any) + (wrap . :any))) (defconst org-babel-header-arg-names (mapcar #'car org-babel-common-header-args-w-values) @@ -415,7 +448,7 @@ specific header arguments as well.") '((:session . "none") (:results . "replace") (:exports . "results")) "Default arguments to use when evaluating an inline source block.") -(defvar org-babel-data-names '("TBLNAME" "RESULTS" "NAME")) +(defvar org-babel-data-names '("tblname" "results" "name")) (defvar org-babel-result-regexp (concat "^[ \t]*#\\+" @@ -433,8 +466,8 @@ be saved in the second match data.") "The minimum number of lines for block output. If number of lines of output is equal to or exceeds this value, the output is placed in a #+begin_example...#+end_example -block. Otherwise the output is marked as literal by inserting -colons at the starts of the lines. This variable only takes +block. Otherwise the output is marked as literal by inserting +colons at the starts of the lines. This variable only takes effect if the :results output option is in effect.") (defvar org-babel-noweb-error-langs nil @@ -452,7 +485,7 @@ can not be resolved.") (defun org-babel-named-src-block-regexp-for-name (name) "This generates a regexp used to match a src block named NAME." (concat org-babel-src-name-regexp (regexp-quote name) - "\\([ \t]\\|$\\|(\\)" ".*[\r\n]" + "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*" (substring org-babel-src-block-regexp 1))) (defun org-babel-named-data-regexp-for-name (name) @@ -495,15 +528,13 @@ block." (new-hash (when cache? (org-babel-sha1-hash info))) (old-hash (when cache? (org-babel-current-result-hash))) (body (setf (nth 1 info) - (let ((noweb (cdr (assoc :noweb params)))) - (if (and noweb - (or (string= "yes" noweb) - (string= "tangle" noweb))) - (org-babel-expand-noweb-references info) - (nth 1 info))))) + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) + (nth 1 info)))) (dir (cdr (assoc :dir params))) (default-directory - (or (and dir (file-name-as-directory dir)) default-directory)) + (or (and dir (file-name-as-directory (expand-file-name dir))) + default-directory)) (org-babel-call-process-region-original (if (boundp 'org-babel-call-process-region-original) org-babel-call-process-region-original @@ -511,15 +542,16 @@ block." (indent (car (last info))) result cmd) (unwind-protect - (flet ((call-process-region (&rest args) - (apply 'org-babel-tramp-handle-call-process-region args))) - (flet ((lang-check (f) - (let ((f (intern (concat "org-babel-execute:" f)))) - (when (fboundp f) f)))) + (let ((call-process-region + (lambda (&rest args) + (apply 'org-babel-tramp-handle-call-process-region args)))) + (let ((lang-check (lambda (f) + (let ((f (intern (concat "org-babel-execute:" f)))) + (when (fboundp f) f))))) (setq cmd - (or (lang-check lang) - (lang-check (symbol-name - (cdr (assoc lang org-src-lang-modes)))) + (or (funcall lang-check lang) + (funcall lang-check (symbol-name + (cdr (assoc lang org-src-lang-modes)))) (error "No org-babel-execute function for %s!" lang)))) (if (and (not arg) new-hash (equal new-hash old-hash)) (save-excursion ;; return cached result @@ -572,10 +604,9 @@ arguments and pop open the results in a preview buffer." (params (setf (nth 2 info) (sort (org-babel-merge-params (nth 2 info) params) (lambda (el1 el2) (string< (symbol-name (car el1)) - (symbol-name (car el2))))))) + (symbol-name (car el2))))))) (body (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) + (if (org-babel-noweb-p params :eval) (org-babel-expand-noweb-references info) (nth 1 info)))) (expand-cmd (intern (concat "org-babel-expand-body:" lang))) (assignments-cmd (intern (concat "org-babel-variable-assignments:" @@ -592,17 +623,32 @@ arguments and pop open the results in a preview buffer." "Return the edit (levenshtein) distance between strings S1 S2." (let* ((l1 (length s1)) (l2 (length s2)) - (dist (map 'vector (lambda (_) (make-vector (1+ l2) nil)) - (number-sequence 1 (1+ l1))))) - (flet ((in (i j) (aref (aref dist i) j)) - (mmin (&rest lst) (apply #'min (remove nil lst)))) - (setf (aref (aref dist 0) 0) 0) - (dolist (i (number-sequence 1 l1)) - (dolist (j (number-sequence 1 l2)) - (setf (aref (aref dist i) j) - (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1) - (mmin (in (1- i) j) (in i (1- j)) (in (1- i) (1- j))))))) - (in l1 l2)))) + (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil)) + (number-sequence 1 (1+ l1))))) + (in (lambda (i j) (aref (aref dist i) j))) + (mmin (lambda (&rest lst) (apply #'min (remove nil lst))))) + (setf (aref (aref dist 0) 0) 0) + (dolist (i (number-sequence 1 l1)) + (dolist (j (number-sequence 1 l2)) + (setf (aref (aref dist i) j) + (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1) + (funcall mmin (funcall in (1- i) j) + (funcall in i (1- j)) + (funcall in (1- i) (1- j))))))) + (funcall in l1 l2))) + +(defun org-babel-combine-header-arg-lists (original &rest others) + "Combine a number of lists of header argument names and arguments." + (let ((results (copy-sequence original))) + (dolist (new-list others) + (dolist (arg-pair new-list) + (let ((header (car arg-pair)) + (args (cdr arg-pair))) + (setq results + (cons arg-pair (org-remove-if + (lambda (pair) (equal header (car pair))) + results)))))) + results)) ;;;###autoload (defun org-babel-check-src-block () @@ -616,13 +662,13 @@ arguments and pop open the results in a preview buffer." (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1)) (and (org-babel-where-is-src-block-head) (org-babel-parse-header-arguments - (org-babel-clean-text-properties + (org-no-properties (match-string 4)))))) (dolist (name names) (when (and (not (string= header name)) (<= (org-babel-edit-distance header name) too-close) (not (member header names))) - (error "supplied header \"%S\" is suspiciously close to \"%S\"" + (error "Supplied header \"%S\" is suspiciously close to \"%S\"" header name)))) (message "No suspicious header arguments found."))) @@ -631,17 +677,15 @@ arguments and pop open the results in a preview buffer." "Insert a header argument selecting from lists of common args and values." (interactive) (let* ((lang (car (org-babel-get-src-block-info 'light))) - (lang-headers (intern (concat "org-babel-header-arg-names:" lang))) - (headers (append (if (boundp lang-headers) - (mapcar (lambda (h) (cons h :any)) - (eval lang-headers)) - nil) - org-babel-common-header-args-w-values)) + (lang-headers (intern (concat "org-babel-header-args:" lang))) + (headers (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (if (boundp lang-headers) (eval lang-headers) nil))) (arg (org-icompleting-read - "Header Arg: " - (mapcar - (lambda (header-spec) (symbol-name (car header-spec))) - headers)))) + "Header Arg: " + (mapcar + (lambda (header-spec) (symbol-name (car header-spec))) + headers)))) (insert ":" arg) (let ((vals (cdr (assoc (intern arg) headers)))) (when vals @@ -661,6 +705,30 @@ arguments and pop open the results in a preview buffer." ""))) vals "")))))))) +;; Add support for completing-read insertion of header arguments after ":" +(defun org-babel-header-arg-expand () + "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts." + (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head)) + (org-babel-enter-header-arg-w-completion (match-string 2)))) + +(defun org-babel-enter-header-arg-w-completion (&optional lang) + "Insert header argument appropriate for LANG with completion." + (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang))) + (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var))) + (headers-w-values (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values lang-headers)) + (headers (mapcar #'symbol-name (mapcar #'car headers-w-values))) + (header (org-completing-read "Header Arg: " headers)) + (args (cdr (assoc (intern header) headers-w-values))) + (arg (when (and args (listp args)) + (org-completing-read + (format "%s: " header) + (mapcar #'symbol-name (apply #'append args)))))) + (insert (concat header " " (or arg ""))) + (cons header arg))) + +(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand) + ;;;###autoload (defun org-babel-load-in-session (&optional arg info) "Load the body of the current source-code block. @@ -672,8 +740,7 @@ session." (lang (nth 0 info)) (params (nth 2 info)) (body (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) + (if (org-babel-noweb-p params :eval) (org-babel-expand-noweb-references info) (nth 1 info)))) (session (cdr (assoc :session params))) @@ -691,7 +758,7 @@ session." "Initiate session for current code block. If called with a prefix argument then resolve any variable references in the header arguments and assign these variables in -the session. Copy the body of the code block to the kill ring." +the session. Copy the body of the code block to the kill ring." (interactive "P") (let* ((info (or info (org-babel-get-src-block-info (not arg)))) (lang (nth 0 info)) @@ -718,7 +785,7 @@ the session. Copy the body of the code block to the kill ring." ;;;###autoload (defun org-babel-switch-to-session (&optional arg info) "Switch to the session of the current code block. -Uses `org-babel-initiate-session' to start the session. If called +Uses `org-babel-initiate-session' to start the session. If called with a prefix argument then this is passed on to `org-babel-initiate-session'." (interactive "P") @@ -731,18 +798,18 @@ with a prefix argument then this is passed on to (defun org-babel-switch-to-session-with-code (&optional arg info) "Switch to code buffer and display session." (interactive "P") - (flet ((swap-windows - () - (let ((other-window-buffer (window-buffer (next-window)))) - (set-window-buffer (next-window) (current-buffer)) - (set-window-buffer (selected-window) other-window-buffer)) - (other-window 1))) - (let ((info (org-babel-get-src-block-info)) - (org-src-window-setup 'reorganize-frame)) - (save-excursion - (org-babel-switch-to-session arg info)) - (org-edit-src-code)) - (swap-windows))) + (let ((swap-windows + (lambda () + (let ((other-window-buffer (window-buffer (next-window)))) + (set-window-buffer (next-window) (current-buffer)) + (set-window-buffer (selected-window) other-window-buffer)) + (other-window 1))) + (info (org-babel-get-src-block-info)) + (org-src-window-setup 'reorganize-frame)) + (save-excursion + (org-babel-switch-to-session arg info)) + (org-edit-src-code) + (funcall swap-windows))) (defmacro org-babel-do-in-edit-buffer (&rest body) "Evaluate BODY in edit buffer if there is a code block at point. @@ -759,9 +826,9 @@ Return t if a code block was found at point, nil otherwise." (defun org-babel-do-key-sequence-in-edit-buffer (key) "Read key sequence and execute the command in edit buffer. Enter a key sequence to be executed in the language major-mode -edit buffer. For example, TAB will alter the contents of the +edit buffer. For example, TAB will alter the contents of the Org-mode code block according to the effect of TAB in the -language major-mode buffer. For languages that support +language major-mode buffer. For languages that support interactive sessions, this can be used to send code from the Org buffer to the session for evaluation using the native major-mode evaluation mechanisms." @@ -959,11 +1026,11 @@ the current subtree." (setf (nth 2 info) (sort (copy-sequence (nth 2 info)) (lambda (a b) (string< (car a) (car b))))) - (labels ((rm (lst) + (let* ((rm (lambda (lst) (dolist (p '("replace" "silent" "append" "prepend")) (setq lst (remove p lst))) - lst) - (norm (arg) + lst)) + (norm (lambda (arg) (let ((v (if (and (listp (cdr arg)) (null (cddr arg))) (copy-sequence (cdr arg)) (cdr arg)))) @@ -973,19 +1040,19 @@ the current subtree." (cond ((and (listp v) ; lists are sorted (member (car arg) '(:result-params))) - (sort (rm v) #'string<)) + (sort (funcall rm v) #'string<)) ((and (stringp v) ; strings are sorted (member (car arg) '(:results :exports))) - (mapconcat #'identity (sort (rm (split-string v)) + (mapconcat #'identity (sort (funcall rm (split-string v)) #'string<) " ")) - (t v)))))) + (t v))))))) ((lambda (hash) (when (org-called-interactively-p 'interactive) (message hash)) hash) (let ((it (format "%s-%s" (mapconcat #'identity (delq nil (mapcar (lambda (arg) - (let ((normalized (norm arg))) + (let ((normalized (funcall norm arg))) (when normalized (format "%S" normalized)))) (nth 2 info))) ":") @@ -993,9 +1060,17 @@ the current subtree." (sha1 it)))))) (defun org-babel-current-result-hash () - "Return the in-buffer hash associated with INFO." + "Return the current in-buffer hash." + (org-babel-where-is-src-block-result) + (org-no-properties (match-string 3))) + +(defun org-babel-set-current-result-hash (hash) + "Set the current in-buffer hash to HASH." (org-babel-where-is-src-block-result) - (org-babel-clean-text-properties (match-string 3))) + (save-excursion (goto-char (match-beginning 3)) + ;; (mapc #'delete-overlay (overlays-at (point))) + (replace-match hash nil nil nil 3) + (org-babel-hide-hash))) (defun org-babel-hide-hash () "Hide the hash in the current results line. @@ -1136,22 +1211,23 @@ may be specified in the properties of the current outline entry." (cons (intern (concat ":" header-arg)) (org-babel-read val)))) (mapcar - 'symbol-name - (append - org-babel-header-arg-names - (progn - (setq sym (intern (concat "org-babel-header-arg-names:" - lang))) - (and (boundp sym) (eval sym))))))))))) + #'symbol-name + (mapcar + #'car + (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (progn + (setq sym (intern (concat "org-babel-header-args:" lang))) + (and (boundp sym) (eval sym)))))))))))) (defvar org-src-preserve-indentation) (defun org-babel-parse-src-block-match () "Parse the results from a match of the `org-babel-src-block-regexp'." (let* ((block-indentation (length (match-string 1))) - (lang (org-babel-clean-text-properties (match-string 2))) + (lang (org-no-properties (match-string 2))) (lang-headers (intern (concat "org-babel-default-header-args:" lang))) (switches (match-string 3)) - (body (org-babel-clean-text-properties + (body (org-no-properties (let* ((body (match-string 5)) (sub-length (- (length body) 1))) (if (and (> sub-length 0) @@ -1173,23 +1249,23 @@ may be specified in the properties of the current outline entry." (org-babel-params-from-properties lang) (if (boundp lang-headers) (eval lang-headers) nil) (org-babel-parse-header-arguments - (org-babel-clean-text-properties (or (match-string 4) "")))) + (org-no-properties (or (match-string 4) "")))) switches block-indentation))) (defun org-babel-parse-inline-src-block-match () "Parse the results from a match of the `org-babel-inline-src-block-regexp'." - (let* ((lang (org-babel-clean-text-properties (match-string 2))) + (let* ((lang (org-no-properties (match-string 2))) (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) (list lang (org-babel-strip-protective-commas - (org-babel-clean-text-properties (match-string 5)) lang) + (org-no-properties (match-string 5)) lang) (org-babel-merge-params org-babel-default-inline-header-args (org-babel-params-from-properties lang) (if (boundp lang-headers) (eval lang-headers) nil) (org-babel-parse-header-arguments - (org-babel-clean-text-properties (or (match-string 4) ""))))))) + (org-no-properties (or (match-string 4) ""))))))) (defun org-babel-balanced-split (string alts) "Split STRING on instances of ALTS. @@ -1197,43 +1273,44 @@ ALTS is a cons of two character options where each option may be either the numeric code of a single character or a list of character alternatives. For example to split on balanced instances of \"[ \t]:\" set ALTS to '((32 9) . 58)." - (flet ((matches (ch spec) (if (listp spec) (member ch spec) (equal spec ch))) - (matched (ch last) - (if (consp alts) - (and (matches ch (cdr alts)) - (matches last (car alts))) - (matches ch alts)))) - (let ((balance 0) (quote nil) (partial nil) (lst nil) (last 0)) - (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]: - (setq balance (+ balance - (cond ((or (equal 91 ch) (equal 40 ch)) 1) - ((or (equal 93 ch) (equal 41 ch)) -1) - (t 0)))) - (when (and (equal 34 ch) (not (equal 92 last))) - (setq quote (not quote))) - (setq partial (cons ch partial)) - (when (and (= balance 0) (not quote) (matched ch last)) - (setq lst (cons (apply #'string (nreverse - (if (consp alts) - (cddr partial) - (cdr partial)))) - lst)) - (setq partial nil)) - (setq last ch)) - (string-to-list string)) - (nreverse (cons (apply #'string (nreverse partial)) lst))))) + (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))) + (matched (lambda (ch last) + (if (consp alts) + (and (funcall matches ch (cdr alts)) + (funcall matches last (car alts))) + (funcall matches ch alts)))) + (balance 0) (last 0) + quote partial lst) + (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]: + (setq balance (+ balance + (cond ((or (equal 91 ch) (equal 40 ch)) 1) + ((or (equal 93 ch) (equal 41 ch)) -1) + (t 0)))) + (when (and (equal 34 ch) (not (equal 92 last))) + (setq quote (not quote))) + (setq partial (cons ch partial)) + (when (and (= balance 0) (not quote) (funcall matched ch last)) + (setq lst (cons (apply #'string (nreverse + (if (consp alts) + (cddr partial) + (cdr partial)))) + lst)) + (setq partial nil)) + (setq last ch)) + (string-to-list string)) + (nreverse (cons (apply #'string (nreverse partial)) lst)))) (defun org-babel-join-splits-near-ch (ch list) "Join splits where \"=\" is on either end of the split." - (flet ((last= (str) (= ch (aref str (1- (length str))))) - (first= (str) (= ch (aref str 0)))) + (let ((last= (lambda (str) (= ch (aref str (1- (length str)))))) + (first= (lambda (str) (= ch (aref str 0))))) (reverse (org-reduce (lambda (acc el) - (let ((head (car acc))) - (if (and head (or (last= head) (first= el))) - (cons (concat head el) (cdr acc)) - (cons el acc)))) - list :initial-value nil)))) + (let ((head (car acc))) + (if (and head (or (funcall last= head) (funcall first= el))) + (cons (concat head el) (cdr acc)) + (cons el acc)))) + list :initial-value nil)))) (defun org-babel-parse-header-arguments (arg-string) "Parse a string of header arguments returning an alist." @@ -1322,20 +1399,20 @@ names." Return a cons cell, the `car' of which contains the TABLE less colnames, and the `cdr' of which contains a list of the column names. Note: this function removes any hlines in TABLE." - (flet ((trans (table) (apply #'mapcar* #'list table))) - (let* ((width (apply 'max - (mapcar (lambda (el) (if (listp el) (length el) 0)) table))) - (table (trans (mapcar (lambda (row) - (if (not (equal row 'hline)) - row - (setq row '()) - (dotimes (n width) - (setq row (cons 'hline row))) - row)) - table)))) - (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row)) - (trans (cdr table))) - (remove 'hline (car table)))))) + (let* ((trans (lambda (table) (apply #'mapcar* #'list table))) + (width (apply 'max + (mapcar (lambda (el) (if (listp el) (length el) 0)) table))) + (table (funcall trans (mapcar (lambda (row) + (if (not (equal row 'hline)) + row + (setq row '()) + (dotimes (n width) + (setq row (cons 'hline row))) + row)) + table)))) + (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row)) + (funcall trans (cdr table))) + (remove 'hline (car table))))) (defun org-babel-put-colnames (table colnames) "Add COLNAMES to TABLE if they exist." @@ -1410,7 +1487,7 @@ to the table for reinsertion to org-mode." Return the point at the beginning of the current source block. Specifically at the beginning of the #+BEGIN_SRC line. If the point is not on a source block then return nil." - (let ((initial (point)) top bottom) + (let ((initial (point)) (case-fold-search t) top bottom) (or (save-excursion ;; on a source name line or a #+header line (beginning-of-line 1) @@ -1418,7 +1495,8 @@ If the point is not on a source block then return nil." (looking-at org-babel-multi-line-header-regexp)) (progn (while (and (forward-line 1) - (looking-at org-babel-multi-line-header-regexp))) + (or (looking-at org-babel-src-name-regexp) + (looking-at org-babel-multi-line-header-regexp)))) (looking-at org-babel-src-block-regexp)) (point))) (save-excursion ;; on a #+begin_src line @@ -1439,26 +1517,49 @@ If the point is not on a source block then return nil." "Go to the beginning of the current code block." (interactive) ((lambda (head) - (if head (goto-char head) (error "not currently in a code block"))) + (if head (goto-char head) (error "Not currently in a code block"))) (org-babel-where-is-src-block-head))) ;;;###autoload (defun org-babel-goto-named-src-block (name) "Go to a named source-code block." (interactive - (let ((completion-ignore-case t)) - (list (org-icompleting-read "source-block name: " - (org-babel-src-block-names) nil t)))) + (let ((completion-ignore-case t) + (case-fold-search t) + (under-point (thing-at-point 'line))) + (list (org-icompleting-read + "source-block name: " (org-babel-src-block-names) nil t + (cond + ;; noweb + ((string-match (org-babel-noweb-wrap) under-point) + (let ((block-name (match-string 1 under-point))) + (string-match "[^(]*" block-name) + (match-string 0 block-name))) + ;; #+call: + ((string-match org-babel-lob-one-liner-regexp under-point) + (let ((source-info (car (org-babel-lob-get-info)))) + (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info) + (let ((source-name (match-string 1 source-info))) + source-name)))) + ;; #+results: + ((string-match (concat "#\\+" org-babel-results-keyword + "\\:\s+\\([^\\(]*\\)") under-point) + (match-string 1 under-point)) + ;; symbol-at-point + ((and (thing-at-point 'symbol)) + (org-babel-find-named-block (thing-at-point 'symbol)) + (thing-at-point 'symbol)) + ("")))))) (let ((point (org-babel-find-named-block name))) (if point ;; taken from `org-open-at-point' - (progn (goto-char point) (org-show-context)) + (progn (org-mark-ring-push) (goto-char point) (org-show-context)) (message "source-code block '%s' not found in this buffer" name)))) (defun org-babel-find-named-block (name) "Find a named source-code block. Return the location of the source block identified by source -NAME, or nil if no such block exists. Set match data according to +NAME, or nil if no such block exists. Set match data according to org-babel-named-src-block-regexp." (save-excursion (let ((case-fold-search t) @@ -1472,7 +1573,7 @@ org-babel-named-src-block-regexp." "Returns the names of source blocks in FILE or the current buffer." (save-excursion (when file (find-file file)) (goto-char (point-min)) - (let (names) + (let ((case-fold-search t) names) (while (re-search-forward org-babel-src-name-w-name-regexp nil t) (setq names (cons (match-string 3) names))) names))) @@ -1495,23 +1596,24 @@ org-babel-named-src-block-regexp." Return the location of the result named NAME in the current buffer or nil if no such result exists." (save-excursion - (goto-char (or point (point-min))) - (catch 'is-a-code-block - (when (re-search-forward - (concat org-babel-result-regexp - "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t) - (when (and (string= "name" (downcase (match-string 1))) - (or (beginning-of-line 1) - (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp))) - (throw 'is-a-code-block (org-babel-find-named-result name (point)))) - (beginning-of-line 0) (point))))) + (let ((case-fold-search t)) + (goto-char (or point (point-min))) + (catch 'is-a-code-block + (when (re-search-forward + (concat org-babel-result-regexp + "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t) + (when (and (string= "name" (downcase (match-string 1))) + (or (beginning-of-line 1) + (looking-at org-babel-src-block-regexp) + (looking-at org-babel-multi-line-header-regexp))) + (throw 'is-a-code-block (org-babel-find-named-result name (point)))) + (beginning-of-line 0) (point)))))) (defun org-babel-result-names (&optional file) "Returns the names of results in FILE or the current buffer." (save-excursion (when file (find-file file)) (goto-char (point-min)) - (let (names) + (let ((case-fold-search t) names) (while (re-search-forward org-babel-result-w-name-regexp nil t) (setq names (cons (match-string 4) names))) names))) @@ -1541,7 +1643,7 @@ With optional prefix argument ARG, jump backward ARG many source blocks." ;;;###autoload (defun org-babel-mark-block () - "Mark current src block" + "Mark current src block." (interactive) ((lambda (head) (when head @@ -1585,13 +1687,13 @@ region is not active then the point is demarcated." "" (concat "\n" (make-string (current-column) ? ))))))) (move-end-of-line 2)) - (sort (if (region-active-p) (list (mark) (point)) (list (point))) #'>)) + (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>)) (let ((start (point)) (lang (org-icompleting-read "Lang: " (mapcar (lambda (el) (symbol-name (car el))) org-babel-load-languages))) (body (delete-and-extract-region - (if (region-active-p) (mark) (point)) (point)))) + (if (org-region-active-p) (mark) (point)) (point)))) (insert (concat (if (looking-at "^") "" "\n") (if arg (concat stars "\n") "") "#+begin_src " lang "\n" @@ -1609,11 +1711,12 @@ source block. Specifically at the beginning of the results line. If no result exists for this block then create a results line following the source block." (save-excursion - (let* ((on-lob-line (save-excursion + (let* ((case-fold-search t) + (on-lob-line (save-excursion (beginning-of-line 1) (looking-at org-babel-lob-one-liner-regexp))) (inlinep (when (org-babel-get-inline-src-block-matches) - (match-end 0))) + (match-end 0))) (name (if on-lob-line (mapconcat #'identity (butlast (org-babel-lob-get-info)) "") (nth 4 (or info (org-babel-get-src-block-info 'light))))) @@ -1722,7 +1825,7 @@ If the path of the link is a file path it is expanded using `expand-file-name'." (let* ((case-fold-search t) (raw (and (looking-at org-bracket-link-regexp) - (org-babel-clean-text-properties (match-string 1)))) + (org-no-properties (match-string 1)))) (type (and (string-match org-link-types-re raw) (match-string 1 raw)))) (cond @@ -1734,17 +1837,13 @@ If the path of the link is a file path it is expanded using (defun org-babel-format-result (result &optional sep) "Format RESULT for writing to file." - (flet ((echo-res (result) - (if (stringp result) result (format "%S" result)))) + (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r))))) (if (listp result) ;; table result (orgtbl-to-generic - result - (list - :sep (or sep "\t") - :fmt 'echo-res)) + result (list :sep (or sep "\t") :fmt echo-res)) ;; scalar result - (echo-res result)))) + (funcall echo-res result)))) (defun org-babel-insert-result (result &optional result-params info hash indent lang) @@ -1752,7 +1851,7 @@ If the path of the link is a file path it is expanded using By default RESULT is inserted after the end of the current source block. With optional argument RESULT-PARAMS controls insertion of results in the org-mode file. -RESULT-PARAMS can take the following values... +RESULT-PARAMS can take the following values: replace - (default option) insert results after the source block replacing any previously inserted results @@ -1768,16 +1867,13 @@ raw ----- results are added directly to the Org-mode file. This is a good option if you code block will output org-mode formatted text. -wrap ---- results are added directly to the Org-mode file as with +drawer -- results are added directly to the Org-mode file as with \"raw\", but are wrapped in a RESULTS drawer, allowing them to later be replaced or removed automatically. -org ----- similar in effect to raw, only the results are wrapped - in an org code block. Similar to the raw option, on - export the results will be interpreted as org-formatted - text, however by wrapping the results in an org code - block they can be replaced upon re-execution of the - code block. +org ----- results are added inside of a \"#+BEGIN_SRC org\" block. + They are not comma-escaped when inserted, but Org syntax + here will be discarded when exporting the file. html ---- results are added inside of a #+BEGIN_HTML block. This is a good option if you code block will output html @@ -1794,9 +1890,12 @@ code ---- the results are extracted in the syntax of the source optional LANG argument." (if (stringp result) (progn - (setq result (org-babel-clean-text-properties result)) + (setq result (org-no-properties result)) (when (member "file" result-params) - (setq result (org-babel-result-to-file result)))) + (setq result (org-babel-result-to-file + result (when (assoc :file-desc (nth 2 info)) + (or (cdr (assoc :file-desc (nth 2 info))) + result)))))) (unless (listp result) (setq result (format "%S" result)))) (if (and result-params (member "silent" result-params)) (progn @@ -1838,12 +1937,13 @@ code ---- the results are extracted in the syntax of the source ((member "prepend" result-params)))) ; already there (setq results-switches (if results-switches (concat " " results-switches) "")) - (flet ((wrap (start finish) - (goto-char end) (insert (concat finish "\n")) - (goto-char beg) (insert (concat start "\n")) - (goto-char end) (goto-char (point-at-eol)) - (setq end (point-marker))) - (proper-list-p (it) (and (listp it) (null (cdr (last it)))))) + (let ((wrap (lambda (start finish &optional escape) + (goto-char end) (insert (concat finish "\n")) + (goto-char beg) (insert (concat start "\n")) + (if escape (org-add-protective-commas (point) end)) + (goto-char end) (goto-char (point-at-eol)) + (setq end (point-marker)))) + (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it))))))) ;; insert results based on type (cond ;; do nothing for an empty result @@ -1860,7 +1960,7 @@ code ---- the results are extracted in the syntax of the source '(:splicep nil :istart "- " :iend "\n"))) "\n")) ;; assume the result is a table if it's not a string - ((proper-list-p result) + ((funcall proper-list-p result) (goto-char beg) (insert (concat (orgtbl-to-orgtbl (if (or (eq 'hline (car result)) @@ -1869,30 +1969,35 @@ code ---- the results are extracted in the syntax of the source result (list result)) '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) (goto-char beg) (when (org-at-table-p) (org-table-align))) - ((and (listp result) (not (proper-list-p result))) + ((and (listp result) (not (funcall proper-list-p result))) (insert (format "%s\n" result))) ((member "file" result-params) (when inlinep (goto-char inlinep)) (insert result)) (t (goto-char beg) (insert result))) - (when (proper-list-p result) (goto-char (org-table-end))) + (when (funcall proper-list-p result) (goto-char (org-table-end))) (setq end (point-marker)) ;; possibly wrap result (cond + ((assoc :wrap (nth 2 info)) + (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS"))) + (funcall wrap (concat "#+BEGIN_" name) (concat "#+END_" name)))) ((member "html" result-params) - (wrap "#+BEGIN_HTML" "#+END_HTML")) + (funcall wrap "#+BEGIN_HTML" "#+END_HTML")) ((member "latex" result-params) - (wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) - ((member "code" result-params) - (wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) - "#+END_SRC")) + (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) ((member "org" result-params) - (wrap "#+BEGIN_ORG" "#+END_ORG")) + (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" 'escape)) + ((member "code" result-params) + (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) + "#+END_SRC")) ((member "raw" result-params) (goto-char beg) (if (org-at-table-p) (org-cycle))) - ((member "wrap" result-params) - (wrap ":RESULTS:" ":END:")) - ((and (not (proper-list-p result)) + ((or (member "drawer" result-params) + ;; Stay backward compatible with <7.9.2 + (member "wrap" result-params)) + (funcall wrap ":RESULTS:" ":END:")) + ((and (not (funcall proper-list-p result)) (not (member "file" result-params))) (org-babel-examplize-region beg end results-switches) (setq end (point))))) @@ -1919,44 +2024,40 @@ code ---- the results are extracted in the syntax of the source (delete-region start (org-babel-result-end)))))) (defun org-babel-result-end () - "Return the point at the end of the current set of results" + "Return the point at the end of the current set of results." (save-excursion (cond ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) ((org-at-item-p) (let* ((struct (org-list-struct)) (prvs (org-list-prevs-alist struct))) (org-list-get-list-end (point-at-bol) struct prvs))) - ((looking-at "^\\([ \t]*\\):RESULTS:") + ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:")) (progn (re-search-forward (concat "^" (match-string 1) ":END:")) (forward-char 1) (point))) (t - (let ((case-fold-search t) - (blocks-re (regexp-opt - (list "latex" "html" "example" "src" "result" "org")))) - (if (looking-at (concat "[ \t]*#\\+begin_" blocks-re)) - (progn (re-search-forward (concat "[ \t]*#\\+end_" blocks-re) nil t) + (let ((case-fold-search t)) + (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)")) + (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1)) + nil t) (forward-char 1)) (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") (forward-line 1)))) (point))))) -(defun org-babel-result-to-file (result) - "Convert RESULT into an `org-mode' link. +(defun org-babel-result-to-file (result &optional description) + "Convert RESULT into an `org-mode' link with optional DESCRIPTION. If the `default-directory' is different from the containing file's directory then expand relative links." - (flet ((cond-exp (file) - (if (and default-directory - buffer-file-name - (not (string= (expand-file-name default-directory) - (expand-file-name - (file-name-directory buffer-file-name))))) - (expand-file-name file default-directory) - file))) - (if (stringp result) - (format "[[file:%s]]" (cond-exp result)) - (when (and (listp result) (= 2 (length result)) - (stringp (car result)) (stringp (cadr result))) - (format "[[file:%s][%s]]" (car result) (cadr result)))))) + (when (stringp result) + (format "[[file:%s]%s]" + (if (and default-directory + buffer-file-name + (not (string= (expand-file-name default-directory) + (expand-file-name + (file-name-directory buffer-file-name))))) + (expand-file-name result default-directory) + result) + (if description (concat "[" description "]") "")))) (defvar org-babel-capitalize-examplize-region-markers nil "Make true to capitalize begin/end example markers inserted by code blocks.") @@ -1964,12 +2065,12 @@ file's directory then expand relative links." (defun org-babel-examplize-region (beg end &optional results-switches) "Comment out region using the inline '==' or ': ' org example quote." (interactive "*r") - (flet ((chars-between (b e) - (not (string-match "^[\\s]*$" (buffer-substring b e)))) - (maybe-cap (str) (if org-babel-capitalize-examplize-region-markers - (upcase str) str))) - (if (or (chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) - (chars-between end (save-excursion (goto-char end) (point-at-eol)))) + (let ((chars-between (lambda (b e) + (not (string-match "^[\\s]*$" (buffer-substring b e))))) + (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers + (upcase str) str)))) + (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) + (funcall chars-between end (save-excursion (goto-char end) (point-at-eol)))) (save-excursion (goto-char beg) (insert (format "=%s=" (prog1 (buffer-substring beg end) @@ -1985,16 +2086,16 @@ file's directory then expand relative links." (goto-char beg) (insert (if results-switches (format "%s%s\n" - (maybe-cap "#+begin_example") + (funcall maybe-cap "#+begin_example") results-switches) - (maybe-cap "#+begin_example\n"))) + (funcall maybe-cap "#+begin_example\n"))) (if (markerp end) (goto-char end) (forward-char (- end beg))) - (insert (maybe-cap "#+end_example\n"))))))))) + (insert (funcall maybe-cap "#+end_example\n"))))))))) (defun org-babel-update-block-body (new-body) "Update the body of the current code block to NEW-BODY." (if (not (org-babel-where-is-src-block-head)) - (error "not in source block") + (error "Not in a source block") (save-match-data (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5)) (indent-rigidly (match-beginning 5) (match-end 5) 2))) @@ -2004,104 +2105,108 @@ file's directory then expand relative links." Later elements of PLISTS override the values of previous elements. This takes into account some special considerations for certain parameters when merging lists." - (let ((results-exclusive-groups - (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'results org-babel-common-header-args-w-values)))) - (exports-exclusive-groups - (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'exports org-babel-common-header-args-w-values)))) - (variable-index 0) - params results exports tangle noweb cache vars shebang comments padline) - (flet ((e-merge (exclusive-groups &rest result-params) - ;; maintain exclusivity of mutually exclusive parameters - (let (output) - (mapc (lambda (new-params) - (mapc (lambda (new-param) - (mapc (lambda (exclusive-group) - (when (member new-param exclusive-group) - (mapcar (lambda (excluded-param) - (setq output - (delete - excluded-param - output))) - exclusive-group))) - exclusive-groups) - (setq output (org-uniquify - (cons new-param output)))) - new-params)) - result-params) - output))) - (mapc - (lambda (plist) - (mapc - (lambda (pair) - (case (car pair) - (:var - (let ((name (if (listp (cdr pair)) - (cadr pair) - (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" - (cdr pair)) - (intern (match-string 1 (cdr pair))))))) - (if name - (setq vars - (append - (if (member name (mapcar #'car vars)) - (delq nil - (mapcar - (lambda (p) - (unless (equal (car p) name) p)) - vars)) - vars) - (list (cons name pair)))) - ;; if no name is given and we already have named variables - ;; then assign to named variables in order - (if (and vars (nth variable-index vars)) - (prog1 (setf (cddr (nth variable-index vars)) - (concat (symbol-name - (car (nth variable-index vars))) - "=" (cdr pair))) - (incf variable-index)) - (error "variable \"%s\" must be assigned a default value" - (cdr pair)))))) - (:results - (setq results (e-merge results-exclusive-groups - results - (split-string - (let ((r (cdr pair))) - (if (stringp r) r (eval r))))))) - (:file - (when (cdr pair) - (setq results (e-merge results-exclusive-groups - results '("file"))) - (unless (or (member "both" exports) - (member "none" exports) - (member "code" exports)) - (setq exports (e-merge exports-exclusive-groups - exports '("results")))) - (setq params (cons pair (assq-delete-all (car pair) params))))) - (:exports - (setq exports (e-merge exports-exclusive-groups - exports (split-string (cdr pair))))) - (:tangle ;; take the latest -- always overwrite - (setq tangle (or (list (cdr pair)) tangle))) - (:noweb - (setq noweb (e-merge '(("yes" "no" "tangle")) noweb - (split-string (or (cdr pair) ""))))) - (:cache - (setq cache (e-merge '(("yes" "no")) cache + (let* ((results-exclusive-groups + (mapcar (lambda (group) (mapcar #'symbol-name group)) + (cdr (assoc 'results org-babel-common-header-args-w-values)))) + (exports-exclusive-groups + (mapcar (lambda (group) (mapcar #'symbol-name group)) + (cdr (assoc 'exports org-babel-common-header-args-w-values)))) + (variable-index 0) + (e-merge (lambda (exclusive-groups &rest result-params) + ;; maintain exclusivity of mutually exclusive parameters + (let (output) + (mapc (lambda (new-params) + (mapc (lambda (new-param) + (mapc (lambda (exclusive-group) + (when (member new-param exclusive-group) + (mapcar (lambda (excluded-param) + (setq output + (delete + excluded-param + output))) + exclusive-group))) + exclusive-groups) + (setq output (org-uniquify + (cons new-param output)))) + new-params)) + result-params) + output))) + params results exports tangle noweb cache vars shebang comments padline) + + (mapc + (lambda (plist) + (mapc + (lambda (pair) + (case (car pair) + (:var + (let ((name (if (listp (cdr pair)) + (cadr pair) + (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" + (cdr pair)) + (intern (match-string 1 (cdr pair))))))) + (if name + (setq vars + (append + (if (member name (mapcar #'car vars)) + (delq nil + (mapcar + (lambda (p) + (unless (equal (car p) name) p)) + vars)) + vars) + (list (cons name pair)))) + ;; if no name is given and we already have named variables + ;; then assign to named variables in order + (if (and vars (nth variable-index vars)) + (prog1 (setf (cddr (nth variable-index vars)) + (concat (symbol-name + (car (nth variable-index vars))) + "=" (cdr pair))) + (incf variable-index)) + (error "Variable \"%s\" must be assigned a default value" + (cdr pair)))))) + (:results + (setq results (funcall e-merge results-exclusive-groups + results + (split-string + (let ((r (cdr pair))) + (if (stringp r) r (eval r))))))) + (:file + (when (cdr pair) + (setq results (funcall e-merge results-exclusive-groups + results '("file"))) + (unless (or (member "both" exports) + (member "none" exports) + (member "code" exports)) + (setq exports (funcall e-merge exports-exclusive-groups + exports '("results")))) + (setq params (cons pair (assq-delete-all (car pair) params))))) + (:exports + (setq exports (funcall e-merge exports-exclusive-groups + exports (split-string (cdr pair))))) + (:tangle ;; take the latest -- always overwrite + (setq tangle (or (list (cdr pair)) tangle))) + (:noweb + (setq noweb (funcall e-merge + '(("yes" "no" "tangle" "no-export" + "strip-export" "eval")) + noweb + (split-string (or (cdr pair) ""))))) + (:cache + (setq cache (funcall e-merge '(("yes" "no")) cache + (split-string (or (cdr pair) ""))))) + (:padline + (setq padline (funcall e-merge '(("yes" "no")) padline (split-string (or (cdr pair) ""))))) - (:padline - (setq padline (e-merge '(("yes" "no")) padline - (split-string (or (cdr pair) ""))))) - (:shebang ;; take the latest -- always overwrite - (setq shebang (or (list (cdr pair)) shebang))) - (:comments - (setq comments (e-merge '(("yes" "no")) comments - (split-string (or (cdr pair) ""))))) - (t ;; replace: this covers e.g. :session - (setq params (cons pair (assq-delete-all (car pair) params)))))) - plist)) - plists)) + (:shebang ;; take the latest -- always overwrite + (setq shebang (or (list (cdr pair)) shebang))) + (:comments + (setq comments (funcall e-merge '(("yes" "no")) comments + (split-string (or (cdr pair) ""))))) + (t ;; replace: this covers e.g. :session + (setq params (cons pair (assq-delete-all (car pair) params)))))) + plist)) + plists) (setq vars (reverse vars)) (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) (mapc @@ -2118,6 +2223,21 @@ This results in much faster noweb reference expansion but does not properly allow code blocks to inherit the \":noweb-ref\" header argument from buffer or subtree wide properties.") +(defun org-babel-noweb-p (params context) + "Check if PARAMS require expansion in CONTEXT. +CONTEXT may be one of :tangle, :export or :eval." + (let* (intersect + (intersect (lambda (as bs) + (when as + (if (member (car as) bs) + (car as) + (funcall intersect (cdr as) bs)))))) + (funcall intersect (case context + (:tangle '("yes" "tangle" "no-export" "strip-export")) + (:eval '("yes" "no-export" "strip-export" "eval")) + (:export '("yes"))) + (split-string (or (cdr (assoc :noweb params)) ""))))) + (defun org-babel-expand-noweb-references (&optional info parent-buffer) "Expand Noweb references in the body of the current source code block. @@ -2152,105 +2272,104 @@ block but are passed literally to the \"example-block\"." (info (or info (org-babel-get-src-block-info))) (lang (nth 0 info)) (body (nth 1 info)) + (ob-nww-start org-babel-noweb-wrap-start) + (ob-nww-end org-babel-noweb-wrap-end) (comment (string= "noweb" (cdr (assoc :comments (nth 2 info))))) (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|" ":noweb-ref[ \t]+" "\\)")) - (new-body "") index source-name evaluate prefix blocks-in-buffer) - (flet ((nb-add (text) (setq new-body (concat new-body text))) - (c-wrap (text) + (new-body "") + (nb-add (lambda (text) (setq new-body (concat new-body text)))) + (c-wrap (lambda (text) (with-temp-buffer (funcall (intern (concat lang "-mode"))) (comment-region (point) (progn (insert text) (point))) (org-babel-trim (buffer-string))))) - (with-temp-buffer - (insert body) (goto-char (point-min)) - (setq index (point)) - (while (and (re-search-forward "<<\\([^ \t\n].+?[^ \t\n]\\|[^ \t\n]\\)>>" - nil t)) - (save-match-data (setf source-name (match-string 1))) - (save-match-data (setq evaluate (string-match "\(.*\)" source-name))) - (save-match-data - (setq prefix - (buffer-substring (match-beginning 0) - (save-excursion - (beginning-of-line 1) (point))))) - ;; add interval to new-body (removing noweb reference) - (goto-char (match-beginning 0)) - (nb-add (buffer-substring index (point))) - (goto-char (match-end 0)) - (setq index (point)) - (nb-add - (with-current-buffer parent-buffer - (save-restriction - (widen) - (mapconcat ;; interpose PREFIX between every line - #'identity - (split-string - (if evaluate - (let ((raw (org-babel-ref-resolve source-name))) - (if (stringp raw) raw (format "%S" raw))) - (or - ;; retrieve from the library of babel - (nth 2 (assoc (intern source-name) - org-babel-library-of-babel)) - ;; return the contents of headlines literally - (save-excursion - (when (org-babel-ref-goto-headline-id source-name) - (org-babel-ref-headline-body))) - ;; find the expansion of reference in this buffer - (let ((rx (concat rx-prefix source-name "[ \t\n]")) - expansion) - (save-excursion - (goto-char (point-min)) - (if *org-babel-use-quick-and-dirty-noweb-expansion* - (while (re-search-forward rx nil t) - (let* ((i (org-babel-get-src-block-info 'light)) - (body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - ((lambda (cs) - (concat (c-wrap (car cs)) "\n" - body "\n" - (c-wrap (cadr cs)))) - (org-babel-tangle-comment-links i)) - body))) - (setq expansion (cons sep (cons full expansion))))) - (org-babel-map-src-blocks nil - (let ((i (org-babel-get-src-block-info 'light))) - (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) - (nth 4 i)) - source-name) - (let* ((body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - ((lambda (cs) - (concat (c-wrap (car cs)) "\n" - body "\n" - (c-wrap (cadr cs)))) - (org-babel-tangle-comment-links i)) - body))) - (setq expansion - (cons sep (cons full expansion))))))))) - (and expansion - (mapconcat #'identity (nreverse (cdr expansion)) ""))) - ;; possibly raise an error if named block doesn't exist - (if (member lang org-babel-noweb-error-langs) - (error "%s" (concat - "<<" source-name ">> " - "could not be resolved (see " - "`org-babel-noweb-error-langs')")) - ""))) - "[\n\r]") (concat "\n" prefix)))))) - (nb-add (buffer-substring index (point-max))))) + index source-name evaluate prefix blocks-in-buffer) + (with-temp-buffer + (org-set-local 'org-babel-noweb-wrap-start ob-nww-start) + (org-set-local 'org-babel-noweb-wrap-end ob-nww-end) + (insert body) (goto-char (point-min)) + (setq index (point)) + (while (and (re-search-forward (org-babel-noweb-wrap) nil t)) + (save-match-data (setf source-name (match-string 1))) + (save-match-data (setq evaluate (string-match "\(.*\)" source-name))) + (save-match-data + (setq prefix + (buffer-substring (match-beginning 0) + (save-excursion + (beginning-of-line 1) (point))))) + ;; add interval to new-body (removing noweb reference) + (goto-char (match-beginning 0)) + (funcall nb-add (buffer-substring index (point))) + (goto-char (match-end 0)) + (setq index (point)) + (funcall nb-add + (with-current-buffer parent-buffer + (save-restriction + (widen) + (mapconcat ;; interpose PREFIX between every line + #'identity + (split-string + (if evaluate + (let ((raw (org-babel-ref-resolve source-name))) + (if (stringp raw) raw (format "%S" raw))) + (or + ;; retrieve from the library of babel + (nth 2 (assoc (intern source-name) + org-babel-library-of-babel)) + ;; return the contents of headlines literally + (save-excursion + (when (org-babel-ref-goto-headline-id source-name) + (org-babel-ref-headline-body))) + ;; find the expansion of reference in this buffer + (let ((rx (concat rx-prefix source-name "[ \t\n]")) + expansion) + (save-excursion + (goto-char (point-min)) + (if *org-babel-use-quick-and-dirty-noweb-expansion* + (while (re-search-forward rx nil t) + (let* ((i (org-babel-get-src-block-info 'light)) + (body (org-babel-expand-noweb-references i)) + (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + "\n")) + (full (if comment + ((lambda (cs) + (concat (funcall c-wrap (car cs)) "\n" + body "\n" + (funcall c-wrap (cadr cs)))) + (org-babel-tangle-comment-links i)) + body))) + (setq expansion (cons sep (cons full expansion))))) + (org-babel-map-src-blocks nil + (let ((i (org-babel-get-src-block-info 'light))) + (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) + (nth 4 i)) + source-name) + (let* ((body (org-babel-expand-noweb-references i)) + (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + "\n")) + (full (if comment + ((lambda (cs) + (concat (funcall c-wrap (car cs)) "\n" + body "\n" + (funcall c-wrap (cadr cs)))) + (org-babel-tangle-comment-links i)) + body))) + (setq expansion + (cons sep (cons full expansion))))))))) + (and expansion + (mapconcat #'identity (nreverse (cdr expansion)) ""))) + ;; possibly raise an error if named block doesn't exist + (if (member lang org-babel-noweb-error-langs) + (error "%s" (concat + (org-babel-noweb-wrap source-name) + "could not be resolved (see " + "`org-babel-noweb-error-langs')")) + ""))) + "[\n\r]") (concat "\n" prefix)))))) + (funcall nb-add (buffer-substring index (point-max)))) new-body)) -(defun org-babel-clean-text-properties (text) - "Strip all properties from text return." - (when text - (set-text-properties 0 (length text) nil text) text)) - (defun org-babel-strip-protective-commas (body &optional lang) "Strip protective commas from bodies of source blocks." (with-temp-buffer @@ -2340,14 +2459,14 @@ If the table is trivial, then return it as a scalar." (let (result) (save-window-excursion (with-temp-buffer - (condition-case nil + (condition-case err (progn (org-table-import file-name separator) (delete-file file-name) (setq result (mapcar (lambda (row) (mapcar #'org-babel-string-read row)) (org-table-to-lisp)))) - (error nil))) + (error (message "Error reading results: %s" err) nil))) (if (null (cdr result)) ;; if result is trivial vector, then scalarize it (if (consp (car result)) (if (null (cdr (car result))) @@ -2361,7 +2480,7 @@ If the table is trivial, then return it as a scalar." (org-babel-read (or (and (stringp cell) (string-match "\\\"\\(.+\\)\\\"" cell) (match-string 1 cell)) - cell))) + cell) t)) (defun org-babel-reverse-string (string) "Return the reverse of STRING." @@ -2388,7 +2507,7 @@ of the string." (defvar org-babel-org-babel-call-process-region-original nil) (defun org-babel-tramp-handle-call-process-region (start end program &optional delete buffer display &rest args) - "Use tramp to handle call-process-region. + "Use Tramp to handle `call-process-region'. Fixes a bug in `tramp-handle-call-process-region'." (if (and (featurep 'tramp) (file-remote-p default-directory)) (let ((tmpfile (tramp-compat-make-temp-file ""))) @@ -2400,7 +2519,7 @@ Fixes a bug in `tramp-handle-call-process-region'." (apply 'process-file program tmpfile buffer display args) (delete-file tmpfile))) ;; org-babel-call-process-region-original is the original emacs - ;; definition. It is in scope from the let binding in + ;; definition. It is in scope from the let binding in ;; org-babel-execute-src-block (apply org-babel-call-process-region-original start end program delete buffer display args))) @@ -2410,17 +2529,16 @@ Fixes a bug in `tramp-handle-call-process-region'." (if (file-remote-p file) (let (localname) (with-parsed-tramp-file-name file nil - localname)) + localname)) file)) (defun org-babel-process-file-name (name &optional no-quote-p) "Prepare NAME to be used in an external process. If NAME specifies a remote location, the remote portion of the name is removed, since in that case the process will be executing -remotely. The file name is then processed by -`expand-file-name'. Unless second argument NO-QUOTE-P is non-nil, -the file name is additionally processed by -`shell-quote-argument'" +remotely. The file name is then processed by `expand-file-name'. +Unless second argument NO-QUOTE-P is non-nil, the file name is +additionally processed by `shell-quote-argument'" ((lambda (f) (if no-quote-p f (shell-quote-argument f))) (expand-file-name (org-babel-local-file-name name)))) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 2b4a001979..97241b6ac6 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -29,15 +29,15 @@ ;; The functions `org-batch-agenda', `org-batch-agenda-csv', and ;; `org-batch-store-agenda-views' are implemented as macros to provide ;; a convenient way for extracting agenda information from the command -;; line. The Lisp does not evaluate parameters of a macro call; thus +;; line. The Lisp does not evaluate parameters of a macro call; thus ;; it is not necessary to quote the parameters passed to one of those -;; functions. E.g. you can write: +;; functions. E.g. you can write: ;; ;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)' ;; -;; To export an agenda spanning 7 days. If `org-batch-agenda' would +;; To export an agenda spanning 7 days. If `org-batch-agenda' would ;; have been implemented as a regular function you'd have to quote the -;; symbol org-agenda-span. Moreover: To use a symbol as parameter +;; symbol org-agenda-span. Moreover: To use a symbol as parameter ;; value you would have to double quote the symbol. ;; ;; This is a hack, but it works even when running Org byte-compiled. @@ -46,6 +46,7 @@ ;;; Code: (require 'org) +(require 'org-macs) (eval-when-compile (require 'cl)) @@ -80,23 +81,30 @@ (declare-function org-habit-get-priority "org-habit" (habit &optional moment)) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) - -(defvar calendar-mode-map) -(defvar org-clock-current-task) ; defined in org-clock.el -(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el -(defvar org-habit-show-habits) +(declare-function org-agenda-columns "org-colview" ()) +(declare-function org-add-archive-files "org-archive" (files)) +(declare-function org-capture "org-capture" (&optional goto keys)) + +(defvar calendar-mode-map) ; defined in calendar.el +(defvar org-clock-current-task nil) ; defined in org-clock.el +(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el +(defvar org-habit-show-habits) ; defined in org-habit.el (defvar org-habit-show-habits-only-for-today) +(defvar org-habit-show-all-today) ;; Defined somewhere in this file, but used before definition. -(defvar org-agenda-buffer-name) -(defvar org-agenda-overriding-header) +(defvar org-agenda-buffer-name "*Org Agenda*") +(defvar org-agenda-overriding-header nil) (defvar org-agenda-title-append nil) -(defvar entry) -(defvar date) -(defvar org-agenda-undo-list) -(defvar org-agenda-pending-undo-list) +(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el +(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el (defvar original-date) ; dynamically scoped, calendar.el does scope this +(defvar org-agenda-undo-list nil + "List of undoable operations in the agenda since last refresh.") +(defvar org-agenda-pending-undo-list nil + "In a series of undo commands, this is the list of remaining undo items.") + (defcustom org-agenda-confirm-kill 1 "When set, remote killing from the agenda buffer needs confirmation. When t, a confirmation is always needed. When a number N, confirmation is @@ -127,9 +135,9 @@ addresses the separator between the current and the previous block." (string))) (defgroup org-agenda-export nil - "Options concerning exporting agenda views in Org-mode." - :tag "Org Agenda Export" - :group 'org-agenda) + "Options concerning exporting agenda views in Org-mode." + :tag "Org Agenda Export" + :group 'org-agenda) (defcustom org-agenda-with-colors t "Non-nil means use colors in agenda views." @@ -152,8 +160,8 @@ before assigned to the variables. So make sure to quote values you do (sexp :tag "Value")))) (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text) - "Hook run in temporary buffer before writing it to an export file. -A useful function is `org-agenda-add-entry-text'." + "Hook run in a temporary buffer before writing the agenda to an export file. +A useful function for this hook is `org-agenda-add-entry-text'." :group 'org-agenda-export :type 'hook :options '(org-agenda-add-entry-text)) @@ -161,7 +169,7 @@ A useful function is `org-agenda-add-entry-text'." (defcustom org-agenda-add-entry-text-maxlines 0 "Maximum number of entry text lines to be added to agenda. This is only relevant when `org-agenda-add-entry-text' is part of -`org-agenda-before-write-hook', which it is by default. +`org-agenda-before-write-hook', which is the default. When this is 0, nothing will happen. When it is greater than 0, it specifies the maximum number of lines that will be added for each entry that is listed in the agenda view. @@ -180,7 +188,7 @@ When this variable nil, the URL will (also) be shown." :group 'org-agenda :type 'boolean) -(defcustom org-agenda-export-html-style "" +(defcustom org-agenda-export-html-style nil "The style specification for exported HTML Agenda files. If this variable contains a string, it will replace the default <style> section as produced by `htmlize'. @@ -216,8 +224,7 @@ or, if you want to keep the style in a file, <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> As the value of this option simply gets inserted into the HTML <head> header, -you can \"misuse\" it to also add other text to the header. However, -<style>...</style> is required, if not present the variable will be ignored." +you can \"misuse\" it to also add other text to the header." :group 'org-agenda-export :group 'org-export-html :type 'string) @@ -228,9 +235,9 @@ you can \"misuse\" it to also add other text to the header. However, :type 'boolean) (defgroup org-agenda-custom-commands nil - "Options concerning agenda views in Org-mode." - :tag "Org Agenda Custom Commands" - :group 'org-agenda) + "Options concerning agenda views in Org-mode." + :tag "Org Agenda Custom Commands" + :group 'org-agenda) (defconst org-sorting-choice '(choice @@ -247,116 +254,118 @@ you can \"misuse\" it to also add other text to the header. However, ;; Keep custom values for `org-agenda-filter-preset' compatible with ;; the new variable `org-agenda-tag-filter-preset'. -(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) +(if (fboundp 'defvaralias) + (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) + (defvaralias 'org-agenda-filter 'org-agenda-tag-filter)) (defconst org-agenda-custom-commands-local-options - `(repeat :tag "Local settings for this command. Remember to quote values" + `(repeat :tag "Local settings for this command. Remember to quote values" (choice :tag "Setting" - (list :tag "Heading for this block" - (const org-agenda-overriding-header) - (string :tag "Headline")) - (list :tag "Files to be searched" - (const org-agenda-files) - (list - (const :format "" quote) - (repeat (file)))) - (list :tag "Sorting strategy" - (const org-agenda-sorting-strategy) - (list - (const :format "" quote) - (repeat - ,org-sorting-choice))) - (list :tag "Prefix format" - (const org-agenda-prefix-format :value " %-12:c%?-12t% s") - (string)) - (list :tag "Number of days in agenda" - (const org-agenda-span) - (choice (const :tag "Day" 'day) - (const :tag "Week" 'week) - (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")) - (list :tag "Start on day of week" - (const org-agenda-start-on-weekday) - (choice :value 1 - (const :tag "Today" nil) - (integer :tag "Weekday No."))) - (list :tag "Include data from diary" - (const org-agenda-include-diary) - (boolean)) - (list :tag "Deadline Warning days" - (const org-deadline-warning-days) - (integer :value 1)) - (list :tag "Category filter preset" - (const org-agenda-category-filter-preset) - (list - (const :format "" quote) - (repeat - (string :tag "+category or -category")))) - (list :tag "Tags filter preset" - (const org-agenda-tag-filter-preset) - (list - (const :format "" quote) - (repeat - (string :tag "+tag or -tag")))) - (list :tag "Set daily/weekly entry types" - (const org-agenda-entry-types) - (list - (const :format "" quote) - (set :greedy t :value (:deadline :scheduled :timestamp :sexp) - (const :deadline) - (const :scheduled) - (const :timestamp) - (const :sexp)))) - (list :tag "Standard skipping condition" - :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) - (const org-agenda-skip-function) - (list - (const :format "" quote) - (list - (choice - :tag "Skipping range" - (const :tag "Skip entry" org-agenda-skip-entry-if) - (const :tag "Skip subtree" org-agenda-skip-subtree-if)) - (repeat :inline t :tag "Conditions for skipping" - (choice - :tag "Condition type" - (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp)) - (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp)) - (list :tag "TODO state is" :inline t - (const 'todo) + (list :tag "Heading for this block" + (const org-agenda-overriding-header) + (string :tag "Headline")) + (list :tag "Files to be searched" + (const org-agenda-files) + (list + (const :format "" quote) + (repeat (file)))) + (list :tag "Sorting strategy" + (const org-agenda-sorting-strategy) + (list + (const :format "" quote) + (repeat + ,org-sorting-choice))) + (list :tag "Prefix format" + (const org-agenda-prefix-format :value " %-12:c%?-12t% s") + (string)) + (list :tag "Number of days in agenda" + (const org-agenda-span) + (choice (const :tag "Day" 'day) + (const :tag "Week" 'week) + (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")) + (list :tag "Start on day of week" + (const org-agenda-start-on-weekday) + (choice :value 1 + (const :tag "Today" nil) + (integer :tag "Weekday No."))) + (list :tag "Include data from diary" + (const org-agenda-include-diary) + (boolean)) + (list :tag "Deadline Warning days" + (const org-deadline-warning-days) + (integer :value 1)) + (list :tag "Category filter preset" + (const org-agenda-category-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+category or -category")))) + (list :tag "Tags filter preset" + (const org-agenda-tag-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+tag or -tag")))) + (list :tag "Set daily/weekly entry types" + (const org-agenda-entry-types) + (list + (const :format "" quote) + (set :greedy t :value (:deadline :scheduled :timestamp :sexp) + (const :deadline) + (const :scheduled) + (const :timestamp) + (const :sexp)))) + (list :tag "Standard skipping condition" + :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) + (const org-agenda-skip-function) + (list + (const :format "" quote) + (list + (choice + :tag "Skipping range" + (const :tag "Skip entry" org-agenda-skip-entry-if) + (const :tag "Skip subtree" org-agenda-skip-subtree-if)) + (repeat :inline t :tag "Conditions for skipping" (choice - (const :tag "any not-done state" 'todo) - (const :tag "any done state" 'done) - (const :tag "any state" 'any) - (list :tag "Keyword list" - (const :format "" quote) - (repeat (string :tag "Keyword"))))) - (list :tag "TODO state is not" :inline t - (const 'nottodo) - (choice - (const :tag "any not-done state" 'todo) - (const :tag "any done state" 'done) - (const :tag "any state" 'any) - (list :tag "Keyword list" - (const :format "" quote) - (repeat (string :tag "Keyword"))))) - (const :tag "scheduled" 'scheduled) - (const :tag "not scheduled" 'notscheduled) - (const :tag "deadline" 'deadline) - (const :tag "no deadline" 'notdeadline) - (const :tag "timestamp" 'timestamp) - (const :tag "no timestamp" 'nottimestamp)))))) - (list :tag "Non-standard skipping condition" - :value (org-agenda-skip-function) - (const org-agenda-skip-function) - (sexp :tag "Function or form (quoted!)")) - (list :tag "Any variable" - (variable :tag "Variable") - (sexp :tag "Value (sexp)")))) + :tag "Condition type" + (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp)) + (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp)) + (list :tag "TODO state is" :inline t + (const 'todo) + (choice + (const :tag "any not-done state" 'todo) + (const :tag "any done state" 'done) + (const :tag "any state" 'any) + (list :tag "Keyword list" + (const :format "" quote) + (repeat (string :tag "Keyword"))))) + (list :tag "TODO state is not" :inline t + (const 'nottodo) + (choice + (const :tag "any not-done state" 'todo) + (const :tag "any done state" 'done) + (const :tag "any state" 'any) + (list :tag "Keyword list" + (const :format "" quote) + (repeat (string :tag "Keyword"))))) + (const :tag "scheduled" 'scheduled) + (const :tag "not scheduled" 'notscheduled) + (const :tag "deadline" 'deadline) + (const :tag "no deadline" 'notdeadline) + (const :tag "timestamp" 'timestamp) + (const :tag "no timestamp" 'nottimestamp)))))) + (list :tag "Non-standard skipping condition" + :value (org-agenda-skip-function) + (const org-agenda-skip-function) + (sexp :tag "Function or form (quoted!)")) + (list :tag "Any variable" + (variable :tag "Variable") + (sexp :tag "Value (sexp)")))) "Selection of examples for agenda command settings. This will be spliced into the custom type of `org-agenda-custom-commands'.") @@ -434,69 +443,69 @@ should provide a description for the prefix, like :group 'org-agenda-custom-commands :type `(repeat (choice :value ("x" "Describe command here" tags "" nil) - (list :tag "Single command" - (string :tag "Access Key(s) ") - (option (string :tag "Description")) - (choice - (const :tag "Agenda" agenda) - (const :tag "TODO list" alltodo) - (const :tag "Search words" search) - (const :tag "Stuck projects" stuck) - (const :tag "Tags/Property match (all agenda files)" tags) - (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) - (const :tag "TODO keyword search (all agenda files)" todo) - (const :tag "Tags sparse tree (current buffer)" tags-tree) - (const :tag "TODO keyword tree (current buffer)" todo-tree) - (const :tag "Occur tree (current buffer)" occur-tree) - (sexp :tag "Other, user-defined function")) - (string :tag "Match (only for some commands)") - ,org-agenda-custom-commands-local-options - (option (repeat :tag "Export" (file :tag "Export to")))) - (list :tag "Command series, all agenda files" - (string :tag "Access Key(s)") - (string :tag "Description ") - (repeat :tag "Component" - (choice - (list :tag "Agenda" - (const :format "" agenda) - (const :tag "" :format "" "") - ,org-agenda-custom-commands-local-options) - (list :tag "TODO list (all keywords)" - (const :format "" alltodo) - (const :tag "" :format "" "") - ,org-agenda-custom-commands-local-options) - (list :tag "Search words" - (const :format "" search) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "Stuck projects" - (const :format "" stuck) - (const :tag "" :format "" "") - ,org-agenda-custom-commands-local-options) - (list :tag "Tags search" - (const :format "" tags) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "Tags search, TODO entries only" - (const :format "" tags-todo) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "TODO keyword search" - (const :format "" todo) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "Other, user-defined function" - (symbol :tag "function") - (string :tag "Match") - ,org-agenda-custom-commands-local-options))) - - (repeat :tag "Settings for entire command set" - (list (variable :tag "Any variable") - (sexp :tag "Value"))) - (option (repeat :tag "Export" (file :tag "Export to")))) - (cons :tag "Prefix key documentation" - (string :tag "Access Key(s)") - (string :tag "Description "))))) + (list :tag "Single command" + (string :tag "Access Key(s) ") + (option (string :tag "Description")) + (choice + (const :tag "Agenda" agenda) + (const :tag "TODO list" alltodo) + (const :tag "Search words" search) + (const :tag "Stuck projects" stuck) + (const :tag "Tags/Property match (all agenda files)" tags) + (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) + (const :tag "TODO keyword search (all agenda files)" todo) + (const :tag "Tags sparse tree (current buffer)" tags-tree) + (const :tag "TODO keyword tree (current buffer)" todo-tree) + (const :tag "Occur tree (current buffer)" occur-tree) + (sexp :tag "Other, user-defined function")) + (string :tag "Match (only for some commands)") + ,org-agenda-custom-commands-local-options + (option (repeat :tag "Export" (file :tag "Export to")))) + (list :tag "Command series, all agenda files" + (string :tag "Access Key(s)") + (string :tag "Description ") + (repeat :tag "Component" + (choice + (list :tag "Agenda" + (const :format "" agenda) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "TODO list (all keywords)" + (const :format "" alltodo) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "Search words" + (const :format "" search) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Stuck projects" + (const :format "" stuck) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "Tags search" + (const :format "" tags) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Tags search, TODO entries only" + (const :format "" tags-todo) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "TODO keyword search" + (const :format "" todo) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Other, user-defined function" + (symbol :tag "function") + (string :tag "Match") + ,org-agenda-custom-commands-local-options))) + + (repeat :tag "Settings for entire command set" + (list (variable :tag "Any variable") + (sexp :tag "Value"))) + (option (repeat :tag "Export" (file :tag "Export to")))) + (cons :tag "Prefix key documentation" + (string :tag "Access Key(s)") + (string :tag "Description "))))) (defcustom org-agenda-query-register ?o "The register holding the current query string. @@ -550,9 +559,9 @@ this one will be used." (const :tag "equal" "="))) (defgroup org-agenda-skip nil - "Options concerning skipping parts of agenda files." - :tag "Org Agenda Skip" - :group 'org-agenda) + "Options concerning skipping parts of agenda files." + :tag "Org Agenda Skip" + :group 'org-agenda) (defcustom org-agenda-skip-function-global nil "Function to be called at each match during agenda construction. @@ -636,11 +645,11 @@ all Don't show any entries with a timestamp in the global todo list. The idea behind this is that by setting a timestamp, you have already \"taken care\" of this item. -This variable can also have an integer as a value. If positive (N), -todos with a timestamp N or more days in the future will be ignored. If +This variable can also have an integer as a value. If positive (N), +todos with a timestamp N or more days in the future will be ignored. If negative (-N), todos with a timestamp N or more days in the past will be -ignored. If 0, todos with a timestamp either today or in the future will -be ignored. For example, a value of -1 will exclude todos with a +ignored. If 0, todos with a timestamp either today or in the future will +be ignored. For example, a value of -1 will exclude todos with a timestamp in the past (yesterday or earlier), while a value of 7 will exclude todos with a timestamp a week or more in the future. @@ -674,7 +683,7 @@ all Don't show any scheduled entries in the global todo list. t Same as `all', for backward compatibility. -This variable can also have an integer as a value. See +This variable can also have an integer as a value. See `org-agenda-todo-ignore-timestamp' for more details. See also `org-agenda-todo-ignore-with-date'. @@ -715,7 +724,7 @@ all Ignore all TODO entries that do have a deadline. t Same as `near', for backward compatibility. -This variable can also have an integer as a value. See +This variable can also have an integer as a value. See `org-agenda-todo-ignore-timestamp' for more details. See also `org-agenda-todo-ignore-with-date'. @@ -774,6 +783,21 @@ but not scheduled today." (const :tag "Always" t) (const :tag "Not when scheduled today" not-today))) +(defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil + "Non-nil means skip timestamp line if same entry shows because of deadline. +In the agenda of today, an entry can show up multiple times +because it has both a plain timestamp and has a nearby deadline. +When this variable is t, then only the deadline is shown and the +fact that the entry has a timestamp for or including today is not +shown. When this variable is nil, the entry will be shown +several times." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :version "24.1" + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t))) + (defcustom org-agenda-skip-deadline-if-done nil "Non-nil means don't show deadlines when the corresponding item is done. When nil, the deadline is still shown and should give you a happy feeling. @@ -799,7 +823,7 @@ because you will take care of it on the day when scheduled." :group 'org-agenda-daily/weekly :version "24.1" :type '(choice - (const :tag "Always show prewarning" nil) + (const :tag "Alwas show prewarning" nil) (const :tag "Remove prewarning if entry is scheduled" t) (integer :tag "Restart prewarning N days before deadline"))) @@ -860,12 +884,14 @@ N days, just insert a special line indicating the size of the gap." When nil, the matcher string is not shown, but is put into the help-echo property so than moving the mouse over the command shows it. Setting it to nil is good if matcher strings are very long and/or if -you want to use two-column display (see `org-agenda-menu-two-column')." +you want to use two-columns display (see `org-agenda-menu-two-columns')." :group 'org-agenda :version "24.1" :type 'boolean) -(defcustom org-agenda-menu-two-column nil +(define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3") + +(defcustom org-agenda-menu-two-columns nil "Non-nil means, use two columns to show custom commands in the dispatcher. If you use this, you probably want to set `org-agenda-menu-show-matcher' to nil." @@ -873,8 +899,14 @@ to nil." :version "24.1" :type 'boolean) -(defcustom org-finalize-agenda-hook nil - "Hook run just before displaying an agenda buffer." +(define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3") +(defcustom org-agenda-finalize-hook nil + "Hook run just before displaying an agenda buffer. +The buffer is still writable when the hook is called. + +You can modify some of the buffer substrings but you should be +extra careful not to modify the text properties of the agenda +headlines as the agenda display heavily relies on them." :group 'org-agenda-startup :type 'hook) @@ -932,7 +964,8 @@ have been removed when this is called, as will any matches for regular 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 and timeline. +Dynamically scoped.") (defgroup org-agenda-windows nil "Options concerning the windows used by the Agenda in Org Mode." @@ -975,11 +1008,11 @@ option will be ignored." :type 'boolean) (defcustom org-agenda-ndays nil - "Number of days to include in overview display. + "Number of days to include in overview display. Should be 1 or 7. Obsolete, see `org-agenda-span'." - :group 'org-agenda-daily/weekly - :type 'integer) + :group 'org-agenda-daily/weekly + :type 'integer) (make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1") @@ -1202,10 +1235,18 @@ agenda display." :type 'boolean) (defcustom org-agenda-start-with-log-mode nil - "The initial value of log-mode in a newly created agenda window." + "The initial value of log-mode in a newly created agenda window. +See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further +explanations on the possible values." :group 'org-agenda-startup :group 'org-agenda-daily/weekly - :type 'boolean) + :type '(choice (const :tag "Don't show log items" nil) + (const :tag "Show only log items" 'only) + (const :tag "Show all possible log items" 'clockcheck) + (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'" + (choice (const :tag "Show closed log items" 'closed) + (const :tag "Show clocked log items" 'clock) + (const :tag "Show all logged state changes" 'state))))) (defcustom org-agenda-start-with-clockreport-mode nil "The initial value of clockreport-mode in a newly created agenda window." @@ -1501,8 +1542,10 @@ Custom commands can set this variable in the options section." :group 'org-agenda-line-format) (defvar org-prefix-format-compiled nil - "The compiled version of the most recently used prefix format. -See the variable `org-agenda-prefix-format'.") + "The compiled prefix format and associated variables. +This is a list where first element is a list of variable bindings, and second +element is the compiled format expression. See the variable +`org-agenda-prefix-format'.") (defcustom org-agenda-todo-keyword-format "%-1s" "Format for the TODO keyword in agenda lines. @@ -1511,6 +1554,16 @@ to occupy a fixed space in the agenda display." :group 'org-agenda-line-format :type 'string) +(defcustom org-agenda-diary-sexp-prefix nil + "A regexp that matches part of a diary sexp entry +which should be treated as scheduling/deadline information in +`org-agenda'. + +For example, you can use this to extract the `diary-remind-message' from +`diary-remind' entries." + :group 'org-agenda-line-format + :type '(choice (const :tag "None" nil) (regexp :tag "Regexp"))) + (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") "Text preceding timerange entries in the agenda view. This is a list with two strings. The first applies when the range @@ -1659,7 +1712,7 @@ determines if it is a foreground or a background color." (defcustom org-agenda-day-face-function nil "Function called to determine what face should be used to display a day. -The only argument passed to that function is the day. It should +The only argument passed to that function is the day. It should returns a face, or nil if does not want to specify a face and let the normal rules apply." :group 'org-agenda-line-format @@ -1762,10 +1815,6 @@ Note that functions in this alist don't need to be quoted." :version "24.1" :group 'org-agenda) -(eval-when-compile - (require 'cl)) -(require 'org) - (defmacro org-agenda-with-point-at-orig-entry (string &rest body) "Execute BODY with point at location given by `org-hd-marker' property. If STRING is non-nil, the text property will be fetched from position 0 @@ -1789,7 +1838,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (setcdr ass (cdr entry)) (push entry org-agenda-custom-commands)))) -;;; Define the Org-agenda-mode +;;; Define the org-agenda-mode (defvar org-agenda-mode-map (make-sparse-keymap) "Keymap for `org-agenda-mode'.") @@ -1797,7 +1846,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvaralias 'org-agenda-keymap 'org-agenda-mode-map)) (defvar org-agenda-menu) ; defined later in this file. -(defvar org-agenda-restrict) ; defined later in this file. +(defvar org-agenda-restrict nil) ; defined later in this file. (defvar org-agenda-follow-mode nil) (defvar org-agenda-entry-text-mode nil) (defvar org-agenda-clockreport-mode nil) @@ -1805,10 +1854,76 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvar org-agenda-redo-command nil) (defvar org-agenda-query-string nil) (defvar org-agenda-mode-hook nil - "Hook for `org-agenda-mode', run after the mode is turned on.") + "Hook run after `org-agenda-mode' is turned on. +The buffer is still writable when this hook is called.") (defvar org-agenda-type nil) (defvar org-agenda-force-single-file nil) -(defvar org-agenda-bulk-marked-entries) ;; Defined further down in this file +(defvar org-agenda-bulk-marked-entries nil + "List of markers that refer to marked entries in the agenda.") + +;;; Multiple agenda buffers support + +(defcustom org-agenda-sticky nil + "Non-nil means agenda q key will bury agenda buffers. +Agenda commands will then show existing buffer instead of generating new ones. +When nil, `q' will kill the single agenda buffer." + :group 'org-agenda + :version "24.3" + :type 'boolean) + +;;;###autoload +(defun org-toggle-sticky-agenda (&optional arg) + "Toggle `org-agenda-sticky'." + (interactive "P") + (let ((new-value (if arg + (> (prefix-numeric-value arg) 0) + (not org-agenda-sticky)))) + (if (equal new-value org-agenda-sticky) + (and (org-called-interactively-p 'interactive) + (message "Sticky agenda was already %s" + (if org-agenda-sticky "enabled" "disabled"))) + (setq org-agenda-sticky new-value) + (org-agenda-kill-all-agenda-buffers) + (and (org-called-interactively-p 'interactive) + (message "Sticky agenda was %s" + (if org-agenda-sticky "enabled" "disabled")))))) + +(defvar org-agenda-buffer nil + "Agenda buffer currently being generated.") + +(defvar org-agenda-last-prefix-arg nil) +(defvar org-agenda-this-buffer-name nil) +(defvar org-agenda-doing-sticky-redo nil) +(defvar org-agenda-this-buffer-is-sticky nil) + +(defconst org-agenda-local-vars + '(org-agenda-this-buffer-name + org-agenda-undo-list + org-agenda-pending-undo-list + org-agenda-follow-mode + org-agenda-entry-text-mode + org-agenda-clockreport-mode + org-agenda-show-log + org-agenda-redo-command + org-agenda-query-string + org-agenda-type + org-agenda-bulk-marked-entries + org-agenda-undo-has-started-in + org-agenda-info + org-agenda-tag-filter-overlays + org-agenda-cat-filter-overlays + org-agenda-pre-window-conf + org-agenda-columns-active + org-agenda-tag-filter + org-agenda-category-filter + org-agenda-markers + org-agenda-last-search-view-search-was-boolean + org-agenda-filtered-by-category + org-agenda-filter-form + org-agenda-show-window + org-agenda-cycle-counter + org-agenda-last-prefix-arg) + "Variables that must be local in agenda buffers to allow multiple buffers.") (defun org-agenda-mode () "Mode for time-sorted view on action items in Org-mode files. @@ -1817,7 +1932,30 @@ The following commands are available: \\{org-agenda-mode-map}" (interactive) - (kill-all-local-variables) + (cond (org-agenda-doing-sticky-redo + ;; Refreshing sticky agenda-buffer + ;; + ;; Preserve the value of `org-agenda-local-vars' variables, + ;; while letting `kill-all-local-variables' kill the rest + (let ((save (buffer-local-variables))) + (kill-all-local-variables) + (mapc 'make-local-variable org-agenda-local-vars) + (dolist (elem save) + (let ((var (car elem)) + (val (cdr elem))) + (when (and val + (member var org-agenda-local-vars)) + (set var val))))) + (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) + (org-agenda-sticky + ;; Creating a sticky Agenda buffer for the first time + (kill-all-local-variables) + (mapc 'make-local-variable org-agenda-local-vars) + (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) + (t + ;; Creating a non-sticky agenda buffer + (kill-all-local-variables) + (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil))) (setq org-agenda-undo-list nil org-agenda-pending-undo-list nil org-agenda-bulk-marked-entries nil) @@ -1829,14 +1967,13 @@ The following commands are available: (easy-menu-add org-agenda-menu) (if org-startup-truncated (setq truncate-lines t)) (org-set-local 'line-move-visual nil) - (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) + (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) ;; Make sure properties are removed when copying text - (when (boundp 'buffer-substring-filters) - (org-set-local 'buffer-substring-filters - (cons (lambda (x) - (set-text-properties 0 (length x) nil x) x) - buffer-substring-filters))) + (make-local-variable 'filter-buffer-substring-functions) + (add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (substring-no-properties (funcall fun start end delete)))) (unless org-agenda-keep-modes (setq org-agenda-follow-mode org-agenda-start-with-follow-mode org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode @@ -1868,11 +2005,13 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) (org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile) (org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark) +(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all) (org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp) (org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark) -(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-remove-all-marks) -(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda) +(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-unmark-all) (org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action) +(org-defkey org-agenda-mode-map "k" 'org-agenda-capture) +(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda) (org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload) (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default) (org-defkey org-agenda-mode-map "\C-c\C-xa" 'org-agenda-toggle-archive-tag) @@ -1901,8 +2040,6 @@ The following commands are available: (org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) (org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note) (org-defkey org-agenda-mode-map "z" 'org-agenda-add-note) -(org-defkey org-agenda-mode-map "k" 'org-agenda-action) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-k" 'org-agenda-action) (org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later) (org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier) (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later) @@ -1913,7 +2050,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) (let ((l '(1 2 3 4 5 6 7 8 9 0))) (while l (org-defkey org-agenda-mode-map - (int-to-string (pop l)) 'digit-argument))) + (int-to-string (pop l)) 'digit-argument))) (org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode) (org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode) @@ -1924,21 +2061,23 @@ The following commands are available: (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" 'org-agenda-redo) +(org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t))) (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-clock-modify-effort-estimate) (org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property) (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) +(org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit) (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write) (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) (org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) -(org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority) (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags) (org-defkey org-agenda-mode-map "n" 'org-agenda-next-line) (org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line) +(org-defkey org-agenda-mode-map "N" 'org-agenda-next-item) +(org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item) (substitute-key-definition 'next-line 'org-agenda-next-line org-agenda-mode-map global-map) (substitute-key-definition 'previous-line 'org-agenda-previous-line @@ -1946,8 +2085,8 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach) (org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line) (org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line) -(org-defkey org-agenda-mode-map "," 'org-agenda-priority) (org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority) +(org-defkey org-agenda-mode-map "," 'org-agenda-priority) (org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry) (org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar) (org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date) @@ -1981,6 +2120,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag) (org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) (org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category) +(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-category) (org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) (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) @@ -2034,7 +2174,7 @@ The following commands are available: ["Show some entry text" org-agenda-entry-text-mode :style toggle :selected org-agenda-entry-text-mode :active t] - "--" + "--" ["Show Logbook entries" org-agenda-log-mode :style toggle :selected org-agenda-show-log :active (org-agenda-check-type nil 'agenda 'timeline) @@ -2054,9 +2194,10 @@ The following commands are available: ["Show original entry" org-agenda-show t] ["Go To (other window)" org-agenda-goto t] ["Go To (this window)" org-agenda-switch-to t] + ["Capture with cursor date" org-agenda-capture t] ["Follow Mode" org-agenda-follow-mode :style toggle :selected org-agenda-follow-mode :active t] -; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] + ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] "--" ("TODO" ["Cycle TODO" org-agenda-todo t] @@ -2075,10 +2216,11 @@ The following commands are available: ["Delete subtree" org-agenda-kill t]) ("Bulk action" ["Mark entry" org-agenda-bulk-mark t] + ["Mark all" org-agenda-bulk-mark-all t] ["Mark matching regexp" org-agenda-bulk-mark-regexp t] ["Unmark entry" org-agenda-bulk-unmark t] - ["Unmark all entries" org-agenda-bulk-remove-all-marks :active t :keys "C-u s"]) - ["Act on all marked" org-agenda-bulk-action t] + ["Unmark all entries" org-agenda-bulk-unmark-all :active t :keys "U"]) + ["Act on all marked" org-agenda-bulk-action t] "--" ("Tags and Properties" ["Show all Tags" org-agenda-show-tags t] @@ -2090,11 +2232,6 @@ The following commands are available: ["Schedule" org-agenda-schedule t] ["Set Deadline" org-agenda-deadline t] "--" - ["Mark item" org-agenda-action :active t :keys "k m"] - ["Show mark item" org-agenda-action :active t :keys "k v"] - ["Schedule marked item" org-agenda-action :active t :keys "k s"] - ["Set Deadline for marked item" org-agenda-action :active t :keys "k d"] - "--" ["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"] @@ -2115,7 +2252,7 @@ The following commands are available: ["Set Priority" org-agenda-priority t] ["Increase Priority" org-agenda-priority-up t] ["Decrease Priority" org-agenda-priority-down t] - ["Show Priority" org-agenda-show-priority 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)] @@ -2144,12 +2281,8 @@ The following commands are available: (defvar org-agenda-allow-remote-undo t "Non-nil means allow remote undo from the agenda buffer.") -(defvar org-agenda-undo-list nil - "List of undoable operations in the agenda since last refresh.") (defvar org-agenda-undo-has-started-in nil "Buffers that have already seen `undo-start' in the current undo sequence.") -(defvar org-agenda-pending-undo-list nil - "In a series of undo commands, this is the list of remaining undo items.") (defun org-agenda-undo () "Undo a remote editing step in the agenda. @@ -2193,14 +2326,60 @@ that have been changed along." ;;; Agenda dispatch -(defvar org-agenda-restrict nil) (defvar org-agenda-restrict-begin (make-marker)) (defvar org-agenda-restrict-end (make-marker)) (defvar org-agenda-last-dispatch-buffer nil) (defvar org-agenda-overriding-restriction nil) +(defcustom org-agenda-custom-commands-contexts nil + "Alist of custom agenda keys and contextual rules. + +For example, if you have a custom agenda command \"p\" and you +want this command to be accessible only from plain text files, +use this: + + '((\"p\" (in-file . \"\\.txt\"))) + +Here are the available contexts definitions: + + in-file: command displayed only in matching files + in-mode: command displayed only in matching modes + not-in-file: command not displayed in matching files + not-in-mode: command not displayed in matching modes + [function]: a custom function taking no argument + +If you define several checks, the agenda command will be +accessible if there is at least one valid check. + +You can also bind a key to another agenda custom command +depending on contextual rules. + + '((\"p\" \"q\" (in-file . \"\\.txt\"))) + +Here it means: in .txt files, use \"p\" as the key for the +agenda command otherwise associated with \"q\". (The command +originally associated with \"q\" is not displayed to avoid +duplicates.)" + :version "24.3" + :group 'org-agenda-custom-commands + :type '(repeat (list :tag "Rule" + (string :tag " Agenda key") + (string :tag "Replace by command") + (repeat :tag "Available when" + (choice + (cons :tag "Condition" + (choice + (const :tag "In file" in-file) + (const :tag "Not in file" not-in-file) + (const :tag "In mode" in-mode) + (const :tag "Not in mode" not-in-mode)) + (regexp)) + (function :tag "Custom function")))))) + +(defvar org-keys nil) +(defvar org-match nil) ;;;###autoload -(defun org-agenda (&optional arg keys restriction) +(defun org-agenda (&optional arg org-keys restriction) "Dispatch agenda commands to collect entries to the agenda buffer. Prompts for a command to execute. Any prefix arg will be passed on to the selected command. The default selections are: @@ -2215,6 +2394,7 @@ 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. / Multi occur across all agenda files and also files listed in `org-agenda-text-search-extra-files'. < Restrict agenda commands to buffer, subtree, or region. @@ -2236,6 +2416,7 @@ Pressing `<' twice means to restrict to the current subtree or region (interactive "P") (catch 'exit (let* ((prefix-descriptions nil) + (org-agenda-buffer-name org-agenda-buffer-name) (org-agenda-window-setup (if (equal (buffer-name) org-agenda-buffer-name) 'current-window @@ -2253,9 +2434,12 @@ Pressing `<' twice means to restrict to the current subtree or region ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) (t (cons (car x) (cons "" (cdr x)))))) org-agenda-custom-commands))) + (org-agenda-custom-commands + (org-contextualize-keys + org-agenda-custom-commands org-agenda-custom-commands-contexts)) (buf (current-buffer)) (bfn (buffer-file-name (buffer-base-buffer))) - entry key type match lprops ans) + entry key type org-match lprops ans) ;; Turn off restriction unless there is an overriding one, (unless org-agenda-overriding-restriction (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list) @@ -2270,10 +2454,16 @@ Pressing `<' twice means to restrict to the current subtree or region (put 'org-agenda-redo-command 'last-args nil) ;; Remember where this call originated (setq org-agenda-last-dispatch-buffer (current-buffer)) - (unless keys + (unless org-keys (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) - keys (car ans) + org-keys (car ans) restriction (cdr ans))) + ;; If we have sticky agenda buffers, set a name for the buffer, + ;; depending on the invoking keys. The user may still set this + ;; as a command option, which will overwrite what we do here. + (if org-agenda-sticky + (setq org-agenda-buffer-name + (format "*Org Agenda(%s)*" org-keys))) ;; Establish the restriction, if any (when (and (not org-agenda-overriding-restriction) restriction) (put 'org-agenda-files 'org-restrict (list bfn)) @@ -2292,11 +2482,15 @@ Pressing `<' twice means to restrict to the current subtree or region ;; For example the todo list should not need it (but does...) (cond - ((setq entry (assoc keys org-agenda-custom-commands)) + ((setq entry (assoc org-keys org-agenda-custom-commands)) (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) (progn - (setq type (nth 2 entry) match (eval (nth 3 entry)) + (setq type (nth 2 entry) org-match (eval (nth 3 entry)) lprops (nth 4 entry)) + (if org-agenda-sticky + (setq org-agenda-buffer-name + (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match)) + (format "*Org Agenda(%s)*" org-keys)))) (put 'org-agenda-redo-command 'org-lprops lprops) (cond ((eq type 'agenda) @@ -2304,44 +2498,45 @@ Pressing `<' twice means to restrict to the current subtree or region ((eq type 'alltodo) (org-let lprops '(org-todo-list current-prefix-arg))) ((eq type 'search) - (org-let lprops '(org-search-view current-prefix-arg match nil))) + (org-let lprops '(org-search-view current-prefix-arg org-match nil))) ((eq type 'stuck) (org-let lprops '(org-agenda-list-stuck-projects current-prefix-arg))) ((eq type 'tags) - (org-let lprops '(org-tags-view current-prefix-arg match))) + (org-let lprops '(org-tags-view current-prefix-arg org-match))) ((eq type 'tags-todo) - (org-let lprops '(org-tags-view '(4) match))) + (org-let lprops '(org-tags-view '(4) org-match))) ((eq type 'todo) - (org-let lprops '(org-todo-list match))) + (org-let lprops '(org-todo-list org-match))) ((eq type 'tags-tree) (org-check-for-org-mode) - (org-let lprops '(org-match-sparse-tree current-prefix-arg match))) + (org-let lprops '(org-match-sparse-tree current-prefix-arg org-match))) ((eq type 'todo-tree) (org-check-for-org-mode) (org-let lprops '(org-occur (concat "^" org-outline-regexp "[ \t]*" - (regexp-quote match) "\\>")))) + (regexp-quote org-match) "\\>")))) ((eq type 'occur-tree) (org-check-for-org-mode) - (org-let lprops '(org-occur match))) + (org-let lprops '(org-occur org-match))) ((functionp type) - (org-let lprops '(funcall type match))) + (org-let lprops '(funcall type org-match))) ((fboundp type) - (org-let lprops '(funcall type match))) + (org-let lprops '(funcall type org-match))) (t (error "Invalid custom agenda command type %s" type)))) (org-agenda-run-series (nth 1 entry) (cddr entry)))) - ((equal keys "C") + ((equal org-keys "C") (setq org-agenda-custom-commands org-agenda-custom-commands-orig) (customize-variable 'org-agenda-custom-commands)) - ((equal keys "a") (call-interactively 'org-agenda-list)) - ((equal keys "s") (call-interactively 'org-search-view)) - ((equal keys "t") (call-interactively 'org-todo-list)) - ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) - ((equal keys "m") (call-interactively 'org-tags-view)) - ((equal keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) - ((equal keys "e") (call-interactively 'org-store-agenda-views)) - ((equal keys "?") (org-tags-view nil "+FLAGGED") + ((equal org-keys "a") (call-interactively 'org-agenda-list)) + ((equal org-keys "s") (call-interactively 'org-search-view)) + ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4)))) + ((equal org-keys "t") (call-interactively 'org-todo-list)) + ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) + ((equal org-keys "m") (call-interactively 'org-tags-view)) + ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) + ((equal org-keys "e") (call-interactively 'org-store-agenda-views)) + ((equal org-keys "?") (org-tags-view nil "+FLAGGED") (org-add-hook 'post-command-hook (lambda () @@ -2357,15 +2552,15 @@ Pressing `<' twice means to restrict to the current subtree or region (copy-sequence note)) nil 'face 'org-warning))))))) t t)) - ((equal keys "L") - (unless (eq major-mode 'org-mode) + ((equal org-keys "L") + (unless (derived-mode-p 'org-mode) (error "This is not an Org-mode file")) (unless restriction (put 'org-agenda-files 'org-restrict (list bfn)) (org-call-with-arg 'org-timeline arg))) - ((equal keys "#") (call-interactively 'org-agenda-list-stuck-projects)) - ((equal keys "/") (call-interactively 'org-occur-in-agenda-files)) - ((equal keys "!") (customize-variable 'org-stuck-projects)) + ((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)) (t (error "Invalid agenda key")))))) (defun org-agenda-append-agenda () @@ -2373,11 +2568,13 @@ Pressing `<' twice means to restrict to the current subtree or region This function allows interactive building of block agendas. Agenda views are separated by `org-agenda-block-separator'." (interactive) - (unless (string= (buffer-name) org-agenda-buffer-name) + (unless (derived-mode-p 'org-agenda-mode) (error "Can only append from within agenda buffer")) (let ((org-agenda-multi t)) (org-agenda) - (widen))) + (widen) + (org-agenda-finalize) + (org-agenda-fit-window-to-buffer))) (defun org-agenda-normalize-custom-commands (cmds) (delq nil @@ -2393,7 +2590,7 @@ Agenda views are separated by `org-agenda-block-separator'." "The user interface for selecting an agenda command." (catch 'exit (let* ((bfn (buffer-file-name (buffer-base-buffer))) - (restrict-ok (and bfn (eq major-mode 'org-mode))) + (restrict-ok (and bfn (derived-mode-p 'org-mode))) (region-p (org-region-active-p)) (custom org-agenda-custom-commands) (selstring "") @@ -2406,15 +2603,15 @@ Agenda views are separated by `org-agenda-block-separator'." (erase-buffer) (insert (eval-when-compile (let ((header -" -Press key for an agenda command: < Buffer, subtree/region restriction + "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) -s Search for keywords C Configure custom agenda commands -/ Multi-occur ? Find :FLAGGED: entries +/ Multi-occur C Configure custom agenda commands +? Find :FLAGGED: entries * Toggle sticky agenda views ") (start 0)) (while (string-match @@ -2474,13 +2671,12 @@ s Search for keywords C Configure custom agenda commands ((stringp match) (setq match (copy-sequence match)) (org-add-props match nil 'face 'org-warning)) - (match - (format "set of %d commands" (length match))) - (t "")))) + ((listp type) + (format "set of %d commands" (length type)))))) (if (org-string-nw-p match) (add-text-properties 0 (length line) (list 'help-echo - (concat "Matcher: "match)) line))) + (concat "Matcher: " match)) line))) (push line lines))) (setq lines (nreverse lines)) (when prefixes @@ -2497,7 +2693,7 @@ s Search for keywords C Configure custom agenda commands prefixes)) ;; Check if we should display in two columns - (if org-agenda-menu-two-column + (if org-agenda-menu-two-columns (progn (setq n (length lines) n1 (+ (/ n 2) (mod n 2)) @@ -2547,6 +2743,9 @@ s Search for keywords C Configure custom agenda commands nil (cons (substring (car x) 1) (cdr x)))) custom)))) + ((eq c ?*) + (call-interactively 'org-toggle-sticky-agenda) + (sit-for 2)) ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) (message "Restriction is only possible in Org-mode buffers") (ding) (sit-for 1)) @@ -2568,7 +2767,7 @@ s Search for keywords C Configure custom agenda commands ((eq c ?>) (org-agenda-remove-restriction-lock 'noupdate) (setq restriction nil)) - ((and (equal selstring "") (memq c '(?s ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) + ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) ((and (> (length selstring) 0) (eq c ?\d)) (delete-window) @@ -2577,55 +2776,72 @@ s Search for keywords C Configure custom agenda commands ((equal c ?q) (error "Abort")) (t (error "Invalid key %c" c)))))))) -(defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter -(defvar org-agenda-last-arguments nil - "The arguments of the previous call to `org-agenda'.") +(defun org-agenda-fit-window-to-buffer () + "Fit the window to the buffer size." + (and (memq org-agenda-window-setup '(reorganize-frame)) + (fboundp 'fit-window-to-buffer) + (org-fit-window-to-buffer + nil + (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) + (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) + +(defvar org-cmd nil) +(defvar org-agenda-overriding-cmd nil) +(defvar org-agenda-overriding-arguments nil) +(defvar org-agenda-overriding-cmd-arguments nil) (defun org-agenda-run-series (name series) - (org-let (nth 1 series) '(org-prepare-agenda name)) + (org-let (nth 1 series) '(org-agenda-prepare name)) + ;; We need to reset agenda markers here, because when constructing a + ;; block agenda, the individual blocks do not do that. + (org-agenda-reset-markers) (let* ((org-agenda-multi t) (redo (list 'org-agenda-run-series name (list 'quote series))) - (org-agenda-overriding-arguments - (or org-agenda-overriding-arguments - (unless (null (delq nil (get 'org-agenda-redo-command 'last-args))) - (get 'org-agenda-redo-command 'last-args)))) (cmds (car series)) (gprops (nth 1 series)) match ;; The byte compiler incorrectly complains about this. Keep it! - cmd type lprops) - (while (setq cmd (pop cmds)) - (setq type (car cmd) match (eval (nth 1 cmd)) lprops (nth 2 cmd)) - (cond - ((eq type 'agenda) - (org-let2 gprops lprops - '(call-interactively 'org-agenda-list))) - ((eq type 'alltodo) - (org-let2 gprops lprops - '(call-interactively 'org-todo-list))) - ((eq type 'search) - (org-let2 gprops lprops - '(org-search-view current-prefix-arg match nil))) - ((eq type 'stuck) - (org-let2 gprops lprops - '(call-interactively 'org-agenda-list-stuck-projects))) - ((eq type 'tags) - (org-let2 gprops lprops - '(org-tags-view current-prefix-arg match))) - ((eq type 'tags-todo) - (org-let2 gprops lprops - '(org-tags-view '(4) match))) - ((eq type 'todo) - (org-let2 gprops lprops - '(org-todo-list match))) - ((fboundp type) - (org-let2 gprops lprops - '(funcall type match))) - (t (error "Invalid type in command series")))) + org-cmd type lprops) + (while (setq org-cmd (pop cmds)) + (setq type (car org-cmd) + match (eval (nth 1 org-cmd)) + lprops (nth 2 org-cmd)) + (let ((org-agenda-overriding-arguments + (if (eq org-agenda-overriding-cmd org-cmd) + (or org-agenda-overriding-arguments + org-agenda-overriding-cmd-arguments)))) + (cond + ((eq type 'agenda) + (org-let2 gprops lprops + '(call-interactively 'org-agenda-list))) + ((eq type 'alltodo) + (org-let2 gprops lprops + '(call-interactively 'org-todo-list))) + ((eq type 'search) + (org-let2 gprops lprops + '(org-search-view current-prefix-arg match nil))) + ((eq type 'stuck) + (org-let2 gprops lprops + '(call-interactively 'org-agenda-list-stuck-projects))) + ((eq type 'tags) + (org-let2 gprops lprops + '(org-tags-view current-prefix-arg match))) + ((eq type 'tags-todo) + (org-let2 gprops lprops + '(org-tags-view '(4) match))) + ((eq type 'todo) + (org-let2 gprops lprops + '(org-todo-list match))) + ((fboundp type) + (org-let2 gprops lprops + '(funcall type match))) + (t (error "Invalid type in command series"))))) (widen) + (let ((inhibit-read-only t)) + (add-text-properties (point-min) (point-max) + `(org-serie t org-serie-redo-cmd ,redo))) (setq org-agenda-redo-command redo) - (put 'org-agenda-redo-command 'last-args org-agenda-last-arguments) (goto-char (point-min))) - (org-fit-agenda-window) - (org-let (nth 1 series) '(org-finalize-agenda))) + (org-agenda-fit-window-to-buffer) + (org-let (nth 1 series) '(org-agenda-finalize))) ;;;###autoload (defmacro org-batch-agenda (cmd-key &rest parameters) @@ -2743,7 +2959,6 @@ This ensures the export commands can easily use it." (setq res (replace-match ";" t t res))) (org-trim res))) - ;;;###autoload (defun org-store-agenda-views (&rest parameters) (interactive) @@ -2756,11 +2971,18 @@ This ensures the export commands can easily use it." (pop-up-frames nil) (dir default-directory) (pars (org-make-parameter-alist parameters)) - cmd thiscmdkey files opts cmd-or-set) + cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname) (save-window-excursion (while cmds (setq cmd (pop cmds) thiscmdkey (car cmd) + thiscmdcmd (cdr cmd) + match (nth 2 thiscmdcmd) + bufname (if org-agenda-sticky + (or (and (stringp match) + (format "*Org Agenda(%s:%s)*" thiscmdkey match)) + (format "*Org Agenda(%s)*" thiscmdkey)) + org-agenda-buffer-name) cmd-or-set (nth 2 cmd) opts (nth (if (listp cmd-or-set) 3 4) cmd) files (nth (if (listp cmd-or-set) 4 5) cmd)) @@ -2769,15 +2991,17 @@ This ensures the export commands can easily use it." (org-eval-in-environment (append org-agenda-exporter-settings opts pars) (org-agenda nil thiscmdkey)) - (set-buffer org-agenda-buffer-name) + (set-buffer bufname) (while files (org-eval-in-environment (append org-agenda-exporter-settings opts pars) - (org-agenda-write (expand-file-name (pop files) dir) nil t))) - (and (get-buffer org-agenda-buffer-name) - (kill-buffer org-agenda-buffer-name))))))) + (org-agenda-write (expand-file-name (pop files) dir) nil t bufname))) + (and (get-buffer bufname) + (kill-buffer bufname))))))) (def-edebug-spec org-batch-store-agenda-views (&rest sexp)) +(defvar org-agenda-current-span nil + "The current span used in the agenda view.") ; local variable in the agenda buffer (defun org-agenda-mark-header-line (pos) "Mark the line at POS as an agenda structure header." (save-excursion @@ -2788,9 +3012,9 @@ This ensures the export commands can easily use it." (put-text-property (point-at-bol) (point-at-eol) 'org-agenda-title-append org-agenda-title-append)))) -(defvar org-mobile-creating-agendas) +(defvar org-mobile-creating-agendas) ; defined in org-mobile.el (defvar org-agenda-write-buffer-name "Agenda View") -(defun org-agenda-write (file &optional open nosettings) +(defun org-agenda-write (file &optional open nosettings agenda-bufname) "Write the current buffer (an agenda view) as a file. Depending on the extension of the file name, plain text (.txt), HTML (.html or .htm) or Postscript (.ps) is produced. @@ -2801,7 +3025,8 @@ With prefix argument OPEN, open the new file immediately. If NOSETTINGS is given, do not scope the settings of `org-agenda-exporter-settings' into the export commands. This is used when the settings have already been scoped and we do not wish to overrule other, -higher priority settings." +higher priority settings. +If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (interactive "FWrite agenda to file: \nP") (if (not (file-writable-p file)) (error "Cannot write agenda to file %s" file)) @@ -2828,9 +3053,7 @@ higher priority settings." ((string-match "\\.html?\\'" file) (require 'htmlize) (set-buffer (htmlize-buffer (current-buffer))) - - (when (and org-agenda-export-html-style - (string-match "<style>" org-agenda-export-html-style)) + (when org-agenda-export-html-style ;; replace <style> section with org-agenda-export-html-style (goto-char (point-min)) (kill-region (- (search-forward "<style") 6) @@ -2870,7 +3093,9 @@ higher priority settings." (save-buffer 0) (kill-buffer (current-buffer)) (message "Plain text written to %s" file)))))))) - (set-buffer org-agenda-buffer-name)) + (set-buffer (or agenda-bufname + (and (called-interactively-p 'any) (buffer-name)) + org-agenda-buffer-name))) (when open (org-open-file file))) (defvar org-agenda-tag-filter-overlays nil) @@ -2933,7 +3158,7 @@ removed from the entry content. Currently only `planning' is allowed here." (let (txt drawer-re kwd-time-re ind) (save-excursion (with-current-buffer (marker-buffer marker) - (if (not (eq major-mode 'org-mode)) + (if (not (derived-mode-p 'org-mode)) (setq txt "") (save-excursion (save-restriction @@ -3049,28 +3274,19 @@ removed from the entry content. Currently only `planning' is allowed here." (defun org-check-for-org-mode () "Make sure current buffer is in org-mode. Error if not." - (or (eq major-mode 'org-mode) + (or (derived-mode-p 'org-mode) (error "Cannot execute org-mode agenda command on buffer in %s" major-mode))) -(defun org-fit-agenda-window () - "Fit the window to the buffer size." - (and (memq org-agenda-window-setup '(reorganize-frame)) - (fboundp 'fit-window-to-buffer) - (org-fit-window-to-buffer - nil - (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) - (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) - ;;; Agenda prepare and finalize (defvar org-agenda-multi nil) ; dynamically scoped -(defvar org-agenda-buffer-name "*Org Agenda*") -(defvar org-pre-agenda-window-conf nil) +(defvar org-agenda-pre-window-conf nil) (defvar org-agenda-columns-active nil) (defvar org-agenda-name nil) (defvar org-agenda-tag-filter nil) (defvar org-agenda-category-filter nil) +(defvar org-agenda-top-category-filter nil) (defvar org-agenda-tag-filter-while-redo nil) (defvar org-agenda-tag-filter-preset nil "A preset of the tags filter used for secondary agenda filtering. @@ -3092,63 +3308,107 @@ the entire agenda view. In a block agenda, it will not work reliably to define a filter for one of the individual blocks. You need to set it in the global options and expect it to be applied to the entire view.") -(defun org-prepare-agenda (&optional name) - (setq org-todo-keywords-for-agenda nil) - (setq org-drawers-for-agenda nil) - (unless org-agenda-persistent-filter - (setq org-agenda-tag-filter nil - org-agenda-category-filter nil)) - (put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset) - (put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset) - (if org-agenda-multi + +(defun org-agenda-use-sticky-p () + "Return non-nil if an agenda buffer named +`org-agenda-buffer-name' exists and should be shown instead of +generating a new one." + (and + ;; turned off by user + org-agenda-sticky + ;; For multi-agenda buffer already exists + (not org-agenda-multi) + ;; buffer found + (get-buffer org-agenda-buffer-name) + ;; C-u parameter is same as last call + (with-current-buffer (get-buffer org-agenda-buffer-name) + (and + (equal current-prefix-arg + org-agenda-last-prefix-arg) + ;; In case user turned stickiness on, while having existing + ;; Agenda buffer active, don't reuse that buffer, because it + ;; does not have org variables local + org-agenda-this-buffer-is-sticky)))) + +(defun org-agenda-prepare-window (abuf) + "Setup agenda buffer in the window." + (let* ((awin (get-buffer-window abuf)) + wconf) + (cond + ((equal (current-buffer) abuf) nil) + (awin (select-window awin)) + ((not (setq wconf (current-window-configuration)))) + ((equal org-agenda-window-setup 'current-window) + (org-pop-to-buffer-same-window abuf)) + ((equal org-agenda-window-setup 'other-window) + (org-switch-to-buffer-other-window abuf)) + ((equal org-agenda-window-setup 'other-frame) + (switch-to-buffer-other-frame abuf)) + ((equal org-agenda-window-setup 'reorganize-frame) + (delete-other-windows) + (org-switch-to-buffer-other-window abuf))) + ;; additional test in case agenda is invoked from within agenda + ;; buffer via elisp link + (unless (equal (current-buffer) abuf) + (org-pop-to-buffer-same-window abuf)) + (setq org-agenda-pre-window-conf + (or org-agenda-pre-window-conf wconf)))) + +(defun org-agenda-prepare (&optional name) + (if (org-agenda-use-sticky-p) (progn - (setq buffer-read-only nil) - (goto-char (point-max)) - (unless (or (bobp) org-agenda-compact-blocks - (not org-agenda-block-separator)) - (insert "\n" - (if (stringp org-agenda-block-separator) - org-agenda-block-separator - (make-string (window-width) org-agenda-block-separator)) - "\n")) - (narrow-to-region (point) (point-max))) - (setq org-done-keywords-for-agenda nil) - (org-agenda-reset-markers) - (setq org-agenda-contributing-files nil) - (setq org-agenda-columns-active nil) - (org-prepare-agenda-buffers (org-agenda-files nil 'ifmode)) - (setq org-todo-keywords-for-agenda - (org-uniquify org-todo-keywords-for-agenda)) - (setq org-done-keywords-for-agenda - (org-uniquify org-done-keywords-for-agenda)) - (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda)) - (let* ((abuf (get-buffer-create org-agenda-buffer-name)) - (awin (get-buffer-window abuf))) - (cond - ((equal (current-buffer) abuf) nil) - (awin (select-window awin)) - ((not (setq org-pre-agenda-window-conf (current-window-configuration)))) - ((equal org-agenda-window-setup 'current-window) - (org-pop-to-buffer-same-window abuf)) - ((equal org-agenda-window-setup 'other-window) - (org-switch-to-buffer-other-window abuf)) - ((equal org-agenda-window-setup 'other-frame) - (switch-to-buffer-other-frame abuf)) - ((equal org-agenda-window-setup 'reorganize-frame) - (delete-other-windows) - (org-switch-to-buffer-other-window abuf))) - ;; additional test in case agenda is invoked from within agenda - ;; buffer via elisp link - (unless (equal (current-buffer) abuf) - (org-pop-to-buffer-same-window abuf))) - (setq buffer-read-only nil) - (let ((inhibit-read-only t)) (erase-buffer)) - (org-agenda-mode) - (and name (not org-agenda-name) - (org-set-local 'org-agenda-name name))) - (setq buffer-read-only nil)) - -(defun org-finalize-agenda () + ;; Popup existing buffer + (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)) + (message "Sticky Agenda buffer, use `r' to refresh") + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) + (setq org-todo-keywords-for-agenda nil) + (setq org-drawers-for-agenda nil) + (unless org-agenda-persistent-filter + (setq org-agenda-tag-filter nil + org-agenda-category-filter nil)) + (put 'org-agenda-tag-filter :preset-filter + org-agenda-tag-filter-preset) + (put 'org-agenda-category-filter :preset-filter + org-agenda-category-filter-preset) + (if org-agenda-multi + (progn + (setq buffer-read-only nil) + (goto-char (point-max)) + (unless (or (bobp) org-agenda-compact-blocks + (not org-agenda-block-separator)) + (insert "\n" + (if (stringp org-agenda-block-separator) + org-agenda-block-separator + (make-string (window-width) org-agenda-block-separator)) + "\n")) + (narrow-to-region (point) (point-max))) + (setq org-done-keywords-for-agenda nil) + + ;; Setting any org variables that are in org-agenda-local-vars + ;; list need to be done after the prepare call + (org-agenda-prepare-window (get-buffer-create org-agenda-buffer-name)) + (setq buffer-read-only nil) + (org-agenda-reset-markers) + (let ((inhibit-read-only t)) (erase-buffer)) + (org-agenda-mode) + (setq org-agenda-buffer (current-buffer)) + (setq org-agenda-contributing-files nil) + (setq org-agenda-columns-active nil) + (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) + (setq org-todo-keywords-for-agenda + (org-uniquify org-todo-keywords-for-agenda)) + (setq org-done-keywords-for-agenda + (org-uniquify org-done-keywords-for-agenda)) + (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda)) + (setq org-agenda-last-prefix-arg current-prefix-arg) + (setq org-agenda-this-buffer-name org-agenda-buffer-name) + (and name (not org-agenda-name) + (org-set-local 'org-agenda-name name))) + (setq buffer-read-only nil))) + +(defvar org-agenda-overriding-columns-format) ; From org-colview.el +(defun org-agenda-finalize () "Finishing touch for the agenda buffer, called just before displaying it." (unless org-agenda-multi (save-excursion @@ -3177,13 +3437,14 @@ the global options and expect it to be applied to the entire view.") (org-agenda-entry-text-show)) (if (functionp 'org-habit-insert-consistency-graphs) (org-habit-insert-consistency-graphs)) - (run-hooks 'org-finalize-agenda-hook) + (let ((inhibit-read-only t)) + (run-hooks 'org-agenda-finalize-hook)) (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter)) (org-agenda-filter-apply org-agenda-tag-filter 'tag)) (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter)) (org-agenda-filter-apply org-agenda-category-filter 'category)) - ))) + (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))) (defun org-agenda-mark-clocking-task () "Mark the current clock entry in the agenda if it is present." @@ -3203,7 +3464,7 @@ the global options and expect it to be applied to the entire view.") (overlay-put ov 'type 'org-agenda-clocking) (overlay-put ov 'face 'org-agenda-clocking) (overlay-put ov 'help-echo - "The clock is running in this item"))))))) + "The clock is running in this item"))))))) (defun org-agenda-fontify-priorities () "Make highest priority lines bold, and lowest italic." @@ -3288,6 +3549,7 @@ A good way to set it is through options in `org-agenda-custom-commands'.") Also moves point to the end of the skipped region, so that search can continue from there." (let ((p (point-at-bol)) to) + (when (org-in-src-block-p) (throw :skip t)) (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) (get-text-property p :org-archived) (org-end-of-subtree t) @@ -3328,7 +3590,10 @@ Org-mode keeps a list of these markers and resets them when they are no longer in use." (let ((m (copy-marker (or pos (point))))) (setq org-agenda-last-marker-time (org-float-time)) - (push m org-agenda-markers) + (if org-agenda-buffer + (with-current-buffer org-agenda-buffer + (push m org-agenda-markers)) + (push m org-agenda-markers)) m)) (defun org-agenda-reset-markers () @@ -3337,9 +3602,13 @@ no longer in use." (move-marker (pop org-agenda-markers) nil))) (defun org-agenda-save-markers-for-cut-and-paste (beg end) - "Save relative positions of markers in region." - (mapc (lambda (m) (org-check-and-save-marker m beg end)) - org-agenda-markers)) + "Save relative positions of markers in region. +This check for agenda markers in all agenda buffers currently active." + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (eq major-mode 'org-agenda-mode) + (mapc (lambda (m) (org-check-and-save-marker m beg end)) + org-agenda-markers))))) ;;; Entry text mode @@ -3400,18 +3669,17 @@ under the current date. If the buffer contains an active region, only check the region for dates." (interactive "P") - (org-compile-prefix-format 'timeline) - (org-set-sorting-strategy 'timeline) (let* ((dopast t) - (doclosed org-agenda-show-log) + (org-agenda-show-log-scoped org-agenda-show-log) (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 doclosed ; always include today - org-timeline-show-empty-dates)) + (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)) @@ -3427,8 +3695,10 @@ dates." (setq day-numbers (delq nil (mapcar (lambda(x) (if (>= x today) x nil)) day-numbers)))) - (org-prepare-agenda (concat "Timeline " (file-name-nondirectory entry))) - (if doclosed (push :closed args)) + (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) @@ -3470,13 +3740,13 @@ dates." (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-finalize-agenda-entries rtn) "\n")) + (and rtn (insert (org-agenda-finalize-entries rtn) "\n")) (put-text-property s (1- (point)) 'day d))))) (goto-char (point-min)) (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-finalize-agenda) + (org-agenda-finalize) (setq buffer-read-only t))) (defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re) @@ -3489,7 +3759,7 @@ 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) + dates dates1 date day day1 day2 ts1 ts2 pos) (if force-today (setq dates (list (org-today)))) (save-excursion @@ -3528,11 +3798,9 @@ When EMPTY is non-nil, also include days without any entries." ;;; Agenda Daily/Weekly (defvar org-agenda-start-day nil ; dynamically scoped parameter -"Start day for the agenda view. + "Start day for the agenda view. Custom commands can set this variable in the options section.") (defvar org-starting-day nil) ; local variable in the agenda buffer -(defvar org-agenda-current-span nil - "The current span used in the agenda view.") ; local variable in the agenda buffer (defvar org-arg-loc nil) ; local variable (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) @@ -3568,6 +3836,7 @@ command. A good way to set it is through options in somewhat less efficient) way of determining what is included in the daily/weekly agenda, see `org-agenda-skip-function'.") +(defvar org-agenda-buffer-tmp-name nil) ;;;###autoload (defun org-agenda-list (&optional arg start-day span) "Produce a daily/weekly view from all files in variable `org-agenda-files'. @@ -3581,167 +3850,181 @@ the number of days. SPAN defaults to `org-agenda-span'. START-DAY defaults to TODAY, or to the most recent match for the weekday given in `org-agenda-start-on-weekday'." (interactive "P") - (if (and (integerp arg) (> arg 0)) - (setq span arg arg nil)) - (setq start-day (or start-day org-agenda-start-day)) (if org-agenda-overriding-arguments (setq arg (car org-agenda-overriding-arguments) start-day (nth 1 org-agenda-overriding-arguments) span (nth 2 org-agenda-overriding-arguments))) - (if (stringp start-day) - ;; Convert to an absolute day number - (setq start-day (time-to-days (org-read-date nil t start-day)))) - (setq org-agenda-last-arguments (list arg start-day span)) - (org-compile-prefix-format 'agenda) - (org-set-sorting-strategy 'agenda) - (let* ((span (org-agenda-ndays-to-span - (or span org-agenda-ndays org-agenda-span))) - (today (org-today)) - (sd (or start-day today)) - (ndays (org-agenda-span-to-ndays span sd)) - (org-agenda-start-on-weekday - (if (eq ndays 7) - org-agenda-start-on-weekday)) - (thefiles (org-agenda-files nil 'ifmode)) - (files thefiles) - (start (if (or (null org-agenda-start-on-weekday) - (< ndays 7)) - sd - (let* ((nt (calendar-day-of-week - (calendar-gregorian-from-absolute sd))) - (n1 org-agenda-start-on-weekday) - (d (- nt n1))) - (- sd (+ (if (< d 0) 7 0) d))))) - (day-numbers (list start)) - (day-cnt 0) - (inhibit-redisplay (not debug-on-error)) - s e rtn rtnall file date d start-pos end-pos todayp - clocktable-start clocktable-end filter) - (setq org-agenda-redo-command - (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span))) - (dotimes (n (1- ndays)) - (push (1+ (car day-numbers)) day-numbers)) - (setq day-numbers (nreverse day-numbers)) - (setq clocktable-start (car day-numbers) - clocktable-end (1+ (or (org-last day-numbers) 0))) - (org-prepare-agenda "Day/Week") - (org-set-local 'org-starting-day (car day-numbers)) - (org-set-local 'org-arg-loc arg) - (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) - (unless org-agenda-compact-blocks - (let* ((d1 (car day-numbers)) - (d2 (org-last day-numbers)) - (w1 (org-days-to-iso-week d1)) - (w2 (org-days-to-iso-week d2))) - (setq s (point)) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert (org-agenda-span-name span) - "-agenda" - (if (< (- d2 d1) 350) - (if (= w1 w2) - (format " (W%02d)" w1) - (format " (W%02d-W%02d)" w1 w2)) - "") - ":\n"))) - (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure - 'org-date-line t)) - (org-agenda-mark-header-line s)) - (while (setq d (pop day-numbers)) - (setq date (calendar-gregorian-from-absolute d) - s (point)) - (if (or (setq todayp (= d today)) - (and (not start-pos) (= d sd))) - (setq start-pos (point)) - (if (and start-pos (not end-pos)) - (setq end-pos (point)))) - (setq files thefiles - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (let ((org-agenda-entry-types org-agenda-entry-types)) - (unless org-agenda-include-deadlines - (setq org-agenda-entry-types - (delq :deadline org-agenda-entry-types))) - (cond - ((memq org-agenda-show-log '(only clockcheck)) - (setq rtn (org-agenda-get-day-entries - file date :closed))) - (org-agenda-show-log - (setq rtn (apply 'org-agenda-get-day-entries - file date - (append '(:closed) org-agenda-entry-types)))) - (t - (setq rtn (apply 'org-agenda-get-day-entries - file date - org-agenda-entry-types))))) - (setq rtnall (append rtnall rtn)))) ;; all entries - (if org-agenda-include-diary - (let ((org-agenda-search-headline-for-time t)) - (require 'diary-lib) - (setq rtn (org-get-entries-from-diary date)) - (setq rtnall (append rtnall rtn)))) - (if (or rtnall org-agenda-show-all-dates) - (progn - (setq day-cnt (1+ day-cnt)) - (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) - (put-text-property s (1- (point)) 'org-day-cnt day-cnt) - (when todayp - (put-text-property s (1- (point)) 'org-today t)) - (if rtnall (insert ;; all entries - (org-finalize-agenda-entries - (org-agenda-add-time-grid-maybe - rtnall ndays todayp)) - "\n")) - (put-text-property s (1- (point)) 'day d) - (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) - (when (and org-agenda-clockreport-mode clocktable-start) - (let ((org-agenda-files (org-agenda-files nil 'ifmode)) - ;; the above line is to ensure the restricted range! - (p (copy-sequence org-agenda-clockreport-parameter-plist)) - tbl) - (setq p (org-plist-delete p :block)) - (setq p (plist-put p :tstart clocktable-start)) - (setq p (plist-put p :tend clocktable-end)) - (setq p (plist-put p :scope 'agenda)) - (when (and (eq org-agenda-clockreport-mode 'with-filter) - (setq filter (or org-agenda-tag-filter-while-redo - (get 'org-agenda-tag-filter :preset-filter)))) - (setq p (plist-put p :tags (mapconcat (lambda (x) - (if (string-match "[<>=]" x) - "" - x)) - filter "")))) - (setq tbl (apply 'org-get-clocktable p)) - (insert tbl))) - (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) - (unless (and (pos-visible-in-window-p (point-min)) - (pos-visible-in-window-p (point-max))) - (goto-char (1- (point-max))) - (recenter -1) - (if (not (pos-visible-in-window-p (or start-pos 1))) - (progn - (goto-char (or start-pos 1)) - (recenter 1)))) - (goto-char (or start-pos 1)) - (add-text-properties (point-min) (point-max) '(org-agenda-type agenda)) - (if (eq org-agenda-show-log 'clockcheck) - (org-agenda-show-clocking-issues)) - (org-finalize-agenda) - (setq buffer-read-only t) - (message ""))) + (if (and (integerp arg) (> arg 0)) + (setq span arg arg nil)) + (catch 'exit + (setq org-agenda-buffer-name + (or org-agenda-buffer-tmp-name + (if org-agenda-sticky + (cond ((and org-keys (stringp org-match)) + (format "*Org Agenda(%s:%s)*" org-keys org-match)) + (org-keys + (format "*Org Agenda(%s)*" org-keys)) + (t "*Org Agenda(a)*"))) + org-agenda-buffer-name)) + (org-agenda-prepare "Day/Week") + (setq start-day (or start-day org-agenda-start-day)) + (if (stringp start-day) + ;; Convert to an absolute day number + (setq start-day (time-to-days (org-read-date nil t start-day)))) + (org-compile-prefix-format 'agenda) + (org-set-sorting-strategy 'agenda) + (let* ((span (org-agenda-ndays-to-span + (or span org-agenda-ndays org-agenda-span))) + (today (org-today)) + (sd (or start-day today)) + (ndays (org-agenda-span-to-ndays span sd)) + (org-agenda-start-on-weekday + (if (eq ndays 7) + org-agenda-start-on-weekday)) + (thefiles (org-agenda-files nil 'ifmode)) + (files thefiles) + (start (if (or (null org-agenda-start-on-weekday) + (< ndays 7)) + sd + (let* ((nt (calendar-day-of-week + (calendar-gregorian-from-absolute sd))) + (n1 org-agenda-start-on-weekday) + (d (- nt n1))) + (- sd (+ (if (< d 0) 7 0) d))))) + (day-numbers (list start)) + (day-cnt 0) + (inhibit-redisplay (not debug-on-error)) + (org-agenda-show-log-scoped org-agenda-show-log) + s e rtn rtnall file date d start-pos end-pos todayp + clocktable-start clocktable-end filter) + (setq org-agenda-redo-command + (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span))) + (dotimes (n (1- ndays)) + (push (1+ (car day-numbers)) day-numbers)) + (setq day-numbers (nreverse day-numbers)) + (setq clocktable-start (car day-numbers) + clocktable-end (1+ (or (org-last day-numbers) 0))) + (org-set-local 'org-starting-day (car day-numbers)) + (org-set-local 'org-arg-loc arg) + (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) + (unless org-agenda-compact-blocks + (let* ((d1 (car day-numbers)) + (d2 (org-last day-numbers)) + (w1 (org-days-to-iso-week d1)) + (w2 (org-days-to-iso-week d2))) + (setq s (point)) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert (org-agenda-span-name span) + "-agenda" + (if (< (- d2 d1) 350) + (if (= w1 w2) + (format " (W%02d)" w1) + (format " (W%02d-W%02d)" w1 w2)) + "") + ":\n"))) + (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure + 'org-date-line t)) + (org-agenda-mark-header-line s)) + (while (setq d (pop day-numbers)) + (setq date (calendar-gregorian-from-absolute d) + s (point)) + (if (or (setq todayp (= d today)) + (and (not start-pos) (= d sd))) + (setq start-pos (point)) + (if (and start-pos (not end-pos)) + (setq end-pos (point)))) + (setq files thefiles + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (let ((org-agenda-entry-types org-agenda-entry-types)) + (unless org-agenda-include-deadlines + (setq org-agenda-entry-types + (delq :deadline org-agenda-entry-types))) + (cond + ((memq org-agenda-show-log-scoped '(only clockcheck)) + (setq rtn (org-agenda-get-day-entries + file date :closed))) + (org-agenda-show-log-scoped + (setq rtn (apply 'org-agenda-get-day-entries + file date + (append '(:closed) org-agenda-entry-types)))) + (t + (setq rtn (apply 'org-agenda-get-day-entries + file date + org-agenda-entry-types))))) + (setq rtnall (append rtnall rtn)))) ;; all entries + (if org-agenda-include-diary + (let ((org-agenda-search-headline-for-time t)) + (require 'diary-lib) + (setq rtn (org-get-entries-from-diary date)) + (setq rtnall (append rtnall rtn)))) + (if (or rtnall org-agenda-show-all-dates) + (progn + (setq day-cnt (1+ day-cnt)) + (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) + (put-text-property s (1- (point)) 'org-day-cnt day-cnt) + (when todayp + (put-text-property s (1- (point)) 'org-today t)) + (setq rtnall + (org-agenda-add-time-grid-maybe rtnall ndays todayp)) + (if rtnall (insert ;; all entries + (org-agenda-finalize-entries rtnall) + "\n")) + (put-text-property s (1- (point)) 'day d) + (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) + (when (and org-agenda-clockreport-mode clocktable-start) + (let ((org-agenda-files (org-agenda-files nil 'ifmode)) + ;; the above line is to ensure the restricted range! + (p (copy-sequence org-agenda-clockreport-parameter-plist)) + tbl) + (setq p (org-plist-delete p :block)) + (setq p (plist-put p :tstart clocktable-start)) + (setq p (plist-put p :tend clocktable-end)) + (setq p (plist-put p :scope 'agenda)) + (when (and (eq org-agenda-clockreport-mode 'with-filter) + (setq filter (or org-agenda-tag-filter-while-redo + (get 'org-agenda-tag-filter :preset-filter)))) + (setq p (plist-put p :tags (mapconcat (lambda (x) + (if (string-match "[<>=]" x) + "" + x)) + filter "")))) + (setq tbl (apply 'org-get-clocktable p)) + (insert tbl))) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (unless (and (pos-visible-in-window-p (point-min)) + (pos-visible-in-window-p (point-max))) + (goto-char (1- (point-max))) + (recenter -1) + (if (not (pos-visible-in-window-p (or start-pos 1))) + (progn + (goto-char (or start-pos 1)) + (recenter 1)))) + (goto-char (or start-pos 1)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type agenda + org-last-args (,arg ,start-day ,span) + org-redo-cmd ,org-agenda-redo-command + org-serie-cmd ,org-cmd)) + (if (eq org-agenda-show-log-scoped 'clockcheck) + (org-agenda-show-clocking-issues)) + (org-agenda-finalize) + (setq buffer-read-only t) + (message "")))) (defun org-agenda-ndays-to-span (n) "Return a span symbol for a span of N days, or N if none matches." @@ -3750,8 +4033,8 @@ given in `org-agenda-start-on-weekday'." ((= n 7) 'week) (t n))) -(defun org-agenda-span-to-ndays (span start-day) - "Return ndays from SPAN starting at START-DAY." +(defun org-agenda-span-to-ndays (span &optional start-day) + "Return ndays from SPAN, possibly starting at START-DAY." (cond ((numberp span) span) ((eq span 'day) 1) ((eq span 'week) 7) @@ -3773,13 +4056,13 @@ given in `org-agenda-start-on-weekday'." ;;; Agenda word search (defvar org-agenda-search-history nil) -(defvar org-todo-only nil) (defvar org-search-syntax-table nil "Special syntax table for org-mode search. In this table, we have single quotes not as word constituents, to that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") +(defvar org-mode-syntax-table) ; From org.el (defun org-search-syntax-table () (unless org-search-syntax-table (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table)) @@ -3834,9 +4117,10 @@ as a whole, to include whitespace. This command searches the agenda files, and in addition the files listed in `org-agenda-text-search-extra-files'." (interactive "P") - (org-compile-prefix-format 'search) - (org-set-sorting-strategy 'search) - (org-prepare-agenda "SEARCH") + (if org-agenda-overriding-arguments + (setq todo-only (car org-agenda-overriding-arguments) + string (nth 1 org-agenda-overriding-arguments) + edit-at (nth 2 org-agenda-overriding-arguments))) (let* ((props (list 'face nil 'done-face 'org-agenda-done 'org-not-done-regexp org-not-done-regexp @@ -3847,7 +4131,7 @@ in `org-agenda-text-search-extra-files'." (full-words org-agenda-search-view-force-full-words) (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) regexp rtn rtnall files file pos - marker category org-category-pos tags c neg re boolean + marker category category-pos tags c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) (unless (and (not edit-at) (stringp string) @@ -3855,182 +4139,194 @@ in `org-agenda-text-search-extra-files'." (setq string (read-string (if org-agenda-search-view-always-boolean "[+-]Word/{Regexp} ...: " - "Phrase, or [+-]Word/{Regexp} ...: ") + "Phrase or [+-]Word/{Regexp} ...: ") (cond ((integerp edit-at) (cons string edit-at)) (edit-at string)) 'org-agenda-search-history))) - (org-set-local 'org-todo-only todo-only) - (setq org-agenda-redo-command - (list 'org-search-view (if todo-only t nil) string - '(if current-prefix-arg 1 nil))) - (setq org-agenda-query-string string) - - (if (equal (string-to-char string) ?*) - (setq hdl-only t - words (substring string 1)) - (setq words string)) - (when (equal (string-to-char words) ?!) - (setq todo-only t - words (substring words 1))) - (when (equal (string-to-char words) ?:) - (setq full-words t - words (substring words 1))) - (if (or org-agenda-search-view-always-boolean - (member (string-to-char words) '(?- ?+ ?\{))) - (setq boolean t)) - (setq words (org-split-string words)) - (let (www w) - (while (setq w (pop words)) - (while (and (string-match "\\\\\\'" w) words) - (setq w (concat (substring w 0 -1) " " (pop words)))) - (push w www)) - (setq words (nreverse www) www nil) - (while (setq w (pop words)) - (when (and (string-match "\\`[-+]?{" w) - (not (string-match "}\\'" w))) - (while (and words (not (string-match "}\\'" (car words)))) - (setq w (concat w " " (pop words)))) - (setq w (concat w " " (pop words)))) - (push w www)) - (setq words (nreverse www))) - (setq org-agenda-last-search-view-search-was-boolean boolean) - (when boolean - (let (wds w) + (catch 'exit + (if org-agenda-sticky + (setq org-agenda-buffer-name + (if (stringp string) + (format "*Org Agenda(%s:%s)*" + (or org-keys (or (and todo-only "S") "s")) string) + (format "*Org Agenda(%s)*" (or (and todo-only "S") "s"))))) + (org-agenda-prepare "SEARCH") + (org-compile-prefix-format 'search) + (org-set-sorting-strategy 'search) + (setq org-agenda-redo-command + (list 'org-search-view (if todo-only t nil) + (list 'if 'current-prefix-arg nil string))) + (setq org-agenda-query-string string) + (if (equal (string-to-char string) ?*) + (setq hdl-only t + words (substring string 1)) + (setq words string)) + (when (equal (string-to-char words) ?!) + (setq todo-only t + words (substring words 1))) + (when (equal (string-to-char words) ?:) + (setq full-words t + words (substring words 1))) + (if (or org-agenda-search-view-always-boolean + (member (string-to-char words) '(?- ?+ ?\{))) + (setq boolean t)) + (setq words (org-split-string words)) + (let (www w) (while (setq w (pop words)) - (if (or (equal (substring w 0 1) "\"") - (and (> (length w) 1) - (member (substring w 0 1) '("+" "-")) - (equal (substring w 1 2) "\""))) - (while (and words (not (equal (substring w -1) "\""))) - (setq w (concat w " " (pop words))))) - (and (string-match "\\`\\([-+]?\\)\"" w) - (setq w (replace-match "\\1" nil nil w))) - (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) - (push w wds)) - (setq words (nreverse wds)))) - (if boolean - (mapc (lambda (w) - (setq c (string-to-char w)) - (if (equal c ?-) - (setq neg t w (substring w 1)) - (if (equal c ?+) - (setq neg nil w (substring w 1)) - (setq neg nil))) - (if (string-match "\\`{.*}\\'" w) - (setq re (substring w 1 -1)) - (if full-words - (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) - (setq re (regexp-quote (downcase w))))) - (if neg (push re regexps-) (push re regexps+))) - words) - (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+") - regexps+)) - (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) - (if (not regexps+) - (setq regexp org-outline-regexp-bol) - (setq regexp (pop regexps+)) - (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) - rtnall nil) - (while (setq file (pop files)) - (setq ee nil) - (catch 'nextfile - (org-check-agenda-file file) - (setq buffer (if (file-exists-p file) - (org-get-agenda-file-buffer file) - (error "No such file %s" file))) - (if (not buffer) - ;; If file does not exist, make sure an error message is sent - (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" - file)))) - (with-current-buffer buffer - (with-syntax-table (org-search-syntax-table) - (unless (eq major-mode 'org-mode) - (error "Agenda file %s is not in `org-mode'" file)) - (let ((case-fold-search t)) - (save-excursion - (save-restriction - (if org-agenda-restrict - (narrow-to-region org-agenda-restrict-begin - org-agenda-restrict-end) - (widen)) - (goto-char (point-min)) - (unless (or (org-at-heading-p) - (outline-next-heading)) - (throw 'nextfile t)) - (goto-char (max (point-min) (1- (point)))) - (while (re-search-forward regexp nil t) - (org-back-to-heading t) - (skip-chars-forward "* ") - (setq beg (point-at-bol) - beg1 (point) - end (progn (outline-next-heading) (point))) - (catch :skip - (goto-char beg) - (org-agenda-skip) - (setq str (buffer-substring-no-properties - (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))) - regexps-) - (mapc (lambda (wr) (unless (string-match wr str) - (goto-char (1- end)) - (throw :skip t))) - (if todo-only - (cons (concat "^\*+[ \t]+" org-not-done-regexp) - regexps+) - regexps+)) - (goto-char beg) - (setq marker (org-agenda-new-marker (point)) - category (org-get-category) - org-category-pos (get-text-property (point) 'org-category-position) - tags (org-get-tags-at (point)) - txt (org-agenda-format-item - "" - (buffer-substring-no-properties - beg1 (point-at-eol)) - category tags)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker marker - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'priority 1000 'org-category category - 'org-category-position org-category-pos - 'type "search") - (push txt ee) - (goto-char (1- end)))))))))) - (setq rtn (nreverse ee)) - (setq rtnall (append rtnall rtn))) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert "Search words: ") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure)) - (setq pos (point)) - (insert string "\n") - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) - (setq pos (point)) - (unless org-agenda-multi - (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n") - (add-text-properties pos (1- (point)) - (list 'face 'org-agenda-structure)))) - (org-agenda-mark-header-line (point-min)) - (when rtnall - (insert (org-finalize-agenda-entries rtnall) "\n")) - (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) - (add-text-properties (point-min) (point-max) '(org-agenda-type search)) - (org-finalize-agenda) - (setq buffer-read-only t))) + (while (and (string-match "\\\\\\'" w) words) + (setq w (concat (substring w 0 -1) " " (pop words)))) + (push w www)) + (setq words (nreverse www) www nil) + (while (setq w (pop words)) + (when (and (string-match "\\`[-+]?{" w) + (not (string-match "}\\'" w))) + (while (and words (not (string-match "}\\'" (car words)))) + (setq w (concat w " " (pop words)))) + (setq w (concat w " " (pop words)))) + (push w www)) + (setq words (nreverse www))) + (setq org-agenda-last-search-view-search-was-boolean boolean) + (when boolean + (let (wds w) + (while (setq w (pop words)) + (if (or (equal (substring w 0 1) "\"") + (and (> (length w) 1) + (member (substring w 0 1) '("+" "-")) + (equal (substring w 1 2) "\""))) + (while (and words (not (equal (substring w -1) "\""))) + (setq w (concat w " " (pop words))))) + (and (string-match "\\`\\([-+]?\\)\"" w) + (setq w (replace-match "\\1" nil nil w))) + (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) + (push w wds)) + (setq words (nreverse wds)))) + (if boolean + (mapc (lambda (w) + (setq c (string-to-char w)) + (if (equal c ?-) + (setq neg t w (substring w 1)) + (if (equal c ?+) + (setq neg nil w (substring w 1)) + (setq neg nil))) + (if (string-match "\\`{.*}\\'" w) + (setq re (substring w 1 -1)) + (if full-words + (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) + (setq re (regexp-quote (downcase w))))) + (if neg (push re regexps-) (push re regexps+))) + words) + (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+") + regexps+)) + (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) + (if (not regexps+) + (setq regexp org-outline-regexp-bol) + (setq regexp (pop regexps+)) + (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) + rtnall nil) + (while (setq file (pop files)) + (setq ee nil) + (catch 'nextfile + (org-check-agenda-file file) + (setq buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file))) + (if (not buffer) + ;; If file does not exist, make sure an error message is sent + (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" + file)))) + (with-current-buffer buffer + (with-syntax-table (org-search-syntax-table) + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in `org-mode'" file)) + (let ((case-fold-search t)) + (save-excursion + (save-restriction + (if org-agenda-restrict + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + (goto-char (point-min)) + (unless (or (org-at-heading-p) + (outline-next-heading)) + (throw 'nextfile t)) + (goto-char (max (point-min) (1- (point)))) + (while (re-search-forward regexp nil t) + (org-back-to-heading t) + (skip-chars-forward "* ") + (setq beg (point-at-bol) + beg1 (point) + end (progn (outline-next-heading) (point))) + (catch :skip + (goto-char beg) + (org-agenda-skip) + (setq str (buffer-substring-no-properties + (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))) + regexps-) + (mapc (lambda (wr) (unless (string-match wr str) + (goto-char (1- end)) + (throw :skip t))) + (if todo-only + (cons (concat "^\*+[ \t]+" org-not-done-regexp) + regexps+) + regexps+)) + (goto-char beg) + (setq marker (org-agenda-new-marker (point)) + category (org-get-category) + category-pos (get-text-property (point) 'org-category-position) + tags (org-get-tags-at (point)) + txt (org-agenda-format-item + "" + (buffer-substring-no-properties + beg1 (point-at-eol)) + category tags t)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'priority 1000 'org-category category + 'org-category-position category-pos + 'type "search") + (push txt ee) + (goto-char (1- end)))))))))) + (setq rtn (nreverse ee)) + (setq rtnall (append rtnall rtn))) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert "Search words: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure)) + (setq pos (point)) + (insert string "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (setq pos (point)) + (unless org-agenda-multi + (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n") + (add-text-properties pos (1- (point)) + (list 'face 'org-agenda-structure)))) + (org-agenda-mark-header-line (point-min)) + (when rtnall + (insert (org-agenda-finalize-entries rtnall) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type search + org-last-args (,todo-only ,string ,edit-at) + org-redo-cmd ,org-agenda-redo-command + org-serie-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) ;;; Agenda TODO list @@ -4038,16 +4334,15 @@ in `org-agenda-text-search-extra-files'." (defvar org-last-arg nil) ;;;###autoload -(defun org-todo-list (arg) +(defun org-todo-list (&optional arg) "Show all (not done) TODO entries from all agenda file in a single list. The prefix arg can be used to select a specific TODO keyword and limit the list to these. When using \\[universal-argument], you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'." (interactive "P") - (org-compile-prefix-format 'todo) - (org-set-sorting-strategy 'todo) - (org-prepare-agenda "TODO") + (if org-agenda-overriding-arguments + (setq arg org-agenda-overriding-arguments)) (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) (let* ((today (org-today)) (date (calendar-gregorian-from-absolute today)) @@ -4061,51 +4356,67 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (when (equal arg '(4)) (setq org-select-this-todo-keyword (org-icompleting-read "Keyword (or KWD1|K2D2|...): " - (mapcar 'list kwds) nil nil))) + (mapcar 'list kwds) nil nil))) (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) - (org-set-local 'org-last-arg arg) - (setq org-agenda-redo-command - '(org-todo-list (or current-prefix-arg org-last-arg))) - (setq files (org-agenda-files nil 'ifmode) - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (setq rtn (org-agenda-get-day-entries file date :todo)) - (setq rtnall (append rtnall rtn)))) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert "Global list of TODO items of type: ") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure - 'short-heading - (concat "ToDo: " - (or org-select-this-todo-keyword "ALL")))) + (catch 'exit + (if org-agenda-sticky + (setq org-agenda-buffer-name + (if (stringp org-select-this-todo-keyword) + (format "*Org Agenda(%s:%s)*" (or org-keys "t") + org-select-this-todo-keyword) + (format "*Org Agenda(%s)*" (or org-keys "t"))))) + (org-agenda-prepare "TODO") + (org-compile-prefix-format 'todo) + (org-set-sorting-strategy 'todo) + (setq org-agenda-redo-command + `(org-todo-list (or (and (numberp current-prefix-arg) + current-prefix-arg) + ,org-select-this-todo-keyword + current-prefix-arg ,arg))) + (setq files (org-agenda-files nil 'ifmode) + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (setq rtn (org-agenda-get-day-entries file date :todo)) + (setq rtnall (append rtnall rtn)))) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert "Global list of TODO items of type: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure + 'short-heading + (concat "ToDo: " + (or org-select-this-todo-keyword "ALL")))) + (org-agenda-mark-header-line (point-min)) + (setq pos (point)) + (insert (or org-select-this-todo-keyword "ALL") "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (setq pos (point)) + (unless org-agenda-multi + (insert "Available with `N r': (0)[ALL]") + (let ((n 0) s) + (mapc (lambda (x) + (setq s (format "(%d)%s" (setq n (1+ n)) x)) + (if (> (+ (current-column) (string-width s) 1) (frame-width)) + (insert "\n ")) + (insert " " s)) + kwds)) + (insert "\n")) + (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) (org-agenda-mark-header-line (point-min)) - (setq pos (point)) - (insert (or org-select-this-todo-keyword "ALL") "\n") - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) - (setq pos (point)) - (unless org-agenda-multi - (insert "Available with `N r': (0)ALL") - (let ((n 0) s) - (mapc (lambda (x) - (setq s (format "(%d)%s" (setq n (1+ n)) x)) - (if (> (+ (current-column) (string-width s) 1) (frame-width)) - (insert "\n ")) - (insert " " s)) - kwds)) - (insert "\n")) - (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) - (org-agenda-mark-header-line (point-min)) - (when rtnall - (insert (org-finalize-agenda-entries rtnall) "\n")) - (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) - (add-text-properties (point-min) (point-max) '(org-agenda-type todo)) - (org-finalize-agenda) - (setq buffer-read-only t))) + (when rtnall + (insert (org-agenda-finalize-entries rtnall) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type todo + org-last-args ,arg + org-redo-cmd ,org-agenda-redo-command + org-serie-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) ;;; Agenda tags match @@ -4114,8 +4425,9 @@ for a keyword. A numeric prefix directly selects the Nth keyword in "Show all headlines for all `org-agenda-files' matching a TAGS criterion. The prefix arg TODO-ONLY limits the search to TODO entries." (interactive "P") - (org-compile-prefix-format 'tags) - (org-set-sorting-strategy 'tags) + (if org-agenda-overriding-arguments + (setq todo-only (car org-agenda-overriding-arguments) + match (nth 1 org-agenda-overriding-arguments))) (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels) (completion-ignore-case t) @@ -4125,58 +4437,71 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (setq match nil)) (setq matcher (org-make-tags-matcher match) match (car matcher) matcher (cdr matcher)) - (org-prepare-agenda (concat "TAGS " match)) - (setq org-agenda-query-string match) - (setq org-agenda-redo-command - (list 'org-tags-view (list 'quote todo-only) - (list 'if 'current-prefix-arg nil 'org-agenda-query-string))) - (setq files (org-agenda-files nil 'ifmode) - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (setq buffer (if (file-exists-p file) - (org-get-agenda-file-buffer file) - (error "No such file %s" file))) - (if (not buffer) - ;; If file does not exist, error message to agenda - (setq rtn (list - (format "ORG-AGENDA-ERROR: No such org-file %s" file)) - rtnall (append rtnall rtn)) - (with-current-buffer buffer - (unless (eq major-mode 'org-mode) - (error "Agenda file %s is not in `org-mode'" file)) - (save-excursion - (save-restriction - (if org-agenda-restrict - (narrow-to-region org-agenda-restrict-begin - org-agenda-restrict-end) - (widen)) - (setq rtn (org-scan-tags 'agenda matcher todo-only)) - (setq rtnall (append rtnall rtn)))))))) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert "Headlines with TAGS match: ") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure - 'short-heading - (concat "Match: " match))) - (setq pos (point)) - (insert match "\n") - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) - (setq pos (point)) - (unless org-agenda-multi - (insert "Press `C-u r' to search again with new search string\n")) - (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) - (org-agenda-mark-header-line (point-min)) - (when rtnall - (insert (org-finalize-agenda-entries rtnall) "\n")) - (goto-char (point-min)) - (or org-agenda-multi (org-fit-agenda-window)) - (add-text-properties (point-min) (point-max) '(org-agenda-type tags)) - (org-finalize-agenda) - (setq buffer-read-only t))) + (catch 'exit + (if org-agenda-sticky + (setq org-agenda-buffer-name + (if (stringp match) + (format "*Org Agenda(%s:%s)*" + (or org-keys (or (and todo-only "M") "m")) match) + (format "*Org Agenda(%s)*" (or (and todo-only "M") "m"))))) + (org-agenda-prepare (concat "TAGS " match)) + (org-compile-prefix-format 'tags) + (org-set-sorting-strategy 'tags) + (setq org-agenda-query-string match) + (setq org-agenda-redo-command + (list 'org-tags-view `(quote ,todo-only) + (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string)))) + (setq files (org-agenda-files nil 'ifmode) + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (setq buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file))) + (if (not buffer) + ;; If file does not exist, error message to agenda + (setq rtn (list + (format "ORG-AGENDA-ERROR: No such org-file %s" file)) + rtnall (append rtnall rtn)) + (with-current-buffer buffer + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in `org-mode'" file)) + (save-excursion + (save-restriction + (if org-agenda-restrict + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + (setq rtn (org-scan-tags 'agenda matcher todo-only)) + (setq rtnall (append rtnall rtn)))))))) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert "Headlines with TAGS match: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure + 'short-heading + (concat "Match: " match))) + (setq pos (point)) + (insert match "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (setq pos (point)) + (unless org-agenda-multi + (insert "Press `C-u r' to search again with new search string\n")) + (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) + (org-agenda-mark-header-line (point-min)) + (when rtnall + (insert (org-agenda-finalize-entries rtnall) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type tags + org-last-args (,todo-only ,match) + org-redo-cmd ,org-agenda-redo-command + org-serie-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) ;;; Agenda Finding stuck projects @@ -4305,15 +4630,18 @@ that can be put into `org-agenda-skip-function' for the duration of a command." (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))) end))) (defun org-agenda-skip-if-todo (args end) "Helper function for `org-agenda-skip-if', do not use it directly. -ARGS is a list with first element either `todo' or `nottodo'. -The remainder is either a list of TODO keywords, or a state symbol -`todo' or `done' or `any'." +ARGS is a list with first element either `todo', `nottodo', +`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) @@ -4337,9 +4665,20 @@ The remainder is either a list of TODO keywords, or a state symbol (concat "^\\*+[ \t]+\\<\\(" (mapconcat 'identity todo-wds "\\|") "\\)\\>")) - (if (eq kw 'todo) - (re-search-forward todo-re end t) - (not (re-search-forward todo-re end t))))) + (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)) + ))) ;;;###autoload (defun org-agenda-list-stuck-projects (&rest ignore) @@ -4357,7 +4696,7 @@ of what a project is and how to check if it stuck, customize the variable (todo (nth 1 org-stuck-projects)) (todo-wds (if (member "*" todo) (progn - (org-prepare-agenda-buffers (org-agenda-files + (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) (org-delete-all org-done-keywords-for-agenda @@ -4390,13 +4729,12 @@ of what a project is and how to check if it stuck, customize the variable (org-tags-view nil matcher) (with-current-buffer org-agenda-buffer-name (setq org-agenda-redo-command - '(org-agenda-list-stuck-projects - (or current-prefix-arg org-last-arg)))))) + `(org-agenda-list-stuck-projects ,current-prefix-arg))))) ;;; Diary integration (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. -(defvar list-diary-entries-hook) +(defvar diary-list-entries-hook) (defvar diary-time-regexp) (defun org-get-entries-from-diary (date) "Get the (Emacs Calendar) diary entries for DATE." @@ -4405,8 +4743,8 @@ of what a project is and how to check if it stuck, customize the variable (diary-display-hook '(fancy-diary-display)) (diary-display-function 'fancy-diary-display) (pop-up-frames nil) - (list-diary-entries-hook - (cons 'org-diary-default-entry list-diary-entries-hook)) + (diary-list-entries-hook + (cons 'org-diary-default-entry diary-list-entries-hook)) (diary-file-name-prefix-function nil) ; turn this feature off (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) entries @@ -4517,7 +4855,7 @@ Needed to avoid empty dates which mess up holiday display." ;;;###autoload (defun org-diary (&rest args) - "Return diary information from org-files. + "Return diary information from org files. This function can be used in a \"sexp\" diary entry in the Emacs calendar. It accesses org files and extracts information from those files to be listed in the diary. The function accepts arguments specifying what @@ -4545,6 +4883,8 @@ function from a program - use `org-agenda-get-day-entries' instead." (when (> (- (org-float-time) org-agenda-last-marker-time) 5) + ;; I am not sure if this works with sticky agendas, because the marker + ;; list is then no longer a global variable. (org-agenda-reset-markers)) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) @@ -4558,7 +4898,7 @@ function from a program - use `org-agenda-get-day-entries' instead." (> (- time org-diary-last-run-time) 3)) - (org-prepare-agenda-buffers files)) + (org-agenda-prepare-buffers files)) (setq org-diary-last-run-time time) ;; If this is called during org-agenda, don't return any entries to ;; the calendar. Org Agenda will list these entries itself. @@ -4567,7 +4907,7 @@ function from a program - use `org-agenda-get-day-entries' instead." (setq rtn (apply 'org-agenda-get-day-entries file date args)) (setq results (append results rtn))) (if results - (concat (org-finalize-agenda-entries results) "\n")))) + (concat (org-agenda-finalize-entries results) "\n")))) ;;; Agenda entry finders @@ -4588,8 +4928,9 @@ the documentation of `org-diary'." ;; If file does not exist, make sure an error message ends up in diary (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) (with-current-buffer buffer - (unless (eq major-mode 'org-mode) + (unless (derived-mode-p 'org-mode) (error "Agenda file %s is not in `org-mode'" file)) + (setq org-agenda-buffer (or org-agenda-buffer buffer)) (let ((case-fold-search nil)) (save-excursion (save-restriction @@ -4608,7 +4949,7 @@ the documentation of `org-diary'." ((eq arg :timestamp) (setq rtn (org-agenda-get-blocks)) (setq results (append results rtn)) - (setq rtn (org-agenda-get-timestamps)) + (setq rtn (org-agenda-get-timestamps deadline-results)) (setq results (append results rtn))) ((eq arg :sexp) (setq rtn (org-agenda-get-sexps)) @@ -4650,7 +4991,7 @@ the documentation of `org-diary'." "|") "\\|") "\\)")) (t org-not-done-regexp)))) - marker priority category org-category-pos tags todo-state + marker priority category category-pos tags todo-state ee txt beg end) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4666,17 +5007,17 @@ the documentation of `org-diary'." (goto-char (match-beginning 2)) (setq marker (org-agenda-new-marker (match-beginning 0)) category (org-get-category) - org-category-pos (get-text-property (point) 'org-category-position) + category-pos (get-text-property (point) 'org-category-position) txt (org-trim (buffer-substring (match-beginning 2) (match-end 0))) tags (org-get-tags-at (point)) - txt (org-agenda-format-item "" txt category tags) + txt (org-agenda-format-item "" txt category tags t) priority (1+ (org-get-priority txt)) todo-state (org-get-todo-state)) (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'priority priority 'org-category category - 'org-category-position org-category-pos + 'org-category-position category-pos 'type "todo" 'todo-state todo-state) (push txt ee) (if org-agenda-todo-list-sublevels @@ -4685,7 +5026,7 @@ the documentation of `org-diary'." (nreverse ee))) (defun org-agenda-todo-custom-ignore-p (time n) - "Check whether timestamp is farther away then n number of days. + "Check whether timestamp is farther away than n number of days. This function is invoked if `org-agenda-todo-ignore-deadlines', `org-agenda-todo-ignore-scheduled' or `org-agenda-todo-ignore-timestamp' is set to an integer." @@ -4760,7 +5101,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (defconst org-agenda-no-heading-message "No heading for this item in buffer or region.") -(defun org-agenda-get-timestamps () +(defun org-agenda-get-timestamps (&optional deadline-results) "Return the date stamp information for agenda display." (let* ((props (list 'face 'org-agenda-calendar-event 'org-not-done-regexp org-not-done-regexp @@ -4771,13 +5112,13 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (d1 (calendar-absolute-from-gregorian date)) - (remove-re - (concat - (regexp-quote - (format-time-string - "<%Y-%m-%d" - (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) - ".*?>")) + mm + (deadline-position-alist + (mapcar (lambda (a) (and (setq mm (get-text-property + 0 'org-hd-marker a)) + (cons (marker-position mm) a))) + deadline-results)) + (remove-re org-ts-regexp) (regexp (concat (if org-agenda-include-inactive-timestamps "[[<]" "<") @@ -4788,11 +5129,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (apply 'encode-time ; DATE bound by calendar (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 1 11)) - "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" + "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) marker hdmarker deadlinep scheduledp clockp closedp inactivep - donep tmp priority category org-category-pos ee txt timestr tags - b0 b3 e3 head todo-state end-of-match show-all) + donep tmp priority category category-pos ee txt timestr tags + b0 b3 e3 head todo-state end-of-match show-all warntime) (goto-char (point-min)) (while (setq end-of-match (re-search-forward regexp nil t)) (setq b0 (match-beginning 0) @@ -4824,6 +5165,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', clockp (and org-agenda-include-inactive-timestamps (or (string-match org-clock-string tmp) (string-match "]-+\\'" tmp))) + warntime (org-entry-get (point) "APPT_WARNTIME") donep (member todo-state org-done-keywords)) (if (or scheduledp deadlinep closedp clockp (and donep org-agenda-skip-timestamp-if-done)) @@ -4833,11 +5175,14 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (setq timestr (substring timestr 0 (match-end 0)))) (setq marker (org-agenda-new-marker b0) category (org-get-category b0) - org-category-pos (get-text-property b0 'org-category-position)) + category-pos (get-text-property b0 'org-category-position)) (save-excursion (if (not (re-search-backward org-outline-regexp-bol nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) + (if (and (eq t org-agenda-skip-timestamp-if-deadline-is-shown) + (assoc (point) deadline-position-alist)) + (throw :skip nil)) (setq hdmarker (org-agenda-new-marker) tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") @@ -4845,14 +5190,15 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (setq txt (org-agenda-format-item (if inactivep org-agenda-inactive-leader nil) head category tags timestr - remove-re))) + remove-re t))) (setq priority (org-get-priority txt)) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker) (org-add-props txt nil 'priority priority 'org-category category 'date date - 'org-category-position org-category-pos + 'org-category-position category-pos 'todo-state todo-state + 'warntime warntime 'type "timestamp") (push txt ee)) (if org-agenda-skip-additional-timestamps-same-entry @@ -4869,8 +5215,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (regexp "^&?%%(") - marker category org-category-pos ee txt tags entry - result beg b sexp sexp-entry todo-state) + marker category extra category-pos ee txt tags entry + result beg b sexp sexp-entry todo-state warntime) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -4887,23 +5233,30 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (when result (setq marker (org-agenda-new-marker beg) category (org-get-category beg) - org-category-pos (get-text-property beg 'org-category-position) - todo-state (org-get-todo-state)) + category-pos (get-text-property beg 'org-category-position) + tags (save-excursion (org-backward-heading-same-level 0) + (org-get-tags-at)) + todo-state (org-get-todo-state) + warntime (org-entry-get (point) "APPT_WARNTIME")) (dolist (r (if (stringp result) (list result) result)) ;; we expect a list here + (when (and org-agenda-diary-sexp-prefix + (string-match org-agenda-diary-sexp-prefix r)) + (setq extra (match-string 0 r) + r (replace-match "" nil nil r))) (if (string-match "\\S-" r) (setq txt r) (setq txt "SEXP entry returned empty string")) (setq txt (org-agenda-format-item - "" txt category tags 'time)) + extra txt category tags 'time)) (org-add-props txt props 'org-marker marker) (org-add-props txt nil 'org-category category 'date date 'todo-state todo-state - 'org-category-position org-category-pos - 'type "sexp") + 'org-category-position category-pos 'tags tags + 'type "sexp" 'warntime warntime) (push txt ee))))) (nreverse ee))) @@ -4977,6 +5330,7 @@ please use `org-class' instead." dayname skip-weeks))) (make-obsolete 'org-diary-class 'org-class "") +(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list' (defalias 'org-get-closed 'org-agenda-get-progress) (defun org-agenda-get-progress () "Return the logged TODO entries for agenda display." @@ -4987,9 +5341,9 @@ please use `org-class' instead." 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) - (items (if (consp org-agenda-show-log) - org-agenda-show-log - (if (eq org-agenda-show-log 'clockcheck) + (items (if (consp org-agenda-show-log-scoped) + org-agenda-show-log-scoped + (if (eq org-agenda-show-log-scoped 'clockcheck) '(clock) org-agenda-log-mode-items))) (parts @@ -5011,7 +5365,7 @@ please use `org-class' instead." (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 1 11)))) (org-agenda-search-headline-for-time nil) - marker hdmarker priority category org-category-pos tags closedp + marker hdmarker priority category category-pos tags closedp statep clockp state ee txt extra timestr rest clocked) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5023,7 +5377,7 @@ please use `org-class' instead." clockp (not (or closedp statep)) state (and statep (match-string 2)) category (org-get-category (match-beginning 0)) - org-category-pos (get-text-property (match-beginning 0) 'org-category-position) + category-pos (get-text-property (match-beginning 0) 'org-category-position) timestr (buffer-substring (match-beginning 0) (point-at-eol))) (when (string-match "\\]" timestr) ;; substring should only run to end of time stamp @@ -5061,14 +5415,14 @@ please use `org-class' instead." (setq txt (org-agenda-format-item (cond (closedp "Closed: ") - (statep (concat "State: (" state ")")) - (t (concat "Clocked: (" clocked ")"))) + (statep (concat "State: (" state ")")) + (t (concat "Clocked: (" clocked ")"))) txt category tags timestr))) (setq priority 100000) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done 'priority priority 'org-category category - 'org-category-position org-category-pos + 'org-category-position category-pos 'type "closed" 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) (push txt ee)) @@ -5146,7 +5500,7 @@ See also the user option `org-agenda-clock-consistency-checks'." ;; There is a gap, lets see if we need to report it (unless (org-agenda-check-clock-gap tlend ts gapok) (setq issue (format "Clocking gap: %d minutes" - (/ (- ts tlend) 60)) + (/ (- ts tlend) 60)) face (or (plist-get pl :gap-face) face)))) (t nil))) (setq tlend (or te tlend) tlstart (or ts tlstart)) @@ -5206,9 +5560,9 @@ See also the user option `org-agenda-clock-consistency-checks'." (regexp org-deadline-time-regexp) (todayp (org-agenda-todayp date)) ; DATE bound by calendar (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar - d2 diff dfrac wdays pos pos1 category org-category-pos + d2 diff dfrac wdays pos pos1 category category-pos tags suppress-prewarning ee txt head face s todo-state - show-all upcomingp donep timestr) + show-all upcomingp donep timestr warntime) (goto-char (point-min)) (while (re-search-forward regexp nil t) (setq suppress-prewarning nil) @@ -5229,7 +5583,7 @@ See also the user option `org-agenda-clock-consistency-checks'." todo-state (save-match-data (org-get-todo-state)) show-all (or (eq org-agenda-repeating-timestamp-show-all t) (member todo-state - org-agenda-repeating-timestamp-show-all)) + org-agenda-repeating-timestamp-show-all)) d2 (org-time-string-to-absolute (match-string 1) d1 'past show-all (current-buffer) pos) @@ -5254,7 +5608,8 @@ See also the user option `org-agenda-clock-consistency-checks'." (not (= diff 0)))) (setq txt nil) (setq category (org-get-category) - org-category-pos (get-text-property (point) 'org-category-position)) + warntime (org-entry-get (point) "APPT_WARNTIME") + category-pos (get-text-property (point) 'org-category-position)) (if (not (re-search-backward "^\\*+[ \t]+" nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) @@ -5284,11 +5639,12 @@ See also the user option `org-agenda-clock-consistency-checks'." (setq face (org-agenda-deadline-face dfrac)) (org-add-props txt props 'org-marker (org-agenda-new-marker pos) + 'warntime warntime 'org-hd-marker (org-agenda-new-marker pos1) 'priority (+ (- diff) (org-get-priority txt)) 'org-category category - 'org-category-position org-category-pos + 'org-category-position category-pos 'todo-state todo-state 'type (if upcomingp "upcoming-deadline" "deadline") 'date (if upcomingp date d2) @@ -5321,11 +5677,12 @@ FRACTION is what fraction of the head-warning time has passed." mm (deadline-position-alist (mapcar (lambda (a) (and (setq mm (get-text-property - 0 'org-hd-marker a)) - (cons (marker-position mm) a))) + 0 'org-hd-marker a)) + (cons (marker-position mm) a))) deadline-results)) - d2 diff pos pos1 category org-category-pos tags donep - ee txt head pastschedp todo-state face timestr s habitp show-all) + d2 diff pos pos1 category category-pos tags donep + ee txt head pastschedp todo-state face timestr s habitp show-all + did-habit-check-p warntime) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -5340,14 +5697,24 @@ FRACTION is what fraction of the head-warning time has passed." d2 (org-time-string-to-absolute (match-string 1) d1 'past show-all (current-buffer) pos) - diff (- d2 d1)) + diff (- d2 d1) + warntime (org-entry-get (point) "APPT_WARNTIME")) (setq pastschedp (and todayp (< diff 0))) + (setq did-habit-check-p nil) ;; When to show a scheduled item in the calendar: ;; If it is on or past the date. (when (or (and (< diff 0) (< (abs diff) org-scheduled-past-days) (and todayp (not org-agenda-only-exact-dates))) - (= diff 0)) + (= diff 0) + ;; org-is-habit-p uses org-entry-get, which is expansive + ;; so we go extra mile to only call it once + (and todayp + (boundp 'org-habit-show-all-today) + org-habit-show-all-today + (setq did-habit-check-p t) + (setq habitp (and (functionp 'org-is-habit-p) + (org-is-habit-p))))) (save-excursion (setq donep (member todo-state org-done-keywords)) (if (and donep @@ -5356,10 +5723,11 @@ FRACTION is what fraction of the head-warning time has passed." (and (functionp 'org-is-habit-p) (org-is-habit-p)))) (setq txt nil) - (setq habitp (and (functionp 'org-is-habit-p) - (org-is-habit-p))) + (setq habitp (if did-habit-check-p habitp + (and (functionp 'org-is-habit-p) + (org-is-habit-p)))) (setq category (org-get-category) - org-category-pos (get-text-property (point) 'org-category-position)) + category-pos (get-text-property (point) 'org-category-position)) (if (not (re-search-backward "^\\*+[ \t]+" nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) @@ -5367,6 +5735,7 @@ FRACTION is what fraction of the head-warning time has passed." (if habitp (if (or (not org-habit-show-habits) (and (not todayp) + (boundp 'org-habit-show-habits-only-for-today) org-habit-show-habits-only-for-today)) (throw :skip nil)) (if (and @@ -5406,11 +5775,12 @@ FRACTION is what fraction of the head-warning time has passed." 'org-hd-marker (org-agenda-new-marker pos1) 'type (if pastschedp "past-scheduled" "scheduled") 'date (if pastschedp d2 date) + 'warntime warntime 'priority (if habitp (org-habit-get-priority habitp) (+ 94 (- 5 diff) (org-get-priority txt))) 'org-category category - 'org-category-position org-category-pos + 'category-position category-pos 'org-habit-p habitp 'todo-state todo-state) (push txt ee)))))) @@ -5428,7 +5798,7 @@ FRACTION is what fraction of the head-warning time has passed." (abbreviate-file-name buffer-file-name)))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) - marker hdmarker ee txt d1 d2 s1 s2 category org-category-pos + marker hdmarker ee txt d1 d2 s1 s2 category category-pos todo-state tags pos head donep) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5451,7 +5821,7 @@ FRACTION is what fraction of the head-warning time has passed." (throw :skip t)) (setq marker (org-agenda-new-marker (point))) (setq category (org-get-category) - org-category-pos (get-text-property (point) 'org-category-position)) + category-pos (get-text-property (point) 'org-category-position)) (if (not (re-search-backward org-outline-regexp-bol nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) @@ -5477,15 +5847,14 @@ FRACTION is what fraction of the head-warning time has passed." ((= d1 d0) (concat "<" start-time ">")) ((= d2 d0) - (concat "<" end-time ">")) - (t nil)) - remove-re)))) + (concat "<" end-time ">"))) + remove-re t)))) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date 'todo-state todo-state 'priority (org-get-priority txt) 'org-category category - 'org-category-position org-category-pos) + 'org-category-position category-pos) (push txt ee)))) (goto-char pos))) ;; Sort the entries by expiration date. @@ -5513,7 +5882,7 @@ The flag is set if the currently compiled format contains a `%e'.") (when (org-string-match-p (car entry) category) (if (listp (cadr entry)) (return (cadr entry)) - (return (apply 'create-image (cdr entry))))))) + (return (apply 'create-image (cdr entry))))))) (defun org-agenda-format-item (extra txt &optional category tags dotime remove-re habitp) @@ -5527,151 +5896,163 @@ time-of-day should be extracted from TXT for sorting of this entry, and for the `%t' specifier in the format. When DOTIME is a string, this string is searched for a time before TXT is. TAGS can be the tags of the headline. Any match of REMOVE-RE will be removed from TXT." - (save-match-data - ;; Diary entries sometimes have extra whitespace at the beginning - (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) - - ;; Fix the tags part in txt - (setq txt (org-agenda-fix-displayed-tags - txt tags - org-agenda-show-inherited-tags - org-agenda-hide-tags-regexp)) - (let* ((category (or category - (if (stringp org-category) - org-category - (and org-category (symbol-name org-category))) - (if buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ""))) - (category-icon (org-agenda-get-category-icon category)) - (category-icon (if category-icon - (propertize " " 'display category-icon) - "")) - ;; time, tag, effort are needed for the eval of the prefix format - (tag (if tags (nth (1- (length tags)) tags) "")) - time effort neffort - (ts (if dotime (concat - (if (stringp dotime) dotime "") - (and org-agenda-search-headline-for-time txt)))) - (time-of-day (and dotime (org-get-time-of-day ts))) - stamp plain s0 s1 s2 rtn srp l - duration thecategory) - (and (eq major-mode 'org-mode) buffer-file-name - (add-to-list 'org-agenda-contributing-files buffer-file-name)) - (when (and dotime time-of-day) - ;; Extract starting and ending time and move them to prefix - (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) - (setq plain (string-match org-plain-time-of-day-regexp ts))) - (setq s0 (match-string 0 ts) - srp (and stamp (match-end 3)) - s1 (match-string (if plain 1 2) ts) - s2 (match-string (if plain 8 (if srp 4 6)) ts)) - - ;; If the times are in TXT (not in DOTIMES), and the prefix will list - ;; them, we might want to remove them there to avoid duplication. - ;; The user can turn this off with a variable. - (if (and org-prefix-has-time - org-agenda-remove-times-when-in-prefix (or stamp plain) - (string-match (concat (regexp-quote s0) " *") txt) - (not (equal ?\] (string-to-char (substring txt (match-end 0))))) - (if (eq org-agenda-remove-times-when-in-prefix 'beg) - (= (match-beginning 0) 0) - t)) - (setq txt (replace-match "" nil nil txt)))) - ;; Normalize the time(s) to 24 hour - (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 - (when (and s1 (not s2) org-agenda-default-appointment-duration) - (setq s2 - (org-minutes-to-hh:mm-string - (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration)))) - - ;; Compute the duration - (when s2 - (setq duration (- (org-hh:mm-string-to-minutes s2) - (org-hh:mm-string-to-minutes s1))))) - - (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") - txt) - ;; Tags are in the string - (if (or (eq org-agenda-remove-tags t) - (and org-agenda-remove-tags - org-prefix-has-tag)) - (setq txt (replace-match "" t t txt)) - (setq txt (replace-match - (concat (make-string (max (- 50 (length txt)) 1) ?\ ) - (match-string 2 txt)) - t t txt)))) - (when (eq major-mode 'org-mode) - (setq effort - (condition-case nil - (org-get-effort - (or (get-text-property 0 'org-hd-marker txt) - (get-text-property 0 'org-marker txt))) - (error nil))) - (when effort - (setq neffort (org-duration-string-to-minutes effort) - effort (setq effort (concat "[" effort "]"))))) - ;; prevent erroring out with %e format when there is no effort - (or effort (setq effort "")) - - (when remove-re - (while (string-match remove-re txt) - (setq txt (replace-match "" t t txt)))) - - ;; Set org-heading property on `txt' to mark the start of the - ;; heading. - (add-text-properties 0 (length txt) '(org-heading t) txt) - - ;; Prepare the variables needed in the eval of the compiled format - (setq time (cond (s2 (concat - (org-agenda-time-of-day-to-ampm-maybe s1) - "-" (org-agenda-time-of-day-to-ampm-maybe s2) - (if org-agenda-timegrid-use-ampm " "))) - (s1 (concat - (org-agenda-time-of-day-to-ampm-maybe s1) - (if org-agenda-timegrid-use-ampm - "........ " - "......"))) - (t "")) - extra (or (and (not habitp) extra) "") - category (if (symbolp category) (symbol-name category) category) - thecategory (copy-sequence category)) - (if (string-match org-bracket-link-regexp category) - (progn - (setq l (if (match-end 3) - (- (match-end 3) (match-beginning 3)) - (- (match-end 1) (match-beginning 1)))) - (when (< l (or org-prefix-category-length 0)) - (setq category (copy-sequence category)) - (org-add-props category nil - 'extra-space (make-string - (- org-prefix-category-length l 1) ?\ )))) - (if (and org-prefix-category-max-length - (>= (length category) org-prefix-category-max-length)) - (setq category (substring category 0 (1- org-prefix-category-max-length))))) - ;; Evaluate the compiled format - (setq rtn (concat (eval org-prefix-format-compiled) txt)) - - ;; And finally add the text properties - (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) - (org-add-props rtn nil - 'org-category (if thecategory (downcase thecategory) category) - 'tags (mapcar 'org-downcase-keep-props tags) - 'org-highest-priority org-highest-priority - 'org-lowest-priority org-lowest-priority - 'time-of-day time-of-day - 'duration duration - 'effort effort - 'effort-minutes neffort - 'txt txt - 'time time - 'extra extra - 'format org-prefix-format-compiled - 'dotime dotime)))) + ;; We keep the org-prefix-* variable values along with a compiled + ;; formatter, so that multiple agendas existing at the same time, do + ;; not step on each other toes. + ;; + ;; It was inconvenient to make these variables buffer local in + ;; Agenda buffers, because this function expects to be called with + ;; the buffer where item comes from being current, and not agenda + ;; buffer + (let* ((bindings (car org-prefix-format-compiled)) + (formatter (cadr org-prefix-format-compiled))) + (loop for (var value) in bindings + do (set var value)) + (save-match-data + ;; Diary entries sometimes have extra whitespace at the beginning + (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) + + ;; Fix the tags part in txt + (setq txt (org-agenda-fix-displayed-tags + txt tags + org-agenda-show-inherited-tags + org-agenda-hide-tags-regexp)) + (let* ((category (or category + (if (stringp org-category) + org-category + (and org-category (symbol-name org-category))) + (if buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ""))) + (category-icon (org-agenda-get-category-icon category)) + (category-icon (if category-icon + (propertize " " 'display category-icon) + "")) + ;; time, tag, effort are needed for the eval of the prefix format + (tag (if tags (nth (1- (length tags)) tags) "")) + time effort neffort + (ts (if dotime (concat + (if (stringp dotime) dotime "") + (and org-agenda-search-headline-for-time txt)))) + (time-of-day (and dotime (org-get-time-of-day ts))) + stamp plain s0 s1 s2 rtn srp l + duration thecategory) + (and (derived-mode-p 'org-mode) buffer-file-name + (add-to-list 'org-agenda-contributing-files buffer-file-name)) + (when (and dotime time-of-day) + ;; Extract starting and ending time and move them to prefix + (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) + (setq plain (string-match org-plain-time-of-day-regexp ts))) + (setq s0 (match-string 0 ts) + srp (and stamp (match-end 3)) + s1 (match-string (if plain 1 2) ts) + s2 (match-string (if plain 8 (if srp 4 6)) ts)) + + ;; If the times are in TXT (not in DOTIMES), and the prefix will list + ;; them, we might want to remove them there to avoid duplication. + ;; The user can turn this off with a variable. + (if (and org-prefix-has-time + org-agenda-remove-times-when-in-prefix (or stamp plain) + (string-match (concat (regexp-quote s0) " *") txt) + (not (equal ?\] (string-to-char (substring txt (match-end 0))))) + (if (eq org-agenda-remove-times-when-in-prefix 'beg) + (= (match-beginning 0) 0) + t)) + (setq txt (replace-match "" nil nil txt)))) + ;; Normalize the time(s) to 24 hour + (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 + (when (and s1 (not s2) org-agenda-default-appointment-duration) + (setq s2 + (org-minutes-to-hh:mm-string + (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration)))) + + ;; Compute the duration + (when s2 + (setq duration (- (org-hh:mm-string-to-minutes s2) + (org-hh:mm-string-to-minutes s1))))) + + (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + txt) + ;; Tags are in the string + (if (or (eq org-agenda-remove-tags t) + (and org-agenda-remove-tags + org-prefix-has-tag)) + (setq txt (replace-match "" t t txt)) + (setq txt (replace-match + (concat (make-string (max (- 50 (length txt)) 1) ?\ ) + (match-string 2 txt)) + t t txt)))) + (when (derived-mode-p 'org-mode) + (setq effort + (condition-case nil + (org-get-effort + (or (get-text-property 0 'org-hd-marker txt) + (get-text-property 0 'org-marker txt))) + (error nil))) + (when effort + (setq neffort (org-duration-string-to-minutes effort) + effort (setq effort (concat "[" effort "]"))))) + ;; prevent erroring out with %e format when there is no effort + (or effort (setq effort "")) + + (when remove-re + (while (string-match remove-re txt) + (setq txt (replace-match "" t t txt)))) + + ;; Set org-heading property on `txt' to mark the start of the + ;; heading. + (add-text-properties 0 (length txt) '(org-heading t) txt) + + ;; Prepare the variables needed in the eval of the compiled format + (setq time (cond (s2 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + "-" (org-agenda-time-of-day-to-ampm-maybe s2) + (if org-agenda-timegrid-use-ampm " "))) + (s1 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + (if org-agenda-timegrid-use-ampm + "........ " + "......"))) + (t "")) + extra (or (and (not habitp) extra) "") + category (if (symbolp category) (symbol-name category) category) + thecategory (copy-sequence category)) + (if (string-match org-bracket-link-regexp category) + (progn + (setq l (if (match-end 3) + (- (match-end 3) (match-beginning 3)) + (- (match-end 1) (match-beginning 1)))) + (when (< l (or org-prefix-category-length 0)) + (setq category (copy-sequence category)) + (org-add-props category nil + 'extra-space (make-string + (- org-prefix-category-length l 1) ?\ )))) + (if (and org-prefix-category-max-length + (>= (length category) org-prefix-category-max-length)) + (setq category (substring category 0 (1- org-prefix-category-max-length))))) + ;; Evaluate the compiled format + (setq rtn (concat (eval formatter) txt)) + + ;; And finally add the text properties + (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) + (org-add-props rtn nil + 'org-category (if thecategory (downcase thecategory) category) + 'tags (mapcar 'org-downcase-keep-props tags) + 'org-highest-priority org-highest-priority + 'org-lowest-priority org-lowest-priority + 'time-of-day time-of-day + 'duration duration + 'effort effort + 'effort-minutes neffort + 'txt txt + 'time time + 'extra extra + 'format org-prefix-format-compiled + 'dotime dotime))))) (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) "Remove tags string from TXT, and add a modified list of tags. @@ -5703,7 +6084,7 @@ The modified list may contain inherited tags, and tags matched by x)) tags ":") (if have-i "::" ":")))))) - txt) + txt) (defun org-downcase-keep-props (s) (let ((props (text-properties-at 0 s))) @@ -5757,8 +6138,8 @@ The modified list may contain inherited tags, and tags matched by (defun org-compile-prefix-format (key) "Compile the prefix format into a Lisp form that can be evaluated. -The resulting form is returned and stored in the variable -`org-prefix-format-compiled'." +The resulting form and associated variable bindings is returned +and stored in the variable `org-prefix-format-compiled'." (setq org-prefix-has-time nil org-prefix-has-tag nil org-prefix-category-length nil org-prefix-has-effort nil) @@ -5802,7 +6183,14 @@ The resulting form is returned and stored in the variable (setq s (replace-match "%s" t nil s)) (push varform vars)) (setq vars (nreverse vars)) - (setq org-prefix-format-compiled `(format ,s ,@vars)))) + (with-current-buffer (or org-agenda-buffer (current-buffer)) + (setq org-prefix-format-compiled + (list + `((org-prefix-has-time ,org-prefix-has-time) + (org-prefix-has-tag ,org-prefix-has-tag) + (org-prefix-category-length ,org-prefix-category-length) + (org-prefix-has-effort ,org-prefix-has-effort)) + `(format ,s ,@vars)))))) (defun org-set-sorting-strategy (key) (if (symbolp (car org-agenda-sorting-strategy)) @@ -5823,23 +6211,23 @@ HH:MM." (when (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) - (let* ((h (string-to-number (match-string 1 s))) - (m (if (match-end 3) (string-to-number (match-string 3 s)) 0)) - (ampm (if (match-end 4) (downcase (match-string 4 s)))) - (am-p (equal ampm "am")) - (h1 (cond ((not ampm) h) - ((= h 12) (if am-p 0 12)) - (t (+ h (if am-p 0 12))))) - (h2 (if (and string mod24 (not (and (= m 0) (= h1 24)))) - (mod h1 24) h1)) - (t0 (+ (* 100 h2) m)) - (t1 (concat (if (>= h1 24) "+" " ") - (if (and org-agenda-time-leading-zero - (< t0 1000)) "0" "") - (if (< t0 100) "0" "") - (if (< t0 10) "0" "") - (int-to-string t0)))) - (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) + (let* ((h (string-to-number (match-string 1 s))) + (m (if (match-end 3) (string-to-number (match-string 3 s)) 0)) + (ampm (if (match-end 4) (downcase (match-string 4 s)))) + (am-p (equal ampm "am")) + (h1 (cond ((not ampm) h) + ((= h 12) (if am-p 0 12)) + (t (+ h (if am-p 0 12))))) + (h2 (if (and string mod24 (not (and (= m 0) (= h1 24)))) + (mod h1 24) h1)) + (t0 (+ (* 100 h2) m)) + (t1 (concat (if (>= h1 24) "+" " ") + (if (and org-agenda-time-leading-zero + (< t0 1000)) "0" "") + (if (< t0 100) "0" "") + (if (< t0 10) "0" "") + (int-to-string t0)))) + (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) (defvar org-agenda-before-sorting-filter-function nil "Function to be applied to agenda items prior to sorting. @@ -5861,7 +6249,7 @@ You can also use this function as a filter, by returning nil for lines you don't want to have in the agenda at all. For this application, you could bind the variable in the options section of a custom command.") -(defun org-finalize-agenda-entries (list &optional nosort) +(defun org-agenda-finalize-entries (list &optional nosort) "Sort and concatenate the agenda items." (setq list (mapcar 'org-agenda-highlight-todo list)) (if nosort @@ -5918,8 +6306,7 @@ could bind the variable in the options section of a custom command.") (let ((pa (or (get-text-property 1 'priority a) 0)) (pb (or (get-text-property 1 'priority b) 0))) (cond ((> pa pb) +1) - ((< pa pb) -1) - (t nil)))) + ((< pa pb) -1)))) (defsubst org-cmp-effort (a b) "Compare the effort values of string A and B." @@ -5927,16 +6314,14 @@ could bind the variable in the options section of a custom command.") (ea (or (get-text-property 1 'effort-minutes a) def)) (eb (or (get-text-property 1 'effort-minutes b) def))) (cond ((> ea eb) +1) - ((< ea eb) -1) - (t nil)))) + ((< ea eb) -1)))) (defsubst org-cmp-category (a b) "Compare the string values of categories of strings A and B." (let ((ca (or (get-text-property 1 'org-category a) "")) (cb (or (get-text-property 1 'org-category b) ""))) (cond ((string-lessp ca cb) -1) - ((string-lessp cb ca) +1) - (t nil)))) + ((string-lessp cb ca) +1)))) (defsubst org-cmp-todo-state (a b) "Compare the todo states of strings A and B." @@ -5958,8 +6343,7 @@ could bind the variable in the options section of a custom command.") (cond ((and donepa (not donepb)) -1) ((and (not donepa) donepb) +1) ((< la lb) -1) - ((< lb la) +1) - (t nil)))) + ((< lb la) +1)))) (defsubst org-cmp-alpha (a b) "Compare the headlines, alphabetically." @@ -5980,8 +6364,7 @@ could bind the variable in the options section of a custom command.") (cond ((not ta) +1) ((not tb) -1) ((string-lessp ta tb) -1) - ((string-lessp tb ta) +1) - (t nil)))) + ((string-lessp tb ta) +1)))) (defsubst org-cmp-tag (a b) "Compare the string values of the first tags of A and B." @@ -5990,8 +6373,7 @@ could bind the variable in the options section of a custom command.") (cond ((not ta) +1) ((not tb) -1) ((string-lessp ta tb) -1) - ((string-lessp tb ta) +1) - (t nil)))) + ((string-lessp tb ta) +1)))) (defsubst org-cmp-time (a b) "Compare the time-of-day values of strings A and B." @@ -5999,16 +6381,14 @@ could bind the variable in the options section of a custom command.") (ta (or (get-text-property 1 'time-of-day a) def)) (tb (or (get-text-property 1 'time-of-day b) def))) (cond ((< ta tb) -1) - ((< tb ta) +1) - (t nil)))) + ((< tb ta) +1)))) (defsubst org-cmp-habit-p (a b) "Compare the todo states of strings A and B." (let ((ha (get-text-property 1 'org-habit-p a)) (hb (get-text-property 1 'org-habit-p b))) (cond ((and ha (not hb)) -1) - ((and (not ha) hb) +1) - (t nil)))) + ((and (not ha) hb) +1)))) (defsubst org-em (x y list) (or (memq x list) (memq y list))) @@ -6131,13 +6511,15 @@ in the file. Otherwise, restriction will be to the current subtree." (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." - (if (memq org-agenda-type types) - t - (if error - (error "Not allowed in %s-type agenda buffers" org-agenda-type) - nil))) - -(defun org-agenda-quit () + (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)))) + +(defun org-agenda-Quit (&optional arg) "Exit agenda by removing the window or the buffer." (interactive) (if org-agenda-columns-active @@ -6145,23 +6527,51 @@ If ERROR is non-nil, throw an error, otherwise just return nil." (let ((buf (current-buffer))) (if (eq org-agenda-window-setup 'other-frame) (progn - (kill-buffer buf) (org-agenda-reset-markers) + (kill-buffer buf) (org-columns-remove-overlays) (setq org-agenda-archives-mode nil) (delete-frame)) (and (not (eq org-agenda-window-setup 'current-window)) (not (one-window-p)) (delete-window)) - (kill-buffer buf) (org-agenda-reset-markers) + (kill-buffer buf) (org-columns-remove-overlays) (setq org-agenda-archives-mode nil))) ;; Maybe restore the pre-agenda window configuration. (and org-agenda-restore-windows-after-quit (not (eq org-agenda-window-setup 'other-frame)) - org-pre-agenda-window-conf - (set-window-configuration org-pre-agenda-window-conf)))) + org-agenda-pre-window-conf + (set-window-configuration org-agenda-pre-window-conf) + (setq org-agenda-pre-window-conf nil)))) + +(defun org-agenda-quit () + "Exit agenda by killing agenda buffer or burying it when +`org-agenda-sticky' is non-NIL" + (interactive) + (if (and (eq org-indirect-buffer-display 'other-window) + org-last-indirect-buffer) + (delete-window (get-buffer-window org-last-indirect-buffer))) + (if org-agenda-columns-active + (org-columns-quit) + (if org-agenda-sticky + (let ((buf (current-buffer))) + (if (eq org-agenda-window-setup 'other-frame) + (progn + (delete-frame)) + (and (not (eq org-agenda-window-setup 'current-window)) + (not (one-window-p)) + (delete-window))) + (with-current-buffer buf + (bury-buffer) + ;; Maybe restore the pre-agenda window configuration. + (and org-agenda-restore-windows-after-quit + (not (eq org-agenda-window-setup 'other-frame)) + org-agenda-pre-window-conf + (set-window-configuration org-agenda-pre-window-conf) + (setq org-agenda-pre-window-conf nil)))) + (org-agenda-Quit)))) (defun org-agenda-exit () "Exit agenda by removing the window or the buffer. @@ -6170,7 +6580,18 @@ Org-mode buffers visited directly by the user will not be touched." (interactive) (org-release-buffers org-agenda-new-buffers) (setq org-agenda-new-buffers nil) - (org-agenda-quit)) + (org-agenda-Quit)) + +(defun org-agenda-kill-all-agenda-buffers () + "Kill all buffers in `org-agena-mode'. +This is used when toggling sticky agendas. You can also explicitly invoke it +with `C-c a C-k'." + (interactive) + (let (blist) + (dolist (buf (buffer-list)) + (when (with-current-buffer buf (eq major-mode 'org-agenda-mode)) + (push buf blist))) + (mapc 'kill-buffer blist))) (defun org-agenda-execute (arg) "Execute another agenda command, keeping same window. @@ -6180,25 +6601,43 @@ in the agenda." (let ((org-agenda-window-setup 'current-window)) (org-agenda arg))) -(defun org-agenda-redo () - "Rebuild Agenda. -When this is the global TODO list, a prefix argument will be interpreted." - (interactive) - (let* ((org-agenda-keep-modes t) +(defun org-agenda-redo (&optional all) + "Rebuild possibly ALL agenda view(s) in the current buffer." + (interactive "P") + (let* ((p (or (and (looking-at "\\'") (1- (point))) (point))) + (cpa (unless (eq all t) current-prefix-arg)) + (org-agenda-doing-sticky-redo org-agenda-sticky) + (org-agenda-sticky nil) + (org-agenda-buffer-name (or org-agenda-this-buffer-name + org-agenda-buffer-name)) + (org-agenda-keep-modes t) (tag-filter org-agenda-tag-filter) (tag-preset (get 'org-agenda-tag-filter :preset-filter)) + (top-cat-filter org-agenda-top-category-filter) (cat-filter org-agenda-category-filter) (cat-preset (get 'org-agenda-category-filter :preset-filter)) (org-agenda-tag-filter-while-redo (or tag-filter tag-preset)) (cols org-agenda-columns-active) (line (org-current-line)) (window-line (- line (org-current-line (window-start)))) - (lprops (get 'org-agenda-redo-command 'org-lprops))) + (lprops (get 'org-agenda-redo-command 'org-lprops)) + (redo-cmd (get-text-property p 'org-redo-cmd)) + (last-args (get-text-property p 'org-last-args)) + (org-agenda-overriding-cmd (get-text-property p 'org-serie-cmd)) + (org-agenda-overriding-cmd-arguments + (unless (eq all t) + (cond ((listp last-args) + (cons (or cpa (car last-args)) (cdr last-args))) + ((stringp last-args) + last-args)))) + (serie-redo-cmd (get-text-property p 'org-serie-redo-cmd))) (put 'org-agenda-tag-filter :preset-filter nil) (put 'org-agenda-category-filter :preset-filter nil) (and cols (org-columns-quit)) (message "Rebuilding agenda buffer...") - (org-let lprops '(eval org-agenda-redo-command)) + (if serie-redo-cmd + (eval serie-redo-cmd) + (org-let lprops '(eval redo-cmd))) (setq org-agenda-undo-list nil org-agenda-pending-undo-list nil) (message "Rebuilding agenda buffer...done") @@ -6206,6 +6645,7 @@ When this is the global TODO list, a prefix argument will be interpreted." (put 'org-agenda-category-filter :preset-filter cat-preset) (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag)) (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category)) + (and top-cat-filter (org-agenda-filter-top-category-apply top-cat-filter)) (and cols (org-called-interactively-p 'any) (org-agenda-columns)) (org-goto-line line) (recenter window-line))) @@ -6218,13 +6658,38 @@ When this is the global TODO list, a prefix argument will be interpreted." "Keep only those lines in the agenda buffer that have a specific category. The category is that of the current line." (interactive "P") - (if org-agenda-filtered-by-category + (if (and org-agenda-filtered-by-category + org-agenda-category-filter) (org-agenda-filter-show-all-cat) (let ((cat (org-no-properties (get-text-property (point) 'org-category)))) (if cat (org-agenda-filter-apply (list (concat (if strip "-" "+") cat)) 'category) (error "No category at point"))))) +(defun org-find-top-category (&optional pos) + (save-excursion + (with-current-buffer (if pos (marker-buffer pos) (current-buffer)) + (if pos (goto-char pos)) + ;; Skip up to the topmost parent + (while (ignore-errors (outline-up-heading 1) t)) + (ignore-errors + (nth 4 (org-heading-components)))))) + +(defvar org-agenda-filtered-by-top-category nil) + +(defun org-agenda-filter-by-top-category (strip) + "Keep only those lines in the agenda buffer that have a specific category. +The category is that of the current line." + (interactive "P") + (if org-agenda-filtered-by-top-category + (progn + (setq org-agenda-filtered-by-top-category nil + org-agenda-top-category-filter nil) + (org-agenda-filter-show-all-cat)) + (let ((cat (org-find-top-category (org-get-at-bol 'org-hd-marker)))) + (if cat (org-agenda-filter-top-category-apply cat strip) + (error "No top-level category at point"))))) + (defun org-agenda-filter-by-tag (strip &optional char narrow) "Keep only those lines in the agenda buffer that have a specific tag. The tag is selected with its fast selection letter, as configured. @@ -6277,7 +6742,7 @@ to switch to narrowing." (message "Effort%s: %s " effort-op effort-prompt) (setq char (read-char-exclusive)) (when (or (< char ?0) (> char ?9)) - (error "Need 1-9,0 to select effort" )))) + (error "Need 1-9,0 to select effort")))) (when (equal char ?\t) (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) (org-set-local 'org-global-tags-completion-table @@ -6420,10 +6885,27 @@ If the line does not have an effort defined, return nil." (if (get-char-property (point) 'invisible) (ignore-errors (org-agenda-previous-line))))) +(defun org-agenda-filter-top-category-apply (category &optional negative) + "Set FILTER as the new agenda filter and apply it." + (org-agenda-set-mode-name) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let* ((pos (org-get-at-bol 'org-hd-marker)) + (topcat (and pos (org-find-top-category pos)))) + (if (and topcat (funcall (if negative 'identity 'not) + (string= category topcat))) + (org-agenda-filter-hide-line 'category))) + (beginning-of-line 2))) + (if (get-char-property (point) 'invisible) + (org-agenda-previous-line)) + (setq org-agenda-top-category-filter category + org-agenda-filtered-by-top-category t)) + (defun org-agenda-filter-hide-line (type) (let (ov) (setq ov (make-overlay (max (point-min) (1- (point-at-bol))) - (point-at-eol))) + (point-at-eol))) (overlay-put ov 'invisible t) (overlay-put ov 'type type) (if (eq type 'tag) @@ -6439,7 +6921,7 @@ If the line does not have an effort defined, return nil." (goto-char pos) (if (< (overlay-start ov) (point-at-eol)) (move-overlay ov (point-at-eol) - (overlay-end ov))))))) + (overlay-end ov))))))) (defun org-agenda-filter-show-all-tag nil (mapc 'delete-overlay org-agenda-tag-filter-overlays) @@ -6491,36 +6973,58 @@ Negative selection means regexp must not match for selection of an entry." " ")) (setq org-agenda-redo-command (list 'org-search-view - org-todo-only + (car (get-text-property (min (1- (point-max)) (point)) + 'org-last-args)) org-agenda-query-string (+ (length org-agenda-query-string) (if (member char '(?\{ ?\})) 0 1)))) (set-register org-agenda-query-register org-agenda-query-string) - (org-agenda-redo)) + (let ((org-agenda-overriding-arguments + (cdr org-agenda-redo-command))) + (org-agenda-redo))) (t (error "Cannot manipulate query for %s-type agenda buffers" org-agenda-type)))) (defun org-add-to-string (var string) (set var (concat (symbol-value var) string))) -(defun org-agenda-goto-date (date) +(defun org-agenda-goto-date (span) "Jump to DATE in agenda." - (interactive (list (let ((org-read-date-prefer-future - (eval org-agenda-jump-prefer-future))) - (org-read-date)))) - (org-agenda-list nil date)) + (interactive "P") + (let* ((org-read-date-prefer-future + (eval org-agenda-jump-prefer-future)) + (date (org-read-date)) + (org-agenda-sticky-orig org-agenda-sticky) + (org-agenda-buffer-tmp-name (buffer-name)) + (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (0-arg (or current-prefix-arg (car args))) + (2-arg (nth 2 args)) + (newcmd (list 'org-agenda-list 0-arg date + (org-agenda-span-to-ndays 2-arg))) + (newargs (cdr newcmd)) + (inhibit-read-only t) + org-agenda-sticky) + (if (not (org-agenda-check-type t 'agenda)) + (error "Not available in non-agenda blocks") + (add-text-properties (point-min) (point-max) + `(org-redo-cmd ,newcmd org-last-args ,newargs)) + (org-agenda-redo) + (setq org-agenda-sticky org-agenda-sticky-orig + org-agenda-this-buffer-is-sticky org-agenda-sticky)))) (defun org-agenda-goto-today () "Go to today." (interactive) (org-agenda-check-type t 'timeline 'agenda) - (let ((tdpos (text-property-any (point-min) (point-max) 'org-today t))) + (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))) (cond (tdpos (goto-char tdpos)) ((eq org-agenda-type 'agenda) (let* ((sd (org-agenda-compute-starting-span - (org-today) (or org-agenda-current-span org-agenda-ndays org-agenda-span))) - (org-agenda-overriding-arguments org-agenda-last-arguments)) + (org-today) (or curspan org-agenda-ndays org-agenda-span))) + (org-agenda-overriding-arguments args)) (setf (nth 1 org-agenda-overriding-arguments) sd) (org-agenda-redo) (org-agenda-find-same-or-today-or-agenda))) @@ -6531,19 +7035,43 @@ Negative selection means regexp must not match for selection of an entry." (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) (text-property-any (point-min) (point-max) 'org-today t) (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) + (and (get-text-property (min (1- (point-max)) (point)) 'org-serie) + (org-agenda-goto-block-beginning)) (point-min)))) +(defun org-agenda-goto-block-beginning () + "Go the agenda block beginning." + (interactive) + (if (not (derived-mode-p 'org-agenda-mode)) + (error "Cannot execute this command outside of org-agenda-mode buffers") + (let (dest) + (save-excursion + (unless (looking-at "\\'") + (forward-char)) + (let* ((prop 'org-agenda-structural-header) + (p (previous-single-property-change (point) prop)) + (n (next-single-property-change (or (and (looking-at "\\`") 1) + (1- (point))) prop))) + (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p)))))) + (if (not dest) + (error "Cannot find the beginning of the blog") + (goto-char dest) + (move-beginning-of-line 1))))) + (defun org-agenda-later (arg) "Go forward in time by thee current span. With prefix ARG, go forward that many times the current span." (interactive "p") (org-agenda-check-type t 'agenda) - (let* ((span org-agenda-current-span) - (sd org-starting-day) + (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (span (or (nth 2 args) org-agenda-current-span)) + (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day)) (greg (calendar-gregorian-from-absolute sd)) (cnt (org-get-at-bol 'org-day-cnt)) greg2) (cond + ((numberp span) + (setq sd (+ span sd))) ((eq span 'day) (setq sd (+ arg sd))) ((eq span 'week) @@ -6558,8 +7086,13 @@ With prefix ARG, go forward that many times the current span." (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))) (t (setq sd (+ (* span arg) sd)))) - (let ((org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) sd span t))) + (let ((org-agenda-overriding-cmd + ;; `cmd' may have been set by `org-agenda-run-series' which + ;; uses `org-agenda-overriding-cmd' to decide whether + ;; overriding is allowed for `cmd' + (get-text-property (min (1- (point-max)) (point)) 'org-serie-cmd)) + (org-agenda-overriding-arguments + (list (car args) sd span))) (org-agenda-redo) (org-agenda-find-same-or-today-or-agenda cnt)))) @@ -6572,10 +7105,9 @@ With prefix ARG, go backward that many times the current span." (defun org-agenda-view-mode-dispatch () "Call one of the view mode commands." (interactive) - (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort - time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck - [a]rch-trees [A]rch-files clock[R]eport include[D]iary - [E]ntryText") + (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort + time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck + [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") (let ((a (read-char-exclusive))) (case a (?\ (call-interactively 'org-agenda-reset-view)) @@ -6642,18 +7174,22 @@ written as 2-digit years." "Change the agenda view to SPAN. SPAN may be `day', `week', `month', `year'." (org-agenda-check-type t 'agenda) - (if (and (not n) (equal org-agenda-current-span span)) - (error "Viewing span is already \"%s\"" span)) - (let* ((sd (or (org-get-at-bol 'day) - org-starting-day)) - (sd (org-agenda-compute-starting-span sd span n)) - (org-agenda-overriding-arguments - (or org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) sd span t)))) - (org-agenda-redo) - (org-agenda-find-same-or-today-or-agenda)) - (org-agenda-set-mode-name) - (message "Switched to %s view" span)) + (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (curspan (nth 2 args))) + (if (and (not n) (equal curspan span)) + (error "Viewing span is already \"%s\"" span)) + (let* ((sd (or (org-get-at-bol 'day) + (nth 1 args) + org-starting-day)) + (sd (org-agenda-compute-starting-span sd span n)) + (org-agenda-overriding-cmd + (get-text-property (min (1- (point-max)) (point)) 'org-serie-cmd)) + (org-agenda-overriding-arguments + (list (car args) sd span))) + (org-agenda-redo) + (org-agenda-find-same-or-today-or-agenda)) + (org-agenda-set-mode-name) + (message "Switched to %s view" span))) (defun org-agenda-compute-starting-span (sd span &optional n) "Compute starting date for agenda. @@ -6732,20 +7268,21 @@ so that the date SD will be in that range." "Detach overlay INDEX." (org-detach-overlay org-hl)) -;; FIXME this is currently not used. -(defun org-highlight-until-next-command (beg end &optional buffer) - "Move the highlight overlay to BEG/END, remove it before the next command." - (org-highlight beg end buffer) - (add-hook 'pre-command-hook 'org-unhighlight-once)) (defun org-unhighlight-once () "Remove the highlight from its position, and this function from the hook." (remove-hook 'pre-command-hook 'org-unhighlight-once) (org-unhighlight)) +(defvar org-agenda-pre-follow-window-conf nil) (defun org-agenda-follow-mode () "Toggle follow mode in an agenda buffer." (interactive) + (unless org-agenda-follow-mode + (setq org-agenda-pre-follow-window-conf + (current-window-configuration))) (setq org-agenda-follow-mode (not org-agenda-follow-mode)) + (unless org-agenda-follow-mode + (set-window-configuration org-agenda-pre-follow-window-conf)) (org-agenda-set-mode-name) (org-agenda-do-context-action) (message "Follow mode is %s" @@ -6883,7 +7420,7 @@ When called with a prefix argument, include all archive files as well." 'help-echo "Category used in filtering")) "") (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter - :preset-filter)) + :preset-filter)) '(:eval (org-propertize (concat " {" (mapconcat @@ -6907,11 +7444,14 @@ When called with a prefix argument, include all archive files as well." ""))) (force-mode-line-update)) -(defun org-agenda-post-command-hook () +(define-obsolete-function-alias + 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3") + +(defun org-agenda-update-agenda-type () + "Update the agenda type after each command." (setq org-agenda-type (or (get-text-property (point) 'org-agenda-type) - (get-text-property (max (point-min) (1- (point))) - 'org-agenda-type)))) + (get-text-property (max (point-min) (1- (point))) 'org-agenda-type)))) (defun org-agenda-next-line () "Move cursor to the next line, and show if follow mode is active." @@ -6925,25 +7465,40 @@ When called with a prefix argument, include all archive files as well." (call-interactively 'previous-line) (org-agenda-do-context-action)) +(defun org-agenda-next-item (n) + "Move cursor to next agenda item." + (interactive "p") + (let ((col (current-column))) + (dotimes (c n) + (when (next-single-property-change (point-at-eol) 'org-marker) + (move-end-of-line 1) + (goto-char (next-single-property-change (point) 'org-marker)))) + (org-move-to-column col)) + (org-agenda-do-context-action)) + +(defun org-agenda-previous-item (n) + "Move cursor to next agenda item." + (interactive "p") + (dotimes (c n) + (let ((col (current-column)) + (goto (save-excursion + (move-end-of-line 0) + (previous-single-property-change (point) 'org-marker)))) + (if goto (goto-char goto)) + (org-move-to-column col))) + (org-agenda-do-context-action)) + (defun org-agenda-do-context-action () "Show outline path and, maybe, follow mode window." (let ((m (org-get-at-bol 'org-marker))) (when (and (markerp m) (marker-buffer m)) (and org-agenda-follow-mode (if org-agenda-follow-indirect - (org-agenda-tree-to-indirect-buffer) + (org-agenda-tree-to-indirect-buffer nil) (org-agenda-show))) (and org-agenda-show-outline-path (org-with-point-at m (org-display-outline-path t)))))) -(defun org-agenda-show-priority () - "Show the priority of the current item. -This priority is composed of the main priority given with the [#A] cookies, -and by additional input from the age of a schedules or deadline entry." - (interactive) - (let* ((pri (org-get-at-bol 'priority))) - (message "Priority is %d" (if pri pri -1000)))) - (defun org-agenda-show-tags () "Show the tags applicable to the current item." (interactive) @@ -6964,7 +7519,7 @@ and by additional input from the age of a schedules or deadline entry." (widen) (push-mark) (goto-char pos) - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (org-show-context 'agenda) (save-excursion (and (outline-next-heading) @@ -6983,36 +7538,38 @@ Point is in the buffer where the item originated.") "Kill the entry or subtree belonging to the current agenda entry." (interactive) (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) - (let* ((marker (or (org-get-at-bol 'org-marker) + (let* ((bufname-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker)) (type (org-get-at-bol 'type)) dbeg dend (n 0) conf) (org-with-remote-undo buffer - (with-current-buffer buffer - (save-excursion - (goto-char pos) - (if (and (eq major-mode 'org-mode) (not (member type '("sexp")))) - (setq dbeg (progn (org-back-to-heading t) (point)) - dend (org-end-of-subtree t t)) - (setq dbeg (point-at-bol) - dend (min (point-max) (1+ (point-at-eol))))) - (goto-char dbeg) - (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) - (setq conf (or (eq t org-agenda-confirm-kill) - (and (numberp org-agenda-confirm-kill) - (> n org-agenda-confirm-kill)))) - (and conf - (not (y-or-n-p - (format "Delete entry with %d lines in buffer \"%s\"? " - n (buffer-name buffer)))) - (error "Abort")) - (org-remove-subtree-entries-from-agenda buffer dbeg dend) - (with-current-buffer buffer (delete-region dbeg dend)) - (message "Agenda item and source killed")))) - -(defvar org-archive-default-command) + (with-current-buffer buffer + (save-excursion + (goto-char pos) + (if (and (derived-mode-p 'org-mode) (not (member type '("sexp")))) + (setq dbeg (progn (org-back-to-heading t) (point)) + dend (org-end-of-subtree t t)) + (setq dbeg (point-at-bol) + dend (min (point-max) (1+ (point-at-eol))))) + (goto-char dbeg) + (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) + (setq conf (or (eq t org-agenda-confirm-kill) + (and (numberp org-agenda-confirm-kill) + (> n org-agenda-confirm-kill)))) + (and conf + (not (y-or-n-p + (format "Delete entry with %d lines in buffer \"%s\"? " + n (buffer-name buffer)))) + (error "Abort")) + (let ((org-agenda-buffer-name bufname-orig)) + (org-remove-subtree-entries-from-agenda buffer dbeg dend)) + (with-current-buffer buffer (delete-region dbeg dend)) + (message "Agenda item and source killed")))) + +(defvar org-archive-default-command) ; defined in org-archive.el (defun org-agenda-archive-default () "Archive the entry or subtree belonging to the current agenda entry." (interactive) @@ -7039,19 +7596,21 @@ Point is in the buffer where the item originated.") "Move the entry to the archive sibling." (interactive) (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) - (let* ((marker (or (org-get-at-bol 'org-marker) + (let* ((bufname-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker))) (org-with-remote-undo buffer (with-current-buffer buffer - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (if (and confirm (not (y-or-n-p "Archive this subtree or entry? "))) (error "Abort") (save-excursion (goto-char pos) - (org-remove-subtree-entries-from-agenda) + (let ((org-agenda-buffer-name bufname-orig)) + (org-remove-subtree-entries-from-agenda)) (org-back-to-heading t) (funcall cmd))) (error "Archiving works only in Org-mode files")))))) @@ -7086,7 +7645,8 @@ If this information is not given, the function uses the tree at point." (interactive "P") (if (equal goto '(16)) (org-refile-goto-last-stored) - (let* ((marker (or (org-get-at-bol 'org-hd-marker) + (let* ((buffer-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-hd-marker) (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker)) @@ -7099,7 +7659,8 @@ If this information is not given, the function uses the tree at point." (save-restriction (widen) (goto-char marker) - (org-remove-subtree-entries-from-agenda) + (let ((org-agenda-buffer-name buffer-orig)) + (org-remove-subtree-entries-from-agenda)) (org-refile goto buffer rfloc))))) (unless no-update (org-agenda-redo)))) @@ -7150,13 +7711,14 @@ at the text of the entry itself." (and delete-other-windows (delete-other-windows)) (widen) (goto-char pos) - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (org-show-context 'agenda) (save-excursion (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading (when (outline-invisible-p) - (show-entry)))))) ; display invisible text + (show-entry)) ; display invisible text + (run-hooks 'org-agenda-after-show-hook))))) (defun org-agenda-goto-mouse (ev) "Go to the Org-mode file which contains the item at the mouse click." @@ -7177,10 +7739,13 @@ if it was hidden in the outline." (select-window win))) (defvar org-agenda-show-window nil) -(defun org-agenda-show-and-scroll-up () +(defun org-agenda-show-and-scroll-up (&optional arg) "Display the Org-mode file which contains the item at point. -When called repeatedly, scroll the window that is displaying the buffer." - (interactive) +When called repeatedly, scroll the window that is displaying the buffer. +With a \\[universal-argument] prefix, use `org-show-entry' instead of +`show-subtree' to display the item, so that drawers and logbooks stay +folded." + (interactive "P") (let ((win (selected-window))) (if (and (window-live-p org-agenda-show-window) (eq this-command last-command)) @@ -7188,7 +7753,7 @@ When called repeatedly, scroll the window that is displaying the buffer." (select-window org-agenda-show-window) (ignore-errors (scroll-up))) (org-agenda-goto t) - (show-subtree) + (if arg (org-show-entry) (show-subtree)) (setq org-agenda-show-window (selected-window))) (select-window win))) @@ -7306,31 +7871,34 @@ docstring of `org-agenda-show-1'." (defun org-agenda-error () (error "Command not allowed in this line")) -(defun org-agenda-tree-to-indirect-buffer () +(defun org-agenda-tree-to-indirect-buffer (arg) "Show the subtree corresponding to the current entry in an indirect buffer. -This calls the command `org-tree-to-indirect-buffer' from the original -Org-mode buffer. -With numerical prefix arg ARG, go up to this level and then take that tree. +This calls the command `org-tree-to-indirect-buffer' from the original buffer. + +With a numerical prefix ARG, go up to this level and then take that tree. +With a negative numeric ARG, go up by this number of levels. With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't use the dedicated frame)." - (interactive) - (if (and current-prefix-arg (listp current-prefix-arg)) - (org-agenda-do-tree-to-indirect-buffer) - (let ((agenda-window (selected-window)) + (interactive "P") + (if current-prefix-arg + (org-agenda-do-tree-to-indirect-buffer arg) + (let ((agenda-buffer (buffer-name)) + (agenda-window (selected-window)) (indirect-window (and org-last-indirect-buffer (get-buffer-window org-last-indirect-buffer)))) - (save-window-excursion (org-agenda-do-tree-to-indirect-buffer)) - (unwind-protect - (progn - (unless (and indirect-window (window-live-p indirect-window)) - (setq indirect-window (split-window agenda-window))) - (select-window indirect-window) - (switch-to-buffer org-last-indirect-buffer :norecord) - (fit-window-to-buffer indirect-window)) - (select-window (get-buffer-window org-agenda-buffer-name)))))) - -(defun org-agenda-do-tree-to-indirect-buffer () + (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg)) + (unless (or (eq org-indirect-buffer-display 'new-frame) + (eq org-indirect-buffer-display 'dedicated-frame)) + (unwind-protect + (unless (and indirect-window (window-live-p indirect-window)) + (setq indirect-window (split-window agenda-window))) + (and indirect-window (select-window indirect-window)) + (switch-to-buffer org-last-indirect-buffer :norecord) + (fit-window-to-buffer indirect-window))) + (select-window (get-buffer-window agenda-buffer))))) + +(defun org-agenda-do-tree-to-indirect-buffer (arg) "Same as `org-agenda-tree-to-indirect-buffer' without saving window." (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) @@ -7340,7 +7908,7 @@ use the dedicated frame)." (with-current-buffer buffer (save-excursion (goto-char pos) - (call-interactively 'org-tree-to-indirect-buffer))))) + (funcall 'org-tree-to-indirect-buffer arg))))) (defvar org-last-heading-marker (make-marker) "Marker pointing to the headline that last changed its TODO state @@ -7429,6 +7997,7 @@ If JUST-THIS is non-nil, change just the current line, not all. If FORCE-TAGS is non nil, the car of it returns the new tags." (let* ((inhibit-read-only t) (line (org-current-line)) + (org-agenda-buffer (current-buffer)) (thetags (with-current-buffer (marker-buffer hdmarker) (save-excursion (save-restriction (widen) (goto-char hdmarker) @@ -7448,14 +8017,14 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." tags thetags new (let ((org-prefix-format-compiled - (or (get-text-property (point) 'format) - org-prefix-format-compiled))) + (or (get-text-property (min (1- (point-max)) (point)) 'format) + org-prefix-format-compiled)) + (extra (org-get-at-bol 'extra))) (with-current-buffer (marker-buffer hdmarker) (save-excursion (save-restriction (widen) - (org-agenda-format-item (org-get-at-bol 'extra) - newhead cat tags dotime))))) + (org-agenda-format-item extra newhead cat tags dotime))))) pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) undone-face (org-get-at-bol 'undone-face) done-face (org-get-at-bol 'done-face)) @@ -7475,9 +8044,11 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." undone-face done-face)))) (org-agenda-highlight-todo 'line) (beginning-of-line 1)) - (t (error "Line update did not work")))) - (beginning-of-line 0))) - (org-finalize-agenda))) + (t (error "Line update did not work"))) + (save-restriction + (narrow-to-region (point-at-bol) (point-at-eol)) + (org-agenda-finalize))) + (beginning-of-line 0))))) (defun org-agenda-align-tags (&optional line) "Align all tags in agenda items to `org-agenda-tags-column'." @@ -7517,11 +8088,12 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (interactive) (org-agenda-priority 'down)) -(defun org-agenda-priority (&optional force-direction) +(defun org-agenda-priority (&optional force-direction show) "Set the priority of line at point, also in Org-mode file. This changes the line at point, all other lines in the agenda referring to the same tree node, and the headline of the tree node in the Org-mode file." - (interactive) + (interactive "P") + (if (equal force-direction '(4)) (setq show t)) (unless org-enable-priority-commands (error "Priority commands are disabled")) (org-agenda-check-no-diary) @@ -7540,7 +8112,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (save-excursion (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading - (funcall 'org-priority force-direction) + (funcall 'org-priority force-direction show) (end-of-line 1) (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead hdmarker) @@ -7832,73 +8404,7 @@ ARG is passed through to `org-deadline'." (goto-char pos) (setq ts (org-deadline arg time))) (org-agenda-show-new-time marker ts "D")) - (message "Deadline for this item set to %s" ts))) - -(defun org-agenda-action () - "Select entry for agenda action, or execute an agenda action. -This command prompts for another letter. Valid inputs are: - -m Mark the entry at point for an agenda action -s Schedule the marked entry to the date at the cursor -d Set the deadline of the marked entry to the date at the cursor -r Call `org-remember' with cursor date as the default date -c Call `org-capture' with cursor date as the default date -SPC Show marked entry in other window -TAB Visit marked entry in other window - -The cursor may be at a date in the calendar, or in the Org agenda." - (interactive) - (let (ans) - (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [c]apture [ ]show") - (setq ans (read-char-exclusive)) - (cond - ((equal ans ?m) - ;; Mark this entry - (if (eq major-mode 'org-agenda-mode) - (let ((m (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker)))) - (if m - (progn - (move-marker org-agenda-action-marker - (marker-position m) (marker-buffer m)) - (message "Entry marked for action; press `k' at desired date in agenda or calendar")) - (error "Don't know which entry to mark"))) - (error "This command works only in the agenda"))) - ((equal ans ?s) - (org-agenda-do-action '(org-schedule nil org-overriding-default-time))) - ((equal ans ?d) - (org-agenda-do-action '(org-deadline nil org-overriding-default-time))) - ((equal ans ?r) - (org-agenda-do-action '(org-remember) t)) - ((equal ans ?c) - (org-agenda-do-action '(org-capture) t)) - ((equal ans ?\ ) - (let ((cw (selected-window))) - (org-switch-to-buffer-other-window - (marker-buffer org-agenda-action-marker)) - (goto-char org-agenda-action-marker) - (org-show-context 'agenda) - (select-window cw))) - ((equal ans ?\C-i) - (org-switch-to-buffer-other-window - (marker-buffer org-agenda-action-marker)) - (goto-char org-agenda-action-marker) - (org-show-context 'agenda)) - (t (error "Invalid agenda action %c" ans))))) - -(defun org-agenda-do-action (form &optional current-buffer) - "Evaluate FORM at the entry pointed to by `org-agenda-action-marker'." - (let ((org-overriding-default-time (org-get-cursor-date))) - (if current-buffer - (eval form) - (if (not (marker-buffer org-agenda-action-marker)) - (error "No entry has been selected for agenda action") - (with-current-buffer (marker-buffer org-agenda-action-marker) - (save-excursion - (save-restriction - (widen) - (goto-char org-agenda-action-marker) - (eval form)))))))) + (message "Deadline for this item set to %s" ts))) (defun org-agenda-clock-in (&optional arg) "Start the clock on the currently selected item." @@ -8026,6 +8532,12 @@ top-level as top-level entries at the end of the file." :version "24.1" :type 'boolean) +(defcustom org-agenda-bulk-mark-char ">" + "A single-character string to be used as the bulk mark." + :group 'org-agenda + :version "24.1" + :type 'string) + (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) "Add a diary entry with TYPE to `org-agenda-diary-file'. If TEXT is not empty, it will become the headline of the new entry, and @@ -8039,12 +8551,12 @@ the resulting entry will not be shown. When TEXT is empty, switch to (cond ((eq type 'anniversary) (or (re-search-forward "^*[ \t]+Anniversaries" nil t) - (progn - (or (org-at-heading-p t) - (progn - (outline-next-heading) - (insert "* Anniversaries\n\n") - (beginning-of-line -1))))) + (progn + (or (org-at-heading-p t) + (progn + (outline-next-heading) + (insert "* Anniversaries\n\n") + (beginning-of-line -1))))) (outline-next-heading) (org-back-over-empty-lines) (backward-char 1) @@ -8183,12 +8695,11 @@ entries in that Org-mode file." (fset 'calendar-cursor-to-date oldf)))))) (defun org-agenda-execute-calendar-command (cmd) - "Execute a calendar command from the agenda, with the date associated to -the cursor position." + "Execute a calendar command from the agenda with date from cursor." (org-agenda-check-type t 'agenda 'timeline) (require 'diary-lib) - (unless (get-text-property (point) 'day) - (error "Don't know which date to use for calendar command")) + (unless (get-text-property (min (1- (point-max)) (point)) 'day) + (error "Don't know which date to use for the calendar command")) (let* ((oldf (symbol-function 'calendar-cursor-to-date)) (point (point)) (date (calendar-gregorian-from-absolute @@ -8196,14 +8707,14 @@ the cursor position." ;; the following 2 vars are needed in the calendar (displayed-month (car date)) (displayed-year (nth 2 date))) - (unwind-protect - (progn - (fset 'calendar-cursor-to-date - (lambda (&optional error dummy) - (calendar-gregorian-from-absolute - (get-text-property point 'day)))) - (call-interactively cmd)) - (fset 'calendar-cursor-to-date oldf)))) + (unwind-protect + (progn + (fset 'calendar-cursor-to-date + (lambda (&optional error dummy) + (calendar-gregorian-from-absolute + (get-text-property point 'day)))) + (call-interactively cmd)) + (fset 'calendar-cursor-to-date oldf)))) (defun org-agenda-phases-of-moon () "Display the phases of the moon for the 3 months around the cursor date." @@ -8215,9 +8726,9 @@ the cursor position." (interactive) (org-agenda-execute-calendar-command 'list-calendar-holidays)) -(defvar calendar-longitude) -(defvar calendar-latitude) -(defvar calendar-location-name) +(defvar calendar-longitude) ; defined in calendar.el +(defvar calendar-latitude) ; defined in calendar.el +(defvar calendar-location-name) ; defined in calendar.el (defun org-agenda-sunrise-sunset (arg) "Display sunrise and sunset for the cursor date. @@ -8236,7 +8747,7 @@ argument, latitude and longitude will be prompted for." "Open the Emacs calendar with the date at the cursor." (interactive) (org-agenda-check-type t 'agenda 'timeline) - (let* ((day (or (get-text-property (point) 'day) + (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) (error "Don't know which date to open in calendar"))) (date (calendar-gregorian-from-absolute day)) (calendar-move-hook nil) @@ -8257,7 +8768,7 @@ This is a command that has to be installed in `calendar-mode-map'." (defun org-agenda-convert-date () (interactive) (org-agenda-check-type t 'agenda 'timeline) - (let ((day (get-text-property (point) 'day)) + (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) date s) (unless day (error "Don't know which date to convert")) @@ -8284,9 +8795,6 @@ This is a command that has to be installed in `calendar-mode-map'." ;;; Bulk commands -(defvar org-agenda-bulk-marked-entries nil - "List of markers that refer to marked entries in the agenda.") - (defun org-agenda-bulk-marked-p () (eq (get-char-property (point-at-bol) 'type) 'org-marked-entry-overlay)) @@ -8302,7 +8810,7 @@ This is a command that has to be installed in `calendar-mode-map'." (unless m (error "Nothing to mark at point")) (push m org-agenda-bulk-marked-entries) (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) - (org-overlay-display ov "> " + (org-overlay-display ov (concat org-agenda-bulk-mark-char " ") (org-get-todo-face "TODO") 'evaporate) (overlay-put ov 'type 'org-marked-entry-overlay)) @@ -8312,8 +8820,13 @@ This is a command that has to be installed in `calendar-mode-map'." (message "%d entries marked for bulk action" (length org-agenda-bulk-marked-entries)))))) +(defun org-agenda-bulk-mark-all () + "Mark all entries for future agenda bulk action." + (interactive) + (org-agenda-bulk-mark-regexp ".")) + (defun org-agenda-bulk-mark-regexp (regexp) - "Mark entries match REGEXP." + "Mark entries matching REGEXP for future agenda bulk action." (interactive "sMark entries matching regexp: ") (let ((entries-marked 0)) (save-excursion @@ -8326,27 +8839,30 @@ This is a command that has to be installed in `calendar-mode-map'." (if (not entries-marked) (message "No entry matching this regexp.")))) -(defun org-agenda-bulk-unmark () +(defun org-agenda-bulk-unmark (&optional arg) "Unmark the entry at point for future bulk action." - (interactive) - (when (org-agenda-bulk-marked-p) - (org-agenda-bulk-remove-overlays - (point-at-bol) (+ 2 (point-at-bol))) - (setq org-agenda-bulk-marked-entries - (delete (org-get-at-bol 'org-hd-marker) - org-agenda-bulk-marked-entries))) - (beginning-of-line 2) - (while (and (get-char-property (point) 'invisible) (not (eobp))) - (beginning-of-line 2)) - (message "%d entries marked for bulk action" - (length org-agenda-bulk-marked-entries))) + (interactive "P") + (if arg + (org-agenda-bulk-unmark-all) + (cond ((org-agenda-bulk-marked-p) + (org-agenda-bulk-remove-overlays + (point-at-bol) (+ 2 (point-at-bol))) + (setq org-agenda-bulk-marked-entries + (delete (org-get-at-bol 'org-hd-marker) + org-agenda-bulk-marked-entries)) + (beginning-of-line 2) + (while (and (get-char-property (point) 'invisible) (not (eobp))) + (beginning-of-line 2)) + (message "%d entries left marked for bulk action" + (length org-agenda-bulk-marked-entries))) + (t (message "No entry to unmark here"))))) (defun org-agenda-bulk-toggle () - "Toggle marking the entry at point for bulk action." - (interactive) - (if (org-agenda-bulk-marked-p) - (org-agenda-bulk-unmark) - (org-agenda-bulk-mark))) + "Toggle marking the entry at point for bulk action." + (interactive) + (if (org-agenda-bulk-marked-p) + (org-agenda-bulk-unmark) + (org-agenda-bulk-mark))) (defun org-agenda-bulk-remove-overlays (&optional beg end) "Remove the mark overlays between BEG and END in the agenda buffer. @@ -8360,13 +8876,23 @@ from the list in `org-agenda-bulk-marked-entries'." (delete-overlay ov))) (overlays-in (or beg (point-min)) (or end (point-max))))) -(defun org-agenda-bulk-remove-all-marks () +(defun org-agenda-bulk-unmark-all () "Remove all marks in the agenda buffer. -This will remove the markers, and the overlays." +This will remove the markers and the overlays." (interactive) - (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries) - (setq org-agenda-bulk-marked-entries nil) - (org-agenda-bulk-remove-overlays (point-min) (point-max))) + (if (null org-agenda-bulk-marked-entries) + (message "No entry to unmark") + (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries) + (setq org-agenda-bulk-marked-entries nil) + (org-agenda-bulk-remove-overlays (point-min) (point-max)))) + +(defcustom org-agenda-persistent-marks nil + "Non-nil means marked items will stay marked after a bulk action. +You can toggle this interactively by typing `p' when prompted for a +bulk action." + :group 'org-agenda + :version "24.1" + :type 'boolean) (defun org-agenda-bulk-action (&optional arg) "Execute an remote-editing action on all marked entries. @@ -8384,148 +8910,161 @@ The prefix arg is passed through to the command if possible." org-agenda-bulk-marked-entries) ;; Prompt for the bulk command - (message (concat "Bulk: [r]efile [$]arch [A]rch->sib [t]odo" - " [+/-]tag [s]chd [S]catter [d]eadline [f]unction" - (when org-agenda-bulk-custom-functions - (concat " Custom: [" - (mapconcat (lambda(f) (char-to-string (car f))) - org-agenda-bulk-custom-functions "") - "]")))) - (let* ((action (read-char-exclusive)) - (org-log-refile (if org-log-refile 'time nil)) - (entries (reverse org-agenda-bulk-marked-entries)) - redo-at-end - cmd rfloc state e tag pos (cnt 0) (cntskip 0)) - (cond - ((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 org-agenda-bulk-marked-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 (org-icompleting-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 (org-icompleting-read - (format "Tag to %s: " (if (eq action ?+) "add" "remove")) - (with-current-buffer (marker-buffer (car entries)) - (delq nil - (mapcar (lambda (x) - (if (stringp (car x)) x)) org-tag-alist))))) - (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) - - ((memq action '(?s ?d)) - (let* ((date (unless arg - (org-read-date - nil nil nil - (if (eq action ?s) "(Re)Schedule to" "Set Deadline to")))) - (ans (if arg nil org-read-date-final-answer)) - (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) - (setq cmd `(let* ((bound (fboundp 'read-string)) - (old (and bound (symbol-function 'read-string)))) - (unwind-protect - (progn - (fset 'read-string (lambda (&rest ignore) ,ans)) - (eval '(,c1 arg))) - (if bound - (fset 'read-string old) - (fmakunbound 'read-string))))))) - - ((equal action ?S) - (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) - (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) - (incf distance) - (incf day-of-week) - (if (= day-of-week 7) - (setq day-of-week 0))) - (incf day-of-week) - (if (= 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 - (org-icompleting-read "Function: " - obarray 'fboundp t nil nil))))) - - (t (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)) - (setq org-agenda-bulk-marked-entries - (delete e org-agenda-bulk-marked-entries)) - (setq cnt (1+ cnt)))) - (setq org-agenda-bulk-marked-entries nil) - (org-agenda-bulk-remove-all-marks) - (when redo-at-end (org-agenda-redo)) - (message "Acted on %d entries%s" - cnt - (if (= cntskip 0) - "" - (format ", skipped %d (disappeared before their turn)" - cntskip))))) + (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 (org-icompleting-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 (org-icompleting-read + (format "Tag to %s: " (if (eq action ?+) "add" "remove")) + (with-current-buffer (marker-buffer (car entries)) + (delq nil + (mapcar (lambda (x) + (if (stringp (car x)) x)) org-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))) + (setq cmd `(eval '(,c1 arg ,time))))) + + ((equal action ?S) + (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) + (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) + (incf distance) + (incf day-of-week) + (if (= day-of-week 7) + (setq day-of-week 0))) + (incf day-of-week) + (if (= 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 + (org-icompleting-read "Function: " + obarray 'fboundp t nil nil))))) + + (t (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)) + (setq cnt (1+ cnt)))) + (when redo-at-end (org-agenda-redo)) + (unless org-agenda-persistent-marks + (org-agenda-bulk-unmark-all)) + (message "Acted on %d entries%s%s" + cnt + (if (= cntskip 0) + "" + (format ", skipped %d (disappeared before their turn)" + cntskip)) + (if (not org-agenda-persistent-marks) + "" " (kept marked)")))))) + +(defun org-agenda-capture () + "Call `org-capture' with the date at point." + (interactive) + (if (not (eq major-mode 'org-agenda-mode)) + (error "You cannot do this outside of agenda buffers") + (let ((org-overriding-default-time + (org-get-cursor-date))) + (call-interactively 'org-capture)))) ;;; Flagging notes @@ -8576,7 +9115,7 @@ tag and (if present) the flagging note." ;;; Appointment reminders -(defvar appt-time-msg-list) +(defvar appt-time-msg-list) ; defined in appt.el ;;;###autoload (defun org-agenda-to-appt (&optional refresh filter &rest args) @@ -8606,7 +9145,10 @@ belonging to the \"Work\" category. ARGS are symbols indicating what kind of entries to consider. By default `org-agenda-to-appt' will use :deadline, :scheduled and :timestamp entries. See the docstring of `org-diary' for -details and examples." +details and examples. + +If an entry as a APPT_WARNTIME property, its value will be used +to override `appt-message-warning-time'." (interactive "P") (if refresh (setq appt-time-msg-list nil)) (if (eq filter t) @@ -8621,9 +9163,10 @@ details and examples." (today (org-date-to-gregorian (time-to-days (current-time)))) (org-agenda-restrict nil) - (files (org-agenda-files 'unrestricted)) entries file) + (files (org-agenda-files 'unrestricted)) entries file + (org-agenda-buffer nil)) ;; Get all entries which may contain an appt - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (while (setq file (pop files)) (setq entries (delq nil @@ -8645,7 +9188,8 @@ details and examples." (or (and (stringp cat-filter) (string-match cat-filter cat)) (and (stringp evt-filter) - (string-match evt-filter evt)))))))) + (string-match evt-filter evt))))))) + (wrn (get-text-property 1 'warntime x))) ;; FIXME: Shall we remove text-properties for the appt text? ;; (setq evt (set-text-properties 0 (length evt) nil evt)) (when (and ok tod) @@ -8654,7 +9198,9 @@ details and examples." "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) (concat (match-string 1 tod) ":" (match-string 2 tod)))) - (appt-add tod evt) + (if (version< emacs-version "23.3") + (appt-add tod evt) + (appt-add tod evt wrn)) (setq cnt (1+ cnt))))) entries) (org-release-buffers org-agenda-new-buffers) (if (eq cnt 0) @@ -8669,7 +9215,7 @@ details and examples." (eq date today))) (defun org-agenda-todo-yesterday (&optional arg) - "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday" + "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday." (interactive "P") (let* ((hour (third (decode-time (org-current-time)))) diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index db3b8250bc..29b883824e 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -31,6 +31,7 @@ (require 'org) (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) (defcustom org-archive-default-command 'org-archive-subtree "The default archiving command." @@ -100,14 +101,14 @@ the archived entry, with a prefix \"ARCHIVE_\", to remember this information." :group 'org-archive :type '(set :greedy t - (const :tag "Time" time) - (const :tag "File" file) - (const :tag "Category" category) - (const :tag "TODO state" todo) - (const :tag "Priority" priority) - (const :tag "Inherited tags" itags) - (const :tag "Outline path" olpath) - (const :tag "Local tags" ltags))) + (const :tag "Time" time) + (const :tag "File" file) + (const :tag "Category" category) + (const :tag "TODO state" todo) + (const :tag "Priority" priority) + (const :tag "Inherited tags" itags) + (const :tag "Outline path" olpath) + (const :tag "Local tags" ltags))) (defun org-get-local-archive-location () "Get the archive location applicable at point." @@ -223,13 +224,14 @@ this heading." (current-time))) category todo priority ltags itags atags ;; end of variables that will be used for saving context - location afile heading buffer level newfile-p infile-p visiting) + location afile heading buffer level newfile-p infile-p visiting + datetree-date datetree-subheading-p) ;; Find the local archive location (setq location (org-get-local-archive-location) afile (org-extract-archive-file location) heading (org-extract-archive-heading location) - infile-p (equal file (abbreviate-file-name afile))) + infile-p (equal file (abbreviate-file-name (or afile "")))) (unless afile (error "Invalid `org-archive-location'")) @@ -240,6 +242,13 @@ this heading." (setq buffer (current-buffer))) (unless buffer (error "Cannot access file \"%s\"" afile)) + (when (string-match "\\`datetree/" heading) + ;; Replace with ***, to represent the 3 levels of headings the + ;; datetree has. + (setq heading (replace-regexp-in-string "\\`datetree/" "***" heading)) + (setq datetree-subheading-p (> (length heading) 3)) + (setq datetree-date (org-date-to-gregorian + (or (org-entry-get nil "CLOSED" t) time)))) (if (and (> (length heading) 0) (string-match "^\\*+" heading)) (setq level (match-end 0)) @@ -263,7 +272,7 @@ this heading." (let (this-command) (org-copy-subtree 1 nil t)) (set-buffer buffer) ;; Enforce org-mode for the archive buffer - (if (not (eq major-mode 'org-mode)) + (if (not (derived-mode-p 'org-mode)) ;; Force the mode for future visits. (let ((org-insert-mode-line-in-empty-file t) (org-inhibit-startup t)) @@ -272,6 +281,10 @@ this heading." (goto-char (point-max)) (insert (format "\nArchived entries from file %s\n\n" (buffer-file-name this-buffer)))) + (when datetree-date + (require 'org-datetree) + (org-datetree-find-date-create datetree-date) + (org-narrow-to-subtree)) ;; Force the TODO keywords of the original buffer (let ((org-todo-line-regexp tr-org-todo-line-regexp) (org-todo-keywords-1 tr-org-todo-keywords-1) @@ -285,7 +298,7 @@ this heading." tr-org-odd-levels-only))) (goto-char (point-min)) (show-all) - (if heading + (if (and heading (not (and datetree-date (not datetree-subheading-p)))) (progn (if (re-search-forward (concat "^" (regexp-quote heading) @@ -295,7 +308,8 @@ this heading." ;; Heading not found, just insert it at the end (goto-char (point-max)) (or (bolp) (insert "\n")) - (insert "\n" heading "\n") + ;; datetrees don't need too much spacing + (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) ;; Make the subtree visible (show-subtree) @@ -306,9 +320,10 @@ this heading." (org-end-of-subtree t)) (skip-chars-backward " \t\r\n") (and (looking-at "[ \t\r\n]*") - (replace-match "\n\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)) (insert "\n")) + (goto-char (point-max)) (unless datetree-date (insert "\n"))) ;; Paste (org-paste-subtree (org-get-valid-level level (and heading 1))) ;; Shall we append inherited tags? @@ -336,6 +351,7 @@ this heading." (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) (org-entry-put (point) n v))))) + (widen) ;; Save and kill the buffer, if it is not the same buffer. (when (not (eq this-buffer buffer)) (save-buffer)))) diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el index 61cbe1560a..655b8db668 100644 --- a/lisp/org/org-ascii.el +++ b/lisp/org/org-ascii.el @@ -36,7 +36,7 @@ :tag "Org Export ASCII" :group 'org-export) -(defcustom org-export-ascii-underline '(?\- ?\= ?\~ ?^ ?\# ?\$) +(defcustom org-export-ascii-underline '(?\= ?\- ?\~ ?\^ ?\. ?\# ?\$) "Characters for underlining headings in ASCII export. In the given sequence, these characters will be used for level 1, 2, ..." :group 'org-export-ascii @@ -144,9 +144,9 @@ command to convert it." (interactive "r") (let (reg ascii buf pop-up-frames) (save-window-excursion - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq ascii (org-export-region-as-ascii - beg end t 'string)) + beg end t 'string)) (setq reg (buffer-substring beg end) buf (get-buffer-create "*Org tmp*")) (with-current-buffer buf @@ -154,7 +154,7 @@ command to convert it." (insert reg) (org-mode) (setq ascii (org-export-region-as-ascii - (point-min) (point-max) t 'string))) + (point-min) (point-max) t 'string))) (kill-buffer buf))) (delete-region beg end) (insert ascii))) @@ -193,7 +193,7 @@ in a window. A non-interactive call will only return the buffer." ;;;###autoload (defun org-export-as-ascii (arg &optional hidden ext-plist - to-buffer body-only pub-dir) + to-buffer body-only pub-dir) "Export the outline as a pretty ASCII file. If there is an active region, export only the region. The prefix ARG specifies how many levels of the outline should become @@ -373,54 +373,54 @@ publishing directory." (push (concat (make-string (string-width (nth 3 lang-words)) ?=) "\n") thetoc) (mapc #'(lambda (line) - (if (string-match org-todo-line-regexp - line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (match-string 3 line) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) + (if (string-match org-todo-line-regexp + line) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (match-string 3 line) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (setq txt (org-html-expand-for-ascii txt)) - - (while (string-match org-bracket-link-regexp txt) - (setq txt - (replace-match - (match-string (if (match-end 2) 3 1) txt) - t t txt))) - - (if (and (memq org-export-with-tags '(not-in-toc nil)) - (string-match - (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") - txt)) - (setq txt (replace-match "" t t txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt 1))) - - (if org-export-with-section-numbers - (setq txt (concat (org-section-number level) - " " txt))) - (if (<= level umax-toc) - (progn - (push - (concat - (make-string - (* (max 0 (- level org-min-level)) 4) ?\ ) - (format (if todo "%s (*)\n" "%s\n") txt)) - thetoc) - (setq org-last-level level)) - )))) + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (setq txt (org-html-expand-for-ascii txt)) + + (while (string-match org-bracket-link-regexp txt) + (setq txt + (replace-match + (match-string (if (match-end 2) 3 1) txt) + t t txt))) + + (if (and (memq org-export-with-tags '(not-in-toc nil)) + (string-match + (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") + txt)) + (setq txt (replace-match "" t t txt))) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt 1))) + + (if org-export-with-section-numbers + (setq txt (concat (org-section-number level) + " " txt))) + (if (<= level umax-toc) + (progn + (push + (concat + (make-string + (* (max 0 (- level org-min-level)) 4) ?\ ) + (format (if todo "%s (*)\n" "%s\n") txt)) + thetoc) + (setq org-last-level level)) + )))) lines) (setq thetoc (if have-headings (nreverse thetoc) nil)))) diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index a87993f4b2..e02d7e07a4 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -78,12 +78,15 @@ Allowed values are: mv rename the file to move it into the attachment directory cp copy the file ln create a hard link. Note that this is not supported + on all systems, and then the result is not defined. +lns create a symbol link. Note that this is not supported on all systems, and then the result is not defined." :group 'org-attach :type '(choice (const :tag "Copy" cp) (const :tag "Move/Rename" mv) - (const :tag "Link" ln))) + (const :tag "Hard Link" ln) + (const :tag "Symbol Link" lns))) (defcustom org-attach-expert nil "Non-nil means do not show the splash buffer with the attach dispatcher." @@ -130,7 +133,7 @@ Shows a list of commands and prompts for another key to execute a command." (princ "Select an Attachment Command: a Select a file and attach it to the task, using `org-attach-method'. -c/m/l Attach a file using copy/move/link method. +c/m/l/y Attach a file using copy/move/link/symbolic-link method. n Create a new attachment, as an Emacs buffer. z Synchronize the current task with its attachment directory, in case you added attachments yourself. @@ -158,6 +161,8 @@ i Make children of the current entry inherit its attachment directory."))) (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach))) ((memq c '(?l ?\C-l)) (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 '(?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)) @@ -254,9 +259,9 @@ This checks for the existence of a \".git\" directory in that directory." (shell-command "git add .") (shell-command "git ls-files --deleted" t) (mapc #'(lambda (file) - (unless (string= file "") - (shell-command - (concat "git rm \"" file "\"")))) + (unless (string= file "") + (shell-command + (concat "git rm \"" file "\"")))) (split-string (buffer-string) "\n")) (shell-command "git commit -m 'Synchronized attachments'"))))) @@ -282,7 +287,8 @@ Only do this when `org-attach-store-link-p' is non-nil." (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', or `ln', default taken from `org-attach-method'." +METHOD may be `cp', `mv', `ln', or `lns' default taken from +`org-attach-method'." (interactive "fFile to keep as an attachment: \nP") (setq method (or method org-attach-method)) (let ((basename (file-name-nondirectory file))) @@ -294,7 +300,8 @@ METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'." (cond ((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 'ln) (add-name-to-file file fname)) + ((eq method 'lns) (make-symbolic-link file fname))) (org-attach-commit) (org-attach-tag) (cond ((eq org-attach-store-link-p 'attached) @@ -319,6 +326,13 @@ Beware that this does not work on systems that do not support hard links. On some systems, this apparently does copy the file instead." (interactive) (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) +(defun org-attach-attach-lns () + "Attach a file by creating a symbolic link to it. + +Beware that this does not work on systems that do not support symbolic links. +On some systems, this apparently does copy the file instead." + (interactive) + (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) (defun org-attach-new (file) "Create a new attachment FILE for the current task. @@ -415,7 +429,7 @@ If IN-EMACS is non-nil, force opening in Emacs." (file (if (= (length files) 1) (car files) (org-icompleting-read "Open attachment: " - (mapcar 'list files) nil t)))) + (mapcar 'list files) nil t)))) (org-open-file (expand-file-name file attach-dir) in-emacs))) (defun org-attach-open-in-emacs () diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index 04af6969de..be395ad392 100644 --- a/lisp/org/org-bbdb.el +++ b/lisp/org/org-bbdb.el @@ -109,17 +109,20 @@ (declare-function bbdb-record-getprop "ext:bbdb" (record property)) (declare-function bbdb-record-name "ext:bbdb" (record)) (declare-function bbdb-records "ext:bbdb" - (&optional dont-check-disk already-in-db-buffer)) + (&optional dont-check-disk already-in-db-buffer)) (declare-function bbdb-split "ext:bbdb" (string separators)) (declare-function bbdb-string-trim "ext:bbdb" (string)) (declare-function bbdb-record-get-field "ext:bbdb" (record field)) (declare-function bbdb-search-name "ext:bbdb-com" (regexp &optional layout)) (declare-function bbdb-search-organization "ext:bbdb-com" (regexp &optional layout)) +;; `bbdb-record-note' is part of BBDB v3.x +(declare-function bbdb-record-note "ext:bbdb" (record label)) + (declare-function calendar-leap-year-p "calendar" (year)) (declare-function diary-ordinal-suffix "diary-lib" (n)) -(defvar date) ;; dynamically scoped from Org +(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el ;; Customization @@ -134,30 +137,31 @@ :require 'bbdb) (defcustom org-bbdb-anniversary-format-alist - '(("birthday" lambda - (name years suffix) - (concat "Birthday: [[bbdb:" name "][" name " (" - (format "%s" years) ; handles numbers as well as strings - suffix ")]]")) - ("wedding" lambda - (name years suffix) - (concat "[[bbdb:" name "][" name "'s " - (format "%s" years) - suffix " wedding anniversary]]"))) + '(("birthday" . + (lambda (name years suffix) + (concat "Birthday: [[bbdb:" name "][" name " (" + (format "%s" years) ; handles numbers as well as strings + suffix ")]]"))) + ("wedding" . + (lambda (name years suffix) + (concat "[[bbdb:" name "][" name "'s " + (format "%s" years) + suffix " wedding anniversary]]")))) "How different types of anniversaries should be formatted. An alist of elements (STRING . FORMAT) where STRING is the name of an anniversary class and format is either: 1) A format string with the following substitutions (in order): - * the name of the record containing this anniversary - * the number of years - * an ordinal suffix (st, nd, rd, th) for the year + - the name of the record containing this anniversary + - the number of years + - an ordinal suffix (st, nd, rd, th) for the year 2) A function to be called with three arguments: NAME YEARS SUFFIX (string int string) returning a string for the diary or nil. 3) An Emacs Lisp form that should evaluate to a string (or nil) in the scope of variables NAME, YEARS and SUFFIX (among others)." - :type 'sexp + :type '(alist :key-type (string :tag "Class") + :value-type (function :tag "Function")) :group 'org-bbdb-anniversaries :require 'bbdb) @@ -203,7 +207,7 @@ date year)." (company (if (fboundp 'bbdb-record-getprop) (bbdb-record-getprop rec 'company) (car (bbdb-record-get-field rec 'organization)))) - (link (org-make-link "bbdb:" name))) + (link (concat "bbdb:" name))) (org-store-link-props :type "bbdb" :name name :company company :link link :description name) link))) @@ -217,6 +221,8 @@ italicized, in all other cases it is left unchanged." (cond ((eq format 'html) (format "<i>%s</i>" desc)) ((eq format 'latex) (format "\\textit{%s}" desc)) + ((eq format 'odt) + (format "<text:span text:style-name=\"Emphasis\">%s</text:span>" desc)) (t desc))) (defun org-bbdb-open (name) @@ -272,7 +278,7 @@ italicized, in all other cases it is left unchanged." "Convert YYYY-MM-DD to (month date year). Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted it will be considered unknown." - (multiple-value-bind (a b c) (values-list (bbdb-split time-str "-")) + (multiple-value-bind (a b c) (values-list (org-split-string time-str "-")) (if (eq c nil) (list (string-to-number a) (string-to-number b) @@ -299,13 +305,19 @@ The hash table is created on first use.") (defun org-bbdb-make-anniv-hash () "Create a hash with anniversaries extracted from BBDB, for fast access. The anniversaries are assumed to be stored `org-bbdb-anniversary-field'." - - (let (split tmp annivs) + (let ((old-bbdb (fboundp 'bbdb-record-getprop)) + split tmp annivs) (clrhash org-bbdb-anniv-hash) (dolist (rec (bbdb-records)) - (when (setq annivs (bbdb-record-getprop - rec org-bbdb-anniversary-field)) - (setq annivs (bbdb-split annivs "\n")) + (when (setq annivs (if old-bbdb + (bbdb-record-getprop + rec org-bbdb-anniversary-field) + (bbdb-record-note + rec org-bbdb-anniversary-field))) + (setq annivs (if old-bbdb + (bbdb-split annivs "\n") + ;; parameter order is reversed in new bbdb + (bbdb-split "\n" annivs))) (while annivs (setq split (org-bbdb-anniv-split (pop annivs))) (multiple-value-bind (m d y) diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el index 041a915409..b5f3013e00 100644 --- a/lisp/org/org-beamer.el +++ b/lisp/org/org-beamer.el @@ -87,7 +87,7 @@ BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}." (defconst org-beamer-column-widths "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC" -"The column widths that should be installed as allowed property values.") + "The column widths that should be installed as allowed property values.") (defconst org-beamer-transitions "\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC" @@ -107,6 +107,7 @@ These are just a completion help.") ("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}") ("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}") ("example" "e" "\\begin{example}%a%U%x" "\\end{example}") + ("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}") ("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}") ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}") ("normal" "h" "%h" "") ; Emit the heading as normal text @@ -117,7 +118,7 @@ These are just a completion help.") These are the defaults - for user definitions, see `org-beamer-environments-extra'. \"normal\" is a special fake environment, which emit the heading as -normal text. It is needed when an environment should be surrounded +normal text. It is needed when an environment should be surrounded by normal text. Since beamer export converts nodes into environments, you need to have a node to end the environment. For example @@ -155,6 +156,12 @@ close The closing string of the environment." (string :tag "Begin") (string :tag "End")))) +(defcustom org-beamer-inherited-properties nil + "Properties that should be inherited during beamer export." + :group 'org-beamer + :type '(repeat + (string :tag "Property"))) + (defvar org-beamer-frame-level-now nil) (defvar org-beamer-header-extra nil) (defvar org-beamer-export-is-beamer-p nil) @@ -488,6 +495,12 @@ The effect is that these values will be accessible during export." (if (and (not (assoc "BEAMER_env" props)) (looking-at ".*?:B_\\(note\\(NH\\)?\\):")) (push (cons "BEAMER_env" (match-string 1)) props)) + (when (org-bound-and-true-p org-beamer-inherited-properties) + (mapc (lambda (p) + (unless (assoc p props) + (let ((v (org-entry-get nil p 'inherit))) + (and v (push (cons p v) props))))) + org-beamer-inherited-properties)) (put-text-property (point-at-bol) (point-at-eol) 'org-props props))) (setq org-export-latex-options-plist (plist-put org-export-latex-options-plist :tags nil)))))) @@ -502,7 +515,7 @@ This function will run in the final LaTeX document." (while (re-search-forward org-beamer-fragile-re nil t) (save-excursion ;; Are we inside a frame here? - (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}" + (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}\\(<[^>]*>\\)?" nil t) (equal (match-string 1) "begin")) ;; yes, inside a frame, make sure "fragile" is one of the options @@ -520,7 +533,7 @@ This function will run in the final LaTeX document." :group 'org-beamer :version "24.1" :type '(string :tag "Outline frame title") -) + ) (defcustom org-beamer-outline-frame-options nil "Outline frame options appended after \\begin{frame}. @@ -529,7 +542,7 @@ include square brackets." :group 'org-beamer :version "24.1" :type '(string :tag "Outline frame options") -) + ) (defun org-beamer-fix-toc () "Fix the table of contents by removing the vspace line." diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index 4c852fcb87..f8e07adcd8 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -111,6 +111,7 @@ (require 'bibtex) (eval-when-compile (require 'cl)) +(require 'org-compat) (defvar org-bibtex-description nil) ; dynamically scoped from org.el (defvar org-id-locations) @@ -184,33 +185,33 @@ "Bibtex entry types with required and optional parameters.") (defvar org-bibtex-fields - '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.") - (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.") + '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.") + (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.") (:author . "The name(s) of the author(s), in the format described in the LaTeX book. Remember, all names are separated with the and keyword, and not commas.") - (:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.") + (:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.") (:chapter . "A chapter (or section or whatever) number.") (:crossref . "The database key of the entry being cross referenced.") - (:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.") - (:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.") - (:howpublished . "How something strange has been published. The first word should be capitalized.") + (:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.") + (:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.") + (:howpublished . "How something strange has been published. The first word should be capitalized.") (:institution . "The sponsoring institution of a technical report.") (:journal . "A journal name.") - (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.") - (:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,") - (:note . "Any additional information that can help the reader. The first word should be capitalized.") - (:number . "Any additional information that can help the reader. The first word should be capitalized.") + (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.") + (:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,") + (:note . "Any additional information that can help the reader. The first word should be capitalized.") + (:number . "Any additional information that can help the reader. The first word should be capitalized.") (:organization . "The organization that sponsors a conference or that publishes a manual.") (:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).") (:publisher . "The publisher’s name.") (:school . "The name of the school where a thesis was written.") - (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.") + (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.") (:title . "The work’s title, typed as explained in the LaTeX book.") (:type . "The type of a technical report for example, 'Research Note'.") (:volume . "The volume of a journal or multi-volume book.") (:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'")) "Bibtex fields with descriptions.") -(defvar *org-bibtex-entries* nil +(defvar org-bibtex-entries nil "List to hold parsed bibtex entries.") (defcustom org-bibtex-autogen-keys nil @@ -229,7 +230,7 @@ For example setting to 'BIB_' would allow interoperability with fireforg." (defcustom org-bibtex-treat-headline-as-title t "Treat headline text as title if title property is absent. If an entry is missing a title property, use the headline text as -the property. If this value is t, `org-bibtex-check' will ignore +the property. If this value is t, `org-bibtex-check' will ignore a missing title field." :group 'org-bibtex :version "24.1" @@ -247,7 +248,7 @@ not placed in the exported bibtex entry." (defcustom org-bibtex-key-property "CUSTOM_ID" "Property that holds the bibtex key. By default, this is CUSTOM_ID, which enables easy linking to -bibtex headlines from within an org file. This can be set to ID +bibtex headlines from within an org file. This can be set to ID to enable global links, but only with great caution, as global IDs must be unique." :group 'org-bibtex @@ -263,12 +264,12 @@ IDs must be unique." (defcustom org-bibtex-tags-are-keywords nil "Convert the value of the keywords field to tags and vice versa. If set to t, comma-separated entries in a bibtex entry's keywords -field will be converted to org tags. Note: spaces will be escaped +field will be converted to org tags. Note: spaces will be escaped with underscores, and characters that are not permitted in org tags will be removed. If t, local tags in an org entry will be exported as a -comma-separated string of keywords when exported to bibtex. Tags +comma-separated string of keywords when exported to bibtex. Tags defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will not be exported." :group 'org-bibtex @@ -277,7 +278,7 @@ not be exported." (defcustom org-bibtex-no-export-tags nil "List of tag(s) that should not be converted to keywords. -This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t." +This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t." :group 'org-bibtex :version "24.1" :type '(repeat :tag "Tag" (string))) @@ -309,71 +310,72 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t." (defun org-bibtex-headline () "Return a bibtex entry of the given headline as a string." - (flet ((val (key lst) (cdr (assoc key lst))) - (to (string) (intern (concat ":" string))) - (from (key) (substring (symbol-name key) 1)) - (flatten (&rest lsts) - (apply #'append (mapcar - (lambda (e) - (if (listp e) (apply #'flatten e) (list e))) - lsts)))) - (let ((notes (buffer-string)) - (id (org-bibtex-get org-bibtex-key-property)) - (type (org-bibtex-get org-bibtex-type-property-name)) - (tags (when org-bibtex-tags-are-keywords - (delq nil - (mapcar - (lambda (tag) - (unless (member tag - (append org-bibtex-tags - org-bibtex-no-export-tags)) - tag)) - (org-get-local-tags-at)))))) - (when type - (let ((entry (format - "@%s{%s,\n%s\n}\n" type id - (mapconcat - (lambda (pair) - (format " %s={%s}" (car pair) (cdr pair))) - (remove nil - (if (and org-bibtex-export-arbitrary-fields - org-bibtex-prefix) - (mapcar - (lambda (kv) - (let ((key (car kv)) (val (cdr kv))) - (when (and - (string-match org-bibtex-prefix key) - (not (string= - (downcase (concat org-bibtex-prefix - org-bibtex-type-property-name)) - (downcase key)))) - (cons (downcase (replace-regexp-in-string - org-bibtex-prefix "" key)) - val)))) - (org-entry-properties nil 'standard)) - (mapcar - (lambda (field) - (let ((value (or (org-bibtex-get (from field)) - (and (equal :title field) - (nth 4 (org-heading-components)))))) - (when value (cons (from field) value)))) - (flatten - (val :required (val (to type) org-bibtex-types)) - (val :optional (val (to type) org-bibtex-types)))))) - ",\n")))) - (with-temp-buffer - (insert entry) - (when tags - (bibtex-beginning-of-entry) - (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t) - (progn (goto-char (match-end 1)) (insert ", ")) - (bibtex-make-field "keywords" t t)) - (insert (mapconcat #'identity tags ", "))) - (buffer-string))))))) + (let* ((val (lambda (key lst) (cdr (assoc key lst)))) + (to (lambda (string) (intern (concat ":" string)))) + (from (lambda (key) (substring (symbol-name key) 1))) + flatten ; silent compiler warning + (flatten (lambda (&rest lsts) + (apply #'append (mapcar + (lambda (e) + (if (listp e) (apply flatten e) (list e))) + lsts)))) + (notes (buffer-string)) + (id (org-bibtex-get org-bibtex-key-property)) + (type (org-bibtex-get org-bibtex-type-property-name)) + (tags (when org-bibtex-tags-are-keywords + (delq nil + (mapcar + (lambda (tag) + (unless (member tag + (append org-bibtex-tags + org-bibtex-no-export-tags)) + tag)) + (org-get-local-tags-at)))))) + (when type + (let ((entry (format + "@%s{%s,\n%s\n}\n" type id + (mapconcat + (lambda (pair) + (format " %s={%s}" (car pair) (cdr pair))) + (remove nil + (if (and org-bibtex-export-arbitrary-fields + org-bibtex-prefix) + (mapcar + (lambda (kv) + (let ((key (car kv)) (val0 (cdr kv))) + (when (and + (string-match org-bibtex-prefix key) + (not (string= + (downcase (concat org-bibtex-prefix + org-bibtex-type-property-name)) + (downcase key)))) + (cons (downcase (replace-regexp-in-string + org-bibtex-prefix "" key)) + val0)))) + (org-entry-properties nil 'standard)) + (mapcar + (lambda (field) + (let ((value (or (org-bibtex-get (funcall from field)) + (and (equal :title field) + (nth 4 (org-heading-components)))))) + (when value (cons (funcall from field) value)))) + (funcall flatten + (funcall val :required (funcall val (funcall to type) org-bibtex-types)) + (funcall val :optional (funcall val (funcall to type) org-bibtex-types)))))) + ",\n")))) + (with-temp-buffer + (insert entry) + (when tags + (bibtex-beginning-of-entry) + (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t) + (progn (goto-char (match-end 1)) (insert ", ")) + (bibtex-make-field "keywords" t t)) + (insert (mapconcat #'identity tags ", "))) + (buffer-string)))))) (defun org-bibtex-ask (field) (unless (assoc field org-bibtex-fields) - (error "field:%s is not known" field)) + (error "Field:%s is not known" field)) (save-window-excursion (let* ((name (substring (symbol-name field) 1)) (buf-name (format "*Bibtex Help %s*" name))) @@ -385,7 +387,7 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t." (read-from-minibuffer (format "%s: " name)))))) (defun org-bibtex-autokey () - "Generate an autokey for the current headline" + "Generate an autokey for the current headline." (org-bibtex-put org-bibtex-key-property (if org-bibtex-autogen-keys (let* ((entry (org-bibtex-headline)) @@ -404,24 +406,26 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t." (read-from-minibuffer "id: ")))) (defun org-bibtex-fleshout (type &optional optional) - "Fleshout the current heading, ensuring that all required fields are present. + "Fleshout current heading, ensuring all required fields are present. With optional argument OPTIONAL, also prompt for optional fields." - (flet ((val (key lst) (cdr (assoc key lst))) - (keyword (name) (intern (concat ":" (downcase name)))) - (name (keyword) (substring (symbol-name keyword) 1))) + (let ((val (lambda (key lst) (cdr (assoc key lst)))) + (keyword (lambda (name) (intern (concat ":" (downcase name))))) + (name (lambda (keyword) (substring (symbol-name keyword) 1)))) (dolist (field (append (if org-bibtex-treat-headline-as-title - (remove :title (val :required (val type org-bibtex-types))) - (val :required (val type org-bibtex-types))) - (when optional (val :optional (val type org-bibtex-types))))) + (remove :title (funcall val :required (funcall val type org-bibtex-types))) + (funcall val :required (funcall val type org-bibtex-types))) + (when optional (funcall val :optional (funcall val type org-bibtex-types))))) (when (consp field) ; or'd pair of fields e.g., (:editor :author) - (let ((present (first (remove nil - (mapcar - (lambda (f) (when (org-bibtex-get (name f)) f)) - field))))) - (setf field (or present (keyword (org-icompleting-read - "Field: " (mapcar #'name field))))))) - (let ((name (name field))) + (let ((present (first (remove + nil + (mapcar + (lambda (f) (when (org-bibtex-get (funcall name f)) f)) + field))))) + (setf field (or present (funcall keyword + (org-icompleting-read + "Field: " (mapcar name field))))))) + (let ((name (funcall name field))) (unless (org-bibtex-get name) (let ((prop (org-bibtex-ask field))) (when prop (org-bibtex-put name prop))))))) @@ -546,7 +550,7 @@ Headlines are exported using `org-bibtex-export-headline'." (error (throw 'bib (point))))))))) (with-temp-file filename (insert (mapconcat #'identity bibtex-entries "\n"))) - (message "Successfully exported %d bibtex entries to %s" + (message "Successfully exported %d BibTeX entries to %s" (length bibtex-entries) filename) nil)))) (defun org-bibtex-check (&optional optional) @@ -578,7 +582,7 @@ If nonew is t, add data to the headline of the entry at point." (type (if (keywordp type) type (intern (concat ":" type)))) (org-bibtex-treat-headline-as-title (if nonew nil t))) (unless (assoc type org-bibtex-types) - (error "type:%s is not known" type)) + (error "Type:%s is not known" type)) (if nonew (org-back-to-heading) (org-insert-heading) @@ -597,57 +601,60 @@ With a prefix arg, query for optional fields." (org-bibtex-create arg t)) (defun org-bibtex-read () - "Read a bibtex entry and save to `*org-bibtex-entries*'. + "Read a bibtex entry and save to `org-bibtex-entries'. This uses `bibtex-parse-entry'." (interactive) - (flet ((keyword (str) (intern (concat ":" (downcase str)))) - (clean-space (str) (replace-regexp-in-string - "[[:space:]\n\r]+" " " str)) - (strip-delim (str) ; strip enclosing "..." and {...} - (dolist (pair '((34 . 34) (123 . 125) (123 . 125))) - (when (and (= (aref str 0) (car pair)) - (= (aref str (1- (length str))) (cdr pair))) - (setf str (substring str 1 (1- (length str)))))) str)) + (let ((keyword (lambda (str) (intern (concat ":" (downcase str))))) + (clean-space (lambda (str) (replace-regexp-in-string + "[[:space:]\n\r]+" " " str))) + (strip-delim + (lambda (str) ; strip enclosing "..." and {...} + (dolist (pair '((34 . 34) (123 . 125) (123 . 125))) + (when (and (= (aref str 0) (car pair)) + (= (aref str (1- (length str))) (cdr pair))) + (setf str (substring str 1 (1- (length str)))))) str))) (push (mapcar (lambda (pair) - (cons (let ((field (keyword (car pair)))) + (cons (let ((field (funcall keyword (car pair)))) (case field (:=type= :type) (:=key= :key) (otherwise field))) - (clean-space (strip-delim (cdr pair))))) + (funcall clean-space (funcall strip-delim (cdr pair))))) (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry))) - *org-bibtex-entries*))) + org-bibtex-entries))) (defun org-bibtex-write () - "Insert a heading built from the first element of `*org-bibtex-entries*'." + "Insert a heading built from the first element of `org-bibtex-entries'." (interactive) - (when (= (length *org-bibtex-entries*) 0) - (error "No entries in `*org-bibtex-entries*'.")) - (let ((entry (pop *org-bibtex-entries*)) - (org-special-properties nil)) ; avoids errors with `org-entry-put' - (flet ((val (field) (cdr (assoc field entry))) - (togtag (tag) (org-toggle-tag tag 'on))) - (org-insert-heading) - (insert (val :title)) - (org-bibtex-put "TITLE" (val :title)) - (org-bibtex-put org-bibtex-type-property-name (downcase (val :type))) - (dolist (pair entry) - (case (car pair) - (:title nil) - (:type nil) - (:key (org-bibtex-put org-bibtex-key-property (cdr pair))) - (:keywords (if org-bibtex-tags-are-keywords - (mapc - (lambda (kw) - (togtag - (replace-regexp-in-string - "[^[:alnum:]_@#%]" "" - (replace-regexp-in-string "[ \t]+" "_" kw)))) - (split-string (cdr pair) ", *")) - (org-bibtex-put (car pair) (cdr pair)))) - (otherwise (org-bibtex-put (car pair) (cdr pair))))) - (mapc #'togtag org-bibtex-tags)))) + (when (= (length org-bibtex-entries) 0) + (error "No entries in `org-bibtex-entries'")) + (let* ((entry (pop org-bibtex-entries)) + (org-special-properties nil) ; avoids errors with `org-entry-put' + (val (lambda (field) (cdr (assoc field entry)))) + (togtag (lambda (tag) (org-toggle-tag tag 'on)))) + (org-insert-heading) + (insert (funcall val :title)) + (org-bibtex-put "TITLE" (funcall val :title)) + (org-bibtex-put org-bibtex-type-property-name + (downcase (funcall val :type))) + (dolist (pair entry) + (case (car pair) + (:title nil) + (:type nil) + (:key (org-bibtex-put org-bibtex-key-property (cdr pair))) + (:keywords (if org-bibtex-tags-are-keywords + (mapc + (lambda (kw) + (funcall + togtag + (replace-regexp-in-string + "[^[:alnum:]_@#%]" "" + (replace-regexp-in-string "[ \t]+" "_" kw)))) + (split-string (cdr pair) ", *")) + (org-bibtex-put (car pair) (cdr pair)))) + (otherwise (org-bibtex-put (car pair) (cdr pair))))) + (mapc togtag org-bibtex-tags))) (defun org-bibtex-yank () "If kill ring holds a bibtex entry yank it as an Org-mode headline." @@ -656,7 +663,7 @@ This uses `bibtex-parse-entry'." (with-temp-buffer (yank 1) (setf entry (org-bibtex-read))) (if entry (org-bibtex-write) - (error "yanked text does not appear to contain a bibtex entry")))) + (error "Yanked text does not appear to contain a BibTeX entry")))) (defun org-bibtex-export-to-kill-ring () "Export current headline to kill ring as bibtex entry." diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 454463f708..9d20814a2c 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -58,6 +58,9 @@ (declare-function org-table-goto-line "org-table" (N)) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) +(declare-function org-at-encrypted-entry-p "org-crypt" ()) +(declare-function org-encrypt-entry "org-crypt" ()) +(declare-function org-decrypt-entry "org-crypt" ()) (defvar org-remember-default-headline) (defvar org-remember-templates) @@ -101,7 +104,7 @@ description A short string describing the template, will be shown during selection. type The type of entry. Valid types are: - entry an Org-mode node, with a headline. Will be + entry an Org-mode node, with a headline. Will be filed as the child of the target entry or as a top-level entry. item a plain list item, will be placed in the @@ -183,6 +186,14 @@ properties are: before and after the new item. Default 0, only common other value is 1. + :empty-lines-before Set this to the number of lines the should be inserted + before the new item. Overrides :empty-lines for the + number lines inserted before. + + :empty-lines-after Set this to the number of lines the should be inserted + after the new item. Overrides :empty-lines for the + number of lines inserted after. + :clock-in Start the clock in this item. :clock-keep Keep the clock running when filing the captured entry. @@ -211,51 +222,53 @@ will be filed as a child of the target headline. It can also be freely formatted text. Furthermore, the following %-escapes will be replaced with content and expanded in this order: - %[pathname] insert the contents of the file given by `pathname'. - %(sexp) evaluate elisp `(sexp)' and replace with the result. - %<...> the result of format-time-string on the ... format specification. - %t time stamp, date only. - %T time stamp with date and time. - %u, %U like the above, but inactive time stamps. - %a annotation, normally the link created with `org-store-link'. - %i initial content, copied from the active region. If %i is + %[pathname] Insert the contents of the file given by `pathname'. + %(sexp) Evaluate elisp `(sexp)' and replace with the result. + %<...> The result of format-time-string on the ... format specification. + %t Time stamp, date only. + %T Time stamp with date and time. + %u, %U Like the above, but inactive time stamps. + %i Initial content, copied from the active region. If %i is indented, the entire inserted text will be indented as well. - %A like %a, but prompt for the description part. - %c current kill ring head. - %x content of the X clipboard. - %k title of currently clocked task. - %K link to currently clocked task. - %n user name (taken from `user-full-name'). - %f file visited by current buffer when org-capture was called. - %F full path of the file or directory visited by current buffer. - %:keyword specific information for certain link types, see below. - %^g prompt for tags, with completion on tags in target file. - %^G prompt for tags, with completion on all tags in all agenda files. - %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. - You may define a prompt like %^{Please specify birthday. - %^C interactive selection of which kill or clip to use. - %^L like %^C, but insert as link. - %^{prop}p prompt the user for a value for property `prop'. - %^{prompt} prompt the user for a string and replace this sequence with it. + %a Annotation, normally the link created with `org-store-link'. + %A Like %a, but prompt for the description part. + %l Like %a, but only insert the literal link. + %c Current kill ring head. + %x Content of the X clipboard. + %k Title of currently clocked task. + %K Link to currently clocked task. + %n User name (taken from `user-full-name'). + %f File visited by current buffer when org-capture was called. + %F Full path of the file or directory visited by current buffer. + %:keyword Specific information for certain link types, see below. + %^g Prompt for tags, with completion on tags in target file. + %^G Prompt for tags, with completion on all tags in all agenda files. + %^t Like %t, but prompt for date. Similarly %^T, %^u, %^U. + You may define a prompt like: %^{Please specify birthday}t + %^C Interactive selection of which kill or clip to use. + %^L Like %^C, but insert as link. + %^{prop}p Prompt the user for a value for property `prop'. + %^{prompt} Prompt the user for a string and replace this sequence with it. A default value and a completion table ca be specified like this: %^{prompt|default|completion2|completion3|...}. %? After completing the template, position cursor here. + %\\n Insert the text entered at the nth %^{prompt}, where `n' is + a number, starting from 1. -Apart from these general escapes, you can access information specific to the -link type that is created. For example, calling `org-capture' in emails -or gnus will record the author and the subject of the message, which you +Apart from these general escapes, you can access information specific to +the link type that is created. For example, calling `org-capture' in emails +or in Gnus will record the author and the subject of the message, which you can access with \"%:from\" and \"%:subject\", respectively. Here is a complete list of what is recorded for each link type. Link type | Available information ------------------------+------------------------------------------------------ bbdb | %:type %:name %:company -vm, wl, mh, mew, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress +vm, wl, mh, mew, rmail, | %:type %:subject %:message-id +gnus | %:from %:fromname %:fromaddress | %:to %:toname %:toaddress | %:fromto (either \"to NAME\" or \"from NAME\") - | %:date - | %:date-timestamp (as active timestamp) + | %:date %:date-timestamp (as active timestamp) | %:date-timestamp-inactive (as inactive timestamp) gnus | %:group, for messages also all email fields w3, w3m | %:type %:url @@ -266,71 +279,71 @@ calendar | %:type %:date" :type '(repeat (choice :value ("" "" entry (file "~/org/notes.org") "") - (list :tag "Multikey description" - (string :tag "Keys ") - (string :tag "Description")) - (list :tag "Template entry" - (string :tag "Keys ") - (string :tag "Description ") - (choice :tag "Capture Type " :value entry - (const :tag "Org entry" entry) - (const :tag "Plain list item" item) - (const :tag "Checkbox item" checkitem) - (const :tag "Plain text" plain) - (const :tag "Table line" table-line)) - (choice :tag "Target location" - (list :tag "File" - (const :format "" file) - (file :tag " File")) - (list :tag "ID" - (const :format "" id) - (string :tag " ID")) - (list :tag "File & Headline" - (const :format "" file+headline) - (file :tag " File ") - (string :tag " Headline")) - (list :tag "File & Outline path" - (const :format "" file+olp) - (file :tag " File ") - (repeat :tag "Outline path" :inline t - (string :tag "Headline"))) - (list :tag "File & Regexp" - (const :format "" file+regexp) - (file :tag " File ") - (regexp :tag " Regexp")) - (list :tag "File & Date tree" - (const :format "" file+datetree) - (file :tag " File")) - (list :tag "File & Date tree, prompt for date" - (const :format "" file+datetree+prompt) - (file :tag " File")) - (list :tag "File & function" - (const :format "" file+function) - (file :tag " File ") - (sexp :tag " Function")) - (list :tag "Current clocking task" - (const :format "" clock)) - (list :tag "Function" - (const :format "" function) - (sexp :tag " Function"))) - (choice :tag "Template" - (string) - (list :tag "File" - (const :format "" file) - (file :tag "Template file")) - (list :tag "Function" - (const :format "" function) - (function :tag "Template function"))) - (plist :inline t - ;; Give the most common options as checkboxes - :options (((const :format "%v " :prepend) (const t)) - ((const :format "%v " :immediate-finish) (const t)) - ((const :format "%v " :empty-lines) (const 1)) - ((const :format "%v " :clock-in) (const t)) - ((const :format "%v " :clock-keep) (const t)) - ((const :format "%v " :clock-resume) (const t)) - ((const :format "%v " :unnarrowed) (const t)) - ((const :format "%v " :kill-buffer) (const t)))))))) + (list :tag "Multikey description" + (string :tag "Keys ") + (string :tag "Description")) + (list :tag "Template entry" + (string :tag "Keys ") + (string :tag "Description ") + (choice :tag "Capture Type " :value entry + (const :tag "Org entry" entry) + (const :tag "Plain list item" item) + (const :tag "Checkbox item" checkitem) + (const :tag "Plain text" plain) + (const :tag "Table line" table-line)) + (choice :tag "Target location" + (list :tag "File" + (const :format "" file) + (file :tag " File")) + (list :tag "ID" + (const :format "" id) + (string :tag " ID")) + (list :tag "File & Headline" + (const :format "" file+headline) + (file :tag " File ") + (string :tag " Headline")) + (list :tag "File & Outline path" + (const :format "" file+olp) + (file :tag " File ") + (repeat :tag "Outline path" :inline t + (string :tag "Headline"))) + (list :tag "File & Regexp" + (const :format "" file+regexp) + (file :tag " File ") + (regexp :tag " Regexp")) + (list :tag "File & Date tree" + (const :format "" file+datetree) + (file :tag " File")) + (list :tag "File & Date tree, prompt for date" + (const :format "" file+datetree+prompt) + (file :tag " File")) + (list :tag "File & function" + (const :format "" file+function) + (file :tag " File ") + (sexp :tag " Function")) + (list :tag "Current clocking task" + (const :format "" clock)) + (list :tag "Function" + (const :format "" function) + (sexp :tag " Function"))) + (choice :tag "Template" + (string) + (list :tag "File" + (const :format "" file) + (file :tag "Template file")) + (list :tag "Function" + (const :format "" function) + (function :tag "Template function"))) + (plist :inline t + ;; Give the most common options as checkboxes + :options (((const :format "%v " :prepend) (const t)) + ((const :format "%v " :immediate-finish) (const t)) + ((const :format "%v " :empty-lines) (const 1)) + ((const :format "%v " :clock-in) (const t)) + ((const :format "%v " :clock-keep) (const t)) + ((const :format "%v " :clock-resume) (const t)) + ((const :format "%v " :unnarrowed) (const t)) + ((const :format "%v " :kill-buffer) (const t)))))))) (defcustom org-capture-before-finalize-hook nil "Hook that is run right before a capture process is finalized. @@ -342,11 +355,25 @@ widened to the entire buffer." (defcustom org-capture-after-finalize-hook nil "Hook that is run right after a capture process is finalized. - Suitable for window cleanup" +Suitable for window cleanup." + :group 'org-capture + :version "24.1" + :type 'hook) + +(defcustom org-capture-prepare-finalize-hook nil + "Hook that is run before the finalization starts. +The capture buffer is current and still narrowed." :group 'org-capture :version "24.1" :type 'hook) +(defcustom org-capture-bookmark t + "When non-nil, add a bookmark pointing at the last stored +position when capturing." + :group 'org-capture + :version "24.3" + :type 'boolean) + ;;; The property list for keeping information about the capture process (defvar org-capture-plist nil @@ -394,12 +421,13 @@ for a capture buffer.") "Hook for the minor `org-capture-mode'.") (define-minor-mode org-capture-mode - "Minor mode for special key bindings in a capture buffer." + "Minor mode for special key bindings in a capture buffer. + +Turning on this mode runs the normal hook `org-capture-mode-hook'." nil " Rem" org-capture-mode-map (org-set-local 'header-line-format - "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.") - (run-hooks 'org-capture-mode-hook)) + "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")) (define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) (define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) (define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) @@ -407,6 +435,67 @@ for a capture buffer.") ;;; The main commands ;;;###autoload +(defvar org-capture-initial nil) +(defvar org-capture-entry nil) +(defun org-capture-string (string &optional keys) + (interactive "sInitial text: \n") + (let ((org-capture-initial string) + (org-capture-entry (org-capture-select-template keys))) + (org-capture))) + +(defcustom org-capture-templates-contexts nil + "Alist of capture templates and valid contexts. + +For example, if you have a capture template \"c\" and you want +this template to be accessible only from `message-mode' buffers, +use this: + + '((\"c\" (in-mode . \"message-mode\"))) + +Here are the available contexts definitions: + + in-file: command displayed only in matching files + in-mode: command displayed only in matching modes + not-in-file: command not displayed in matching files + not-in-mode: command not displayed in matching modes + [function]: a custom function taking no argument + +If you define several checks, the agenda command will be +accessible if there is at least one valid check. + +You can also bind a key to another agenda custom command +depending on contextual rules. + + '((\"c\" \"d\" (in-mode . \"message-mode\"))) + +Here it means: in `message-mode buffers', use \"d\" as the +key for the capture template otherwise associated with \"d\". +\(The template originally associated with \"q\" is not displayed +to avoid duplicates.)" + :version "24.3" + :group 'org-capture + :type '(repeat (list :tag "Rule" + (string :tag " Capture key") + (string :tag "Replace by template") + (repeat :tag "Available when" + (choice + (cons :tag "Condition" + (choice + (const :tag "In file" in-file) + (const :tag "Not in file" not-in-file) + (const :tag "In mode" in-mode) + (const :tag "Not in mode" not-in-mode)) + (regexp)) + (function :tag "Custom function")))))) + +(defcustom org-capture-use-agenda-date nil + "Non-nil means use the date at point when capturing from agendas. +When nil, you can still capturing using the date at point with \\[org-agenda-capture]]." + :group 'org-capture + :version "24.3" + :type 'boolean) + +;;;###autoload (defun org-capture (&optional goto keys) "Capture something. \\<org-capture-mode-map> @@ -424,10 +513,17 @@ stored. When called with a `C-0' (zero) prefix, insert a template at point. -Lisp programs can set KEYS to a string associated with a template in -`org-capture-templates'. In this case, interactive selection will be -bypassed." +Lisp programs can set KEYS to a string associated with a template +in `org-capture-templates'. In this case, interactive selection +will be bypassed. + +If `org-capture-use-agenda-date' is non-nil, capturing from the +agenda will use the date at point as the default date." (interactive "P") + (when (and org-capture-use-agenda-date + (eq major-mode 'org-agenda-mode)) + (setq org-overriding-default-time + (org-get-cursor-date))) (cond ((equal goto '(4)) (org-capture-goto-target)) ((equal goto '(16)) (org-capture-goto-last-stored)) @@ -438,9 +534,11 @@ bypassed." org-capture-link-is-already-stored) (plist-get org-store-link-plist :annotation) (ignore-errors (org-store-link nil)))) - (initial (and (org-region-active-p) - (buffer-substring (point) (mark)))) - (entry (org-capture-select-template keys))) + (entry (or org-capture-entry (org-capture-select-template keys))) + initial) + (setq initial (or org-capture-initial + (and (org-region-active-p) + (buffer-substring (point) (mark))))) (when (stringp initial) (remove-text-properties 0 (length initial) '(read-only t) initial)) (when (stringp annotation) @@ -489,7 +587,7 @@ bypassed." (error "Capture template `%s': %s" (org-capture-get :key) (nth 1 error)))) - (if (and (eq major-mode 'org-mode) + (if (and (derived-mode-p 'org-mode) (org-capture-get :clock-in)) (condition-case nil (progn @@ -530,6 +628,8 @@ captured item after finalizing." (buffer-base-buffer (current-buffer))) (error "This does not seem to be a capture buffer for Org-mode")) + (run-hooks 'org-capture-prepare-finalize-hook) + ;; Did we start the clock in this capture buffer? (when (and org-capture-clock-was-started org-clock-marker (marker-buffer org-clock-marker) @@ -577,9 +677,10 @@ captured item after finalizing." (goto-char end) (or (bolp) (newline)) (org-capture-empty-lines-after - (or (org-capture-get :empty-lines 'local) 0)))) + (or (org-capture-get :empty-lines-after 'local) + (org-capture-get :empty-lines 'local) 0)))) ;; Postprocessing: Update Statistics cookies, do the sorting - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (save-excursion (when (ignore-errors (org-back-to-heading)) (org-update-parent-todo-statistics) @@ -594,11 +695,17 @@ captured item after finalizing." ;; Store this place as the last one where we stored something ;; Do the marking in the base buffer, so that it makes sense after ;; the indirect buffer has been killed. - (org-capture-bookmark-last-stored-position) + (when org-capture-bookmark + (org-capture-bookmark-last-stored-position)) ;; Run the hook (run-hooks 'org-capture-before-finalize-hook)) + (when (org-capture-get :decrypted) + (save-excursion + (goto-char (org-capture-get :decrypted)) + (org-encrypt-entry))) + ;; Kill the indirect buffer (save-buffer) (let ((return-wconf (org-capture-get :return-to-wconf 'local)) @@ -675,8 +782,8 @@ already gone. Any prefix argument will be passed to the refile command." (defun org-capture-kill () "Abort the current capture process." (interactive) - ;; FIXME: This does not do the right thing, we need to remove the new stuff - ;; By hand it is easy: undo, then kill the buffer + ;; FIXME: This does not do the right thing, we need to remove the + ;; new stuff by hand it is easy: undo, then kill the buffer (let ((org-note-abort t) (org-capture-before-finalize-hook nil)) (org-capture-finalize))) @@ -700,9 +807,11 @@ already gone. Any prefix argument will be passed to the refile command." ;; store the current point (org-capture-put :initial-target-position (point))) +(defvar org-time-was-given) ; dynamically scoped parameter (defun org-capture-set-target-location (&optional target) - "Find target buffer and position and store then in the property list." - (let ((target-entry-p t)) + "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))) (save-excursion (cond @@ -727,7 +836,7 @@ already gone. Any prefix argument will be passed to the refile command." (widen) (let ((hd (nth 2 target))) (goto-char (point-min)) - (unless (eq major-mode 'org-mode) + (unless (derived-mode-p 'org-mode) (error "Target buffer \"%s\" for file+headline should be in Org mode" (current-buffer))) @@ -759,7 +868,7 @@ already gone. Any prefix argument will be passed to the refile command." (goto-char (if (org-capture-get :prepend) (match-beginning 0) (match-end 0))) (org-capture-put :exact-position (point)) - (setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p)))) + (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)) @@ -781,11 +890,22 @@ already gone. Any prefix argument will be passed to the refile command." (let ((prompt-time (org-read-date nil t nil "Date for tree entry:" (current-time)))) - (org-capture-put :prompt-time prompt-time - :default-time prompt-time) + (org-capture-put + :default-time + (cond ((and (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) (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, possible corrected for late night workers + ;; current date, possibly corrected for late night workers (org-today)))))) ((eq (car target) 'file+function) @@ -794,12 +914,12 @@ already gone. Any prefix argument will be passed to the refile command." (widen) (funcall (nth 2 target)) (org-capture-put :exact-position (point)) - (setq target-entry-p (and (eq major-mode 'org-mode) (org-at-heading-p)))) + (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 (eq major-mode 'org-mode) (org-at-heading-p)))) + (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) @@ -812,8 +932,14 @@ already gone. Any prefix argument will be passed to the refile command." (t (error "Invalid capture target specification"))) + (when (and (featurep 'org-crypt) (org-at-encrypted-entry-p)) + (org-decrypt-entry) + (setq decrypted-hl-pos + (save-excursion (and (org-back-to-heading t) (point))))) + (org-capture-put :buffer (current-buffer) :pos (point) - :target-entry-p target-entry-p)))) + :target-entry-p target-entry-p + :decrypted decrypted-hl-pos)))) (defun org-capture-expand-file (file) "Expand functions and symbols for FILE. @@ -893,7 +1019,7 @@ it. When it is a variable, retrieve the value. Return whatever we get." (progn (outline-next-heading) (or (bolp) (insert "\n"))) - (org-end-of-subtree t t) + (org-end-of-subtree t nil) (or (bolp) (insert "\n"))))) (org-capture-empty-lines-before) (setq beg (point)) @@ -905,8 +1031,9 @@ it. When it is a variable, retrieve the value. Return whatever we get." (setq end (point)) (org-capture-mark-kill-region beg (1- end)) (org-capture-narrow beg (1- end)) - (goto-char beg) - (if (re-search-forward "%\\?" end t) (replace-match "")))) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))) (defun org-capture-place-item () "Place the template as a new plain list item." @@ -962,7 +1089,9 @@ it. When it is a variable, retrieve the value. Return whatever we get." (setq end (point)) (org-capture-mark-kill-region beg (1- end)) (org-capture-narrow beg (1- end)) - (if (re-search-forward "%\\?" end t) (replace-match "")))) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))) (defun org-capture-place-table-line () "Place the template as a table line." @@ -982,9 +1111,9 @@ it. When it is a variable, retrieve the value. Return whatever we get." (setq beg (1+ (point-at-eol)) end (save-excursion (outline-next-heading) (point))))) (if (re-search-forward org-table-dataline-regexp end t) - (let ((b (org-table-begin)) (e (org-table-end))) + (let ((b (org-table-begin)) (e (org-table-end)) (case-fold-search t)) (goto-char e) - (if (looking-at "[ \t]*#\\+TBLFM:") + (if (looking-at "[ \t]*#\\+tblfm:") (forward-line 1)) (narrow-to-region b (point))) (goto-char end) @@ -1040,7 +1169,9 @@ it. When it is a variable, retrieve the value. Return whatever we get." (setq end (point)))) (goto-char beg) (org-capture-position-for-last-stored 'table-line) - (if (re-search-forward "%\\?" end t) (replace-match "")) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")) (org-table-align))) (defun org-capture-place-plain-text () @@ -1075,7 +1206,9 @@ Of course, if exact position has been required, just put it there." (setq end (point)) (org-capture-mark-kill-region beg (1- end)) (org-capture-narrow beg (1- end)) - (if (re-search-forward "%\\?" end t) (replace-match "")))) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))) (defun org-capture-mark-kill-region (beg end) "Mark the region that will have to be killed when aborting capture." @@ -1128,7 +1261,8 @@ Of course, if exact position has been required, just put it there." (defun org-capture-empty-lines-before (&optional n) "Arrange for the correct number of empty lines before the insertion point. Point will be after the empty lines, so insertion can directly be done." - (setq n (or n (org-capture-get :empty-lines) 0)) + (setq n (or n (org-capture-get :empty-lines-before) + (org-capture-get :empty-lines) 0)) (let ((pos (point))) (org-back-over-empty-lines) (delete-region (point) pos) @@ -1137,7 +1271,8 @@ Point will be after the empty lines, so insertion can directly be done." (defun org-capture-empty-lines-after (&optional n) "Arrange for the correct number of empty lines after the inserted string. Point will remain at the first line after the inserted text." - (setq n (or n (org-capture-get :empty-lines) 0)) + (setq n (or n (org-capture-get :empty-lines-after) + (org-capture-get :empty-lines) 0)) (org-back-over-empty-lines) (while (looking-at "[ \t]*\n") (replace-match "")) (let ((pos (point))) @@ -1153,11 +1288,11 @@ Point will remain at the first line after the inserted text." (or (bolp) (newline)) (setq beg (point)) (cond - ((and (eq type 'entry) (eq major-mode 'org-mode)) + ((and (eq type 'entry) (derived-mode-p 'org-mode)) (org-capture-verify-tree (org-capture-get :template)) (org-paste-subtree nil template t)) ((and (memq type '(item checkitem)) - (eq major-mode 'org-mode) + (derived-mode-p 'org-mode) (save-excursion (skip-chars-backward " \t\n") (setq pp (point)) (org-in-item-p))) @@ -1225,7 +1360,7 @@ Use PREFIX as a prefix for the name of the indirect buffer." buf))))) (defun org-capture-verify-tree (tree) - "Throw error if TREE is not a valid tree" + "Throw error if TREE is not a valid tree." (unless (org-kill-is-subtree-p tree) (error "Template is not a valid Org entry or tree"))) @@ -1235,7 +1370,8 @@ Use PREFIX as a prefix for the name of the indirect buffer." "Select a capture template. Lisp programs can force the template by setting KEYS to a string." (let ((org-capture-templates - (or org-capture-templates + (or (org-contextualize-keys + org-capture-templates org-capture-templates-contexts) '(("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a"))))) (if keys @@ -1252,8 +1388,7 @@ Lisp programs can force the template by setting KEYS to a string." The template may still contain \"%?\" for cursor positioning." (setq template (or template (org-capture-get :template))) (when (stringp initial) - (setq initial (org-no-properties initial)) - (remove-text-properties 0 (length initial) '(read-only t) initial)) + (setq initial (org-no-properties initial))) (let* ((buffer (org-capture-get :buffer)) (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) (ct (org-capture-get :default-time)) @@ -1288,14 +1423,16 @@ The template may still contain \"%?\" for cursor positioning." (org-get-x-clipboard 'CLIPBOARD) (org-get-x-clipboard 'SECONDARY) v-c))) - (v-A (if (and v-a - (string-match - "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a)) - (replace-match "[\\1[%^{Link description}]]" nil nil v-a) + (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]") + (v-A (if (and v-a (string-match l-re v-a)) + (replace-match "[[\\1][%^{Link description}]]" nil nil v-a) + v-a)) + (v-l (if (and v-a (string-match l-re v-a)) + (replace-match "\\1" nil nil v-a) v-a)) (v-n user-full-name) (v-k (if (marker-buffer org-clock-marker) - (org-substring-no-properties org-clock-heading))) + (org-no-properties org-clock-heading))) (v-K (if (marker-buffer org-clock-marker) (org-make-link-string (buffer-file-name (marker-buffer org-clock-marker)) @@ -1306,7 +1443,7 @@ The template may still contain \"%?\" for cursor positioning." (org-startup-folded nil) (org-inhibit-startup t) org-time-was-given org-end-time-was-given x - prompt completions char time pos default histvar) + prompt completions char time pos default histvar strings) (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a) @@ -1339,15 +1476,7 @@ The template may still contain \"%?\" for cursor positioning." (error (insert (format "%%![Couldn't insert %s: %s]" filename error))))))) ;; %() embedded elisp - (goto-char (point-min)) - (while (re-search-forward "%\\((.+)\\)" nil t) - (unless (org-capture-escaped-%) - (goto-char (match-beginning 0)) - (let ((template-start (point))) - (forward-char 1) - (let ((result (org-eval (read (current-buffer))))) - (delete-region template-start (point)) - (insert result))))) + (org-capture-expand-embedded-elisp) ;; The current time (goto-char (point-min)) @@ -1356,7 +1485,7 @@ The template may still contain \"%?\" for cursor positioning." ;; Simple %-escapes (goto-char (point-min)) - (while (re-search-forward "%\\([tTuUaiAcxkKInfF]\\)" nil t) + (while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t) (unless (org-capture-escaped-%) (when (and initial (equal (match-string 0) "%i")) (save-match-data @@ -1366,7 +1495,8 @@ The template may still contain \"%?\" for cursor positioning." (org-split-string initial "\n") (concat "\n" lead)))))) (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") + (or (org-add-props (eval (intern (concat "v-" (match-string 1)))) + '(org-protected t)) "") t t))) ;; From the property list @@ -1383,8 +1513,8 @@ The template may still contain \"%?\" for cursor positioning." (let ((org-inhibit-startup t)) (org-mode)) ;; Interactive template entries (goto-char (point-min)) - (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" - nil t) + (while (and (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) + (not (get-text-property (1- (point)) 'org-protected))) (unless (org-capture-escaped-%) (setq char (if (match-end 3) (match-string-no-properties 3)) prompt (if (match-end 2) (match-string-no-properties 2))) @@ -1415,7 +1545,7 @@ The template may still contain \"%?\" for cursor positioning." (setq ins (mapconcat 'identity (org-split-string ins (org-re "[^[:alnum:]_@#%]+")) - ":")) + ":")) (when (string-match "\\S-" ins) (or (equal (char-before) ?:) (insert ":")) (insert ins) @@ -1436,7 +1566,7 @@ The template may still contain \"%?\" for cursor positioning." '(clipboards . 1) (car clipboards)))))) ((equal char "p") - (org-set-property (org-substring-no-properties prompt) nil)) + (org-set-property (org-no-properties prompt) nil)) (char ;; These are the date/time related ones (setq org-time-was-given (equal (upcase char) char)) @@ -1448,11 +1578,21 @@ The template may still contain \"%?\" for cursor positioning." nil nil (list org-end-time-was-given))) (t (let (org-completion-use-ido) - (insert (org-completing-read-no-i - (concat (if prompt prompt "Enter string") - (if default (concat " [" default "]")) - ": ") - completions nil nil nil histvar default))))))) + (push (org-completing-read-no-i + (concat (if prompt prompt "Enter string") + (if default (concat " [" default "]")) + ": ") + completions nil nil nil histvar default) + strings) + (insert (car strings))))))) + ;; Replace %n escapes with nth %^{...} string + (setq strings (nreverse strings)) + (goto-char (point-min)) + (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t) + (unless (org-capture-escaped-%) + (replace-match + (nth (1- (string-to-number (match-string 1))) strings) + nil t))) ;; Make sure there are no empty lines before the text, and that ;; it ends with a newline character (goto-char (point-min)) @@ -1471,6 +1611,34 @@ The template may still contain \"%?\" for cursor positioning." t) nil)) +(defun org-capture-expand-embedded-elisp () + "Evaluate embedded elisp %(sexp) and replace with the result." + (goto-char (point-min)) + (while (re-search-forward "%(" nil t) + (unless (org-capture-escaped-%) + (goto-char (match-beginning 0)) + (let ((template-start (point))) + (forward-char 1) + (let ((result (org-eval (read (current-buffer))))) + (delete-region template-start (point)) + (insert result)))))) + +(defun org-capture-inside-embedded-elisp-p () + "Return non-nil if point is inside of embedded elisp %(sexp)." + (let (beg end) + (with-syntax-table emacs-lisp-mode-syntax-table + (save-excursion + ;; `looking-at' and `search-backward' below do not match the "%(" if + ;; point is in its middle + (when (equal (char-before) ?%) + (backward-char)) + (save-match-data + (when (or (looking-at "%(") (search-backward "%(" nil t)) + (setq beg (point)) + (setq end (progn (forward-char) (forward-sexp) (1- (point))))))) + (when (and beg end) + (and (<= (point) end) (>= (point) beg)))))) + ;;;###autoload (defun org-capture-import-remember-templates () "Set org-capture-templates to be similar to `org-remember-templates'." diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index c39fb249e7..bb6f2b955b 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -26,7 +26,6 @@ ;; This file contains the time clocking code for Org-mode -(require 'org) (require 'org-exp) ;;; Code: @@ -38,6 +37,7 @@ (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (defvar org-time-stamp-formats) (defvar org-ts-what) +(defvar org-frame-title-format-backup frame-title-format) (defgroup org-clock nil "Options concerning clocking working time in Org-mode." @@ -247,26 +247,26 @@ string as argument." :group 'org-clock) (defcustom org-clocktable-defaults - `(list - :maxlevel 2 - :lang ,org-export-default-language - :scope 'file - :block nil - :tstart nil - :tend nil - :step nil - :stepskip0 nil - :fileskip0 nil - :tags nil - :emphasize nil - :link nil - :narrow '40! - :indent t - :formula nil - :timestamp nil - :level nil - :tcolumns nil - :formatter nil) + (list + :maxlevel 2 + :lang org-export-default-language + :scope 'file + :block nil + :tstart nil + :tend nil + :step nil + :stepskip0 nil + :fileskip0 nil + :tags nil + :emphasize nil + :link nil + :narrow '40! + :indent t + :formula nil + :timestamp nil + :level nil + :tcolumns nil + :formatter nil) "Default properties for clock tables." :group 'org-clock :version "24.1" @@ -324,6 +324,53 @@ play with them." :version "24.1" :type 'boolean) +(defcustom org-clock-continuously nil + "Non-nil means to start clocking from the last clock-out time, if any." + :type 'boolean + :version "24.1" + :group 'org-clock) + +(defcustom org-clock-total-time-cell-format "*%s*" + "Format string for the total time cells." + :group 'org-clock + :version "24.1" + :type 'boolean) + +(defcustom org-clock-file-time-cell-format "*%s*" + "Format string for the file time cells." + :group 'org-clock + :version "24.1" + :type 'boolean) + +(defcustom org-clock-clocked-in-display 'mode-line + "When clocked in for a task, org-mode can display the current +task and accumulated time in the mode line and/or frame title. +Allowed values are: + +both displays in both mode line and frame title +mode-line displays only in mode line (default) +frame-title displays only in frame title +nil current clock is not displayed" + :group 'org-clock + :type '(choice + (const :tag "Mode line" mode-line) + (const :tag "Frame title" frame-title) + (const :tag "Both" both) + (const :tag "None" nil))) + +(defcustom org-clock-frame-title-format '(t org-mode-line-string) + "The value for `frame-title-format' when clocking in. + +When `org-clock-clocked-in-display' is set to 'frame-title +or 'both, clocking in will replace `frame-title-format' with +this value. Clocking out will restore `frame-title-format'. + +`org-frame-title-string' is a format string using the same +specifications than `frame-title-format', which see." + :version "24.1" + :group 'org-clock + :type 'sexp) + (defvar org-clock-in-prepare-hook nil "Hook run when preparing the clock. This hook is run before anything happens to the task that @@ -521,7 +568,7 @@ If not, show simply the clocked time like 01:50." 'org-mode-line-clock-overrun 'org-mode-line-clock))) (effort-str (format org-time-clocksum-format effort-h effort-m)) (clockstr (org-propertize - (concat "[%s/" effort-str + (concat " [%s/" effort-str "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") 'face 'org-mode-line-clock))) (format clockstr work-done-str)) @@ -545,8 +592,7 @@ If not, show simply the clocked time like 01:50." 'help-echo (concat help-text ": " org-clock-heading)) (org-propertize clock-string 'help-echo help-text))) 'local-map org-clock-mode-line-map - 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight) - )) + 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight))) (if (and org-clock-task-overrun org-clock-task-overrun-text) (setq org-mode-line-string (concat (org-propertize @@ -564,39 +610,40 @@ previous clocking intervals." (+ currently-clocked-time (or org-clock-total-time 0)))) (defun org-clock-modify-effort-estimate (&optional value) - "Add to or set the effort estimate of the item currently being clocked. + "Add to or set the effort estimate of the item currently being clocked. VALUE can be a number of minutes, or a string with format hh:mm or mm. When the string starts with a + or a - sign, the current value of the effort property will be changed by that amount. This will update the \"Effort\" property of currently clocked item, and the mode line." - (interactive) - (when (org-clock-is-active) - (let ((current org-clock-effort) sign) - (unless value - ;; Prompt user for a value or a change - (setq value - (read-string - (format "Set effort (hh:mm or mm%s): " - (if current - (format ", prefix + to add to %s" org-clock-effort) - ""))))) - (when (stringp value) - ;; 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) - value (substring value 1)) - (setq current 0)) - (setq value (org-duration-string-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-hh:mm-string value)) - (org-entry-put org-clock-marker "Effort" org-clock-effort) - (org-clock-update-mode-line) - (message "Effort is now %s" org-clock-effort)))) + (interactive) + (if (org-clock-is-active) + (let ((current org-clock-effort) sign) + (unless value + ;; Prompt user for a value or a change + (setq value + (read-string + (format "Set effort (hh:mm or mm%s): " + (if current + (format ", prefix + to add to %s" org-clock-effort) + ""))))) + (when (stringp value) + ;; 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) + value (substring value 1)) + (setq current 0)) + (setq value (org-duration-string-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-hh:mm-string value)) + (org-entry-put org-clock-marker "Effort" org-clock-effort) + (org-clock-update-mode-line) + (message "Effort is now %s" org-clock-effort)) + (message "Clock is not currently active"))) (defvar org-clock-notification-was-shown nil "Shows if we have shown notification already.") @@ -632,15 +679,14 @@ use libnotify if available, or fall back on a message." ((stringp org-show-notification-handler) (start-process "emacs-timer-notification" nil org-show-notification-handler notification)) - ((featurep 'notifications) - (require 'notifications) + ((fboundp 'notifications-notify) (notifications-notify :title "Org-mode message" :body notification ;; FIXME how to link to the Org icon? ;; :app-icon "~/.emacs.d/icons/mail.png" :urgency 'low)) - ((org-program-exists "notify-send") + ((executable-find "notify-send") (start-process "emacs-timer-notification" nil "notify-send" notification)) ;; Maybe the handler will send a message, so only use message as @@ -656,18 +702,13 @@ Use alsa's aplay tool if available." ((stringp org-clock-sound) (let ((file (expand-file-name org-clock-sound))) (if (file-exists-p file) - (if (org-program-exists "aplay") + (if (executable-find "aplay") (start-process "org-clock-play-notification" nil "aplay" file) (condition-case nil (play-sound-file file) (error (beep t) (beep t))))))))) -(defun org-program-exists (program-name) - "Checks whenever we can locate PROGRAM-NAME using the `which' executable." - (if (member system-type '(gnu/linux darwin)) - (= 0 (call-process "which" nil nil nil program-name)))) - (defvar org-clock-mode-line-entry nil "Information for the mode line about the running clock.") @@ -729,9 +770,9 @@ If necessary, clock-out of the currently active clock." (let ((temp (copy-marker (car clock) (marker-insertion-type (car clock))))) (if (org-is-active-clock clock) - (org-clock-out fail-quietly at-time) + (org-clock-out nil fail-quietly at-time) (org-with-clock clock - (org-clock-out fail-quietly at-time))) + (org-clock-out nil fail-quietly at-time))) (setcar clock temp))) (defsubst org-clock-clock-cancel (clock) @@ -934,18 +975,18 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (let ((dangling (or (not (org-clock-is-active)) (/= (car clock) org-clock-marker)))) (if (or (not only-dangling-p) dangling) - (org-clock-resolve - clock - (or prompt-fn - (function - (lambda (clock) - (format - "Dangling clock started %d mins ago" - (floor - (/ (- (org-float-time (current-time)) - (org-float-time (cdr clock))) 60)))))) - (or last-valid - (cdr clock))))))))))) + (org-clock-resolve + clock + (or prompt-fn + (function + (lambda (clock) + (format + "Dangling clock started %d mins ago" + (floor + (/ (- (org-float-time (current-time)) + (org-float-time (cdr clock))) 60)))))) + (or last-valid + (cdr clock))))))))))) (defun org-emacs-idle-seconds () "Return the current Emacs idle time in seconds, or nil if not idle." @@ -958,6 +999,13 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling "Return the current Mac idle time in seconds." (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'"))) +(defvar org-x11idle-exists-p + ;; Check that x11idle exists + (and (eq window-system 'x) + (eq (call-process-shell-command "command" nil nil nil "-v" "x11idle") 0) + ;; Check that x11idle can retrieve the idle time + (eq (call-process-shell-command "x11idle" nil nil nil) 0))) + (defun org-x11-idle-seconds () "Return the current X11 idle time in seconds." (/ (string-to-number (shell-command-to-string "x11idle")) 1000)) @@ -968,7 +1016,7 @@ This routine returns a floating point number." (cond ((eq system-type 'darwin) (org-mac-idle-seconds)) - ((eq window-system 'x) + ((and (eq window-system 'x) org-x11idle-exists-p) (org-x11-idle-seconds)) (t (org-emacs-idle-seconds)))) @@ -1010,15 +1058,18 @@ so long." "Reset `org-clock-current-task' to nil." (setq org-clock-current-task nil)) +(defvar org-clock-out-time nil) ; store the time of the last clock-out (defun org-clock-in (&optional select start-time) "Start the clock on the current item. If necessary, clock-out of the currently active clock. -With a prefix argument SELECT (\\[universal-argument]), offer a list of \ -recently clocked tasks to -clock into. When SELECT is \\[universal-argument] \\[universal-argument], \ -clock into the current task and mark -is as the default task, a special task that will always be offered in -the clocking selection, associated with the letter `d'." +With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked +tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task +and mark it as the default task, a special task that will always be offered +in the clocking selection, associated with the letter `d'. +When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \ +clock in by using the last clock-out +time as the start time \(see `org-clock-continuously' to +make this the default behavior.)" (interactive "P") (setq org-clock-notification-was-shown nil) (catch 'abort @@ -1026,7 +1077,7 @@ the clocking selection, associated with the letter `d'." (org-clocking-p))) ts selected-task target-pos (msg-extra "") (leftover (and (not org-clock-resolving-clocks) - org-clock-leftover-time))) + org-clock-leftover-time))) (when (and org-clock-auto-clock-resolution (or (not interrupting) @@ -1037,6 +1088,11 @@ the clocking selection, associated with the letter `d'." (let ((org-clock-clocking-in t)) (org-resolve-clocks))) ; check if any clocks are dangling + (when (equal select '(64)) + ;; Set start-time to `org-clock-out-time' + (let ((org-clock-continuously t)) + (org-clock-in nil org-clock-out-time))) + (when (equal select '(4)) (setq selected-task (org-clock-select-task "Clock-in on task: ")) (if selected-task @@ -1069,7 +1125,7 @@ the clocking selection, associated with the letter `d'." (marker-position org-clock-marker) (marker-buffer org-clock-marker)) (let ((org-clock-clocking-in t)) - (org-clock-out t))) + (org-clock-out nil t))) ;; Clock in at which position? (setq target-pos @@ -1090,7 +1146,12 @@ the clocking selection, associated with the letter `d'." (goto-char target-pos) (org-back-to-heading t) (or interrupting (move-marker org-clock-interrupted-task nil)) - (org-clock-history-push) + (save-excursion + (forward-char) ;; make sure the marker is not at the + ;; beginning of the heading, since the + ;; user is liking to insert stuff here + ;; manually + (org-clock-history-push)) (org-clock-set-current) (cond ((functionp org-clock-in-switch-to-state) (looking-at org-complex-heading-regexp) @@ -1111,7 +1172,8 @@ the clocking selection, associated with the letter `d'." (cond ((and org-clock-heading-function (functionp org-clock-heading-function)) (funcall org-clock-heading-function)) - ((looking-at org-complex-heading-regexp) + ((and (looking-at org-complex-heading-regexp) + (match-string 4)) (replace-regexp-in-string "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" (match-string 4))) @@ -1144,7 +1206,7 @@ the clocking selection, associated with the letter `d'." (t (insert-before-markers "\n") (backward-char 1) - (org-indent-line-function) + (org-indent-line) (when (and (save-excursion (end-of-line 0) (org-in-item-p))) @@ -1155,7 +1217,8 @@ the clocking selection, associated with the letter `d'." (setq org-clock-total-time (org-clock-sum-current-item (org-clock-get-sum-start))) (setq org-clock-start-time - (or (and leftover + (or (and org-clock-continuously org-clock-out-time) + (and leftover (y-or-n-p (format "You stopped another clock %d mins ago; start this one from then? " @@ -1171,18 +1234,26 @@ the clocking selection, associated with the letter `d'." (save-excursion (org-back-to-heading t) (point)) (buffer-base-buffer)) (setq org-clock-has-been-used t) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-mode-line-string)))) + ;; add to mode line + (when (or (eq org-clock-clocked-in-display 'mode-line) + (eq org-clock-clocked-in-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-mode-line-string))))) + ;; add to frame title + (when (or (eq org-clock-clocked-in-display 'frame-title) + (eq org-clock-clocked-in-display 'both)) + (setq frame-title-format org-clock-frame-title-format)) (org-clock-update-mode-line) (when org-clock-mode-line-timer (cancel-timer org-clock-mode-line-timer) (setq org-clock-mode-line-timer nil)) - (setq org-clock-mode-line-timer - (run-with-timer org-clock-update-period - org-clock-update-period - 'org-clock-update-mode-line)) + (when org-clock-clocked-in-display + (setq org-clock-mode-line-timer + (run-with-timer org-clock-update-period + org-clock-update-period + 'org-clock-update-mode-line))) (when org-clock-idle-timer (cancel-timer org-clock-idle-timer) (setq org-clock-idle-timer nil)) @@ -1191,6 +1262,41 @@ the clocking selection, associated with the letter `d'." (message "Clock starts at %s - %s" ts msg-extra) (run-hooks 'org-clock-in-hook))))))) +;;;###autoload +(defun org-clock-in-last (&optional arg) + "Clock in the last closed clocked item. +When already clocking in, send an warning. +With a universal prefix argument, select the task you want to +clock in from the last clocked in tasks. +With two universal prefix arguments, start clocking using the +last clock-out time, if any. +With three universal prefix arguments, interactively prompt +for a todo state to switch to, overriding the existing value +`org-clock-in-switch-to-state'." + (interactive "P") + (if (equal arg '(4)) + (org-clock-in (org-clock-select-task)) + (let ((start-time (if (or org-clock-continuously (equal arg '(16))) + (or org-clock-out-time (current-time)) + (current-time)))) + (if (null org-clock-history) + (message "No last clock") + (let ((org-clock-in-switch-to-state + (if (and (not org-clock-current-task) (equal arg '(64))) + (completing-read "Switch to state: " + (and org-clock-history + (with-current-buffer + (marker-buffer (car org-clock-history)) + org-todo-keywords-1))) + org-clock-in-switch-to-state)) + (already-clocking org-clock-current-task)) + (org-clock-clock-in (list (car org-clock-history)) nil start-time) + (or already-clocking + ;; Don't display a message if we are already clocking in + (message "Clocking back: %s (in %s)" + org-clock-current-task + (buffer-name (marker-buffer org-clock-marker))))))))) + (defun org-clock-mark-default-task () "Mark current task as default task." (interactive) @@ -1284,7 +1390,7 @@ line and position cursor in that line." (if (and (>= (org-get-indentation) ind-last) (org-at-item-p)) (when (and (>= (org-get-indentation) ind-last) - (org-at-item-p)) + (org-at-item-p)) (let ((struct (org-list-struct))) (goto-char (org-list-get-bottom-point struct))))) (insert ":END:\n") @@ -1293,7 +1399,7 @@ line and position cursor in that line." (goto-char first) (insert ":" drawer ":\n") (beginning-of-line 0) - (org-indent-line-function) + (org-indent-line) (org-flag-drawer t) (beginning-of-line 2) (or org-log-states-order-reversed @@ -1313,28 +1419,41 @@ line and position cursor in that line." (< org-clock-into-drawer 2))) (insert ":" drawer ":\n:END:\n") (beginning-of-line -1) - (org-indent-line-function) + (org-indent-line) (org-flag-drawer t) (beginning-of-line 2) - (org-indent-line-function) + (org-indent-line) (beginning-of-line) (or org-log-states-order-reversed (and (re-search-forward org-property-end-re nil t) (goto-char (match-beginning 0)))))))) -(defun org-clock-out (&optional fail-quietly at-time) +(defun org-clock-out (&optional switch-to-state fail-quietly at-time) "Stop the currently running clock. -If there is no running clock, throw an error, unless FAIL-QUIETLY is set." - (interactive) +Throw an error if there is no running clock and FAIL-QUIETLY is nil. +With a universal prefix, prompt for a state to switch the clocked out task +to, overriding the existing value of `org-clock-out-switch-to-state'." + (interactive "P") (catch 'exit (when (not (org-clocking-p)) (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (force-mode-line-update) (if fail-quietly (throw 'exit t) (error "No active clock"))) - (let (ts te s h m remove) + (let ((org-clock-out-switch-to-state + (if switch-to-state + (completing-read "Switch to state: " + (with-current-buffer + (marker-buffer org-clock-marker) + org-todo-keywords-1) + nil t "DONE") + org-clock-out-switch-to-state)) + (now (current-time)) + ts te s h m remove) + (setq org-clock-out-time now) (save-excursion ; Do not replace this with `with-current-buffer'. - (with-no-warnings (set-buffer (org-clocking-buffer))) + (org-no-warnings (set-buffer (org-clocking-buffer))) (save-restriction (widen) (goto-char org-clock-marker) @@ -1346,8 +1465,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (goto-char (match-end 0)) (delete-region (point) (point-at-eol)) (insert "--") - (setq te (org-insert-time-stamp (or at-time (current-time)) - 'with-hm 'inactive)) + (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te))) (org-float-time (apply 'encode-time (org-parse-time-string ts)))) h (floor (/ s 3600)) @@ -1374,6 +1492,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (setq org-clock-idle-timer nil)) (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (when org-clock-out-switch-to-state (save-excursion (org-back-to-heading t) @@ -1394,7 +1513,8 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m (if remove " => LINE REMOVED" "")) (run-hooks 'org-clock-out-hook) - (org-clock-delete-current)))))) + (unless (org-clocking-p) + (org-clock-delete-current))))))) (add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer) @@ -1407,7 +1527,8 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (when clock-drawer (save-excursion (org-back-to-heading t) - (while (search-forward clock-drawer end t) + (while (and (< (point) end) + (search-forward clock-drawer end t)) (goto-char (match-beginning 0)) (org-remove-empty-drawer-at clock-drawer (point)) (forward-line 1)))))) @@ -1471,19 +1592,23 @@ UPDOWN tells whether to change 'up or 'down." (interactive) (when (not (org-clocking-p)) (setq global-mode-string - (delq 'org-mode-line-string global-mode-string)) + (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (force-mode-line-update) (error "No active clock")) (save-excursion ; Do not replace this with `with-current-buffer'. - (with-no-warnings (set-buffer (org-clocking-buffer))) + (org-no-warnings (set-buffer (org-clocking-buffer))) (goto-char org-clock-marker) - (delete-region (1- (point-at-bol)) (point-at-eol)) - ;; Just in case, remove any empty LOGBOOK left over - (org-remove-empty-drawer-at "LOGBOOK" (point))) + (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")) + (progn (delete-region (1- (point-at-bol)) (point-at-eol)) + (org-remove-empty-drawer-at "LOGBOOK" (point))) + (message "Clock gone, cancel the timer anyway") + (sit-for 2))) (move-marker org-clock-marker nil) (move-marker org-clock-hd-marker nil) (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) (force-mode-line-update) (message "Clock canceled") (run-hooks 'org-clock-cancel-hook)) @@ -1520,13 +1645,20 @@ With prefix arg SELECT, offer recently clocked tasks for selection." "Holds the file total time in minutes, after a call to `org-clock-sum'.") (make-variable-buffer-local 'org-clock-file-total-minutes) -(defun org-clock-sum (&optional tstart tend headline-filter) +(defun org-clock-sum-today (&optional headline-filter) + "Sum the times for each subtree for today." + (interactive) + (let ((range (org-clock-special-range 'today))) + (org-clock-sum (car range) (cadr range) nil :org-clock-minutes-today))) + +(defun org-clock-sum (&optional tstart tend headline-filter propname) "Sum the times for each subtree. Puts the resulting times in minutes as a text property on each headline. -TSTART and TEND can mark a time range to be considered. HEADLINE-FILTER is a -zero-arg function that, if specified, is called for each headline in the time -range with point at the headline. Headlines for which HEADLINE-FILTER returns -nil are excluded from the clock summation." +TSTART and TEND can mark a time range to be considered. +HEADLINE-FILTER is a zero-arg function that, if specified, is called for +each headline in the time range with point at the headline. Headlines for +which HEADLINE-FILTER returns nil are excluded from the clock summation. +PROPNAME lets you set a custom text property instead of :org-clock-minutes." (interactive) (let* ((bmp (buffer-modified-p)) (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" @@ -1543,7 +1675,7 @@ nil are excluded from the clock summation." (if (consp tstart) (setq tstart (org-float-time tstart))) (if (consp tend) (setq tend (org-float-time tend))) (remove-text-properties (point-min) (point-max) - '(:org-clock-minutes t + `(,(or propname :org-clock-minutes) t :org-clock-force-headline-inclusion t)) (save-excursion (goto-char (point-max)) @@ -1592,7 +1724,8 @@ nil are excluded from the clock summation." (aset ltimes l (+ (aref ltimes l) t1)))) (setq time (aref ltimes level)) (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) :org-clock-minutes time) + (put-text-property (point) (point-at-eol) + (or propname :org-clock-minutes) time) (if headline-filter (save-excursion (save-match-data @@ -1667,8 +1800,8 @@ will be easy to remove." (org-move-to-column c) (unless (eolp) (skip-chars-backward "^ \t")) (skip-chars-backward " \t") - (setq ov (make-overlay (1- (point)) (point-at-eol)) - tx (concat (buffer-substring (1- (point)) (point)) + (setq ov (make-overlay (point-at-bol) (point-at-eol)) + tx (concat (buffer-substring (point-at-bol) (point)) (make-string (+ off (max 0 (- c (current-column)))) ?.) (org-add-props (if org-time-clocksum-use-fractional (format fmt @@ -1864,13 +1997,13 @@ the returned times will be formatted strings." (setq d (nth 1 date) month (car date) y (nth 2 date) dow 1 key 'week)) - ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey) - (require 'cal-iso) - (setq y (string-to-number (match-string 1 skey))) - (setq q (string-to-number (match-string 2 skey))) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (org-quarter-to-date q y)))) - (setq d (nth 1 date) month (car date) y (nth 2 date) + ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey) + (require 'cal-iso) + (setq y (string-to-number (match-string 1 skey))) + (setq q (string-to-number (match-string 2 skey))) + (setq date (calendar-gregorian-from-absolute + (calendar-absolute-from-iso (org-quarter-to-date q y)))) + (setq d (nth 1 date) month (car date) y (nth 2 date) dow 1 key 'quarter)) ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey) @@ -1881,12 +2014,11 @@ the returned times will be formatted strings." ((string-match "\\([-+][0-9]+\\)$" skey) (setq shift (string-to-number (match-string 1 skey)) key (intern (substring skey 0 (match-beginning 1)))) - (if(and (memq key '(quarter thisq)) (> shift 0)) - (error "Looking forward with quarters isn't implemented.") - ()))) + (if (and (memq key '(quarter thisq)) (> shift 0)) + (error "Looking forward with quarters isn't implemented")))) (when (= shift 0) - (cond ((eq key 'yesterday) (setq key 'today shift -1)) + (cond ((eq key 'yesterday) (setq key 'today shift -1)) ((eq key 'lastweek) (setq key 'week shift -1)) ((eq key 'lastmonth) (setq key 'month shift -1)) ((eq key 'lastyear) (setq key 'year shift -1)) @@ -1900,27 +2032,27 @@ the returned times will be formatted strings." ((memq key '(month thismonth)) (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0)) ((memq key '(quarter thisq)) - ; compute if this shift remains in this year - ; if not, compute how many years and quarters we have to shift (via floor*) - ; and compute the shifted years, months and quarters + ; compute if this shift remains in this year + ; if not, compute how many years and quarters we have to shift (via floor*) + ; and compute the shifted years, months and quarters (cond ((< (+ (- q 1) shift) 0) ; shift not in this year - (setq interval (* -1 (+ (- q 1) shift))) - ; set tmp to ((years to shift) (quarters to shift)) - (setq tmp (org-floor* interval 4)) - ; due to the use of floor, 0 quarters actually means 4 - (if (= 0 (nth 1 tmp)) - (setq shiftedy (- y (nth 0 tmp)) - shiftedm 1 - shiftedq 1) - (setq shiftedy (- y (+ 1 (nth 0 tmp))) - shiftedm (- 13 (* 3 (nth 1 tmp))) - shiftedq (- 5 (nth 1 tmp)))) - (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy)) + (setq interval (* -1 (+ (- q 1) shift))) + ; set tmp to ((years to shift) (quarters to shift)) + (setq tmp (org-floor* interval 4)) + ; due to the use of floor, 0 quarters actually means 4 + (if (= 0 (nth 1 tmp)) + (setq shiftedy (- y (nth 0 tmp)) + shiftedm 1 + shiftedq 1) + (setq shiftedy (- y (+ 1 (nth 0 tmp))) + shiftedm (- 13 (* 3 (nth 1 tmp))) + shiftedq (- 5 (nth 1 tmp)))) + (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy)) ((> (+ q shift) 0) ; shift is within this year - (setq shiftedq (+ q shift)) - (setq shiftedy y) - (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0)))) + (setq shiftedq (+ q shift)) + (setq shiftedy y) + (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0)))) ((memq key '(year thisyear)) (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) (t (error "No such time block %s" key))) @@ -1938,7 +2070,7 @@ the returned times will be formatted strings." ((memq key '(year thisyear)) (setq txt (format-time-string "the year %Y" ts))) ((memq key '(quarter thisq)) - (setq txt (concatenate 'string (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))) + (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))) ) (if as-strings (list (format-time-string fm ts) (format-time-string fm te) txt) @@ -1976,62 +2108,62 @@ the currently selected interval size." ((equal s "lastyear") (setq s "thisyear-1")) ((equal s "lastq") (setq s "thisq-1"))) - (cond - ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s) - (setq block (match-string 1 s) - shift (if (match-end 2) - (string-to-number (match-string 2 s)) - 0)) - (setq shift (+ shift n)) - (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) - ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) - ;; 1 1 2 3 3 4 4 5 6 6 5 2 - (setq y (string-to-number (match-string 1 s)) - wp (and (match-end 3) (match-string 3 s)) - mw (and (match-end 4) (string-to-number (match-string 4 s))) - d (and (match-end 6) (string-to-number (match-string 6 s)))) - (cond - (d (setq ins (format-time-string - "%Y-%m-%d" - (encode-time 0 0 0 (+ d n) m y)))) - ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) - (require 'cal-iso) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (list (+ mw n) 1 y)))) - (setq ins (format-time-string - "%G-W%V" - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) - ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0)) - (require 'cal-iso) - ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year - (if (> (+ mw n) 4) - (setq mw 0 - y (+ 1 y)) - ()) - ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year - (if (= (+ mw n) 0) - (setq mw 5 - y (- y 1)) - ()) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y)))) - (setq ins (format-time-string - (concatenate 'string (number-to-string y) "-Q" (number-to-string (+ mw n))) - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) - (mw - (setq ins (format-time-string - "%Y-%m" - (encode-time 0 0 0 1 (+ mw n) y)))) - (y - (setq ins (number-to-string (+ y n)))))) - (t (error "Cannot shift clocktable block"))) - (when ins - (goto-char b) - (insert ins) - (delete-region (point) (+ (point) (- e b))) - (beginning-of-line 1) - (org-update-dblock) - t))))) + (cond + ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s) + (setq block (match-string 1 s) + shift (if (match-end 2) + (string-to-number (match-string 2 s)) + 0)) + (setq shift (+ shift n)) + (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) + ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) + ;; 1 1 2 3 3 4 4 5 6 6 5 2 + (setq y (string-to-number (match-string 1 s)) + wp (and (match-end 3) (match-string 3 s)) + mw (and (match-end 4) (string-to-number (match-string 4 s))) + d (and (match-end 6) (string-to-number (match-string 6 s)))) + (cond + (d (setq ins (format-time-string + "%Y-%m-%d" + (encode-time 0 0 0 (+ d n) m y)))) + ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) + (require 'cal-iso) + (setq date (calendar-gregorian-from-absolute + (calendar-absolute-from-iso (list (+ mw n) 1 y)))) + (setq ins (format-time-string + "%G-W%V" + (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) + ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0)) + (require 'cal-iso) + ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year + (if (> (+ mw n) 4) + (setq mw 0 + y (+ 1 y)) + ()) + ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year + (if (= (+ mw n) 0) + (setq mw 5 + y (- y 1)) + ()) + (setq date (calendar-gregorian-from-absolute + (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y)))) + (setq ins (format-time-string + (concat (number-to-string y) "-Q" (number-to-string (+ mw n))) + (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) + (mw + (setq ins (format-time-string + "%Y-%m" + (encode-time 0 0 0 1 (+ mw n) y)))) + (y + (setq ins (number-to-string (+ y n)))))) + (t (error "Cannot shift clocktable block"))) + (when ins + (goto-char b) + (insert ins) + (delete-region (point) (+ (point) (- e b))) + (beginning-of-line 1) + (org-update-dblock) + t))))) (defun org-dblock-write:clocktable (params) "Write the standard clocktable." @@ -2082,7 +2214,7 @@ the currently selected interval size." ;; we collect from several files (let* ((files scope) file) - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (while (setq file (pop files)) (with-current-buffer (find-buffer-visiting file) (save-excursion @@ -2091,7 +2223,7 @@ the currently selected interval size." ;; Just from the current file (save-restriction ;; get the right range into the restriction - (org-prepare-agenda-buffers (list (buffer-file-name))) + (org-agenda-prepare-buffers (list (buffer-file-name))) (cond ((not scope)) ; use the restriction as it is now ((eq scope 'file) (widen)) @@ -2150,6 +2282,7 @@ from the dynamic block definition." (ntcol (max 1 (or (plist-get params :tcolumns) 100))) (rm-file-column (plist-get params :one-file-with-archives)) (indent (plist-get params :indent)) + (case-fold-search t) range-text total-time tbl level hlc formula pcol file-time entries entry headline recalc content narrow-cut-p tcol) @@ -2159,192 +2292,196 @@ from the dynamic block definition." (setq level nil indent t narrow (or narrow '40!) ntcol 1)) ;; Some consistency test for parameters - (unless (integerp ntcol) - (setq params (plist-put params :tcolumns (setq ntcol 100)))) - - (when (and narrow (integerp narrow) link) - ;; We cannot have both integer narrow and link - (message - "Using hard narrowing in clocktable to allow for links") - (setq narrow (intern (format "%d!" narrow)))) + (unless (integerp ntcol) + (setq params (plist-put params :tcolumns (setq ntcol 100)))) - (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 (and narrow (integerp narrow) link) + ;; We cannot have both integer narrow and link + (message + "Using hard narrowing in clocktable to allow for links") + (setq narrow (intern (format "%d!" narrow)))) - (when block - ;; Get the range text for the header - (setq range-text (nth 2 (org-clock-special-range block nil t)))) - - ;; Compute the total time - (setq total-time (apply '+ (mapcar 'cadr tables))) - - ;; Now we need to output this tsuff - (goto-char ipos) + (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)))) - ;; Insert the text *before* the actual table - (insert-before-markers - (or header - ;; Format the standard header - (concat - (nth 9 lwords) " [" - (substring - (format-time-string (cdr org-time-stamp-formats)) - 1 -1) - "]" - (if block (concat ", for " range-text ".") "") - "\n\n"))) - - ;; Insert the narrowing line - (when (and narrow (integerp narrow) (not narrow-cut-p)) - (insert-before-markers - "|" ; table line starter - (if multifile "|" "") ; file column, maybe - (if level-p "|" "") ; 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 - - ;; Insert the table header line - (insert-before-markers - "|" ; table line starter - (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe - (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe - (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe - (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe - (concat (nth 4 lwords) "|" - (nth 5 lwords) "|\n")) ; headline and time columns - - ;; Insert the total time in the table + (when block + ;; Get the range text for the header + (setq range-text (nth 2 (org-clock-special-range block nil t)))) + + ;; Compute the total time + (setq total-time (apply '+ (mapcar 'cadr tables))) + + ;; Now we need to output this tsuff + (goto-char ipos) + + ;; Insert the text *before* the actual table + (insert-before-markers + (or header + ;; Format the standard header + (concat + (nth 9 lwords) " [" + (substring + (format-time-string (cdr org-time-stamp-formats)) + 1 -1) + "]" + (if block (concat ", for " range-text ".") "") + "\n\n"))) + + ;; Insert the narrowing line + (when (and narrow (integerp narrow) (not narrow-cut-p)) (insert-before-markers - "|-\n" ; a hline - "|" ; table line starter - (if multifile (concat "| " (nth 6 lwords) " ") "") - ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe + "|" ; table line starter + (if multifile "|" "") ; file column, maybe + (if level-p "|" "") ; level column, maybe + (if timestamp "|" "") ; timestamp column, maybe (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (concat "*" (nth 7 lwords) "*| ") ; instead of a headline - "*" - (org-minutes-to-hh:mm-string (or total-time 0)) ; the time - "*|\n") ; close line - - ;; Now iterate over the tables and insert the data - ;; but only if any time has been collected - (when (and total-time (> total-time 0)) - - (while (setq tbl (pop tables)) - ;; now tbl is the table resulting from one file. - (setq file-time (nth 1 tbl)) - (when (or (and file-time (> file-time 0)) - (not (plist-get params :fileskip0))) - (insert-before-markers "|-\n") ; a hline because a new file starts - ;; First the file time, if we have multiple files - (when multifile - ;; Summarize the time collected from this file - (insert-before-markers - (format (concat "| %s %s | %s%s*" (nth 8 lwords) "* | *%s*|\n") - (file-name-nondirectory (car tbl)) - (if level-p "| " "") ; level column, maybe - (if timestamp "| " "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time - - ;; Get the list of node entries and iterate over it - (setq entries (nth 2 tbl)) - (while (setq entry (pop entries)) - (setq level (car entry) - headline (nth 1 entry) - hlc (if emph (or (cdr (assoc level hlchars)) "") "")) - (when narrow-cut-p - (if (and (string-match (concat "\\`" org-bracket-link-regexp - "\\'") - headline) - (match-end 3)) - (setq headline - (format "[[%s][%s]]" - (match-string 1 headline) - (org-shorten-string (match-string 3 headline) - narrow))) - (setq headline (org-shorten-string headline narrow)))) - (insert-before-markers - "|" ; start the table line - (if multifile "|" "") ; free space for file name column? - (if level-p (format "%d|" (car entry)) "") ; level, maybe - (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe - (if properties - (concat - (mapconcat - (lambda (p) (or (cdr (assoc p (nth 4 entry))) "")) - properties "|") "|") "") ;properties columns, maybe - (if indent (org-clocktable-indent-string level) "") ; indentation - hlc headline hlc "|" ; headline - (make-string (min (1- ntcol) (or (- level 1))) ?|) + (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-p (concat (nth 2 lwords) "|") "") ; level column, maybe + (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe + (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe + (concat (nth 4 lwords) "|" + (nth 5 lwords) "|\n")) ; headline and time columns + + ;; Insert the total time in the table + (insert-before-markers + "|-\n" ; a hline + "|" ; table line starter + (if multifile (concat "| " (nth 6 lwords) " ") "") + ; file column, maybe + (if level-p "|" "") ; level column, maybe + (if timestamp "|" "") ; timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ; properties columns, maybe + (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline + (format org-clock-total-time-cell-format + (org-minutes-to-hh:mm-string (or total-time 0))) ; the time + "|\n") ; close line + + ;; Now iterate over the tables and insert the data + ;; but only if any time has been collected + (when (and total-time (> total-time 0)) + + (while (setq tbl (pop tables)) + ;; now tbl is the table resulting from one file. + (setq file-time (nth 1 tbl)) + (when (or (and file-time (> file-time 0)) + (not (plist-get params :fileskip0))) + (insert-before-markers "|-\n") ; a hline because a new file starts + ;; First the file time, if we have multiple files + (when multifile + ;; Summarize the time collected from this file + (insert-before-markers + (format (concat "| %s %s | %s%s" + (format org-clock-file-time-cell-format (nth 8 lwords)) + " | *%s*|\n") + (file-name-nondirectory (car tbl)) + (if level-p "| " "") ; level column, maybe + (if timestamp "| " "") ; timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ;properties columns, maybe + (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time + + ;; Get the list of node entries and iterate over it + (setq entries (nth 2 tbl)) + (while (setq entry (pop entries)) + (setq level (car entry) + headline (nth 1 entry) + hlc (if emph (or (cdr (assoc level hlchars)) "") "")) + (when narrow-cut-p + (if (and (string-match (concat "\\`" org-bracket-link-regexp + "\\'") + headline) + (match-end 3)) + (setq headline + (format "[[%s][%s]]" + (match-string 1 headline) + (org-shorten-string (match-string 3 headline) + narrow))) + (setq headline (org-shorten-string headline narrow)))) + (insert-before-markers + "|" ; start the table line + (if multifile "|" "") ; free space for file name column? + (if level-p (format "%d|" (car entry)) "") ; level, maybe + (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe + (if properties + (concat + (mapconcat + (lambda (p) (or (cdr (assoc p (nth 4 entry))) "")) + properties "|") "|") "") ;properties columns, maybe + (if indent (org-clocktable-indent-string level) "") ; indentation + hlc headline hlc "|" ; headline + (make-string (min (1- ntcol) (or (- level 1))) ?|) ; empty fields for higher levels - hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time - "|\n" ; close line - ))))) - (backward-delete-char 1) - (if (setq formula (plist-get params :formula)) - (cond - ((eq formula '%) - ;; compute the column where the % numbers need to go - (setq pcol (+ 2 - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0) - (min maxlevel (or ntcol 100)))) - ;; compute the column where the total time is - (setq tcol (+ 2 - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0))) - (insert - (format - "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" - pcol ; the column where the % numbers should go - (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time - tcol ; column of the total time - tcol (1- pcol) ; range of columns where times can be found - )) - (setq recalc t)) - ((stringp formula) - (insert "\n#+TBLFM: " formula) - (setq recalc t)) - (t (error "invalid formula in clocktable"))) - ;; Should we rescue an old formula? - (when (stringp (setq content (plist-get params :content))) - (when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content) - (setq recalc t) - (insert "\n" (match-string 1 (plist-get params :content))) - (beginning-of-line 0)))) - ;; Back to beginning, align the table, recalculate if necessary - (goto-char ipos) - (skip-chars-forward "^|") - (org-table-align) - (when org-hide-emphasis-markers - ;; we need to align a second time - (org-table-align)) - (when recalc - (if (eq formula '%) - (save-excursion - (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) - (org-table-goto-column pcol nil 'force) - (insert "%"))) - (org-table-recalculate 'all)) - (when rm-file-column - ;; The file column is actually not wanted - (forward-char 1) - (org-table-delete-column)) - total-time)) + hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time + "|\n" ; close line + ))))) + ;; When exporting subtrees or regions the region might be + ;; activated, so let's disable ̀delete-active-region' + (let ((delete-active-region nil)) (backward-delete-char 1)) + (if (setq formula (plist-get params :formula)) + (cond + ((eq formula '%) + ;; compute the column where the % numbers need to go + (setq pcol (+ 2 + (if multifile 1 0) + (if level-p 1 0) + (if timestamp 1 0) + (min maxlevel (or ntcol 100)))) + ;; compute the column where the total time is + (setq tcol (+ 2 + (if multifile 1 0) + (if level-p 1 0) + (if timestamp 1 0))) + (insert + (format + "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" + pcol ; the column where the % numbers should go + (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time + tcol ; column of the total time + tcol (1- pcol) ; range of columns where times can be found + )) + (setq recalc t)) + ((stringp formula) + (insert "\n#+TBLFM: " formula) + (setq recalc t)) + (t (error "Invalid formula in clocktable"))) + ;; Should we rescue an old formula? + (when (stringp (setq content (plist-get params :content))) + (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content) + (setq recalc t) + (insert "\n" (match-string 1 (plist-get params :content))) + (beginning-of-line 0)))) + ;; Back to beginning, align the table, recalculate if necessary + (goto-char ipos) + (skip-chars-forward "^|") + (org-table-align) + (when org-hide-emphasis-markers + ;; we need to align a second time + (org-table-align)) + (when recalc + (if (eq formula '%) + (save-excursion + (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) + (org-table-goto-column pcol nil 'force) + (insert "%"))) + (org-table-recalculate 'all)) + (when rm-file-column + ;; The file column is actually not wanted + (forward-char 1) + (org-table-delete-column)) + total-time)) (defun org-clocktable-indent-string (level) (if (= level 1) @@ -2464,7 +2601,9 @@ TIME: The sum of all time spend in this tree, in minutes. This time (org-clock-sum ts te (unless (null matcher) (lambda () - (let ((tags-list (org-get-tags-at))) + (let* ((tags-list (org-get-tags-at)) + (org-scanner-tags tags-list) + (org-trust-scanner-tags t)) (eval matcher))))) (goto-char (point-min)) (setq st t) @@ -2496,13 +2635,13 @@ TIME: The sum of all time spend in this tree, in minutes. This time (cdr (assoc "DEADLINE" props)) (cdr (assoc "TIMESTAMP" props)) (cdr (assoc "TIMESTAMP_IA" props)))) - props (when properties - (remove nil - (mapcar - (lambda (p) - (when (org-entry-get (point) p inherit-property-p) - (cons p (org-entry-get (point) p inherit-property-p)))) - properties)))) + props (when properties + (remove nil + (mapcar + (lambda (p) + (when (org-entry-get (point) p inherit-property-p) + (cons p (org-entry-get (point) p inherit-property-p)))) + properties)))) (when (> time 0) (push (list level hdl tsp time props) tbl)))))) (setq tbl (nreverse tbl)) (list file org-clock-file-total-minutes tbl)))) @@ -2566,7 +2705,7 @@ The details of what will be saved are regulated by the variable (buffer-file-name (org-clocking-buffer)) "\" . " (int-to-string (marker-position org-clock-marker)) "))\n")) - ;; Store clocked task history. Tasks are stored reversed to make + ;; Store clocked task history. Tasks are stored reversed to make ;; reading simpler (when (and (memq org-clock-persist '(t history)) org-clock-history) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index 5cec355d73..e17210b7ff 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -33,9 +33,10 @@ (declare-function org-agenda-redo "org-agenda" ()) (declare-function org-agenda-do-context-action "org-agenda" ()) +(declare-function org-clock-sum-today "org-clock" (&optional headline-filter)) (when (featurep 'xemacs) - (error "Do not load this file into XEmacs, use 'org-colview-xemacs.el'.")) + (error "Do not load this file into XEmacs, use `org-colview-xemacs.el'")) ;;; Column View @@ -149,6 +150,7 @@ This is the compiled version of the format.") "Create a new column overlay and add it to the list." (let ((ov (make-overlay beg end))) (overlay-put ov 'face (or face 'secondary-selection)) + (remove-text-properties 0 (length string) '(face nil) string) (org-overlay-display ov string face) (push ov org-columns-overlays) ov)) @@ -186,17 +188,15 @@ This is the compiled version of the format.") (cons "ITEM" ;; When in a buffer, get the whole line, ;; we'll clean it later… - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (save-match-data - (org-no-properties - (org-remove-tabs - (buffer-substring-no-properties - (point-at-bol) (point-at-eol))))) + (org-remove-tabs + (buffer-substring-no-properties + (point-at-bol) (point-at-eol)))) ;; In agenda, just get the `txt' property - (org-no-properties - (or (org-get-at-bol 'txt) - (buffer-substring - (point) (progn (end-of-line) (point))))))) + (or (org-get-at-bol 'txt) + (buffer-substring-no-properties + (point) (progn (end-of-line) (point)))))) (assoc property props)) width (or (cdr (assoc property org-columns-current-maxwidths)) (nth 2 column) @@ -240,20 +240,20 @@ This is the compiled version of the format.") (save-excursion (goto-char beg) (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later? - ;; Make the rest of the line disappear. - (org-unmodified - (setq ov (org-columns-new-overlay beg (point-at-eol))) - (overlay-put ov 'invisible t) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'intangible t) - (overlay-put ov 'line-prefix "") - (overlay-put ov 'wrap-prefix "") - (push ov org-columns-overlays) - (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) - (overlay-put ov 'keymap org-columns-map) - (push ov org-columns-overlays) - (let ((inhibit-read-only t)) - (put-text-property (max (point-min) (1- (point-at-bol))) + ;; Make the rest of the line disappear. + (org-unmodified + (setq ov (org-columns-new-overlay beg (point-at-eol))) + (overlay-put ov 'invisible t) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'intangible t) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "") + (push ov org-columns-overlays) + (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) + (overlay-put ov 'keymap org-columns-map) + (push ov org-columns-overlays) + (let ((inhibit-read-only t)) + (put-text-property (max (point-min) (1- (point-at-bol))) (min (point-max) (1+ (point-at-eol))) 'read-only "Type `e' to edit property"))))) @@ -304,7 +304,7 @@ for the duration of the command.") (org-set-local 'org-columns-current-widths (nreverse widths)) (setq org-columns-full-header-line-format title) (setq org-columns-previous-hscroll -1) -; (org-columns-hscoll-title) + ; (org-columns-hscoll-title) (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))) (defun org-columns-hscoll-title () @@ -442,8 +442,8 @@ Where possible, use the standard interface for changing this line." (org-edit-headline)))) ((equal key "TODO") (setq eval '(org-with-point-at - pom - (call-interactively 'org-todo)))) + pom + (call-interactively 'org-todo)))) ((equal key "PRIORITY") (setq eval '(org-with-point-at pom (call-interactively 'org-priority)))) @@ -499,7 +499,7 @@ Where possible, use the standard interface for changing this line." (org-columns-eval eval)) (org-columns-display-here))) (org-move-to-column col) - (if (and (eq major-mode 'org-mode) + (if (and (derived-mode-p 'org-mode) (nth 3 (assoc key org-columns-current-fmt-compiled))) (org-columns-update key))))))) @@ -665,27 +665,38 @@ around it." (org-open-link-from-string value arg))) (defun org-columns-get-format-and-top-level () - (let (fmt) + (let ((fmt (org-columns-get-format))) + (org-columns-goto-top-level) + fmt)) + +(defun org-columns-get-format (&optional fmt-string) + (interactive) + (let (fmt-as-property fmt) (when (condition-case nil (org-back-to-heading) (error nil)) - (setq fmt (org-entry-get nil "COLUMNS" t))) - (setq fmt (or fmt org-columns-default-format)) + (setq fmt-as-property (org-entry-get nil "COLUMNS" t))) + (setq fmt (or fmt-string fmt-as-property org-columns-default-format)) (org-set-local 'org-columns-current-fmt fmt) (org-columns-compile-format fmt) - (if (marker-position org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker - org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker (point))) fmt)) -(defun org-columns () - "Turn on column view on an org-mode file." +(defun org-columns-goto-top-level () + (when (condition-case nil (org-back-to-heading) (error nil)) + (org-entry-get nil "COLUMNS" t)) + (if (marker-position org-entry-property-inherited-from) + (move-marker org-columns-top-level-marker org-entry-property-inherited-from) + (move-marker org-columns-top-level-marker (point)))) + +(defun org-columns (&optional columns-fmt-string) + "Turn on column view on an org-mode file. +When COLUMNS-FMT-STRING is non-nil, use it as the column format." (interactive) (org-verify-version 'columns) (org-columns-remove-overlays) (move-marker org-columns-begin-marker (point)) (let ((org-columns-time (time-to-number-of-days (current-time))) beg end fmt cache maxwidths) - (setq fmt (org-columns-get-format-and-top-level)) + (org-columns-goto-top-level) + (setq fmt (org-columns-get-format columns-fmt-string)) (save-excursion (goto-char org-columns-top-level-marker) (setq beg (point)) @@ -700,6 +711,11 @@ around it." (save-restriction (narrow-to-region beg end) (org-clock-sum)))) + (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (org-clock-sum-today)))) (while (re-search-forward org-outline-regexp-bol end t) (if (and org-columns-skip-archived-trees (looking-at (concat ".*:" org-archive-tag ":"))) @@ -1014,7 +1030,7 @@ Don't set this, this is meant for dynamic scoping.") (if (marker-position org-columns-begin-marker) (goto-char org-columns-begin-marker)) (org-columns-remove-overlays) - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (call-interactively 'org-columns) (org-agenda-redo) (call-interactively 'org-agenda-columns))) @@ -1083,6 +1099,14 @@ Don't set this, this is meant for dynamic scoping.") (while l (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) sum)) + ((string-match (concat "\\([0-9.]+\\) *\\(" + (regexp-opt (mapcar 'car org-effort-durations)) + "\\)") s) + (setq s (concat "0:" (org-duration-string-to-minutes s t))) + (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) + (while l + (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) + sum)) ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) (if (equal s "[X]") 1. 0.000001)) ((memq fmt '(estimate)) (org-string-to-estimate s)) @@ -1215,13 +1239,16 @@ PARAMS is a property list of parameters: :vlines When t, make each column a colgroup to enforce vertical lines. :maxlevel When set to a number, don't capture headlines below this level. :skip-empty-rows - When t, skip rows where all specifiers other than ITEM are empty." + When t, skip rows where all specifiers other than ITEM are empty. +:format When non-nil, specify the column view format to use." (let ((pos (move-marker (make-marker) (point))) (hlines (plist-get params :hlines)) (vlines (plist-get params :vlines)) (maxlevel (plist-get params :maxlevel)) (content-lines (org-split-string (plist-get params :content) "\n")) (skip-empty-rows (plist-get params :skip-empty-rows)) + (columns-fmt (plist-get params :format)) + (case-fold-search t) tbl id idpos nfields tmp recalc line id-as-string view-file view-pos) (when (setq id (plist-get params :id)) @@ -1250,7 +1277,7 @@ PARAMS is a property list of parameters: (save-restriction (widen) (goto-char (or view-pos (point))) - (org-columns) + (org-columns columns-fmt) (setq tbl (org-columns-capture-view maxlevel skip-empty-rows)) (setq nfields (length (car tbl))) (org-columns-quit)))) @@ -1287,7 +1314,7 @@ PARAMS is a property list of parameters: (while (setq line (pop content-lines)) (when (string-match "^#" line) (insert "\n" line) - (when (string-match "^[ \t]*#\\+TBLFM" line) + (when (string-match "^[ \t]*#\\+tblfm" line) (setq recalc t)))) (if recalc (progn (goto-char pos) (org-table-recalculate 'all)) @@ -1337,12 +1364,11 @@ and tailing newline characters." (org-columns-remove-overlays) (move-marker org-columns-begin-marker (point)) (let ((org-columns-time (time-to-number-of-days (current-time))) - cache maxwidths m p a d fmt) + cache maxwidths m p a d fmt) (cond ((and (boundp 'org-agenda-overriding-columns-format) org-agenda-overriding-columns-format) - (setq fmt org-agenda-overriding-columns-format) - (org-set-local 'org-agenda-overriding-columns-format fmt)) + (setq fmt org-agenda-overriding-columns-format)) ((setq m (org-get-at-bol 'org-hd-marker)) (setq fmt (or (org-entry-get m "COLUMNS" t) (with-current-buffer (marker-buffer m) @@ -1370,7 +1396,7 @@ and tailing newline characters." (setq p (org-entry-properties m)) (when (or (not (setq a (assoc org-effort-property p))) - (not (string-match "\\S-" (or (cdr a) "")))) + (not (string-match "\\S-" (or (cdr a) "")))) ;; OK, the property is not defined. Use appointment duration? (when (and org-agenda-columns-add-appointments-to-effort-sum (setq d (get-text-property (point) 'duration))) @@ -1397,8 +1423,9 @@ and tailing newline characters." "Summarize the summarizable columns in column view in the agenda. This will add overlays to the date lines, to show the summary for each day." (let* ((fmt (mapcar (lambda (x) - (if (equal (car x) "CLOCKSUM") - (list "CLOCKSUM" (nth 1 x) (nth 2 x) ":" 'add_times + (if (string-match "CLOCKSUM.*" (car x)) + (list (match-string 0 (car x)) + (nth 1 x) (nth 2 x) ":" 'add_times nil '+ nil) x)) org-columns-current-fmt-compiled)) @@ -1485,23 +1512,25 @@ This will add overlays to the date lines, to show the summary for each day." (goto-char (point-min)) (org-columns-get-format-and-top-level) (while (setq fm (pop fmt)) - (if (equal (car fm) "CLOCKSUM") - (org-clock-sum) - (when (and (nth 4 fm) - (setq a (assoc (car fm) - org-columns-current-fmt-compiled)) - (equal (nth 4 a) (nth 4 fm))) - (org-columns-compute (car fm))))))))))) + (cond ((equal (car fm) "CLOCKSUM") + (org-clock-sum)) + ((equal (car fm) "CLOCKSUM_T") + (org-clock-sum-today)) + ((and (nth 4 fm) + (setq a (assoc (car fm) + org-columns-current-fmt-compiled)) + (equal (nth 4 a) (nth 4 fm))) + (org-columns-compute (car fm))))))))))) (defun org-format-time-period (interval) "Convert time in fractional days to days/hours/minutes/seconds." (if (numberp interval) - (let* ((days (floor interval)) - (frac-hours (* 24 (- interval days))) - (hours (floor frac-hours)) - (minutes (floor (* 60 (- frac-hours hours)))) - (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes))))) - (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) + (let* ((days (floor interval)) + (frac-hours (* 24 (- interval days))) + (hours (floor frac-hours)) + (minutes (floor (* 60 (- frac-hours hours)))) + (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes))))) + (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) "")) (defun org-estimate-mean-and-var (v) @@ -1519,10 +1548,10 @@ and variances (respectively) of the individual estimates." (let ((mean 0) (var 0)) (mapc (lambda (e) - (let ((stats (org-estimate-mean-and-var e))) - (setq mean (+ mean (car stats))) - (setq var (+ var (cadr stats))))) - el) + (let ((stats (org-estimate-mean-and-var e))) + (setq mean (+ mean (car stats))) + (setq var (+ var (cadr stats))))) + el) (let ((stdev (sqrt var))) (list (- mean stdev) (+ mean stdev))))) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index ce72e25d99..7604284966 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -34,7 +34,6 @@ (require 'org-macs) -(declare-function find-library-name "find-func" (library)) (declare-function w32-focus-frame "term/w32-win" (frame)) ;; The following constant is for backward compatibility. We do not use @@ -111,6 +110,7 @@ any other entries, and any resulting duplicates will be removed entirely." t)) t))) + ;;;; Emacs/XEmacs compatibility ;; Keys @@ -326,20 +326,8 @@ Works on both Emacs and XEmacs." string) (apply 'propertize string properties))) -(defun org-substring-no-properties (string &optional from to) - (if (featurep 'xemacs) - (org-no-properties (substring string (or from 0) to)) - (substring-no-properties string from to))) - -(defun org-find-library-name (library) - (if (fboundp 'find-library-name) - (file-name-directory (find-library-name library)) - ; XEmacs does not have `find-library-name' - (flet ((find-library-name-helper (filename ignored-codesys) - filename) - (find-library-name (library) - (find-library library nil 'find-library-name-helper))) - (file-name-directory (find-library-name library))))) +(defmacro org-find-library-dir (library) + `(file-name-directory (locate-library ,library))) (defun org-count-lines (s) "How many lines in string S?" @@ -396,7 +384,7 @@ TIME defaults to the current time." (save-match-data (apply 'looking-at args)))) -; XEmacs does not have `looking-back'. + ; XEmacs does not have `looking-back'. (if (fboundp 'looking-back) (defalias 'org-looking-back 'looking-back) (defun org-looking-back (regexp &optional limit greedy) @@ -436,7 +424,7 @@ With two arguments, return floor and remainder of their quotient." (let ((q (floor x y))) (list q (- x (if y (* y q) q))))) -;; `pop-to-buffer-same-window' has been introduced with Emacs 24.1. +;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1. (defun org-pop-to-buffer-same-window (&optional buffer-or-name norecord label) "Pop to buffer specified by BUFFER-OR-NAME in the selected window." @@ -445,6 +433,33 @@ With two arguments, return floor and remainder of their quotient." 'pop-to-buffer-same-window buffer-or-name norecord) (funcall 'switch-to-buffer buffer-or-name norecord))) +;; `condition-case-unless-debug' has been introduced in Emacs 24.1 +;; `condition-case-no-debug' has been introduced in Emacs 23.1 +(defalias 'org-condition-case-unless-debug + (or (and (fboundp 'condition-case-unless-debug) + 'condition-case-unless-debug) + (and (fboundp 'condition-case-no-debug) + 'condition-case-no-debug) + 'condition-case)) + +;;;###autoload +(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"))) + (if (require 'org-version org-version.el 'noerror) + '(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!!")))))) + (provide 'org-compat) ;;; org-compat.el ends here diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index c613ba20e4..a187d2facf 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -75,7 +75,7 @@ (context plain recipients &optional sign always-trust)) (defgroup org-crypt nil - "Org Crypt" + "Org Crypt." :tag "Org Crypt" :group 'org) @@ -111,6 +111,7 @@ nil : Leave auto-save-mode enabled. NOTE: This only works for entries which have a tag that matches `org-crypt-tag-matcher'." :group 'org-crypt + :version "24.1" :type '(choice (const :tag "Always" t) (const :tag "Never" nil) (const :tag "Ask" ask) @@ -129,13 +130,13 @@ See `org-crypt-disable-auto-save'." (eq org-crypt-disable-auto-save t) (and (eq org-crypt-disable-auto-save 'ask) - (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? "))) + (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? "))) (message (concat "org-decrypt: Disabling auto-save-mode for " (or (buffer-file-name) (current-buffer)))) - ; The argument to auto-save-mode has to be "-1", since - ; giving a "nil" argument toggles instead of disabling. + ; The argument to auto-save-mode has to be "-1", since + ; giving a "nil" argument toggles instead of disabling. (auto-save-mode -1)) ((eq org-crypt-disable-auto-save nil) - (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage.")) + (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage.")) ((eq org-crypt-disable-auto-save 'encrypt) (message "org-decrypt: Enabling re-encryption on auto-save.") (add-hook 'auto-save-hook @@ -221,7 +222,7 @@ See `org-crypt-disable-auto-save'." ;; outline property starts at the \n of the heading. (delete-region (1- (point)) end) ;; Store a checksum of the decrypted and the encrypted - ;; text value. This allow to reuse the same encrypted text + ;; text value. This allow to reuse the same encrypted text ;; if the text does not change, and therefore avoid a ;; re-encryption process. (insert "\n" (propertize decrypted-text @@ -251,6 +252,14 @@ See `org-crypt-disable-auto-save'." (cdr (org-make-tags-matcher org-crypt-tag-matcher)) todo-only))) +(defun org-at-encrypted-entry-p () + "Is the current entry encrypted?" + (unless (org-before-first-heading-p) + (save-excursion + (org-back-to-heading t) + (search-forward "-----BEGIN PGP MESSAGE-----" + (save-excursion (org-end-of-subtree t)) t)))) + (defun org-crypt-use-before-save-magic () "Add a hook to automatically encrypt entries before a file is saved to disk." (add-hook diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 48656190a0..a951cf9964 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -26,18 +26,18 @@ ;; Synopsis ;; ======== ;; -;; Allows org-mode to make use of the Emacs `etags' system. Defines tag +;; Allows org-mode to make use of the Emacs `etags' system. Defines tag ;; destinations in org-mode files as any text between <<double angled ;; brackets>>. This allows the tags-generation program `exuberant ctags' to ;; parse these files and create tag tables that record where these -;; destinations are found. Plain [[links]] in org mode files which do not have +;; destinations are found. Plain [[links]] in org mode files which do not have ;; <<matching destinations>> within the same file will then be interpreted as ;; links to these 'tagged' destinations, allowing seamless navigation between -;; multiple org-mode files. Topics can be created in any org mode file and -;; will always be found by plain links from other files. Other file types +;; multiple org-mode files. Topics can be created in any org mode file and +;; will always be found by plain links from other files. Other file types ;; recognized by ctags (source code files, latex files, etc) will also be ;; available as destinations for plain links, and similarly, org-mode links -;; will be available as tags from source files. Finally, the function +;; will be available as tags from source files. Finally, the function ;; `org-ctags-find-tag-interactive' lets you choose any known tag, using ;; autocompletion, and quickly jump to it. ;; @@ -82,25 +82,25 @@ ;; ===== ;; ;; When you click on a link "[[foo]]" and org cannot find a matching "<<foo>>" -;; in the current buffer, the tags facility will take over. The file TAGS in +;; in the current buffer, the tags facility will take over. The file TAGS in ;; the active directory is examined to see if the tags facility knows about -;; "<<foo>>" in any other files. If it does, the matching file will be opened +;; "<<foo>>" in any other files. If it does, the matching file will be opened ;; and the cursor will jump to the position of "<<foo>>" in that file. ;; ;; User-visible functions: ;; - `org-ctags-find-tag-interactive': type a tag (plain link) name and visit -;; it. With autocompletion. Bound to ctrl-O in the above setup. -;; - All the etags functions should work. These include: +;; it. With autocompletion. Bound to ctrl-O in the above setup. +;; - All the etags functions should work. These include: ;; ;; M-. `find-tag' -- finds the tag at point ;; ;; C-M-. find-tag based on regular expression ;; ;; M-x tags-search RET -- like C-M-. but searches through ENTIRE TEXT -;; of ALL the files referenced in the TAGS file. A quick way to +;; of ALL the files referenced in the TAGS file. A quick way to ;; search through an entire 'project'. ;; -;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'. +;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'. ;; You may need to bind this key yourself with (eg) ;; (global-set-key (kbd "<M-kp-multiply>") 'pop-tag-mark) ;; @@ -116,8 +116,8 @@ ;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file. ;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in ;; your `org-open-link-functions' list, as is done in the setup -;; above. This will cause the TAGS file to be rebuilt whenever a link -;; cannot be found. This may be slow with large file collections however. +;; above. This will cause the TAGS file to be rebuilt whenever a link +;; cannot be found. This may be slow with large file collections however. ;; 3. You run the following from the command line (all 1 line): ;; ;; ctags --langdef=orgmode --langmap=orgmode:.org @@ -126,7 +126,7 @@ ;; ;; If you are paranoid, you might want to run (org-ctags-create-tags ;; "/path/to/org/files") at startup, by including the following toplevel form -;; in .emacs. However this can cause a pause of several seconds if ctags has +;; in .emacs. However this can cause a pause of several seconds if ctags has ;; to scan lots of files. ;; ;; (progn @@ -193,6 +193,7 @@ Created as a local variable in each buffer.") The following patterns are replaced in the string: `%t' - replaced with the capitalized title of the hyperlink" :group 'org-ctags + :version "24.1" :type 'string) @@ -247,7 +248,7 @@ buffer position where the tag is found." ((re-search-backward " \n\\(.*\\),[0-9]+\n") (list (match-string 1) line pos)) (t ; can't find a file name preceding the matched - ; tag?? + ; tag?? (error "Malformed TAGS file: %s" (buffer-name)))))) (t ; tag not found nil)))))) @@ -308,7 +309,7 @@ The new topic will be titled NAME (or TITLE if supplied)." activate compile) "Before trying to find a tag, save our current position on org mark ring." (save-excursion - (if (and (eq major-mode 'org-mode) org-ctags-enabled-p) + (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p) (org-mark-ring-push)))) @@ -411,7 +412,7 @@ asked before creating a new file." (defun org-ctags-append-topic (name &optional narrowp) "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Append a new toplevel heading to the end of the current buffer. The +Append a new toplevel heading to the end of the current buffer. The heading contains NAME surrounded by <<angular brackets>>, thus making the heading a destination for the tag `NAME'." (interactive "sTopic: ") @@ -456,12 +457,12 @@ to rebuild (update) the TAGS file." "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. Wrapper for org-ctags-rebuild-tags-file-then-find-tag." (if (and (buffer-file-name) - (y-or-n-p - (format - "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?" - name - (file-name-directory (buffer-file-name))))) - (org-ctags-rebuild-tags-file-then-find-tag name) + (y-or-n-p + (format + "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?" + name + (file-name-directory (buffer-file-name))))) + (org-ctags-rebuild-tags-file-then-find-tag name) nil)) @@ -533,7 +534,7 @@ a new topic." (t ;; New tag (run-hook-with-args-until-success - 'org-open-link-functions tag)))))) + 'org-open-link-functions tag)))))) (org-ctags-enable) diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index 192d1d6e6d..4ff8e7d00d 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -38,6 +38,15 @@ This is normally one, but if the buffer has an entry with a DATE_TREE property (any value), the date tree will become a subtree under that entry, so the base level will be properly adjusted.") +(defcustom org-datetree-add-timestamp nil + "When non-nil, add a time stamp when create a datetree entry." + :group 'org-capture + :version "24.3" + :type '(choice + (const :tag "Do not add a time stamp" nil) + (const :tag "Add an inactive time stamp" inactive) + (const :tag "Add an active time stamp" active))) + ;;;###autoload (defun org-datetree-find-date-create (date &optional keep-restriction) "Find or create an entry for DATE. @@ -63,7 +72,7 @@ tree can be found." (goto-char (prog1 (point) (widen)))))) (defun org-datetree-find-year-create (year) - (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)$") + (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)\\s-*$") match) (goto-char (point-min)) (while (and (setq match (re-search-forward re nil t)) @@ -119,7 +128,7 @@ tree can be found." (org-datetree-insert-line year month day))))) (defun org-datetree-insert-line (year &optional month day) - (let ((pos (point))) + (let ((pos (point)) ts-type) (skip-chars-backward " \t\n") (delete-region (point) pos) (insert "\n" (make-string org-datetree-base-level ?*) " \n") @@ -136,6 +145,10 @@ tree can be found." (insert (format " %s" (format-time-string "%B" (encode-time 0 0 0 1 month year)))))) + (when (and day (setq ts-type org-datetree-add-timestamp)) + (insert "\n") + (org-indent-line) + (org-insert-time-stamp (encode-time 0 0 0 day month year) nil ts-type)) (beginning-of-line 1))) (defun org-datetree-file-entry-under (txt date) @@ -155,42 +168,42 @@ before running this command, even though the command tries to be smart." (let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'")) (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'")) dct ts tmp date year month day pos hdl-pos) - (while (re-search-forward org-ts-regexp nil t) - (catch 'next - (setq ts (match-string 0)) - (setq tmp (buffer-substring - (max (point-at-bol) (- (match-beginning 0) - org-ds-keyword-length)) - (match-beginning 0))) - (if (or (string-match "-\\'" tmp) - (string-match dre tmp) - (string-match sre tmp)) + (while (re-search-forward org-ts-regexp nil t) + (catch 'next + (setq ts (match-string 0)) + (setq tmp (buffer-substring + (max (point-at-bol) (- (match-beginning 0) + org-ds-keyword-length)) + (match-beginning 0))) + (if (or (string-match "-\\'" tmp) + (string-match dre tmp) + (string-match sre tmp)) + (throw 'next nil)) + (setq dct (decode-time (org-time-string-to-time (match-string 0))) + date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)) + year (nth 2 date) + month (car date) + day (nth 1 date) + pos (point)) + (org-back-to-heading t) + (setq hdl-pos (point)) + (unless (org-up-heading-safe) + ;; No parent, we are not in a date tree + (goto-char pos) + (throw 'next nil)) + (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") + ;; Parent looks wrong, we are not in a date tree + (goto-char pos) (throw 'next nil)) - (setq dct (decode-time (org-time-string-to-time (match-string 0))) - date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)) - year (nth 2 date) - month (car date) - day (nth 1 date) - pos (point)) - (org-back-to-heading t) - (setq hdl-pos (point)) - (unless (org-up-heading-safe) - ;; No parent, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") - ;; Parent looks wrong, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) - ;; At correct date already, do nothing + (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) + ;; At correct date already, do nothing (progn (goto-char pos) (throw 'next nil))) - ;; OK, we need to refile this entry - (goto-char hdl-pos) - (org-cut-subtree) - (save-excursion - (save-restriction - (org-datetree-file-entry-under (current-kill 0) date))))))) + ;; OK, we need to refile this entry + (goto-char hdl-pos) + (org-cut-subtree) + (save-excursion + (save-restriction + (org-datetree-file-entry-under (current-kill 0) date))))))) (provide 'org-datetree) diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el index c3fd62c1fe..22cc5a7cda 100644 --- a/lisp/org/org-docbook.el +++ b/lisp/org/org-docbook.el @@ -163,7 +163,7 @@ avoid same set of footnote IDs being used multiple times." "A list of DocBook expressions to convert emphasis fontifiers. Each element of the list is a list of three elements. The first element is the character used as a marker for fontification. -The second element is a formatting string to wrap fontified text with. +The second element is a format string to wrap fontified text with. The third element decides whether to protect converted text from other conversions." :group 'org-export-docbook @@ -295,7 +295,7 @@ then use this command to convert it." (interactive "r") (let (reg docbook buf) (save-window-excursion - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq docbook (org-export-region-as-docbook beg end t 'string)) (setq reg (buffer-substring beg end) @@ -629,7 +629,7 @@ publishing directory." (insert org-export-docbook-doctype)) (insert "<!-- Date: " date " -->\n") (insert (format "<!-- DocBook XML file generated by Org-mode %s Emacs %s -->\n" - org-version emacs-major-version)) + (org-version) emacs-major-version)) (insert org-export-docbook-article-header) (insert (format "\n <title>%s</title> @@ -1018,11 +1018,11 @@ publishing directory." (t ;; This line either is list item or end a list. (when (when (get-text-property 0 'list-item line) - (setq line (org-export-docbook-list-line - line - (get-text-property 0 'list-item line) - (get-text-property 0 'list-struct line) - (get-text-property 0 'list-prevs line))))) + (setq line (org-export-docbook-list-line + line + (get-text-property 0 'list-item line) + (get-text-property 0 'list-struct line) + (get-text-property 0 'list-prevs line))))) ;; Empty lines start a new paragraph. If hand-formatted lists ;; are not fully interpreted, lines starting with "-", "+", "*" @@ -1066,7 +1066,7 @@ publishing directory." (if (eq major-mode (default-value 'major-mode)) (nxml-mode))) - ;; Remove empty paragraphs. Replace them with a newline. + ;; Remove empty paragraphs. Replace them with a newline. (goto-char (point-min)) (while (re-search-forward "[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t) @@ -1355,10 +1355,10 @@ that need to be preserved in later phase of DocBook exporting." (concat replaced line))) (defun org-export-docbook-list-line (line pos struct prevs) - "Insert list syntax in export buffer. Return LINE, maybe modified. + "Insert list syntax in export buffer. Return LINE, maybe modified. POS is the item position or line position the line had before -modifications to buffer. STRUCT is the list structure. PREVS is +modifications to buffer. STRUCT is the list structure. PREVS is the alist of previous items." (let* ((get-type (function diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el new file mode 100644 index 0000000000..3d67ae7892 --- /dev/null +++ b/lisp/org/org-element.el @@ -0,0 +1,4356 @@ +;;; org-element.el --- Parser And Applications for Org syntax + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> +;; Keywords: outlines, hypermedia, calendar, wp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Org syntax can be divided into three categories: "Greater +;; elements", "Elements" and "Objects". +;; +;; Elements are related to the structure of the document. Indeed, all +;; elements are a cover for the document: each position within belongs +;; to at least one element. +;; +;; An element always starts and ends at the beginning of a line. With +;; a few exceptions (namely `babel-call', `clock', `headline', `item', +;; `keyword', `planning', `property-drawer' and `section' types), it +;; can also accept a fixed set of keywords as attributes. Those are +;; called "affiliated keywords" to distinguish them from other +;; keywords, which are full-fledged elements. Almost all affiliated +;; keywords are referenced in `org-element-affiliated-keywords'; the +;; others are export attributes and start with "ATTR_" prefix. +;; +;; Element containing other elements (and only elements) are called +;; greater elements. Concerned types are: `center-block', `drawer', +;; `dynamic-block', `footnote-definition', `headline', `inlinetask', +;; `item', `plain-list', `quote-block', `section' and `special-block'. +;; +;; Other element types are: `babel-call', `clock', `comment', +;; `comment-block', `example-block', `export-block', `fixed-width', +;; `horizontal-rule', `keyword', `latex-environment', `paragraph', +;; `planning', `property-drawer', `quote-section', `src-block', +;; `table', `table-row' and `verse-block'. Among them, `paragraph' +;; and `verse-block' types can contain Org objects and plain text. +;; +;; Objects are related to document's contents. Some of them are +;; recursive. Associated types are of the following: `bold', `code', +;; `entity', `export-snippet', `footnote-reference', +;; `inline-babel-call', `inline-src-block', `italic', +;; `latex-fragment', `line-break', `link', `macro', `radio-target', +;; `statistics-cookie', `strike-through', `subscript', `superscript', +;; `table-cell', `target', `timestamp', `underline' and `verbatim'. +;; +;; Some elements also have special properties whose value can hold +;; objects themselves (i.e. an item tag or an headline name). Such +;; values are called "secondary strings". Any object belongs to +;; either an element or a secondary string. +;; +;; Notwithstanding affiliated keywords, each greater element, element +;; and object has a fixed set of properties attached to it. Among +;; them, four are shared by all types: `:begin' and `:end', which +;; refer to the beginning and ending buffer positions of the +;; considered element or object, `:post-blank', which holds the number +;; of blank lines, or white spaces, at its end and `:parent' which +;; refers to the element or object containing it. Greater elements +;; and elements containing objects will also have `:contents-begin' +;; and `:contents-end' properties to delimit contents. +;; +;; Lisp-wise, an element or an object can be represented as a list. +;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: +;; TYPE is a symbol describing the Org element or object. +;; PROPERTIES is the property list attached to it. See docstring of +;; appropriate parsing function to get an exhaustive +;; list. +;; CONTENTS is a list of elements, objects or raw strings contained +;; in the current element or object, when applicable. +;; +;; An Org buffer is a nested list of such elements and objects, whose +;; type is `org-data' and properties is nil. +;; +;; The first part of this file defines Org syntax, while the second +;; one provide accessors and setters functions. +;; +;; The next part implements a parser and an interpreter for each +;; element and object type in Org syntax. +;; +;; The following part creates a fully recursive buffer parser. It +;; also provides a tool to map a function to elements or objects +;; matching some criteria in the parse tree. Functions of interest +;; are `org-element-parse-buffer', `org-element-map' and, to a lesser +;; extent, `org-element-parse-secondary-string'. +;; +;; The penultimate part is the cradle of an interpreter for the +;; obtained parse tree: `org-element-interpret-data'. +;; +;; The library ends by furnishing `org-element-at-point' function, and +;; a way to give information about document structure around point +;; with `org-element-context'. + + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'org) + + +;;; Definitions And Rules +;; +;; Define elements, greater elements and specify recursive objects, +;; along with the affiliated keywords recognized. Also set up +;; restrictions on recursive objects combinations. +;; +;; These variables really act as a control center for the parsing +;; process. + +(defconst org-element-paragraph-separate + (concat "^\\(?:" + ;; Headlines, inlinetasks. + org-outline-regexp "\\|" + ;; Footnote definitions. + "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|" + "[ \t]*\\(?:" + ;; Empty lines. + "$" "\\|" + ;; Tables (any type). + "\\(?:|\\|\\+-[-+]\\)" "\\|" + ;; Blocks (any type), Babel calls, drawers (any type), + ;; fixed-width areas and keywords. Note: this is only an + ;; indication and need some thorough check. + "[#:]" "\\|" + ;; Horizontal rules. + "-\\{5,\\}[ \t]*$" "\\|" + ;; LaTeX environments. + "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|" + ;; Planning and Clock lines. + (regexp-opt (list org-scheduled-string + org-deadline-string + org-closed-string + org-clock-string)) + "\\|" + ;; Lists. + (let ((term (case org-plain-list-ordered-item-terminator + (?\) ")") (?. "\\.") (otherwise "[.)]"))) + (alpha (and org-alphabetical-lists "\\|[A-Za-z]"))) + (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" + "\\(?:[ \t]\\|$\\)")) + "\\)\\)") + "Regexp to separate paragraphs in an Org buffer. +In the case of lines starting with \"#\" and \":\", this regexp +is not sufficient to know if point is at a paragraph ending. See +`org-element-paragraph-parser' for more information.") + +(defconst org-element-all-elements + '(center-block clock comment comment-block drawer dynamic-block example-block + export-block fixed-width footnote-definition headline + horizontal-rule inlinetask item keyword latex-environment + babel-call paragraph plain-list planning property-drawer + quote-block quote-section section special-block src-block table + table-row verse-block) + "Complete list of element types.") + +(defconst org-element-greater-elements + '(center-block drawer dynamic-block footnote-definition headline inlinetask + item plain-list quote-block section special-block table) + "List of recursive element types aka Greater Elements.") + +(defconst org-element-all-successors + '(export-snippet footnote-reference inline-babel-call inline-src-block + latex-or-entity line-break link macro radio-target + statistics-cookie sub/superscript table-cell target + text-markup timestamp) + "Complete list of successors.") + +(defconst org-element-object-successor-alist + '((subscript . sub/superscript) (superscript . sub/superscript) + (bold . text-markup) (code . text-markup) (italic . text-markup) + (strike-through . text-markup) (underline . text-markup) + (verbatim . text-markup) (entity . latex-or-entity) + (latex-fragment . latex-or-entity)) + "Alist of translations between object type and successor name. + +Sharing the same successor comes handy when, for example, the +regexp matching one object can also match the other object.") + +(defconst org-element-all-objects + '(bold code entity export-snippet footnote-reference inline-babel-call + inline-src-block italic line-break latex-fragment link macro + radio-target statistics-cookie strike-through subscript superscript + table-cell target timestamp underline verbatim) + "Complete list of object types.") + +(defconst org-element-recursive-objects + '(bold italic link macro subscript radio-target strike-through superscript + table-cell underline) + "List of recursive object types.") + +(defconst org-element-block-name-alist + '(("CENTER" . org-element-center-block-parser) + ("COMMENT" . org-element-comment-block-parser) + ("EXAMPLE" . org-element-example-block-parser) + ("QUOTE" . org-element-quote-block-parser) + ("SRC" . org-element-src-block-parser) + ("VERSE" . org-element-verse-block-parser)) + "Alist between block names and the associated parsing function. +Names must be uppercase. Any block whose name has no association +is parsed with `org-element-special-block-parser'.") + +(defconst org-element-affiliated-keywords + '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" + "RESULTS" "SOURCE" "SRCNAME" "TBLNAME") + "List of affiliated keywords as strings. +By default, all keywords setting attributes (i.e. \"ATTR_LATEX\") +are affiliated keywords and need not to be in this list.") + +(defconst org-element--affiliated-re + (format "[ \t]*#\\+%s:" + ;; Regular affiliated keywords. + (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?" + (regexp-opt org-element-affiliated-keywords))) + "Regexp matching any affiliated keyword. + +Keyword name is put in match group 1. Moreover, if keyword +belongs to `org-element-dual-keywords', put the dual value in +match group 2. + +Don't modify it, set `org-element-affiliated-keywords' instead.") + +(defconst org-element-keyword-translation-alist + '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME") + ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME") + ("RESULT" . "RESULTS") ("HEADERS" . "HEADER")) + "Alist of usual translations for keywords. +The key is the old name and the value the new one. The property +holding their value will be named after the translated name.") + +(defconst org-element-multiple-keywords '("HEADER") + "List of affiliated keywords that can occur more that once in an element. + +Their value will be consed into a list of strings, which will be +returned as the value of the property. + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'. + +By default, all keywords setting attributes (i.e. \"ATTR_LATEX\") +allow multiple occurrences and need not to be in this list.") + +(defconst org-element-parsed-keywords '("AUTHOR" "CAPTION" "DATE" "TITLE") + "List of keywords whose value can be parsed. + +Their value will be stored as a secondary string: a list of +strings and objects. + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'.") + +(defconst org-element-dual-keywords '("CAPTION" "RESULTS") + "List of keywords which can have a secondary value. + +In Org syntax, they can be written with optional square brackets +before the colons. For example, results keyword can be +associated to a hash value with the following: + + #+RESULTS[hash-string]: some-source + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'.") + +(defconst org-element-object-restrictions + '((bold export-snippet inline-babel-call inline-src-block latex-or-entity link + radio-target sub/superscript target text-markup timestamp) + (footnote-reference export-snippet footnote-reference inline-babel-call + inline-src-block latex-or-entity line-break link macro + radio-target sub/superscript target text-markup + timestamp) + (headline inline-babel-call inline-src-block latex-or-entity link macro + radio-target statistics-cookie sub/superscript target text-markup + timestamp) + (inlinetask inline-babel-call inline-src-block latex-or-entity link macro + radio-target sub/superscript target text-markup timestamp) + (italic export-snippet inline-babel-call inline-src-block latex-or-entity + link radio-target sub/superscript target text-markup timestamp) + (item export-snippet footnote-reference inline-babel-call latex-or-entity + link macro radio-target sub/superscript target text-markup) + (keyword latex-or-entity macro sub/superscript text-markup) + (link export-snippet inline-babel-call inline-src-block latex-or-entity link + sub/superscript text-markup) + (macro macro) + (paragraph export-snippet footnote-reference inline-babel-call + inline-src-block latex-or-entity line-break link macro + radio-target statistics-cookie sub/superscript target text-markup + timestamp) + (radio-target export-snippet latex-or-entity sub/superscript) + (strike-through export-snippet inline-babel-call inline-src-block + latex-or-entity link radio-target sub/superscript target + text-markup timestamp) + (subscript export-snippet inline-babel-call inline-src-block latex-or-entity + sub/superscript target text-markup) + (superscript export-snippet inline-babel-call inline-src-block + latex-or-entity sub/superscript target text-markup) + (table-cell export-snippet latex-or-entity link macro radio-target + sub/superscript target text-markup timestamp) + (table-row table-cell) + (underline export-snippet inline-babel-call inline-src-block latex-or-entity + link radio-target sub/superscript target text-markup timestamp) + (verse-block footnote-reference inline-babel-call inline-src-block + latex-or-entity line-break link macro radio-target + sub/superscript target text-markup timestamp)) + "Alist of objects restrictions. + +CAR is an element or object type containing objects and CDR is +a list of successors that will be called within an element or +object of such type. + +For example, in a `radio-target' object, one can only find +entities, export snippets, latex-fragments, subscript and +superscript. + +This alist also applies to secondary string. For example, an +`headline' type element doesn't directly contain objects, but +still has an entry since one of its properties (`:title') does.") + +(defconst org-element-secondary-value-alist + '((headline . :title) + (inlinetask . :title) + (item . :tag) + (footnote-reference . :inline-definition)) + "Alist between element types and location of secondary value.") + + + +;;; Accessors and Setters +;; +;; Provide four accessors: `org-element-type', `org-element-property' +;; `org-element-contents' and `org-element-restriction'. +;; +;; Setter functions allow to modify elements by side effect. There is +;; `org-element-put-property', `org-element-set-contents', +;; `org-element-set-element' and `org-element-adopt-element'. Note +;; that `org-element-set-element' and `org-element-adopt-elements' are +;; higher level functions since also update `:parent' property. + +(defsubst org-element-type (element) + "Return type of ELEMENT. + +The function returns the type of the element or object provided. +It can also return the following special value: + `plain-text' for a string + `org-data' for a complete document + nil in any other case." + (cond + ((not (consp element)) (and (stringp element) 'plain-text)) + ((symbolp (car element)) (car element)))) + +(defsubst org-element-property (property element) + "Extract the value from the PROPERTY of an ELEMENT." + (plist-get (nth 1 element) property)) + +(defsubst org-element-contents (element) + "Extract contents from an ELEMENT." + (and (consp element) (nthcdr 2 element))) + +(defsubst org-element-restriction (element) + "Return restriction associated to ELEMENT. +ELEMENT can be an element, an object or a symbol representing an +element or object type." + (cdr (assq (if (symbolp element) element (org-element-type element)) + org-element-object-restrictions))) + +(defsubst org-element-put-property (element property value) + "In ELEMENT set PROPERTY to VALUE. +Return modified element." + (when (consp element) + (setcar (cdr element) (plist-put (nth 1 element) property value))) + element) + +(defsubst org-element-set-contents (element &rest contents) + "Set ELEMENT contents to CONTENTS. +Return modified element." + (cond ((not element) (list contents)) + ((cdr element) (setcdr (cdr element) contents)) + (t (nconc element contents)))) + +(defsubst org-element-set-element (old new) + "Replace element or object OLD with element or object NEW. +The function takes care of setting `:parent' property for NEW." + ;; Since OLD is going to be changed into NEW by side-effect, first + ;; make sure that every element or object within NEW has OLD as + ;; parent. + (mapc (lambda (blob) (org-element-put-property blob :parent old)) + (org-element-contents new)) + ;; Transfer contents. + (apply 'org-element-set-contents old (org-element-contents new)) + ;; Ensure NEW has same parent as OLD, then overwrite OLD properties + ;; with NEW's. + (org-element-put-property new :parent (org-element-property :parent old)) + (setcar (cdr old) (nth 1 new)) + ;; Transfer type. + (setcar old (car new))) + +(defsubst org-element-adopt-elements (parent &rest children) + "Append elements to the contents of another element. + +PARENT is an element or object. CHILDREN can be elements, +objects, or a strings. + +The function takes care of setting `:parent' property for CHILD. +Return parent element." + (if (not parent) children + ;; Link every child to PARENT. + (mapc (lambda (child) + (unless (stringp child) + (org-element-put-property child :parent parent))) + children) + ;; Add CHILDREN at the end of PARENT contents. + (apply 'org-element-set-contents + parent + (nconc (org-element-contents parent) children)) + ;; Return modified PARENT element. + parent)) + + + +;;; Greater elements +;; +;; For each greater element type, we define a parser and an +;; interpreter. +;; +;; A parser returns the element or object as the list described above. +;; Most of them accepts no argument. Though, exceptions exist. Hence +;; every element containing a secondary string (see +;; `org-element-secondary-value-alist') will accept an optional +;; argument to toggle parsing of that secondary string. Moreover, +;; `item' parser requires current list's structure as its first +;; element. +;; +;; An interpreter accepts two arguments: the list representation of +;; the element or object, and its contents. The latter may be nil, +;; depending on the element or object considered. It returns the +;; appropriate Org syntax, as a string. +;; +;; Parsing functions must follow the naming convention: +;; org-element-TYPE-parser, where TYPE is greater element's type, as +;; defined in `org-element-greater-elements'. +;; +;; Similarly, interpreting functions must follow the naming +;; convention: org-element-TYPE-interpreter. +;; +;; With the exception of `headline' and `item' types, greater elements +;; cannot contain other greater elements of their own type. +;; +;; Beside implementing a parser and an interpreter, adding a new +;; greater element requires to tweak `org-element--current-element'. +;; Moreover, the newly defined type must be added to both +;; `org-element-all-elements' and `org-element-greater-elements'. + + +;;;; Center Block + +(defun org-element-center-block-parser (limit) + "Parse a center block. + +LIMIT bounds the search. + +Return a list whose CAR is `center-block' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end' and `:post-blank' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_CENTER" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((block-end-line (match-beginning 0))) + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (save-excursion (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'center-block + (nconc + (list :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords)))))))) + +(defun org-element-center-block-interpreter (center-block contents) + "Interpret CENTER-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents)) + + +;;;; Drawer + +(defun org-element-drawer-parser (limit) + "Parse a drawer. + +LIMIT bounds the search. + +Return a list whose CAR is `drawer' and CDR is a plist containing +`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end' and `:post-blank' keywords. + +Assume point is at beginning of drawer." + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward "^[ \t]*:END:" limit t))) + ;; Incomplete drawer: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((drawer-end-line (match-beginning 0))) + (save-excursion + (let* ((case-fold-search t) + (name (progn (looking-at org-drawer-regexp) + (org-match-string-no-properties 1))) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty drawers have no contents. + (contents-begin (progn (forward-line) + (and (< (point) drawer-end-line) + (point)))) + (contents-end (and contents-begin drawer-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char drawer-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'drawer + (nconc + (list :begin begin + :end end + :drawer-name name + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-drawer-interpreter (drawer contents) + "Interpret DRAWER element as Org syntax. +CONTENTS is the contents of the element." + (format ":%s:\n%s:END:" + (org-element-property :drawer-name drawer) + contents)) + + +;;;; Dynamic Block + +(defun org-element-dynamic-block-parser (limit) + "Parse a dynamic block. + +LIMIT bounds the search. + +Return a list whose CAR is `dynamic-block' and CDR is a plist +containing `:block-name', `:begin', `:end', `:hiddenp', +`:contents-begin', `:contents-end', `:arguments' and +`:post-blank' keywords. + +Assume point is at beginning of dynamic block." + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward org-dblock-end-re limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((name (progn (looking-at org-dblock-start-re) + (org-match-string-no-properties 1))) + (arguments (org-match-string-no-properties 3)) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'dynamic-block + (nconc + (list :begin begin + :end end + :block-name name + :arguments arguments + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-dynamic-block-interpreter (dynamic-block contents) + "Interpret DYNAMIC-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (format "#+BEGIN: %s%s\n%s#+END:" + (org-element-property :block-name dynamic-block) + (let ((args (org-element-property :arguments dynamic-block))) + (and args (concat " " args))) + contents)) + + +;;;; Footnote Definition + +(defun org-element-footnote-definition-parser (limit) + "Parse a footnote definition. + +LIMIT bounds the search. + +Return a list whose CAR is `footnote-definition' and CDR is +a plist containing `:label', `:begin' `:end', `:contents-begin', +`:contents-end' and `:post-blank' keywords. + +Assume point is at the beginning of the footnote definition." + (save-excursion + (let* ((label (progn (looking-at org-footnote-definition-re) + (org-match-string-no-properties 1))) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (ending (save-excursion + (if (progn + (end-of-line) + (re-search-forward + (concat org-outline-regexp-bol "\\|" + org-footnote-definition-re "\\|" + "^[ \t]*$") limit 'move)) + (match-beginning 0) + (point)))) + (contents-begin (progn (search-forward "]") + (skip-chars-forward " \r\t\n" ending) + (and (/= (point) ending) (point)))) + (contents-end (and contents-begin ending)) + (end (progn (goto-char ending) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'footnote-definition + (nconc + (list :label label + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines ending end)) + (cadr keywords)))))) + +(defun org-element-footnote-definition-interpreter (footnote-definition contents) + "Interpret FOOTNOTE-DEFINITION element as Org syntax. +CONTENTS is the contents of the footnote-definition." + (concat (format "[%s]" (org-element-property :label footnote-definition)) + " " + contents)) + + +;;;; Headline + +(defun org-element-headline-parser (limit &optional raw-secondary-p) + "Parse an headline. + +Return a list whose CAR is `headline' and CDR is a plist +containing `:raw-value', `:title', `:begin', `:end', +`:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end', +`:level', `:priority', `:tags', `:todo-keyword',`:todo-type', +`:scheduled', `:deadline', `:timestamp', `:clock', `:category', +`:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p' +keywords. + +The plist also contains any property set in the property drawer, +with its name in lowercase, the underscores replaced with hyphens +and colons at the beginning (i.e. `:custom-id'). + +When RAW-SECONDARY-P is non-nil, headline's title will not be +parsed as a secondary string, but as a plain string instead. + +Assume point is at beginning of the headline." + (save-excursion + (let* ((components (org-heading-components)) + (level (nth 1 components)) + (todo (nth 2 components)) + (todo-type + (and todo (if (member todo org-done-keywords) 'done 'todo))) + (tags (let ((raw-tags (nth 5 components))) + (and raw-tags (org-split-string raw-tags ":")))) + (raw-value (or (nth 4 components) "")) + (quotedp + (let ((case-fold-search nil)) + (string-match (format "^%s\\( \\|$\\)" org-quote-string) + raw-value))) + (commentedp + (let ((case-fold-search nil)) + (string-match (format "^%s\\( \\|$\\)" org-comment-string) + raw-value))) + (archivedp (member org-archive-tag tags)) + (footnote-section-p (and org-footnote-section + (string= org-footnote-section raw-value))) + ;; Normalize property names: ":SOME_PROP:" becomes + ;; ":some-prop". + (standard-props (let (plist) + (mapc + (lambda (p) + (let ((p-name (downcase (car p)))) + (while (string-match "_" p-name) + (setq p-name + (replace-match "-" nil nil p-name))) + (setq p-name (intern (concat ":" p-name))) + (setq plist + (plist-put plist p-name (cdr p))))) + (org-entry-properties nil 'standard)) + plist)) + (time-props (org-entry-properties nil 'special "CLOCK")) + (scheduled (cdr (assoc "SCHEDULED" time-props))) + (deadline (cdr (assoc "DEADLINE" time-props))) + (clock (cdr (assoc "CLOCK" time-props))) + (timestamp (cdr (assoc "TIMESTAMP" time-props))) + (begin (point)) + (end (save-excursion (goto-char (org-end-of-subtree t t)))) + (pos-after-head (progn (forward-line) (point))) + (contents-begin (save-excursion + (skip-chars-forward " \r\t\n" end) + (and (/= (point) end) (line-beginning-position)))) + (hidden (org-invisible-p2)) + (contents-end (and contents-begin + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))))) + ;; Clean RAW-VALUE from any quote or comment string. + (when (or quotedp commentedp) + (let ((case-fold-search nil)) + (setq raw-value + (replace-regexp-in-string + (concat + (regexp-opt (list org-quote-string org-comment-string)) + "\\(?: \\|$\\)") + "" + raw-value)))) + ;; Clean TAGS from archive tag, if any. + (when archivedp (setq tags (delete org-archive-tag tags))) + (let ((headline + (list 'headline + (nconc + (list :raw-value raw-value + :begin begin + :end end + :pre-blank + (if (not contents-begin) 0 + (count-lines pos-after-head contents-begin)) + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :level level + :priority (nth 3 components) + :tags tags + :todo-keyword todo + :todo-type todo-type + :scheduled scheduled + :deadline deadline + :timestamp timestamp + :clock clock + :post-blank (count-lines + (if (not contents-end) pos-after-head + (goto-char contents-end) + (forward-line) + (point)) + end) + :footnote-section-p footnote-section-p + :archivedp archivedp + :commentedp commentedp + :quotedp quotedp) + standard-props)))) + (org-element-put-property + headline :title + (if raw-secondary-p raw-value + (org-element-parse-secondary-string + raw-value (org-element-restriction 'headline) headline))))))) + +(defun org-element-headline-interpreter (headline contents) + "Interpret HEADLINE element as Org syntax. +CONTENTS is the contents of the element." + (let* ((level (org-element-property :level headline)) + (todo (org-element-property :todo-keyword headline)) + (priority (org-element-property :priority headline)) + (title (org-element-interpret-data + (org-element-property :title headline))) + (tags (let ((tag-list (if (org-element-property :archivedp headline) + (cons org-archive-tag + (org-element-property :tags headline)) + (org-element-property :tags headline)))) + (and tag-list + (format ":%s:" (mapconcat 'identity tag-list ":"))))) + (commentedp (org-element-property :commentedp headline)) + (quotedp (org-element-property :quotedp headline)) + (pre-blank (or (org-element-property :pre-blank headline) 0)) + (heading (concat (make-string level ?*) + (and todo (concat " " todo)) + (and quotedp (concat " " org-quote-string)) + (and commentedp (concat " " org-comment-string)) + (and priority + (format " [#%s]" (char-to-string priority))) + (cond ((and org-footnote-section + (org-element-property + :footnote-section-p headline)) + (concat " " org-footnote-section)) + (title (concat " " title)))))) + (concat heading + ;; Align tags. + (when tags + (cond + ((zerop org-tags-column) (format " %s" tags)) + ((< org-tags-column 0) + (concat + (make-string + (max (- (+ org-tags-column (length heading) (length tags))) 1) + ? ) + tags)) + (t + (concat + (make-string (max (- org-tags-column (length heading)) 1) ? ) + tags)))) + (make-string (1+ pre-blank) 10) + contents))) + + +;;;; Inlinetask + +(defun org-element-inlinetask-parser (limit &optional raw-secondary-p) + "Parse an inline task. + +Return a list whose CAR is `inlinetask' and CDR is a plist +containing `:title', `:begin', `:end', `:hiddenp', +`:contents-begin' and `:contents-end', `:level', `:priority', +`:raw-value', `:tags', `:todo-keyword', `:todo-type', +`:scheduled', `:deadline', `:timestamp', `:clock' and +`:post-blank' keywords. + +The plist also contains any property set in the property drawer, +with its name in lowercase, the underscores replaced with hyphens +and colons at the beginning (i.e. `:custom-id'). + +When optional argument RAW-SECONDARY-P is non-nil, inline-task's +title will not be parsed as a secondary string, but as a plain +string instead. + +Assume point is at beginning of the inline task." + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (components (org-heading-components)) + (todo (nth 2 components)) + (todo-type (and todo + (if (member todo org-done-keywords) 'done 'todo))) + (tags (let ((raw-tags (nth 5 components))) + (and raw-tags (org-split-string raw-tags ":")))) + (raw-value (or (nth 4 components) "")) + ;; Normalize property names: ":SOME_PROP:" becomes + ;; ":some-prop". + (standard-props (let (plist) + (mapc + (lambda (p) + (let ((p-name (downcase (car p)))) + (while (string-match "_" p-name) + (setq p-name + (replace-match "-" nil nil p-name))) + (setq p-name (intern (concat ":" p-name))) + (setq plist + (plist-put plist p-name (cdr p))))) + (org-entry-properties nil 'standard)) + plist)) + (time-props (org-entry-properties nil 'special "CLOCK")) + (scheduled (cdr (assoc "SCHEDULED" time-props))) + (deadline (cdr (assoc "DEADLINE" time-props))) + (clock (cdr (assoc "CLOCK" time-props))) + (timestamp (cdr (assoc "TIMESTAMP" time-props))) + (task-end (save-excursion + (end-of-line) + (and (re-search-forward "^\\*+ END" limit t) + (match-beginning 0)))) + (contents-begin (progn (forward-line) + (and task-end (< (point) task-end) (point)))) + (hidden (and contents-begin (org-invisible-p2))) + (contents-end (and contents-begin task-end)) + (before-blank (if (not task-end) (point) + (goto-char task-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol)))) + (inlinetask + (list 'inlinetask + (nconc + (list :raw-value raw-value + :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :level (nth 1 components) + :priority (nth 3 components) + :tags tags + :todo-keyword todo + :todo-type todo-type + :scheduled scheduled + :deadline deadline + :timestamp timestamp + :clock clock + :post-blank (count-lines before-blank end)) + standard-props + (cadr keywords))))) + (org-element-put-property + inlinetask :title + (if raw-secondary-p raw-value + (org-element-parse-secondary-string + raw-value + (org-element-restriction 'inlinetask) + inlinetask)))))) + +(defun org-element-inlinetask-interpreter (inlinetask contents) + "Interpret INLINETASK element as Org syntax. +CONTENTS is the contents of inlinetask." + (let* ((level (org-element-property :level inlinetask)) + (todo (org-element-property :todo-keyword inlinetask)) + (priority (org-element-property :priority inlinetask)) + (title (org-element-interpret-data + (org-element-property :title inlinetask))) + (tags (let ((tag-list (org-element-property :tags inlinetask))) + (and tag-list + (format ":%s:" (mapconcat 'identity tag-list ":"))))) + (task (concat (make-string level ?*) + (and todo (concat " " todo)) + (and priority + (format " [#%s]" (char-to-string priority))) + (and title (concat " " title))))) + (concat task + ;; Align tags. + (when tags + (cond + ((zerop org-tags-column) (format " %s" tags)) + ((< org-tags-column 0) + (concat + (make-string + (max (- (+ org-tags-column (length task) (length tags))) 1) + ? ) + tags)) + (t + (concat + (make-string (max (- org-tags-column (length task)) 1) ? ) + tags)))) + ;; Prefer degenerate inlinetasks when there are no + ;; contents. + (when contents + (concat "\n" + contents + (make-string level ?*) " END"))))) + + +;;;; Item + +(defun org-element-item-parser (limit struct &optional raw-secondary-p) + "Parse an item. + +STRUCT is the structure of the plain list. + +Return a list whose CAR is `item' and CDR is a plist containing +`:bullet', `:begin', `:end', `:contents-begin', `:contents-end', +`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and +`:post-blank' keywords. + +When optional argument RAW-SECONDARY-P is non-nil, item's tag, if +any, will not be parsed as a secondary string, but as a plain +string instead. + +Assume point is at the beginning of the item." + (save-excursion + (beginning-of-line) + (looking-at org-list-full-item-re) + (let* ((begin (point)) + (bullet (org-match-string-no-properties 1)) + (checkbox (let ((box (org-match-string-no-properties 3))) + (cond ((equal "[ ]" box) 'off) + ((equal "[X]" box) 'on) + ((equal "[-]" box) 'trans)))) + (counter (let ((c (org-match-string-no-properties 2))) + (save-match-data + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string 0 c))))))) + (end (save-excursion (goto-char (org-list-get-item-end begin struct)) + (unless (bolp) (forward-line)) + (point))) + (contents-begin + (progn (goto-char + ;; Ignore tags in un-ordered lists: they are just + ;; a part of item's body. + (if (and (match-beginning 4) + (save-match-data (string-match "[.)]" bullet))) + (match-beginning 4) + (match-end 0))) + (skip-chars-forward " \r\t\n" limit) + ;; If first line isn't empty, contents really start + ;; at the text after item's meta-data. + (if (= (point-at-bol) begin) (point) (point-at-bol)))) + (hidden (progn (forward-line) + (and (not (= (point) end)) (org-invisible-p2)))) + (contents-end (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + (item + (list 'item + (list :bullet bullet + :begin begin + :end end + ;; CONTENTS-BEGIN and CONTENTS-END may be + ;; mixed up in the case of an empty item + ;; separated from the next by a blank line. + ;; Thus ensure the former is always the + ;; smallest. + :contents-begin (min contents-begin contents-end) + :contents-end (max contents-begin contents-end) + :checkbox checkbox + :counter counter + :hiddenp hidden + :structure struct + :post-blank (count-lines contents-end end))))) + (org-element-put-property + item :tag + (let ((raw-tag (org-list-get-tag begin struct))) + (and raw-tag + (if raw-secondary-p raw-tag + (org-element-parse-secondary-string + raw-tag (org-element-restriction 'item) item)))))))) + +(defun org-element-item-interpreter (item contents) + "Interpret ITEM element as Org syntax. +CONTENTS is the contents of the element." + (let* ((bullet (org-list-bullet-string (org-element-property :bullet item))) + (checkbox (org-element-property :checkbox item)) + (counter (org-element-property :counter item)) + (tag (let ((tag (org-element-property :tag item))) + (and tag (org-element-interpret-data tag)))) + ;; Compute indentation. + (ind (make-string (length bullet) 32)) + (item-starts-with-par-p + (eq (org-element-type (car (org-element-contents item))) + 'paragraph))) + ;; Indent contents. + (concat + bullet + (and counter (format "[@%d] " counter)) + (case checkbox + (on "[X] ") + (off "[ ] ") + (trans "[-] ")) + (and tag (format "%s :: " tag)) + (let ((contents (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))) + (if item-starts-with-par-p (org-trim contents) + (concat "\n" contents)))))) + + +;;;; Plain List + +(defun org-element-plain-list-parser (limit &optional structure) + "Parse a plain list. + +Optional argument STRUCTURE, when non-nil, is the structure of +the plain list being parsed. + +Return a list whose CAR is `plain-list' and CDR is a plist +containing `:type', `:begin', `:end', `:contents-begin' and +`:contents-end', `:structure' and `:post-blank' keywords. + +Assume point is at the beginning of the list." + (save-excursion + (let* ((struct (or structure (org-list-struct))) + (prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct)) + (type (org-list-get-list-type (point) struct prevs)) + (contents-begin (point)) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (contents-end + (progn (goto-char (org-list-get-list-end (point) struct prevs)) + (unless (bolp) (forward-line)) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + ;; Return value. + (list 'plain-list + (nconc + (list :type type + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :structure struct + :post-blank (count-lines contents-end end)) + (cadr keywords)))))) + +(defun org-element-plain-list-interpreter (plain-list contents) + "Interpret PLAIN-LIST element as Org syntax. +CONTENTS is the contents of the element." + (with-temp-buffer + (insert contents) + (goto-char (point-min)) + (org-list-repair) + (buffer-string))) + + +;;;; Quote Block + +(defun org-element-quote-block-parser (limit) + "Parse a quote block. + +LIMIT bounds the search. + +Return a list whose CAR is `quote-block' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end' and `:post-blank' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_QUOTE" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'quote-block + (nconc + (list :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-quote-block-interpreter (quote-block contents) + "Interpret QUOTE-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents)) + + +;;;; Section + +(defun org-element-section-parser (limit) + "Parse a section. + +LIMIT bounds the search. + +Return a list whose CAR is `section' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `contents-end' +and `:post-blank' keywords." + (save-excursion + ;; Beginning of section is the beginning of the first non-blank + ;; line after previous headline. + (let ((begin (point)) + (end (progn (org-with-limited-levels (outline-next-heading)) + (point))) + (pos-before-blank (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point)))) + (list 'section + (list :begin begin + :end end + :contents-begin begin + :contents-end pos-before-blank + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-section-interpreter (section contents) + "Interpret SECTION element as Org syntax. +CONTENTS is the contents of the element." + contents) + + +;;;; Special Block + +(defun org-element-special-block-parser (limit) + "Parse a special block. + +LIMIT bounds the search. + +Return a list whose CAR is `special-block' and CDR is a plist +containing `:type', `:begin', `:end', `:hiddenp', +`:contents-begin', `:contents-end' and `:post-blank' keywords. + +Assume point is at the beginning of the block." + (let* ((case-fold-search t) + (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(S-+\\)") + (upcase (match-string-no-properties 1))))) + (if (not (save-excursion + (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) + (list 'special-block + (nconc + (list :type type + :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-special-block-interpreter (special-block contents) + "Interpret SPECIAL-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (let ((block-type (org-element-property :type special-block))) + (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type))) + + + +;;; Elements +;; +;; For each element, a parser and an interpreter are also defined. +;; Both follow the same naming convention used for greater elements. +;; +;; Also, as for greater elements, adding a new element type is done +;; through the following steps: implement a parser and an interpreter, +;; tweak `org-element--current-element' so that it recognizes the new +;; type and add that new type to `org-element-all-elements'. +;; +;; As a special case, when the newly defined type is a block type, +;; `org-element-block-name-alist' has to be modified accordingly. + + +;;;; Babel Call + +(defun org-element-babel-call-parser (limit) + "Parse a babel call. + +LIMIT bounds the search. + +Return a list whose CAR is `babel-call' and CDR is a plist +containing `:begin', `:end', `:info' and `:post-blank' as +keywords." + (save-excursion + (let ((case-fold-search t) + (info (progn (looking-at org-babel-block-lob-one-liner-regexp) + (org-babel-lob-get-info))) + (begin (point-at-bol)) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'babel-call + (list :begin begin + :end end + :info info + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-babel-call-interpreter (babel-call contents) + "Interpret BABEL-CALL element as Org syntax. +CONTENTS is nil." + (let* ((babel-info (org-element-property :info babel-call)) + (main (car babel-info)) + (post-options (nth 1 babel-info))) + (concat "#+CALL: " + (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main + ;; Remove redundant square brackets. + (replace-match (match-string 1 main) nil nil main)) + (and post-options (format "[%s]" post-options))))) + + +;;;; Clock + +(defun org-element-clock-parser (limit) + "Parse a clock. + +LIMIT bounds the search. + +Return a list whose CAR is `clock' and CDR is a plist containing +`:status', `:value', `:time', `:begin', `:end' and `:post-blank' +as keywords." + (save-excursion + (let* ((case-fold-search nil) + (begin (point)) + (value (progn (search-forward org-clock-string (line-end-position) t) + (org-skip-whitespace) + (looking-at "\\[.*\\]") + (org-match-string-no-properties 0))) + (time (and (progn (goto-char (match-end 0)) + (looking-at " +=> +\\(\\S-+\\)[ \t]*$")) + (org-match-string-no-properties 1))) + (status (if time 'closed 'running)) + (post-blank (let ((before-blank (progn (forward-line) (point)))) + (skip-chars-forward " \r\t\n" limit) + (unless (eobp) (beginning-of-line)) + (count-lines before-blank (point)))) + (end (point))) + (list 'clock + (list :status status + :value value + :time time + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-clock-interpreter (clock contents) + "Interpret CLOCK element as Org syntax. +CONTENTS is nil." + (concat org-clock-string " " + (org-element-property :value clock) + (let ((time (org-element-property :time clock))) + (and time + (concat " => " + (apply 'format + "%2s:%02s" + (org-split-string time ":"))))))) + + +;;;; Comment + +(defun org-element-comment-parser (limit) + "Parse a comment. + +LIMIT bounds the search. + +Return a list whose CAR is `comment' and CDR is a plist +containing `:begin', `:end', `:value' and `:post-blank' +keywords. + +Assume point is at comment beginning." + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (value (prog2 (looking-at "[ \t]*# ?") + (buffer-substring-no-properties + (match-end 0) (line-end-position)) + (forward-line))) + (com-end + ;; Get comments ending. + (progn + (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)")) + ;; Accumulate lines without leading hash and first + ;; whitespace. + (setq value + (concat value + "\n" + (buffer-substring-no-properties + (match-end 0) (line-end-position)))) + (forward-line)) + (point))) + (end (progn (goto-char com-end) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'comment + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines com-end end)) + (cadr keywords)))))) + +(defun org-element-comment-interpreter (comment contents) + "Interpret COMMENT element as Org syntax. +CONTENTS is nil." + (replace-regexp-in-string "^" "# " (org-element-property :value comment))) + + +;;;; Comment Block + +(defun org-element-comment-block-parser (limit) + "Parse an export block. + +LIMIT bounds the search. + +Return a list whose CAR is `comment-block' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:value' and +`:post-blank' keywords. + +Assume point is at comment block beginning." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_COMMENT" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol)))) + (value (buffer-substring-no-properties + contents-begin contents-end))) + (list 'comment-block + (nconc + (list :begin begin + :end end + :value value + :hiddenp hidden + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-comment-block-interpreter (comment-block contents) + "Interpret COMMENT-BLOCK element as Org syntax. +CONTENTS is nil." + (format "#+BEGIN_COMMENT\n%s#+END_COMMENT" + (org-remove-indentation (org-element-property :value comment-block)))) + + +;;;; Example Block + +(defun org-element-example-block-parser (limit) + "Parse an example block. + +LIMIT bounds the search. + +Return a list whose CAR is `example-block' and CDR is a plist +containing `:begin', `:end', `:number-lines', `:preserve-indent', +`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp', +`:switches', `:value' and `:post-blank' keywords." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_EXAMPLE" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((switches + (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") + (org-match-string-no-properties 1))) + ;; Switches analysis + (number-lines (cond ((not switches) nil) + ((string-match "-n\\>" switches) 'new) + ((string-match "+n\\>" switches) 'continued))) + (preserve-indent (and switches (string-match "-i\\>" switches))) + ;; Should labels be retained in (or stripped from) example + ;; blocks? + (retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches)))) + ;; What should code-references use - labels or + ;; line-numbers? + (use-labels + (or (not switches) + (and retain-labels (not (string-match "-k\\>" switches))))) + (label-fmt (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches))) + ;; Standard block parsing. + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (value (buffer-substring-no-properties contents-begin contents-end)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'example-block + (nconc + (list :begin begin + :end end + :value value + :switches switches + :number-lines number-lines + :preserve-indent preserve-indent + :retain-labels retain-labels + :use-labels use-labels + :label-fmt label-fmt + :hiddenp hidden + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-example-block-interpreter (example-block contents) + "Interpret EXAMPLE-BLOCK element as Org syntax. +CONTENTS is nil." + (let ((switches (org-element-property :switches example-block))) + (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n" + (org-remove-indentation + (org-element-property :value example-block)) + "#+END_EXAMPLE"))) + + +;;;; Export Block + +(defun org-element-export-block-parser (limit) + "Parse an export block. + +LIMIT bounds the search. + +Return a list whose CAR is `export-block' and CDR is a plist +containing `:begin', `:end', `:type', `:hiddenp', `:value' and +`:post-blank' keywords. + +Assume point is at export-block beginning." + (let* ((case-fold-search t) + (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") + (upcase (org-match-string-no-properties 1))))) + (if (not (save-excursion + (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol)))) + (value (buffer-substring-no-properties contents-begin + contents-end))) + (list 'export-block + (nconc + (list :begin begin + :end end + :type type + :value value + :hiddenp hidden + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-export-block-interpreter (export-block contents) + "Interpret EXPORT-BLOCK element as Org syntax. +CONTENTS is nil." + (let ((type (org-element-property :type export-block))) + (concat (format "#+BEGIN_%s\n" type) + (org-element-property :value export-block) + (format "#+END_%s" type)))) + + +;;;; Fixed-width + +(defun org-element-fixed-width-parser (limit) + "Parse a fixed-width section. + +LIMIT bounds the search. + +Return a list whose CAR is `fixed-width' and CDR is a plist +containing `:begin', `:end', `:value' and `:post-blank' keywords. + +Assume point is at the beginning of the fixed-width area." + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + value + (end-area + (progn + (while (and (< (point) limit) + (looking-at "[ \t]*:\\( \\|$\\)")) + ;; Accumulate text without starting colons. + (setq value + (concat value + (buffer-substring-no-properties + (match-end 0) (point-at-eol)) + "\n")) + (forward-line)) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'fixed-width + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines end-area end)) + (cadr keywords)))))) + +(defun org-element-fixed-width-interpreter (fixed-width contents) + "Interpret FIXED-WIDTH element as Org syntax. +CONTENTS is nil." + (replace-regexp-in-string + "^" ": " (substring (org-element-property :value fixed-width) 0 -1))) + + +;;;; Horizontal Rule + +(defun org-element-horizontal-rule-parser (limit) + "Parse an horizontal rule. + +LIMIT bounds the search. + +Return a list whose CAR is `horizontal-rule' and CDR is a plist +containing `:begin', `:end' and `:post-blank' keywords." + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (post-hr (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'horizontal-rule + (nconc + (list :begin begin + :end end + :post-blank (count-lines post-hr end)) + (cadr keywords)))))) + +(defun org-element-horizontal-rule-interpreter (horizontal-rule contents) + "Interpret HORIZONTAL-RULE element as Org syntax. +CONTENTS is nil." + "-----") + + +;;;; Keyword + +(defun org-element-keyword-parser (limit) + "Parse a keyword at point. + +LIMIT bounds the search. + +Return a list whose CAR is `keyword' and CDR is a plist +containing `:key', `:value', `:begin', `:end' and `:post-blank' +keywords." + (save-excursion + (let* ((case-fold-search t) + (begin (point)) + (key (progn (looking-at "[ \t]*#\\+\\(\\S-+\\):") + (upcase (org-match-string-no-properties 1)))) + (value (org-trim (buffer-substring-no-properties + (match-end 0) (point-at-eol)))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'keyword + (list :key key + :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-keyword-interpreter (keyword contents) + "Interpret KEYWORD element as Org syntax. +CONTENTS is nil." + (format "#+%s: %s" + (org-element-property :key keyword) + (org-element-property :value keyword))) + + +;;;; Latex Environment + +(defun org-element-latex-environment-parser (limit) + "Parse a LaTeX environment. + +LIMIT bounds the search. + +Return a list whose CAR is `latex-environment' and CDR is a plist +containing `:begin', `:end', `:value' and `:post-blank' +keywords. + +Assume point is at the beginning of the latex environment." + (save-excursion + (let* ((case-fold-search t) + (code-begin (point)) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (env (progn (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") + (regexp-quote (match-string 1)))) + (code-end + (progn (re-search-forward (format "^[ \t]*\\\\end{%s}" env) limit t) + (forward-line) + (point))) + (value (buffer-substring-no-properties code-begin code-end)) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'latex-environment + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines code-end end)) + (cadr keywords)))))) + +(defun org-element-latex-environment-interpreter (latex-environment contents) + "Interpret LATEX-ENVIRONMENT element as Org syntax. +CONTENTS is nil." + (org-element-property :value latex-environment)) + + +;;;; Paragraph + +(defun org-element-paragraph-parser (limit) + "Parse a paragraph. + +LIMIT bounds the search. + +Return a list whose CAR is `paragraph' and CDR is a plist +containing `:begin', `:end', `:contents-begin' and +`:contents-end' and `:post-blank' keywords. + +Assume point is at the beginning of the paragraph." + (save-excursion + (let* (;; INNER-PAR-P is non-nil when paragraph is at the + ;; beginning of an item or a footnote reference. In that + ;; case, we mustn't look for affiliated keywords since they + ;; belong to the container. + (inner-par-p (not (bolp))) + (contents-begin (point)) + (keywords (unless inner-par-p + (org-element--collect-affiliated-keywords))) + (begin (if inner-par-p contents-begin (car keywords))) + (before-blank + (let ((case-fold-search t)) + (end-of-line) + (re-search-forward org-element-paragraph-separate limit 'm) + (while (and (/= (point) limit) + (cond + ;; Skip non-existent or incomplete drawer. + ((save-excursion + (beginning-of-line) + (and (looking-at "[ \t]*:\\S-") + (or (not (looking-at org-drawer-regexp)) + (not (save-excursion + (re-search-forward + "^[ \t]*:END:" limit t))))))) + ;; Stop at comments. + ((save-excursion + (beginning-of-line) + (not (looking-at "[ \t]*#\\S-"))) nil) + ;; Skip incomplete dynamic blocks. + ((save-excursion + (beginning-of-line) + (looking-at "[ \t]*#\\+BEGIN: ")) + (not (save-excursion + (re-search-forward + "^[ \t]*\\+END:" limit t)))) + ;; Skip incomplete blocks. + ((save-excursion + (beginning-of-line) + (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")) + (not (save-excursion + (re-search-forward + (concat "^[ \t]*#\\+END_" + (match-string 1)) + limit t)))) + ;; Skip incomplete latex environments. + ((save-excursion + (beginning-of-line) + (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")) + (not (save-excursion + (re-search-forward + (format "^[ \t]*\\\\end{%s}" + (match-string 1)) + limit t)))) + ;; Skip ill-formed keywords. + ((not (save-excursion + (beginning-of-line) + (looking-at "[ \t]*#\\+\\S-+:")))))) + (re-search-forward org-element-paragraph-separate limit 'm)) + (if (eobp) (point) (goto-char (line-beginning-position))))) + (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'paragraph + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines before-blank end)) + (cadr keywords)))))) + +(defun org-element-paragraph-interpreter (paragraph contents) + "Interpret PARAGRAPH element as Org syntax. +CONTENTS is the contents of the element." + contents) + + +;;;; Planning + +(defun org-element-planning-parser (limit) + "Parse a planning. + +LIMIT bounds the search. + +Return a list whose CAR is `planning' and CDR is a plist +containing `:closed', `:deadline', `:scheduled', `:begin', `:end' +and `:post-blank' keywords." + (save-excursion + (let* ((case-fold-search nil) + (begin (point)) + (post-blank (let ((before-blank (progn (forward-line) (point)))) + (skip-chars-forward " \r\t\n" limit) + (unless (eobp) (beginning-of-line)) + (count-lines before-blank (point)))) + (end (point)) + closed deadline scheduled) + (goto-char begin) + (while (re-search-forward org-keyword-time-not-clock-regexp + (line-end-position) t) + (goto-char (match-end 1)) + (org-skip-whitespace) + (let ((time (buffer-substring-no-properties + (1+ (point)) (1- (match-end 0)))) + (keyword (match-string 1))) + (cond ((equal keyword org-closed-string) (setq closed time)) + ((equal keyword org-deadline-string) (setq deadline time)) + (t (setq scheduled time))))) + (list 'planning + (list :closed closed + :deadline deadline + :scheduled scheduled + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-planning-interpreter (planning contents) + "Interpret PLANNING element as Org syntax. +CONTENTS is nil." + (mapconcat + 'identity + (delq nil + (list (let ((closed (org-element-property :closed planning))) + (when closed (concat org-closed-string " [" closed "]"))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline (concat org-deadline-string " <" deadline ">"))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat org-scheduled-string " <" scheduled ">"))))) + " ")) + + +;;;; Property Drawer + +(defun org-element-property-drawer-parser (limit) + "Parse a property drawer. + +LIMIT bounds the search. + +Return a list whose CAR is `property-drawer' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end', `:properties' and `:post-blank' keywords. + +Assume point is at the beginning of the property drawer." + (save-excursion + (let ((case-fold-search t) + (begin (point)) + (prop-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (properties + (let (val) + (while (not (looking-at "^[ \t]*:END:")) + (when (looking-at "[ \t]*:\\([A-Za-z][-_A-Za-z0-9]*\\):") + (push (cons (org-match-string-no-properties 1) + (org-trim + (buffer-substring-no-properties + (match-end 0) (point-at-eol)))) + val)) + (forward-line)) + val)) + (prop-end (progn (re-search-forward "^[ \t]*:END:" limit t) + (point-at-bol))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'property-drawer + (list :begin begin + :end end + :hiddenp hidden + :properties properties + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-property-drawer-interpreter (property-drawer contents) + "Interpret PROPERTY-DRAWER element as Org syntax. +CONTENTS is nil." + (let ((props (org-element-property :properties property-drawer))) + (concat + ":PROPERTIES:\n" + (mapconcat (lambda (p) + (format org-property-format (format ":%s:" (car p)) (cdr p))) + (nreverse props) "\n") + "\n:END:"))) + + +;;;; Quote Section + +(defun org-element-quote-section-parser (limit) + "Parse a quote section. + +LIMIT bounds the search. + +Return a list whose CAR is `quote-section' and CDR is a plist +containing `:begin', `:end', `:value' and `:post-blank' keywords. + +Assume point is at beginning of the section." + (save-excursion + (let* ((begin (point)) + (end (progn (org-with-limited-levels (outline-next-heading)) + (point))) + (pos-before-blank (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + (value (buffer-substring-no-properties begin pos-before-blank))) + (list 'quote-section + (list :begin begin + :end end + :value value + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-quote-section-interpreter (quote-section contents) + "Interpret QUOTE-SECTION element as Org syntax. +CONTENTS is nil." + (org-element-property :value quote-section)) + + +;;;; Src Block + +(defun org-element-src-block-parser (limit) + "Parse a src block. + +LIMIT bounds the search. + +Return a list whose CAR is `src-block' and CDR is a plist +containing `:language', `:switches', `:parameters', `:begin', +`:end', `:hiddenp', `:number-lines', `:retain-labels', +`:use-labels', `:label-fmt', `:preserve-indent', `:value' and +`:post-blank' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + ;; Get beginning position. + (begin (car keywords)) + ;; Get language as a string. + (language + (progn + (looking-at + (concat "^[ \t]*#\\+BEGIN_SRC" + "\\(?: +\\(\\S-+\\)\\)?" + "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?" + "\\(.*\\)[ \t]*$")) + (org-match-string-no-properties 1))) + ;; Get switches. + (switches (org-match-string-no-properties 2)) + ;; Get parameters. + (parameters (org-match-string-no-properties 3)) + ;; Switches analysis + (number-lines (cond ((not switches) nil) + ((string-match "-n\\>" switches) 'new) + ((string-match "+n\\>" switches) 'continued))) + (preserve-indent (and switches (string-match "-i\\>" switches))) + (label-fmt (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches))) + ;; Should labels be retained in (or stripped from) + ;; src blocks? + (retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches)))) + ;; What should code-references use - labels or + ;; line-numbers? + (use-labels + (or (not switches) + (and retain-labels (not (string-match "-k\\>" switches))))) + ;; Get visibility status. + (hidden (progn (forward-line) (org-invisible-p2))) + ;; Retrieve code. + (value (buffer-substring-no-properties (point) contents-end)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + ;; Get position after ending blank lines. + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'src-block + (nconc + (list :language language + :switches (and (org-string-nw-p switches) + (org-trim switches)) + :parameters (and (org-string-nw-p parameters) + (org-trim parameters)) + :begin begin + :end end + :number-lines number-lines + :preserve-indent preserve-indent + :retain-labels retain-labels + :use-labels use-labels + :label-fmt label-fmt + :hiddenp hidden + :value value + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-src-block-interpreter (src-block contents) + "Interpret SRC-BLOCK element as Org syntax. +CONTENTS is nil." + (let ((lang (org-element-property :language src-block)) + (switches (org-element-property :switches src-block)) + (params (org-element-property :parameters src-block)) + (value (let ((val (org-element-property :value src-block))) + (cond + + (org-src-preserve-indentation val) + ((zerop org-edit-src-content-indentation) + (org-remove-indentation val)) + (t + (let ((ind (make-string + org-edit-src-content-indentation 32))) + (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" ind + (org-remove-indentation val) nil nil 1))))))) + (concat (format "#+BEGIN_SRC%s\n" + (concat (and lang (concat " " lang)) + (and switches (concat " " switches)) + (and params (concat " " params)))) + value + "#+END_SRC"))) + + +;;;; Table + +(defun org-element-table-parser (limit) + "Parse a table at point. + +LIMIT bounds the search. + +Return a list whose CAR is `table' and CDR is a plist containing +`:begin', `:end', `:tblfm', `:type', `:contents-begin', +`:contents-end', `:value' and `:post-blank' keywords. + +Assume point is at the beginning of the table." + (save-excursion + (let* ((case-fold-search t) + (table-begin (point)) + (type (if (org-at-table.el-p) 'table.el 'org)) + (keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (table-end (goto-char (marker-position (org-table-end t)))) + (tblfm (let (acc) + (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") + (push (org-match-string-no-properties 1) acc) + (forward-line)) + acc)) + (pos-before-blank (point)) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'table + (nconc + (list :begin begin + :end end + :type type + :tblfm tblfm + ;; Only `org' tables have contents. `table.el' tables + ;; use a `:value' property to store raw table as + ;; a string. + :contents-begin (and (eq type 'org) table-begin) + :contents-end (and (eq type 'org) table-end) + :value (and (eq type 'table.el) + (buffer-substring-no-properties + table-begin table-end)) + :post-blank (count-lines pos-before-blank end)) + (cadr keywords)))))) + +(defun org-element-table-interpreter (table contents) + "Interpret TABLE element as Org syntax. +CONTENTS is nil." + (if (eq (org-element-property :type table) 'table.el) + (org-remove-indentation (org-element-property :value table)) + (concat (with-temp-buffer (insert contents) + (org-table-align) + (buffer-string)) + (mapconcat (lambda (fm) (concat "#+TBLFM: " fm)) + (reverse (org-element-property :tblfm table)) + "\n")))) + + +;;;; Table Row + +(defun org-element-table-row-parser (limit) + "Parse table row at point. + +LIMIT bounds the search. + +Return a list whose CAR is `table-row' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:type' and `:post-blank' keywords." + (save-excursion + (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard)) + (begin (point)) + ;; A table rule has no contents. In that case, ensure + ;; CONTENTS-BEGIN matches CONTENTS-END. + (contents-begin (and (eq type 'standard) + (search-forward "|") + (point))) + (contents-end (and (eq type 'standard) + (progn + (end-of-line) + (skip-chars-backward " \t") + (point)))) + (end (progn (forward-line) (point)))) + (list 'table-row + (list :type type + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank 0))))) + +(defun org-element-table-row-interpreter (table-row contents) + "Interpret TABLE-ROW element as Org syntax. +CONTENTS is the contents of the table row." + (if (eq (org-element-property :type table-row) 'rule) "|-" + (concat "| " contents))) + + +;;;; Verse Block + +(defun org-element-verse-block-parser (limit) + "Parse a verse block. + +LIMIT bounds the search. + +Return a list whose CAR is `verse-block' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:hiddenp' and `:post-blank' keywords. + +Assume point is at beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_VERSE" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((keywords (org-element--collect-affiliated-keywords)) + (begin (car keywords)) + (hidden (progn (forward-line) (org-invisible-p2))) + (contents-begin (point)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'verse-block + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :hiddenp hidden + :post-blank (count-lines pos-before-blank end)) + (cadr keywords))))))))) + +(defun org-element-verse-block-interpreter (verse-block contents) + "Interpret VERSE-BLOCK element as Org syntax. +CONTENTS is verse block contents." + (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents)) + + + +;;; Objects +;; +;; Unlike to elements, interstices can be found between objects. +;; That's why, along with the parser, successor functions are provided +;; for each object. Some objects share the same successor (i.e. `code' +;; and `verbatim' objects). +;; +;; A successor must accept a single argument bounding the search. It +;; will return either a cons cell whose CAR is the object's type, as +;; a symbol, and CDR the position of its next occurrence, or nil. +;; +;; Successors follow the naming convention: +;; org-element-NAME-successor, where NAME is the name of the +;; successor, as defined in `org-element-all-successors'. +;; +;; Some object types (i.e. `italic') are recursive. Restrictions on +;; object types they can contain will be specified in +;; `org-element-object-restrictions'. +;; +;; Adding a new type of object is simple. Implement a successor, +;; a parser, and an interpreter for it, all following the naming +;; convention. Register type in `org-element-all-objects' and +;; successor in `org-element-all-successors'. Maybe tweak +;; restrictions about it, and that's it. + + +;;;; Bold + +(defun org-element-bold-parser () + "Parse bold object at point. + +Return a list whose CAR is `bold' and CDR is a plist with +`:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first star marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'bold + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-bold-interpreter (bold contents) + "Interpret BOLD object as Org syntax. +CONTENTS is the contents of the object." + (format "*%s*" contents)) + +(defun org-element-text-markup-successor (limit) + "Search for the next text-markup object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is a symbol among `bold', +`italic', `underline', `strike-through', `code' and `verbatim' +and CDR is beginning position." + (save-excursion + (unless (bolp) (backward-char)) + (when (re-search-forward org-emph-re limit t) + (let ((marker (match-string 3))) + (cons (cond + ((equal marker "*") 'bold) + ((equal marker "/") 'italic) + ((equal marker "_") 'underline) + ((equal marker "+") 'strike-through) + ((equal marker "~") 'code) + ((equal marker "=") 'verbatim) + (t (error "Unknown marker at %d" (match-beginning 3)))) + (match-beginning 2)))))) + + +;;;; Code + +(defun org-element-code-parser () + "Parse code object at point. + +Return a list whose CAR is `code' and CDR is a plist with +`:value', `:begin', `:end' and `:post-blank' keywords. + +Assume point is at the first tilde marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (value (org-match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'code + (list :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-code-interpreter (code contents) + "Interpret CODE object as Org syntax. +CONTENTS is nil." + (format "~%s~" (org-element-property :value code))) + + +;;;; Entity + +(defun org-element-entity-parser () + "Parse entity at point. + +Return a list whose CAR is `entity' and CDR a plist with +`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1', +`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as +keywords. + +Assume point is at the beginning of the entity." + (save-excursion + (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)") + (let* ((value (org-entity-get (match-string 1))) + (begin (match-beginning 0)) + (bracketsp (string= (match-string 2) "{}")) + (post-blank (progn (goto-char (match-end 1)) + (when bracketsp (forward-char 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'entity + (list :name (car value) + :latex (nth 1 value) + :latex-math-p (nth 2 value) + :html (nth 3 value) + :ascii (nth 4 value) + :latin1 (nth 5 value) + :utf-8 (nth 6 value) + :begin begin + :end end + :use-brackets-p bracketsp + :post-blank post-blank))))) + +(defun org-element-entity-interpreter (entity contents) + "Interpret ENTITY object as Org syntax. +CONTENTS is nil." + (concat "\\" + (org-element-property :name entity) + (when (org-element-property :use-brackets-p entity) "{}"))) + +(defun org-element-latex-or-entity-successor (limit) + "Search for the next latex-fragment or entity object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `entity' or +`latex-fragment' and CDR is beginning position." + (save-excursion + (let ((matchers + (remove "begin" (plist-get org-format-latex-options :matchers))) + ;; ENTITY-RE matches both LaTeX commands and Org entities. + (entity-re + "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")) + (when (re-search-forward + (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps))) + matchers "\\|") + "\\|" entity-re) + limit t) + (goto-char (match-beginning 0)) + (if (looking-at entity-re) + ;; Determine if it's a real entity or a LaTeX command. + (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment) + (match-beginning 0)) + ;; No entity nor command: point is at a LaTeX fragment. + ;; Determine its type to get the correct beginning position. + (cons 'latex-fragment + (catch 'return + (mapc (lambda (e) + (when (looking-at (nth 1 (assoc e org-latex-regexps))) + (throw 'return + (match-beginning + (nth 2 (assoc e org-latex-regexps)))))) + matchers) + (point)))))))) + + +;;;; Export Snippet + +(defun org-element-export-snippet-parser () + "Parse export snippet at point. + +Return a list whose CAR is `export-snippet' and CDR a plist with +`:begin', `:end', `:back-end', `:value' and `:post-blank' as +keywords. + +Assume point is at the beginning of the snippet." + (save-excursion + (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t) + (let* ((begin (match-beginning 0)) + (back-end (org-match-string-no-properties 1)) + (value (buffer-substring-no-properties + (point) + (progn (re-search-forward "@@" nil t) (match-beginning 0)))) + (post-blank (skip-chars-forward " \t")) + (end (point))) + (list 'export-snippet + (list :back-end back-end + :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-export-snippet-interpreter (export-snippet contents) + "Interpret EXPORT-SNIPPET object as Org syntax. +CONTENTS is nil." + (format "@@%s:%s@@" + (org-element-property :back-end export-snippet) + (org-element-property :value export-snippet))) + +(defun org-element-export-snippet-successor (limit) + "Search for the next export-snippet object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `export-snippet' and CDR +its beginning position." + (save-excursion + (let (beg) + (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t) + (setq beg (match-beginning 0)) + (search-forward "@@" limit t)) + (cons 'export-snippet beg))))) + + +;;;; Footnote Reference + +(defun org-element-footnote-reference-parser () + "Parse footnote reference at point. + +Return a list whose CAR is `footnote-reference' and CDR a plist +with `:label', `:type', `:inline-definition', `:begin', `:end' +and `:post-blank' as keywords." + (save-excursion + (looking-at org-footnote-re) + (let* ((begin (point)) + (label (or (org-match-string-no-properties 2) + (org-match-string-no-properties 3) + (and (match-string 1) + (concat "fn:" (org-match-string-no-properties 1))))) + (type (if (or (not label) (match-string 1)) 'inline 'standard)) + (inner-begin (match-end 0)) + (inner-end + (let ((count 1)) + (forward-char) + (while (and (> count 0) (re-search-forward "[][]" nil t)) + (if (equal (match-string 0) "[") (incf count) (decf count))) + (1- (point)))) + (post-blank (progn (goto-char (1+ inner-end)) + (skip-chars-forward " \t"))) + (end (point)) + (footnote-reference + (list 'footnote-reference + (list :label label + :type type + :begin begin + :end end + :post-blank post-blank)))) + (org-element-put-property + footnote-reference :inline-definition + (and (eq type 'inline) + (org-element-parse-secondary-string + (buffer-substring inner-begin inner-end) + (org-element-restriction 'footnote-reference) + footnote-reference)))))) + +(defun org-element-footnote-reference-interpreter (footnote-reference contents) + "Interpret FOOTNOTE-REFERENCE object as Org syntax. +CONTENTS is nil." + (let ((label (or (org-element-property :label footnote-reference) "fn:")) + (def + (let ((inline-def + (org-element-property :inline-definition footnote-reference))) + (if (not inline-def) "" + (concat ":" (org-element-interpret-data inline-def)))))) + (format "[%s]" (concat label def)))) + +(defun org-element-footnote-reference-successor (limit) + "Search for the next footnote-reference object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `footnote-reference' and +CDR is beginning position." + (save-excursion + (catch 'exit + (while (re-search-forward org-footnote-re limit t) + (save-excursion + (let ((beg (match-beginning 0)) + (count 1)) + (backward-char) + (while (re-search-forward "[][]" limit t) + (if (equal (match-string 0) "[") (incf count) (decf count)) + (when (zerop count) + (throw 'exit (cons 'footnote-reference beg)))))))))) + + +;;;; Inline Babel Call + +(defun org-element-inline-babel-call-parser () + "Parse inline babel call at point. + +Return a list whose CAR is `inline-babel-call' and CDR a plist +with `:begin', `:end', `:info' and `:post-blank' as keywords. + +Assume point is at the beginning of the babel call." + (save-excursion + (unless (bolp) (backward-char)) + (looking-at org-babel-inline-lob-one-liner-regexp) + (let ((info (save-match-data (org-babel-lob-get-info))) + (begin (match-end 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'inline-babel-call + (list :begin begin + :end end + :info info + :post-blank post-blank))))) + +(defun org-element-inline-babel-call-interpreter (inline-babel-call contents) + "Interpret INLINE-BABEL-CALL object as Org syntax. +CONTENTS is nil." + (let* ((babel-info (org-element-property :info inline-babel-call)) + (main-source (car babel-info)) + (post-options (nth 1 babel-info))) + (concat "call_" + (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source) + ;; Remove redundant square brackets. + (replace-match + (match-string 1 main-source) nil nil main-source) + main-source) + (and post-options (format "[%s]" post-options))))) + +(defun org-element-inline-babel-call-successor (limit) + "Search for the next inline-babel-call object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `inline-babel-call' and +CDR is beginning position." + (save-excursion + ;; Use a simplified version of + ;; `org-babel-inline-lob-one-liner-regexp'. + (when (re-search-forward + "call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?" + limit t) + (cons 'inline-babel-call (match-beginning 0))))) + + +;;;; Inline Src Block + +(defun org-element-inline-src-block-parser () + "Parse inline source block at point. + +LIMIT bounds the search. + +Return a list whose CAR is `inline-src-block' and CDR a plist +with `:begin', `:end', `:language', `:value', `:parameters' and +`:post-blank' as keywords. + +Assume point is at the beginning of the inline src block." + (save-excursion + (unless (bolp) (backward-char)) + (looking-at org-babel-inline-src-block-regexp) + (let ((begin (match-beginning 1)) + (language (org-match-string-no-properties 2)) + (parameters (org-match-string-no-properties 4)) + (value (org-match-string-no-properties 5)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'inline-src-block + (list :language language + :value value + :parameters parameters + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-inline-src-block-interpreter (inline-src-block contents) + "Interpret INLINE-SRC-BLOCK object as Org syntax. +CONTENTS is nil." + (let ((language (org-element-property :language inline-src-block)) + (arguments (org-element-property :parameters inline-src-block)) + (body (org-element-property :value inline-src-block))) + (format "src_%s%s{%s}" + language + (if arguments (format "[%s]" arguments) "") + body))) + +(defun org-element-inline-src-block-successor (limit) + "Search for the next inline-babel-call element. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `inline-babel-call' and +CDR is beginning position." + (save-excursion + (unless (bolp) (backward-char)) + (when (re-search-forward org-babel-inline-src-block-regexp limit t) + (cons 'inline-src-block (match-beginning 1))))) + +;;;; Italic + +(defun org-element-italic-parser () + "Parse italic object at point. + +Return a list whose CAR is `italic' and CDR is a plist with +`:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first slash marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'italic + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-italic-interpreter (italic contents) + "Interpret ITALIC object as Org syntax. +CONTENTS is the contents of the object." + (format "/%s/" contents)) + + +;;;; Latex Fragment + +(defun org-element-latex-fragment-parser () + "Parse latex fragment at point. + +Return a list whose CAR is `latex-fragment' and CDR a plist with +`:value', `:begin', `:end', and `:post-blank' as keywords. + +Assume point is at the beginning of the latex fragment." + (save-excursion + (let* ((begin (point)) + (substring-match + (catch 'exit + (mapc (lambda (e) + (let ((latex-regexp (nth 1 (assoc e org-latex-regexps)))) + (when (or (looking-at latex-regexp) + (and (not (bobp)) + (save-excursion + (backward-char) + (looking-at latex-regexp)))) + (throw 'exit (nth 2 (assoc e org-latex-regexps)))))) + (plist-get org-format-latex-options :matchers)) + ;; None found: it's a macro. + (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*") + 0)) + (value (match-string-no-properties substring-match)) + (post-blank (progn (goto-char (match-end substring-match)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'latex-fragment + (list :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-latex-fragment-interpreter (latex-fragment contents) + "Interpret LATEX-FRAGMENT object as Org syntax. +CONTENTS is nil." + (org-element-property :value latex-fragment)) + +;;;; Line Break + +(defun org-element-line-break-parser () + "Parse line break at point. + +Return a list whose CAR is `line-break', and CDR a plist with +`:begin', `:end' and `:post-blank' keywords. + +Assume point is at the beginning of the line break." + (list 'line-break (list :begin (point) :end (point-at-eol) :post-blank 0))) + +(defun org-element-line-break-interpreter (line-break contents) + "Interpret LINE-BREAK object as Org syntax. +CONTENTS is nil." + "\\\\") + +(defun org-element-line-break-successor (limit) + "Search for the next line-break object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `line-break' and CDR is +beginning position." + (save-excursion + (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t) + (goto-char (match-beginning 1))))) + ;; A line break can only happen on a non-empty line. + (when (and beg (re-search-backward "\\S-" (point-at-bol) t)) + (cons 'line-break beg))))) + + +;;;; Link + +(defun org-element-link-parser () + "Parse link at point. + +Return a list whose CAR is `link' and CDR a plist with `:type', +`:path', `:raw-link', `:begin', `:end', `:contents-begin', +`:contents-end' and `:post-blank' as keywords. + +Assume point is at the beginning of the link." + (save-excursion + (let ((begin (point)) + end contents-begin contents-end link-end post-blank path type + raw-link link) + (cond + ;; Type 1: Text targeted from a radio target. + ((and org-target-link-regexp (looking-at org-target-link-regexp)) + (setq type "radio" + link-end (match-end 0) + path (org-match-string-no-properties 0))) + ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]] + ((looking-at org-bracket-link-regexp) + (setq contents-begin (match-beginning 3) + contents-end (match-end 3) + link-end (match-end 0) + ;; RAW-LINK is the original link. + raw-link (org-match-string-no-properties 1) + link (org-translate-link + (org-link-expand-abbrev + (org-link-unescape raw-link)))) + ;; Determine TYPE of link and set PATH accordingly. + (cond + ;; File type. + ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link)) + (setq type "file" path link)) + ;; Explicit type (http, irc, bbdb...). See `org-link-types'. + ((string-match org-link-re-with-space3 link) + (setq type (match-string 1 link) path (match-string 2 link))) + ;; Id type: PATH is the id. + ((string-match "^id:\\([-a-f0-9]+\\)" link) + (setq type "id" path (match-string 1 link))) + ;; Code-ref type: PATH is the name of the reference. + ((string-match "^(\\(.*\\))$" link) + (setq type "coderef" path (match-string 1 link))) + ;; Custom-id type: PATH is the name of the custom id. + ((= (aref link 0) ?#) + (setq type "custom-id" path (substring link 1))) + ;; Fuzzy type: Internal link either matches a target, an + ;; headline name or nothing. PATH is the target or + ;; headline's name. + (t (setq type "fuzzy" path link)))) + ;; Type 3: Plain link, i.e. http://orgmode.org + ((looking-at org-plain-link-re) + (setq raw-link (org-match-string-no-properties 0) + type (org-match-string-no-properties 1) + path (org-match-string-no-properties 2) + link-end (match-end 0))) + ;; Type 4: Angular link, i.e. <http://orgmode.org> + ((looking-at org-angle-link-re) + (setq raw-link (buffer-substring-no-properties + (match-beginning 1) (match-end 2)) + type (org-match-string-no-properties 1) + path (org-match-string-no-properties 2) + link-end (match-end 0)))) + ;; In any case, deduce end point after trailing white space from + ;; LINK-END variable. + (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t")) + end (point)) + (list 'link + (list :type type + :path path + :raw-link (or raw-link path) + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-link-interpreter (link contents) + "Interpret LINK object as Org syntax. +CONTENTS is the contents of the object, or nil." + (let ((type (org-element-property :type link)) + (raw-link (org-element-property :raw-link link))) + (if (string= type "radio") raw-link + (format "[[%s]%s]" + raw-link + (if contents (format "[%s]" contents) ""))))) + +(defun org-element-link-successor (limit) + "Search for the next link object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `link' and CDR is +beginning position." + (save-excursion + (let ((link-regexp + (if (not org-target-link-regexp) org-any-link-re + (concat org-any-link-re "\\|" org-target-link-regexp)))) + (when (re-search-forward link-regexp limit t) + (cons 'link (match-beginning 0)))))) + + +;;;; Macro + +(defun org-element-macro-parser () + "Parse macro at point. + +Return a list whose CAR is `macro' and CDR a plist with `:key', +`:args', `:begin', `:end', `:value' and `:post-blank' as +keywords. + +Assume point is at the macro." + (save-excursion + (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}") + (let ((begin (point)) + (key (downcase (org-match-string-no-properties 1))) + (value (org-match-string-no-properties 0)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point)) + (args (let ((args (org-match-string-no-properties 3)) args2) + (when args + (setq args (org-split-string args ",")) + (while args + (while (string-match "\\\\\\'" (car args)) + ;; Repair bad splits. + (setcar (cdr args) (concat (substring (car args) 0 -1) + "," (nth 1 args))) + (pop args)) + (push (pop args) args2)) + (mapcar 'org-trim (nreverse args2)))))) + (list 'macro + (list :key key + :value value + :args args + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-macro-interpreter (macro contents) + "Interpret MACRO object as Org syntax. +CONTENTS is nil." + (org-element-property :value macro)) + +(defun org-element-macro-successor (limit) + "Search for the next macro object. + +LIMIT bounds the search. + +Return value is cons cell whose CAR is `macro' and CDR is +beginning position." + (save-excursion + (when (re-search-forward + "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" + limit t) + (cons 'macro (match-beginning 0))))) + + +;;;; Radio-target + +(defun org-element-radio-target-parser () + "Parse radio target at point. + +Return a list whose CAR is `radio-target' and CDR a plist with +`:begin', `:end', `:contents-begin', `:contents-end', `:value' +and `:post-blank' as keywords. + +Assume point is at the radio target." + (save-excursion + (looking-at org-radio-target-regexp) + (let ((begin (point)) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1)) + (value (org-match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'radio-target + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank + :value value))))) + +(defun org-element-radio-target-interpreter (target contents) + "Interpret TARGET object as Org syntax. +CONTENTS is the contents of the object." + (concat "<<<" contents ">>>")) + +(defun org-element-radio-target-successor (limit) + "Search for the next radio-target object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `radio-target' and CDR +is beginning position." + (save-excursion + (when (re-search-forward org-radio-target-regexp limit t) + (cons 'radio-target (match-beginning 0))))) + + +;;;; Statistics Cookie + +(defun org-element-statistics-cookie-parser () + "Parse statistics cookie at point. + +Return a list whose CAR is `statistics-cookie', and CDR a plist +with `:begin', `:end', `:value' and `:post-blank' keywords. + +Assume point is at the beginning of the statistics-cookie." + (save-excursion + (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") + (let* ((begin (point)) + (value (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'statistics-cookie + (list :begin begin + :end end + :value value + :post-blank post-blank))))) + +(defun org-element-statistics-cookie-interpreter (statistics-cookie contents) + "Interpret STATISTICS-COOKIE object as Org syntax. +CONTENTS is nil." + (org-element-property :value statistics-cookie)) + +(defun org-element-statistics-cookie-successor (limit) + "Search for the next statistics cookie object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `statistics-cookie' and +CDR is beginning position." + (save-excursion + (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t) + (cons 'statistics-cookie (match-beginning 0))))) + + +;;;; Strike-Through + +(defun org-element-strike-through-parser () + "Parse strike-through object at point. + +Return a list whose CAR is `strike-through' and CDR is a plist +with `:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first plus sign marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'strike-through + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-strike-through-interpreter (strike-through contents) + "Interpret STRIKE-THROUGH object as Org syntax. +CONTENTS is the contents of the object." + (format "+%s+" contents)) + + +;;;; Subscript + +(defun org-element-subscript-parser () + "Parse subscript at point. + +Return a list whose CAR is `subscript' and CDR a plist with +`:begin', `:end', `:contents-begin', `:contents-end', +`:use-brackets-p' and `:post-blank' as keywords. + +Assume point is at the underscore." + (save-excursion + (unless (bolp) (backward-char)) + (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) + t + (not (looking-at org-match-substring-regexp)))) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 5) + (match-beginning 3))) + (contents-end (or (match-end 5) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'subscript + (list :begin begin + :end end + :use-brackets-p bracketsp + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-subscript-interpreter (subscript contents) + "Interpret SUBSCRIPT object as Org syntax. +CONTENTS is the contents of the object." + (format + (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") + contents)) + +(defun org-element-sub/superscript-successor (limit) + "Search for the next sub/superscript object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is either `subscript' or +`superscript' and CDR is beginning position." + (save-excursion + (when (re-search-forward org-match-substring-regexp limit t) + (cons (if (string= (match-string 2) "_") 'subscript 'superscript) + (match-beginning 2))))) + + +;;;; Superscript + +(defun org-element-superscript-parser () + "Parse superscript at point. + +Return a list whose CAR is `superscript' and CDR a plist with +`:begin', `:end', `:contents-begin', `:contents-end', +`:use-brackets-p' and `:post-blank' as keywords. + +Assume point is at the caret." + (save-excursion + (unless (bolp) (backward-char)) + (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t + (not (looking-at org-match-substring-regexp)))) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 5) + (match-beginning 3))) + (contents-end (or (match-end 5) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'superscript + (list :begin begin + :end end + :use-brackets-p bracketsp + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-superscript-interpreter (superscript contents) + "Interpret SUPERSCRIPT object as Org syntax. +CONTENTS is the contents of the object." + (format + (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s") + contents)) + + +;;;; Table Cell + +(defun org-element-table-cell-parser () + "Parse table cell at point. + +Return a list whose CAR is `table-cell' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end' +and `:post-blank' keywords." + (looking-at "[ \t]*\\(.*?\\)[ \t]*|") + (let* ((begin (match-beginning 0)) + (end (match-end 0)) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1))) + (list 'table-cell + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank 0)))) + +(defun org-element-table-cell-interpreter (table-cell contents) + "Interpret TABLE-CELL element as Org syntax. +CONTENTS is the contents of the cell, or nil." + (concat " " contents " |")) + +(defun org-element-table-cell-successor (limit) + "Search for the next table-cell object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `table-cell' and CDR is +beginning position." + (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point)))) + + +;;;; Target + +(defun org-element-target-parser () + "Parse target at point. + +Return a list whose CAR is `target' and CDR a plist with +`:begin', `:end', `:value' and `:post-blank' as keywords. + +Assume point is at the target." + (save-excursion + (looking-at org-target-regexp) + (let ((begin (point)) + (value (org-match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'target + (list :begin begin + :end end + :value value + :post-blank post-blank))))) + +(defun org-element-target-interpreter (target contents) + "Interpret TARGET object as Org syntax. +CONTENTS is nil." + (format "<<%s>>" (org-element-property :value target))) + +(defun org-element-target-successor (limit) + "Search for the next target object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `target' and CDR is +beginning position." + (save-excursion + (when (re-search-forward org-target-regexp limit t) + (cons 'target (match-beginning 0))))) + + +;;;; Timestamp + +(defun org-element-timestamp-parser () + "Parse time stamp at point. + +Return a list whose CAR is `timestamp', and CDR a plist with +`:type', `:begin', `:end', `:value' and `:post-blank' keywords. + +Assume point is at the beginning of the timestamp." + (save-excursion + (let* ((begin (point)) + (activep (eq (char-after) ?<)) + (main-value + (progn + (looking-at "[<[]\\(\\(%%\\)?.*?\\)[]>]\\(?:--[<[]\\(.*?\\)[]>]\\)?") + (match-string-no-properties 1))) + (range-end (match-string-no-properties 3)) + (type (cond ((match-string 2) 'diary) + ((and activep range-end) 'active-range) + (activep 'active) + (range-end 'inactive-range) + (t 'inactive))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'timestamp + (list :type type + :value main-value + :range-end range-end + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-timestamp-interpreter (timestamp contents) + "Interpret TIMESTAMP object as Org syntax. +CONTENTS is nil." + (let ((type (org-element-property :type timestamp) )) + (concat + (format (if (memq type '(inactive inactive-range)) "[%s]" "<%s>") + (org-element-property :value timestamp)) + (let ((range-end (org-element-property :range-end timestamp))) + (when range-end + (concat "--" + (format (if (eq type 'inactive-range) "[%s]" "<%s>") + range-end))))))) + +(defun org-element-timestamp-successor (limit) + "Search for the next timestamp object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `timestamp' and CDR is +beginning position." + (save-excursion + (when (re-search-forward + (concat org-ts-regexp-both + "\\|" + "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" + "\\|" + "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") + limit t) + (cons 'timestamp (match-beginning 0))))) + + +;;;; Underline + +(defun org-element-underline-parser () + "Parse underline object at point. + +Return a list whose CAR is `underline' and CDR is a plist with +`:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first underscore marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'underline + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-underline-interpreter (underline contents) + "Interpret UNDERLINE object as Org syntax. +CONTENTS is the contents of the object." + (format "_%s_" contents)) + + +;;;; Verbatim + +(defun org-element-verbatim-parser () + "Parse verbatim object at point. + +Return a list whose CAR is `verbatim' and CDR is a plist with +`:value', `:begin', `:end' and `:post-blank' keywords. + +Assume point is at the first equal sign marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (value (org-match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'verbatim + (list :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-verbatim-interpreter (verbatim contents) + "Interpret VERBATIM object as Org syntax. +CONTENTS is nil." + (format "=%s=" (org-element-property :value verbatim))) + + + +;;; Parsing Element Starting At Point +;; +;; `org-element--current-element' is the core function of this section. +;; It returns the Lisp representation of the element starting at +;; point. +;; +;; `org-element--current-element' makes use of special modes. They +;; are activated for fixed element chaining (i.e. `plain-list' > +;; `item') or fixed conditional element chaining (i.e. `headline' > +;; `section'). Special modes are: `first-section', `section', +;; `quote-section', `item' and `table-row'. + +(defun org-element--current-element + (limit &optional granularity special structure) + "Parse the element starting at point. + +LIMIT bounds the search. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. + +Possible types are defined in `org-element-all-elements'. + +Optional argument GRANULARITY determines the depth of the +recursion. Allowed values are `headline', `greater-element', +`element', `object' or nil. When it is broader than `object' (or +nil), secondary values will not be parsed, since they only +contain objects. + +Optional argument SPECIAL, when non-nil, can be either +`first-section', `section', `quote-section', `table-row' and +`item'. + +If STRUCTURE isn't provided but SPECIAL is set to `item', it will +be computed. + +This function assumes point is always at the beginning of the +element it has to parse." + (save-excursion + ;; If point is at an affiliated keyword, try moving to the + ;; beginning of the associated element. If none is found, the + ;; keyword is orphaned and will be treated as plain text. + (when (looking-at org-element--affiliated-re) + (let ((opoint (point))) + (while (looking-at org-element--affiliated-re) (forward-line)) + (when (looking-at "[ \t]*$") (goto-char opoint)))) + (let ((case-fold-search t) + ;; Determine if parsing depth allows for secondary strings + ;; parsing. It only applies to elements referenced in + ;; `org-element-secondary-value-alist'. + (raw-secondary-p (and granularity (not (eq granularity 'object))))) + (cond + ;; Item. + ((eq special 'item) + (org-element-item-parser limit structure raw-secondary-p)) + ;; Table Row. + ((eq special 'table-row) (org-element-table-row-parser limit)) + ;; Headline. + ((org-with-limited-levels (org-at-heading-p)) + (org-element-headline-parser limit raw-secondary-p)) + ;; Sections (must be checked after headline). + ((eq special 'section) (org-element-section-parser limit)) + ((eq special 'quote-section) (org-element-quote-section-parser limit)) + ((eq special 'first-section) + (org-element-section-parser + (or (save-excursion (org-with-limited-levels (outline-next-heading))) + limit))) + ;; When not at bol, point is at the beginning of an item or + ;; a footnote definition: next item is always a paragraph. + ((not (bolp)) (org-element-paragraph-parser limit)) + ;; Planning and Clock. + ((and (looking-at org-planning-or-clock-line-re)) + (if (equal (match-string 1) org-clock-string) + (org-element-clock-parser limit) + (org-element-planning-parser limit))) + ;; Inlinetask. + ((org-at-heading-p) + (org-element-inlinetask-parser limit raw-secondary-p)) + ;; LaTeX Environment. + ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}") + (if (save-excursion + (re-search-forward + (format "[ \t]*\\\\end{%s}[ \t]*" + (regexp-quote (match-string 1))) + nil t)) + (org-element-latex-environment-parser limit) + (org-element-paragraph-parser limit))) + ;; Drawer and Property Drawer. + ((looking-at org-drawer-regexp) + (let ((name (match-string 1))) + (cond + ((not (save-excursion + (re-search-forward "^[ \t]*:END:[ \t]*$" nil t))) + (org-element-paragraph-parser limit)) + ((equal "PROPERTIES" name) + (org-element-property-drawer-parser limit)) + (t (org-element-drawer-parser limit))))) + ;; Fixed Width + ((looking-at "[ \t]*:\\( \\|$\\)") + (org-element-fixed-width-parser limit)) + ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and + ;; Keywords. + ((looking-at "[ \t]*#") + (goto-char (match-end 0)) + (cond ((looking-at "\\(?: \\|$\\)") + (beginning-of-line) + (org-element-comment-parser limit)) + ((looking-at "\\+BEGIN_\\(\\S-+\\)") + (beginning-of-line) + (let ((parser (assoc (upcase (match-string 1)) + org-element-block-name-alist))) + (if parser (funcall (cdr parser) limit) + (org-element-special-block-parser limit)))) + ((looking-at "\\+CALL:") + (beginning-of-line) + (org-element-babel-call-parser limit)) + ((looking-at "\\+BEGIN:? ") + (beginning-of-line) + (org-element-dynamic-block-parser limit)) + ((looking-at "\\+\\S-+:") + (beginning-of-line) + (org-element-keyword-parser limit)) + (t + (beginning-of-line) + (org-element-paragraph-parser limit)))) + ;; Footnote Definition. + ((looking-at org-footnote-definition-re) + (org-element-footnote-definition-parser limit)) + ;; Horizontal Rule. + ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") + (org-element-horizontal-rule-parser limit)) + ;; Table. + ((org-at-table-p t) (org-element-table-parser limit)) + ;; List. + ((looking-at (org-item-re)) + (org-element-plain-list-parser limit (or structure (org-list-struct)))) + ;; Default element: Paragraph. + (t (org-element-paragraph-parser limit)))))) + + +;; Most elements can have affiliated keywords. When looking for an +;; element beginning, we want to move before them, as they belong to +;; that element, and, in the meantime, collect information they give +;; into appropriate properties. Hence the following function. +;; +;; Usage of optional arguments may not be obvious at first glance: +;; +;; - TRANS-LIST is used to polish keywords names that have evolved +;; during Org history. In example, even though =result= and +;; =results= coexist, we want to have them under the same =result= +;; property. It's also true for "srcname" and "name", where the +;; latter seems to be preferred nowadays (thus the "name" property). +;; +;; - CONSED allows to regroup multi-lines keywords under the same +;; property, while preserving their own identity. This is mostly +;; used for "attr_latex" and al. +;; +;; - PARSED prepares a keyword value for export. This is useful for +;; "caption". Objects restrictions for such keywords are defined in +;; `org-element-object-restrictions'. +;; +;; - DUALS is used to take care of keywords accepting a main and an +;; optional secondary values. For example "results" has its +;; source's name as the main value, and may have an hash string in +;; optional square brackets as the secondary one. +;; +;; A keyword may belong to more than one category. + +(defun org-element--collect-affiliated-keywords + (&optional key-re trans-list consed parsed duals) + "Collect affiliated keywords before point. + +Optional argument KEY-RE is a regexp matching keywords, which +puts matched keyword in group 1. It defaults to +`org-element--affiliated-re'. + +TRANS-LIST is an alist where key is the keyword and value the +property name it should be translated to, without the colons. It +defaults to `org-element-keyword-translation-alist'. + +CONSED is a list of strings. Any keyword belonging to that list +will have its value consed. The check is done after keyword +translation. It defaults to `org-element-multiple-keywords'. + +PARSED is a list of strings. Any keyword member of this list +will have its value parsed. The check is done after keyword +translation. If a keyword is a member of both CONSED and PARSED, +it's value will be a list of parsed strings. It defaults to +`org-element-parsed-keywords'. + +DUALS is a list of strings. Any keyword member of this list can +have two parts: one mandatory and one optional. Its value is +a cons cell whose CAR is the former, and the CDR the latter. If +a keyword is a member of both PARSED and DUALS, both values will +be parsed. It defaults to `org-element-dual-keywords'. + +Return a list whose CAR is the position at the first of them and +CDR a plist of keywords and values." + (save-excursion + (let ((case-fold-search t) + (key-re (or key-re org-element--affiliated-re)) + (trans-list (or trans-list org-element-keyword-translation-alist)) + (consed (or consed org-element-multiple-keywords)) + (parsed (or parsed org-element-parsed-keywords)) + (duals (or duals org-element-dual-keywords)) + ;; RESTRICT is the list of objects allowed in parsed + ;; keywords value. + (restrict (org-element-restriction 'keyword)) + output) + (unless (bobp) + (while (and (not (bobp)) (progn (forward-line -1) (looking-at key-re))) + (let* ((raw-kwd (upcase (match-string 1))) + ;; Apply translation to RAW-KWD. From there, KWD is + ;; the official keyword. + (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd)) + ;; Find main value for any keyword. + (value + (save-match-data + (org-trim + (buffer-substring-no-properties + (match-end 0) (point-at-eol))))) + ;; If KWD is a dual keyword, find its secondary + ;; value. Maybe parse it. + (dual-value + (and (member kwd duals) + (let ((sec (org-match-string-no-properties 2))) + (if (or (not sec) (not (member kwd parsed))) sec + (org-element-parse-secondary-string sec restrict))))) + ;; Attribute a property name to KWD. + (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) + ;; Now set final shape for VALUE. + (when (member kwd parsed) + (setq value (org-element-parse-secondary-string value restrict))) + (when (member kwd duals) + ;; VALUE is mandatory. Set it to nil if there is none. + (setq value (and value (cons value dual-value)))) + ;; Attributes are always consed. + (when (or (member kwd consed) (string-match "^ATTR_" kwd)) + (setq value (cons value (plist-get output kwd-sym)))) + ;; Eventually store the new value in OUTPUT. + (setq output (plist-put output kwd-sym value)))) + (unless (looking-at key-re) (forward-line 1))) + (list (point) output)))) + + + +;;; The Org Parser +;; +;; The two major functions here are `org-element-parse-buffer', which +;; parses Org syntax inside the current buffer, taking into account +;; region, narrowing, or even visibility if specified, and +;; `org-element-parse-secondary-string', which parses objects within +;; a given string. +;; +;; The (almost) almighty `org-element-map' allows to apply a function +;; on elements or objects matching some type, and accumulate the +;; resulting values. In an export situation, it also skips unneeded +;; parts of the parse tree. + +(defun org-element-parse-buffer (&optional granularity visible-only) + "Recursively parse the buffer and return structure. +If narrowing is in effect, only parse the visible part of the +buffer. + +Optional argument GRANULARITY determines the depth of the +recursion. It can be set to the following symbols: + +`headline' Only parse headlines. +`greater-element' Don't recurse into greater elements excepted + headlines and sections. Thus, elements + parsed are the top-level ones. +`element' Parse everything but objects and plain text. +`object' Parse the complete buffer (default). + +When VISIBLE-ONLY is non-nil, don't parse contents of hidden +elements. + +Assume buffer is in Org mode." + (save-excursion + (goto-char (point-min)) + (org-skip-whitespace) + (org-element--parse-elements + (point-at-bol) (point-max) + ;; Start in `first-section' mode so text before the first + ;; headline belongs to a section. + 'first-section nil granularity visible-only (list 'org-data nil)))) + +(defun org-element-parse-secondary-string (string restriction &optional parent) + "Recursively parse objects in STRING and return structure. + +RESTRICTION is a symbol limiting the object types that will be +looked after. + +Optional argument PARENT, when non-nil, is the element or object +containing the secondary string. It is used to set correctly +`:parent' property within the string." + (with-temp-buffer + (insert string) + (let ((secondary (org-element--parse-objects + (point-min) (point-max) nil restriction))) + (mapc (lambda (obj) (org-element-put-property obj :parent parent)) + secondary)))) + +(defun org-element-map (data types fun &optional info first-match no-recursion) + "Map a function on selected elements or objects. + +DATA is the parsed tree, as returned by, i.e, +`org-element-parse-buffer'. TYPES is a symbol or list of symbols +of elements or objects types. FUN is the function called on the +matching element or object. It must accept one arguments: the +element or object itself. + +When optional argument INFO is non-nil, it should be a plist +holding export options. In that case, parts of the parse tree +not exportable according to that property list will be skipped. + +When optional argument FIRST-MATCH is non-nil, stop at the first +match for which FUN doesn't return nil, and return that value. + +Optional argument NO-RECURSION is a symbol or a list of symbols +representing elements or objects types. `org-element-map' won't +enter any recursive element or object whose type belongs to that +list. Though, FUN can still be applied on them. + +Nil values returned from FUN do not appear in the results." + ;; Ensure TYPES and NO-RECURSION are a list, even of one element. + (unless (listp types) (setq types (list types))) + (unless (listp no-recursion) (setq no-recursion (list no-recursion))) + ;; Recursion depth is determined by --CATEGORY. + (let* ((--category + (catch 'found + (let ((category 'greater-elements)) + (mapc (lambda (type) + (cond ((or (memq type org-element-all-objects) + (eq type 'plain-text)) + ;; If one object is found, the function + ;; has to recurse into every object. + (throw 'found 'objects)) + ((not (memq type org-element-greater-elements)) + ;; If one regular element is found, the + ;; function has to recurse, at least, + ;; into every element it encounters. + (and (not (eq category 'elements)) + (setq category 'elements))))) + types) + category))) + --acc + --walk-tree + (--walk-tree + (function + (lambda (--data) + ;; Recursively walk DATA. INFO, if non-nil, is a plist + ;; holding contextual information. + (let ((--type (org-element-type --data))) + (cond + ((not --data)) + ;; Ignored element in an export context. + ((and info (memq --data (plist-get info :ignore-list)))) + ;; Secondary string: only objects can be found there. + ((not --type) + (when (eq --category 'objects) (mapc --walk-tree --data))) + ;; Unconditionally enter parse trees. + ((eq --type 'org-data) + (mapc --walk-tree (org-element-contents --data))) + (t + ;; Check if TYPE is matching among TYPES. If so, + ;; apply FUN to --DATA and accumulate return value + ;; into --ACC (or exit if FIRST-MATCH is non-nil). + (when (memq --type types) + (let ((result (funcall fun --data))) + (cond ((not result)) + (first-match (throw '--map-first-match result)) + (t (push result --acc))))) + ;; If --DATA has a secondary string that can contain + ;; objects with their type among TYPES, look into it. + (when (eq --category 'objects) + (let ((sec-prop + (assq --type org-element-secondary-value-alist))) + (when sec-prop + (funcall --walk-tree + (org-element-property (cdr sec-prop) --data))))) + ;; Determine if a recursion into --DATA is possible. + (cond + ;; --TYPE is explicitly removed from recursion. + ((memq --type no-recursion)) + ;; --DATA has no contents. + ((not (org-element-contents --data))) + ;; Looking for greater elements but --DATA is simply + ;; an element or an object. + ((and (eq --category 'greater-elements) + (not (memq --type org-element-greater-elements)))) + ;; Looking for elements but --DATA is an object. + ((and (eq --category 'elements) + (memq --type org-element-all-objects))) + ;; In any other case, map contents. + (t (mapc --walk-tree (org-element-contents --data))))))))))) + (catch '--map-first-match + (funcall --walk-tree data) + ;; Return value in a proper order. + (nreverse --acc)))) + +;; The following functions are internal parts of the parser. +;; +;; The first one, `org-element--parse-elements' acts at the element's +;; level. +;; +;; The second one, `org-element--parse-objects' applies on all objects +;; of a paragraph or a secondary string. It uses +;; `org-element--get-next-object-candidates' to optimize the search of +;; the next object in the buffer. +;; +;; More precisely, that function looks for every allowed object type +;; first. Then, it discards failed searches, keeps further matches, +;; and searches again types matched behind point, for subsequent +;; calls. Thus, searching for a given type fails only once, and every +;; object is searched only once at top level (but sometimes more for +;; nested types). + +(defun org-element--parse-elements + (beg end special structure granularity visible-only acc) + "Parse elements between BEG and END positions. + +SPECIAL prioritize some elements over the others. It can be set +to `first-section', `quote-section', `section' `item' or +`table-row'. + +When value is `item', STRUCTURE will be used as the current list +structure. + +GRANULARITY determines the depth of the recursion. See +`org-element-parse-buffer' for more information. + +When VISIBLE-ONLY is non-nil, don't parse contents of hidden +elements. + +Elements are accumulated into ACC." + (save-excursion + (goto-char beg) + ;; When parsing only headlines, skip any text before first one. + (when (and (eq granularity 'headline) (not (org-at-heading-p))) + (org-with-limited-levels (outline-next-heading))) + ;; Main loop start. + (while (< (point) end) + ;; Find current element's type and parse it accordingly to + ;; its category. + (let* ((element (org-element--current-element + end granularity special structure)) + (type (org-element-type element)) + (cbeg (org-element-property :contents-begin element))) + (goto-char (org-element-property :end element)) + ;; Fill ELEMENT contents by side-effect. + (cond + ;; If VISIBLE-ONLY is true and element is hidden or if it has + ;; no contents, don't modify it. + ((or (and visible-only (org-element-property :hiddenp element)) + (not cbeg))) + ;; Greater element: parse it between `contents-begin' and + ;; `contents-end'. Make sure GRANULARITY allows the + ;; recursion, or ELEMENT is an headline, in which case going + ;; inside is mandatory, in order to get sub-level headings. + ((and (memq type org-element-greater-elements) + (or (memq granularity '(element object nil)) + (and (eq granularity 'greater-element) + (eq type 'section)) + (eq type 'headline))) + (org-element--parse-elements + cbeg (org-element-property :contents-end element) + ;; Possibly switch to a special mode. + (case type + (headline + (if (org-element-property :quotedp element) 'quote-section + 'section)) + (plain-list 'item) + (table 'table-row)) + (org-element-property :structure element) + granularity visible-only element)) + ;; ELEMENT has contents. Parse objects inside, if + ;; GRANULARITY allows it. + ((memq granularity '(object nil)) + (org-element--parse-objects + cbeg (org-element-property :contents-end element) element + (org-element-restriction type)))) + (org-element-adopt-elements acc element))) + ;; Return result. + acc)) + +(defun org-element--parse-objects (beg end acc restriction) + "Parse objects between BEG and END and return recursive structure. + +Objects are accumulated in ACC. + +RESTRICTION is a list of object types which are allowed in the +current object." + (let (candidates) + (save-excursion + (goto-char beg) + (while (and (< (point) end) + (setq candidates (org-element--get-next-object-candidates + end restriction candidates))) + (let ((next-object + (let ((pos (apply 'min (mapcar 'cdr candidates)))) + (save-excursion + (goto-char pos) + (funcall (intern (format "org-element-%s-parser" + (car (rassq pos candidates))))))))) + ;; 1. Text before any object. Untabify it. + (let ((obj-beg (org-element-property :begin next-object))) + (unless (= (point) obj-beg) + (setq acc + (org-element-adopt-elements + acc + (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) obj-beg)))))) + ;; 2. Object... + (let ((obj-end (org-element-property :end next-object)) + (cont-beg (org-element-property :contents-begin next-object))) + ;; Fill contents of NEXT-OBJECT by side-effect, if it has + ;; a recursive type. + (when (and cont-beg + (memq (car next-object) org-element-recursive-objects)) + (save-restriction + (narrow-to-region + cont-beg + (org-element-property :contents-end next-object)) + (org-element--parse-objects + (point-min) (point-max) next-object + (org-element-restriction next-object)))) + (setq acc (org-element-adopt-elements acc next-object)) + (goto-char obj-end)))) + ;; 3. Text after last object. Untabify it. + (unless (= (point) end) + (setq acc + (org-element-adopt-elements + acc + (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) end))))) + ;; Result. + acc))) + +(defun org-element--get-next-object-candidates (limit restriction objects) + "Return an alist of candidates for the next object. + +LIMIT bounds the search, and RESTRICTION narrows candidates to +some object types. + +Return value is an alist whose CAR is position and CDR the object +type, as a symbol. + +OBJECTS is the previous candidates alist." + (let (next-candidates types-to-search) + ;; If no previous result, search every object type in RESTRICTION. + ;; Otherwise, keep potential candidates (old objects located after + ;; point) and ask to search again those which had matched before. + (if (not objects) (setq types-to-search restriction) + (mapc (lambda (obj) + (if (< (cdr obj) (point)) (push (car obj) types-to-search) + (push obj next-candidates))) + objects)) + ;; Call the appropriate successor function for each type to search + ;; and accumulate matches. + (mapc + (lambda (type) + (let* ((successor-fun + (intern + (format "org-element-%s-successor" + (or (cdr (assq type org-element-object-successor-alist)) + type)))) + (obj (funcall successor-fun limit))) + (and obj (push obj next-candidates)))) + types-to-search) + ;; Return alist. + next-candidates)) + + + +;;; Towards A Bijective Process +;; +;; The parse tree obtained with `org-element-parse-buffer' is really +;; a snapshot of the corresponding Org buffer. Therefore, it can be +;; interpreted and expanded into a string with canonical Org syntax. +;; Hence `org-element-interpret-data'. +;; +;; The function relies internally on +;; `org-element--interpret-affiliated-keywords'. + +;;;###autoload +(defun org-element-interpret-data (data &optional parent) + "Interpret DATA as Org syntax. + +DATA is a parse tree, an element, an object or a secondary string +to interpret. + +Optional argument PARENT is used for recursive calls. It contains +the element or object containing data, or nil. + +Return Org syntax as a string." + (let* ((type (org-element-type data)) + (results + (cond + ;; Secondary string. + ((not type) + (mapconcat + (lambda (obj) (org-element-interpret-data obj parent)) + data "")) + ;; Full Org document. + ((eq type 'org-data) + (mapconcat + (lambda (obj) (org-element-interpret-data obj parent)) + (org-element-contents data) "")) + ;; Plain text. + ((stringp data) data) + ;; Element/Object without contents. + ((not (org-element-contents data)) + (funcall (intern (format "org-element-%s-interpreter" type)) + data nil)) + ;; Element/Object with contents. + (t + (let* ((greaterp (memq type org-element-greater-elements)) + (objectp (and (not greaterp) + (memq type org-element-recursive-objects))) + (contents + (mapconcat + (lambda (obj) (org-element-interpret-data obj data)) + (org-element-contents + (if (or greaterp objectp) data + ;; Elements directly containing objects must + ;; have their indentation normalized first. + (org-element-normalize-contents + data + ;; When normalizing first paragraph of an + ;; item or a footnote-definition, ignore + ;; first line's indentation. + (and (eq type 'paragraph) + (equal data (car (org-element-contents parent))) + (memq (org-element-type parent) + '(footnote-definiton item)))))) + ""))) + (funcall (intern (format "org-element-%s-interpreter" type)) + data + (if greaterp (org-element-normalize-contents contents) + contents))))))) + (if (memq type '(org-data plain-text nil)) results + ;; Build white spaces. If no `:post-blank' property is + ;; specified, assume its value is 0. + (let ((post-blank (or (org-element-property :post-blank data) 0))) + (if (memq type org-element-all-objects) + (concat results (make-string post-blank 32)) + (concat + (org-element--interpret-affiliated-keywords data) + (org-element-normalize-string results) + (make-string post-blank 10))))))) + +(defun org-element--interpret-affiliated-keywords (element) + "Return ELEMENT's affiliated keywords as Org syntax. +If there is no affiliated keyword, return the empty string." + (let ((keyword-to-org + (function + (lambda (key value) + (let (dual) + (when (member key org-element-dual-keywords) + (setq dual (cdr value) value (car value))) + (concat "#+" key + (and dual + (format "[%s]" (org-element-interpret-data dual))) + ": " + (if (member key org-element-parsed-keywords) + (org-element-interpret-data value) + value) + "\n")))))) + (mapconcat + (lambda (prop) + (let ((value (org-element-property prop element)) + (keyword (upcase (substring (symbol-name prop) 1)))) + (when value + (if (or (member keyword org-element-multiple-keywords) + ;; All attribute keywords can have multiple lines. + (string-match "^ATTR_" keyword)) + (mapconcat (lambda (line) (funcall keyword-to-org keyword line)) + value + "") + (funcall keyword-to-org keyword value))))) + ;; List all ELEMENT's properties matching an attribute line or an + ;; affiliated keyword, but ignore translated keywords since they + ;; cannot belong to the property list. + (loop for prop in (nth 1 element) by 'cddr + when (let ((keyword (upcase (substring (symbol-name prop) 1)))) + (or (string-match "^ATTR_" keyword) + (and + (member keyword org-element-affiliated-keywords) + (not (assoc keyword + org-element-keyword-translation-alist))))) + collect prop) + ""))) + +;; Because interpretation of the parse tree must return the same +;; number of blank lines between elements and the same number of white +;; space after objects, some special care must be given to white +;; spaces. +;; +;; The first function, `org-element-normalize-string', ensures any +;; string different from the empty string will end with a single +;; newline character. +;; +;; The second function, `org-element-normalize-contents', removes +;; global indentation from the contents of the current element. + +(defun org-element-normalize-string (s) + "Ensure string S ends with a single newline character. + +If S isn't a string return it unchanged. If S is the empty +string, return it. Otherwise, return a new string with a single +newline character at its end." + (cond + ((not (stringp s)) s) + ((string= "" s) "") + (t (and (string-match "\\(\n[ \t]*\\)*\\'" s) + (replace-match "\n" nil nil s))))) + +(defun org-element-normalize-contents (element &optional ignore-first) + "Normalize plain text in ELEMENT's contents. + +ELEMENT must only contain plain text and objects. + +If optional argument IGNORE-FIRST is non-nil, ignore first line's +indentation to compute maximal common indentation. + +Return the normalized element that is element with global +indentation removed from its contents. The function assumes that +indentation is not done with TAB characters." + (let* (ind-list ; for byte-compiler + collect-inds ; for byte-compiler + (collect-inds + (function + ;; Return list of indentations within BLOB. This is done by + ;; walking recursively BLOB and updating IND-LIST along the + ;; way. FIRST-FLAG is non-nil when the first string hasn't + ;; been seen yet. It is required as this string is the only + ;; one whose indentation doesn't happen after a newline + ;; character. + (lambda (blob first-flag) + (mapc + (lambda (object) + (when (and first-flag (stringp object)) + (setq first-flag nil) + (string-match "\\`\\( *\\)" object) + (let ((len (length (match-string 1 object)))) + ;; An indentation of zero means no string will be + ;; modified. Quit the process. + (if (zerop len) (throw 'zero (setq ind-list nil)) + (push len ind-list)))) + (cond + ((stringp object) + (let ((start 0)) + ;; Avoid matching blank or empty lines. + (while (and (string-match "\n\\( *\\)\\(.\\)" object start) + (not (equal (match-string 2 object) " "))) + (setq start (match-end 0)) + (push (length (match-string 1 object)) ind-list)))) + ((memq (org-element-type object) org-element-recursive-objects) + (funcall collect-inds object first-flag)))) + (org-element-contents blob)))))) + ;; Collect indentation list in ELEMENT. Possibly remove first + ;; value if IGNORE-FIRST is non-nil. + (catch 'zero (funcall collect-inds element (not ignore-first))) + (if (not ind-list) element + ;; Build ELEMENT back, replacing each string with the same + ;; string minus common indentation. + (let* (build ; For byte compiler. + (build + (function + (lambda (blob mci first-flag) + ;; Return BLOB with all its strings indentation + ;; shortened from MCI white spaces. FIRST-FLAG is + ;; non-nil when the first string hasn't been seen + ;; yet. + (setcdr (cdr blob) + (mapcar + (lambda (object) + (when (and first-flag (stringp object)) + (setq first-flag nil) + (setq object + (replace-regexp-in-string + (format "\\` \\{%d\\}" mci) "" object))) + (cond + ((stringp object) + (replace-regexp-in-string + (format "\n \\{%d\\}" mci) "\n" object)) + ((memq (org-element-type object) + org-element-recursive-objects) + (funcall build object mci first-flag)) + (t object))) + (org-element-contents blob))) + blob)))) + (funcall build element (apply 'min ind-list) (not ignore-first)))))) + + + +;;; The Toolbox +;; +;; The first move is to implement a way to obtain the smallest element +;; containing point. This is the job of `org-element-at-point'. It +;; basically jumps back to the beginning of section containing point +;; and moves, element after element, with +;; `org-element--current-element' until the container is found. Note: +;; When using `org-element-at-point', secondary values are never +;; parsed since the function focuses on elements, not on objects. +;; +;; At a deeper level, `org-element-context' lists all elements and +;; objects containing point. +;; +;; `org-element-nested-p' and `org-element-swap-A-B' may be used +;; internally by navigation and manipulation tools. + +;;;###autoload +(defun org-element-at-point (&optional keep-trail) + "Determine closest element around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. + +Possible types are defined in `org-element-all-elements'. +Properties depend on element or object type, but always +include :begin, :end, :parent and :post-blank properties. + +As a special case, if point is at the very beginning of a list or +sub-list, returned element will be that list instead of the first +item. In the same way, if point is at the beginning of the first +row of a table, returned element will be the table instead of the +first row. + +If optional argument KEEP-TRAIL is non-nil, the function returns +a list of of elements leading to element at point. The list's +CAR is always the element at point. Following positions contain +element's siblings, then parents, siblings of parents, until the +first element of current section." + (org-with-wide-buffer + ;; If at an headline, parse it. It is the sole element that + ;; doesn't require to know about context. Be sure to disallow + ;; secondary string parsing, though. + (if (org-with-limited-levels (org-at-heading-p)) + (progn + (beginning-of-line) + (if (not keep-trail) (org-element-headline-parser (point-max) t) + (list (org-element-headline-parser (point-max) t)))) + ;; Otherwise move at the beginning of the section containing + ;; point. + (let ((origin (point)) + (end (save-excursion + (org-with-limited-levels (outline-next-heading)) (point))) + element type special-flag trail struct prevs parent) + (org-with-limited-levels + (if (org-with-limited-levels (org-before-first-heading-p)) + (goto-char (point-min)) + (org-back-to-heading) + (forward-line))) + (org-skip-whitespace) + (beginning-of-line) + ;; Parse successively each element, skipping those ending + ;; before original position. + (catch 'exit + (while t + (setq element + (org-element--current-element end 'element special-flag struct) + type (car element)) + (org-element-put-property element :parent parent) + (when keep-trail (push element trail)) + (cond + ;; 1. Skip any element ending before point. Also skip + ;; element ending at point when we're sure that another + ;; element has started. + ((let ((elem-end (org-element-property :end element))) + (when (or (< elem-end origin) + (and (= elem-end origin) (/= elem-end end))) + (goto-char elem-end)))) + ;; 2. An element containing point is always the element at + ;; point. + ((not (memq type org-element-greater-elements)) + (throw 'exit (if keep-trail trail element))) + ;; 3. At any other greater element type, if point is + ;; within contents, move into it. + (t + (let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin) + ;; Create an anchor for tables and plain lists: + ;; when point is at the very beginning of these + ;; elements, ignoring affiliated keywords, + ;; target them instead of their contents. + (and (= cbeg origin) (memq type '(plain-list table))) + ;; When point is at contents end, do not move + ;; into elements with an explicit ending, but + ;; return that element instead. + (and (= cend origin) + (memq type + '(center-block + drawer dynamic-block inlinetask item + plain-list quote-block special-block)))) + (throw 'exit (if keep-trail trail element)) + (setq parent element) + (case type + (plain-list + (setq special-flag 'item + struct (org-element-property :structure element))) + (table (setq special-flag 'table-row)) + (otherwise (setq special-flag nil))) + (setq end cend) + (goto-char cbeg))))))))))) + +;;;###autoload +(defun org-element-context () + "Return closest element or object around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element or object and PROPS a plist of properties +associated to it. + +Possible types are defined in `org-element-all-elements' and +`org-element-all-objects'. Properties depend on element or +object type, but always include :begin, :end, :parent +and :post-blank properties." + (org-with-wide-buffer + (let* ((origin (point)) + (element (org-element-at-point)) + (type (car element)) + end) + ;; Check if point is inside an element containing objects or at + ;; a secondary string. In that case, move to beginning of the + ;; element or secondary string and set END to the other side. + (if (not (or (and (eq type 'item) + (let ((tag (org-element-property :tag element))) + (and tag + (progn + (beginning-of-line) + (search-forward tag (point-at-eol)) + (goto-char (match-beginning 0)) + (and (>= origin (point)) + (<= origin + ;; `1+' is required so some + ;; successors can match + ;; properly their object. + (setq end (1+ (match-end 0))))))))) + (and (memq type '(headline inlinetask)) + (progn (beginning-of-line) + (skip-chars-forward "* ") + (setq end (point-at-eol)))) + (and (memq type '(paragraph table-cell verse-block)) + (let ((cbeg (org-element-property + :contents-begin element)) + (cend (org-element-property + :contents-end element))) + (and (>= origin cbeg) + (<= origin cend) + (progn (goto-char cbeg) (setq end cend))))))) + element + (let ((restriction (org-element-restriction element)) + (parent element) + candidates) + (catch 'exit + (while (setq candidates (org-element--get-next-object-candidates + end restriction candidates)) + (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates)) + candidates))) + ;; If ORIGIN is before next object in element, there's + ;; no point in looking further. + (if (> (cdr closest-cand) origin) (throw 'exit element) + (let* ((object + (progn (goto-char (cdr closest-cand)) + (funcall (intern (format "org-element-%s-parser" + (car closest-cand)))))) + (cbeg (org-element-property :contents-begin object)) + (cend (org-element-property :contents-end object))) + (cond + ;; ORIGIN is after OBJECT, so skip it. + ((< (org-element-property :end object) origin) + (goto-char (org-element-property :end object))) + ;; ORIGIN is within a non-recursive object or at an + ;; object boundaries: Return that object. + ((or (not cbeg) (> cbeg origin) (< cend origin)) + (throw 'exit + (org-element-put-property object :parent parent))) + ;; Otherwise, move within current object and restrict + ;; search to the end of its contents. + (t (goto-char cbeg) + (org-element-put-property object :parent parent) + (setq parent object end cend))))))) + parent)))))) + +(defsubst org-element-nested-p (elem-A elem-B) + "Non-nil when elements ELEM-A and ELEM-B are nested." + (let ((beg-A (org-element-property :begin elem-A)) + (beg-B (org-element-property :begin elem-B)) + (end-A (org-element-property :end elem-A)) + (end-B (org-element-property :end elem-B))) + (or (and (>= beg-A beg-B) (<= end-A end-B)) + (and (>= beg-B beg-A) (<= end-B end-A))))) + +(defun org-element-swap-A-B (elem-A elem-B) + "Swap elements ELEM-A and ELEM-B. +Assume ELEM-B is after ELEM-A in the buffer. Leave point at the +end of ELEM-A." + (goto-char (org-element-property :begin elem-A)) + ;; There are two special cases when an element doesn't start at bol: + ;; the first paragraph in an item or in a footnote definition. + (let ((specialp (not (bolp)))) + ;; Only a paragraph without any affiliated keyword can be moved at + ;; ELEM-A position in such a situation. Note that the case of + ;; a footnote definition is impossible: it cannot contain two + ;; paragraphs in a row because it cannot contain a blank line. + (if (and specialp + (or (not (eq (org-element-type elem-B) 'paragraph)) + (/= (org-element-property :begin elem-B) + (org-element-property :contents-begin elem-B)))) + (error "Cannot swap elements")) + ;; In a special situation, ELEM-A will have no indentation. We'll + ;; give it ELEM-B's (which will in, in turn, have no indentation). + (let* ((ind-B (when specialp + (goto-char (org-element-property :begin elem-B)) + (org-get-indentation))) + (beg-A (org-element-property :begin elem-A)) + (end-A (save-excursion + (goto-char (org-element-property :end elem-A)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + (beg-B (org-element-property :begin elem-B)) + (end-B (save-excursion + (goto-char (org-element-property :end elem-B)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + ;; Store overlays responsible for visibility status. We + ;; also need to store their boundaries as they will be + ;; removed from buffer. + (overlays + (cons + (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov))) + (overlays-in beg-A end-A)) + (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov))) + (overlays-in beg-B end-B)))) + ;; Get contents. + (body-A (buffer-substring beg-A end-A)) + (body-B (delete-and-extract-region beg-B end-B))) + (goto-char beg-B) + (when specialp + (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) + (org-indent-to-column ind-B)) + (insert body-A) + ;; Restore ex ELEM-A overlays. + (let ((offset (- beg-B beg-A))) + (mapc (lambda (ov) + (move-overlay + (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset))) + (car overlays)) + (goto-char beg-A) + (delete-region beg-A end-A) + (insert body-B) + ;; Restore ex ELEM-B overlays. + (mapc (lambda (ov) + (move-overlay + (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset))) + (cdr overlays))) + (goto-char (org-element-property :end elem-B))))) + + +(provide 'org-element) +;;; org-element.el ends here diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 8b5b3f312e..bd675c376b 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -252,7 +252,7 @@ loaded, add these packages to `org-export-latex-packages-alist'." "* Other" "** Misc. (often used)" - ("circ" "\\circ" t "ˆ" "^" "^" "ˆ") + ("circ" "\\^{}" nil "ˆ" "^" "^" "ˆ") ("vert" "\\vert{}" t "|" "|" "|" "|") ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") ("sect" "\\S" nil "§" "paragraph" "§" "§") @@ -260,6 +260,11 @@ loaded, add these packages to `org-export-latex-packages-alist'." ("lt" "\\textless{}" nil "<" "<" "<" "<") ("gt" "\\textgreater{}" nil ">" ">" ">" ">") ("tilde" "\\~{}" nil "˜" "~" "~" "~") + ("slash" "/" nil "/" "/" "/" "/") + ("plus" "+" nil "+" "+" "+" "+") + ("under" "\\_" nil "_" "_" "_" "_") + ("equal" "=" nil "=" "=" "=" "=") + ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^") ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") @@ -492,34 +497,31 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." ;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org (defun org-entities-create-table () - "Create an org-mode table with all entities." + "Create an Org mode table with all entities." (interactive) - (let ((ll org-entities) - (pos (point)) - e latex mathp html latin utf8 name ascii) + (let ((pos (point)) e latex mathp html latin utf8 name ascii) (insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n") - (while ll - (when (listp e) - (setq e (pop ll)) - (setq name (car e) - latex (nth 1 e) - mathp (nth 2 e) - html (nth 3 e) - ascii (nth 4 e) - latin (nth 5 e) - utf8 (nth 6 e)) - (if (equal ascii "|") (setq ascii "\\vert")) - (if (equal latin "|") (setq latin "\\vert")) - (if (equal utf8 "|") (setq utf8 "\\vert")) - (if (equal ascii "=>") (setq ascii "= >")) - (if (equal latin "=>") (setq latin "= >")) - (insert "|" name - "|" (format "=%s=" latex) - "|" (format (if mathp "$%s$" "$\\mbox{%s}$") - latex) - "|" (format "=%s=" html) "|" html - "|" ascii "|" latin "|" utf8 - "|\n"))) + (mapc (lambda (e) (when (listp e) + (setq name (car e) + latex (nth 1 e) + mathp (nth 2 e) + html (nth 3 e) + ascii (nth 4 e) + latin (nth 5 e) + utf8 (nth 6 e)) + (if (equal ascii "|") (setq ascii "\\vert")) + (if (equal latin "|") (setq latin "\\vert")) + (if (equal utf8 "|") (setq utf8 "\\vert")) + (if (equal ascii "=>") (setq ascii "= >")) + (if (equal latin "=>") (setq latin "= >")) + (insert "|" name + "|" (format "=%s=" latex) + "|" (format (if mathp "$%s$" "$\\mbox{%s}$") + latex) + "|" (format "=%s=" html) "|" html + "|" ascii "|" latin "|" utf8 + "|\n"))) + org-entities) (goto-char pos) (org-table-align))) diff --git a/lisp/org/org-eshell.el b/lisp/org/org-eshell.el index f572095d81..4335fce578 100644 --- a/lisp/org/org-eshell.el +++ b/lisp/org/org-eshell.el @@ -37,18 +37,18 @@ followed by a colon." (let* ((buffer-and-command (if (string-match "\\([A-Za-z0-9-+*]+\\):\\(.*\\)" link) - (list (match-string 1 link) - (match-string 2 link)) + (list (match-string 1 link) + (match-string 2 link)) (list eshell-buffer-name link))) (eshell-buffer-name (car buffer-and-command)) (command (cadr buffer-and-command))) - (if (get-buffer eshell-buffer-name) - (org-pop-to-buffer-same-window eshell-buffer-name) - (eshell)) - (goto-char (point-max)) - (eshell-kill-input) - (insert command) - (eshell-send-input))) + (if (get-buffer eshell-buffer-name) + (org-pop-to-buffer-same-window eshell-buffer-name) + (eshell)) + (goto-char (point-max)) + (eshell-kill-input) + (insert command) + (eshell-send-input))) (defun org-eshell-store-link () "Store a link that, when opened, switches back to the current eshell buffer @@ -57,7 +57,7 @@ (let* ((command (concat "cd " dired-directory)) (link (concat (buffer-name) ":" command))) (org-store-link-props - :link (org-make-link "eshell:" link) + :link (concat "eshell:" link) :description command)))) (provide 'org-eshell) diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el index fbac659209..89a0e5e550 100644 --- a/lisp/org/org-exp-blocks.el +++ b/lisp/org/org-exp-blocks.el @@ -72,8 +72,13 @@ (eval-when-compile (require 'cl)) -(require 'org) (require 'find-func) +(require 'org-compat) + +(declare-function org-split-string "org" (string &optional separators)) +(declare-function org-remove-indentation "org" (code &optional n)) + +(defvar org-protecting-blocks nil) ; From org.el (defun org-export-blocks-set (var value) "Set the value of `org-export-blocks' and install fontification." @@ -142,7 +147,6 @@ export function should accept three arguments." (defun org-export-blocks-html-quote (body &optional open close) "Protect BODY from org html export. The optional OPEN and CLOSE tags will be inserted around BODY." - (concat "\n#+BEGIN_HTML\n" (or open "") @@ -160,6 +164,7 @@ The optional OPEN and CLOSE tags will be inserted around BODY." (or close "") "#+END_LaTeX\n")) +(defvar org-src-preserve-indentation) ; From org-src.el (defun org-export-blocks-preprocess () "Export all blocks according to the `org-export-blocks' block export alist. Does not export block types specified in specified in BLOCKS @@ -167,65 +172,70 @@ which defaults to the value of `org-export-blocks-witheld'." (interactive) (save-window-excursion (let ((case-fold-search t) - (types '()) - matched indentation type func + (interblock (lambda (start end) + (mapcar (lambda (pair) (funcall (second pair) start end)) + org-export-interblocks))) + matched indentation type types func start end body headers preserve-indent progress-marker) - (flet ((interblock (start end) - (mapcar (lambda (pair) (funcall (second pair) start end)) - org-export-interblocks))) - (goto-char (point-min)) - (setq start (point)) - (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]")) - (while (re-search-forward beg-re nil t) - (let* ((match-start (copy-marker (match-beginning 0))) - (body-start (copy-marker (match-end 0))) - (indentation (length (match-string 1))) - (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s" - (regexp-quote (downcase (match-string 2))))) - (type (intern (downcase (match-string 2)))) - (headers (save-match-data - (org-split-string (match-string 3) "[ \t]+"))) - (balanced 1) - (preserve-indent (or org-src-preserve-indentation - (member "-i" headers))) - match-end) - (while (and (not (zerop balanced)) - (re-search-forward inner-re nil t)) - (if (string= (downcase (match-string 1)) "end") - (decf balanced) - (incf balanced))) - (when (not (zerop balanced)) - (error "unbalanced begin/end_%s blocks with %S" - type (buffer-substring match-start (point)))) - (setq match-end (copy-marker (match-end 0))) - (unless preserve-indent - (setq body (save-match-data (org-remove-indentation - (buffer-substring - body-start (match-beginning 0)))))) - (unless (memq type types) (setq types (cons type types))) - (save-match-data (interblock start match-start)) - (when (setq func (cadr (assoc type org-export-blocks))) - (let ((replacement (save-match-data - (if (memq type org-export-blocks-witheld) "" - (apply func body headers))))) - (when replacement - (delete-region match-start match-end) - (goto-char match-start) (insert replacement) - (if preserve-indent - ;; indent only the code block markers - (save-excursion - (indent-line-to indentation) ; indent end_block - (goto-char match-start) - (indent-line-to indentation)) ; indent begin_block - ;; indent everything - (indent-code-rigidly match-start (point) indentation))))) - ;; cleanup markers - (set-marker match-start nil) - (set-marker body-start nil) - (set-marker match-end nil)) - (setq start (point)))) - (interblock start (point-max)) - (run-hooks 'org-export-blocks-postblock-hook))))) + (goto-char (point-min)) + (setq start (point)) + (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]")) + (while (re-search-forward beg-re nil t) + (let* ((match-start (copy-marker (match-beginning 0))) + (body-start (copy-marker (match-end 0))) + (indentation (length (match-string 1))) + (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s" + (regexp-quote (downcase (match-string 2))))) + (type (intern (downcase (match-string 2)))) + (headers (save-match-data + (org-split-string (match-string 3) "[ \t]+"))) + (balanced 1) + (preserve-indent (or org-src-preserve-indentation + (member "-i" headers))) + match-end) + (while (and (not (zerop balanced)) + (re-search-forward inner-re nil t)) + (if (string= (downcase (match-string 1)) "end") + (decf balanced) + (incf balanced))) + (when (not (zerop balanced)) + (error "Unbalanced begin/end_%s blocks with %S" + type (buffer-substring match-start (point)))) + (setq match-end (copy-marker (match-end 0))) + (unless preserve-indent + (setq body (save-match-data (org-remove-indentation + (buffer-substring + body-start (match-beginning 0)))))) + (unless (memq type types) (setq types (cons type types))) + (save-match-data (funcall interblock start match-start)) + (when (setq func (cadr (assoc type org-export-blocks))) + (let ((replacement (save-match-data + (if (memq type org-export-blocks-witheld) "" + (apply func body headers))))) + ;; ;; un-comment this code after the org-element merge + ;; (save-match-data + ;; (when (and replacement (string= replacement "")) + ;; (delete-region + ;; (car (org-element-collect-affiliated-keyword)) + ;; match-start))) + (when replacement + (delete-region match-start match-end) + (goto-char match-start) (insert replacement) + (if preserve-indent + ;; indent only the code block markers + (save-excursion + (indent-line-to indentation) ; indent end_block + (goto-char match-start) + (indent-line-to indentation)) ; indent begin_block + ;; indent everything + (indent-code-rigidly match-start (point) indentation))))) + ;; cleanup markers + (set-marker match-start nil) + (set-marker body-start nil) + (set-marker match-end nil)) + (setq start (point)))) + (funcall interblock start (point-max)) + (run-hooks 'org-export-blocks-postblock-hook)))) ;;================================================================================ ;; type specific functions @@ -233,14 +243,14 @@ which defaults to the value of `org-export-blocks-witheld'." ;;-------------------------------------------------------------------------------- ;; ditaa: create images from ASCII art using the ditaa utility (defcustom org-ditaa-jar-path (expand-file-name - "ditaa.jar" - (file-name-as-directory - (expand-file-name - "scripts" - (file-name-as-directory - (expand-file-name - "../contrib" - (file-name-directory (find-library-name "org"))))))) + "ditaa.jar" + (file-name-as-directory + (expand-file-name + "scripts" + (file-name-as-directory + (expand-file-name + "../contrib" + (file-name-directory (org-find-library-dir "org"))))))) "Path to the ditaa jar executable." :group 'org-babel :type 'string) @@ -273,29 +283,29 @@ passed to the ditaa utility as command line arguments." (org-split-string body "\n") "\n"))) (prog1 - (cond - ((member org-export-current-backend '(html latex docbook)) - (unless (file-exists-p out-file) - (mapc ;; remove old hashed versions of this file - (lambda (file) - (when (and (string-match (concat (regexp-quote (car out-file-parts)) - "_\\([[:alnum:]]+\\)\\." - (regexp-quote (cdr out-file-parts))) - file) - (= (length (match-string 1 out-file)) 40)) - (delete-file (expand-file-name file - (file-name-directory out-file))))) - (directory-files (or (file-name-directory out-file) - default-directory))) - (with-temp-file data-file (insert body)) - (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) - (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))) - (format "\n[[file:%s]]\n" out-file)) - (t (concat - "\n#+BEGIN_EXAMPLE\n" - body (if (string-match "\n$" body) "" "\n") - "#+END_EXAMPLE\n"))) - (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")))) + (cond + ((member org-export-current-backend '(html latex docbook)) + (unless (file-exists-p out-file) + (mapc ;; remove old hashed versions of this file + (lambda (file) + (when (and (string-match (concat (regexp-quote (car out-file-parts)) + "_\\([[:alnum:]]+\\)\\." + (regexp-quote (cdr out-file-parts))) + file) + (= (length (match-string 1 out-file)) 40)) + (delete-file (expand-file-name file + (file-name-directory out-file))))) + (directory-files (or (file-name-directory out-file) + default-directory))) + (with-temp-file data-file (insert body)) + (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) + (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))) + (format "\n[[file:%s]]\n" out-file)) + (t (concat + "\n#+BEGIN_EXAMPLE\n" + body (if (string-match "\n$" body) "" "\n") + "#+END_EXAMPLE\n"))) + (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")))) ;;-------------------------------------------------------------------------------- ;; dot: create graphs using the dot graphing language @@ -332,29 +342,29 @@ digraph data_relationships { (cons raw-out-file "png"))) (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) (prog1 - (cond - ((member org-export-current-backend '(html latex docbook)) - (unless (file-exists-p out-file) - (mapc ;; remove old hashed versions of this file - (lambda (file) - (when (and (string-match (concat (regexp-quote (car out-file-parts)) - "_\\([[:alnum:]]+\\)\\." - (regexp-quote (cdr out-file-parts))) - file) - (= (length (match-string 1 out-file)) 40)) - (delete-file (expand-file-name file - (file-name-directory out-file))))) - (directory-files (or (file-name-directory out-file) - default-directory))) - (with-temp-file data-file (insert body)) - (message (concat "dot " data-file " " args " -o " out-file)) - (shell-command (concat "dot " data-file " " args " -o " out-file))) - (format "\n[[file:%s]]\n" out-file)) - (t (concat - "\n#+BEGIN_EXAMPLE\n" - body (if (string-match "\n$" body) "" "\n") - "#+END_EXAMPLE\n"))) - (message "begin_dot blocks are DEPRECATED, use begin_src blocks")))) + (cond + ((member org-export-current-backend '(html latex docbook)) + (unless (file-exists-p out-file) + (mapc ;; remove old hashed versions of this file + (lambda (file) + (when (and (string-match (concat (regexp-quote (car out-file-parts)) + "_\\([[:alnum:]]+\\)\\." + (regexp-quote (cdr out-file-parts))) + file) + (= (length (match-string 1 out-file)) 40)) + (delete-file (expand-file-name file + (file-name-directory out-file))))) + (directory-files (or (file-name-directory out-file) + default-directory))) + (with-temp-file data-file (insert body)) + (message (concat "dot " data-file " " args " -o " out-file)) + (shell-command (concat "dot " data-file " " args " -o " out-file))) + (format "\n[[file:%s]]\n" out-file)) + (t (concat + "\n#+BEGIN_EXAMPLE\n" + body (if (string-match "\n$" body) "" "\n") + "#+END_EXAMPLE\n"))) + (message "begin_dot blocks are DEPRECATED, use begin_src blocks")))) ;;-------------------------------------------------------------------------------- ;; comment: export comments in author-specific css-stylable divs diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el index 174619a3b8..6b506cd127 100644 --- a/lisp/org/org-exp.el +++ b/lisp/org/org-exp.el @@ -1,4 +1,4 @@ -;;; org-exp.el --- ASCII, HTML, XOXO and iCalendar export for Org-mode +;;; org-exp.el --- Export internals for Org-mode ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. @@ -190,16 +190,31 @@ This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." ("eo" "Aŭtoro" "Dato" "Enhavo" "Piednotoj") ("es" "Autor" "Fecha" "Índice" "Pies de página") ("fi" "Tekijä" "Päivämäärä" "Sisällysluettelo" "Alaviitteet") - ("fr" "Auteur" "Date" "Table des matières" "Notes de bas de page") + ("fr" "Auteur" "Date" "Sommaire" "Notes de bas de page") ("hu" "Szerzõ" "Dátum" "Tartalomjegyzék" "Lábjegyzet") ("is" "Höfundur" "Dagsetning" "Efnisyfirlit" "Aftanmálsgreinar") ("it" "Autore" "Data" "Indice" "Note a piè di pagina") + ;; Use numeric character entities for proper rendering of non-UTF8 documents + ;; ("ja" "著者" "日付" "目次" "脚注") + ("ja" "著者" "日付" "目次" "脚注") ("nl" "Auteur" "Datum" "Inhoudsopgave" "Voetnoten") ("no" "Forfatter" "Dato" "Innhold" "Fotnoter") ("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l) ("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk) ("pl" "Autor" "Data" "Spis treści" "Przypis") - ("sv" "Författare" "Datum" "Innehåll" "Fotnoter")) + ;; Use numeric character entities for proper rendering of non-UTF8 documents + ;; ("ru" "Автор" "Дата" "Содержание" "Сноски") + ("ru" "Автор" "Дата" "Содержание" "Сноски") + ("sv" "Författare" "Datum" "Innehåll" "Fotnoter") + ;; Use numeric character entities for proper rendering of non-UTF8 documents + ;; ("uk" "Автор" "Дата" "Зміст" "Примітки") + ("uk" "Автор" "Дата" "Зміст" "Примітки") + ;; Use numeric character entities for proper rendering of non-UTF8 documents + ;; ("zh-CN" "作者" "日期" "目录" "脚注") + ("zh-CN" "作者" "日期" "目录" "脚注") + ;; Use numeric character entities for proper rendering of non-UTF8 documents + ;; ("zh-TW" "作者" "日期" "目錄" "腳註") + ("zh-TW" "作者" "日期" "目錄" "腳註")) "Terms used in export text, translated to different languages. Use the variable `org-export-default-language' to set the language, or use the +OPTION lines for a per-file setting." @@ -525,12 +540,14 @@ This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\". Allowed values are: -nil Don't do anything. -verbatim Keep everything in verbatim -dvipng Process the LaTeX fragments to images. - This will also include processing of non-math environments. -t Do MathJax preprocessing if there is at least on math snippet, - and arrange for MathJax.js to be loaded. +nil Don't do anything. +verbatim Keep everything in verbatim +dvipng Process the LaTeX fragments to images. + This will also include processing of non-math environments. +imagemagick Convert the LaTeX fragments to pdf files and use imagemagick + to convert pdf files to png files. +t Do MathJax preprocessing if there is at least on math snippet, + and arrange for MathJax.js to be loaded. The default is nil, because this option needs the `dvipng' program which is not available on all systems." @@ -540,6 +557,7 @@ is not available on all systems." (const :tag "Do not process math in any way" nil) (const :tag "Obsolete, use dvipng setting" t) (const :tag "Use dvipng to make images" dvipng) + (const :tag "Use imagemagick to make images" imagemagick) (const :tag "Use MathJax to display math" mathjax) (const :tag "Leave math verbatim" verbatim))) @@ -623,7 +641,7 @@ table.el tables." (defvar org-export-current-backend nil "During export, this will be bound to a symbol such as 'html, 'latex, 'docbook, 'ascii, etc, indicating which of the export - backends is in use. Otherwise it has the value nil. Users + backends is in use. Otherwise it has the value nil. Users should not attempt to change the value of this variable directly, but it can be used in code to test whether export is in progress, and if so, what the backend is.") @@ -702,7 +720,7 @@ Each element is a list of 3 items: 2. The string that can be used in the OPTION lines to set this option, or nil if this option cannot be changed in this way 3. The customization variable that sets the default for this option." -) + ) (defun org-default-export-plist () "Return the property list with default settings for the export variables." @@ -713,8 +731,7 @@ Each element is a list of 3 items: (setq s (nth 2 e) v (cond ((assq s letbind) (nth 1 (assq s letbind))) - ((boundp s) (symbol-value s)) - (t nil)) + ((boundp s) (symbol-value s))) rtn (cons (car e) (cons v rtn)))) rtn)) @@ -957,6 +974,8 @@ Pressing `1' will switch between these two options." (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background)) (subtree-p (or (org-region-active-p) (eq org-export-initial-scope 'subtree))) + (regb (and (org-region-active-p) (region-beginning))) + (rege (and (org-region-active-p) (region-end))) (help "[t] insert the export option template \[v] limit export to visible part of outline tree \[1] switch buffer/subtree export @@ -1037,6 +1056,10 @@ Pressing `1' will switch between these two options." ((not subtree-p) (setq subtree-p t) (setq bpos (point)) + (org-mark-subtree) + (org-activate-mark) + (setq regb (and (org-region-active-p) (region-beginning))) + (setq rege (and (org-region-active-p) (region-end))) (message "Export subtree: ")))) (when (eq r1 ?\ ) (let ((case-fold-search t) @@ -1074,8 +1097,9 @@ Pressing `1' will switch between these two options." "-f" (symbol-name (nth 1 ass))))) (set-process-sentinel p 'org-export-process-sentinel) (message "Background process \"%s\": started" p)) - ;; background processing not requested, or not possible - (if subtree-p (progn (org-mark-subtree) (org-activate-mark))) + ;; set the mark correctly when exporting a subtree + (if subtree-p (let (deactivate-mark) (push-mark rege t t) (goto-char regb))) + (call-interactively (nth 1 ass)) (when (and bpos (get-buffer-window cbuf)) (let ((cw (selected-window))) @@ -1184,7 +1208,7 @@ on this string to produce the exported version." (when (plist-get parameters :footnotes) (org-footnote-normalize nil parameters)) - ;; Change lists ending. Other parts of export may insert blank + ;; Change lists ending. Other parts of export may insert blank ;; lines and lists' structure could be altered. (org-export-mark-list-end) @@ -1300,11 +1324,8 @@ on this string to produce the exported version." ;; Remove or replace comments (org-export-handle-comments (plist-get parameters :comments)) - ;; Remove #+TBLFM and #+TBLNAME lines - (org-export-handle-table-metalines) - - ;; Remove #+results and #+name lines - (org-export-res/src-name-cleanup) + ;; Remove #+TBLFM #+TBLNAME #+NAME #+RESULTS lines + (org-export-handle-metalines) ;; Run the final hook (run-hooks 'org-export-preprocess-final-hook) @@ -1406,53 +1427,53 @@ the current file." (goto-char (point-min)) (while (re-search-forward org-bracket-link-regexp nil t) (org-if-unprotected-at (1+ (match-beginning 0)) - (let* ((org-link-search-must-match-exact-headline t) - (md (match-data)) - (desc (match-end 2)) - (link (org-link-unescape (match-string 1))) - (slink (org-solidify-link-text link)) - found props pos cref - (target - (cond - ((= (string-to-char link) ?#) - ;; user wants exactly this link - link) - ((cdr (assoc slink target-alist)) - (or (cdr (assoc (assoc slink target-alist) - org-export-preferred-target-alist)) - (cdr (assoc slink target-alist)))) - ((and (string-match "^id:" link) - (cdr (assoc (substring link 3) target-alist)))) - ((string-match "^(\\(.*\\))$" link) - (setq cref (match-string 1 link)) - (concat "coderef:" cref)) - ((string-match org-link-types-re link) nil) - ((or (file-name-absolute-p link) - (string-match "^\\." link)) - nil) - (t - (let ((org-link-search-inhibit-query t)) - (save-excursion - (setq found (condition-case nil (org-link-search link) - (error nil))) - (when (and found - (or (org-at-heading-p) - (not (eq found 'dedicated)))) - (or (get-text-property (point) 'target) - (get-text-property - (max (point-min) - (1- (or (previous-single-property-change - (point) 'target) 0))) - 'target))))))))) - (when target - (set-match-data md) - (goto-char (match-beginning 1)) - (setq props (text-properties-at (point))) - (delete-region (match-beginning 1) (match-end 1)) - (setq pos (point)) - (insert target) - (unless desc (insert "][" link)) - (add-text-properties pos (point) props)))))) + (let* ((org-link-search-must-match-exact-headline t) + (md (match-data)) + (desc (match-end 2)) + (link (org-link-unescape (match-string 1))) + (slink (org-solidify-link-text link)) + found props pos cref + (target + (cond + ((= (string-to-char link) ?#) + ;; user wants exactly this link + link) + ((cdr (assoc slink target-alist)) + (or (cdr (assoc (assoc slink target-alist) + org-export-preferred-target-alist)) + (cdr (assoc slink target-alist)))) + ((and (string-match "^id:" link) + (cdr (assoc (substring link 3) target-alist)))) + ((string-match "^(\\(.*\\))$" link) + (setq cref (match-string 1 link)) + (concat "coderef:" cref)) + ((string-match org-link-types-re link) nil) + ((or (file-name-absolute-p link) + (string-match "^\\." link)) + nil) + (t + (let ((org-link-search-inhibit-query t)) + (save-excursion + (setq found (condition-case nil (org-link-search link) + (error nil))) + (when (and found + (or (org-at-heading-p) + (not (eq found 'dedicated)))) + (or (get-text-property (point) 'target) + (get-text-property + (max (point-min) + (1- (or (previous-single-property-change + (point) 'target) 0))) + 'target))))))))) + (when target + (set-match-data md) + (goto-char (match-beginning 1)) + (setq props (text-properties-at (point))) + (delete-region (match-beginning 1) (match-end 1)) + (setq pos (point)) + (insert target) + (unless desc (insert "][" link)) + (add-text-properties pos (point) props)))))) (defun org-export-remember-html-container-classes () "Store the HTML_CONTAINER_CLASS properties in a text property." @@ -1462,8 +1483,10 @@ the current file." "^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t) (setq class (match-string 1)) (save-excursion - (org-back-to-heading t) - (put-text-property (point-at-bol) (point-at-eol) 'html-container-class class))))) + (when (re-search-backward "^\\*" (point-min) t) + (org-back-to-heading t) + (put-text-property (point-at-bol) (point-at-eol) + 'html-container-class class)))))) (defvar org-export-format-drawer-function nil "Function to be called to format the contents of a drawer. @@ -1532,8 +1555,8 @@ removed as well." select-tags "\\|") "\\):")) (re-excl (concat ":\\(" (mapconcat 'regexp-quote - exclude-tags "\\|") - "\\):")) + exclude-tags "\\|") + "\\):")) beg end cont) (goto-char (point-min)) (when (and select-tags @@ -1594,8 +1617,8 @@ When it is a list of strings, keep only tasks with these TODO keywords." org-todo-keywords-1)))) "\\|") "\\)\\($\\|[ \t]\\)")) - (case-fold-search nil) - beg) + (case-fold-search nil) + beg) (goto-char (point-min)) (while (re-search-forward re nil t) (org-if-unprotected @@ -1741,7 +1764,7 @@ from the buffer." (add-text-properties (point-at-bol) (min (1+ (point-at-eol)) (point-max)) `(org-protected t original-indentation ,ind org-native-text t))))) - ;; Delete #+ATTR_BACKEND: stuff of another backend. Those + ;; Delete #+ATTR_BACKEND: stuff of another backend. Those ;; matching the current backend will be taken care of by ;; `org-export-attach-captions-and-attributes' (goto-char (point-min)) @@ -1819,9 +1842,9 @@ These special cookies will later be interpreted by the backend." (replace-match "")) (unless (bolp) (insert "\n")) ;; As org-list-end is inserted at column 0, it would end - ;; by indentation any list. It can be problematic when + ;; by indentation any list. It can be problematic when ;; there are lists within lists: the inner list end would - ;; also become the outer list end. To avoid this, text + ;; also become the outer list end. To avoid this, text ;; property `original-indentation' is added, as ;; `org-list-struct' pays attention to it when reading a ;; list. @@ -1838,7 +1861,7 @@ These special properties will later be interpreted by the backend." ;; Mark a list with 3 properties: `list-item' which is ;; position at beginning of line, `list-struct' which is ;; list structure, and `list-prevs' which is the alist of - ;; item and its predecessor. Leave point at list ending. + ;; item and its predecessor. Leave point at list ending. (lambda (ctxt) (let* ((struct (org-list-struct)) (top (org-list-get-top-point struct)) @@ -1866,9 +1889,9 @@ These special properties will later be interpreted by the backend." 'list-struct struct 'list-prevs prevs))) poi) - ;; Take care of bottom point. As babel may have inserted + ;; Take care of bottom point. As babel may have inserted ;; a new list in buffer, list ending isn't always - ;; marked. Now mark every list ending and add properties + ;; marked. Now mark every list ending and add properties ;; useful to line processing exporters. (goto-char bottom) (when (or (looking-at "^ORG-LIST-END-MARKER\n") @@ -1878,8 +1901,8 @@ These special properties will later be interpreted by the backend." (unless (bolp) (insert "\n")) (insert (org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom - 'list-struct struct - 'list-prevs prevs))) + 'list-struct struct + 'list-prevs prevs))) ;; Following property is used by LaTeX exporter. (add-text-properties top (point) (list 'list-context ctxt))))))) ;; Mark lists except for backends not interpreting them. @@ -1971,29 +1994,33 @@ table line. If it is a link, add it to the line containing the link." "Remove comments, or convert to backend-specific format. ORG-COMMENTSP can be a format string for publishing comments. When it is nil, all comments will be removed." - (let ((re "^\\(#\\|[ \t]*#\\+ \\)\\(.*\n?\\)") - pos) + (let ((re "^[ \t]*#\\( \\|$\\)")) (goto-char (point-min)) - (while (or (looking-at re) - (re-search-forward re nil t)) - (setq pos (match-beginning 0)) - (if (get-text-property pos 'org-protected) - (goto-char (1+ pos)) - (if (and org-commentsp - (not (equal (char-before (match-end 1)) ?+))) - (progn (add-text-properties - (match-beginning 0) (match-end 0) '(org-protected t)) - (replace-match (org-add-props - (format org-commentsp (match-string 2)) - nil 'org-protected t) - t t)) - (goto-char (1+ pos)) - (replace-match "") - (goto-char (max (point-min) (1- pos)))))))) + (while (re-search-forward re nil t) + (let ((pos (match-beginning 0)) + (end (progn (forward-line) (point)))) + (if (get-text-property pos 'org-protected) + (forward-line) + (if (not org-commentsp) (delete-region pos end) + (add-text-properties pos end '(org-protected t)) + (replace-match + (org-add-props + (format org-commentsp (buffer-substring (match-end 0) end)) + nil 'org-protected t) + t t))))) + ;; Hack attack: previous implementation also removed keywords at + ;; column 0. Brainlessly do it again. + (goto-char (point-min)) + (while (re-search-forward "^#\\+" nil t) + (unless (get-text-property (point-at-bol) 'org-protected) + (delete-region (point-at-bol) (progn (forward-line) (point))))))) -(defun org-export-handle-table-metalines () - "Remove table specific metalines #+TBLNAME: and #+TBLFM:." - (let ((re "^[ \t]*#\\+TBL\\(NAME\\|FM\\):\\(.*\n?\\)") +(defun org-export-handle-metalines () + "Remove tables and source blocks metalines. +This function should only be called after all block processing +has taken place." + (let ((re "^[ \t]*#\\+\\(tbl\\(?:name\\|fm\\)\\|results\\(?:\\[[a-z0-9]+\\]\\)?\\|name\\):\\(.*\n?\\)") + (case-fold-search t) pos) (goto-char (point-min)) (while (or (looking-at re) @@ -2005,18 +2032,6 @@ When it is nil, all comments will be removed." (replace-match "") (goto-char (max (point-min) (1- pos))))))) -(defun org-export-res/src-name-cleanup () - "Clean up #+results and #+name lines for export. -This function should only be called after all block processing -has taken place." - (interactive) - (save-excursion - (goto-char (point-min)) - (let ((case-fold-search t)) - (while (org-re-search-forward-unprotected - "#\\+\\(name\\|results\\(\\[[a-z0-9]+\\]\\)?\\):" nil t) - (delete-region (match-beginning 0) (progn (forward-line) (point))))))) - (defun org-export-mark-radio-links () "Find all matches for radio targets and turn them into internal links." (let ((re-radio (and org-target-link-regexp @@ -2146,8 +2161,8 @@ can work correctly." (goto-char (point-min)) (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t) (org-if-unprotected-at (match-beginning 1) - (replace-match "\\1 \\3") - (goto-char (match-beginning 0))))) + (replace-match "\\1 \\3") + (goto-char (match-beginning 0))))) (defun org-export-concatenate-multiline-emphasis () "Find multi-line emphasis and put it all into a single line. @@ -2372,7 +2387,7 @@ TYPE must be a string, any of: (if (stringp val) val (format "%s" val)) "\n") (concat "\n" ind-str))))) - ;; Eventually do the replacement, if VAL isn't nil. Move + ;; Eventually do the replacement, if VAL isn't nil. Move ;; point at beginning of macro for recursive expansions. (when val (replace-match val t t) @@ -2391,13 +2406,14 @@ TYPE must be a string, any of: (defun org-export-handle-include-files () "Include the contents of include files, with proper formatting." (let ((case-fold-search t) - params file markup lang start end prefix prefix1 switches all minlevel lines) + params file markup lang start end prefix prefix1 switches all minlevel currentlevel addlevel lines) (goto-char (point-min)) - (while (re-search-forward "^#\\+INCLUDE:?[ \t]+\\(.*\\)" nil t) + (while (re-search-forward "^#\\+include:[ \t]+\\(.*\\)" nil t) (setq params (read (concat "(" (match-string 1) ")")) prefix (org-get-and-remove-property 'params :prefix) prefix1 (org-get-and-remove-property 'params :prefix1) minlevel (org-get-and-remove-property 'params :minlevel) + addlevel (org-get-and-remove-property 'params :addlevel) lines (org-get-and-remove-property 'params :lines) file (org-symname-or-string (pop params)) markup (org-symname-or-string (pop params)) @@ -2406,6 +2422,7 @@ TYPE must be a string, any of: switches (mapconcat #'(lambda (x) (format "%s" x)) params " ") start nil end nil) (delete-region (match-beginning 0) (match-end 0)) + (setq currentlevel (or (org-current-level) 0)) (if (or (not file) (not (file-exists-p file)) (not (file-readable-p file))) @@ -2421,7 +2438,7 @@ TYPE must be a string, any of: end (format "#+end_%s" markup)))) (insert (or start "")) (insert (org-get-file-contents (expand-file-name file) - prefix prefix1 markup minlevel lines)) + prefix prefix1 markup currentlevel minlevel addlevel lines)) (or (bolp) (newline)) (insert (or end "")))) all)) @@ -2438,13 +2455,15 @@ TYPE must be a string, any of: (when intersection (error "Recursive #+INCLUDE: %S" intersection)))))) -(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel lines) +(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel parentlevel addlevel lines) "Get the contents of FILE and return them as a string. If PREFIX is a string, prepend it to each line. If PREFIX1 is a string, prepend it to the first line instead of PREFIX. If MARKUP, don't protect org-like lines, the exporter will -take care of the block they are in. If LINES is a string -specifying a range of lines, include only those lines ." +take care of the block they are in. If ADDLEVEL is a number, +demote included file to current heading level+ADDLEVEL. +If LINES is a string specifying a range of lines, +include only those lines." (if (stringp markup) (setq markup (downcase markup))) (with-temp-buffer (insert-file-contents file) @@ -2477,6 +2496,14 @@ specifying a range of lines, include only those lines ." (when minlevel (dotimes (lvl minlevel) (org-map-region 'org-demote (point-min) (point-max)))) + (when addlevel + (let ((inclevel (or (if (org-before-first-heading-p) + (1- (and (outline-next-heading) + (org-current-level))) + (1- (org-current-level))) + 0))) + (dotimes (level (- (+ parentlevel addlevel) inclevel)) + (org-map-region 'org-demote (point-min) (point-max))))) (buffer-string))) (defun org-get-and-remove-property (listvar prop) @@ -2548,7 +2575,7 @@ in the list) and remove property and value from the list in LISTVAR." (defvar org-export-latex-minted-options) ;; defined in org-latex.el (defun org-remove-formatting-on-newlines-in-region (beg end) - "Remove formatting on newline characters" + "Remove formatting on newline characters." (interactive "r") (save-excursion (goto-char beg) @@ -2562,10 +2589,10 @@ in the list) and remove property and value from the list in LISTVAR." The CODE is marked up in `org-export-current-backend' format. Check if a function by name -\"org-<backend>-format-source-code-or-example\" is bound. If yes, -use it as the custom formatter. Otherwise, use the default -formatter. Default formatters are provided for docbook, html, -latex and ascii backends. For example, use +\"org-<backend>-format-source-code-or-example\" is bound. If yes, +use it as the custom formatter. Otherwise, use the default +formatter. Default formatters are provided for docbook, html, +latex and ascii backends. For example, use `org-html-format-source-code-or-example' to provide a custom formatter for export to \"html\". @@ -2703,65 +2730,64 @@ INDENT was the original indentation of the block." (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) (cond ((and lang org-export-latex-listings) - (flet ((make-option-string - (pair) - (concat (first pair) - (if (> (length (second pair)) 0) - (concat "=" (second pair)))))) - (let* ((lang-sym (intern lang)) - (minted-p (eq org-export-latex-listings 'minted)) - (listings-p (not minted-p)) - (backend-lang - (or (cadr - (assq - lang-sym - (cond - (minted-p org-export-latex-minted-langs) - (listings-p org-export-latex-listings-langs)))) - lang)) - (custom-environment - (cadr - (assq - lang-sym - org-export-latex-custom-lang-environments)))) - (concat - (when (and listings-p (not custom-environment)) - (format - "\\lstset{%s}\n" - (mapconcat - #'make-option-string - (append org-export-latex-listings-options - `(("language" ,backend-lang))) ","))) - (when (and caption org-export-latex-listings-w-names) - (format - "\n%s $\\equiv$ \n" - (replace-regexp-in-string "_" "\\\\_" caption))) - (cond - (custom-environment - (format "\\begin{%s}\n%s\\end{%s}\n" - custom-environment rtn custom-environment)) - (listings-p - (format "\\begin{%s}\n%s\\end{%s}" - "lstlisting" rtn "lstlisting")) - (minted-p - (format - "\\begin{minted}[%s]{%s}\n%s\\end{minted}" - (mapconcat #'make-option-string - org-export-latex-minted-options ",") - backend-lang rtn))))))) + (let* ((make-option-string + (lambda (pair) + (concat (first pair) + (if (> (length (second pair)) 0) + (concat "=" (second pair)))))) + (lang-sym (intern lang)) + (minted-p (eq org-export-latex-listings 'minted)) + (listings-p (not minted-p)) + (backend-lang + (or (cadr + (assq + lang-sym + (cond + (minted-p org-export-latex-minted-langs) + (listings-p org-export-latex-listings-langs)))) + lang)) + (custom-environment + (cadr + (assq + lang-sym + org-export-latex-custom-lang-environments)))) + (concat + (when (and listings-p (not custom-environment)) + (format + "\\lstset{%s}\n" + (mapconcat + make-option-string + (append org-export-latex-listings-options + `(("language" ,backend-lang))) ","))) + (when (and caption org-export-latex-listings-w-names) + (format + "\n%s $\\equiv$ \n" + (replace-regexp-in-string "_" "\\\\_" caption))) + (cond + (custom-environment + (format "\\begin{%s}\n%s\\end{%s}\n" + custom-environment rtn custom-environment)) + (listings-p + (format "\\begin{%s}\n%s\\end{%s}" + "lstlisting" rtn "lstlisting")) + (minted-p + (format + "\\begin{minted}[%s]{%s}\n%s\\end{minted}" + (mapconcat make-option-string + org-export-latex-minted-options ",") + backend-lang rtn)))))) (t (concat (car org-export-latex-verbatim-wrap) rtn (cdr org-export-latex-verbatim-wrap))))) - ((eq org-export-current-backend 'ascii) - ;; This is not HTML or LaTeX, so just make it an example. - (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) - (concat caption "\n" + ((eq org-export-current-backend 'ascii) + ;; This is not HTML or LaTeX, so just make it an example. + (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) + (concat caption "\n" (concat (mapconcat (lambda (l) (concat " " l)) (org-split-string rtn "\n") "\n") - "\n") - )) + "\n"))) (t (error "Don't know how to markup source or example block in %s" (upcase backend-name))))) @@ -2787,7 +2813,7 @@ backend-specific lines pre-pended or appended to the original source block. NUMBER is non-nil if the literal example specifies \"+n\" or -\"-n\" switch. If NUMBER is non-nil add line numbers. +\"-n\" switch. If NUMBER is non-nil add line numbers. CONT is non-nil if the literal example specifies \"+n\" switch. If CONT is nil, start numbering this block from 1. Otherwise @@ -2837,7 +2863,7 @@ block numbering. When non-nil do the following: (fm (cond ((eq org-export-current-backend 'html) (format "<span class=\"linenr\">%s</span>" - fmt)) + fmt)) ((eq org-export-current-backend 'ascii) fmt) ((eq org-export-current-backend 'latex) fmt) ((eq org-export-current-backend 'docbook) fmt) @@ -2915,7 +2941,7 @@ block numbering. When non-nil do the following: (setq lv (- (match-end 1) (match-beginning 1)) todo (and (match-beginning 2) (not (member (match-string 2 line) - org-done-keywords)))) + org-done-keywords)))) ; TODO, not DONE (if (<= lv level) (throw 'exit nil)) (if todo (throw 'exit t)))))))) @@ -3202,8 +3228,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." (or org-tag-alist (org-get-buffer-tags)) " ") "") (mapconcat 'identity org-file-tags " ") org-archive-location - "org file:~/org/%s.org" - )) + "org file:~/org/%s.org")) ;;;###autoload (defun org-insert-export-options-template () @@ -3244,8 +3269,7 @@ If yes remove the column and the special lines." (mapcar (lambda (x) (cond ((member x '("<" "<")) :start) ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend) - (t nil))) + ((member x '("<>" "<>")) :startend))) (org-split-string x "[ \t]*|[ \t]*"))) nil) ((org-table-cookie-line-p x) @@ -3266,8 +3290,7 @@ If yes remove the column and the special lines." (mapcar (lambda (x) (cond ((member x '("<" "<")) :start) ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend) - (t nil))) + ((member x '("<>" "<>")) :startend))) (cdr (org-split-string x "[ \t]*|[ \t]*")))) nil) ((org-table-cookie-line-p x) @@ -3284,18 +3307,20 @@ If yes remove the column and the special lines." (defun org-export-cleanup-toc-line (s) "Remove tags and timestamps from lines going into the toc." - (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) + (if (not s) + "" ; Return a string when argument is nil + (when (memq org-export-with-tags '(not-in-toc nil)) + (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) + (setq s (replace-match "" t t s)))) + (when org-export-remove-timestamps-from-toc + (while (string-match org-maybe-keyword-time-regexp s) (setq s (replace-match "" t t s)))) - (when org-export-remove-timestamps-from-toc - (while (string-match org-maybe-keyword-time-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (match-string (if (match-end 3) 3 1) s) - t t s))) - (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s) - (setq s (replace-match "" t t s))) - s) + (while (string-match org-bracket-link-regexp s) + (setq s (replace-match (match-string (if (match-end 3) 3 1) s) + t t s))) + (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s) + (setq s (replace-match "" t t s))) + s)) (defun org-get-text-property-any (pos prop &optional object) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index 58f879dd51..cfa4c1c30a 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -287,12 +287,14 @@ column view defines special faces for each outline level. See the file (defface org-date-selected (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold nil)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold nil)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold nil)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold nil)) + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t)) (t (:inverse-video t)))) - "Face for highlighting the calendar day when using `org-read-date'." + "Face for highlighting the calendar day when using `org-read-date'. +Using a bold face here might cause discrepencies while displaying the +calendar." :group 'org-faces) (defface org-sexp-date @@ -309,6 +311,11 @@ Note that the variable `org-tag-faces' can be used to overrule this face for specific tags." :group 'org-faces) +(defface org-list-dt + '((t (:bold t))) + "Default face for definition terms in lists." + :group 'org-faces) + (defface org-todo ; font-lock-warning-face (org-compatible-face nil '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) @@ -381,8 +388,8 @@ determines if it is a foreground or a background color." (cons (string :tag "Keyword") (choice :tag "Face " - (string :tag "Color") - (sexp :tag "Face"))))) + (string :tag "Color") + (sexp :tag "Face"))))) (defcustom org-priority-faces nil "Faces for specific Priorities. @@ -398,8 +405,8 @@ determines if it is a foreground or a background color." (cons (character :tag "Priority") (choice :tag "Face " - (string :tag "Color") - (sexp :tag "Face"))))) + (string :tag "Color") + (sexp :tag "Face"))))) (defvar org-tags-special-faces-re nil) (defun org-set-tag-faces (var value) @@ -412,7 +419,7 @@ determines if it is a foreground or a background color." (defface org-checkbox (org-compatible-face 'bold '((t (:bold t)))) - "Face for checkboxes" + "Face for checkboxes." :group 'org-faces) @@ -439,8 +446,8 @@ changes." (cons (string :tag "Tag ") (choice :tag "Face" - (string :tag "Foreground color") - (sexp :tag "Face"))))) + (string :tag "Foreground color") + (sexp :tag "Face"))))) (defface org-table ;; originally copied from font-lock-function-name-face (org-compatible-face nil @@ -484,9 +491,9 @@ changes." :version "22.1") (defface org-document-title - '((((class color) (background light)) (:foreground "midnight blue" :weight bold :height 1.44)) - (((class color) (background dark)) (:foreground "pale turquoise" :weight bold :height 1.44)) - (t (:weight bold :height 1.44))) + '((((class color) (background light)) (:foreground "midnight blue" :weight bold)) + (((class color) (background dark)) (:foreground "pale turquoise" :weight bold)) + (t (:weight bold))) "Face for document title, i.e. that which follows the #+TITLE: keyword." :group 'org-faces) @@ -549,9 +556,9 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword." :version "22.1") (org-copy-face 'org-block 'org-quote - "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.") + "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.") (org-copy-face 'org-block 'org-verse - "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.") + "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.") (defcustom org-fontify-quote-and-verse-blocks nil "Non-nil means, add a special face to #+begin_quote and #+begin_verse block. @@ -574,8 +581,8 @@ content of these blocks will still be treated as Org syntax." (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) (t (:inverse-video t)))) - "Basic face for displaying the secondary selection." - :group 'org-faces) + "Basic face for displaying the secondary selection." + :group 'org-faces) (defface org-agenda-structure ;; originally copied from font-lock-function-name-face (org-compatible-face nil @@ -602,7 +609,7 @@ content of these blocks will still be treated as Org syntax." "Face used in agenda for weekend days. See the variable `org-agenda-weekend-days' for a definition of which days belong to the weekend." - :weight 'bold) + :weight 'bold) (defface org-scheduled (org-compatible-face nil @@ -727,8 +734,8 @@ month and 365.24 days for a year)." (defconst org-level-faces '(org-level-1 org-level-2 org-level-3 org-level-4 - org-level-5 org-level-6 org-level-7 org-level-8 - )) + org-level-5 org-level-6 org-level-7 org-level-8 + )) (defcustom org-n-level-faces (length org-level-faces) "The number of different faces to be used for headlines. @@ -738,14 +745,14 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." :group 'org-faces) (defcustom org-cycle-level-faces t - "Non-nil means level styles cycle after level `org-n-level-faces'. + "Non-nil means level styles cycle after level `org-n-level-faces'. Then so level org-n-level-faces+1 is styled like level 1. If nil, then all levels >=org-n-level-faces are styled like level org-n-level-faces" - :group 'org-appearance - :group 'org-faces - :version "24.1" - :type 'boolean) + :group 'org-appearance + :group 'org-faces + :version "24.1" + :type 'boolean) (defface org-latex-and-export-specials (let ((font (cond ((assq :inherit custom-face-attributes) diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index f5186aaacf..91bf334795 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -80,7 +80,7 @@ ;; that received the input of the feed. You should add FEEDSTATUS ;; to your list of drawers in the files that receive feed input: ;; -;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS +;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS ;; ;; Acknowledgments ;; --------------- @@ -100,6 +100,10 @@ (declare-function xml-get-attribute-or-nil "xml" (node attribute)) (declare-function xml-substitute-special "xml" (string)) +(declare-function org-capture-escaped-% "org-capture" ()) +(declare-function org-capture-inside-embedded-elisp-p "org-capture" ()) +(declare-function org-capture-expand-embedded-elisp "org-capture" ()) + (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." :tag "Org Feed" @@ -179,34 +183,34 @@ Here are the keyword-value pair allows in `org-feed-alist'. :group 'org-feed :type '(repeat (list :value ("" "http://" "" "") - (string :tag "Name") - (string :tag "Feed URL") - (file :tag "File for inbox") - (string :tag "Headline for inbox") - (repeat :inline t - (choice - (list :inline t :tag "Filter" - (const :filter) - (symbol :tag "Filter Function")) - (list :inline t :tag "Template" - (const :template) - (string :tag "Template")) - (list :inline t :tag "Formatter" - (const :formatter) - (symbol :tag "Formatter Function")) - (list :inline t :tag "New items handler" - (const :new-handler) - (symbol :tag "Handler Function")) - (list :inline t :tag "Changed items" - (const :changed-handler) - (symbol :tag "Handler Function")) - (list :inline t :tag "Parse Feed" - (const :parse-feed) - (symbol :tag "Parse Feed Function")) - (list :inline t :tag "Parse Entry" - (const :parse-entry) - (symbol :tag "Parse Entry Function")) - ))))) + (string :tag "Name") + (string :tag "Feed URL") + (file :tag "File for inbox") + (string :tag "Headline for inbox") + (repeat :inline t + (choice + (list :inline t :tag "Filter" + (const :filter) + (symbol :tag "Filter Function")) + (list :inline t :tag "Template" + (const :template) + (string :tag "Template")) + (list :inline t :tag "Formatter" + (const :formatter) + (symbol :tag "Formatter Function")) + (list :inline t :tag "New items handler" + (const :new-handler) + (symbol :tag "Handler Function")) + (list :inline t :tag "Changed items" + (const :changed-handler) + (symbol :tag "Handler Function")) + (list :inline t :tag "Parse Feed" + (const :parse-feed) + (symbol :tag "Parse Feed Function")) + (list :inline t :tag "Parse Entry" + (const :parse-entry) + (symbol :tag "Parse Entry Function")) + ))))) (defcustom org-feed-drawer "FEEDSTATUS" "The name of the drawer for feed status information. @@ -225,12 +229,14 @@ Any fields from the feed item can be interpolated into the template with %name, for example %title, %description, %pubDate etc. In addition, the following special escapes are valid as well: -%h the title, or the first line of the description -%t the date as a stamp, either from <pubDate> (if present), or - the current date. -%T date and time -%u,%U like %t,%T, but inactive time stamps -%a A link, from <guid> if that is a permalink, else from <link>" +%h The title, or the first line of the description +%t The date as a stamp, either from <pubDate> (if present), or + the current date +%T Date and time +%u,%U Like %t,%T, but inactive time stamps +%a A link, from <guid> if that is a permalink, else from <link> +%(sexp) Evaluate elisp `(sexp)' and replace with the result, the simple + %-escapes above can be used as arguments, e.g. %(capitalize \\\"%h\\\")" :group 'org-feed :type '(string :tag "Template")) @@ -251,7 +257,7 @@ of the file pointed to by the URL." (const :tag "Externally with wget" wget) (function :tag "Function"))) - (defcustom org-feed-before-adding-hook nil +(defcustom org-feed-before-adding-hook nil "Hook that is run before adding new feed items to a file. You might want to commit the file in its current state to version control, for example." @@ -450,8 +456,8 @@ Switch to that buffer, and return the position of that headline." nil t) (goto-char (match-beginning 0)) (goto-char (point-max)) - (insert "\n\n* " heading "\n\n") - (org-back-to-heading t)) + (insert "\n\n* " heading "\n\n") + (org-back-to-heading t)) (point)) (defun org-feed-read-previous-status (pos drawer) @@ -506,9 +512,10 @@ This will find DRAWER and extract the alist." ENTRY is a property list. This function adds a `:formatted-for-org' property and returns the full property list. If that property is already present, nothing changes." + (require 'org-capture) (if formatter (funcall formatter entry) - (let (dlines fmt tmp indent time name + (let (dlines time escape name tmp v-h v-t v-T v-u v-U v-a) (setq dlines (org-split-string (or (plist-get entry :description) "???") "\n") @@ -527,20 +534,35 @@ If that property is already present, nothing changes." "")) (with-temp-buffer (insert template) + + ;; Simple %-escapes + ;; before embedded elisp to support simple %-escapes as + ;; arguments for embedded elisp (goto-char (point-min)) (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t) - (setq name (match-string 1)) - (cond - ((member name '("h" "t" "T" "u" "U" "a")) - (replace-match (symbol-value (intern (concat "v-" name))) t t)) - ((setq tmp (plist-get entry (intern (concat ":" name)))) - (save-excursion - (save-match-data - (beginning-of-line 1) - (when (looking-at (concat "^\\([ \t]*\\)%" name "[ \t]*$")) - (setq tmp (org-feed-make-indented-block - tmp (org-get-indentation)))))) - (replace-match tmp t t)))) + (unless (org-capture-escaped-%) + (setq name (match-string 1) + escape (org-capture-inside-embedded-elisp-p)) + (cond + ((member name '("h" "t" "T" "u" "U" "a")) + (setq tmp (symbol-value (intern (concat "v-" name))))) + ((setq tmp (plist-get entry (intern (concat ":" name)))) + (save-excursion + (save-match-data + (beginning-of-line 1) + (when (looking-at + (concat "^\\([ \t]*\\)%" name "[ \t]*$")) + (setq tmp (org-feed-make-indented-block + tmp (org-get-indentation)))))))) + (when tmp + ;; escape string delimiters `"' when inside %() embedded lisp + (when escape + (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp))) + (replace-match tmp t t)))) + + ;; %() embedded elisp + (org-capture-expand-embedded-elisp) + (decode-coding-string (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index a9ba8d7510..3aaa44b7ac 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -57,6 +57,7 @@ (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function org-show-context "org" (&optional key)) (declare-function org-trim "org" (s)) +(declare-function org-skip-whitespace "org" ()) (declare-function outline-next-heading "outline") (declare-function org-skip-whitespace "org" ()) @@ -277,9 +278,7 @@ otherwise." (concat org-outline-regexp-bol "\\|" org-footnote-definition-re "\\|" "^[ \t]*$") bound 'move)) - (progn (goto-char (match-beginning 0)) - (org-skip-whitespace) - (point-at-bol)) + (match-beginning 0) (point))))) (list label beg end (org-trim (buffer-substring-no-properties beg-def end))))))))) @@ -362,7 +361,7 @@ Return a non-nil value when a definition has been found." (looking-at (format "\\[%s\\]\\|\\[%s:" label label)) (goto-char (match-end 0)) (org-show-context 'link-search) - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")) t))) @@ -451,7 +450,8 @@ or new, let the user edit the definition of the footnote." (error "Cannot insert a footnote here")) (let* ((lbls (and (not (equal org-footnote-auto-label 'random)) (org-footnote-all-labels))) - (propose (org-footnote-unique-label lbls)) + (propose (and (not (equal org-footnote-auto-label 'random)) + (org-footnote-unique-label lbls))) (label (org-footnote-normalize-label (cond @@ -489,7 +489,7 @@ or new, let the user edit the definition of the footnote." (let ((label (org-footnote-normalize-label label))) (cond ;; In an Org file. - ((eq major-mode 'org-mode) + ((derived-mode-p 'org-mode) ;; If `org-footnote-section' is defined, find it, or create it ;; at the end of the buffer. (when org-footnote-section @@ -553,7 +553,7 @@ or new, let the user edit the definition of the footnote." (backward-char) ;; Only notify user about next possible action when in an Org ;; buffer, as the bindings may have different meanings otherwise. - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))) @@ -713,7 +713,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; 2. Find and remove the footnote section, if any. Also ;; determine where footnotes shall be inserted (INS-POINT). (cond - ((and org-footnote-section (eq major-mode 'org-mode)) + ((and org-footnote-section (derived-mode-p 'org-mode)) (goto-char (point-min)) (if (re-search-forward (concat "^\\*[ \t]+" (regexp-quote org-footnote-section) @@ -729,7 +729,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; of the section containing their first reference. ;; Nevertheless, in an export situation, set insertion point to ;; `point-max' by default. - ((eq major-mode 'org-mode) + ((derived-mode-p 'org-mode) (when export-props (goto-char (point-max)) (skip-chars-backward " \r\t\n") @@ -790,7 +790,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; No footnote: exit. ((not ref-table)) ;; Cases when footnotes should be inserted in one place. - ((or (not (eq major-mode 'org-mode)) + ((or (not (derived-mode-p 'org-mode)) org-footnote-section export-props) ;; Insert again the section title, if any. Ensure that title, @@ -799,7 +799,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; separate section with a blank line, unless explicitly ;; stated in `org-blank-before-new-entry'. (cond - ((not (eq major-mode 'org-mode)) + ((not (derived-mode-p 'org-mode)) (skip-chars-backward " \t\n\r") (delete-region (point) ins-point) (unless (bolp) (newline)) @@ -845,7 +845,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': (beginning-of-line 0) (while (and (not (bobp)) (= (char-after) ?#)) (beginning-of-line 0)) - (if (looking-at "[ \t]*#\\+TBLFM:") (beginning-of-line 2)) + (if (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) (beginning-of-line 2)) (end-of-line 1) (skip-chars-backward "\n\r\t ") (forward-line)) @@ -872,7 +872,11 @@ Return the number of footnotes removed." (while (re-search-forward def-re nil t) (let ((full-def (org-footnote-at-definition-p))) (when full-def - (delete-region (nth 1 full-def) (nth 2 full-def)) + ;; Remove the footnote, and all blank lines before it. + (goto-char (nth 1 full-def)) + (skip-chars-backward " \r\t\n") + (unless (bolp) (forward-line)) + (delete-region (point) (nth 2 full-def)) (incf ndef)))) ndef))) @@ -888,7 +892,7 @@ If LABEL is non-nil, delete that footnote instead." (label (cond ;; LABEL is provided as argument. (label) - ;; Footnote reference at point. If the footnote is + ;; Footnote reference at point. If the footnote is ;; anonymous, delete it and exit instead. ((setq x (org-footnote-at-reference-p)) (or (car x) diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el index 3b94d92894..a05cb554d4 100644 --- a/lisp/org/org-freemind.el +++ b/lisp/org/org-freemind.el @@ -60,7 +60,7 @@ (require 'xml) (require 'org) -;(require 'rx) + ;(require 'rx) (require 'org-exp) (eval-when-compile (require 'cl)) @@ -139,7 +139,7 @@ NOT READY YET." ;;;###autoload (defun org-export-as-freemind (&optional hidden ext-plist - to-buffer body-only pub-dir) + to-buffer body-only pub-dir) "Export the current buffer as a Freemind file. If there is an active region, export only the region. HIDDEN is obsolete and does nothing. EXT-PLIST is a property list with @@ -258,22 +258,22 @@ The characters \"&<> will be escaped." ;;(org-freemind-unescape-str-to-org "mA≌B<C<=") ;;(org-freemind-unescape-str-to-org "<<") (defun org-freemind-unescape-str-to-org (fm-str) - "Do some html-unescaping of FM-STR and return the result. + "Do some html-unescaping of FM-STR and return the result. This is the opposite of `org-freemind-escape-str-from-org' but it will also unescape &#nn;." - (let ((org-str fm-str)) - (setq org-str (replace-regexp-in-string """ "\"" org-str)) - (setq org-str (replace-regexp-in-string "&" "&" org-str)) - (setq org-str (replace-regexp-in-string "<" "<" org-str)) - (setq org-str (replace-regexp-in-string ">" ">" org-str)) - (setq org-str (replace-regexp-in-string - "&#x\\([a-f0-9]\\{2,4\\}\\);" - (lambda (m) - (char-to-string - (+ (string-to-number (match-string 1 m) 16) - 0 ;?\x800 ;; What is this for? Encoding? - ))) - org-str)))) + (let ((org-str fm-str)) + (setq org-str (replace-regexp-in-string """ "\"" org-str)) + (setq org-str (replace-regexp-in-string "&" "&" org-str)) + (setq org-str (replace-regexp-in-string "<" "<" org-str)) + (setq org-str (replace-regexp-in-string ">" ">" org-str)) + (setq org-str (replace-regexp-in-string + "&#x\\([a-f0-9]\\{2,4\\}\\);" + (lambda (m) + (char-to-string + (+ (string-to-number (match-string 1 m) 16) + 0 ;?\x800 ;; What is this for? Encoding? + ))) + org-str)))) ;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: ") ;; (str2 (org-freemind-escape-str-from-org str1)) @@ -291,7 +291,7 @@ MATCHED is the link just matched." (is-img (and (image-type-from-file-name link) (let ((url-type (substring link 0 col-pos))) (member url-type '("file" "http" "https"))))) - ) + ) (if is-img ;; Fix-me: I can't find a way to get the border to "shrink ;; wrap" around the image using <div>. @@ -334,7 +334,7 @@ MATCHED is the link just matched." "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]" ;;"<a href=\"\\1\">\\2</a>" 'org-freemind-convert-links-helper - fm-str))) + fm-str t t))) ;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>") (defun org-freemind-convert-links-to-org (fm-str) @@ -380,7 +380,7 @@ MATCHED is the link just matched." (dolist (cc (append matched nil)) (if (= 32 cc) ;;(setq res (concat res " ")) - ;; We need to use the numerical version. Otherwise Freemind + ;; We need to use the numerical version. Otherwise Freemind ;; ver 0.9.0 RC9 can not export to html/javascript. (progn (if (< 0 bi) @@ -410,7 +410,7 @@ MATCHED is the link just matched." (defcustom org-freemind-node-css-style "p { margin-top: 3px; margin-bottom: 3px; }" "CSS style for Freemind nodes." - ;; Fix-me: I do not understand this. It worked to export from Freemind + ;; Fix-me: I do not understand this. It worked to export from Freemind ;; with this setting now, but not before??? Was this perhaps a java ;; bug or is it a windows xp bug (some resource gets exhausted if you ;; use sticky keys which I do). @@ -455,8 +455,7 @@ DRAWERS-REGEXP are converted to freemind notes." note-res "</body>\n" "</html>\n" - "</richcontent>\n")) - ) + "</richcontent>\n"))) ;; There is always an LF char: (when (> (length text) 1) @@ -467,10 +466,10 @@ DRAWERS-REGEXP are converted to freemind notes." (if (= 0 (length org-freemind-node-css-style)) "" (concat - "<style type=\"text/css\">\n" - "<!--\n" + "<style type=\"text/css\">\n" + "<!--\n" org-freemind-node-css-style - "-->\n" + "-->\n" "</style>\n")) "</head>\n" "<body>\n")) @@ -520,14 +519,15 @@ DRAWERS-REGEXP are converted to freemind notes." (list node-res note-res)))) (defun org-freemind-write-node (mm-buffer drawers-regexp - num-left-nodes base-level - current-level next-level this-m2 - this-node-end - this-children-visible - next-node-start - next-has-some-visible-child) + num-left-nodes base-level + current-level next-level this-m2 + this-node-end + this-children-visible + next-node-start + next-has-some-visible-child) (let* (this-icons this-bg-color + this-m2-link this-m2-escaped this-rich-node this-rich-note @@ -560,6 +560,10 @@ DRAWERS-REGEXP are converted to freemind notes." (add-to-list 'this-icons "full-7")) )))) (setq this-m2 (org-trim this-m2)) + (when (string-match org-bracket-link-analytic-regexp this-m2) + (setq this-m2-link (concat "link=\"" (match-string 1 this-m2) + (match-string 3 this-m2) "\" ") + this-m2 (replace-match "\\5" nil nil this-m2 0))) (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2)) (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note this-m2-escaped @@ -569,7 +573,8 @@ DRAWERS-REGEXP are converted to freemind notes." (setq this-rich-node (nth 0 node-notes)) (setq this-rich-note (nth 1 node-notes))) (with-current-buffer mm-buffer - (insert "<node text=\"" this-m2-escaped "\"") + (insert "<node " (if this-m2-link this-m2-link "") + "text=\"" this-m2-escaped "\"") (org-freemind-get-node-style this-m2) (when (> next-level current-level) (unless (or this-children-visible @@ -784,15 +789,15 @@ Otherwise give an error say the file exists." ;;; (unless (if node-at-line-last ;;; (>= (point) node-at-line-last) ;;; nil) - ;; Write last node: - (setq this-m2 next-m2) - (setq current-level next-level) - (setq next-node-start (if node-at-line-last - (1+ node-at-line-last) - (point-max))) - (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)) - (with-current-buffer mm-buffer (insert "</node>\n")) - ;) + ;; Write last node: + (setq this-m2 next-m2) + (setq current-level next-level) + (setq next-node-start (if node-at-line-last + (1+ node-at-line-last) + (point-max))) + (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)) + (with-current-buffer mm-buffer (insert "</node>\n")) + ;) ) (with-current-buffer mm-buffer (while (> current-level base-level) @@ -1032,7 +1037,7 @@ PATH should be a list of steps, where each step has the form (let* ((child-attr-list (cadr child)) (step-attr-copy (copy-sequence step-attr-list))) (dolist (child-attr child-attr-list) - ;; Compare attr names: + ;; Compare attr names: (when (org-freemind-symbols= (caar step-attr-copy) (car child-attr)) ;; Compare values: (let ((step-val (cdar step-attr-copy)) @@ -1066,12 +1071,12 @@ PATH should be a list of steps, where each step has the form (defun org-freemind-test-get-tree-text () (let ((node '(p nil "\n" - (a - ((href . "link")) - "text") - "\n" - (b nil "hej") - "\n"))) + (a + ((href . "link")) + "text") + "\n" + (b nil "hej") + "\n"))) (org-freemind-get-tree-text node))) ;; (org-freemind-test-get-tree-text) @@ -1085,11 +1090,9 @@ PATH should be a list of steps, where each step has the form ;;(a (setq is-link t) ) ((h1 h2 h3 h4 h5 h6 p) ;;(setq ntxt (concat "\n" ntxt)) - (setq lf-after 2) - ) + (setq lf-after 2)) (br - (setq lf-after 1) - ) + (setq lf-after 1)) (t (cond ((stringp n) @@ -1106,8 +1109,7 @@ PATH should be a list of steps, where each step has the form (let ((att (car att-val)) (val (cdr att-val))) (when (eq att 'href) - (setq link val))))) - ))))) + (setq link val)))))))))) (if lf-after (setq ntxt (concat ntxt (make-string lf-after ?\n))) (setq ntxt (concat ntxt " "))) @@ -1184,7 +1186,7 @@ PATH should be a list of steps, where each step has the form (org-freemind-node-to-org child (1+ level) skip-levels))))) ;; Fix-me: put back special things, like drawers that are stored in -;; the notes. Should maybe all notes contents be put in drawers? +;; the notes. Should maybe all notes contents be put in drawers? ;;;###autoload (defun org-freemind-to-org-mode (mm-file org-file) "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE." diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index 5b855c291f..77f9c0b8a7 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -32,6 +32,7 @@ ;;; Code: (require 'org) +(require 'gnus-util) (eval-when-compile (require 'gnus-sum)) ;; Declare external functions and variables @@ -100,11 +101,11 @@ If `org-store-link' was called with a prefix arg the meaning of (if (and (string-match "^nntp" group) ;; Only for nntp groups (org-xor current-prefix-arg org-gnus-prefer-web-links)) - (org-make-link (if (string-match "gmane" unprefixed-group) - "http://news.gmane.org/" - "http://groups.google.com/group/") - unprefixed-group) - (org-make-link "gnus:" group)))) + (concat (if (string-match "gmane" unprefixed-group) + "http://news.gmane.org/" + "http://groups.google.com/group/") + unprefixed-group) + (concat "gnus:" group)))) (defun org-gnus-article-link (group newsgroups message-id x-no-archive) "Create a link to a Gnus article. @@ -125,7 +126,7 @@ If `org-store-link' was called with a prefix arg the meaning of "http://mid.gmane.org/%s" "http://groups.google.com/groups/search?as_umsgid=%s") (org-fixup-message-id-for-http message-id)) - (org-make-link "gnus:" group "#" message-id))) + (concat "gnus:" group "#" message-id))) (defun org-gnus-store-link () "Store a link to a Gnus folder or message." @@ -206,7 +207,7 @@ If `org-store-link' was called with a prefix arg the meaning of desc link newsgroup xarchive) ; those are always nil for gcc (and (not gcc) - (error "Can not create link: No Gcc header found.")) + (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) @@ -233,9 +234,9 @@ If `org-store-link' was called with a prefix arg the meaning of (setq group (match-string 1 path) article (match-string 3 path)) (when group - (setq group (org-substring-no-properties group))) + (setq group (org-no-properties group))) (when article - (setq article (org-substring-no-properties article))) + (setq article (org-no-properties article))) (org-gnus-follow-link group article))) (defun org-gnus-follow-link (&optional group article) @@ -244,9 +245,9 @@ If `org-store-link' was called with a prefix arg the meaning of (funcall (cdr (assq 'gnus org-link-frame-setup))) (if gnus-other-frame-object (select-frame gnus-other-frame-object)) (when group - (setq group (org-substring-no-properties group))) + (setq group (org-no-properties group))) (when article - (setq article (org-substring-no-properties article))) + (setq article (org-no-properties article))) (cond ((and group article) (gnus-activate-group group) (condition-case nil @@ -272,7 +273,7 @@ If `org-store-link' was called with a prefix arg the meaning of ;; stop on integer overflows (> articles 0)) (setq group-opened (gnus-group-read-group - articles nil group) + articles t group) articles (if (< articles 16) (1+ articles) (* articles 2)))) diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 6b4776662e..5b68ac3226 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -67,6 +67,12 @@ relative to the current effective date." :group 'org-habit :type 'boolean) +(defcustom org-habit-show-all-today nil + "If non-nil, will show the consistency graph of all habits on +today's agenda, even if they are not scheduled." + :group 'org-habit + :type 'boolean) + (defcustom org-habit-today-glyph ?! "Glyph character used to identify today." :group 'org-habit diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el index 5cecc44a2d..79b028638a 100644 --- a/lisp/org/org-html.el +++ b/lisp/org/org-html.el @@ -98,8 +98,32 @@ not be modified." :group 'org-export-html :type 'boolean) -(defconst org-export-html-scripts -"<script type=\"text/javascript\"> +(defvar org-export-html-scripts + "<script type=\"text/javascript\"> +/* +@licstart The following is the entire license notice for the +JavaScript code in this tag. + +Copyright (C) 2012 Free Software Foundation, Inc. + +The JavaScript code in this tag is free software: you can +redistribute it and/or modify it under the terms of the GNU +General Public License (GNU GPL) as published by the Free Software +Foundation, either version 3 of the License, or (at your option) +any later version. The code is distributed WITHOUT ANY WARRANTY; +without even the implied warranty of MERCHANTABILITY or FITNESS +FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + +As additional permission under GNU GPL version 3 section 7, you +may distribute non-source (e.g., minimized or compacted) forms of +that code without the copy of the GNU GPL normally required by +section 4, provided you include this license notice and a URL +through which recipients can access the Corresponding Source. + + +@licend The above is the entire license notice +for the JavaScript code in this tag. +*/ <!--/*--><![CDATA[/*><!--*/ function CodeHighlightOn(elem, id) { @@ -121,10 +145,10 @@ not be modified." } /*]]>*///--> </script>" -"Basic JavaScript that is needed by HTML files produced by Org-mode.") + "Basic JavaScript that is needed by HTML files produced by Org-mode.") (defconst org-export-html-style-default -"<style type=\"text/css\"> + "<style type=\"text/css\"> <!--/*--><![CDATA[/*><!--*/ html { font-family: Times, serif; font-size: 12pt; } .title { text-align: center; } @@ -255,16 +279,16 @@ You can also customize this for each buffer, using something like :group 'org-export-html :version "24.1" :type '(list :greedy t - (list :tag "path (the path from where to load MathJax.js)" - (const :format " " path) (string)) - (list :tag "scale (scaling for the displayed math)" - (const :format " " scale) (string)) - (list :tag "align (alignment of displayed equations)" - (const :format " " align) (string)) - (list :tag "indent (indentation with left or right alignment)" - (const :format " " indent) (string)) - (list :tag "mathml (should MathML display be used is possible)" - (const :format " " mathml) (boolean)))) + (list :tag "path (the path from where to load MathJax.js)" + (const :format " " path) (string)) + (list :tag "scale (scaling for the displayed math)" + (const :format " " scale) (string)) + (list :tag "align (alignment of displayed equations)" + (const :format " " align) (string)) + (list :tag "indent (indentation with left or right alignment)" + (const :format " " indent) (string)) + (list :tag "mathml (should MathML display be used is possible)" + (const :format " " mathml) (boolean)))) (defun org-export-html-mathjax-config (template options in-buffer) "Insert the user setup into the matchjax template." @@ -276,8 +300,9 @@ You can also customize this for each buffer, using something like (setq val (car (read-from-string (substring in-buffer (match-end 0)))))) (if (not (stringp val)) (setq val (format "%s" val))) - (if (string-match (concat "%" (upcase (symbol-name name))) template) - (setq template (replace-match val t t template)))) + (setq template + (replace-regexp-in-string + (concat "%" (upcase (symbol-name name))) val template t t))) options) (setq val (nth 1 (assq 'mathml options))) (if (string-match (concat "\\<mathml:") in-buffer) @@ -295,6 +320,56 @@ You can also customize this for each buffer, using something like (defcustom org-export-html-mathjax-template "<script type=\"text/javascript\" src=\"%PATH\"> +/** + * + * @source: %PATH + * + * @licstart The following is the entire license notice for the + * JavaScript code in %PATH. + * + * Copyright (C) 2012 MathJax + * + * Licensed under the Apache License, Version 2.0 (the \"License\"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an \"AS IS\" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * @licend The above is the entire license notice + * for the JavaScript code in %PATH. + * + */ + +/* +@licstart The following is the entire license notice for the +JavaScript code below. + +Copyright (C) 2012 Free Software Foundation, Inc. + +The JavaScript code below is free software: you can +redistribute it and/or modify it under the terms of the GNU +General Public License (GNU GPL) as published by the Free Software +Foundation, either version 3 of the License, or (at your option) +any later version. The code is distributed WITHOUT ANY WARRANTY; +without even the implied warranty of MERCHANTABILITY or FITNESS +FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + +As additional permission under GNU GPL version 3 section 7, you +may distribute non-source (e.g., minimized or compacted) forms of +that code without the copy of the GNU GPL normally required by +section 4, provided you include this license notice and a URL +through which recipients can access the Corresponding Source. + + +@licend The above is the entire license notice +for the JavaScript code below. +*/ <!--/*--><![CDATA[/*><!--*/ MathJax.Hub.Config({ // Only one of the two following lines, depending on user settings @@ -382,11 +457,17 @@ precedence over this variable." :group 'org-export-html :type '(choice (const :tag "No preamble" nil) (const :tag "Default preamble" t) - (string :tag "Custom formatting string") + (string :tag "Custom format string") (function :tag "Function (must return a string)"))) (defcustom org-export-html-preamble-format '(("en" "")) - "The format for the HTML preamble. + "Alist of languages and format strings for the HTML preamble. + +The first element of each list is the language code, as used for +the #+LANGUAGE keyword. + +The second element of each list is a format string to format the +preamble itself. This format string can contain these elements: %t stands for the title. %a stands for the author's name. @@ -402,7 +483,7 @@ like that: \"%%\"." (defcustom org-export-html-postamble 'auto "Non-nil means insert a postamble in HTML export. -When `t', insert a string as defined by the formatting string in +When `t', insert a string as defined by the format string in `org-export-html-postamble-format'. When set to a string, this string overrides `org-export-html-postamble-format'. When set to 'auto, discard `org-export-html-postamble-format' and honor @@ -416,8 +497,8 @@ precedence over this variable." :group 'org-export-html :type '(choice (const :tag "No postamble" nil) (const :tag "Auto preamble" 'auto) - (const :tag "Default formatting string" t) - (string :tag "Custom formatting string") + (const :tag "Default format string" t) + (string :tag "Custom format string") (function :tag "Function (must return a string)"))) (defcustom org-export-html-postamble-format @@ -426,7 +507,13 @@ precedence over this variable." <p class=\"creator\">Generated by %c</p> <p class=\"xhtml-validation\">%v</p> ")) - "The format for the HTML postamble. + "Alist of languages and format strings for the HTML postamble. + +The first element of each list is the language code, as used for +the #+LANGUAGE keyword. + +The second element of each list is a format string to format the +postamble itself. This format string can contain these elements: %a stands for the author's name. %e stands for the author's email. @@ -653,6 +740,14 @@ postamble DIV." (string :tag " Div for the content:") (string :tag "Div for the postamble:"))) +(defcustom org-export-html-date-format-string "%Y-%m-%dT%R%z" + "Format string to format the date and time. + +The default is an extended format of the ISO 8601 specification." + :group 'org-export-html + :version "24.1" + :type 'string) + ;;; Hooks (defvar org-export-html-after-blockquotes-hook nil @@ -668,7 +763,7 @@ postamble DIV." (when (and org-current-export-file (plist-get parameters :LaTeX-fragments)) (org-format-latex - (concat "ltxpng/" (file-name-sans-extension + (concat org-latex-preview-ltxpng-directory (file-name-sans-extension (file-name-nondirectory org-current-export-file))) org-current-export-dir nil "Creating LaTeX image %s" @@ -677,8 +772,8 @@ postamble DIV." ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim) ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax) ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax) - ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng) - (t nil)))) + ((eq (plist-get parameters :LaTeX-fragments) 'imagemagick) 'imagemagick) + ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng)))) (goto-char (point-min)) (let (label l1) (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) @@ -730,7 +825,7 @@ command to convert it." (interactive "r") (let (reg html buf pop-up-frames) (save-window-excursion - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq html (org-export-region-as-html beg end t 'string)) (setq reg (buffer-substring beg end) @@ -782,51 +877,51 @@ in a window. A non-interactive call will only return the buffer." ;;; org-html-cvt-link-fn (defconst org-html-cvt-link-fn - nil - "Function to convert link URLs to exportable URLs. + nil + "Function to convert link URLs to exportable URLs. Takes two arguments, TYPE and PATH. Returns exportable url as (TYPE PATH), or nil to signal that it didn't handle this case. Intended to be locally bound around a call to `org-export-as-html'." ) (defun org-html-cvt-org-as-html (opt-plist type path) - "Convert an org filename to an equivalent html filename. + "Convert an org filename to an equivalent html filename. If TYPE is not file, just return `nil'. See variable `org-export-html-link-org-files-as-html'" - (save-match-data - (and - org-export-html-link-org-files-as-html - (string= type "file") - (string-match "\\.org$" path) - (progn - (list - "file" - (concat - (substring path 0 (match-beginning 0)) - "." - (plist-get opt-plist :html-extension))))))) + (save-match-data + (and + org-export-html-link-org-files-as-html + (string= type "file") + (string-match "\\.org$" path) + (progn + (list + "file" + (concat + (substring path 0 (match-beginning 0)) + "." + (plist-get opt-plist :html-extension))))))) ;;; org-html-should-inline-p (defun org-html-should-inline-p (filename descp) - "Return non-nil if link FILENAME should be inlined. + "Return non-nil if link FILENAME should be inlined. The decision to inline the FILENAME link is based on the current settings. DESCP is the boolean of whether there was a link description. See variables `org-export-html-inline-images' and `org-export-html-inline-image-extensions'." - (declare (special - org-export-html-inline-images - org-export-html-inline-image-extensions)) - (and (or (eq t org-export-html-inline-images) - (and org-export-html-inline-images (not descp))) - (org-file-image-p - filename org-export-html-inline-image-extensions))) + (declare (special + org-export-html-inline-images + org-export-html-inline-image-extensions)) + (and (or (eq t org-export-html-inline-images) + (and org-export-html-inline-images (not descp))) + (org-file-image-p + filename org-export-html-inline-image-extensions))) ;;; org-html-make-link (defun org-html-make-link (opt-plist type path fragment desc attr - may-inline-p) - "Make an HTML link. + may-inline-p) + "Make an HTML link. OPT-PLIST is an options list. TYPE is the device-type of the link (THIS://foo.html). PATH is the path of the link (http://THIS#location). @@ -835,89 +930,89 @@ DESC is the link description, if any. ATTR is a string of other attributes of the \"a\" element. MAY-INLINE-P allows inlining it as an image." - (declare (special org-par-open)) - (save-match-data - (let* ((filename path) - ;;First pass. Just sanity stuff. - (components-1 - (cond - ((string= type "file") - (list - type - ;;Substitute just if original path was absolute. - ;;(Otherwise path must remain relative) - (if (file-name-absolute-p path) - (concat "file://" (expand-file-name path)) - path))) - ((string= type "") - (list nil path)) - (t (list type path)))) - - ;;Second pass. Components converted so they can refer - ;;to a remote site. - (components-2 - (or - (and org-html-cvt-link-fn - (apply org-html-cvt-link-fn - opt-plist components-1)) - (apply #'org-html-cvt-org-as-html - opt-plist components-1) - components-1)) - (type (first components-2)) - (thefile (second components-2))) - - - ;;Third pass. Build final link except for leading type - ;;spec. - (cond - ((or - (not type) - (string= type "http") - (string= type "https") - (string= type "file") - (string= type "coderef")) - (if fragment - (setq thefile (concat thefile "#" fragment)))) - - (t)) - - ;;Final URL-build, for all types. - (setq thefile + (declare (special org-par-open)) + (save-match-data + (let* ((filename path) + ;;First pass. Just sanity stuff. + (components-1 + (cond + ((string= type "file") + (list + type + ;;Substitute just if original path was absolute. + ;;(Otherwise path must remain relative) + (if (file-name-absolute-p path) + (concat "file://" (expand-file-name path)) + path))) + ((string= type "") + (list nil path)) + (t (list type path)))) + + ;;Second pass. Components converted so they can refer + ;;to a remote site. + (components-2 + (or + (and org-html-cvt-link-fn + (apply org-html-cvt-link-fn + opt-plist components-1)) + (apply #'org-html-cvt-org-as-html + opt-plist components-1) + components-1)) + (type (first components-2)) + (thefile (second components-2))) + + + ;;Third pass. Build final link except for leading type + ;;spec. + (cond + ((or + (not type) + (string= type "http") + (string= type "https") + (string= type "file") + (string= type "coderef")) + (if fragment + (setq thefile (concat thefile "#" fragment)))) + + (t)) + + ;;Final URL-build, for all types. + (setq thefile (let - ((str (org-export-html-format-href thefile))) + ((str (org-export-html-format-href thefile))) (if (and type (not (or (string= "file" type) (string= "coderef" type)))) (concat type ":" str) - str))) + str))) - (if (and - may-inline-p - ;;Can't inline a URL with a fragment. - (not fragment)) - (progn - (message "image %s %s" thefile org-par-open) - (org-export-html-format-image thefile org-par-open)) - (concat - "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">" - (org-export-html-format-desc desc) - "</a>"))))) - -(defun org-html-handle-links (line opt-plist) - "Return LINE with markup of Org mode links. + (if (and + may-inline-p + ;;Can't inline a URL with a fragment. + (not fragment)) + (progn + (message "image %s %s" thefile org-par-open) + (org-export-html-format-image thefile org-par-open)) + (concat + "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">" + (org-export-html-format-desc desc) + "</a>"))))) + +(defun org-html-handle-links (org-line opt-plist) + "Return ORG-LINE with markup of Org mode links. OPT-PLIST is the export options list." (let ((start 0) (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) + (file-name-directory buffer-file-name) + default-directory)) (link-validate (plist-get opt-plist :link-validation-function)) type id-file fnc rpl path attr desc descp desc1 desc2 link) - (while (string-match org-bracket-link-analytic-regexp++ line start) + (while (string-match org-bracket-link-analytic-regexp++ org-line start) (setq start (match-beginning 0)) (setq path (save-match-data (org-link-unescape - (match-string 3 line)))) + (match-string 3 org-line)))) (setq type (cond - ((match-end 2) (match-string 2 line)) + ((match-end 2) (match-string 2 org-line)) ((save-match-data (or (file-name-absolute-p path) (string-match "^\\.\\.?/" path))) @@ -925,7 +1020,7 @@ OPT-PLIST is the export options list." (t "internal"))) (setq path (org-extract-attributes path)) (setq attr (get-text-property 0 'org-attributes path)) - (setq desc1 (if (match-end 5) (match-string 5 line)) + (setq desc1 (if (match-end 5) (match-string 5 org-line)) desc2 (if (match-end 2) (concat type ":" path) path) descp (and desc1 (not (equal desc1 desc2))) desc (or desc1 desc2)) @@ -1066,9 +1161,9 @@ OPT-PLIST is the export options list." (setq rpl (concat "<i><" type ":" (save-match-data (org-link-unescape path)) "></i>")))) - (setq line (replace-match rpl t t line) + (setq org-line (replace-match rpl t t org-line) start (+ start (length rpl)))) - line)) + org-line)) ;;; org-export-as-html @@ -1150,7 +1245,7 @@ PUB-DIR is set, use this as the publishing directory." (org-current-export-dir (or pub-dir (org-export-directory :html opt-plist))) (org-current-export-file buffer-file-name) - (level 0) (line "") (origline "") txt todo + (level 0) (org-line "") (origline "") txt todo (umax nil) (umax-toc nil) (filename (if to-buffer nil @@ -1227,6 +1322,9 @@ PUB-DIR is set, use this as the publishing directory." (org-export-have-math nil) (org-export-footnotes-seen nil) (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) + (custom-id (or (org-entry-get nil "CUSTOM_ID" t) "")) + (footnote-def-prefix (format "fn-%s" custom-id)) + (footnote-ref-prefix (format "fnr-%s" custom-id)) (lines (org-split-string (org-export-preprocess-string @@ -1267,8 +1365,7 @@ PUB-DIR is set, use this as the publishing directory." rpl path attr desc descp desc1 desc2 link snumber fnc footnotes footref-seen - href - ) + href) (let ((inhibit-read-only t)) (org-unmodified @@ -1285,7 +1382,7 @@ PUB-DIR is set, use this as the publishing directory." ((and date (string-match "%" date)) (setq date (format-time-string date))) (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) + (t (setq date (format-time-string org-export-html-date-format-string)))) ;; Get the language-dependent settings (setq lang-words (or (assoc language org-export-language-setup) @@ -1371,12 +1468,12 @@ PUB-DIR is set, use this as the publishing directory." (insert "\n</div>\n")) (t (setq html-pre-real-contents - (format-spec - (or (cadr (assoc (nth 0 lang-words) - org-export-html-preamble-format)) - (cadr (assoc "en" org-export-html-preamble-format))) - `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email)))))) + (format-spec + (or (cadr (assoc (nth 0 lang-words) + org-export-html-preamble-format)) + (cadr (assoc "en" org-export-html-preamble-format))) + `((?t . ,title) (?a . ,author) + (?d . ,date) (?e . ,email)))))) ;; don't output an empty preamble DIV (unless (and (functionp html-pre) (equal html-pre-real-contents "")) @@ -1394,7 +1491,7 @@ PUB-DIR is set, use this as the publishing directory." "\n<h1 class=\"title\">" title "</h1>\n")) ;; insert body - (if (and org-export-with-toc (not body-only)) + (if org-export-with-toc (progn (push (format "<h%d>%s</h%d>\n" org-export-html-toplevel-hlevel @@ -1405,9 +1502,9 @@ PUB-DIR is set, use this as the publishing directory." (push "<ul>\n<li>" thetoc) (setq lines (mapcar - #'(lambda (line) - (if (and (string-match org-todo-line-regexp line) - (not (get-text-property 0 'org-protected line))) + #'(lambda (org-line) + (if (and (string-match org-todo-line-regexp org-line) + (not (get-text-property 0 'org-protected org-line))) ;; This is a headline (progn (setq have-headings t) @@ -1417,17 +1514,17 @@ PUB-DIR is set, use this as the publishing directory." txt (save-match-data (org-html-expand (org-export-cleanup-toc-line - (match-string 3 line)))) + (match-string 3 org-line)))) todo (or (and org-export-mark-todo-in-toc (match-beginning 2) - (not (member (match-string 2 line) + (not (member (match-string 2 org-line) org-done-keywords))) ; TODO, not DONE (and org-export-mark-todo-in-toc (= level umax-toc) (org-search-todo-below - line lines level)))) + org-line lines level)))) (if (string-match (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) (setq txt (replace-match @@ -1456,11 +1553,11 @@ PUB-DIR is set, use this as the publishing directory." (push "</li>\n</ul>" thetoc)) (push "\n" thetoc))) ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line (replace-match - (concat "@<span class=\"target\">" - (match-string 1 line) "@</span> ") - t t line))) + (while (string-match org-any-target-regexp org-line) + (setq org-line (replace-match + (concat "@<span class=\"target\">" + (match-string 1 org-line) "@</span> ") + t t org-line))) (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) (setq txt (replace-match "" t t txt))) (setq href @@ -1477,7 +1574,7 @@ PUB-DIR is set, use this as the publishing directory." href txt) thetoc) (setq org-last-level level))))) - line) + org-line) lines)) (while (> org-last-level (1- org-min-level)) (setq org-last-level (1- org-last-level)) @@ -1490,28 +1587,28 @@ PUB-DIR is set, use this as the publishing directory." (org-open-par) - (while (setq line (pop lines) origline line) + (while (setq org-line (pop lines) origline org-line) (catch 'nextline ;; end of quote section? - (when (and inquote (string-match org-outline-regexp-bol line)) + (when (and inquote (string-match org-outline-regexp-bol org-line)) (insert "</pre>\n") (org-open-par) (setq inquote nil)) ;; inside a quote section? (when inquote - (insert (org-html-protect line) "\n") + (insert (org-html-protect org-line) "\n") (throw 'nextline nil)) ;; Fixed-width, verbatim lines (examples) (when (and org-export-with-fixed-width - (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line)) + (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" org-line)) (when (not infixed) (setq infixed t) (org-close-par-maybe) (insert "<pre class=\"example\">\n")) - (insert (org-html-protect (match-string 3 line)) "\n") + (insert (org-html-protect (match-string 3 org-line)) "\n") (when (or (not lines) (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" (car lines)))) @@ -1521,17 +1618,17 @@ PUB-DIR is set, use this as the publishing directory." (throw 'nextline nil)) ;; Protected HTML - (when (and (get-text-property 0 'org-protected line) + (when (and (get-text-property 0 'org-protected org-line) ;; Make sure it is the entire line that is protected (not (< (or (next-single-property-change - 0 'org-protected line) 10000) - (length line)))) - (let (par (ind (get-text-property 0 'original-indentation line))) + 0 'org-protected org-line) 10000) + (length org-line)))) + (let (par (ind (get-text-property 0 'original-indentation org-line))) (when (re-search-backward "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) (setq par (match-string 1)) (replace-match "\\2\n")) - (insert line "\n") + (insert org-line "\n") (while (and lines (or (= (length (car lines)) 0) (not ind) @@ -1543,144 +1640,144 @@ PUB-DIR is set, use this as the publishing directory." (throw 'nextline nil)) ;; Blockquotes, verse, and center - (when (equal "ORG-BLOCKQUOTE-START" line) + (when (equal "ORG-BLOCKQUOTE-START" org-line) (org-close-par-maybe) (insert "<blockquote>\n") (org-open-par) (throw 'nextline nil)) - (when (equal "ORG-BLOCKQUOTE-END" line) + (when (equal "ORG-BLOCKQUOTE-END" org-line) (org-close-par-maybe) (insert "\n</blockquote>\n") (org-open-par) (throw 'nextline nil)) - (when (equal "ORG-VERSE-START" line) + (when (equal "ORG-VERSE-START" org-line) (org-close-par-maybe) (insert "\n<p class=\"verse\">\n") (setq org-par-open t) (setq inverse t) (throw 'nextline nil)) - (when (equal "ORG-VERSE-END" line) + (when (equal "ORG-VERSE-END" org-line) (insert "</p>\n") (setq org-par-open nil) (org-open-par) (setq inverse nil) (throw 'nextline nil)) - (when (equal "ORG-CENTER-START" line) + (when (equal "ORG-CENTER-START" org-line) (org-close-par-maybe) (insert "\n<div style=\"text-align: center\">") (org-open-par) (throw 'nextline nil)) - (when (equal "ORG-CENTER-END" line) + (when (equal "ORG-CENTER-END" org-line) (org-close-par-maybe) (insert "\n</div>") (org-open-par) (throw 'nextline nil)) (run-hooks 'org-export-html-after-blockquotes-hook) (when inverse - (let ((i (org-get-string-indentation line))) + (let ((i (org-get-string-indentation org-line))) (if (> i 0) - (setq line (concat (mapconcat 'identity - (make-list (* 2 i) "\\nbsp") "") - " " (org-trim line)))) - (unless (string-match "\\\\\\\\[ \t]*$" line) - (setq line (concat line "\\\\"))))) + (setq org-line (concat (mapconcat 'identity + (make-list (* 2 i) "\\nbsp") "") + " " (org-trim org-line)))) + (unless (string-match "\\\\\\\\[ \t]*$" org-line) + (setq org-line (concat org-line "\\\\"))))) ;; make targets to anchors (setq start 0) (while (string-match - "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start) + "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" org-line start) (cond - ((get-text-property (match-beginning 1) 'org-protected line) + ((get-text-property (match-beginning 1) 'org-protected org-line) (setq start (match-end 1))) ((match-end 2) - (setq line (replace-match - (format - "@<a name=\"%s\" id=\"%s\">@</a>" - (org-solidify-link-text (match-string 1 line)) - (org-solidify-link-text (match-string 1 line))) - t t line))) - ((and org-export-with-toc (equal (string-to-char line) ?*)) + (setq org-line (replace-match + (format + "@<a name=\"%s\" id=\"%s\">@</a>" + (org-solidify-link-text (match-string 1 org-line)) + (org-solidify-link-text (match-string 1 org-line))) + t t org-line))) + ((and org-export-with-toc (equal (string-to-char org-line) ?*)) ;; FIXME: NOT DEPENDENT on TOC????????????????????? - (setq line (replace-match - (concat "@<span class=\"target\">" - (match-string 1 line) "@</span> ") - ;; (concat "@<i>" (match-string 1 line) "@</i> ") - t t line))) + (setq org-line (replace-match + (concat "@<span class=\"target\">" + (match-string 1 org-line) "@</span> ") + ;; (concat "@<i>" (match-string 1 org-line) "@</i> ") + t t org-line))) (t - (setq line (replace-match - (concat "@<a name=\"" - (org-solidify-link-text (match-string 1 line)) - "\" class=\"target\">" (match-string 1 line) - "@</a> ") - t t line))))) + (setq org-line (replace-match + (concat "@<a name=\"" + (org-solidify-link-text (match-string 1 org-line)) + "\" class=\"target\">" (match-string 1 org-line) + "@</a> ") + t t org-line))))) - (setq line (org-html-handle-time-stamps line)) + (setq org-line (org-html-handle-time-stamps org-line)) ;; replace "&" by "&", "<" and ">" by "<" and ">" ;; handle @<..> HTML tags (replace "@>..<" by "<..>") ;; Also handle sub_superscripts and checkboxes - (or (string-match org-table-hline-regexp line) - (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line) - (setq line (org-html-expand line))) + (or (string-match org-table-hline-regexp org-line) + (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" org-line) + (setq org-line (org-html-expand org-line))) ;; Format the links - (setq line (org-html-handle-links line opt-plist)) + (setq org-line (org-html-handle-links org-line opt-plist)) ;; TODO items (if (and org-todo-line-regexp - (string-match org-todo-line-regexp line) + (string-match org-todo-line-regexp org-line) (match-beginning 2)) - (setq line - (concat (substring line 0 (match-beginning 2)) + (setq org-line + (concat (substring org-line 0 (match-beginning 2)) "<span class=\"" - (if (member (match-string 2 line) + (if (member (match-string 2 org-line) org-done-keywords) "done" "todo") " " (org-export-html-get-todo-kwd-class-name - (match-string 2 line)) - "\">" (match-string 2 line) - "</span>" (substring line (match-end 2))))) + (match-string 2 org-line)) + "\">" (match-string 2 org-line) + "</span>" (substring org-line (match-end 2))))) ;; Does this contain a reference to a footnote? (when org-export-with-footnotes (setq start 0) - (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start) + (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" org-line start) ;; Discard protected matches not clearly identified as ;; footnote markers. - (if (or (get-text-property (match-beginning 2) 'org-protected line) - (not (get-text-property (match-beginning 2) 'org-footnote line))) + (if (or (get-text-property (match-beginning 2) 'org-protected org-line) + (not (get-text-property (match-beginning 2) 'org-footnote org-line))) (setq start (match-end 2)) - (let ((n (match-string 2 line)) extra a) + (let ((n (match-string 2 org-line)) extra a) (if (setq a (assoc n footref-seen)) (progn (setcdr a (1+ (cdr a))) (setq extra (format ".%d" (cdr a)))) (setq extra "") (push (cons n 1) footref-seen)) - (setq line + (setq org-line (replace-match (concat (format (concat "%s" (format org-export-html-footnote-format - (concat "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>"))) - (or (match-string 1 line) "") n extra n n) + (concat "<a class=\"footref\" name=\"" footnote-ref-prefix ".%s%s\" href=\"#" footnote-def-prefix ".%s\">%s</a>"))) + (or (match-string 1 org-line) "") n extra n n) ;; If another footnote is following the ;; current one, add a separator. (if (save-match-data (string-match "\\`\\[[0-9]+\\]" - (substring line (match-end 0)))) + (substring org-line (match-end 0)))) org-export-html-footnote-separator "")) - t t line)))))) + t t org-line)))))) (cond - ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line) + ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" org-line) ;; This is a headline (setq level (org-tr-level (- (match-end 1) (match-beginning 1) level-offset)) - txt (match-string 2 line)) + txt (or (match-string 2 org-line) "")) (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt))) (if (<= level (max umax umax-toc)) @@ -1691,19 +1788,19 @@ PUB-DIR is set, use this as the publishing directory." head-count opt-plist) ;; QUOTES - (when (string-match quote-re line) + (when (string-match quote-re org-line) (org-close-par-maybe) (insert "<pre>") (setq inquote t))) ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) + (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" org-line)) (when (not table-open) ;; New table starts (setq table-open t table-buffer nil table-orig-buffer nil)) ;; Accumulate lines - (setq table-buffer (cons line table-buffer) + (setq table-buffer (cons org-line table-buffer) table-orig-buffer (cons origline table-orig-buffer)) (when (or (not lines) (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" @@ -1718,15 +1815,15 @@ PUB-DIR is set, use this as the publishing directory." (t ;; This line either is list item or end a list. - (when (get-text-property 0 'list-item line) - (setq line (org-html-export-list-line - line - (get-text-property 0 'list-item line) - (get-text-property 0 'list-struct line) - (get-text-property 0 'list-prevs line)))) + (when (get-text-property 0 'list-item org-line) + (setq org-line (org-html-export-list-line + org-line + (get-text-property 0 'list-item org-line) + (get-text-property 0 'list-struct org-line) + (get-text-property 0 'list-prevs org-line)))) ;; Horizontal line - (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) + (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line) (if org-par-open (insert "\n</p>\n<hr/>\n<p>\n") (insert "\n<hr/>\n")) @@ -1735,44 +1832,45 @@ PUB-DIR is set, use this as the publishing directory." ;; Empty lines start a new paragraph. If hand-formatted lists ;; are not fully interpreted, lines starting with "-", "+", "*" ;; also start a new paragraph. - (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par)) + (if (string-match "^ [-+*]-\\|^[ \t]*$" org-line) (org-open-par)) ;; Is this the start of a footnote? (when org-export-with-footnotes (when (and (boundp 'footnote-section-tag-regexp) (string-match (concat "^" footnote-section-tag-regexp) - line)) + org-line)) ;; ignore this line (throw 'nextline nil)) - (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) + (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" org-line) (org-close-par-maybe) - (let ((n (match-string 1 line))) + (let ((n (match-string 1 org-line))) (setq org-par-open t - line (replace-match - (format - (concat "<p class=\"footnote\">" - (format org-export-html-footnote-format - "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>")) - n n n) t t line))))) + org-line (replace-match + (format + (concat "<p class=\"footnote\">" + (format org-export-html-footnote-format + (concat + "<a class=\"footnum\" name=\"" footnote-def-prefix ".%s\" href=\"#" footnote-ref-prefix ".%s\">%s</a>"))) + n n n) t t org-line))))) ;; Check if the line break needs to be conserved (cond - ((string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match "<br/>" t t line))) + ((string-match "\\\\\\\\[ \t]*$" org-line) + (setq org-line (replace-match "<br/>" t t org-line))) (org-export-preserve-breaks - (setq line (concat line "<br/>")))) + (setq org-line (concat org-line "<br/>")))) ;; Check if a paragraph should be started (let ((start 0)) (while (and org-par-open - (string-match "\\\\par\\>" line start)) + (string-match "\\\\par\\>" org-line start)) ;; Leave a space in the </p> so that the footnote matcher ;; does not see this. (if (not (get-text-property (match-beginning 0) - 'org-protected line)) - (setq line (replace-match "</p ><p >" t t line))) + 'org-protected org-line)) + (setq org-line (replace-match "</p ><p >" t t org-line))) (setq start (match-end 0)))) - (insert line "\n"))))) + (insert org-line "\n"))))) ;; Properly close all local lists and other lists (when inquote @@ -1814,7 +1912,8 @@ PUB-DIR is set, use this as the publishing directory." (split-string email ",+ *") ", ")) (creator-info - (concat "Org version " org-version " with Emacs version " + (concat "<a href=\"http://orgmode.org\">Org</a> version " + (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version " (number-to-string emacs-major-version)))) (when (plist-get opt-plist :html-postamble) @@ -1831,12 +1930,13 @@ PUB-DIR is set, use this as the publishing directory." (when (plist-get opt-plist :time-stamp-file) (insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n")) (when (and (plist-get opt-plist :author-info) author) - (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n")) + (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n")) (when (and (plist-get opt-plist :email-info) email) (insert "<p class=\"email\">" email "</p>\n")) (when (plist-get opt-plist :creator-info) (insert "<p class=\"creator\">" - (concat "Org version " org-version " with Emacs version " + (concat "<a href=\"http://orgmode.org\">Org</a> version " + (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version " (number-to-string emacs-major-version) "</p>\n"))) (insert html-validation-link "\n")) (t @@ -1931,7 +2031,7 @@ PUB-DIR is set, use this as the publishing directory." (defun org-export-html-format-image (src par-open) "Create image tag with source and attributes." (save-match-data - (if (string-match "^ltxpng/" src) + (if (string-match (regexp-quote org-latex-preview-ltxpng-directory) src) (format "<img src=\"%s\" alt=\"%s\"/>" src (org-find-text-property-in-string 'org-latex-src src)) (let* ((caption (org-find-text-property-in-string 'org-caption src)) @@ -1939,21 +2039,21 @@ PUB-DIR is set, use this as the publishing directory." (label (org-find-text-property-in-string 'org-label src))) (setq caption (and caption (org-html-do-expand caption))) (concat - (if caption - (format "%s<div %sclass=\"figure\"> + (if caption + (format "%s<div %sclass=\"figure\"> <p>" - (if org-par-open "</p>\n" "") - (if label (format "id=\"%s\" " (org-solidify-link-text label)) ""))) - (format "<img src=\"%s\"%s />" - src - (if (string-match "\\<alt=" (or attr "")) - (concat " " attr ) - (concat " " attr " alt=\"" src "\""))) - (if caption - (format "</p>%s + (if org-par-open "</p>\n" "") + (if label (format "id=\"%s\" " (org-solidify-link-text label)) ""))) + (format "<img src=\"%s\"%s />" + src + (if (string-match "\\<alt=" (or attr "")) + (concat " " attr ) + (concat " " attr " alt=\"" src "\""))) + (if caption + (format "</p>%s </div>%s" - (concat "\n<p>" caption "</p>") - (if org-par-open "\n<p>" "")))))))) + (concat "\n<p>" caption "</p>") + (if org-par-open "\n<p>" "")))))))) (defun org-export-html-get-bibliography () "Find bibliography, cut it out and return it." @@ -1969,7 +2069,7 @@ PUB-DIR is set, use this as the publishing directory." (and (looking-at ">") (forward-char 1)) (setq bib (buffer-substring beg (point))) (delete-region beg (point)) - (throw 'exit bib)))) + (throw 'exit bib)))) nil)))) (defvar org-table-number-regexp) ; defined in org-table.el @@ -2020,7 +2120,7 @@ for formatting. This is required for the DocBook exporter." (lambda (x) (string-match "^[ \t]*|-" x)) (cdr lines))))) (nline 0) fnum nfields i (cnt 0) - tbopen line fields html gr colgropen rowstart rowend + tbopen org-line fields html gr colgropen rowstart rowend ali align aligns n) (setq caption (and caption (org-html-do-expand caption))) (when (and col-cookies org-table-clean-did-remove-column) @@ -2029,9 +2129,9 @@ for formatting. This is required for the DocBook exporter." (if splice (setq head nil)) (unless splice (push (if head "<thead>" "<tbody>") html)) (setq tbopen t) - (while (setq line (pop lines)) + (while (setq org-line (pop lines)) (catch 'next-line - (if (string-match "^[ \t]*|-" line) + (if (string-match "^[ \t]*|-" org-line) (progn (unless splice (push (if head "</thead>" "</tbody>") html) @@ -2040,7 +2140,7 @@ for formatting. This is required for the DocBook exporter." ;; ignore this line (throw 'next-line t))) ;; Break the line into fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) + (setq fields (org-split-string org-line "[ \t]*|[ \t]*")) (unless fnum (setq fnum (make-vector (length fields) 0) nfields (length fnum))) (setq nline (1+ nline) i -1 @@ -2114,11 +2214,12 @@ for formatting. This is required for the DocBook exporter." (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) ;; Since the output of HTML table formatter can also be used in - ;; DocBook document, we want to always include the caption to make - ;; DocBook XML file valid. - (push (format "<caption>%s</caption>" (or caption "")) html) + ;; DocBook document, include empty captions for the DocBook + ;; export only so that it produces valid XML. + (when (or caption (eq org-export-current-backend 'docbook)) + (push (format "<caption>%s</caption>" (or caption "")) html)) (when label - (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label))))) + (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label))))) (push html-table-tag html)) (setq html (mapcar (lambda (x) @@ -2155,14 +2256,14 @@ for formatting. This is required for the DocBook exporter." This conversion does *not* use `table-generate-source' from table.el. This has the advantage that Org-mode's HTML conversions can be used. But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (line field-buffer - (head org-export-highlight-first-table-line) - fields html empty i) + (let (org-line field-buffer + (head org-export-highlight-first-table-line) + fields html empty i) (setq html (concat html-table-tag "\n")) - (while (setq line (pop lines)) + (while (setq org-line (pop lines)) (setq empty " ") (catch 'next-line - (if (string-match "^[ \t]*\\+-" line) + (if (string-match "^[ \t]*\\+-" org-line) (progn (if field-buffer (progn @@ -2188,7 +2289,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." ;; Ignore this line (throw 'next-line t))) ;; Break the line into fields and store the fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) + (setq fields (org-split-string org-line "[ \t]*|[ \t]*")) (if field-buffer (setq field-buffer (mapcar (lambda (x) @@ -2338,7 +2439,7 @@ is nil, return nil." l (match-string 0 string) string (substring string (match-end 0))) (push (org-html-do-expand s) res) - (push l res)) + (push l res)) (push (org-html-do-expand string) res) (apply 'concat (nreverse res))))) @@ -2469,22 +2570,22 @@ When TITLE is nil, just close all open levels." (when title ;; If title is nil, this means this function is called to close ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq title (replace-match - (if org-export-with-tags - (save-match-data - (concat - " <span class=\"tag\">" - (mapconcat - (lambda (x) - (format "<span class=\"%s\">%s</span>" - (org-export-html-get-tag-class-name x) - x)) - (org-split-string (match-string 1 title) ":") - " ") - "</span>")) - "") - t t title))) + (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) + (setq title (replace-match + (if org-export-with-tags + (save-match-data + (concat + " <span class=\"tag\">" + (mapconcat + (lambda (x) + (format "<span class=\"%s\">%s</span>" + (org-export-html-get-tag-class-name x) + x)) + (org-split-string (match-string 1 title) ":") + " ") + "</span>")) + "") + t t title))) (if (> level umax) (progn (if (aref org-levels-open (1- level)) @@ -2553,11 +2654,11 @@ Replaces invalid characters with \"_\" and then prepends a prefix." (org-close-li) (insert "</ul>\n"))) -(defun org-html-export-list-line (line pos struct prevs) - "Insert list syntax in export buffer. Return LINE, maybe modified. +(defun org-html-export-list-line (org-line pos struct prevs) + "Insert list syntax in export buffer. Return ORG-LINE, maybe modified. -POS is the item position or line position the line had before -modifications to buffer. STRUCT is the list structure. PREVS is +POS is the item position or org-line position the org-line had before +modifications to buffer. STRUCT is the list structure. PREVS is the alist of previous items." (let* ((get-type (function @@ -2605,10 +2706,10 @@ the alist of previous items." "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" - "\\(.*\\)") line) - (let* ((checkbox (match-string 3 line)) - (desc-tag (or (match-string 4 line) "???")) - (body (or (match-string 5 line) "")) + "\\(.*\\)") org-line) + (let* ((checkbox (match-string 3 org-line)) + (desc-tag (or (match-string 4 org-line) "???")) + (body (or (match-string 5 org-line) "")) (list-beg (org-list-get-list-begin pos struct prevs)) (firstp (= list-beg pos)) ;; Always refer to first item to determine list type, in @@ -2642,9 +2743,9 @@ the alist of previous items." ;; Return modified line body)) ;; At a list ender: go to next line (side-effects only). - ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil)) + ((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil)) ;; Not at an item: return line unchanged (side-effects only). - (t line)))) + (t org-line)))) (provide 'org-html) diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el index d73a6195b3..8523b44258 100644 --- a/lisp/org/org-icalendar.el +++ b/lisp/org/org-icalendar.el @@ -28,8 +28,7 @@ (require 'org-exp) -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl)) (declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) @@ -194,7 +193,7 @@ or if they are only using it locally." (defcustom org-icalendar-timezone (getenv "TZ") "The time zone string for iCalendar export. -When nil of the empty string, use the abbreviation retrieved from Emacs." +When nil or the empty string, use output from \(current-time-zone\)." :group 'org-export-icalendar :type '(choice (const :tag "Unspecified" nil) @@ -257,7 +256,7 @@ The file is stored under the name `org-combined-agenda-icalendar-file'." If COMBINE is non-nil, combine all calendar entries into a single large file and store it under the name `org-combined-agenda-icalendar-file'." (save-excursion - (org-prepare-agenda-buffers files) + (org-agenda-prepare-buffers files) (let* ((dir (org-export-directory :ical (list :publishing-directory org-export-publishing-directory))) @@ -288,20 +287,19 @@ file and store it under the name `org-combined-agenda-icalendar-file'." (let ((standard-output ical-buffer)) (if combine (and (not started) (setq started t) - (org-start-icalendar-file org-icalendar-combined-name)) - (org-start-icalendar-file category)) - (org-print-icalendar-entries combine) + (org-icalendar-start-file org-icalendar-combined-name)) + (org-icalendar-start-file category)) + (org-icalendar-print-entries combine) (when (or (and combine (not files)) (not combine)) (when (and combine org-icalendar-include-bbdb-anniversaries) (require 'org-bbdb) (org-bbdb-anniv-export-ical)) - (org-finish-icalendar-file) + (org-icalendar-finish-file) (set-buffer ical-buffer) (run-hooks 'org-before-save-iCalendar-file-hook) (save-buffer) (run-hooks 'org-after-save-iCalendar-file-hook) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) - )))) + (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))))) (org-release-buffers org-agenda-new-buffers)))) (defvar org-before-save-iCalendar-file-hook nil @@ -315,18 +313,18 @@ A good way to use this is to tell a desktop calendar application to re-read the iCalendar file.") (defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el -(defun org-print-icalendar-entries (&optional combine) +(defun org-icalendar-print-entries (&optional combine) "Print iCalendar entries for the current Org-mode file to `standard-output'. When COMBINE is non nil, add the category to each line." (require 'org-agenda) (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) - (dts (org-ical-ts-to-string + (dts (org-icalendar-ts-to-string (format-time-string (cdr org-time-stamp-formats) (current-time)) "DTSTART")) hd ts ts2 state status (inc t) pos b sexp rrule scheduledp deadlinep todo prefix due start tags - tmp pri categories location summary desc uid alarm + tmp pri categories location summary desc uid alarm alarm-time (sexp-buffer (get-buffer-create "*ical-tmp*"))) (org-refresh-category-properties) (save-excursion @@ -359,26 +357,25 @@ When COMBINE is non nil, add the category to each line." (org-id-get-create) (or (org-id-get) (org-id-new))) categories (org-export-get-categories) + alarm-time (org-entry-get nil "APPT_WARNTIME") + alarm-time (if alarm-time (string-to-number alarm-time) 0) alarm "" deadlinep nil scheduledp nil) + (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos) + deadlinep (string-match org-deadline-regexp tmp) + scheduledp (string-match org-scheduled-regexp tmp) + todo (org-get-todo-state)) + ;; donep (org-entry-is-done-p) (if (looking-at re2) (progn (goto-char (match-end 0)) (setq ts2 (match-string 1) inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) - (setq tmp (buffer-substring (max (point-min) - (- pos org-ds-keyword-length)) - pos) - ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) + (setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) (progn (setq inc nil) (replace-match "\\1" t nil ts)) - ts) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - todo (org-get-todo-state) - ;; donep (org-entry-is-done-p) - )) + ts))) (when (and (not org-icalendar-use-plain-timestamp) (not deadlinep) (not scheduledp)) (throw :skip t)) @@ -403,12 +400,12 @@ When COMBINE is non nil, add the category to each line." (if (or (string-match org-tr-regexp hd) (string-match org-ts-regexp hd)) (setq hd (replace-match "" t t hd))) - (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) + (if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts) (setq rrule (concat "\nRRULE:FREQ=" (cdr (assoc (match-string 2 ts) - '(("d" . "DAILY")("w" . "WEEKLY") + '(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY") ("m" . "MONTHLY")("y" . "YEARLY")))) ";INTERVAL=" (match-string 1 ts))) (setq rrule "")) @@ -419,11 +416,11 @@ When COMBINE is non nil, add the category to each line." ;; (c) only a DISPLAY action is defined. ;; [ESF] (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault)))) - (if (and (> org-icalendar-alarm-time 0) + (if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0)) (car t1) (nth 1 t1) (nth 2 t1)) - (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time)) - (setq alarm "")) - ) + (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM" + summary (or alarm-time org-icalendar-alarm-time))) + (setq alarm ""))) (if (string-match org-bracket-link-regexp summary) (setq summary (replace-match (if (match-end 3) @@ -446,8 +443,8 @@ SUMMARY:%s%s%s CATEGORIES:%s%s END:VEVENT\n" (concat prefix uid) - (org-ical-ts-to-string ts "DTSTART") - (org-ical-ts-to-string ts2 "DTEND" inc) + (org-icalendar-ts-to-string ts "DTSTART") + (org-icalendar-ts-to-string ts2 "DTEND" inc) rrule summary (if (and desc (string-match "\\S-" desc)) (concat "\nDESCRIPTION: " desc) "") @@ -525,13 +522,13 @@ END:VEVENT\n" due (and (member 'todo-due org-icalendar-use-deadline) (org-entry-get nil "DEADLINE")) start (and (member 'todo-start org-icalendar-use-scheduled) - (org-entry-get nil "SCHEDULED")) + (org-entry-get nil "SCHEDULED")) categories (org-export-get-categories) uid (if org-icalendar-store-UID (org-id-get-create) (or (org-id-get) (org-id-new)))) - (and due (setq due (org-ical-ts-to-string due "DUE"))) - (and start (setq start (org-ical-ts-to-string start "DTSTART"))) + (and due (setq due (org-icalendar-ts-to-string due "DUE"))) + (and start (setq start (org-icalendar-ts-to-string start "DTSTART"))) (if (string-match org-bracket-link-regexp hd) (setq hd (replace-match (if (match-end 3) (match-string 3 hd) @@ -588,10 +585,10 @@ characters." (if (not s) nil (if is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s)))) + (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) + (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) + (while (string-match re s) (setq s (replace-match "" t t s))) + (while (string-match re2 s) (setq s (replace-match "" t t s)))) (setq s (replace-regexp-in-string "[[:space:]]+" " " s))) (let ((start 0)) (while (string-match "\\([,;]\\)" s start) @@ -634,7 +631,7 @@ not used right now." (when (string-match "[;,:]" s) (setq s (concat "\"" s "\""))) s)) -(defun org-start-icalendar-file (name) +(defun org-icalendar-start-file (name) "Start an iCalendar file by inserting the header." (let ((user user-full-name) (name (or name "unknown")) @@ -651,11 +648,11 @@ X-WR-TIMEZONE:%s X-WR-CALDESC:%s CALSCALE:GREGORIAN\n" name user timezone description)))) -(defun org-finish-icalendar-file () +(defun org-icalendar-finish-file () "Finish an iCalendar file by inserting the END statement." (princ "END:VCALENDAR\n")) -(defun org-ical-ts-to-string (s keyword &optional inc) +(defun org-icalendar-ts-to-string (s keyword &optional inc) "Take a time string S and convert it to iCalendar format. KEYWORD is added in front, to make a complete line like DTSTART.... When INC is non-nil, increase the hour by two (if time string contains @@ -680,7 +677,7 @@ a time), or the day by one (if it does not contain a time)." (replace-regexp-in-string "%Z" org-icalendar-timezone org-icalendar-date-time-format) - ";VALUE=DATE:%Y%m%d")) + ";VALUE=DATE:%Y%m%d")) (concat keyword (format-time-string fmt time (and (org-icalendar-use-UTC-date-timep) have-time)))))) diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index a93f804946..c156e240db 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -83,6 +83,47 @@ :tag "Org ID" :group 'org) +(define-obsolete-variable-alias + 'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3") +(defcustom org-id-link-to-org-use-id nil + "Non-nil means storing a link to an Org file will use entry IDs. + +The variable can have the following values: + +t Create an ID if needed to make a link to the current entry. + +create-if-interactive + If `org-store-link' is called directly (interactively, as a user + command), do create an ID to support the link. But when doing the + job for capture, only use the ID if it already exists. The + purpose of this setting is to avoid proliferation of unwanted + IDs, just because you happen to be in an Org file when you + call `org-capture' that automatically and preemptively creates a + link. If you do want to get an ID link in a capture template to + an entry not having an ID, create it first by explicitly creating + a link to it, using `C-c C-l' first. + +create-if-interactive-and-no-custom-id + Like create-if-interactive, but do not create an ID if there is + a CUSTOM_ID property defined in the entry. + +use-existing + Use existing ID, do not create one. + +nil Never use an ID to make a link, instead link using a text search for + the headline text." + :group 'org-link-store + :group 'org-id + :version "24.3" + :type '(choice + (const :tag "Create ID to make link" t) + (const :tag "Create if storing link interactively" + create-if-interactive) + (const :tag "Create if storing link interactively and no CUSTOM_ID is present" + create-if-interactive-and-no-custom-id) + (const :tag "Only use existing" use-existing) + (const :tag "Do not use ID to create link" nil))) + (defcustom org-id-uuid-program "uuidgen" "The uuidgen program." :group 'org-id @@ -216,8 +257,7 @@ In any case, the ID of the entry is returned." (setq id (org-id-new prefix)) (org-entry-put pom "ID" id) (org-id-add-location id (buffer-file-name (buffer-base-buffer))) - id) - (t nil))))) + id))))) ;;;###autoload (defun org-id-get-with-outline-path-completion (&optional targets) @@ -273,7 +313,7 @@ With optional argument MARKERP, return the position as a new marker." (when file (setq where (org-id-find-id-in-file id file markerp))) (unless where - (org-id-update-id-locations) + (org-id-update-id-locations nil t) (setq file (org-id-find-id-file id)) (when file (setq where (org-id-find-id-in-file id file markerp)))) @@ -403,7 +443,7 @@ and time is the usual three-integer representation of time." ;; Storing ID locations (files) -(defun org-id-update-id-locations (&optional files) +(defun org-id-update-id-locations (&optional files silent) "Scan relevant files for IDs. Store the relation between files and corresponding IDs. This will scan all agenda files, all associated archives, and all @@ -427,11 +467,11 @@ When CHECK is given, prepare detailed information about duplicate IDs." (if (symbolp org-id-extra-files) (symbol-value org-id-extra-files) org-id-extra-files) - ;; Files associated with live org-mode buffers + ;; Files associated with live org-mode buffers (delq nil (mapcar (lambda (b) (with-current-buffer b - (and (eq major-mode 'org-mode) (buffer-file-name)))) + (and (derived-mode-p 'org-mode) (buffer-file-name)))) (buffer-list))) ;; All files known to have IDs org-id-files))) @@ -441,8 +481,9 @@ When CHECK is given, prepare detailed information about duplicate IDs." (setq files (delq 'agenda-archives (copy-sequence files)))) (setq nfiles (length files)) (while (setq file (pop files)) - (message "Finding ID locations (%d/%d files): %s" - (- nfiles (length files)) nfiles file) + (unless silent + (message "Finding ID locations (%d/%d files): %s" + (- nfiles (length files)) nfiles file)) (setq tfile (file-truename file)) (when (and (file-exists-p file) (not (member tfile seen))) (push tfile seen) @@ -505,7 +546,7 @@ When CHECK is given, prepare detailed information about duplicate IDs." (goto-char (point-min)) (setq org-id-locations (read (current-buffer)))) (error - (message "Could not read org-id-values from %s. Setting it to nil." + (message "Could not read org-id-values from %s. Setting it to nil." org-id-locations-file)))) (setq org-id-files (mapcar 'car org-id-locations)) (setq org-id-locations (org-id-alist-to-hash org-id-locations)))) @@ -600,8 +641,8 @@ optional argument MARKERP, return the position as a new marker." (defun org-id-store-link () "Store a link to the current entry, using its ID." (interactive) - (when (and (buffer-file-name (buffer-base-buffer)) (eq major-mode 'org-mode)) - (let* ((link (org-make-link "id:" (org-id-get-create))) + (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + (let* ((link (concat "id:" (org-id-get-create))) (case-fold-search nil) (desc (save-excursion (org-back-to-heading t) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 99a75841de..d006df8674 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -45,6 +45,7 @@ (declare-function org-inlinetask-get-task-level "org-inlinetask" ()) (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) (declare-function org-list-item-body-column "org-list" (item)) +(defvar org-inlinetask-show-first-star) (defgroup org-indent nil "Options concerning dynamic virtual outline indentation." @@ -159,72 +160,75 @@ properties, after each buffer modification, on the modified zone. The process is synchronous. Though, initial indentation of buffer, which can take a few seconds on large buffers, is done during idle time." nil " Ind" nil - (cond - ((org-bound-and-true-p org-inhibit-startup) - (setq org-indent-mode nil)) - ((and org-indent-mode (featurep 'xemacs)) - (message "org-indent-mode does not work in XEmacs - refusing to turn it on") - (setq org-indent-mode nil)) - ((and org-indent-mode - (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) - (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!") - (ding) - (sit-for 1) - (setq org-indent-mode nil)) - (org-indent-mode - ;; mode was turned on. - (org-set-local 'indent-tabs-mode nil) - (or org-indent-strings (org-indent-initialize)) - (org-set-local 'org-indent-initial-marker (copy-marker 1)) - (when org-indent-mode-turns-off-org-adapt-indentation - (org-set-local 'org-adapt-indentation nil)) - (when org-indent-mode-turns-on-hiding-stars - (org-set-local 'org-hide-leading-stars-before-indent-mode - org-hide-leading-stars) - (org-set-local 'org-hide-leading-stars t)) - (make-local-variable 'buffer-substring-filters) - (add-to-list 'buffer-substring-filters - 'org-indent-remove-properties-from-string) - (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) - (org-add-hook 'before-change-functions - 'org-indent-notify-modified-headline nil 'local) - (and font-lock-mode (org-restart-font-lock)) - (org-indent-remove-properties (point-min) (point-max)) - ;; Submit current buffer to initialize agent. If it's the first - ;; buffer submitted, also start the agent. Current buffer is - ;; pushed in both cases to avoid a race condition. - (if org-indent-agentized-buffers - (push (current-buffer) org-indent-agentized-buffers) +(cond + ((org-bound-and-true-p org-inhibit-startup) + (setq org-indent-mode nil)) + ((and org-indent-mode (featurep 'xemacs)) + (message "org-indent-mode does not work in XEmacs - refusing to turn it on") + (setq org-indent-mode nil)) + ((and org-indent-mode + (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) + (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!") + (ding) + (sit-for 1) + (setq org-indent-mode nil)) + (org-indent-mode + ;; mode was turned on. + (org-set-local 'indent-tabs-mode nil) + (or org-indent-strings (org-indent-initialize)) + (org-set-local 'org-indent-initial-marker (copy-marker 1)) + (when org-indent-mode-turns-off-org-adapt-indentation + (org-set-local 'org-adapt-indentation nil)) + (when org-indent-mode-turns-on-hiding-stars + (org-set-local 'org-hide-leading-stars-before-indent-mode + org-hide-leading-stars) + (org-set-local 'org-hide-leading-stars t)) + (make-local-variable 'filter-buffer-substring-functions) + (add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete)))) + (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) + (org-add-hook 'before-change-functions + 'org-indent-notify-modified-headline nil 'local) + (and font-lock-mode (org-restart-font-lock)) + (org-indent-remove-properties (point-min) (point-max)) + ;; Submit current buffer to initialize agent. If it's the first + ;; buffer submitted, also start the agent. Current buffer is + ;; pushed in both cases to avoid a race condition. + (if org-indent-agentized-buffers (push (current-buffer) org-indent-agentized-buffers) - (setq org-indent-agent-timer - (run-with-idle-timer 0.2 t #'org-indent-initialize-agent)))) - (t - ;; mode was turned off (or we refused to turn it on) - (kill-local-variable 'org-adapt-indentation) - (setq org-indent-agentized-buffers - (delq (current-buffer) org-indent-agentized-buffers)) - (when (markerp org-indent-initial-marker) - (set-marker org-indent-initial-marker nil)) - (when (boundp 'org-hide-leading-stars-before-indent-mode) - (org-set-local 'org-hide-leading-stars - org-hide-leading-stars-before-indent-mode)) - (setq buffer-substring-filters - (delq 'org-indent-remove-properties-from-string - buffer-substring-filters)) - (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local) - (remove-hook 'before-change-functions - 'org-indent-notify-modified-headline 'local) - (org-with-wide-buffer - (org-indent-remove-properties (point-min) (point-max))) - (and font-lock-mode (org-restart-font-lock)) - (redraw-display)))) + (push (current-buffer) org-indent-agentized-buffers) + (setq org-indent-agent-timer + (run-with-idle-timer 0.2 t #'org-indent-initialize-agent)))) + (t + ;; mode was turned off (or we refused to turn it on) + (kill-local-variable 'org-adapt-indentation) + (setq org-indent-agentized-buffers + (delq (current-buffer) org-indent-agentized-buffers)) + (when (markerp org-indent-initial-marker) + (set-marker org-indent-initial-marker nil)) + (when (boundp 'org-hide-leading-stars-before-indent-mode) + (org-set-local 'org-hide-leading-stars + org-hide-leading-stars-before-indent-mode)) + (remove-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete)))) + (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local) + (remove-hook 'before-change-functions + 'org-indent-notify-modified-headline 'local) + (org-with-wide-buffer + (org-indent-remove-properties (point-min) (point-max))) + (and font-lock-mode (org-restart-font-lock)) + (redraw-display)))) (defun org-indent-indent-buffer () "Add indentation properties to the accessible part of the buffer." (interactive) - (if (not (eq major-mode 'org-mode)) + (if (not (derived-mode-p 'org-mode)) (error "Not in Org mode") - (message "Setting buffer indentation. It may take a few seconds...") + (message "Setting buffer indentation. It may take a few seconds...") (org-indent-remove-properties (point-min) (point-max)) (org-indent-add-properties (point-min) (point-max)) (message "Indentation of buffer set."))) @@ -293,8 +297,10 @@ Assume point is at beginning of line." (let ((stars (aref org-indent-stars (min l org-indent-max-levels)))) (and stars - (concat org-indent-inlinetask-first-star - (substring stars 1))))) + (if (org-bound-and-true-p org-inlinetask-show-first-star) + (concat org-indent-inlinetask-first-star + (substring stars 1)) + stars)))) (h (aref org-indent-stars (min l org-indent-max-levels))) (t (aref org-indent-strings @@ -414,12 +420,12 @@ This function is meant to be called by `after-change-functions'." (goto-char beg) (beginning-of-line) (re-search-forward org-outline-regexp-bol end t))) - (let ((end (save-excursion - (goto-char end) - (org-with-limited-levels (outline-next-heading)) - (point)))) - (setq org-indent-modified-headline-flag nil) - (org-indent-add-properties beg end)) + (let ((end (save-excursion + (goto-char end) + (org-with-limited-levels (outline-next-heading)) + (point)))) + (setq org-indent-modified-headline-flag nil) + (org-indent-add-properties beg end)) ;; Otherwise, only set properties on modified area. (org-indent-add-properties beg end))))) diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index b4e5c2244d..31981ae1b2 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -48,9 +48,9 @@ "Store a link to an Info file and node." (when (eq major-mode 'Info-mode) (let (link desc) - (setq link (org-make-link "info:" - (file-name-nondirectory Info-current-file) - "#" Info-current-node)) + (setq link (concat "info:" + (file-name-nondirectory Info-current-file) + "#" Info-current-node)) (setq desc (concat (file-name-nondirectory Info-current-file) "#" Info-current-node)) (org-store-link-props :type "info" :file Info-current-file diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 5cd190050b..01f861e611 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -90,6 +90,9 @@ (defcustom org-inlinetask-min-level 15 "Minimum level a headline must have before it is treated as an inline task. +Don't set it to something higher than `29' or clocking will break since this +is the hardcoded maximum number of stars `org-clock-sum' will work with. + It is strongly recommended that you set `org-cycle-max-level' not at all, or to a number smaller than this one. In fact, when `org-cycle-max-level' is not set, it will be assumed to be one less than the value of smaller than @@ -99,6 +102,12 @@ the value of this variable." (const :tag "Off" nil) (integer))) +(defcustom org-inlinetask-show-first-star nil + "Non-nil means display the first star of an inline task as additional marker. +When nil, the first star is not shown." + :tag "Org Inline Tasks" + :group 'org-structure) + (defcustom org-inlinetask-export t "Non-nil means export inline tasks. When nil, they will not be exported." @@ -329,75 +338,75 @@ Either remove headline and meta data, or do special formatting." (end (copy-marker (save-excursion (org-inlinetask-goto-end) (point)))) content) - ;; Delete SCHEDULED, DEADLINE... - (while (re-search-forward keywords-re end t) - (delete-region (point-at-bol) (1+ (point-at-eol)))) - (goto-char beg) - ;; Delete drawers - (while (re-search-forward org-drawer-regexp end t) - (when (save-excursion (re-search-forward org-property-end-re nil t)) - (delete-region beg (1+ (match-end 0))))) - ;; Get CONTENT, if any. - (goto-char beg) - (forward-line 1) - (unless (= (point) end) - (setq content (buffer-substring (point) - (save-excursion (goto-char end) - (forward-line -1) - (point))))) - ;; Remove the task. - (goto-char beg) - (delete-region beg end) - (when (and org-inlinetask-export - (assq org-export-current-backend - org-inlinetask-export-templates)) - ;; Format CONTENT, if appropriate. - (setq content - (if (not (and content (string-match "\\S-" content))) - "" - ;; Ensure CONTENT has minimal indentation, a single - ;; newline character at its boundaries, and isn't - ;; protected. - (when (string-match "\\`\\([ \t]*\n\\)+" content) - (setq content (substring content (match-end 0)))) - (when (string-match "[ \t\n]+\\'" content) - (setq content (substring content 0 (match-beginning 0)))) - (org-add-props - (concat "\n\n" (org-remove-indentation content) "\n\n") - '(org-protected nil org-native-text nil)))) - - (when (string-match org-complex-heading-regexp headline) - (let* ((nil-to-str - (function - ;; Change nil arguments into empty strings. - (lambda (el) (or (eval el) "")))) - ;; Set up keywords provided to templates. - (todo (or (match-string 2 headline) "")) - (class (or (and (eq "" todo) "") - (if (member todo org-done-keywords) "done" "todo"))) - (priority (or (match-string 3 headline) "")) - (heading (or (match-string 4 headline) "")) - (tags (or (match-string 5 headline) "")) - ;; Read `org-inlinetask-export-templates'. - (backend-spec (assq org-export-current-backend - org-inlinetask-export-templates)) - (format-str (org-add-props (nth 1 backend-spec) - '(org-protected t org-native-text t))) - (tokens (cadr (nth 2 backend-spec))) - ;; Build export string. Ensure it won't break - ;; surrounding lists by giving it arbitrary high - ;; indentation. - (export-str (org-add-props - (eval (append '(format format-str) - (mapcar nil-to-str tokens))) - '(original-indentation 1000)))) - ;; Ensure task starts a new paragraph. - (unless (or (bobp) - (save-excursion (forward-line -1) - (looking-at "[ \t]*$"))) - (insert "\n")) - (insert export-str) - (unless (bolp) (insert "\n"))))))))) + ;; Delete SCHEDULED, DEADLINE... + (while (re-search-forward keywords-re end t) + (delete-region (point-at-bol) (1+ (point-at-eol)))) + (goto-char beg) + ;; Delete drawers + (while (re-search-forward org-drawer-regexp end t) + (when (save-excursion (re-search-forward org-property-end-re nil t)) + (delete-region beg (1+ (match-end 0))))) + ;; Get CONTENT, if any. + (goto-char beg) + (forward-line 1) + (unless (= (point) end) + (setq content (buffer-substring (point) + (save-excursion (goto-char end) + (forward-line -1) + (point))))) + ;; Remove the task. + (goto-char beg) + (delete-region beg end) + (when (and org-inlinetask-export + (assq org-export-current-backend + org-inlinetask-export-templates)) + ;; Format CONTENT, if appropriate. + (setq content + (if (not (and content (string-match "\\S-" content))) + "" + ;; Ensure CONTENT has minimal indentation, a single + ;; newline character at its boundaries, and isn't + ;; protected. + (when (string-match "\\`\\([ \t]*\n\\)+" content) + (setq content (substring content (match-end 0)))) + (when (string-match "[ \t\n]+\\'" content) + (setq content (substring content 0 (match-beginning 0)))) + (org-add-props + (concat "\n\n" (org-remove-indentation content) "\n\n") + '(org-protected nil org-native-text nil)))) + + (when (string-match org-complex-heading-regexp headline) + (let* ((nil-to-str + (function + ;; Change nil arguments into empty strings. + (lambda (el) (or (eval el) "")))) + ;; Set up keywords provided to templates. + (todo (or (match-string 2 headline) "")) + (class (or (and (eq "" todo) "") + (if (member todo org-done-keywords) "done" "todo"))) + (priority (or (match-string 3 headline) "")) + (heading (or (match-string 4 headline) "")) + (tags (or (match-string 5 headline) "")) + ;; Read `org-inlinetask-export-templates'. + (backend-spec (assq org-export-current-backend + org-inlinetask-export-templates)) + (format-str (org-add-props (nth 1 backend-spec) + '(org-protected t org-native-text t))) + (tokens (cadr (nth 2 backend-spec))) + ;; Build export string. Ensure it won't break + ;; surrounding lists by giving it arbitrary high + ;; indentation. + (export-str (org-add-props + (eval (append '(format format-str) + (mapcar nil-to-str tokens))) + '(original-indentation 1000)))) + ;; Ensure task starts a new paragraph. + (unless (or (bobp) + (save-excursion (forward-line -1) + (looking-at "[ \t]*$"))) + (insert "\n")) + (insert export-str) + (unless (bolp) (insert "\n"))))))))) (defun org-inlinetask-get-current-indentation () "Get the indentation of the last non-while line above this one." @@ -423,18 +432,21 @@ Either remove headline and meta data, or do special formatting." (1- (* 2 (or org-inlinetask-min-level 200))) (or org-inlinetask-min-level 200))) (re (concat "^\\(\\*\\)\\(\\*\\{" - (format "%d" (- nstars 3)) - ",\\}\\)\\(\\*\\* .*\\)")) + (format "%d" (- nstars 3)) + ",\\}\\)\\(\\*\\* .*\\)")) ;; Virtual indentation will add the warning face on the first - ;; star. Thus, in that case, only hide it. + ;; star. Thus, in that case, only hide it. (start-face (if (and (org-bound-and-true-p org-indent-mode) (> org-indent-indentation-per-level 1)) 'org-hide 'org-warning))) (while (re-search-forward re limit t) - (add-text-properties (match-beginning 1) (match-end 1) - `(face ,start-face font-lock-fontified t)) - (add-text-properties (match-beginning 2) (match-end 2) + (if org-inlinetask-show-first-star + (add-text-properties (match-beginning 1) (match-end 1) + `(face ,start-face font-lock-fontified t))) + (add-text-properties (match-beginning + (if org-inlinetask-show-first-star 2 1)) + (match-end 2) '(face org-hide font-lock-fontified t)) (add-text-properties (match-beginning 3) (match-end 3) '(face org-inlinetask font-lock-fontified t))))) @@ -452,7 +464,7 @@ Either remove headline and meta data, or do special formatting." ((= end start)) ;; Inlinetask was folded: expand it. ((get-char-property (1+ start) 'invisible) - (outline-flag-region start end nil)) + (org-show-entry)) (t (outline-flag-region start end t))))) (defun org-inlinetask-remove-END-maybe () diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 107428366d..787eed7950 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -81,10 +81,10 @@ "Parse LINK and dispatch to the correct function based on the client found." (let ((link (org-irc-parse-link link))) (cond - ((eq org-irc-client 'erc) - (org-irc-visit-erc link)) - (t - (error "erc only known client"))))) + ((eq org-irc-client 'erc) + (org-irc-visit-erc link)) + (t + (error "ERC only known client"))))) (defun org-irc-parse-link (link) "Parse an IRC LINK and return the attributes found. @@ -102,8 +102,8 @@ attributes that are found." (defun org-irc-store-link () "Dispatch to the appropriate function to store a link to an IRC session." (cond - ((eq major-mode 'erc-mode) - (org-irc-erc-store-link)))) + ((eq major-mode 'erc-mode) + (org-irc-erc-store-link)))) (defun org-irc-elipsify-description (string &optional after) "Remove unnecessary white space from STRING and add ellipses if necessary. @@ -140,9 +140,9 @@ result is a cons of the filename and search string." (when (search-backward-regexp "^[^ ]" nil t) (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) - (when (search-backward erc-line nil t) - (buffer-substring-no-properties (point-at-bol) - (point-at-eol))))))) + (when (search-backward erc-line nil t) + (buffer-substring-no-properties (point-at-bol) + (point-at-eol))))))) (defun org-irc-erc-store-link () "Store a link to the IRC log file or the session itself. @@ -164,27 +164,27 @@ the session itself." :link (concat "file:" (car parsed-line) "::" (cadr parsed-line))) t) - (error "This ERC session is not being logged"))) - (let* ((link-text (org-irc-get-erc-link)) - (link (org-irc-parse-link link-text))) - (if link-text - (progn - (org-store-link-props - :type "irc" - :link (org-make-link "irc:/" link-text) - :description (concat "irc session '" link-text "'") - :server (car (car link)) - :port (or (string-to-number (cadr (pop link))) erc-default-port) - :nick (pop link)) - t) - (error "Failed to create ('irc:/' style) ERC link"))))) + (error "This ERC session is not being logged"))) + (let* ((link-text (org-irc-get-erc-link)) + (link (org-irc-parse-link link-text))) + (if link-text + (progn + (org-store-link-props + :type "irc" + :link (concat "irc:/" link-text) + :description (concat "irc session '" link-text "'") + :server (car (car link)) + :port (or (string-to-number (cadr (pop link))) erc-default-port) + :nick (pop link)) + t) + (error "Failed to create ('irc:/' style) ERC link"))))) (defun org-irc-get-erc-link () "Return an org compatible irc:/ link from an ERC buffer." (let* ((session-port (if (numberp erc-session-port) (number-to-string erc-session-port) - erc-session-port)) - (link (concat erc-session-server ":" session-port))) + erc-session-port)) + (link (concat erc-session-server ":" session-port))) (concat link "/" (if (and (erc-default-target) (erc-channel-p (erc-default-target)) @@ -192,19 +192,19 @@ the session itself." ;; we can get a nick (let ((nick (car (get-text-property (point) 'erc-data)))) (concat (erc-default-target) "/" nick)) - (erc-default-target))))) + (erc-default-target))))) (defun org-irc-get-current-erc-port () "Return the current port as a number. Return the current port number or, if none is set, return the ERC default." (cond - ((stringp erc-session-port) - (string-to-number erc-session-port)) - ((numberp erc-session-port) - erc-session-port) - (t - erc-default-port))) + ((stringp erc-session-port) + (string-to-number erc-session-port)) + ((numberp erc-session-port) + erc-session-port) + (t + erc-default-port))) (defun org-irc-visit-erc (link) "Visit an ERC buffer based on criteria found in LINK." @@ -242,13 +242,13 @@ default." (progn (goto-char (point-max)) (insert (concat nick ": "))) - (error "%s not found in %s" nick chan-name))))) - (progn - (org-pop-to-buffer-same-window server-buffer) - (erc-cmd-JOIN chan-name)))) - (org-pop-to-buffer-same-window server-buffer))) - ;; no server match, make new connection - (erc-select :server server :port port)))) + (error "%s not found in %s" nick chan-name))))) + (progn + (org-pop-to-buffer-same-window server-buffer) + (erc-cmd-JOIN chan-name)))) + (org-pop-to-buffer-same-window server-buffer))) + ;; no server match, make new connection + (erc-select :server server :port port)))) (provide 'org-irc) diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el index f4075d0298..35d43dec8d 100644 --- a/lisp/org/org-jsinfo.el +++ b/lisp/org/org-jsinfo.el @@ -99,13 +99,69 @@ means to use the maximum value consistent with other options." (lambda (x) (list 'cons (list 'const (car x)) '(choice - (symbol :tag "Publishing/Export property") - (string :tag "Value")))) + (symbol :tag "Publishing/Export property") + (string :tag "Value")))) org-infojs-opts-table))) (defcustom org-infojs-template - "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\"></script> -<script type=\"text/javascript\" > + "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\"> +/** + * + * @source: %SCRIPT_PATH + * + * @licstart The following is the entire license notice for the + * JavaScript code in %SCRIPT_PATH. + * + * Copyright (C) 2012 Sebastian Rose + * + * + * The JavaScript code in this tag is free software: you can + * redistribute it and/or modify it under the terms of the GNU + * General Public License (GNU GPL) as published by the Free Software + * Foundation, either version 3 of the License, or (at your option) + * any later version. The code is distributed WITHOUT ANY WARRANTY; + * without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + * + * As additional permission under GNU GPL version 3 section 7, you + * may distribute non-source (e.g., minimized or compacted) forms of + * that code without the copy of the GNU GPL normally required by + * section 4, provided you include this license notice and a URL + * through which recipients can access the Corresponding Source. + * + * @licend The above is the entire license notice + * for the JavaScript code in %SCRIPT_PATH. + * + */ +</script> + +<script type=\"text/javascript\"> + +/* +@licstart The following is the entire license notice for the +JavaScript code in this tag. + +Copyright (C) 2012 Free Software Foundation, Inc. + +The JavaScript code in this tag is free software: you can +redistribute it and/or modify it under the terms of the GNU +General Public License (GNU GPL) as published by the Free Software +Foundation, either version 3 of the License, or (at your option) +any later version. The code is distributed WITHOUT ANY WARRANTY; +without even the implied warranty of MERCHANTABILITY or FITNESS +FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + +As additional permission under GNU GPL version 3 section 7, you +may distribute non-source (e.g., minimized or compacted) forms of +that code without the copy of the GNU GPL normally required by +section 4, provided you include this license notice and a URL +through which recipients can access the Corresponding Source. + + +@licend The above is the entire license notice +for the JavaScript code in this tag. +*/ + <!--/*--><![CDATA[/*><!--*/ %MANAGER_OPTIONS org_html_manager.setup(); // activate after the parameters are set @@ -127,67 +183,67 @@ Option settings will replace the %MANAGER-OPTIONS cookie." exp-plist ;; We do want to use the script, set it up (let ((template org-infojs-template) - (ptoc (plist-get exp-plist :table-of-contents)) - (hlevels (plist-get exp-plist :headline-levels)) - tdepth sdepth s v e opt var val table default) - (setq sdepth hlevels - tdepth hlevels) - (if (integerp ptoc) (setq tdepth (min ptoc tdepth))) - (setq v (plist-get exp-plist :infojs-opt) - table org-infojs-opts-table) - (while (setq e (pop table)) - (setq opt (car e) var (nth 1 e) - default (cdr (assoc opt org-infojs-options))) - (and (symbolp default) (not (memq default '(t nil))) - (setq default (plist-get exp-plist default))) - (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v)) - (setq val (match-string 1 v)) - (setq val default)) - (cond - ((eq opt 'path) - (and (string-match "%SCRIPT_PATH" template) - (setq template (replace-match val t t template)))) - ((eq opt 'sdepth) - (if (integerp (read val)) - (setq sdepth (min (read val) hlevels)))) - ((eq opt 'tdepth) - (if (integerp (read val)) - (setq tdepth (min (read val) hlevels)))) - (t - (setq val - (cond - ((or (eq val t) (equal val "t")) "1") - ((or (eq val nil) (equal val "nil")) "0") - ((stringp val) val) - (t (format "%s" val)))) - (push (cons var val) s)))) - - ;; Now we set the depth of the *generated* TOC to SDEPTH, because the - ;; toc will actually determine the splitting. How much of the toc will - ;; actually be displayed is governed by the TDEPTH option. - (setq exp-plist (plist-put exp-plist :table-of-contents sdepth)) - - ;; The table of contents should not show more sections then we generate - (setq tdepth (min tdepth sdepth)) - (push (cons "TOC_DEPTH" tdepth) s) - - (setq s (mapconcat - (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" - (car x) (cdr x))) - s "\n")) - (when (and s (> (length s) 0)) - (and (string-match "%MANAGER_OPTIONS" template) - (setq s (replace-match s t t template)) - (setq exp-plist - (plist-put - exp-plist :style-extra - (concat (or (plist-get exp-plist :style-extra) "") "\n" s))))) - ;; This script absolutely needs the table of contents, to we change that - ;; setting - (if (not (plist-get exp-plist :table-of-contents)) - (setq exp-plist (plist-put exp-plist :table-of-contents t))) - ;; Return the modified property list - exp-plist))) + (ptoc (plist-get exp-plist :table-of-contents)) + (hlevels (plist-get exp-plist :headline-levels)) + tdepth sdepth s v e opt var val table default) + (setq sdepth hlevels + tdepth hlevels) + (if (integerp ptoc) (setq tdepth (min ptoc tdepth))) + (setq v (plist-get exp-plist :infojs-opt) + table org-infojs-opts-table) + (while (setq e (pop table)) + (setq opt (car e) var (nth 1 e) + default (cdr (assoc opt org-infojs-options))) + (and (symbolp default) (not (memq default '(t nil))) + (setq default (plist-get exp-plist default))) + (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v)) + (setq val (match-string 1 v)) + (setq val default)) + (cond + ((eq opt 'path) + (setq template + (replace-regexp-in-string "%SCRIPT_PATH" val template t t))) + ((eq opt 'sdepth) + (if (integerp (read val)) + (setq sdepth (min (read val) hlevels)))) + ((eq opt 'tdepth) + (if (integerp (read val)) + (setq tdepth (min (read val) hlevels)))) + (t + (setq val + (cond + ((or (eq val t) (equal val "t")) "1") + ((or (eq val nil) (equal val "nil")) "0") + ((stringp val) val) + (t (format "%s" val)))) + (push (cons var val) s)))) + + ;; Now we set the depth of the *generated* TOC to SDEPTH, because the + ;; toc will actually determine the splitting. How much of the toc will + ;; actually be displayed is governed by the TDEPTH option. + (setq exp-plist (plist-put exp-plist :table-of-contents sdepth)) + + ;; The table of contents should not show more sections then we generate + (setq tdepth (min tdepth sdepth)) + (push (cons "TOC_DEPTH" tdepth) s) + + (setq s (mapconcat + (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" + (car x) (cdr x))) + s "\n")) + (when (and s (> (length s) 0)) + (and (string-match "%MANAGER_OPTIONS" template) + (setq s (replace-match s t t template)) + (setq exp-plist + (plist-put + exp-plist :style-extra + (concat (or (plist-get exp-plist :style-extra) "") "\n" s))))) + ;; This script absolutely needs the table of contents, to we change that + ;; setting + (if (not (plist-get exp-plist :table-of-contents)) + (setq exp-plist (plist-put exp-plist :table-of-contents t))) + ;; Return the modified property list + exp-plist))) (defun org-infojs-options-inbuffer-template () (format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s" diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el index 4418dee73e..933fa56b8d 100644 --- a/lisp/org/org-latex.el +++ b/lisp/org/org-latex.el @@ -235,7 +235,7 @@ are written as utf8 files." "Alist of LaTeX expressions to convert emphasis fontifiers. Each element of the list is a list of three elements. The first element is the character used as a marker for fontification. -The second element is a formatting string to wrap fontified text with. +The second element is a format string to wrap fontified text with. If it is \"\\verb\", Org will automatically select a delimiter character that is not in the string. \"\\protectedtexttt\" will use \\texttt to typeset and try to protect special characters. @@ -247,7 +247,7 @@ conversions." (defcustom org-export-latex-title-command "\\maketitle" "The command used to insert the title just after \\begin{document}. If this string contains the formatting specification \"%s\" then -it will be used as a formatting string, passing the title as an +it will be used as a format string, passing the title as an argument." :group 'org-export-latex :type 'string) @@ -321,6 +321,18 @@ will be filled with the link, the second with its description." :version "24.1" :type 'string) +(defcustom org-export-latex-hyperref-options-format + "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={Emacs Org-mode version %s}}\n" + "A format string for hyperref options. +When non-nil, it must contain three %s format specifications +which will respectively be replaced by the document's keywords, +its description and the Org's version number, as a string. Set +this option to the empty string if you don't want to include +hyperref options altogether." + :type 'string + :version "24.3" + :group 'org-export-latex) + (defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\," "Text used to separate footnotes." :group 'org-export-latex @@ -377,6 +389,33 @@ When nil, grouping causes only separation lines between groups." :group 'org-export-latex :type 'boolean) +(defcustom org-export-latex-tables-tstart nil + "LaTeX command for top rule for tables." + :group 'org-export-latex + :version "24.1" + :type '(choice + (const :tag "Nothing" nil) + (string :tag "String") + (const :tag "Booktabs default: \\toprule" "\\toprule"))) + +(defcustom org-export-latex-tables-hline "\\hline" + "LaTeX command to use for a rule somewhere in the middle of a table." + :group 'org-export-latex + :version "24.1" + :type '(choice + (string :tag "String") + (const :tag "Standard: \\hline" "\\hline") + (const :tag "Booktabs default: \\midrule" "\\midrule"))) + +(defcustom org-export-latex-tables-tend nil + "LaTeX command for bottom rule for tables." + :group 'org-export-latex + :version "24.1" + :type '(choice + (const :tag "Nothing" nil) + (string :tag "String") + (const :tag "Booktabs default: \\bottomrule" "\\bottomrule"))) + (defcustom org-export-latex-low-levels 'itemize "How to convert sections below the current level of sectioning. This is specified by the `org-export-headline-levels' option or the @@ -518,9 +557,9 @@ pygmentize -L lexers "Association list of options for the latex listings package. These options are supplied as a comma-separated list to the -\\lstset command. Each element of the association list should be +\\lstset command. Each element of the association list should be a list containing two strings: the name of the option, and the -value. For example, +value. For example, (setq org-export-latex-listings-options '((\"basicstyle\" \"\\small\") @@ -542,9 +581,9 @@ languages." "Association list of options for the latex minted package. These options are supplied within square brackets in -\\begin{minted} environments. Each element of the alist should be +\\begin{minted} environments. Each element of the alist should be a list containing two strings: the name of the option, and the -value. For example, +value. For example, (setq org-export-latex-minted-options '((\"bgcolor\" \"bg\") (\"frame\" \"lines\"))) @@ -553,7 +592,7 @@ will result in src blocks being exported with \\begin{minted}[bgcolor=bg,frame=lines]{<LANG>} -as the start of the minted environment. Note that the same +as the start of the minted environment. Note that the same options will be applied to blocks of all languages." :group 'org-export-latex :version "24.1" @@ -565,7 +604,7 @@ options will be applied to blocks of all languages." (defvar org-export-latex-custom-lang-environments nil "Association list mapping languages to language-specific latex environments used during export of src blocks by the listings - and minted latex packages. For example, + and minted latex packages. For example, (setq org-export-latex-custom-lang-environments '((python \"pythoncode\"))) @@ -607,6 +646,12 @@ and `org-export-with-tags' instead." :version "24.1" :type 'string) +(defcustom org-export-latex-link-with-unknown-path-format "\\texttt{%s}" + "Format string for links with unknown path type." + :group 'org-export-latex + :version "24.3" + :type 'string) + (defcustom org-export-latex-inline-image-extensions '("pdf" "jpeg" "jpg" "png" "ps" "eps") "Extensions of image files that can be inlined into LaTeX. @@ -632,11 +677,24 @@ allowed. The default we use here encompasses both." '("pdflatex -interaction nonstopmode -output-directory %o %f" "pdflatex -interaction nonstopmode -output-directory %o %f" "pdflatex -interaction nonstopmode -output-directory %o %f") - "Commands to process a LaTeX file to a PDF file. -This is a list of strings, each of them will be given to the shell -as a command. %f in the command will be replaced by the full file name, %b -by the file base name (i.e. without extension) and %o by the base directory -of the file. + "Commands to process a LaTeX file to a PDF file and process latex +fragments to pdf files.By default,this is a list of strings,and each of +strings will be given to the shell as a command. %f in the command will +be replaced by the full file name, %b by the file base name (i.e. without +extension) and %o by the base directory of the file. + +If you set `org-create-formula-image-program' +`org-export-with-LaTeX-fragments' to 'imagemagick, you can add a +sublist which contains your own command(s) for LaTeX fragments +previewing, like this: + + '(\"xelatex -interaction nonstopmode -output-directory %o %f\" + \"xelatex -interaction nonstopmode -output-directory %o %f\" + ;; use below command(s) to convert latex fragments + (\"xelatex %f\")) + +With no such sublist, the default command used to convert LaTeX +fragments will be the first string in the list. The reason why this is a list is that it usually takes several runs of `pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever @@ -661,28 +719,28 @@ This function should accept the file name as its single argument." (string :tag "Shell command")) (const :tag "2 runs of pdflatex" ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) + "pdflatex -interaction nonstopmode -output-directory %o %f")) (const :tag "3 runs of pdflatex" ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) (const :tag "pdflatex,bibtex,pdflatex,pdflatex" ("pdflatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) + "bibtex %b" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) (const :tag "2 runs of xelatex" ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) + "xelatex -interaction nonstopmode -output-directory %o %f")) (const :tag "3 runs of xelatex" ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) + "xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) (const :tag "xelatex,bibtex,xelatex,xelatex" ("xelatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) + "bibtex %b" + "xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) (const :tag "texi2dvi" ("texi2dvi -p -b -c -V %f")) (const :tag "rubber" @@ -750,7 +808,7 @@ then use this command to convert it." (interactive "r") (let (reg latex buf) (save-window-excursion - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq latex (org-export-region-as-latex beg end t 'string)) (setq reg (buffer-substring beg end) @@ -985,7 +1043,7 @@ when PUB-DIR is set, use this as the publishing directory." (when (and text (not (eq to-buffer 'string))) (insert (org-export-latex-content text '(lists tables fixed-width keywords)) - "\n\n")) + "\n\n")) ;; insert lines before the first headline (unless (or skip (string-match "^\\*" first-lines)) @@ -1034,6 +1092,11 @@ when PUB-DIR is set, use this as the publishing directory." (if (looking-at "[\n \t]+") (replace-match "\n"))) + ;; Ensure we have a final newline + (goto-char (point-max)) + (or (eq (char-before) ?\n) + (insert ?\n)) + (run-hooks 'org-export-latex-final-hook) (if to-buffer (unless (eq major-mode 'latex-mode) (latex-mode)) @@ -1084,22 +1147,24 @@ when PUB-DIR is set, use this as the publishing directory." (funcall cmds (shell-quote-argument file)) (while cmds (setq cmd (pop cmds)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument base)) - t t cmd))) - (while (string-match "%f" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument file)) - t t cmd))) - (while (string-match "%o" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument output-dir)) - t t cmd))) - (shell-command cmd outbuf))))) + (cond + ((not (listp cmd)) + (while (string-match "%b" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument base)) + t t cmd))) + (while (string-match "%f" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument file)) + t t cmd))) + (while (string-match "%o" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument output-dir)) + t t cmd))) + (shell-command cmd outbuf))))))) (message (concat "Processing LaTeX file " file "...done")) (setq errors (org-export-latex-get-error outbuf)) (if (not (file-exists-p pdffile)) @@ -1471,11 +1536,10 @@ OPT-PLIST is the options plist for current buffer." (or (plist-get opt-plist :date) org-export-latex-date-format))) ;; add some hyperref options - ;; FIXME: let's have a defcustom for this? - (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" - (org-export-latex-fontify-headline keywords) - (org-export-latex-fontify-headline description) - (concat "Emacs Org-mode version " org-version)) + (format org-export-latex-hyperref-options-format + (org-export-latex-fontify-headline keywords) + (org-export-latex-fontify-headline description) + (org-version)) ;; beginning of the document "\n\\begin{document}\n\n" ;; insert the title command @@ -1569,7 +1633,7 @@ links, keywords, lists, tables, fixed-width" (unless (memq 'fixed-width exclude-list) (org-export-latex-fixed-width (plist-get org-export-latex-options-plist :fixed-width))) - ;; return string + ;; return string (buffer-substring (point-min) (point-max)))) (defun org-export-latex-protect-string (s) @@ -1691,13 +1755,13 @@ links, keywords, lists, tables, fixed-width" (let ((org-display-custom-times org-export-latex-display-custom-times)) (while (re-search-forward org-ts-regexp-both nil t) (org-if-unprotected-at (1- (point)) - (replace-match - (org-export-latex-protect-string - (format (if (string= "<" (substring (match-string 0) 0 1)) - org-export-latex-timestamp-markup - org-export-latex-timestamp-inactive-markup) - (substring (org-translate-time (match-string 0)) 1 -1))) - t t))))) + (replace-match + (org-export-latex-protect-string + (format (if (string= "<" (substring (match-string 0) 0 1)) + org-export-latex-timestamp-markup + org-export-latex-timestamp-inactive-markup) + (substring (org-translate-time (match-string 0)) 1 -1))) + t t))))) (defun org-export-latex-quotation-marks () "Export quotation marks depending on language conventions." @@ -1723,8 +1787,7 @@ See the `org-export-latex.el' code for a complete conversion table." (goto-char (point-min)) (while (re-search-forward c nil t) ;; Put the point where to check for org-protected - (unless (or (get-text-property (match-beginning 2) 'org-protected) - (save-match-data (org-at-table.el-p))) + (unless (get-text-property (match-beginning 2) 'org-protected) (cond ((member (match-string 2) '("\\$" "$")) (if (equal (match-string 2) "\\$") nil @@ -1752,7 +1815,7 @@ See the `org-export-latex.el' code for a complete conversion table." (replace-match (match-string 2) t t) (replace-match (concat (match-string 1) "\\" (match-string 2)) t t))))) - (unless (save-match-data (org-inside-latex-math-p)) + (unless (save-match-data (or (org-inside-latex-math-p) (org-at-table-p))) (cond ((equal (match-string 2) "\\") (replace-match (or (save-match-data (org-export-latex-treat-backslash-char @@ -1877,19 +1940,19 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (goto-char (point-min)) (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t) (unless (get-text-property (point) 'org-example) - (if opt - (progn (goto-char (match-beginning 0)) - (insert "\\begin{verbatim}\n") - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat (match-string 1) - (match-string 2)) t t) - (forward-line)) - (insert "\\end{verbatim}\n")) - (progn (goto-char (match-beginning 0)) - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat "%" (match-string 1) - (match-string 2)) t t) - (forward-line))))))) + (if opt + (progn (goto-char (match-beginning 0)) + (insert "\\begin{verbatim}\n") + (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") + (replace-match (concat (match-string 1) + (match-string 2)) t t) + (forward-line)) + (insert "\\end{verbatim}\n")) + (progn (goto-char (match-beginning 0)) + (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") + (replace-match (concat "%" (match-string 1) + (match-string 2)) t t) + (forward-line))))))) (defvar org-table-last-alignment) ; defined in org-table.el (defvar org-table-last-column-widths) ; defined in org-table.el @@ -1915,7 +1978,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (org-table-last-column-widths (copy-sequence org-table-last-column-widths)) fnum fields line lines olines gr colgropen line-fmt align - caption width shortn label attr floatp placement + caption width shortn label attr hfmt floatp placement longtblp tblenv tabular-env) (if org-export-latex-tables-verbatim (let* ((tbl (concat "\\begin{verbatim}\n" raw-table @@ -1952,6 +2015,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." align (and attr (stringp attr) (string-match "\\<align=\\([^ \t\n\r]+\\)" attr) (match-string 1 attr)) + hfmt (and attr (stringp attr) + (string-match "\\<hfmt=\\(\\S-+\\)" attr) + (match-string 1 attr)) floatp (or caption label (string= "table*" tblenv)) placement (if (and attr (stringp attr) @@ -1967,7 +2033,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (when org-table-clean-did-remove-column (pop org-table-last-alignment) (pop org-table-last-column-widths)) - ;; make a formatting string to reflect alignment + ;; make a format string to reflect alignment (setq olines lines) (while (and (not line-fmt) (setq line (pop olines))) (unless (string-match "^[ \t]*|-" line) @@ -2034,14 +2100,21 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." align)) (orgtbl-to-latex lines - `(:tstart nil :tend nil + `(:tstart ,org-export-latex-tables-tstart + :tend ,org-export-latex-tables-tend + :hline ,org-export-latex-tables-hline + :skipheadrule ,longtblp + :hfmt ,hfmt :hlend ,(if longtblp (format "\\\\ -\\hline +%s \\endhead -\\hline\\multicolumn{%d}{r}{Continued on next page}\\ +%s\\multicolumn{%d}{r}{Continued on next page}\\ \\endfoot -\\endlastfoot" (length org-table-last-alignment)) +\\endlastfoot" + org-export-latex-tables-hline + org-export-latex-tables-hline + (length org-table-last-alignment)) nil))) (if (not longtblp) (format "\n\\end{%s}" tabular-env)) (if longtblp "\n" (if org-export-latex-tables-centered @@ -2272,8 +2345,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (insert (save-match-data (funcall fnc (org-link-unescape raw-path) desc 'latex)))) - - (t (insert "\\texttt{" desc "}"))))))) + ;; Unrecognized path type + (t (insert (format org-export-latex-link-with-unknown-path-format desc)))))))) (defun org-export-latex-format-image (path caption label attr &optional shortn) @@ -2382,7 +2455,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ;; Compute string to insert (FNOTE), and protect the outside ;; macro from further transformation. When footnote at ;; point is referring to a previously defined footnote, use - ;; \footnotemark. Otherwise, use \footnote. + ;; \footnotemark. Otherwise, use \footnote. (let ((fnote (if (member lbl org-export-latex-footmark-seen) (org-export-latex-protect-string (format "\\footnotemark[%s]" lbl)) @@ -2607,7 +2680,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defun org-export-latex-lists () "Convert plain text lists in current buffer into LaTeX lists." ;; `org-list-end-re' output has changed since preprocess from - ;; org-exp.el. Make sure it is taken into account. + ;; org-exp.el. Make sure it is taken into account. (let ((org-list-end-re "^ORG-LIST-END-MARKER\n")) (mapc (lambda (e) @@ -2638,181 +2711,181 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (append org-list-export-context '(nil))))) (defconst org-latex-entities - '("\\!" - "\\'" - "\\+" - "\\," - "\\-" - "\\:" - "\\;" - "\\<" - "\\=" - "\\>" - "\\Huge" - "\\LARGE" - "\\Large" - "\\Styles" - "\\\\" - "\\`" - "\\\"" - "\\addcontentsline" - "\\address" - "\\addtocontents" - "\\addtocounter" - "\\addtolength" - "\\addvspace" - "\\alph" - "\\appendix" - "\\arabic" - "\\author" - "\\begin{array}" - "\\begin{center}" - "\\begin{description}" - "\\begin{enumerate}" - "\\begin{eqnarray}" - "\\begin{equation}" - "\\begin{figure}" - "\\begin{flushleft}" - "\\begin{flushright}" - "\\begin{itemize}" - "\\begin{list}" - "\\begin{minipage}" - "\\begin{picture}" - "\\begin{quotation}" - "\\begin{quote}" - "\\begin{tabbing}" - "\\begin{table}" - "\\begin{tabular}" - "\\begin{thebibliography}" - "\\begin{theorem}" - "\\begin{titlepage}" - "\\begin{verbatim}" - "\\begin{verse}" - "\\bf" - "\\bf" - "\\bibitem" - "\\bigskip" - "\\cdots" - "\\centering" - "\\circle" - "\\cite" - "\\cleardoublepage" - "\\clearpage" - "\\cline" - "\\closing" - "\\dashbox" - "\\date" - "\\ddots" - "\\dotfill" - "\\em" - "\\fbox" - "\\flushbottom" - "\\fnsymbol" - "\\footnote" - "\\footnotemark" - "\\footnotesize" - "\\footnotetext" - "\\frac" - "\\frame" - "\\framebox" - "\\hfill" - "\\hline" - "\\hrulespace" - "\\hspace" - "\\huge" - "\\hyphenation" - "\\include" - "\\includeonly" - "\\indent" - "\\input" - "\\it" - "\\kill" - "\\label" - "\\large" - "\\ldots" - "\\line" - "\\linebreak" - "\\linethickness" - "\\listoffigures" - "\\listoftables" - "\\location" - "\\makebox" - "\\maketitle" - "\\mark" - "\\mbox" - "\\medskip" - "\\multicolumn" - "\\multiput" - "\\newcommand" - "\\newcounter" - "\\newenvironment" - "\\newfont" - "\\newlength" - "\\newline" - "\\newpage" - "\\newsavebox" - "\\newtheorem" - "\\nocite" - "\\nofiles" - "\\noindent" - "\\nolinebreak" - "\\nopagebreak" - "\\normalsize" - "\\onecolumn" - "\\opening" - "\\oval" - "\\overbrace" - "\\overline" - "\\pagebreak" - "\\pagenumbering" - "\\pageref" - "\\pagestyle" - "\\par" - "\\parbox" - "\\put" - "\\raggedbottom" - "\\raggedleft" - "\\raggedright" - "\\raisebox" - "\\ref" - "\\rm" - "\\roman" - "\\rule" - "\\savebox" - "\\sc" - "\\scriptsize" - "\\setcounter" - "\\setlength" - "\\settowidth" - "\\sf" - "\\shortstack" - "\\signature" - "\\sl" - "\\small" - "\\smallskip" - "\\sqrt" - "\\tableofcontents" - "\\telephone" - "\\thanks" - "\\thispagestyle" - "\\tiny" - "\\title" - "\\tt" - "\\twocolumn" - "\\typein" - "\\typeout" - "\\underbrace" - "\\underline" - "\\usebox" - "\\usecounter" - "\\value" - "\\vdots" - "\\vector" - "\\verb" - "\\vfill" - "\\vline" - "\\vspace") - "A list of LaTeX commands to be protected when performing conversion.") + '("\\!" + "\\'" + "\\+" + "\\," + "\\-" + "\\:" + "\\;" + "\\<" + "\\=" + "\\>" + "\\Huge" + "\\LARGE" + "\\Large" + "\\Styles" + "\\\\" + "\\`" + "\\\"" + "\\addcontentsline" + "\\address" + "\\addtocontents" + "\\addtocounter" + "\\addtolength" + "\\addvspace" + "\\alph" + "\\appendix" + "\\arabic" + "\\author" + "\\begin{array}" + "\\begin{center}" + "\\begin{description}" + "\\begin{enumerate}" + "\\begin{eqnarray}" + "\\begin{equation}" + "\\begin{figure}" + "\\begin{flushleft}" + "\\begin{flushright}" + "\\begin{itemize}" + "\\begin{list}" + "\\begin{minipage}" + "\\begin{picture}" + "\\begin{quotation}" + "\\begin{quote}" + "\\begin{tabbing}" + "\\begin{table}" + "\\begin{tabular}" + "\\begin{thebibliography}" + "\\begin{theorem}" + "\\begin{titlepage}" + "\\begin{verbatim}" + "\\begin{verse}" + "\\bf" + "\\bf" + "\\bibitem" + "\\bigskip" + "\\cdots" + "\\centering" + "\\circle" + "\\cite" + "\\cleardoublepage" + "\\clearpage" + "\\cline" + "\\closing" + "\\dashbox" + "\\date" + "\\ddots" + "\\dotfill" + "\\em" + "\\fbox" + "\\flushbottom" + "\\fnsymbol" + "\\footnote" + "\\footnotemark" + "\\footnotesize" + "\\footnotetext" + "\\frac" + "\\frame" + "\\framebox" + "\\hfill" + "\\hline" + "\\hrulespace" + "\\hspace" + "\\huge" + "\\hyphenation" + "\\include" + "\\includeonly" + "\\indent" + "\\input" + "\\it" + "\\kill" + "\\label" + "\\large" + "\\ldots" + "\\line" + "\\linebreak" + "\\linethickness" + "\\listoffigures" + "\\listoftables" + "\\location" + "\\makebox" + "\\maketitle" + "\\mark" + "\\mbox" + "\\medskip" + "\\multicolumn" + "\\multiput" + "\\newcommand" + "\\newcounter" + "\\newenvironment" + "\\newfont" + "\\newlength" + "\\newline" + "\\newpage" + "\\newsavebox" + "\\newtheorem" + "\\nocite" + "\\nofiles" + "\\noindent" + "\\nolinebreak" + "\\nopagebreak" + "\\normalsize" + "\\onecolumn" + "\\opening" + "\\oval" + "\\overbrace" + "\\overline" + "\\pagebreak" + "\\pagenumbering" + "\\pageref" + "\\pagestyle" + "\\par" + "\\parbox" + "\\put" + "\\raggedbottom" + "\\raggedleft" + "\\raggedright" + "\\raisebox" + "\\ref" + "\\rm" + "\\roman" + "\\rule" + "\\savebox" + "\\sc" + "\\scriptsize" + "\\setcounter" + "\\setlength" + "\\settowidth" + "\\sf" + "\\shortstack" + "\\signature" + "\\sl" + "\\small" + "\\smallskip" + "\\sqrt" + "\\tableofcontents" + "\\telephone" + "\\thanks" + "\\thispagestyle" + "\\tiny" + "\\title" + "\\tt" + "\\twocolumn" + "\\typein" + "\\typeout" + "\\underbrace" + "\\underline" + "\\usebox" + "\\usecounter" + "\\value" + "\\vdots" + "\\vector" + "\\verb" + "\\vfill" + "\\vline" + "\\vspace") + "A list of LaTeX commands to be protected when performing conversion.") (defconst org-latex-entities-regexp (let (names rest) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 8d3948698f..10f5e6ec6a 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -236,8 +236,7 @@ Otherwise, two of them will be necessary." :group 'org-plain-lists :type 'boolean) -(defcustom org-list-automatic-rules '((bullet . t) - (checkbox . t) +(defcustom org-list-automatic-rules '((checkbox . t) (indent . t)) "Non-nil means apply set of rules when acting on lists. By default, automatic actions are taken when using @@ -247,27 +246,21 @@ By default, automatic actions are taken when using \\[org-insert-todo-heading]. You can disable individually these rules by setting them to nil. Valid rules are: -bullet when non-nil, cycling bullet do not allow lists at - column 0 to have * as a bullet and descriptions lists - to be numbered. checkbox when non-nil, checkbox statistics is updated each time you either insert a new checkbox or toggle a checkbox. - It also prevents from inserting a checkbox in a - description item. indent when non-nil, indenting or outdenting list top-item with its subtree will move the whole list and outdenting a list whose bullet is * to column 0 will change that bullet to \"-\"." - :group 'org-plain-lists - :version "24.1" - :type '(alist :tag "Sets of rules" - :key-type - (choice - (const :tag "Bullet" bullet) - (const :tag "Checkbox" checkbox) - (const :tag "Indent" indent)) - :value-type - (boolean :tag "Activate" :value t))) + :group 'org-plain-lists + :version "24.1" + :type '(alist :tag "Sets of rules" + :key-type + (choice + (const :tag "Checkbox" checkbox) + (const :tag "Indent" indent)) + :value-type + (boolean :tag "Activate" :value t))) (defcustom org-list-use-circular-motion nil "Non-nil means commands implying motion in lists should be cyclic. @@ -491,7 +484,7 @@ group 4: description tag") (defun org-at-item-description-p () "Is point at a description list item?" - (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+")) + (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::\\([ \t]+\\|$\\)")) (defun org-at-item-checkbox-p () "Is point at a line starting a plain-list item with a checklet?" @@ -628,12 +621,15 @@ Assume point is at an item." ;; Return association at point. (lambda (ind) (looking-at org-list-full-item-re) - (list (point) - ind - (match-string-no-properties 1) ; bullet - (match-string-no-properties 2) ; counter - (match-string-no-properties 3) ; checkbox - (match-string-no-properties 4))))) ; description tag + (let ((bullet (match-string-no-properties 1))) + (list (point) + ind + bullet + (match-string-no-properties 2) ; counter + (match-string-no-properties 3) ; checkbox + ;; Description tag. + (and (save-match-data (string-match "[-+*]" bullet)) + (match-string-no-properties 4))))))) (end-before-blank (function ;; Ensure list ends at the first blank line. @@ -694,7 +690,7 @@ Assume point is at an item." (forward-line -1)) ((looking-at "^[ \t]*$") (forward-line -1)) - ;; From there, point is not at an item. Interpret + ;; From there, point is not at an item. Interpret ;; line's indentation: ;; - text at column 0 is necessarily out of any list. ;; Dismiss data recorded above BEG-CELL. Jump to @@ -1015,10 +1011,45 @@ Possible types are `descriptive', `ordered' and `unordered'. The type is determined by the first item of the list." (let ((first (org-list-get-list-begin item struct prevs))) (cond - ((org-list-get-tag first struct) 'descriptive) ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) + ((org-list-get-tag first struct) 'descriptive) (t 'unordered)))) +(defun org-list-get-item-number (item struct prevs parents) + "Return ITEM's sequence number. + +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. PARENTS is the +alist of ancestors, as returned by `org-list-parents-alist'. + +Return value is a list of integers. Counters have an impact on +that value." + (let ((get-relative-number + (function + (lambda (item struct prevs) + ;; Return relative sequence number of ITEM in the sub-list + ;; it belongs. STRUCT is the list structure. PREVS is + ;; the alist of previous items. + (let ((seq 0) (pos item) counter) + (while (and (not (setq counter (org-list-get-counter pos struct))) + (setq pos (org-list-get-prev-item pos struct prevs))) + (incf seq)) + (if (not counter) (1+ seq) + (cond + ((string-match "[A-Za-z]" counter) + (+ (- (string-to-char (upcase (match-string 0 counter))) 64) + seq)) + ((string-match "[0-9]+" counter) + (+ (string-to-number (match-string 0 counter)) seq)) + (t (1+ seq))))))))) + ;; Cons each parent relative number into return value (OUT). + (let ((out (list (funcall get-relative-number item struct prevs))) + (parent item)) + (while (setq parent (org-list-get-parent parent struct parents)) + (push (funcall get-relative-number parent struct prevs) out)) + ;; Return value. + out))) + ;;; Searching @@ -1225,8 +1256,15 @@ This function modifies STRUCT." (let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin)))) (item-end (org-list-get-item-end item struct)) (item-end-no-blank (org-list-get-item-end-before-blank item struct)) - (beforep (and (looking-at org-list-full-item-re) - (<= pos (match-end 0)))) + (beforep + (progn + (looking-at org-list-full-item-re) + ;; Do not count tag in a non-descriptive list. + (<= pos (if (and (match-beginning 4) + (save-match-data + (string-match "[.)]" (match-string 1)))) + (match-beginning 4) + (match-end 0))))) (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) (blank-nb (org-list-separating-blank-lines-number pos struct prevs)) @@ -1270,9 +1308,8 @@ This function modifies STRUCT." (insert body item-sep) ;; 5. Add new item to STRUCT. (mapc (lambda (e) - (let ((p (car e)) - (end (nth 6 e))) - (cond + (let ((p (car e)) (end (nth 6 e))) + (cond ;; Before inserted item, positions don't change but ;; an item ending after insertion has its end shifted ;; by SIZE-OFFSET. @@ -1591,7 +1628,7 @@ as returned by `org-list-prevs-alist'." (if (> ascii 90) (throw 'exit nil) (setq item (org-list-get-next-item item struct prevs))))) - ;; All items checked. All good. + ;; All items checked. All good. t)))) (defun org-list-inc-bullet-maybe (bullet) @@ -1808,7 +1845,6 @@ Initial position of cursor is restored after the changes." (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) (item-re (org-item-re)) - (box-rule-p (cdr (assq 'checkbox org-list-automatic-rules))) (shift-body-ind (function ;; Shift the indentation between END and BEG by DELTA. @@ -1842,14 +1878,11 @@ Initial position of cursor is restored after the changes." (old-bul (org-list-get-bullet item old-struct)) (new-box (org-list-get-checkbox item struct))) (looking-at org-list-full-item-re) - ;; a. Replace bullet + ;; a. Replace bullet (unless (equal old-bul new-bul) (replace-match new-bul nil nil nil 1)) - ;; b. Replace checkbox. + ;; b. Replace checkbox. (cond - ((and new-box box-rule-p - (save-match-data (org-at-item-description-p))) - (message "Cannot add a checkbox to a description list item")) ((equal (match-string 3) new-box)) ((and (match-string 3) new-box) (replace-match new-box nil nil nil 3)) @@ -1859,7 +1892,7 @@ Initial position of cursor is restored after the changes." (t (let ((counterp (match-end 2))) (goto-char (if counterp (1+ counterp) (match-end 1))) (insert (concat new-box (unless counterp " ")))))) - ;; c. Indent item to appropriate column. + ;; c. Indent item to appropriate column. (unless (= new-ind old-ind) (delete-region (goto-char (point-at-bol)) (progn (skip-chars-forward " \t") (point))) @@ -2007,7 +2040,7 @@ Possible values are: `folded', `children' or `subtree'. See (let (bpos bcol tpos tcol) (save-excursion (goto-char item) - (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?[ \t]+") + (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)") (setq bpos (match-beginning 1) tpos (match-end 0) bcol (progn (goto-char bpos) (current-column)) tcol (progn (goto-char tpos) (current-column))) @@ -2164,20 +2197,19 @@ item is invisible." (org-list-struct))) (prevs (org-list-prevs-alist struct)) ;; If we're in a description list, ask for the new term. - (desc (when (org-list-get-tag itemp struct) - (concat (read-string "Term: ") " :: "))) - ;; Don't insert a checkbox if checkbox rule is applied - ;; and it is a description item. - (checkp (and checkbox - (or (not desc) - (not (cdr (assq 'checkbox - org-list-automatic-rules))))))) + (desc (when (eq (org-list-get-list-type itemp struct prevs) + 'descriptive) + (concat (read-string "Term: ") " :: ")))) (setq struct - (org-list-insert-item pos struct prevs checkp desc)) + (org-list-insert-item pos struct prevs checkbox desc)) (org-list-write-struct struct (org-list-parents-alist struct)) - (when checkp (org-update-checkbox-count-maybe)) + (when checkbox (org-update-checkbox-count-maybe)) (looking-at org-list-full-item-re) - (goto-char (match-end 0)) + (goto-char (if (and (match-beginning 4) + (save-match-data + (string-match "[.)]" (match-string 1)))) + (match-beginning 4) + (match-end 0))) t))))) (defun org-list-repair () @@ -2206,7 +2238,6 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (prevs (org-list-prevs-alist struct)) (list-beg (org-list-get-first-item (point) struct prevs)) (bullet (org-list-get-bullet list-beg struct)) - (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) (alpha-p (org-list-use-alpha-bul-p list-beg struct prevs)) (case-fold-search nil) (current (cond @@ -2221,22 +2252,21 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (bullet-list (append '("-" "+" ) ;; *-bullets are not allowed at column 0. - (unless (and bullet-rule-p - (looking-at "\\S-")) '("*")) + (unless (looking-at "\\S-") '("*")) ;; Description items cannot be numbered. (unless (or (eq org-plain-list-ordered-item-terminator ?\)) - (and bullet-rule-p (org-at-item-description-p))) + (org-at-item-description-p)) '("1.")) (unless (or (eq org-plain-list-ordered-item-terminator ?.) - (and bullet-rule-p (org-at-item-description-p))) + (org-at-item-description-p)) '("1)")) (unless (or (not alpha-p) (eq org-plain-list-ordered-item-terminator ?\)) - (and bullet-rule-p (org-at-item-description-p))) + (org-at-item-description-p)) '("a." "A.")) (unless (or (not alpha-p) (eq org-plain-list-ordered-item-terminator ?.) - (and bullet-rule-p (org-at-item-description-p))) + (org-at-item-description-p)) '("a)" "A)")))) (len (length bullet-list)) (item-index (- len (length (member current bullet-list)))) @@ -2339,13 +2369,13 @@ in subtree, ignoring drawers." (lambda (e) (or (< e lim-up) (> e lim-down))) (mapcar 'car struct)))) (mapc (lambda (e) (org-list-set-checkbox - e struct - ;; If there is no box at item, leave as-is - ;; unless function was called with C-u prefix. - (let ((cur-box (org-list-get-checkbox e struct))) - (if (or cur-box (equal toggle-presence '(4))) - ref-checkbox - cur-box)))) + e struct + ;; If there is no box at item, leave as-is + ;; unless function was called with C-u prefix. + (let ((cur-box (org-list-get-checkbox e struct))) + (if (or cur-box (equal toggle-presence '(4))) + ref-checkbox + cur-box)))) items-to-toggle) (setq block-item (org-list-struct-fix-box struct parents prevs orderedp)) @@ -2792,11 +2822,10 @@ COMPARE-FUNC to compare entries." (sort-func (cond ((= dcst ?a) 'string<) ((= dcst ?f) compare-func) - ((= dcst ?t) '<) - (t nil))) + ((= dcst ?t) '<))) (next-record (lambda () - (skip-chars-forward " \r\t\n") - (beginning-of-line))) + (skip-chars-forward " \r\t\n") + (beginning-of-line))) (end-record (lambda () (goto-char (org-list-get-item-end-before-blank (point) struct)))) @@ -2910,7 +2939,7 @@ Point is left at list end." (goto-char e) (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*") (match-end 0))) - ;; Get counter number. For alphabetic counter, get + ;; Get counter number. For alphabetic counter, get ;; its position in the alphabet. (counter (let ((c (org-list-get-counter e struct))) (cond @@ -3116,7 +3145,7 @@ items." ((and counter (eq type 'ordered)) (concat (eval icount) "%s")) (t (concat (eval istart) "%s"))) - (eval iend))) + (eval iend))) (first (car item))) ;; Replace checkbox if any is found. (cond @@ -3173,21 +3202,21 @@ with overruling parameters for `org-list-to-generic'." list (org-combine-plists '(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}" - :ustart "\\begin{itemize}\n" :uend "\\end{itemize}" - :dstart "\\begin{description}\n" :dend "\\end{description}" - :dtstart "[" :dtend "] " - :istart "\\item " :iend "\n" - :icount (let ((enum (nth depth '("i" "ii" "iii" "iv")))) - (if enum - ;; LaTeX increments counter just before - ;; using it, so set it to the desired - ;; value, minus one. - (format "\\setcounter{enum%s}{%s}\n\\item " - enum (1- counter)) - "\\item ")) - :csep "\n" - :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}" - :cbtrans "\\texttt{[-]}") + :ustart "\\begin{itemize}\n" :uend "\\end{itemize}" + :dstart "\\begin{description}\n" :dend "\\end{description}" + :dtstart "[" :dtend "] " + :istart "\\item " :iend "\n" + :icount (let ((enum (nth depth '("i" "ii" "iii" "iv")))) + (if enum + ;; LaTeX increments counter just before + ;; using it, so set it to the desired + ;; value, minus one. + (format "\\setcounter{enum%s}{%s}\n\\item " + enum (1- counter)) + "\\item ")) + :csep "\n" + :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}" + :cbtrans "\\texttt{[-]}") params))) (defun org-list-to-html (list &optional params) @@ -3198,15 +3227,15 @@ with overruling parameters for `org-list-to-generic'." list (org-combine-plists '(:splice nil :ostart "<ol>\n" :oend "\n</ol>" - :ustart "<ul>\n" :uend "\n</ul>" - :dstart "<dl>\n" :dend "\n</dl>" - :dtstart "<dt>" :dtend "</dt>\n" - :ddstart "<dd>" :ddend "</dd>" - :istart "<li>" :iend "</li>" - :icount (format "<li value=\"%s\">" counter) - :isep "\n" :lsep "\n" :csep "\n" - :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>" - :cbtrans "<code>[-]</code>") + :ustart "<ul>\n" :uend "\n</ul>" + :dstart "<dl>\n" :dend "\n</dl>" + :dtstart "<dt>" :dtend "</dt>\n" + :ddstart "<dd>" :ddend "</dd>" + :istart "<li>" :iend "</li>" + :icount (format "<li value=\"%s\">" counter) + :isep "\n" :lsep "\n" :csep "\n" + :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>" + :cbtrans "<code>[-]</code>") params))) (defun org-list-to-texinfo (list &optional params) @@ -3217,14 +3246,14 @@ with overruling parameters for `org-list-to-generic'." list (org-combine-plists '(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize" - :ustart "@enumerate\n" :uend "@end enumerate" - :dstart "@table @asis\n" :dend "@end table" - :dtstart " " :dtend "\n" - :istart "@item\n" :iend "\n" - :icount "@item\n" - :csep "\n" - :cbon "@code{[X]}" :cboff "@code{[ ]}" - :cbtrans "@code{[-]}") + :ustart "@enumerate\n" :uend "@end enumerate" + :dstart "@table @asis\n" :dend "@end table" + :dtstart " " :dtend "\n" + :istart "@item\n" :iend "\n" + :icount "@item\n" + :csep "\n" + :cbon "@code{[X]}" :cboff "@code{[ ]}" + :cbtrans "@code{[-]}") params))) (defun org-list-to-subtree (list &optional params) diff --git a/lisp/org/org-lparse.el b/lisp/org/org-lparse.el index 9c3cd5b481..7024912050 100644 --- a/lisp/org/org-lparse.el +++ b/lisp/org/org-lparse.el @@ -67,7 +67,7 @@ lists." ((file-exists-p file-or-buf) file-or-buf) (t (error "org-lparse-and-open: This shouldn't happen")))) (message "Opening file %s" f) - (org-open-file f) + (org-open-file f 'system) (when org-export-kill-product-buffer-when-displayed (kill-buffer (current-buffer)))))) @@ -89,9 +89,9 @@ emacs --batch No file is created. The prefix ARG is passed through to `org-lparse'." (let ((tempbuf (format "*Org %s Export*" (upcase backend)))) - (org-lparse backend backend arg nil nil tempbuf) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window tempbuf)))) + (org-lparse backend backend arg nil nil tempbuf) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window tempbuf)))) ;;;###autoload (defun org-replace-region-by (backend beg end) @@ -101,7 +101,7 @@ itemized list in org-mode syntax in an HTML buffer and then use this command to convert it." (let (reg backend-string buf pop-up-frames) (save-window-excursion - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq backend-string (org-lparse-region backend beg end t 'string)) (setq reg (buffer-substring beg end) buf (get-buffer-create "*Org tmp*")) @@ -145,16 +145,16 @@ in a window. A non-interactive call will only return the buffer." (defvar org-lparse-par-open nil) (defun org-lparse-should-inline-p (filename descp) - "Return non-nil if link FILENAME should be inlined. + "Return non-nil if link FILENAME should be inlined. The decision to inline the FILENAME link is based on the current settings. DESCP is the boolean of whether there was a link description. See variables `org-export-html-inline-images' and `org-export-html-inline-image-extensions'." - (let ((inline-images (org-lparse-get 'INLINE-IMAGES)) - (inline-image-extensions - (org-lparse-get 'INLINE-IMAGE-EXTENSIONS))) - (and (or (eq t inline-images) (and inline-images (not descp))) - (org-file-image-p filename inline-image-extensions)))) + (let ((inline-images (org-lparse-get 'INLINE-IMAGES)) + (inline-image-extensions + (org-lparse-get 'INLINE-IMAGE-EXTENSIONS))) + (and (or (eq t inline-images) (and inline-images (not descp))) + (org-file-image-p filename inline-image-extensions)))) (defun org-lparse-format-org-link (line opt-plist) "Return LINE with markup of Org mode links. @@ -435,6 +435,10 @@ PUB-DIR specifies the publishing directory." (let* ((org-lparse-backend (intern native-backend)) (org-lparse-other-backend (and target-backend (intern target-backend)))) + (add-hook 'org-export-preprocess-hook + 'org-lparse-strip-experimental-blocks-maybe) + (add-hook 'org-export-preprocess-after-blockquote-hook + 'org-lparse-preprocess-after-blockquote) (unless (org-lparse-backend-is-native-p native-backend) (error "Don't know how to export natively to backend %s" native-backend)) @@ -443,7 +447,11 @@ PUB-DIR specifies the publishing directory." (error "Don't know how to export to backend %s %s" target-backend (format "via %s" native-backend))) (run-hooks 'org-export-first-hook) - (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir))) + (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir) + (remove-hook 'org-export-preprocess-hook + 'org-lparse-strip-experimental-blocks-maybe) + (remove-hook 'org-export-preprocess-after-blockquote-hook + 'org-lparse-preprocess-after-blockquote))) (defcustom org-lparse-use-flashy-warning nil "Control flashing of messages logged with `org-lparse-warn'. @@ -509,7 +517,7 @@ This is a helper routine for interactive use." (message "Exported to %s" out-file) (when prefix-arg (message "Opening %s..." out-file) - (org-open-file out-file)) + (org-open-file out-file 'system)) out-file) (t (message "Export to %s failed" out-file) @@ -565,7 +573,7 @@ and then converted to \"doc\" then org-lparse-backend is set to (defun org-do-lparse (arg &optional hidden ext-plist to-buffer body-only pub-dir) "Export the outline to various formats. -See `org-lparse' for more information. This function is a +See `org-lparse' for more information. This function is a html-agnostic version of the `org-export-as-html' function in 7.5 version." ;; Make sure we have a file name when we need it. @@ -771,7 +779,7 @@ version." ;; collection org-lparse-collect-buffer (org-lparse-collect-count 0) ; things will get haywire if - ; collections are chained. Use + ; collections are chained. Use ; this variable to assert this ; pre-requisite org-lparse-toc @@ -901,7 +909,6 @@ version." (funcall f style env-options-plist) (throw 'nextline nil)))) - (run-hooks 'org-export-html-after-blockquotes-hook) (when (org-lparse-current-environment-p 'verse) (let ((i (org-get-string-indentation line))) (if (> i 0) @@ -1158,7 +1165,7 @@ version." (defun org-lparse-table-get-colalign-info (lines) (let ((col-cookies (org-find-text-property-in-string - 'org-col-cookies (car lines)))) + 'org-col-cookies (car lines)))) (when (and col-cookies org-table-clean-did-remove-column) (setq col-cookies (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies))) @@ -1218,7 +1225,11 @@ for formatting. This is required for the DocBook exporter." ;; column and the special lines (setq lines (org-table-clean-before-export lines))) (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) + (short-caption (or (org-find-text-property-in-string + 'org-caption-shortn (car lines)) caption)) (caption (and caption (org-xml-encode-org-text caption))) + (short-caption (and short-caption + (org-xml-encode-plain-text short-caption))) (label (org-find-text-property-in-string 'org-label (car lines))) (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines)) (attributes (org-find-text-property-in-string 'org-attributes @@ -1229,11 +1240,13 @@ for formatting. This is required for the DocBook exporter." (cdr lines)))))) (setq lines (org-lparse-org-table-to-list-table lines splice)) (org-lparse-insert-list-table - lines splice caption label attributes head org-lparse-table-colalign-info))) + lines splice caption label attributes head org-lparse-table-colalign-info + short-caption))) (defun org-lparse-insert-list-table (lines &optional splice - caption label attributes head - org-lparse-table-colalign-info) + caption label attributes head + org-lparse-table-colalign-info + short-caption) (or (featurep 'org-table) ; required for (require 'org-table)) ; `org-table-number-regexp' (let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0) @@ -1253,7 +1266,7 @@ for formatting. This is required for the DocBook exporter." (insert (org-lparse-format-table-row line) "\n"))) (t (setq org-lparse-table-is-styled t) - (org-lparse-begin 'TABLE caption label attributes) + (org-lparse-begin 'TABLE caption label attributes short-caption) (setq org-lparse-table-begin-marker (point)) (org-lparse-begin-table-rowgroup head) (while (setq line (pop lines)) @@ -1284,13 +1297,14 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." (org-lparse-table-cur-rowgrp-is-hdr org-export-highlight-first-table-line) (caption nil) + (short-caption nil) (attributes nil) (label nil) (org-lparse-table-style 'table-table) (org-lparse-table-is-styled nil) fields org-lparse-table-ncols i (org-lparse-table-rownum -1) (empty (org-lparse-format 'SPACES 1))) - (org-lparse-begin 'TABLE caption label attributes) + (org-lparse-begin 'TABLE caption label attributes short-caption) (while (setq line (pop lines)) (cond ((string-match "^[ \t]*\\+-" line) @@ -1320,9 +1334,9 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." (defvar table-source-languages) ; defined in table.el (defun org-lparse-format-table-table-using-table-generate-source (backend - lines - &optional - spanned-only) + lines + &optional + spanned-only) "Format a table into BACKEND, using `table-generate-source' from table.el. Use SPANNED-ONLY to suppress exporting of simple table.el tables. @@ -1353,9 +1367,9 @@ for further information." (set-buffer " org-tmp2 ") (buffer-substring (point-min) (point-max))) (t - ;; table.el doesn't support the given backend. Currently this + ;; table.el doesn't support the given backend. Currently this ;; happens in case of odt export. Strip the table from the - ;; generated document. A better alternative would be to embed + ;; generated document. A better alternative would be to embed ;; the table as ascii text in the output document. (org-lparse-warn (concat @@ -1706,7 +1720,12 @@ information." (org-lparse-end-paragraph) (org-lparse-end-list-item (or type "u"))) -(defun org-lparse-preprocess-after-blockquote-hook () +(define-obsolete-function-alias + 'org-lparse-preprocess-after-blockquote-hook + 'org-lparse-preprocess-after-blockquote + "24.3") + +(defun org-lparse-preprocess-after-blockquote () "Treat `org-lparse-special-blocks' specially." (goto-char (point-min)) (while (re-search-forward @@ -1719,10 +1738,12 @@ information." (format "ORG-%s-END %s" (upcase (match-string 2)) (match-string 3))) t t)))) -(add-hook 'org-export-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote-hook) +(define-obsolete-function-alias + 'org-lparse-strip-experimental-blocks-maybe-hook + 'org-lparse-strip-experimental-blocks-maybe + "24.3") -(defun org-lparse-strip-experimental-blocks-maybe-hook () +(defun org-lparse-strip-experimental-blocks-maybe () "Strip \"list-table\" and \"annotation\" blocks. Stripping happens only when the exported backend is not one of \"odt\" or \"xhtml\"." @@ -1737,9 +1758,6 @@ Stripping happens only when the exported backend is not one of (when (member (match-string 1) org-lparse-special-blocks) (replace-match "" t t)))))) -(add-hook 'org-export-preprocess-hook - 'org-lparse-strip-experimental-blocks-maybe-hook) - (defvar org-lparse-list-table-p nil "Non-nil if `org-do-lparse' is within a list-table.") @@ -1871,7 +1889,7 @@ See `org-xhtml-entity-format-callbacks-alist' for more information." (replace-match (let ((org-lparse-encode-pending t)) (org-lparse-format 'FONTIFY - (match-string 1 line) "target")) + (match-string 1 line) "target")) t t line))) (when (string-match (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) @@ -1923,8 +1941,7 @@ See `org-xhtml-entity-format-callbacks-alist' for more information." (cond ((string= align "l") "left") ((string= align "r") "right") - ((string= align "c") "center") - (t nil)))))))) + ((string= align "c") "center")))))))) (incf org-lparse-table-rownum) (let ((i -1)) (org-lparse-format @@ -2036,8 +2053,8 @@ When TITLE is nil, just close all open levels." (defvar org-lparse-outline-text-open) (defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags - target extra-targets - extra-class) + target extra-targets + extra-class) (org-lparse-begin 'OUTLINE level1 snumber title tags target extra-targets extra-class) (org-lparse-begin-outline-text level1 snumber extra-class)) @@ -2087,7 +2104,7 @@ When TITLE is nil, just close all open levels." ;; Note that org-tables are NOT multi-line and each line is mapped to ;; a unique row in the exported document. So if an exported table ;; needs to contain a single paragraph (with copious text) it needs to -;; be typed up in a single line. Editing such long lines using the +;; be typed up in a single line. Editing such long lines using the ;; table editor will be a cumbersome task. Furthermore inclusion of ;; multi-paragraph text in a table cell is well-nigh impossible. ;; @@ -2232,11 +2249,11 @@ Replaces invalid characters with \"_\"." (defun org-lparse-format-extra-targets (extra-targets) (if (not extra-targets) "" - (mapconcat (lambda (x) - (setq x (org-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) x))) - (org-lparse-format 'ANCHOR "" x)) - extra-targets ""))) + (mapconcat (lambda (x) + (setq x (org-solidify-link-text + (if (org-uuidgen-p x) (concat "ID-" x) x))) + (org-lparse-format 'ANCHOR "" x)) + extra-targets ""))) (defun org-lparse-format-org-tags (tags) (if (not tags) "" diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el index 2223c63f15..91866b46c0 100644 --- a/lisp/org/org-mac-message.el +++ b/lisp/org/org-mac-message.el @@ -47,7 +47,7 @@ (require 'org) (defgroup org-mac-flagged-mail nil - "Options concerning linking to flagged Mail.app messages" + "Options concerning linking to flagged Mail.app messages." :tag "Org Mail.app" :group 'org-link) @@ -84,15 +84,15 @@ This will use the command `open' with the message URL." (do-applescript (concat "tell application \"Mail\"\n" - "set theLinkList to {}\n" - "set theSelection to selection\n" - "repeat with theMessage in theSelection\n" - "set theID to message id of theMessage\n" - "set theSubject to subject of theMessage\n" - "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - "end repeat\n" - "return theLinkList as string\n" + "set theLinkList to {}\n" + "set theSelection to selection\n" + "repeat with theMessage in theSelection\n" + "set theID to message id of theMessage\n" + "set theSubject to subject of theMessage\n" + "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" + "copy theLink to end of theLinkList\n" + "end repeat\n" + "return theLinkList as string\n" "end tell"))) (defun as-get-flagged-mail () @@ -101,47 +101,47 @@ This will use the command `open' with the message URL." (concat ;; Is Growl installed? "tell application \"System Events\"\n" - "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n" - "if (count of growlHelpers) > 0 then\n" - "set growlHelperApp to item 1 of growlHelpers\n" - "else\n" - "set growlHelperApp to \"\"\n" - "end if\n" + "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n" + "if (count of growlHelpers) > 0 then\n" + "set growlHelperApp to item 1 of growlHelpers\n" + "else\n" + "set growlHelperApp to \"\"\n" + "end if\n" "end tell\n" ;; Get links "tell application \"Mail\"\n" - "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n" - "set theLinkList to {}\n" - "repeat with aMailbox in theMailboxes\n" - "set theSelection to (every message in aMailbox whose flagged status = true)\n" - "repeat with theMessage in theSelection\n" - "set theID to message id of theMessage\n" - "set theSubject to subject of theMessage\n" - "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - - ;; Report progress through Growl - ;; This "double tell" idiom is described in detail at - ;; http://macscripter.net/viewtopic.php?id=24570 The - ;; script compiler needs static knowledge of the - ;; growlHelperApp. Hmm, since we're compiling - ;; on-the-fly here, this is likely to be way less - ;; portable than I'd hoped. It'll work when the name - ;; is still "GrowlHelperApp", though. - "if growlHelperApp is not \"\" then\n" - "tell application \"GrowlHelperApp\"\n" - "tell application growlHelperApp\n" - "set the allNotificationsList to {\"FlaggedMail\"}\n" - "set the enabledNotificationsList to allNotificationsList\n" - "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n" - "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n" - "end tell\n" - "end tell\n" - "end if\n" - "end repeat\n" - "end repeat\n" - "return theLinkList as string\n" + "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n" + "set theLinkList to {}\n" + "repeat with aMailbox in theMailboxes\n" + "set theSelection to (every message in aMailbox whose flagged status = true)\n" + "repeat with theMessage in theSelection\n" + "set theID to message id of theMessage\n" + "set theSubject to subject of theMessage\n" + "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" + "copy theLink to end of theLinkList\n" + + ;; Report progress through Growl + ;; This "double tell" idiom is described in detail at + ;; http://macscripter.net/viewtopic.php?id=24570 The + ;; script compiler needs static knowledge of the + ;; growlHelperApp. Hmm, since we're compiling + ;; on-the-fly here, this is likely to be way less + ;; portable than I'd hoped. It'll work when the name + ;; is still "GrowlHelperApp", though. + "if growlHelperApp is not \"\" then\n" + "tell application \"GrowlHelperApp\"\n" + "tell application growlHelperApp\n" + "set the allNotificationsList to {\"FlaggedMail\"}\n" + "set the enabledNotificationsList to allNotificationsList\n" + "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n" + "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n" + "end tell\n" + "end tell\n" + "end if\n" + "end repeat\n" + "end repeat\n" + "return theLinkList as string\n" "end tell"))) (defun org-mac-message-get-links (&optional select-or-flag) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index daeea71578..e99991702f 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -54,21 +54,22 @@ (defmacro org-called-interactively-p (&optional kind) (if (featurep 'xemacs) - `(interactive-p) - (if (or (> emacs-major-version 23) - (and (>= emacs-major-version 23) - (>= emacs-minor-version 2))) - `(with-no-warnings (called-interactively-p ,kind)) ;; defined with no argument in <=23.1 - `(interactive-p)))) + `(interactive-p) + (if (or (> emacs-major-version 23) + (and (>= emacs-major-version 23) + (>= emacs-minor-version 2))) + ;; defined with no argument in <=23.1 + `(with-no-warnings (called-interactively-p ,kind)) + `(interactive-p)))) (def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp))) (when (and (not (fboundp 'with-silent-modifications)) - (or (< emacs-major-version 23) - (and (= emacs-major-version 23) - (< emacs-minor-version 2)))) - (defmacro with-silent-modifications (&rest body) - `(org-unmodified ,@body)) - (def-edebug-spec with-silent-modifications (body))) + (or (< emacs-major-version 23) + (and (= emacs-major-version 23) + (< emacs-minor-version 2)))) + (defmacro with-silent-modifications (&rest body) + `(org-unmodified ,@body)) + (def-edebug-spec with-silent-modifications (body))) (defmacro org-bound-and-true-p (var) "Return the value of symbol VAR if it is bound, else nil." @@ -129,15 +130,15 @@ Also, do not record undo information." `(if (and (boundp 'partial-completion-mode) partial-completion-mode (fboundp 'partial-completion-mode)) - (unwind-protect - (progn - (partial-completion-mode -1) - ,@body) - (partial-completion-mode 1)) + (unwind-protect + (progn + (partial-completion-mode -1) + ,@body) + (partial-completion-mode 1)) ,@body)) (def-edebug-spec org-without-partial-completion (body)) -;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22 +;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22 (defmacro org-maybe-intangible (props) "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22. In Emacs 21, invisible text is not avoided by the command loop, so the @@ -238,10 +239,15 @@ We use a macro so that the test can happen at compilation time." s) (match-string-no-properties num string))) -(defsubst org-no-properties (s) +(defsubst org-no-properties (s &optional restricted) + "Remove all text properties from string S. +When RESTRICTED is non-nil, only remove the properties listed +in `org-rm-props'." (if (fboundp 'set-text-properties) (set-text-properties 0 (length s) nil s) - (remove-text-properties 0 (length s) org-rm-props s)) + (if restricted + (remove-text-properties 0 (length s) org-rm-props s) + (set-text-properties 0 (length s) nil s))) s) (defsubst org-get-alist-option (option key) @@ -363,18 +369,19 @@ point nowhere." (def-edebug-spec org-save-outline-visibility (form body)) (defmacro org-with-wide-buffer (&rest body) - "Execute body while temporarily widening the buffer." - `(save-excursion - (save-restriction + "Execute body while temporarily widening the buffer." + `(save-excursion + (save-restriction (widen) ,@body))) (def-edebug-spec org-with-wide-buffer (body)) (defmacro org-with-limited-levels (&rest body) "Execute BODY with limited number of outline levels." - `(let* ((org-outline-regexp (org-get-limited-outline-regexp)) + `(let* ((org-called-with-limited-levels t) + (org-outline-regexp (org-get-limited-outline-regexp)) (outline-regexp org-outline-regexp) - (org-outline-regexp-at-bol (concat "^" org-outline-regexp))) + (org-outline-regexp-bol (concat "^" org-outline-regexp))) ,@body)) (def-edebug-spec org-with-limited-levels (body)) @@ -384,14 +391,14 @@ point nowhere." (defun org-get-limited-outline-regexp () "Return outline-regexp with limited number of levels. The number of levels is controlled by `org-inlinetask-min-level'" - (if (or (not (eq major-mode 'org-mode)) (not (featurep 'org-inlinetask))) + (if (or (not (derived-mode-p 'org-mode)) (not (featurep 'org-inlinetask))) org-outline-regexp (let* ((limit-level (1- org-inlinetask-min-level)) (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) (format "\\*\\{1,%d\\} " nstars)))) (defun org-format-seconds (string seconds) - "Compatibility function replacing format-seconds" + "Compatibility function replacing format-seconds." (if (fboundp 'format-seconds) (format-seconds string seconds) (format-time-string string (seconds-to-time seconds)))) @@ -403,12 +410,12 @@ The number of levels is controlled by `org-inlinetask-min-level'" (defun org-make-parameter-alist (flat) "Return alist based on FLAT. -FLAT is a list with alternating symbol names and values. The +FLAT is a list with alternating symbol names and values. The returned alist is a list of lists with the symbol name in car and the value in cdr." (when flat (cons (list (car flat) (cadr flat)) - (org-make-parameter-alist (cddr flat))))) + (org-make-parameter-alist (cddr flat))))) (provide 'org-macs) diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el index 9cc767eaec..74ace5a529 100644 --- a/lisp/org/org-mew.el +++ b/lisp/org/org-mew.el @@ -103,8 +103,7 @@ :date-timestamp-inactive date-ts-ia)) (setq message-id (org-remove-angle-brackets message-id)) (setq desc (org-email-link-description)) - (setq link (org-make-link "mew:" folder-name - "#" message-id)) + (setq link (concat "mew:" folder-name "#" message-id)) (org-add-link-props :link link :description desc) link))) diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index 0c59d50073..7c8b0b2390 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -99,8 +99,8 @@ supported by MH-E." (org-add-link-props :date date :date-timestamp date-ts :date-timestamp-inactive date-ts-ia)) (setq desc (org-email-link-description)) - (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" - (org-remove-angle-brackets message-id))) + (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#" + (org-remove-angle-brackets message-id))) (org-add-link-props :link link :description desc) link)))) @@ -179,17 +179,17 @@ you have a better idea of how to do this then please let us know." (num (org-mhe-get-message-num)) (buffer (get-buffer-create (concat "show-" folder))) (header-field)) - (with-current-buffer buffer - (mh-display-msg num folder) - (if (equal major-mode 'mh-folder-mode) - (mh-header-display) - (mh-show-header-display)) - (set-buffer buffer) - (setq header-field (mh-get-header-field header)) - (if (equal major-mode 'mh-folder-mode) - (mh-show) - (mh-show-show)) - (org-trim header-field)))) + (with-current-buffer buffer + (mh-display-msg num folder) + (if (equal major-mode 'mh-folder-mode) + (mh-header-display) + (mh-show-header-display)) + (set-buffer buffer) + (setq header-field (mh-get-header-field header)) + (if (equal major-mode 'mh-folder-mode) + (mh-show) + (mh-show-show)) + (org-trim header-field)))) (defun org-mhe-follow-link (folder article) "Follow an MH-E link to FOLDER and ARTICLE. diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 3bd9a7c0bb..d2c9c17367 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -236,7 +236,7 @@ by the mobile device, this hook should be used to copy the capture file directory `org-mobile-directory'.") (defvar org-mobile-post-pull-hook nil - "Hook run after running `org-mobile-pull'. + "Hook run after running `org-mobile-pull', only if new items were found. If Emacs does not have direct write access to the WebDAV directory used by the mobile device, this hook should be used to copy the emptied capture file `mobileorg.org' back to the WebDAV directory, for example @@ -300,6 +300,8 @@ Also exclude files matching `org-mobile-files-exclude-regexp'." (push (cons file link-name) rtn))) (nreverse rtn))) +(defvar org-agenda-filter) + ;;;###autoload (defun org-mobile-push () "Push the current state of Org affairs to the WebDAV directory. @@ -316,7 +318,9 @@ create all custom agenda views, for upload to the mobile phone." (org-mobile-check-setup) (org-mobile-prepare-file-lists) (message "Creating agendas...") - (let ((inhibit-redisplay t)) (org-mobile-create-sumo-agenda)) + (let ((inhibit-redisplay t) + (org-agenda-files (mapcar 'car org-mobile-files-alist))) + (org-mobile-create-sumo-agenda)) (message "Creating agendas...done") (org-save-all-org-buffers) ; to save any IDs created by this process (message "Copying files...") @@ -402,7 +406,7 @@ agenda view showing the flagged items." (error "Cannot write to encryption tempfile %s" org-mobile-encryption-tempfile)) (unless (executable-find "openssl") - (error "openssl is needed to encrypt files")))) + (error "OpenSSL is needed to encrypt files")))) (defun org-mobile-create-index-file () "Write the index file in the WebDAV directory." @@ -414,21 +418,14 @@ agenda view showing the flagged items." org-mobile-directory)) file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds) - (org-prepare-agenda-buffers (mapcar 'car files-alist)) + (org-agenda-prepare-buffers (mapcar 'car files-alist)) (setq done-kwds (org-uniquify org-done-keywords-for-agenda)) (setq todo-kwds (org-delete-all done-kwds (org-uniquify org-todo-keywords-for-agenda))) (setq drawers (org-uniquify org-drawers-for-agenda)) - (setq tags (org-uniquify - (delq nil - (mapcar - (lambda (e) - (cond ((stringp e) e) - ((listp e) - (if (stringp (car e)) (car e) nil)) - (t nil))) - org-tag-alist-for-agenda)))) + (setq tags (mapcar 'car (org-global-tags-completion-table + (mapcar 'car files-alist)))) (with-temp-file (if org-mobile-use-encryption org-mobile-encryption-tempfile @@ -454,8 +451,7 @@ agenda view showing the flagged items." ((eq (car x) :startgroup) "{") ((eq (car x) :endgroup) "}") ((eq (car x) :newline) nil) - ((listp x) (car x)) - (t nil))) + ((listp x) (car x)))) def-tags)) (setq def-tags (delq nil def-tags)) (setq tags (org-delete-all def-tags tags)) @@ -579,7 +575,7 @@ The table of checksums is written to the file mobile-checksums." (concat "<after>KEYS=" key " TITLE: " (if (and (stringp desc) (> (length desc) 0)) desc (symbol-name type)) - " " match "</after>")) + "</after>")) settings)) (push (list type match settings) new)) ((or (functionp (nth 2 e)) (symbolp (nth 2 e))) @@ -596,7 +592,7 @@ The table of checksums is written to the file mobile-checksums." (setq settings (cons (list 'org-agenda-title-append (concat "<after>KEYS=" gkey "#" (number-to-string - (setq cnt (1+ cnt))) + (setq cnt (1+ cnt))) " TITLE: " gdesc " " match "</after>")) settings)) (push (list type match settings) new))))) @@ -827,107 +823,95 @@ If BEG and END are given, only do this in that region." (not (equal (downcase (substring (match-string 1) 0 2)) "f(")) (incf cnt-new))) + ;; Find and apply the edits (goto-char beg) (while (re-search-forward "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[\\(\\(id\\|olp\\):\\([^]\n]+\\)\\)" end t) - (setq id-pos (condition-case msg - (org-mobile-locate-entry (match-string 4)) - (error (nth 1 msg)))) - (when (and (markerp id-pos) - (not (member (marker-buffer id-pos) buf-list))) - (org-mobile-timestamp-buffer (marker-buffer id-pos)) - (push (marker-buffer id-pos) buf-list)) - - (if (or (not id-pos) (stringp id-pos)) - (progn - (goto-char (+ 2 (point-at-bol))) - (insert id-pos " ") - (incf cnt-error)) - (add-text-properties (point-at-bol) (point-at-eol) - (list 'org-mobile-marker - (or id-pos "Linked entry not found"))))) - - ;; OK, now go back and start applying - (goto-char beg) - (while (re-search-forward "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)" end t) (catch 'next - (setq id-pos (get-text-property (point-at-bol) 'org-mobile-marker)) - (if (not (markerp id-pos)) - (progn - (incf cnt-error) - (insert "UNKNOWN PROBLEM")) - (let* ((action (match-string 1)) - (data (and (match-end 3) (match-string 3))) - (bos (point-at-bol)) - (eos (save-excursion (org-end-of-subtree t t))) - (cmd (if (equal action "") - '(progn - (incf cnt-flag) - (org-toggle-tag "FLAGGED" 'on) - (and note - (org-entry-put nil "THEFLAGGINGNOTE" note))) - (incf cnt-edit) - (cdr (assoc action org-mobile-action-alist)))) - (note (and (equal action "") - (buffer-substring (1+ (point-at-eol)) eos))) - (org-inhibit-logging 'note) ;; Do not take notes interactively - old new) - (goto-char bos) - (move-marker bos-marker (point)) - (if (re-search-forward "^** Old value[ \t]*$" eos t) - (setq old (buffer-substring - (1+ (match-end 0)) - (progn (outline-next-heading) (point))))) - (if (re-search-forward "^** New value[ \t]*$" eos t) - (setq new (buffer-substring - (1+ (match-end 0)) - (progn (outline-next-heading) - (if (eobp) (org-back-over-empty-lines)) - (point))))) - (setq old (and old (if (string-match "\\S-" old) old nil))) - (setq new (and new (if (string-match "\\S-" new) new nil))) - (if (and note (> (length note) 0)) - ;; Make Note into a single line, to fit into a property - (setq note (mapconcat 'identity - (org-split-string (org-trim note) "\n") - "\\n"))) - (unless (equal data "body") - (setq new (and new (org-trim new)) - old (and old (org-trim old)))) - (goto-char (+ 2 bos-marker)) - (unless (markerp id-pos) - (insert "BAD REFERENCE ") - (incf cnt-error) - (throw 'next t)) - (unless cmd - (insert "BAD FLAG ") - (incf cnt-error) - (throw 'next t)) - ;; Remember this place so that we can return - (move-marker marker (point)) - (setq org-mobile-error nil) - (save-excursion - (condition-case msg - (org-with-point-at id-pos - (progn - (eval cmd) - (if (member "FLAGGED" (org-get-tags)) - (add-to-list 'org-mobile-last-flagged-files - (buffer-file-name (current-buffer)))))) - (error (setq org-mobile-error msg)))) - (when org-mobile-error - (org-pop-to-buffer-same-window (marker-buffer marker)) - (goto-char marker) - (incf cnt-error) - (insert (if (stringp (nth 1 org-mobile-error)) - (nth 1 org-mobile-error) - "EXECUTION FAILED") - " ") - (throw 'next t)) - ;; If we get here, the action has been applied successfully - ;; So remove the entry - (goto-char bos-marker) - (delete-region (point) (org-end-of-subtree t t)))))) + (let* ((action (match-string 1)) + (data (and (match-end 3) (match-string 3))) + (id-pos (condition-case msg + (org-mobile-locate-entry (match-string 4)) + (error (nth 1 msg)))) + (bos (point-at-bol)) + (eos (save-excursion (org-end-of-subtree t t))) + (cmd (if (equal action "") + '(progn + (incf cnt-flag) + (org-toggle-tag "FLAGGED" 'on) + (and note + (org-entry-put nil "THEFLAGGINGNOTE" note))) + (incf cnt-edit) + (cdr (assoc action org-mobile-action-alist)))) + (note (and (equal action "") + (buffer-substring (1+ (point-at-eol)) eos))) + (org-inhibit-logging 'note) ;; Do not take notes interactively + old new) + + (goto-char bos) + (when (and (markerp id-pos) + (not (member (marker-buffer id-pos) buf-list))) + (org-mobile-timestamp-buffer (marker-buffer id-pos)) + (push (marker-buffer id-pos) buf-list)) + (unless (markerp id-pos) + (goto-char (+ 2 (point-at-bol))) + (if (stringp id-pos) + (insert id-pos " ") + (insert "BAD REFERENCE ")) + (incf cnt-error) + (throw 'next t)) + (unless cmd + (insert "BAD FLAG ") + (incf cnt-error) + (throw 'next t)) + (move-marker bos-marker (point)) + (if (re-search-forward "^** Old value[ \t]*$" eos t) + (setq old (buffer-substring + (1+ (match-end 0)) + (progn (outline-next-heading) (point))))) + (if (re-search-forward "^** New value[ \t]*$" eos t) + (setq new (buffer-substring + (1+ (match-end 0)) + (progn (outline-next-heading) + (if (eobp) (org-back-over-empty-lines)) + (point))))) + (setq old (and old (if (string-match "\\S-" old) old nil))) + (setq new (and new (if (string-match "\\S-" new) new nil))) + (if (and note (> (length note) 0)) + ;; Make Note into a single line, to fit into a property + (setq note (mapconcat 'identity + (org-split-string (org-trim note) "\n") + "\\n"))) + (unless (equal data "body") + (setq new (and new (org-trim new)) + old (and old (org-trim old)))) + (goto-char (+ 2 bos-marker)) + ;; Remember this place so that we can return + (move-marker marker (point)) + (setq org-mobile-error nil) + (save-excursion + (condition-case msg + (org-with-point-at id-pos + (progn + (eval cmd) + (unless (member data (list "delete" "archive" "archive-sibling" "addheading")) + (if (member "FLAGGED" (org-get-tags)) + (add-to-list 'org-mobile-last-flagged-files + (buffer-file-name (current-buffer))))))) + (error (setq org-mobile-error msg)))) + (when org-mobile-error + (org-pop-to-buffer-same-window (marker-buffer marker)) + (goto-char marker) + (incf cnt-error) + (insert (if (stringp (nth 1 org-mobile-error)) + (nth 1 org-mobile-error) + "EXECUTION FAILED") + " ") + (throw 'next t)) + ;; If we get here, the action has been applied successfully + ;; So remove the entry + (goto-char bos-marker) + (delete-region (point) (org-end-of-subtree t t))))) (save-buffer) (move-marker marker nil) (move-marker end nil) @@ -988,7 +972,19 @@ is currently a noop.") (if (string-match "\\`id:\\(.*\\)$" link) (org-id-find (match-string 1 link) 'marker) (if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link)) - nil + ; not found with path, but maybe it is to be inserted + ; in top level of the file? + (if (not (string-match "\\`olp:\\(.*?\\)$" link)) + nil + (let ((file (match-string 1 link))) + (setq file (org-link-unescape file)) + (setq file (expand-file-name file org-directory)) + (save-excursion + (find-file file) + (goto-char (point-max)) + (newline) + (goto-char (point-max)) + (move-marker (make-marker) (point))))) (let ((file (match-string 1 link)) (path (match-string 2 link))) (setq file (org-link-unescape file)) @@ -1004,7 +1000,7 @@ The edit only takes place if the current value is equal (except for white space) the OLD. If this is so, OLD will be replace by NEW and the command will return t. If something goes wrong, a string will be returned that indicates what went wrong." - (let (current old1 new1) + (let (current old1 new1 level) (if (stringp what) (setq what (intern what))) (cond @@ -1062,6 +1058,36 @@ be returned that indicates what went wrong." (org-set-tags nil 'align)) (t (error "Heading changed in MobileOrg and on the computer"))))) + ((eq what 'addheading) + (if (org-on-heading-p) ; if false we are in top-level of file + (progn + (end-of-line 1) + (org-insert-heading-respect-content) + (org-demote)) + (beginning-of-line) + (insert "* ")) + (insert new)) + + ((eq what 'refile) + (org-copy-subtree) + (org-with-point-at (org-mobile-locate-entry new) + (if (org-on-heading-p) ; if false we are in top-level of file + (progn + (setq level (org-get-valid-level (funcall outline-level) 1)) + (org-end-of-subtree t t) + (org-paste-subtree level)) + (org-paste-subtree 1))) + (org-cut-subtree)) + + ((eq what 'delete) + (org-cut-subtree)) + + ((eq what 'archive) + (org-archive-subtree)) + + ((eq what 'archive-sibling) + (org-archive-to-archive-sibling)) + ((eq what 'body) (setq current (buffer-substring (min (1+ (point-at-eol)) (point-max)) (save-excursion (outline-next-heading) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index b467064b88..b5a6dad733 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -260,7 +260,7 @@ after the current heading." (interactive) (case (org-mouse-line-position) (:beginning (beginning-of-line) - (org-insert-heading)) + (org-insert-heading)) (t (org-mouse-next-heading) (org-insert-heading)))) @@ -269,10 +269,8 @@ after the current heading." For the acceptable UNITS, see `org-timestamp-change'." (interactive) - (flet ((org-read-date (&rest rest) (current-time))) - (org-time-stamp nil)) - (when shift - (org-timestamp-change shift units))) + (org-time-stamp nil) + (when shift (org-timestamp-change shift units))) (defun org-mouse-keyword-menu (keywords function &optional selected itemformat) "A helper function. @@ -295,19 +293,19 @@ string to (format ITEMFORMAT keyword). If it is neither a string nor a function, elements of KEYWORDS are used directly." (mapcar `(lambda (keyword) - (vector (cond - ((functionp ,itemformat) (funcall ,itemformat keyword)) - ((stringp ,itemformat) (format ,itemformat keyword)) - (t keyword)) - (list 'funcall ,function keyword) - :style (cond - ((null ,selected) t) - ((functionp ,selected) 'toggle) - (t 'radio)) - :selected (if (functionp ,selected) - (and (funcall ,selected keyword) t) - (equal ,selected keyword)))) - keywords)) + (vector (cond + ((functionp ,itemformat) (funcall ,itemformat keyword)) + ((stringp ,itemformat) (format ,itemformat keyword)) + (t keyword)) + (list 'funcall ,function keyword) + :style (cond + ((null ,selected) t) + ((functionp ,selected) 'toggle) + (t 'radio)) + :selected (if (functionp ,selected) + (and (funcall ,selected keyword) t) + (equal ,selected keyword)))) + keywords)) (defun org-mouse-remove-match-and-spaces () "Remove the match, make just one space around the point." @@ -375,8 +373,7 @@ nor a function, elements of KEYWORDS are used directly." (defun org-mouse-set-priority (priority) "Set the priority of the current headline to PRIORITY." - (flet ((read-char-exclusive () priority)) - (org-priority))) + (org-priority priority)) (defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]" "Regular expression matching the priority indicator. @@ -410,8 +407,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (> (match-end 0) point)))))) (defun org-mouse-priority-list () - (loop for priority from ?A to org-lowest-priority - collect (char-to-string priority))) + (loop for priority from ?A to org-lowest-priority + collect (char-to-string priority))) (defun org-mouse-todo-menu (state) "Create the menu with TODO keywords." @@ -464,12 +461,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (defun org-mouse-agenda-type (type) (case type - ('tags "Tags: ") - ('todo "TODO: ") - ('tags-tree "Tags tree: ") - ('todo-tree "TODO tree: ") - ('occur-tree "Occur tree: ") - (t "Agenda command ???"))) + ('tags "Tags: ") + ('todo "TODO: ") + ('tags-tree "Tags tree: ") + ('todo-tree "TODO tree: ") + ('occur-tree "Occur tree: ") + (t "Agenda command ???"))) (defun org-mouse-list-options-menu (alloptions &optional function) (let ((options (save-match-data @@ -488,8 +485,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" " ") nil nil nil 1) (when (functionp ',function) (funcall ',function))) - :style 'toggle - :selected (and (member name options) t))))) + :style 'toggle + :selected (and (member name options) t))))) (defun org-mouse-clip-text (text maxlength) (if (> (length text) maxlength) @@ -532,19 +529,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ,@(org-mouse-keyword-menu (mapcar 'car org-agenda-custom-commands) #'(lambda (key) - (eval `(flet ((read-char-exclusive () (string-to-char ,key))) - (org-agenda nil)))) + (eval `(org-agenda nil (string-to-char ,key)))) nil #'(lambda (key) - (let ((entry (assoc key org-agenda-custom-commands))) - (org-mouse-clip-text - (cond - ((stringp (nth 1 entry)) (nth 1 entry)) - ((stringp (nth 2 entry)) - (concat (org-mouse-agenda-type (nth 1 entry)) - (nth 2 entry))) - (t "Agenda Command '%s'")) - 30)))) + (let ((entry (assoc key org-agenda-custom-commands))) + (org-mouse-clip-text + (cond + ((stringp (nth 1 entry)) (nth 1 entry)) + ((stringp (nth 2 entry)) + (concat (org-mouse-agenda-type (nth 1 entry)) + (nth 2 entry))) + (t "Agenda Command '%s'")) + 30)))) "--" ["Delete Blank Lines" delete-blank-lines :visible (org-mouse-empty-line)] @@ -597,21 +593,21 @@ This means, between the beginning of line and the point." (beginning-of-line)) (defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate) - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (org-mouse-insert-item text) ad-do-it)) (defadvice dnd-open-file (around org-mouse-dnd-open-file activate) - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (org-mouse-insert-item uri) ad-do-it)) (defun org-mouse-match-closure (function) (let ((match (match-data t))) `(lambda (&rest rest) - (save-match-data - (set-match-data ',match) - (apply ',function rest))))) + (save-match-data + (set-match-data ',match) + (apply ',function rest))))) (defun org-mouse-yank-link (click) (interactive "e") @@ -623,234 +619,234 @@ This means, between the beginning of line and the point." (insert-for-yank (concat " [[" (current-kill 0) "]] "))) (defun org-mouse-context-menu (&optional event) - (let ((stamp-prefixes (list org-deadline-string org-scheduled-string)) - (contextlist (org-context))) - (flet ((get-context (context) (org-mouse-get-context contextlist context))) - (cond - ((org-mouse-mark-active) - (let ((region-string (buffer-substring (region-beginning) (region-end)))) + (let* ((stamp-prefixes (list org-deadline-string org-scheduled-string)) + (contextlist (org-context)) + (get-context (lambda (context) (org-mouse-get-context contextlist context)))) + (cond + ((org-mouse-mark-active) + (let ((region-string (buffer-substring (region-beginning) (region-end)))) + (popup-menu + `(nil + ["Sparse Tree" (org-occur ',region-string)] + ["Find in Buffer" (occur ',region-string)] + ["Grep in Current Dir" + (grep (format "grep -rnH -e '%s' *" ',region-string))] + ["Grep in Parent Dir" + (grep (format "grep -rnH -e '%s' ../*" ',region-string))] + "--" + ["Convert to Link" + (progn (save-excursion (goto-char (region-beginning)) (insert "[[")) + (save-excursion (goto-char (region-end)) (insert "]]")))] + ["Insert Link Here" (org-mouse-yank-link ',event)])))) + ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)")) (popup-menu `(nil - ["Sparse Tree" (org-occur ',region-string)] - ["Find in Buffer" (occur ',region-string)] - ["Grep in Current Dir" - (grep (format "grep -rnH -e '%s' *" ',region-string))] - ["Grep in Parent Dir" - (grep (format "grep -rnH -e '%s' ../*" ',region-string))] - "--" - ["Convert to Link" - (progn (save-excursion (goto-char (region-beginning)) (insert "[[")) - (save-excursion (goto-char (region-end)) (insert "]]")))] - ["Insert Link Here" (org-mouse-yank-link ',event)])))) - ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)")) - (popup-menu - `(nil - ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options) - 'org-mode-restart)))) - ((or (eolp) - (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") - (org-looking-back " \\|\t"))) - (org-mouse-popup-global-menu)) - ((get-context :checkbox) - (popup-menu - '(nil - ["Toggle" org-toggle-checkbox t] - ["Remove" org-mouse-remove-match-and-spaces t] - "" - ["All Clear" (org-mouse-for-each-item - (lambda () - (when (save-excursion (org-at-item-checkbox-p)) - (replace-match "[ ]"))))] - ["All Set" (org-mouse-for-each-item + ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options) + 'org-mode-restart)))) + ((or (eolp) + (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") + (org-looking-back " \\|\t"))) + (org-mouse-popup-global-menu)) + ((funcall get-context :checkbox) + (popup-menu + '(nil + ["Toggle" org-toggle-checkbox t] + ["Remove" org-mouse-remove-match-and-spaces t] + "" + ["All Clear" (org-mouse-for-each-item + (lambda () + (when (save-excursion (org-at-item-checkbox-p)) + (replace-match "[ ]"))))] + ["All Set" (org-mouse-for-each-item (lambda () (when (save-excursion (org-at-item-checkbox-p)) (replace-match "[X]"))))] - ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] - ["All Remove" (org-mouse-for-each-item - (lambda () - (when (save-excursion (org-at-item-checkbox-p)) - (org-mouse-remove-match-and-spaces))))] - ))) - ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") - (member (match-string 0) org-todo-keywords-1)) - (popup-menu - `(nil - ,@(org-mouse-todo-menu (match-string 0)) - "--" - ["Check TODOs" org-show-todo-tree t] - ["List all TODO keywords" org-todo-list t] - [,(format "List only %s" (match-string 0)) - (org-todo-list (match-string 0)) t] - ))) - ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z") - (member (match-string 0) stamp-prefixes)) - (popup-menu - `(nil - ,@(org-mouse-keyword-replace-menu stamp-prefixes) - "--" - ["Check Deadlines" org-check-deadlines t] - ))) - ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority - (popup-menu `(nil ,@(org-mouse-keyword-replace-menu - (org-mouse-priority-list) 1 "Priority %s" t)))) - ((get-context :link) - (popup-menu - '(nil - ["Open" org-open-at-point t] - ["Open in Emacs" (org-open-at-point t) t] - "--" - ["Copy link" (org-kill-new (match-string 0))] - ["Cut link" - (progn - (kill-region (match-beginning 0) (match-end 0)) - (just-one-space))] - "--" - ["Grep for TODOs" - (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))] -; ["Paste file link" ((insert "file:") (yank))] - ))) - ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags - (popup-menu - `(nil - [,(format "Display '%s'" (match-string 1)) - (org-tags-view nil ,(match-string 1))] - [,(format "Sparse Tree '%s'" (match-string 1)) - (org-tags-sparse-tree nil ,(match-string 1))] - "--" - ,@(org-mouse-tag-menu)))) - ((org-at-timestamp-p) - (popup-menu - '(nil - ["Show Day" org-open-at-point t] - ["Change Timestamp" org-time-stamp t] - ["Delete Timestamp" (org-mouse-delete-timestamp) t] - ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)] - "--" - ["Set for Today" org-mouse-timestamp-today] - ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)] - ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)] - ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)] - ["Set in a Month" (org-mouse-timestamp-today 1 'month)] - "--" - ["+ 1 Day" (org-timestamp-change 1 'day)] - ["+ 1 Week" (org-timestamp-change 7 'day)] - ["+ 1 Month" (org-timestamp-change 1 'month)] - "--" - ["- 1 Day" (org-timestamp-change -1 'day)] - ["- 1 Week" (org-timestamp-change -7 'day)] - ["- 1 Month" (org-timestamp-change -1 'month)]))) - ((get-context :table-special) - (let ((mdata (match-data))) - (incf (car mdata) 2) - (store-match-data mdata)) - (message "match: %S" (match-string 0)) - (popup-menu `(nil ,@(org-mouse-keyword-replace-menu - '(" " "!" "^" "_" "$" "#" "*" "'") 0 - (lambda (mark) - (case (string-to-char mark) - (? "( ) Nothing Special") - (?! "(!) Column Names") - (?^ "(^) Field Names Above") - (?_ "(^) Field Names Below") - (?$ "($) Formula Parameters") - (?# "(#) Recalculation: Auto") - (?* "(*) Recalculation: Manual") - (?' "(') Recalculation: None"))) t)))) - ((assq :table contextlist) - (popup-menu - '(nil - ["Align Table" org-ctrl-c-ctrl-c] - ["Blank Field" org-table-blank-field] - ["Edit Field" org-table-edit-field] - "--" - ("Column" - ["Move Column Left" org-metaleft] - ["Move Column Right" org-metaright] - ["Delete Column" org-shiftmetaleft] - ["Insert Column" org-shiftmetaright] + ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] + ["All Remove" (org-mouse-for-each-item + (lambda () + (when (save-excursion (org-at-item-checkbox-p)) + (org-mouse-remove-match-and-spaces))))] + ))) + ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") + (member (match-string 0) org-todo-keywords-1)) + (popup-menu + `(nil + ,@(org-mouse-todo-menu (match-string 0)) "--" - ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle]) - ("Row" - ["Move Row Up" org-metaup] - ["Move Row Down" org-metadown] - ["Delete Row" org-shiftmetaup] - ["Insert Row" org-shiftmetadown] - ["Sort lines in region" org-table-sort-lines (org-at-table-p)] + ["Check TODOs" org-show-todo-tree t] + ["List all TODO keywords" org-todo-list t] + [,(format "List only %s" (match-string 0)) + (org-todo-list (match-string 0)) t] + ))) + ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z") + (member (match-string 0) stamp-prefixes)) + (popup-menu + `(nil + ,@(org-mouse-keyword-replace-menu stamp-prefixes) "--" - ["Insert Hline" org-table-insert-hline]) - ("Rectangle" - ["Copy Rectangle" org-copy-special] - ["Cut Rectangle" org-cut-special] - ["Paste Rectangle" org-paste-special] - ["Fill Rectangle" org-table-wrap-region]) - "--" - ["Set Column Formula" org-table-eval-formula] - ["Set Field Formula" (org-table-eval-formula '(4))] - ["Edit Formulas" org-table-edit-formulas] - "--" - ["Recalculate Line" org-table-recalculate] - ["Recalculate All" (org-table-recalculate '(4))] - ["Iterate All" (org-table-recalculate '(16))] - "--" - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks] - ["Sum Column/Rectangle" org-table-sum - :active (or (org-at-table-p) (org-region-active-p))] - ["Field Info" org-table-field-info] - ["Debug Formulas" - (setq org-table-formula-debug (not org-table-formula-debug)) - :style toggle :selected org-table-formula-debug] - ))) - ((and (assq :headline contextlist) (not (eolp))) - (let ((priority (org-mouse-get-priority t))) + ["Check Deadlines" org-check-deadlines t] + ))) + ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority + (popup-menu `(nil ,@(org-mouse-keyword-replace-menu + (org-mouse-priority-list) 1 "Priority %s" t)))) + ((funcall get-context :link) (popup-menu - `("Headline Menu" - ("Tags and Priorities" - ,@(org-mouse-keyword-menu - (org-mouse-priority-list) - #'(lambda (keyword) - (org-mouse-set-priority (string-to-char keyword))) - priority "Priority %s") - "--" - ,@(org-mouse-tag-menu)) - ("TODO Status" - ,@(org-mouse-todo-menu (org-get-todo-state))) - ["Show Tags" - (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) - :visible (not org-mouse-direct)] - ["Show Priority" - (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority)) - :visible (not org-mouse-direct)] - ,@(if org-mouse-direct '("--") nil) - ["New Heading" org-mouse-insert-heading :visible org-mouse-direct] - ["Set Deadline" - (progn (org-mouse-end-headline) (insert " ") (org-deadline)) - :active (not (save-excursion - (org-mouse-re-search-line org-deadline-regexp)))] - ["Schedule Task" - (progn (org-mouse-end-headline) (insert " ") (org-schedule)) - :active (not (save-excursion - (org-mouse-re-search-line org-scheduled-regexp)))] - ["Insert Timestamp" - (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t] -; ["Timestamp (inactive)" org-time-stamp-inactive t] + '(nil + ["Open" org-open-at-point t] + ["Open in Emacs" (org-open-at-point t) t] + "--" + ["Copy link" (org-kill-new (match-string 0))] + ["Cut link" + (progn + (kill-region (match-beginning 0) (match-end 0)) + (just-one-space))] "--" - ["Archive Subtree" org-archive-subtree] - ["Cut Subtree" org-cut-special] - ["Copy Subtree" org-copy-special] - ["Paste Subtree" org-paste-special :visible org-mouse-direct] - ("Sort Children" - ["Alphabetically" (org-sort-entries nil ?a)] - ["Numerically" (org-sort-entries nil ?n)] - ["By Time/Date" (org-sort-entries nil ?t)] + ["Grep for TODOs" + (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))] + ; ["Paste file link" ((insert "file:") (yank))] + ))) + ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags + (popup-menu + `(nil + [,(format "Display '%s'" (match-string 1)) + (org-tags-view nil ,(match-string 1))] + [,(format "Sparse Tree '%s'" (match-string 1)) + (org-tags-sparse-tree nil ,(match-string 1))] + "--" + ,@(org-mouse-tag-menu)))) + ((org-at-timestamp-p) + (popup-menu + '(nil + ["Show Day" org-open-at-point t] + ["Change Timestamp" org-time-stamp t] + ["Delete Timestamp" (org-mouse-delete-timestamp) t] + ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)] + "--" + ["Set for Today" org-mouse-timestamp-today] + ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)] + ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)] + ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)] + ["Set in a Month" (org-mouse-timestamp-today 1 'month)] + "--" + ["+ 1 Day" (org-timestamp-change 1 'day)] + ["+ 1 Week" (org-timestamp-change 7 'day)] + ["+ 1 Month" (org-timestamp-change 1 'month)] + "--" + ["- 1 Day" (org-timestamp-change -1 'day)] + ["- 1 Week" (org-timestamp-change -7 'day)] + ["- 1 Month" (org-timestamp-change -1 'month)]))) + ((funcall get-context :table-special) + (let ((mdata (match-data))) + (incf (car mdata) 2) + (store-match-data mdata)) + (message "match: %S" (match-string 0)) + (popup-menu `(nil ,@(org-mouse-keyword-replace-menu + '(" " "!" "^" "_" "$" "#" "*" "'") 0 + (lambda (mark) + (case (string-to-char mark) + (? "( ) Nothing Special") + (?! "(!) Column Names") + (?^ "(^) Field Names Above") + (?_ "(^) Field Names Below") + (?$ "($) Formula Parameters") + (?# "(#) Recalculation: Auto") + (?* "(*) Recalculation: Manual") + (?' "(') Recalculation: None"))) t)))) + ((assq :table contextlist) + (popup-menu + '(nil + ["Align Table" org-ctrl-c-ctrl-c] + ["Blank Field" org-table-blank-field] + ["Edit Field" org-table-edit-field] + "--" + ("Column" + ["Move Column Left" org-metaleft] + ["Move Column Right" org-metaright] + ["Delete Column" org-shiftmetaleft] + ["Insert Column" org-shiftmetaright] + "--" + ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle]) + ("Row" + ["Move Row Up" org-metaup] + ["Move Row Down" org-metadown] + ["Delete Row" org-shiftmetaup] + ["Insert Row" org-shiftmetadown] + ["Sort lines in region" org-table-sort-lines (org-at-table-p)] "--" - ["Reverse Alphabetically" (org-sort-entries nil ?A)] - ["Reverse Numerically" (org-sort-entries nil ?N)] - ["Reverse By Time/Date" (org-sort-entries nil ?T)]) + ["Insert Hline" org-table-insert-hline]) + ("Rectangle" + ["Copy Rectangle" org-copy-special] + ["Cut Rectangle" org-cut-special] + ["Paste Rectangle" org-paste-special] + ["Fill Rectangle" org-table-wrap-region]) "--" - ["Move Trees" org-mouse-move-tree :active nil] - )))) - (t - (org-mouse-popup-global-menu)))))) + ["Set Column Formula" org-table-eval-formula] + ["Set Field Formula" (org-table-eval-formula '(4))] + ["Edit Formulas" org-table-edit-formulas] + "--" + ["Recalculate Line" org-table-recalculate] + ["Recalculate All" (org-table-recalculate '(4))] + ["Iterate All" (org-table-recalculate '(16))] + "--" + ["Toggle Recalculate Mark" org-table-rotate-recalc-marks] + ["Sum Column/Rectangle" org-table-sum + :active (or (org-at-table-p) (org-region-active-p))] + ["Field Info" org-table-field-info] + ["Debug Formulas" + (setq org-table-formula-debug (not org-table-formula-debug)) + :style toggle :selected org-table-formula-debug] + ))) + ((and (assq :headline contextlist) (not (eolp))) + (let ((priority (org-mouse-get-priority t))) + (popup-menu + `("Headline Menu" + ("Tags and Priorities" + ,@(org-mouse-keyword-menu + (org-mouse-priority-list) + #'(lambda (keyword) + (org-mouse-set-priority (string-to-char keyword))) + priority "Priority %s") + "--" + ,@(org-mouse-tag-menu)) + ("TODO Status" + ,@(org-mouse-todo-menu (org-get-todo-state))) + ["Show Tags" + (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) + :visible (not org-mouse-direct)] + ["Show Priority" + (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority)) + :visible (not org-mouse-direct)] + ,@(if org-mouse-direct '("--") nil) + ["New Heading" org-mouse-insert-heading :visible org-mouse-direct] + ["Set Deadline" + (progn (org-mouse-end-headline) (insert " ") (org-deadline)) + :active (not (save-excursion + (org-mouse-re-search-line org-deadline-regexp)))] + ["Schedule Task" + (progn (org-mouse-end-headline) (insert " ") (org-schedule)) + :active (not (save-excursion + (org-mouse-re-search-line org-scheduled-regexp)))] + ["Insert Timestamp" + (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t] + ; ["Timestamp (inactive)" org-time-stamp-inactive t] + "--" + ["Archive Subtree" org-archive-subtree] + ["Cut Subtree" org-cut-special] + ["Copy Subtree" org-copy-special] + ["Paste Subtree" org-paste-special :visible org-mouse-direct] + ("Sort Children" + ["Alphabetically" (org-sort-entries nil ?a)] + ["Numerically" (org-sort-entries nil ?n)] + ["By Time/Date" (org-sort-entries nil ?t)] + "--" + ["Reverse Alphabetically" (org-sort-entries nil ?A)] + ["Reverse Numerically" (org-sort-entries nil ?N)] + ["Reverse By Time/Date" (org-sort-entries nil ?T)]) + "--" + ["Move Trees" org-mouse-move-tree :active nil] + )))) + (t + (org-mouse-popup-global-menu))))) (defun org-mouse-mark-active () (and mark-active transient-mark-mode)) @@ -868,55 +864,55 @@ This means, between the beginning of line and the point." (mouse-drag-region event))) (add-hook 'org-mode-hook - #'(lambda () - (setq org-mouse-context-menu-function 'org-mouse-context-menu) - - (when (memq 'context-menu org-mouse-features) - (org-defkey org-mouse-map [mouse-3] nil) - (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu)) - (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse) - (when (memq 'context-menu org-mouse-features) - (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) - (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) - (when (memq 'yank-link org-mouse-features) - (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link) - (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) - (when (memq 'move-tree org-mouse-features) - (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) - (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) - - (when (memq 'activate-stars org-mouse-features) - (font-lock-add-keywords - nil - `((,org-outline-regexp - 0 `(face org-link mouse-face highlight keymap ,org-mouse-map) - 'prepend)) - t)) - - (when (memq 'activate-bullets org-mouse-features) - (font-lock-add-keywords - nil - `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +" - (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) - 'prepend))) - t)) - - (when (memq 'activate-checkboxes org-mouse-features) - (font-lock-add-keywords - nil - `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" - (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t))) - t)) - - (defadvice org-open-at-point (around org-mouse-open-at-point activate) - (let ((context (org-context))) - (cond - ((assq :headline-stars context) (org-cycle)) - ((assq :checkbox context) (org-toggle-checkbox)) - ((assq :item-bullet context) - (let ((org-cycle-include-plain-lists t)) (org-cycle))) - ((org-footnote-at-reference-p) nil) - (t ad-do-it)))))) + #'(lambda () + (setq org-mouse-context-menu-function 'org-mouse-context-menu) + + (when (memq 'context-menu org-mouse-features) + (org-defkey org-mouse-map [mouse-3] nil) + (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu)) + (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse) + (when (memq 'context-menu org-mouse-features) + (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) + (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) + (when (memq 'yank-link org-mouse-features) + (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link) + (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) + (when (memq 'move-tree org-mouse-features) + (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) + (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) + + (when (memq 'activate-stars org-mouse-features) + (font-lock-add-keywords + nil + `((,org-outline-regexp + 0 `(face org-link mouse-face highlight keymap ,org-mouse-map) + 'prepend)) + t)) + + (when (memq 'activate-bullets org-mouse-features) + (font-lock-add-keywords + nil + `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +" + (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) + 'prepend))) + t)) + + (when (memq 'activate-checkboxes org-mouse-features) + (font-lock-add-keywords + nil + `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" + (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t))) + t)) + + (defadvice org-open-at-point (around org-mouse-open-at-point activate) + (let ((context (org-context))) + (cond + ((assq :headline-stars context) (org-cycle)) + ((assq :checkbox context) (org-toggle-checkbox)) + ((assq :item-bullet context) + (let ((org-cycle-include-plain-lists t)) (org-cycle))) + ((org-footnote-at-reference-p) nil) + (t ad-do-it)))))) (defun org-mouse-move-tree-start (event) (interactive "e") @@ -936,42 +932,42 @@ This means, between the beginning of line and the point." (sbuf (marker-buffer start)) (ebuf (marker-buffer end))) - (when (and sbuf ebuf) - (set-buffer sbuf) - (goto-char start) - (org-back-to-heading) - (if (and (eq sbuf ebuf) - (equal - (point) - (save-excursion (goto-char end) (org-back-to-heading) (point)))) - ;; if the same line then promote/demote - (if (>= end start) (org-demote-subtree) (org-promote-subtree)) - ;; if different lines then move - (org-cut-subtree) - - (set-buffer ebuf) - (goto-char end) - (org-back-to-heading) - (when (and (eq sbuf ebuf) - (equal - (point) - (save-excursion (goto-char start) - (org-back-to-heading) (point)))) - (outline-end-of-subtree) - (end-of-line) - (if (eobp) (newline) (forward-char))) - - (when (looking-at org-outline-regexp) - (let ((level (- (match-end 0) (match-beginning 0)))) - (when (> end (match-end 0)) + (when (and sbuf ebuf) + (set-buffer sbuf) + (goto-char start) + (org-back-to-heading) + (if (and (eq sbuf ebuf) + (equal + (point) + (save-excursion (goto-char end) (org-back-to-heading) (point)))) + ;; if the same line then promote/demote + (if (>= end start) (org-demote-subtree) (org-promote-subtree)) + ;; if different lines then move + (org-cut-subtree) + + (set-buffer ebuf) + (goto-char end) + (org-back-to-heading) + (when (and (eq sbuf ebuf) + (equal + (point) + (save-excursion (goto-char start) + (org-back-to-heading) (point)))) (outline-end-of-subtree) (end-of-line) - (if (eobp) (newline) (forward-char)) - (setq level (1+ level))) - (org-paste-subtree level) - (save-excursion - (outline-end-of-subtree) - (when (bolp) (delete-char -1)))))))))) + (if (eobp) (newline) (forward-char))) + + (when (looking-at org-outline-regexp) + (let ((level (- (match-end 0) (match-beginning 0)))) + (when (> end (match-end 0)) + (outline-end-of-subtree) + (end-of-line) + (if (eobp) (newline) (forward-char)) + (setq level (1+ level))) + (org-paste-subtree level) + (save-excursion + (outline-end-of-subtree) + (when (bolp) (delete-char -1)))))))))) (defun org-mouse-transform-to-outline () @@ -994,7 +990,7 @@ This means, between the beginning of line and the point." (defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'. (defun org-mouse-do-remotely (command) -; (org-agenda-check-no-diary) + ; (org-agenda-check-no-diary) (when (get-text-property (point) 'org-marker) (let* ((anticol (- (point-at-eol) (point))) (marker (get-text-property (point) 'org-marker)) @@ -1091,20 +1087,20 @@ This means, between the beginning of line and the point." (if (< (car startxy) (car endxy)) :right :left))) -; (setq org-agenda-mode-hook nil) + ; (setq org-agenda-mode-hook nil) (defvar org-agenda-mode-map) (add-hook 'org-agenda-mode-hook - #'(lambda () - (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) - (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) - (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) - (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) - (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) - (org-defkey org-agenda-mode-map [drag-mouse-3] - #'(lambda (event) (interactive "e") - (case (org-mouse-get-gesture event) - (:left (org-agenda-earlier 1)) - (:right (org-agenda-later 1))))))) + #'(lambda () + (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) + (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) + (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) + (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) + (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) + (org-defkey org-agenda-mode-map [drag-mouse-3] + #'(lambda (event) (interactive "e") + (case (org-mouse-get-gesture event) + (:left (org-agenda-earlier 1)) + (:right (org-agenda-later 1))))))) (provide 'org-mouse) diff --git a/lisp/org/org-odt.el b/lisp/org/org-odt.el index ca43d05bdb..7de4b5de85 100644 --- a/lisp/org/org-odt.el +++ b/lisp/org/org-odt.el @@ -100,9 +100,7 @@ Use this to infer values of `org-odt-styles-dir' and (expand-file-name "./schema/" org-odt-data-dir)) ; bail out (eval-when-compile (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install - (expand-file-name "./schema/" org-odt-data-dir))) - (expand-file-name "../contrib/odt/etc/schema/" org-odt-lib-dir) ; git - ) + (expand-file-name "./schema/" org-odt-data-dir)))) "List of directories to search for OpenDocument schema files. Use this list to set the default value of `org-export-odt-schema-dir'. The entries in this list are @@ -213,7 +211,7 @@ heuristically based on the values of `org-odt-lib-dir' and org-odt-styles-dir-list) nil))) (unless styles-dir - (error "Error (org-odt): Cannot find factory styles files. Aborting.")) + (error "Error (org-odt): Cannot find factory styles files, aborting")) styles-dir) "Directory that holds auxiliary XML files used by the ODT exporter. @@ -245,9 +243,6 @@ standard Emacs.") (mapc (lambda (desc) - ;; Let Org open all OpenDocument files using system-registered app - (add-to-list 'org-file-apps - (cons (concat "\\." (car desc) "\\'") 'system)) ;; Let Emacs open all OpenDocument files in archive mode (add-to-list 'auto-mode-alist (cons (concat "\\." (car desc) "\\'") 'archive-mode))) @@ -285,7 +280,7 @@ Valid values are one of: 4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2 ...)) -In case of option 1, an in-built styles.xml is used. See +In case of option 1, an in-built styles.xml is used. See `org-odt-styles-dir' for more information. In case of option 3, the specified file is unzipped and the @@ -326,6 +321,8 @@ a per-file basis. For example, (defconst org-export-odt-tmpdir-prefix "%s-") (defconst org-export-odt-bookmark-prefix "OrgXref.") +(defvar org-odt-zip-dir nil + "Temporary directory that holds XML files during export.") (defvar org-export-odt-embed-images t "Should the images be copied in to the odt file or just linked?") @@ -382,7 +379,8 @@ This variable is effective only if (table . "Table") (definition-term . "Text_20_body_20_bold") (horizontal-line . "Horizontal_20_Line"))) - (character . ((bold . "Bold") + (character . ((default . "Default") + (bold . "Bold") (emphasis . "Emphasis") (code . "OrgCode") (verbatim . "OrgCode") @@ -413,7 +411,10 @@ Interactive commands `org-export-as-odt' and then use `org-export-odt-convert-process' to convert the resulting document to this format. During customization of this variable, the list of valid values are populated based on -`org-export-odt-convert-capabilities'." +`org-export-odt-convert-capabilities'. + +You can set this option on per-file basis using file local +values. See Info node `(emacs) File Variables'." :group 'org-export-odt :version "24.1" :type '(choice :convert-widget @@ -424,6 +425,35 @@ variable, the list of valid values are populated based on ,@(mapcar (lambda (c) `(const :tag ,c ,c)) (org-lparse-reachable-formats "odt"))))) +;;;###autoload +(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp) + +(defmacro org-odt-cleanup-xml-buffers (&rest body) + `(let ((org-odt-zip-dir + (make-temp-file + (format org-export-odt-tmpdir-prefix "odf") t)) + (--cleanup-xml-buffers + (function + (lambda nil + (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" + "meta.xml" "styles.xml"))) + ;; kill all xml buffers + (mapc (lambda (file) + (let ((buf (find-file-noselect + (expand-file-name file org-odt-zip-dir) t))) + (when (buffer-name buf) + (set-buffer-modified-p nil) + (kill-buffer buf)))) + xml-files)) + ;; delete temporary directory. + (delete-directory org-odt-zip-dir t))))) + (org-condition-case-unless-debug err + (prog1 (progn ,@body) + (funcall --cleanup-xml-buffers)) + ((quit error) + (funcall --cleanup-xml-buffers) + (message "OpenDocument export failed: %s" + (error-message-string err)))))) ;;;###autoload (defun org-export-as-odt-and-open (arg) @@ -432,8 +462,9 @@ If there is an active region, export only the region. The prefix ARG specifies how many levels of the outline should become headlines. The default is 3. Lower levels will become bulleted lists." (interactive "P") - (org-lparse-and-open - (or org-export-odt-preferred-output-format "odt") "odt" arg)) + (org-odt-cleanup-xml-buffers + (org-lparse-and-open + (or org-export-odt-preferred-output-format "odt") "odt" arg))) ;;;###autoload (defun org-export-as-odt-batch () @@ -464,8 +495,9 @@ the file header and footer, simply return the content of <body>...</body>, without even the body tags themselves. When PUB-DIR is set, use this as the publishing directory." (interactive "P") - (org-lparse (or org-export-odt-preferred-output-format "odt") - "odt" arg hidden ext-plist to-buffer body-only pub-dir)) + (org-odt-cleanup-xml-buffers + (org-lparse (or org-export-odt-preferred-output-format "odt") + "odt" arg hidden ext-plist to-buffer body-only pub-dir))) (defvar org-odt-entity-control-callbacks-alist `((EXPORT @@ -539,7 +571,7 @@ PUB-DIR is set, use this as the publishing directory." (delete-region (match-beginning 0) (point-max))) ;; Following variable is let bound when `org-do-lparse' is in -;; progress. See org-html.el. +;; progress. See org-html.el. (defvar org-lparse-toc) (defun org-odt-format-toc () (if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n"))) @@ -810,7 +842,7 @@ PUB-DIR is set, use this as the publishing directory." (org-lparse-begin-list-item list-type))) ;; Following variables are let bound when table emission is in -;; progress. See org-lparse.el. +;; progress. See org-lparse.el. (defvar org-lparse-table-begin-marker) (defvar org-lparse-table-ncols) (defvar org-lparse-table-rowgrp-open) @@ -944,7 +976,7 @@ Use `org-odt-add-automatic-style' to add update this variable.'") (defvar org-odt-object-counters nil "Running counters for various OBJECT-TYPEs. -Use this to generate automatic names and style-names. See +Use this to generate automatic names and style-names. See `org-odt-add-automatic-style'.") (defun org-odt-write-automatic-styles () @@ -987,7 +1019,7 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME (cons object-name style-name))) (defvar org-odt-table-indentedp nil) -(defun org-odt-begin-table (caption label attributes) +(defun org-odt-begin-table (caption label attributes short-caption) (setq org-odt-table-indentedp (not (null org-lparse-list-stack))) (when org-odt-table-indentedp ;; Within the Org file, the table is appearing within a list item. @@ -1006,11 +1038,12 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME (insert (org-odt-format-stylized-paragraph 'table (org-odt-format-entity-caption label caption "__Table__")))) - (let ((name-and-style (org-odt-add-automatic-style "Table" attributes))) + (let ((automatic-name (org-odt-add-automatic-style "Table" attributes))) (org-lparse-insert-tag "<table:table table:name=\"%s\" table:style-name=\"%s\">" - (car name-and-style) (or (nth 1 org-odt-table-style-spec) - (cdr name-and-style) "OrgTable"))) + (or short-caption (car automatic-name)) + (or (nth 1 org-odt-table-style-spec) + (cdr automatic-name) "OrgTable"))) (setq org-lparse-table-begin-marker (point))) (defvar org-lparse-table-colalign-info) @@ -1097,7 +1130,7 @@ styles congruent with the ODF-1.2 specification." ;; Additional Note: LibreOffice's AutoFormat facility for tables - ;; which recognizes as many as 16 different cell types - is much - ;; richer. Unfortunately it is NOT amenable to easy configuration + ;; richer. Unfortunately it is NOT amenable to easy configuration ;; by hand. (let* ((template-name (nth 1 style-spec)) @@ -1247,7 +1280,7 @@ styles congruent with the ODF-1.2 specification." (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1)))) (insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n"))) -;; Following variable is let bound during 'ORG-LINK callback. See +;; Following variable is let bound during 'ORG-LINK callback. See ;; org-html.el (defvar org-lparse-link-description-is-image nil) (defun org-odt-format-link (desc href &optional attr) @@ -1443,7 +1476,7 @@ is turned on." (" " "<text:s/>") (" " "<text:tab/>"))) (hfy-face-to-css 'org-odt-hfy-face-to-css) - (hfy-optimisations-1 (copy-seq hfy-optimisations)) + (hfy-optimisations-1 (copy-sequence hfy-optimisations)) (hfy-optimisations (add-to-list 'hfy-optimisations-1 'body-text-only)) (hfy-begin-span-handler @@ -1552,7 +1585,12 @@ See `org-odt-add-label-definition' and (defun org-export-odt-format-formula (src href) (save-match-data (let* ((caption (org-find-text-property-in-string 'org-caption src)) + (short-caption + (or (org-find-text-property-in-string 'org-caption-shortn src) + caption)) (caption (and caption (org-xml-format-desc caption))) + (short-caption (and short-caption + (org-xml-encode-plain-text short-caption))) (label (org-find-text-property-in-string 'org-label src)) (latex-frag (org-find-text-property-in-string 'org-latex-src src)) (embed-as (or (and latex-frag @@ -1572,7 +1610,8 @@ See `org-odt-add-label-definition' and `((,(org-odt-format-entity (if (not (or caption label)) "DisplayFormula" "CaptionedDisplayFormula") - href width height :caption caption :label label) + href width height :caption caption :label label + :short-caption short-caption) ,(if (not (or caption label)) "" (let* ((label-props (car org-odt-entity-labels-alist))) (setcar (last label-props) "math-label") @@ -1732,7 +1771,7 @@ ATTR is a string of other attributes of the a element." (concat (org-lparse-format 'EXTRA-TARGETS extra-targets) - ;; No need to generate section numbers. They are auto-generated by + ;; No need to generate section numbers. They are auto-generated by ;; the application ;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ") @@ -1799,7 +1838,12 @@ ATTR is a string of other attributes of the a element." "Create image tag with source and attributes." (save-match-data (let* ((caption (org-find-text-property-in-string 'org-caption src)) + (short-caption + (or (org-find-text-property-in-string 'org-caption-shortn src) + caption)) (caption (and caption (org-xml-format-desc caption))) + (short-caption (and short-caption + (org-xml-encode-plain-text short-caption))) (attr (org-find-text-property-in-string 'org-attributes src)) (label (org-find-text-property-in-string 'org-label src)) (latex-frag (org-find-text-property-in-string @@ -1837,6 +1881,7 @@ ATTR is a string of other attributes of the a element." (org-odt-format-entity frame-style-handle href width height :caption caption :label label :category category + :short-caption short-caption :user-frame-params user-frame-params))))) (defun org-odt-format-object-description (title description) @@ -1915,7 +1960,7 @@ ATTR is a string of other attributes of the a element." (defun* org-odt-format-entity (entity href width height &key caption label category - user-frame-params) + user-frame-params short-caption) (let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t)) default-frame-params frame-params) (cond @@ -1933,7 +1978,16 @@ ATTR is a string of other attributes of the a element." 'illustration (concat (apply 'org-odt-format-frame href width height - (nth 2 entity-style)) + (let ((entity-style-1 (copy-sequence + (nth 2 entity-style)))) + (setcar (cdr entity-style-1) + (concat + (cadr entity-style-1) + (and short-caption + (format " draw:name=\"%s\" " + short-caption)))) + + entity-style-1)) (org-odt-format-entity-caption label caption (or category (nth 1 entity-style))))) width height frame-params))))) @@ -1973,37 +2027,43 @@ ATTR is a string of other attributes of the a element." methods.") ;; A4 page size is 21.0 by 29.7 cms -;; The default page settings has 2cm margin on each of the sides. So +;; The default page settings has 2cm margin on each of the sides. So ;; the effective text area is 17.0 by 25.7 cm (defvar org-export-odt-max-image-size '(17.0 . 20.0) "Limiting dimensions for an embedded image.") (defun org-odt-do-image-size (probe-method file &optional dpi anchor-type) - (setq dpi (or dpi org-export-odt-pixels-per-inch)) - (setq anchor-type (or anchor-type "paragraph")) - (flet ((size-in-cms (size-in-pixels) - (flet ((pixels-to-cms (pixels) - (let* ((cms-per-inch 2.54) - (inches (/ pixels dpi))) - (* cms-per-inch inches)))) - (and size-in-pixels - (cons (pixels-to-cms (car size-in-pixels)) - (pixels-to-cms (cdr size-in-pixels))))))) + (let* ((dpi (or dpi org-export-odt-pixels-per-inch)) + (anchor-type (or anchor-type "paragraph")) + (--pixels-to-cms + (function + (lambda (pixels dpi) + (let* ((cms-per-inch 2.54) + (inches (/ pixels dpi))) + (* cms-per-inch inches))))) + (--size-in-cms + (function + (lambda (size-in-pixels dpi) + (and size-in-pixels + (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) + (funcall --pixels-to-cms (cdr size-in-pixels) dpi))))))) (case probe-method (emacs - (size-in-cms (ignore-errors ; Emacs could be in batch mode - (clear-image-cache) - (image-size (create-image file) 'pixels)))) + (let ((size-in-pixels + (ignore-errors ; Emacs could be in batch mode + (clear-image-cache) + (image-size (create-image file) 'pixels)))) + (funcall --size-in-cms size-in-pixels dpi))) (imagemagick - (size-in-cms - (let ((dim (shell-command-to-string - (format "identify -format \"%%w:%%h\" \"%s\"" file)))) - (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) - (cons (string-to-number (match-string 1 dim)) - (string-to-number (match-string 2 dim))))))) - (t - (cdr (assoc-string anchor-type - org-export-odt-default-image-sizes-alist)))))) + (let ((size-in-pixels + (let ((dim (shell-command-to-string + (format "identify -format \"%%w:%%h\" \"%s\"" file)))) + (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) + (cons (string-to-number (match-string 1 dim)) + (string-to-number (match-string 2 dim))))))) + (funcall --size-in-cms size-in-pixels dpi))) + (t (cdr (assoc-string anchor-type + org-export-odt-default-image-sizes-alist)))))) (defun org-odt-image-size-from-file (file &optional user-width user-height scale dpi embed-as) @@ -2016,7 +2076,7 @@ ATTR is a string of other attributes of the a element." until size do (setq size (org-odt-do-image-size probe-method file dpi embed-as))) - (or size (error "Cannot determine Image size. Aborting ...")) + (or size (error "Cannot determine image size, aborting")) (setq width (car size) height (cdr size))) (cond (scale @@ -2206,10 +2266,7 @@ captions on export.") ;; Not at all OSes ship with zip by default (error "Executable \"zip\" needed for creating OpenDocument files")) - (let* ((outdir (make-temp-file - (format org-export-odt-tmpdir-prefix org-lparse-backend) t)) - (content-file (expand-file-name "content.xml" outdir))) - + (let* ((content-file (expand-file-name "content.xml" org-odt-zip-dir))) ;; init conten.xml (require 'nxml-mode) (let ((nxml-auto-insert-xml-declaration-flag nil)) @@ -2259,11 +2316,9 @@ visually." (org-odt-write-manifest-file) (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" - "meta.xml")) - (zipdir default-directory)) + "meta.xml"))) (when (equal org-lparse-backend 'odt) (push "styles.xml" xml-files)) - (message "Switching to directory %s" (expand-file-name zipdir)) ;; save all xml files (mapc (lambda (file) @@ -2299,15 +2354,8 @@ visually." cmds)) ;; move the file from outdir to target-dir - (rename-file target-name target-dir) - - ;; kill all xml buffers - (mapc (lambda (file) - (kill-buffer - (find-file-noselect (expand-file-name file zipdir) t))) - xml-files) + (rename-file target-name target-dir))) - (delete-directory zipdir))) (message "Created %s" target) (set-buffer (find-file-noselect target t))) @@ -2366,7 +2414,8 @@ visually." (org-odt-format-tags '("\n<meta:generator>" . "</meta:generator>") (when org-export-creator-info (format "Org-%s/Emacs-%s" - org-version emacs-version))) + (org-version) + emacs-version))) (org-odt-format-tags '("\n<meta:keyword>" . "</meta:keyword>") keywords) (org-odt-format-tags '("\n<dc:subject>" . "</dc:subject>") description) (org-odt-format-tags '("\n<dc:title>" . "</dc:title>") title) @@ -2386,12 +2435,12 @@ visually." ;; Update styles.xml - take care of outline numbering (with-current-buffer (find-file-noselect (expand-file-name "styles.xml") t) - ;; Don't make automatic backup of styles.xml file. This setting + ;; Don't make automatic backup of styles.xml file. This setting ;; prevents the backed-up styles.xml file from being zipped in to - ;; odt file. This is more of a hackish fix. Better alternative + ;; odt file. This is more of a hackish fix. Better alternative ;; would be to fix the zip command so that the output odt file ;; includes only the needed files and excludes any auto-generated - ;; extra files like backups and auto-saves etc etc. Note that + ;; extra files like backups and auto-saves etc etc. Note that ;; currently the zip command zips up the entire temp directory so ;; that any auto-generated files created under the hood ends up in ;; the resulting odt file. @@ -2609,7 +2658,7 @@ using `org-open-file'." cache-dir display-msg) (cond ((eq latex-frag-opt 'dvipng) - (setq cache-dir "ltxpng/") + (setq cache-dir org-latex-preview-ltxpng-directory) (setq display-msg "Creating LaTeX image %s")) ((member latex-frag-opt '(mathjax t)) (setq latex-frag-opt 'mathml) @@ -2657,7 +2706,7 @@ Do this when translation to MathML fails." "" (org-add-props label '(org-protected t)))) t t))))) ;; process latex fragments as part of -;; `org-export-preprocess-after-blockquote-hook'. Note that this hook +;; `org-export-preprocess-after-blockquote-hook'. Note that this hook ;; is the one that is closest and well before the call to ;; `org-export-attach-captions-and-attributes' in ;; `org-export-preprocess-string'. The above arrangement permits @@ -2692,7 +2741,7 @@ Do this when translation to MathML fails." members)) (defun org-odt-copy-styles-file (&optional styles-file) - ;; Non-availability of styles.xml is not a critical error. For now + ;; Non-availability of styles.xml is not a critical error. For now ;; throw an error purely for aesthetic reasons. (setq styles-file (or styles-file org-export-odt-styles-file @@ -2749,7 +2798,7 @@ MathML source to kill ring, if `org-export-copy-to-kill-ring' is non-nil." (interactive `(,(let (frag) - (setq frag (and (setq frag (and (region-active-p) + (setq frag (and (setq frag (and (org-region-active-p) (buffer-substring (region-beginning) (region-end)))) (loop for e in org-latex-regexps @@ -2764,27 +2813,28 @@ non-nil." (file-name-directory buffer-file-name)))) (read-file-name "ODF filename: " nil odf-filename nil (file-name-nondirectory odf-filename))))) - (let* ((org-lparse-backend 'odf) - org-lparse-opt-plist - (filename (or odf-file - (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name)))) - (buffer (find-file-noselect (org-odt-init-outfile filename))) - (coding-system-for-write 'utf-8) - (save-buffer-coding-system 'utf-8)) - (set-buffer buffer) - (set-buffer-file-coding-system coding-system-for-write) - (let ((mathml (org-create-math-formula latex-frag))) - (unless mathml (error "No Math formula created")) - (insert mathml) - (or (org-export-push-to-kill-ring - (upcase (symbol-name org-lparse-backend))) - (message "Exporting... done"))) - (org-odt-save-as-outfile filename nil))) + (org-odt-cleanup-xml-buffers + (let* ((org-lparse-backend 'odf) + org-lparse-opt-plist + (filename (or odf-file + (expand-file-name + (concat + (file-name-sans-extension + (or (file-name-nondirectory buffer-file-name))) + "." "odf") + (file-name-directory buffer-file-name)))) + (buffer (find-file-noselect (org-odt-init-outfile filename))) + (coding-system-for-write 'utf-8) + (save-buffer-coding-system 'utf-8)) + (set-buffer buffer) + (set-buffer-file-coding-system coding-system-for-write) + (let ((mathml (org-create-math-formula latex-frag))) + (unless mathml (error "No Math formula created")) + (insert mathml) + (or (org-export-push-to-kill-ring + (upcase (symbol-name org-lparse-backend))) + (message "Exporting... done"))) + (org-odt-save-as-outfile filename nil)))) ;;;###autoload (defun org-export-as-odf-and-open () diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index 5950d8e26d..6467840992 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -31,6 +31,7 @@ (require 'cl)) (require 'org-macs) +(require 'org-compat) (require 'pcomplete) (declare-function org-split-string "org" (string &optional separators)) @@ -50,14 +51,17 @@ :tag "Org" :group 'org) +(defvar org-drawer-regexp) +(defvar org-property-re) + (defun org-thing-at-point () "Examine the thing at point and let the caller know what it is. The return value is a string naming the thing at point." (let ((beg1 (save-excursion - (skip-chars-backward (org-re "[:alnum:]_@")) + (skip-chars-backward (org-re "[:alnum:]-_@")) (point))) (beg (save-excursion - (skip-chars-backward "a-zA-Z0-9_:$") + (skip-chars-backward "a-zA-Z0-9-_:$") (point))) (line-to-here (buffer-substring (point-at-bol) (point)))) (cond @@ -84,8 +88,18 @@ The return value is a string naming the thing at point." (equal (char-after (point-at-bol)) ?*)) (cons "tag" nil)) ((and (equal (char-before beg1) ?:) - (not (equal (char-after (point-at-bol)) ?*))) + (not (equal (char-after (point-at-bol)) ?*)) + (save-excursion + (move-beginning-of-line 1) + (skip-chars-backward "[ \t\n]") + ;; org-drawer-regexp matches a whole line but while + ;; looking-back, we just ignore trailing whitespaces + (or (org-looking-back (substring org-drawer-regexp 0 -1)) + (org-looking-back org-property-re)))) (cons "prop" nil)) + ((and (equal (char-before beg1) ?:) + (not (equal (char-after (point-at-bol)) ?*))) + (cons "drawer" nil)) (t nil)))) (defun org-command-at-point () @@ -119,7 +133,6 @@ When completing for #+STARTUP, for example, this function returns args))) (cons (reverse args) (reverse begins)))))) - (defun org-pcomplete-initial () "Calls the right completion function for first argument completions." (ignore @@ -127,7 +140,8 @@ When completing for #+STARTUP, for example, this function returns (car (org-thing-at-point))) pcomplete-default-completion-function)))) -(defvar org-additional-option-like-keywords) +(defvar org-options-keywords) ; From org.el +(defvar org-additional-option-like-keywords) ; From org.el (defun pcomplete/org-mode/file-option () "Complete against all valid file options." (require 'org-exp) @@ -137,14 +151,8 @@ When completing for #+STARTUP, for example, this function returns (if (= ?: (aref x (1- (length x)))) (concat x " ") x)) - (delq nil - (pcomplete-uniqify-list - (append - (mapcar (lambda (x) - (if (string-match "^#\\+\\([A-Z_]+:?\\)" x) - (match-string 1 x))) - (org-split-string (org-get-current-options) "\n")) - (copy-sequence org-additional-option-like-keywords)))))) + (append org-options-keywords + org-additional-option-like-keywords))) (substring pcomplete-stub 2))) (defvar org-startup-options) @@ -161,8 +169,40 @@ When completing for #+STARTUP, for example, this function returns (setq opts (delete "showstars" opts))))) opts)))) +(defmacro pcomplete/org-mode/file-option/x (option) + "Complete arguments for OPTION." + `(while + (pcomplete-here + (pcomplete-uniqify-list + (delq nil + (mapcar (lambda(o) + (when (string-match (concat "^[ \t]*#\\+" + ,option ":[ \t]+\\(.*\\)[ \t]*$") o) + (match-string 1 o))) + (split-string (org-get-current-options) "\n"))))))) + +(defun pcomplete/org-mode/file-option/options () + "Complete arguments for the #+OPTIONS file option." + (pcomplete/org-mode/file-option/x "OPTIONS")) + +(defun pcomplete/org-mode/file-option/title () + "Complete arguments for the #+TITLE file option." + (pcomplete/org-mode/file-option/x "TITLE")) + +(defun pcomplete/org-mode/file-option/author () + "Complete arguments for the #+AUTHOR file option." + (pcomplete/org-mode/file-option/x "AUTHOR")) + +(defun pcomplete/org-mode/file-option/email () + "Complete arguments for the #+EMAIL file option." + (pcomplete/org-mode/file-option/x "EMAIL")) + +(defun pcomplete/org-mode/file-option/date () + "Complete arguments for the #+DATE file option." + (pcomplete/org-mode/file-option/x "DATE")) + (defun pcomplete/org-mode/file-option/bind () - "Complete arguments for the #+BIND file option, which are variable names" + "Complete arguments for the #+BIND file option, which are variable names." (let (vars) (mapatoms (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars))))) @@ -196,16 +236,16 @@ When completing for #+STARTUP, for example, this function returns "Complete against all headings. This needs more work, to handle headings with lots of spaces in them." (while - (pcomplete-here - (save-excursion - (goto-char (point-min)) - (let (tbl) - (while (re-search-forward org-todo-line-regexp nil t) - (push (org-make-org-heading-search-string - (match-string-no-properties 3) t) - tbl)) - (pcomplete-uniqify-list tbl))) - (substring pcomplete-stub 1)))) + (pcomplete-here + (save-excursion + (goto-char (point-min)) + (let (tbl) + (while (re-search-forward org-todo-line-regexp nil t) + (push (org-make-org-heading-search-string + (match-string-no-properties 3) t) + tbl)) + (pcomplete-uniqify-list tbl))) + (substring pcomplete-stub 1)))) (defvar org-tag-alist) (defun pcomplete/org-mode/tag () @@ -239,6 +279,25 @@ This needs more work, to handle headings with lots of spaces in them." lst)) (substring pcomplete-stub 1))) +(defvar org-drawers) + +(defun pcomplete/org-mode/drawer () + "Complete a drawer name." + (let ((spc (save-excursion + (move-beginning-of-line 1) + (looking-at "^\\([ \t]*\\):") + (match-string 1))) + (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers))) + (pcomplete-here cpllist + (substring pcomplete-stub 1) + (unless (or (not (delete + nil + (mapcar (lambda(x) + (string-match (substring pcomplete-stub 1) x)) + cpllist))) + (looking-at "[ \t]*\n.*:END:")) + (save-excursion (insert "\n" spc ":END:")))))) + (defun pcomplete/org-mode/block-option/src () "Complete the arguments of a begin_src block. Complete a language in the first field, the header arguments and switches." @@ -256,7 +315,7 @@ Complete a language in the first field, the header arguments and switches." ":session" ":shebang" ":tangle" ":var")))) (defun pcomplete/org-mode/block-option/clocktable () - "Complete keywords in a clocktable line" + "Complete keywords in a clocktable line." (while (pcomplete-here '(":maxlevel" ":scope" ":tstart" ":tend" ":block" ":step" ":stepskip0" ":fileskip0" diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index f44694fa78..48d72ac281 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -144,7 +144,8 @@ and dependant variables." (dotimes (col (length (first table))) (setf collector (cons col collector))) collector))) - row-vals (counter 0)) + (counter 0) + row-vals) (when (>= ind 0) ;; collect values of ind col (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter)) (cons counter (nth ind row))) table))) @@ -159,26 +160,26 @@ and dependant variables." ;; write table to gnuplot grid datafile format (with-temp-file data-file (let ((num-rows (length table)) (num-cols (length (first table))) + (gnuplot-row (lambda (col row value) + (setf col (+ 1 col)) (setf row (+ 1 row)) + (format "%f %f %f\n%f %f %f\n" + col (- row 0.5) value ;; lower edge + col (+ row 0.5) value))) ;; upper edge front-edge back-edge) - (flet ((gnuplot-row (col row value) - (setf col (+ 1 col)) (setf row (+ 1 row)) - (format "%f %f %f\n%f %f %f\n" - col (- row 0.5) value ;; lower edge - col (+ row 0.5) value))) ;; upper edge - (dotimes (col num-cols) - (dotimes (row num-rows) - (setf back-edge - (concat back-edge - (gnuplot-row (- col 1) row (string-to-number - (nth col (nth row table)))))) - (setf front-edge - (concat front-edge - (gnuplot-row col row (string-to-number - (nth col (nth row table))))))) - ;; only insert once per row - (insert back-edge) (insert "\n") ;; back edge - (insert front-edge) (insert "\n") ;; front edge - (setf back-edge "") (setf front-edge ""))))) + (dotimes (col num-cols) + (dotimes (row num-rows) + (setf back-edge + (concat back-edge + (funcall gnuplot-row (- col 1) row + (string-to-number (nth col (nth row table)))))) + (setf front-edge + (concat front-edge + (funcall gnuplot-row col row + (string-to-number (nth col (nth row table))))))) + ;; only insert once per row + (insert back-edge) (insert "\n") ;; back edge + (insert front-edge) (insert "\n") ;; front edge + (setf back-edge "") (setf front-edge "")))) row-vals)) (defun org-plot/gnuplot-script (data-file num-cols params &optional preface) @@ -208,40 +209,41 @@ manner suitable for prepending to a user-specified script." ('2d "plot") ('3d "splot") ('grid "splot"))) - (script "reset") plot-lines) - (flet ((add-to-script (line) (setf script (format "%s\n%s" script line)))) - (when file ;; output file - (add-to-script (format "set term %s" (file-name-extension file))) - (add-to-script (format "set output '%s'" file))) - (case type ;; type - ('2d ()) - ('3d (if map (add-to-script "set map"))) - ('grid (if map - (add-to-script "set pm3d map") - (add-to-script "set pm3d")))) - (when title (add-to-script (format "set title '%s'" title))) ;; title - (when lines (mapc (lambda (el) (add-to-script el)) lines)) ;; line - (when sets ;; set - (mapc (lambda (el) (add-to-script (format "set %s" el))) sets)) - (when x-labels ;; x labels (xtics) - (add-to-script - (format "set xtics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) - x-labels ", ")))) - (when y-labels ;; y labels (ytics) - (add-to-script - (format "set ytics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) - y-labels ", ")))) - (when time-ind ;; timestamp index - (add-to-script "set xdata time") - (add-to-script (concat "set timefmt \"" - (or timefmt ;; timefmt passed to gnuplot - "%Y-%m-%d-%H:%M:%S") "\""))) - (unless preface - (case type ;; plot command + (script "reset") + ; ats = add-to-script + (ats (lambda (line) (setf script (format "%s\n%s" script line)))) + plot-lines) + (when file ;; output file + (funcall ats (format "set term %s" (file-name-extension file))) + (funcall ats (format "set output '%s'" file))) + (case type ;; type + ('2d ()) + ('3d (if map (funcall ats "set map"))) + ('grid (if map (funcall ats "set pm3d map") + (funcall ats "set pm3d")))) + (when title (funcall ats (format "set title '%s'" title))) ;; title + (when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line + (when sets ;; set + (mapc (lambda (el) (funcall ats (format "set %s" el))) sets)) + (when x-labels ;; x labels (xtics) + (funcall ats + (format "set xtics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + x-labels ", ")))) + (when y-labels ;; y labels (ytics) + (funcall ats + (format "set ytics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + y-labels ", ")))) + (when time-ind ;; timestamp index + (funcall ats "set xdata time") + (funcall ats (concat "set timefmt \"" + (or timefmt ;; timefmt passed to gnuplot + "%Y-%m-%d-%H:%M:%S") "\""))) + (unless preface + (case type ;; plot command ('2d (dotimes (col num-cols) (unless (and (equal type '2d) (or (and ind (equal (+ 1 col) ind)) @@ -263,9 +265,9 @@ manner suitable for prepending to a user-specified script." ('grid (setq plot-lines (list (format "'%s' with %s title ''" data-file with))))) - (add-to-script - (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n ")))) - script))) + (funcall ats + (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n ")))) + script)) ;;----------------------------------------------------------------------------- ;; facade functions diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 74fc35f2db..31f6fb2671 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -187,7 +187,7 @@ Each element of this list must be of the form: (module-name :property value property: value ...) -where module-name is an arbitrary name. All the values are strings. +where module-name is an arbitrary name. All the values are strings. Possible properties are: @@ -195,7 +195,7 @@ Possible properties are: :working-suffix - the replacement for online-suffix :base-url - the base URL, e.g. http://www.example.com/project/ Last slash required. - :working-directory - the local working directory. This is, what base-url will + :working-directory - the local working directory. This is, what base-url will be replaced with. :redirects - A list of cons cells, each of which maps a regular expression to match to a path relative to :working-directory. @@ -236,21 +236,21 @@ protocol - protocol to detect in a filename without trailing colon and slashes. If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol' will search filenames for \"org-protocol:/my-protocol:/\" and trigger your action for every match. `org-protocol' is defined in - `org-protocol-the-protocol'. Double and triple slashes are compressed + `org-protocol-the-protocol'. Double and triple slashes are compressed to one by emacsclient. function - function that handles requests with protocol and takes exactly one - argument: the filename with all protocols stripped. If the function - returns nil, emacsclient and -server do nothing. Any non-nil return + argument: the filename with all protocols stripped. If the function + returns nil, emacsclient and -server do nothing. Any non-nil return value is considered a valid filename and thus passed to the server. `org-protocol.el provides some support for handling those filenames, if you stay with the conventions used for the standard handlers in - `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. + `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. kill-client - If t, kill the client immediately, once the sub-protocol is - detected. This is necessary for actions that can be interrupted by - `C-g' to avoid dangling emacsclients. Note, that all other command + detected. This is necessary for actions that can be interrupted by + `C-g' to avoid dangling emacsclients. Note, that all other command line arguments but the this one will be discarded, greedy handlers still receive the whole list of arguments though. @@ -273,6 +273,12 @@ string with two characters." :group 'org-protocol :type 'string) +(defcustom org-protocol-data-separator "/+" + "The default data separator to use. + This should be a single regexp string." + :group 'org-protocol + :type 'string) + ;;; Helper functions: (defun org-protocol-sanitize-uri (uri) @@ -316,32 +322,32 @@ Everything up to the end of the protocols is stripped. Note, that this function will always behave as if `org-protocol-reverse-list-of-files' was set to t and the returned list will -reflect that. I.e. emacsclients first parameter will be the first one in the +reflect that. I.e. emacsclients first parameter will be the first one in the returned list." -(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files - param-list - (reverse param-list)))) - (trigger (car l)) - (len 0) - dir - ret) - (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger) - (setq dir (match-string 1 trigger)) - (setq len (length dir)) - (setcar l (concat dir (match-string 3 trigger)))) - (if strip-path - (progn - (dolist (e l ret) - (setq ret - (append ret - (list - (if (stringp e) - (if (stringp replacement) - (setq e (concat replacement (substring e len))) - (setq e (substring e len))) - e))))) - ret) - l))) + (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files + param-list + (reverse param-list)))) + (trigger (car l)) + (len 0) + dir + ret) + (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger) + (setq dir (match-string 1 trigger)) + (setq len (length dir)) + (setcar l (concat dir (match-string 3 trigger)))) + (if strip-path + (progn + (dolist (e l ret) + (setq ret + (append ret + (list + (if (stringp e) + (if (stringp replacement) + (setq e (concat replacement (substring e len))) + (setq e (substring e len))) + e))))) + ret) + l))) (defun org-protocol-flatten (l) "Greedy handlers might receive a list like this from emacsclient: @@ -350,7 +356,7 @@ where \"/dir/\" is the absolute path to emacsclients working directory. This function transforms it into a flat list." (if (null l) () (if (listp l) - (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) + (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) (list l)))) @@ -358,7 +364,7 @@ This function transforms it into a flat list." (defun org-protocol-store-link (fname) "Process an org-protocol://store-link:// style url. -Additionally store a browser URL as an org link. Also pushes the +Additionally store a browser URL as an org link. Also pushes the link's URL to the `kill-ring'. The location for a browser's bookmark has to look like this: @@ -367,17 +373,17 @@ The location for a browser's bookmark has to look like this: encodeURIComponent(location.href) encodeURIComponent(document.title)+'/'+ \\ -Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page +Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page could contain slashes and the location definitely will. The sub-protocol used to reach this function is set in `org-protocol-protocol-alist'." - (let* ((splitparts (org-protocol-split-data fname t)) + (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator)) (uri (org-protocol-sanitize-uri (car splitparts))) (title (cadr splitparts)) orglink) (if (boundp 'org-stored-links) - (setq org-stored-links (cons (list uri title) org-stored-links))) + (setq org-stored-links (cons (list uri title) org-stored-links))) (kill-new uri) (message "`%s' to insert new org-link, `%s' to insert `%s'" (substitute-command-keys"\\[org-insert-link]") @@ -433,7 +439,7 @@ Now template ?b will be used." (defun org-protocol-do-capture (info capture-func) "Support `org-capture' and `org-remember' alike. CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." - (let* ((parts (org-protocol-split-data info t)) + (let* ((parts (org-protocol-split-data info t org-protocol-data-separator)) (template (or (and (>= 2 (length (car parts))) (pop parts)) org-protocol-default-template-key)) (url (org-protocol-sanitize-uri (car parts))) @@ -529,7 +535,7 @@ This is, how the matching is done: protocol and sub-protocol are regexp-quoted. If a matching protocol is found, the protocol is stripped from fname and the -result is passed to the protocols function as the only parameter. If the +result is passed to the protocols function as the only parameter. If the function returns nil, the filename is removed from the list of filenames passed from emacsclient to the server. If the function returns a non nil value, that value is passed to the server @@ -548,7 +554,7 @@ as filename." (split (split-string fname proto)) (result (if greedy restoffiles (cadr split)))) (when (plist-get (cdr prolist) :kill-client) - (message "Greedy org-protocol handler. Killing client.") + (message "Greedy org-protocol handler. Killing client.") (server-edit)) (when (fboundp func) (unless greedy @@ -566,7 +572,7 @@ as filename." (client (ad-get-arg 1))) (catch 'greedy (dolist (var flist) - ;; `\' to `/' on windows. FIXME: could this be done any better? + ;; `\' to `/' on windows. FIXME: could this be done any better? (let ((fname (expand-file-name (car var)))) (setq fname (org-protocol-check-filename-for-protocol fname (member var flist) client)) @@ -589,14 +595,14 @@ most of the work." (require 'org-publish) (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) (if all (org-protocol-create (cdr all)) - (message "Not in an org-project. Did mean %s?" + (message "Not in an org-project. Did mean %s?" (substitute-command-keys"\\[org-protocol-create]"))))) (defun org-protocol-create (&optional project-plist) "Create a new org-protocol project interactively. An org-protocol project is an entry in `org-protocol-project-alist' which is used by `org-protocol-open-source'. -Optionally use project-plist to initialize the defaults for this project. If +Optionally use project-plist to initialize the defaults for this project. If project-plist is the CDR of an element in `org-publish-project-alist', reuse :base-directory, :html-extension and :base-extension." (interactive) @@ -625,19 +631,19 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse (setq strip-suffix (read-string (concat "Extension to strip from published URLs (" strip-suffix "): ") - strip-suffix nil strip-suffix t)) + strip-suffix nil strip-suffix t)) (setq working-suffix (read-string (concat "Extension of editable files (" working-suffix "): ") - working-suffix nil working-suffix t)) + working-suffix nil working-suffix t)) (when (yes-or-no-p "Save the new org-protocol-project to your init file? ") (setq org-protocol-project-alist (cons `(,base-url . (:base-url ,base-url - :working-directory ,working-dir - :online-suffix ,strip-suffix - :working-suffix ,working-suffix)) + :working-directory ,working-dir + :online-suffix ,strip-suffix + :working-suffix ,working-suffix)) org-protocol-project-alist)) (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist)))) diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el index 74cab14716..947d52b920 100644 --- a/lisp/org/org-publish.el +++ b/lisp/org/org-publish.el @@ -105,7 +105,7 @@ being published. Its value may be a string or regexp matching file names you don't want to be published. The :include property may be used to include extra files. Its -value may be a list of filenames to include. The filenames are +value may be a list of filenames to include. The filenames are considered relative to the base directory. When both :include and :exclude properties are given values, the @@ -315,7 +315,7 @@ You could use brackets to delimit on what part the link will be. (format "%s" (or pub-func "")))) (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) -(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir) +(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir) "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC. TRUE-PUB-DIR is where the file will truly end up. Currently we are not using this - maybe it can eventually be used to check if the file is present at @@ -325,7 +325,7 @@ function can still decide about that independently." (let ((rtn (if org-publish-use-timestamps-flag (org-publish-cache-file-needs-publishing - filename pub-dir pub-func) + filename pub-dir pub-func base-dir) ;; don't use timestamps, always return t t))) (if rtn @@ -334,7 +334,7 @@ function can still decide about that independently." (message "Skipping unmodified file %s" filename))) rtn)) -(defun org-publish-update-timestamp (filename &optional pub-dir pub-func) +(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir) "Update publishing timestamp for file FILENAME. If there is no timestamp, create one." (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) @@ -418,22 +418,22 @@ This splices all the components into the list." (setq retval (if org-sitemap-ignore-case (not (string-lessp (upcase B) (upcase A))) (not (string-lessp B A)))))) - ((or (equal org-sitemap-sort-files 'chronologically) - (equal org-sitemap-sort-files 'anti-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 (equal org-sitemap-sort-files 'chronologically) - (<= A B) - (>= A B))))))) + ((or (equal org-sitemap-sort-files 'chronologically) + (equal org-sitemap-sort-files 'anti-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 (equal org-sitemap-sort-files 'chronologically) + (<= A B) + (>= A B))))))) ;; Directory-wise wins: (when org-sitemap-sort-folders ;; a is directory, b not: (cond ((and (file-directory-p a) (not (file-directory-p b))) (setq retval (equal org-sitemap-sort-folders 'first))) - ;; a is not a directory, but b is: + ;; a is not a directory, but b is: ((and (not (file-directory-p a)) (file-directory-p b)) (setq retval (equal org-sitemap-sort-folders 'last)))))) retval)) @@ -506,7 +506,7 @@ matching filenames." (setq org-publish-temp-files nil) (if org-sitemap-requested (pushnew (expand-file-name (concat base-dir sitemap-filename)) - org-publish-temp-files)) + org-publish-temp-files)) (org-publish-get-base-files-1 base-dir recurse match ;; FIXME distinguish exclude regexp ;; for skip-file and skip-dir? @@ -536,14 +536,14 @@ matching filenames." (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) (when (or - (and + (and i (member filename (mapcar (lambda (file) (expand-file-name file b)) i))) - (and - (not (and e (string-match e filename))) - (string-match xm filename))) + (and + (not (and e (string-match e filename))) + (string-match xm filename))) (setq project-name (car prj)) (throw 'p-found project-name)))))) (when up @@ -600,10 +600,10 @@ PUB-DIR is the publishing directory." (defmacro org-publish-with-aux-preprocess-maybe (&rest body) "Execute BODY with a modified hook to preprocess for index." `(let ((org-export-preprocess-after-headline-targets-hook - (if (plist-get project-plist :makeindex) - (cons 'org-publish-aux-preprocess - org-export-preprocess-after-headline-targets-hook) - org-export-preprocess-after-headline-targets-hook))) + (if (plist-get project-plist :makeindex) + (cons 'org-publish-aux-preprocess + org-export-preprocess-after-headline-targets-hook) + org-export-preprocess-after-headline-targets-hook))) ,@body)) (def-edebug-spec org-publish-with-aux-preprocess-maybe (body)) @@ -624,7 +624,7 @@ See `org-publish-org-to' to the list of arguments." "Publish an org file to HTML. See `org-publish-org-to' to the list of arguments." (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "html" plist filename pub-dir))) + (org-publish-org-to "html" plist filename pub-dir))) (defun org-publish-org-to-org (plist filename pub-dir) "Publish an org file to HTML. @@ -635,19 +635,19 @@ See `org-publish-org-to' to the list of arguments." "Publish an org file to ASCII. See `org-publish-org-to' to the list of arguments." (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "ascii" plist filename pub-dir))) + (org-publish-org-to "ascii" plist filename pub-dir))) (defun org-publish-org-to-latin1 (plist filename pub-dir) "Publish an org file to Latin-1. See `org-publish-org-to' to the list of arguments." (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "latin1" plist filename pub-dir))) + (org-publish-org-to "latin1" plist filename pub-dir))) (defun org-publish-org-to-utf8 (plist filename pub-dir) "Publish an org file to UTF-8. See `org-publish-org-to' to the list of arguments." (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "utf8" plist filename pub-dir))) + (org-publish-org-to "utf8" plist filename pub-dir))) (defun org-publish-attachment (plist filename pub-dir) "Publish a file with no transformation of any kind. @@ -705,15 +705,14 @@ See `org-publish-projects'." (if (listp publishing-function) ;; allow chain of publishing functions (mapc (lambda (f) - (when (org-publish-needed-p filename pub-dir f tmp-pub-dir) + (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir) (funcall f project-plist filename tmp-pub-dir) - (org-publish-update-timestamp filename pub-dir f))) + (org-publish-update-timestamp filename pub-dir f base-dir))) publishing-function) - (when (org-publish-needed-p filename pub-dir publishing-function - tmp-pub-dir) + (when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir) (funcall publishing-function project-plist filename tmp-pub-dir) (org-publish-update-timestamp - filename pub-dir publishing-function))) + filename pub-dir publishing-function base-dir))) (unless no-cache (org-publish-write-cache-file)))) (defun org-publish-projects (projects) @@ -733,9 +732,9 @@ If :makeindex is set, also produce a file theindex.org." (sitemap-function (or (plist-get project-plist :sitemap-function) 'org-publish-org-sitemap)) (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format) - org-publish-sitemap-date-format)) + org-publish-sitemap-date-format)) (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format) - org-publish-sitemap-file-entry-format)) + org-publish-sitemap-file-entry-format)) (preparation-function (plist-get project-plist :preparation-function)) (completion-function (plist-get project-plist :completion-function)) (files (org-publish-get-base-files project exclude-regexp)) file) @@ -751,7 +750,7 @@ If :makeindex is set, also produce a file theindex.org." (plist-get project-plist :base-directory)) project t)) (when completion-function (run-hooks 'completion-function)) - (org-publish-write-cache-file))) + (org-publish-write-cache-file))) (org-publish-expand-projects projects))) (defun org-publish-org-sitemap (project &optional sitemap-filename) @@ -767,9 +766,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (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)))) + (concat "Sitemap for project " (car project)))) (sitemap-style (or (plist-get project-plist :sitemap-style) - 'tree)) + 'tree)) (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension)) (visiting (find-buffer-visiting sitemap-filename)) (ifn (file-name-nondirectory sitemap-filename)) @@ -833,10 +832,10 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (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-sitemap-date-format - (org-publish-find-date file))) - (?a . ,(or (plist-get project-plist :author) user-full-name))))) + `((?t . ,(org-publish-find-title file t)) + (?d . ,(format-time-string org-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." @@ -902,7 +901,7 @@ It returns time in `current-time' format." ;; If this function is called in batch mode, ;; project is still a string here. (list (assoc project org-publish-project-alist)) - (list project)))))) + (list project)))))) ;;;###autoload (defun org-publish-all (&optional force) @@ -1033,25 +1032,24 @@ the project." ;; Create theindex.org if it doesn't exist already (let ((index-file (expand-file-name "theindex.org" directory))) (unless (file-exists-p index-file) - (setq ibuffer (find-file-noselect index-file)) - (with-current-buffer ibuffer - (erase-buffer) - (insert "\n\n#+include: \"theindex.inc\"\n\n") - (save-buffer)) - (kill-buffer ibuffer))))) + (setq ibuffer (find-file-noselect index-file)) + (with-current-buffer ibuffer + (erase-buffer) + (insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n") + (save-buffer)) + (kill-buffer ibuffer))))) ;; Caching functions: (defun org-publish-write-cache-file (&optional free-cache) "Write `org-publish-cache' to file. If FREE-CACHE, empty the cache." - (unless org-publish-cache - (error "%s" "`org-publish-write-cache-file' called, but no cache present")) + (or org-publish-cache + (error "`org-publish-write-cache-file' called, but no cache present")) (let ((cache-file (org-publish-cache-get ":cache-file:"))) - (unless cache-file - (error - "%s" "Cannot find cache-file name in `org-publish-write-cache-file'")) + (or cache-file + (error "Cannot find cache-file name in `org-publish-write-cache-file'")) (with-temp-file cache-file (let ((print-level nil) (print-length nil)) @@ -1068,9 +1066,8 @@ If FREE-CACHE, empty the cache." (defun org-publish-initialize-cache (project-name) "Initialize the projects cache if not initialized yet and return it." - (unless project-name - (error "%s%s" "Cannot initialize `org-publish-cache' without projects name" - " in `org-publish-initialize-cache'")) + (or project-name + (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) (unless (file-exists-p org-publish-timestamp-directory) (make-directory org-publish-timestamp-directory t)) @@ -1105,23 +1102,24 @@ If FREE-CACHE, empty the cache." (clrhash org-publish-cache)) (setq org-publish-cache nil)) -(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func) +(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir) "Check the timestamp of the last publishing of FILENAME. Return `t', if the file needs publishing. The function also checks if any included files have been more recently published, so that the file including them will be republished as well." - (unless org-publish-cache - (error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present")) + (or org-publish-cache + (error "`org-publish-cache-file-needs-publishing' called, but no cache present")) (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) (pstamp (org-publish-cache-get key)) (visiting (find-buffer-visiting filename)) + (case-fold-search t) included-files-ctime buf) (when (equal (file-name-extension filename) "org") (setq buf (find-file (expand-file-name filename))) (with-current-buffer buf (goto-char (point-min)) - (while (re-search-forward "^#\\+INCLUDE:[ \t]+\"?\\([^ \t\n\r\"]*\\)\"?[ \t]*.*$" nil t) + (while (re-search-forward "^#\\+include:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) (let* ((included-file (expand-file-name (match-string 1)))) (add-to-list 'included-files-ctime (org-publish-cache-ctime-of-src included-file) t)))) @@ -1173,28 +1171,24 @@ If the entry will be created, unless NO-CREATE is not nil." "Return the value stored in `org-publish-cache' for key KEY. Returns nil, if no value or nil is found, or the cache does not exist." - (unless org-publish-cache - (error "%s" "`org-publish-cache-get' called, but no cache present")) + (or org-publish-cache + (error "`org-publish-cache-get' called, but no cache present")) (gethash key org-publish-cache)) (defun org-publish-cache-set (key value) "Store KEY VALUE pair in `org-publish-cache'. Returns value on success, else nil." - (unless org-publish-cache - (error "%s" "`org-publish-cache-set' called, but no cache present")) + (or org-publish-cache + (error "`org-publish-cache-set' called, but no cache present")) (puthash key value org-publish-cache)) -(defun org-publish-cache-ctime-of-src (filename) - "Get the FILENAME ctime as an integer." - (let* ((symlink-maybe (or (file-symlink-p filename) filename)) - (src-attr (file-attributes (if (file-name-absolute-p symlink-maybe) - symlink-maybe - (expand-file-name - symlink-maybe - (file-name-directory filename)))))) - (+ - (lsh (car (nth 5 src-attr)) 16) - (cadr (nth 5 src-attr))))) +(defun org-publish-cache-ctime-of-src (file) + "Get the ctime of filename F as an integer." + (let ((attr (file-attributes + (expand-file-name (or (file-symlink-p file) file) + (file-name-directory file))))) + (+ (lsh (car (nth 5 attr)) 16) + (cadr (nth 5 attr))))) (provide 'org-publish) diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index d1d863c284..7a1eb7762d 100644 --- a/lisp/org/org-remember.el +++ b/lisp/org/org-remember.el @@ -64,7 +64,7 @@ and `org-remember-default-headline'. To force prompting anyway, use \\[universal-argument] \\[org-remember-finalize] to file the note. When this variable is nil, \\[org-remember-finalize] gives you the prompts, and -\\[universal-argument] \\[org-remember-finalize] triggers the fast track." +\\[universal-argument] \\[org-remember-finalize] triggers the fasttrack." :group 'org-remember :type 'boolean) @@ -189,22 +189,22 @@ calendar | %:type %:date" (character :tag "Selection Key") (string :tag "Template") (choice :tag "Destination file" - (file :tag "Specify") - (function :tag "Function") - (const :tag "Use `org-default-notes-file'" nil)) + (file :tag "Specify") + (function :tag "Function") + (const :tag "Use `org-default-notes-file'" nil)) (choice :tag "Destin. headline" - (string :tag "Specify") - (function :tag "Function") - (const :tag "Use `org-remember-default-headline'" nil) - (const :tag "At beginning of file" top) - (const :tag "At end of file" bottom) - (const :tag "In a date tree" date-tree)) + (string :tag "Specify") + (function :tag "Function") + (const :tag "Use `org-remember-default-headline'" nil) + (const :tag "At beginning of file" top) + (const :tag "At end of file" bottom) + (const :tag "In a date tree" date-tree)) (choice :tag "Context" - (const :tag "Use in all contexts" nil) - (const :tag "Use in all contexts" t) - (repeat :tag "Use only if in major mode" - (symbol :tag "Major mode")) - (function :tag "Perform a check against function"))))) + (const :tag "Use in all contexts" nil) + (const :tag "Use in all contexts" t) + (repeat :tag "Use only if in major mode" + (symbol :tag "Major mode")) + (function :tag "Perform a check against function"))))) (defcustom org-remember-delete-empty-lines-at-end t "Non-nil means clean up final empty lines in remember buffer." @@ -277,9 +277,6 @@ opposite case, the default, t, is more useful." :group 'org-remember :type 'boolean) -(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' -(defvar initial) ; from remember.el, dynamically scoped in `remember-mode' - ;;;###autoload (defun org-remember-insinuate () "Setup remember.el for use with Org-mode." @@ -297,7 +294,7 @@ conventions in Org-mode. This function returns such a link." (org-store-link nil)) (defconst org-remember-help -"Select a destination location for the note. + "Select a destination location for the note. UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store RET on headline -> Store as sublevel entry to current headline RET at beg-of-buf -> Append to file as level 2 headline @@ -401,8 +398,7 @@ RET at beg-of-buf -> Append to file as level 2 headline This function should be placed into `remember-mode-hook' and in fact requires to be run from that hook to function properly." (when (and (boundp 'initial) (stringp initial)) - (setq initial (org-no-properties initial)) - (remove-text-properties 0 (length initial) '(read-only t) initial)) + (setq initial (org-no-properties initial))) (if org-remember-templates (let* ((entry (org-select-remember-template use-char)) (ct (or org-overriding-default-time (org-current-time))) @@ -431,10 +427,10 @@ to be run from that hook to function properly." ;; `initial' and `annotation' are bound in `remember'. ;; But if the property list has them, we prefer those values (v-i (or (plist-get org-store-link-plist :initial) - (and (boundp 'initial) initial) + (and (boundp 'initial) (symbol-value 'initial)) "")) (v-a (or (plist-get org-store-link-plist :annotation) - (and (boundp 'annotation) annotation) + (and (boundp 'annotation) (symbol-value 'annotation)) "")) ;; Is the link empty? Then we do not want it... (v-a (if (equal v-a "[[]]") "" v-a)) @@ -449,7 +445,7 @@ to be run from that hook to function properly." v-a)) (v-n user-full-name) (v-k (if (marker-buffer org-clock-marker) - (org-substring-no-properties org-clock-heading))) + (org-no-properties org-clock-heading))) (v-K (if (marker-buffer org-clock-marker) (org-make-link-string (buffer-file-name (marker-buffer org-clock-marker)) @@ -476,7 +472,7 @@ to be run from that hook to function properly." (erase-buffer) (insert (substitute-command-keys (format -"## %s \"%s\" -> \"* %s\" + "## %s \"%s\" -> \"* %s\" ## C-u C-c C-c like C-c C-c, and immediately visit note at target location ## C-0 C-c C-c \"%s\" -> \"* %s\" ## %s to select file and header location interactively. @@ -505,18 +501,20 @@ to be run from that hook to function properly." filename error))))))) ;; Simple %-escapes (goto-char (point-min)) - (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) - (unless (org-remember-escaped-%) - (when (and initial (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity - (org-split-string initial "\n") - (concat "\n" lead)))))) - (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") - t t))) + (let ((init (and (boundp 'initial) + (symbol-value 'initial)))) + (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) + (unless (org-remember-escaped-%) + (when (and init (equal (match-string 0) "%i")) + (save-match-data + (let* ((lead (buffer-substring + (point-at-bol) (match-beginning 0)))) + (setq v-i (mapconcat 'identity + (org-split-string init "\n") + (concat "\n" lead)))))) + (replace-match + (or (eval (intern (concat "v-" (match-string 1)))) "") + t t)))) ;; %() embedded elisp (goto-char (point-min)) @@ -536,10 +534,10 @@ to be run from that hook to function properly." (when plist-p (goto-char (point-min)) (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) - (unless (org-remember-escaped-%) - (and (setq x (or (plist-get org-store-link-plist - (intern (match-string 1))) "")) - (replace-match x t t))))) + (unless (org-remember-escaped-%) + (and (setq x (or (plist-get org-store-link-plist + (intern (match-string 1))) "")) + (replace-match x t t))))) ;; Turn on org-mode in the remember buffer, set local variables (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1)) @@ -599,7 +597,7 @@ to be run from that hook to function properly." (car clipboards)))))) ((equal char "p") (let* - ((prop (org-substring-no-properties prompt)) + ((prop (org-no-properties prompt)) (pall (concat prop "_ALL")) (allowed (with-current-buffer @@ -943,7 +941,7 @@ See also the variable `org-reverse-note-order'." (throw 'quit t)) ;; Find the file (with-current-buffer (or visiting (find-file-noselect file)) - (unless (or (eq major-mode 'org-mode) (member heading '(top bottom))) + (unless (or (derived-mode-p 'org-mode) (member heading '(top bottom))) (error "Target files for notes must be in Org-mode if not filing to top/bottom")) (save-excursion (save-restriction @@ -953,7 +951,7 @@ See also the variable `org-reverse-note-order'." ;; Find the default location (when heading (cond - ((not (eq major-mode 'org-mode)) + ((not (derived-mode-p 'org-mode)) (if (eq heading 'top) (goto-char (point-min)) (goto-char (point-max)) @@ -995,7 +993,7 @@ See also the variable `org-reverse-note-order'." (cond ((and fastp (memq heading '(top bottom))) (setq spos org-goto-start-pos - exitcmd (if (eq heading 'top) 'left nil))) + exitcmd (if (eq heading 'top) 'left nil))) (fastp (setq spos org-goto-start-pos exitcmd 'return)) ((eq org-remember-interactive-interface 'outline) diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index 3146ff3275..4be7bcbb5f 100644 --- a/lisp/org/org-rmail.el +++ b/lisp/org/org-rmail.el @@ -33,9 +33,12 @@ (require 'org) ;; Declare external functions and variables -(declare-function rmail-show-message "rmail" (&optional n no-summary)) -(declare-function rmail-what-message "rmail" ()) -(defvar rmail-current-message) +(declare-function rmail-show-message "rmail" (&optional n no-summary)) +(declare-function rmail-what-message "rmail" (&optional pos)) +(declare-function rmail-toggle-header "rmail" (&optional arg)) +(declare-function rmail-widen "rmail" ()) +(defvar rmail-current-message) ; From rmail.el +(defvar rmail-header-style) ; From rmail.el ;; Install the link type (org-add-link-type "rmail" 'org-rmail-open) @@ -52,6 +55,8 @@ (rmail-show-message rmail-current-message)) (when (fboundp 'rmail-narrow-to-non-pruned-header) (rmail-narrow-to-non-pruned-header)) + (when (eq rmail-header-style 'normal) + (rmail-toggle-header -1)) (let* ((folder buffer-file-name) (message-id (mail-fetch-field "message-id")) (from (mail-fetch-field "from")) @@ -73,7 +78,7 @@ :date-timestamp-inactive date-ts-ia)) (setq message-id (org-remove-angle-brackets message-id)) (setq desc (org-email-link-description)) - (setq link (org-make-link "rmail:" folder "#" message-id)) + (setq link (concat "rmail:" folder "#" message-id)) (org-add-link-props :link link :description desc) (rmail-show-message rmail-current-message) link))))) @@ -97,7 +102,7 @@ (rmail (if (string= folder "RMAIL") rmail-file-name folder)) (setq message-number (save-restriction - (widen) + (rmail-widen) (goto-char (point-max)) (if (re-search-backward (concat "^Message-ID:\\s-+" (regexp-quote diff --git a/lisp/org/org-special-blocks.el b/lisp/org/org-special-blocks.el index 43b37c6401..ddd612074b 100644 --- a/lisp/org/org-special-blocks.el +++ b/lisp/org/org-special-blocks.el @@ -80,17 +80,17 @@ seen. This is run after a few special cases are taken care of." (add-hook 'org-export-latex-after-blockquotes-hook 'org-special-blocks-convert-latex-special-cookies) -(defvar line) +(defvar org-line) (defun org-special-blocks-convert-html-special-cookies () "Converts the special cookies into div blocks." - ;; Uses the dynamically-bound variable `line'. - (when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" line) + ;; Uses the dynamically-bound variable `org-line'. + (when (and org-line (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line)) (message "%s" (match-string 1)) - (when (equal (match-string 2 line) "START") + (when (equal (match-string 2 org-line) "START") (org-close-par-maybe) - (insert "\n<div class=\"" (match-string 1 line) "\">") + (insert "\n<div class=\"" (match-string 1 org-line) "\">") (org-open-par)) - (when (equal (match-string 2 line) "END") + (when (equal (match-string 2 org-line) "END") (org-close-par-maybe) (insert "\n</div>") (org-open-par)) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 496dafe5e7..9d6bc1aa2c 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -41,6 +41,7 @@ (declare-function org-at-table.el-p "org" ()) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-switch-to-buffer-other-window "org" (&rest args)) +(declare-function org-strip-protective-commas "org" (beg end)) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (declare-function org-strip-protective-commas "org" (beg end)) @@ -112,8 +113,7 @@ editing it with \\[org-edit-src-code]. Has no effect if :type 'integer) (defvar org-src-strip-leading-and-trailing-blank-lines nil - "If non-nil, blank lines are removed when exiting the code edit -buffer.") + "If non-nil, blank lines are removed when exiting the code edit buffer.") (defcustom org-edit-src-persistent-message t "Non-nil means show persistent exit help message while editing src examples. @@ -130,7 +130,7 @@ current-window Show edit buffer in the current window, keeping all other windows. other-window Use `switch-to-buffer-other-window' to display edit buffer. reorganize-frame Show only two windows on the current frame, the current - window and the edit buffer. When exiting the edit buffer, + window and the edit buffer. When exiting the edit buffer, return to one window. other-frame Use `switch-to-buffer-other-frame' to display edit buffer. Also, when exiting the edit buffer, kill that frame." @@ -174,6 +174,7 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-src-mode-map (make-sparse-keymap)) (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) +(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save) (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) @@ -187,9 +188,9 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-src-ask-before-returning-to-edit-buffer t "If nil, when org-edit-src code is used on a block that already - has an active edit buffer, it will switch to that edit buffer - immediately; otherwise it will ask whether you want to return - to the existing edit buffer.") +has an active edit buffer, it will switch to that edit buffer +immediately; otherwise it will ask whether you want to return to +the existing edit buffer.") (defvar org-src-babel-info nil) @@ -202,13 +203,13 @@ There is a mode hook, and keybindings for `org-edit-src-exit' and `org-edit-src-save'") (defun org-edit-src-code (&optional context code edit-buffer-name) - "Edit the source code example at point. + "Edit the source CODE example at point. The example is copied to a separate buffer, and that buffer is switched to the correct language mode. When done, exit with \\[org-edit-src-exit]. This will remove the original code in the -Org buffer, and replace it with the edited version. Optional +Org buffer, and replace it with the edited version. An optional argument CONTEXT is used by \\[org-edit-src-save] when calling -this function. See \\[org-src-window-setup] to configure the +this function. See `org-src-window-setup' to configure the display of windows containing the Org buffer and the code buffer." (interactive) @@ -271,8 +272,9 @@ buffer." (setq line (org-current-line) col (current-column))) (if (and (setq buffer (org-edit-src-find-buffer beg end)) - (if org-src-ask-before-returning-to-edit-buffer - (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ") t)) + (or (eq context 'save) + (if org-src-ask-before-returning-to-edit-buffer + (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ") t))) (org-src-switch-to-buffer buffer 'return) (when buffer (with-current-buffer buffer @@ -309,7 +311,7 @@ buffer." (error "Language mode `%s' fails with: %S" lang-f (nth 1 e))))) (dolist (pair transmitted-variables) (org-set-local (car pair) (cadr pair))) - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (progn (goto-char (point-min)) (while (re-search-forward "^," nil t) @@ -328,6 +330,7 @@ buffer." (if org-src-preserve-indentation col (max 0 (- col total-nindent)))) (org-src-mode) (set-buffer-modified-p nil) + (setq buffer-file-name nil) (and org-edit-src-persistent-message (org-set-local 'header-line-format msg)) (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) @@ -336,6 +339,7 @@ buffer." t))) (defun org-edit-src-continue (e) + "Continue editing source blocks." ;; Fixme: be more accurate (interactive "e") (mouse-set-point e) (let ((buf (get-char-property (point) 'edit-buffer))) @@ -412,7 +416,7 @@ the fragment in the Org-mode buffer." (case-fold-search t) (msg (substitute-command-keys "Edit, then exit with C-c ' (C-c and single quote)")) - (org-mode-p (eq major-mode 'org-mode)) + (org-mode-p (derived-mode-p 'org-mode)) (beg (make-marker)) (end (make-marker)) (preserve-indentation org-src-preserve-indentation) @@ -436,7 +440,7 @@ the fragment in the Org-mode buffer." code (buffer-substring-no-properties beg end) begline (save-excursion (goto-char beg) (org-current-line))) (if (and (setq buffer (org-edit-src-find-buffer beg end)) - (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ")) + (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ")) (org-pop-to-buffer-same-window buffer) (when buffer (with-current-buffer buffer @@ -452,10 +456,10 @@ the fragment in the Org-mode buffer." (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") (overlay-put ovl 'face 'secondary-selection) (overlay-put ovl - 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'org-edit-src-continue) - map)) + 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'org-edit-src-continue) + map)) (overlay-put ovl :read-only "Leave me alone") (org-pop-to-buffer-same-window buffer) (insert code) @@ -586,6 +590,21 @@ the language, a switch telling if the content should be in a single line." (goto-char pos) (org-get-indentation))) +(defun org-add-protective-commas (beg end &optional line) + "Add protective commas in region. +Return the delta in size of the region." + (interactive "r") + (let ((org-re "^\\(.\\)") + (other-re "^\\([*]\\|[ \t]*#\\+\\)") + (delta 0)) + (save-excursion + (goto-char beg) + (while (re-search-forward (if (derived-mode-p 'org-mode) org-re other-re) + end t) + (if (and line (eq (org-current-line) line)) (setq delta (1+ delta))) + (replace-match ",\\1"))) + delta)) + (defun org-edit-src-exit (&optional context) "Exit special edit and protect problematic lines." (interactive) @@ -595,6 +614,7 @@ the language, a switch telling if the content should be in a single line." (let* ((beg org-edit-src-beg-marker) (end org-edit-src-end-marker) (ovl org-edit-src-overlay) + (bufstr (buffer-string)) (buffer (current-buffer)) (single (org-bound-and-true-p org-edit-src-force-single-line)) (macro (eq single 'macro-definition)) @@ -629,11 +649,8 @@ the language, a switch telling if the content should be in a single line." (goto-char (point-min)) (if (looking-at "\\s-*") (replace-match " "))) (when (org-bound-and-true-p org-edit-src-from-org-mode) - (goto-char (point-min)) - (while (re-search-forward - (if (eq major-mode 'org-mode) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t) - (if (eq (org-current-line) line) (setq delta (1+ delta))) - (replace-match ",\\1"))) + (setq delta (+ delta (org-add-protective-commas + (point-min) (point-max) line)))) (when (org-bound-and-true-p org-edit-src-picture) (setq preserve-indentation nil) (untabify (point-min) (point-max)) @@ -648,13 +665,18 @@ the language, a switch telling if the content should be in a single line." (if (org-bound-and-true-p org-edit-src-picture) (setq total-nindent (+ total-nindent 2))) (setq code (buffer-string)) + (when (eq context 'save) + (erase-buffer) + (insert bufstr)) (set-buffer-modified-p nil)) (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) - (kill-buffer buffer) + (if (eq context 'save) (save-buffer) + (kill-buffer buffer)) (goto-char beg) (when allow-write-back-p - (delete-region beg end) + (delete-region beg (1- end)) (insert code) + (delete-char 1) (goto-char beg) (if single (just-one-space))) (if (memq t (mapcar (lambda (overlay) @@ -666,28 +688,41 @@ the language, a switch telling if the content should be in a single line." ;; Block is visible, put point where it was in the code buffer (org-goto-line (1- (+ (org-current-line) line))) (org-move-to-column (if preserve-indentation col (+ col total-nindent delta)))) - (move-marker beg nil) - (move-marker end nil)) + (unless (eq context 'save) + (move-marker beg nil) + (move-marker end nil))) (unless (eq context 'save) (when org-edit-src-saved-temp-window-config (set-window-configuration org-edit-src-saved-temp-window-config) (setq org-edit-src-saved-temp-window-config nil)))) +(defmacro org-src-in-org-buffer (&rest body) + `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg) + (save-window-excursion + (org-edit-src-exit 'save) + ,@body + (setq msg (current-message)) + (if (eq org-src-window-setup 'other-frame) + (let ((org-src-window-setup 'current-window)) + (org-edit-src-code 'save)) + (org-edit-src-code 'save))) + (setq buffer-undo-list ul) + (push-mark m 'nomessage) + (goto-char (min p (point-max))) + (message (or msg "")))) +(def-edebug-spec org-src-in-org-buffer (body)) + (defun org-edit-src-save () "Save parent buffer with current state source-code buffer." (interactive) - (let ((p (point)) (m (mark)) msg) - (save-window-excursion - (org-edit-src-exit 'save) - (save-buffer) - (setq msg (current-message)) - (if (eq org-src-window-setup 'other-frame) - (let ((org-src-window-setup 'current-window)) - (org-edit-src-code 'save)) - (org-edit-src-code 'save))) - (push-mark m 'nomessage) - (goto-char (min p (point-max))) - (message (or msg "")))) + (org-src-in-org-buffer (save-buffer))) + +(declare-function org-babel-tangle "ob-tangle" (&optional only-this-block target-file lang)) + +(defun org-src-tangle (arg) + "Tangle the parent buffer." + (interactive) + (org-src-in-org-buffer (org-babel-tangle arg))) (defun org-src-mode-configure-edit-buffer () (when (org-bound-and-true-p org-edit-src-from-org-mode) @@ -739,7 +774,7 @@ remotely with point temporarily at the start of the code block in the Org buffer. This command is not bound to a key by default, to avoid conflicts -with language major mode bindings. To bind it to C-c @ in all +with language major mode bindings. To bind it to C-c @ in all language major modes, you could use (add-hook 'org-src-mode-hook @@ -777,7 +812,7 @@ mode." (defun org-src-font-lock-fontify-block (lang start end) "Fontify code block. This function is called by emacs automatic fontification, as long -as `org-src-fontify-natively' is non-nil. For manual +as `org-src-fontify-natively' is non-nil. For manual fontification of code blocks see `org-src-fontify-block' and `org-src-fontify-buffer'" (let ((lang-mode (org-src-get-lang-mode lang))) @@ -790,13 +825,13 @@ fontification of code blocks see `org-src-fontify-block' and (get-buffer-create (concat " org-src-fontification:" (symbol-name lang-mode))) (delete-region (point-min) (point-max)) - (insert (concat string " ")) ;; so there's a final property change + (insert string " ") ;; so there's a final property change (unless (eq major-mode lang-mode) (funcall lang-mode)) (font-lock-fontify-buffer) (setq pos (point-min)) (while (setq next (next-single-property-change pos 'face)) (put-text-property - (+ start (1- pos)) (+ start next) 'face + (+ start (1- pos)) (1- (+ start next)) 'face (get-text-property pos 'face) org-buffer) (setq pos next))) (add-text-properties @@ -813,7 +848,7 @@ fontification of code blocks see `org-src-fontify-block' and (font-lock-fontify-region (nth 0 info) (nth 1 info))))) (defun org-src-fontify-buffer () - "Fontify all code blocks in the current buffer" + "Fontify all code blocks in the current buffer." (interactive) (org-babel-map-src-blocks nil (org-src-fontify-block))) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index e02062a2b9..3eb63b6e53 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -41,6 +41,7 @@ (declare-function org-table-clean-before-export "org-exp" (lines &optional maybe-quoted)) (declare-function org-format-org-table-html "org-html" (lines &optional splice)) +(declare-function aa2u "ext:ascii-art-to-unicode" ()) (defvar orgtbl-mode) ; defined below (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized (defvar org-export-html-table-tag) ; defined in org-exp.el @@ -85,7 +86,13 @@ this variable requires a restart of Emacs to become effective." <!-- #+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 | | | --->\n")) +-->\n") + (org-mode "#+ BEGIN RECEIVE ORGTBL %n +#+ END RECEIVE ORGTBL %n + +#+ORGTBL: SEND %n orgtbl-to-orgtbl :splice nil :skip 0 +| | | +")) "Templates for radio tables in different major modes. All occurrences of %n in a template will be replaced with the name of the table, obtained by prompting the user." @@ -102,7 +109,7 @@ table, obtained by prompting the user." (defcustom org-table-default-size "5x2" "The default size for newly created tables, Columns x Rows." :group 'org-table-settings - :type 'string) + :type 'string) (defcustom org-table-number-regexp "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$" @@ -131,6 +138,8 @@ Other options offered by the customize interface are more restrictive." "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") (const :tag "Very General Number-Like, including hex" "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") + (const :tag "Very General Number-Like, including hex, allows comma as decimal mark" + "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") (string :tag "Regexp:"))) (defcustom org-table-number-fraction 0.5 @@ -217,13 +226,13 @@ t accept as input and present for editing" (defcustom org-calc-default-modes '(calc-internal-prec 12 - calc-float-format (float 8) - calc-angle-mode deg - calc-prefer-frac nil - calc-symbolic-mode nil - calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm)) - calc-display-working-message t - ) + calc-float-format (float 8) + calc-angle-mode deg + calc-prefer-frac nil + calc-symbolic-mode nil + calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm)) + calc-display-working-message t + ) "List with Calc mode settings for use in `calc-eval' for table formulas. The list must contain alternating symbols (Calc modes variables and values). Don't remove any of the default settings, just change the values. Org-mode @@ -368,8 +377,8 @@ available parameters." "Vector of hline line numbers in the current table.") (defconst org-table-range-regexp - "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" - ;; 1 2 3 4 5 + "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" + ;; 1 2 3 4 5 "Regular expression for matching ranges in formulas.") (defconst org-table-range-regexp2 @@ -551,15 +560,18 @@ are found, lines will be split on whitespace into fields." (defvar org-table-last-column-widths) (defun org-table-export (&optional file format) "Export table to a file, with configurable format. -Such a file can be imported into a spreadsheet program like Excel. -FILE can be the output file name. If not given, it will be taken from -a TABLE_EXPORT_FILE property in the current entry or higher up in the -hierarchy, or the user will be prompted for a file name. -FORMAT can be an export format, of the same kind as it used when -`orgtbl-mode' sends a table in a different format. The default format can -be found in the variable `org-table-export-default-format', but the function -first checks if there is an export format specified in a TABLE_EXPORT_FORMAT -property, locally or anywhere up in the hierarchy." +Such a file can be imported into usual spreadsheet programs. + +FILE can be the output file name. If not given, it will be taken +from a TABLE_EXPORT_FILE property in the current entry or higher +up in the hierarchy, or the user will be prompted for a file +name. FORMAT can be an export format, of the same kind as it +used when `orgtbl-mode' sends a table in a different format. + +The command suggests a format depending on TABLE_EXPORT_FORMAT, +whether it is set locally or up in the hierarchy, then on the +extension of the given file name, and finally on the variable +`org-table-export-default-format'." (interactive) (unless (org-at-table-p) (error "No table at point")) @@ -569,9 +581,13 @@ property, locally or anywhere up in the hierarchy." (end (org-table-end)) (txt (buffer-substring-no-properties beg end)) (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t))) + (formats '("orgtbl-to-tsv" "orgtbl-to-csv" + "orgtbl-to-latex" "orgtbl-to-html" + "orgtbl-to-generic" "orgtbl-to-texinfo" + "orgtbl-to-orgtbl")) (format (or format (org-entry-get beg "TABLE_EXPORT_FORMAT" t))) - buf deffmt-readable) + buf deffmt-readable fileext) (unless file (setq file (read-file-name "Export table to: ")) (unless (or (not (file-exists-p file)) @@ -583,19 +599,16 @@ property, locally or anywhere up in the hierarchy." (equal (file-truename file) (file-truename (buffer-file-name)))) (error "Please specify a file name that is different from current")) + (setq fileext (concat (file-name-extension file) "$")) (unless format - (setq deffmt-readable org-table-export-default-format) + (setq deffmt-readable + (or (car (delq nil (mapcar (lambda(f) (if (string-match fileext f) f)) formats))) + org-table-export-default-format)) (while (string-match "\t" deffmt-readable) (setq deffmt-readable (replace-match "\\t" t t deffmt-readable))) (while (string-match "\n" deffmt-readable) (setq deffmt-readable (replace-match "\\n" t t deffmt-readable))) - (setq format (org-completing-read - "Format: " - '("orgtbl-to-tsv" "orgtbl-to-csv" - "orgtbl-to-latex" "orgtbl-to-html" - "orgtbl-to-generic" "orgtbl-to-texinfo" - "orgtbl-to-orgtbl") nil nil - deffmt-readable))) + (setq format (org-completing-read "Format: " formats nil nil deffmt-readable))) (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format) (let* ((transform (intern (match-string 1 format))) (params (if (match-end 2) @@ -695,7 +708,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (re-search-forward org-emph-re end t))) (goto-char beg) (setq raise (and org-use-sub-superscripts - (re-search-forward org-match-substring-regexp end t))) + (re-search-forward org-match-substring-regexp end t))) (goto-char beg) (setq dates (and org-display-custom-times (re-search-forward org-ts-regexp-both end t))) @@ -732,7 +745,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; Get the data fields by splitting the lines. (setq fields (mapcar (lambda (l) - (org-split-string l " *| *")) + (org-split-string l " *| *")) (delq nil (copy-sequence lines)))) ;; How many fields in the longest line? (condition-case nil @@ -764,7 +777,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (> (org-string-width xx) fmax)) (org-add-props xx nil 'help-echo - (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) + (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) (unless (> f1 1) (error "Cannot narrow field starting with wide link \"%s\"" @@ -833,7 +846,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (delete-region (point) end) (move-marker end nil) (move-marker org-table-aligned-end-marker (point)) - (when (and orgtbl-mode (not (eq major-mode 'org-mode))) + (when (and orgtbl-mode (not (derived-mode-p 'org-mode))) (goto-char org-table-aligned-begin-marker) (while (org-hide-wide-columns org-table-aligned-end-marker))) ;; Try to move to the old location @@ -1319,8 +1332,8 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." (while (< i ll) (if (>= (aref org-table-dlines i) line) (throw 'exit i)) - (setq i (1+ i))))) - nil)) + (setq i (1+ i))))) + nil)) (defun org-table-delete-column () "Delete a column from the table." @@ -1627,8 +1640,8 @@ with `org-table-paste-rectangle'." (if (org-region-active-p) (region-end) (point)) current-prefix-arg)) (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 - region cols - (rpl (if cut " " nil))) + region cols + (rpl (if cut " " nil))) (goto-char beg) (org-table-check-inside-data-field) (setq l01 (org-current-line) @@ -2088,22 +2101,23 @@ When NAMED is non-nil, look for a named equation." (defun org-table-store-formulas (alist) "Store the list of formulas below the current table." (setq alist (sort alist 'org-table-formula-less-p)) - (save-excursion - (goto-char (org-table-end)) - (if (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM:\\(.*\n?\\)") - (progn - ;; don't overwrite TBLFM, we might use text properties to store stuff - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 0))) - (org-indent-line-function) - (insert "#+TBLFM:")) - (insert " " - (mapconcat (lambda (x) - (concat - (if (equal (string-to-char (car x)) ?@) "" "$") - (car x) "=" (cdr x))) - alist "::") - "\n"))) + (let ((case-fold-search t)) + (save-excursion + (goto-char (org-table-end)) + (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)") + (progn + ;; don't overwrite TBLFM, we might use text properties to store stuff + (goto-char (match-beginning 3)) + (delete-region (match-beginning 3) (match-end 0))) + (org-indent-line) + (insert (or (match-string 2) "#+TBLFM:"))) + (insert " " + (mapconcat (lambda (x) + (concat + (if (equal (string-to-char (car x)) ?@) "" "$") + (car x) "=" (cdr x))) + alist "::") + "\n")))) (defsubst org-table-formula-make-cmp-string (a) (when (string-match "\\`$[<>]" a) @@ -2133,10 +2147,10 @@ When NAMED is non-nil, look for a named equation." (defun org-table-get-stored-formulas (&optional noerror) "Return an alist with the stored formulas directly after current table." (interactive) - (let (scol eq eq-alist strings string seen) + (let ((case-fold-search t) scol eq eq-alist strings string seen) (save-excursion (goto-char (org-table-end)) - (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") + (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)") (setq strings (org-split-string (org-match-string-no-properties 2) " *:: *")) (while (setq string (pop strings)) @@ -2164,8 +2178,9 @@ KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. For all numbers larger than LIMIT, shift them by DELTA." (save-excursion (goto-char (org-table-end)) - (when (looking-at "[ \t]*#\\+TBLFM:") - (let ((re (concat key "\\([0-9]+\\)")) + (when (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) + (let ((msg "The formulas in #+TBLFM have been updated") + (re (concat key "\\([0-9]+\\)")) (re2 (when remove (if (or (equal key "$") (equal key "$LR")) @@ -2177,7 +2192,7 @@ For all numbers larger than LIMIT, shift them by DELTA." (while (re-search-forward re2 (point-at-eol) t) (unless (save-match-data (org-in-regexp "remote([^)]+?)")) (if (equal (char-before (match-beginning 0)) ?.) - (error "Change makes TBLFM term %s invalid. Use undo to recover." + (error "Change makes TBLFM term %s invalid, use undo to recover" (match-string 0)) (replace-match ""))))) (while (re-search-forward re (point-at-eol) t) @@ -2185,10 +2200,11 @@ For all numbers larger than LIMIT, shift them by DELTA." (setq s (match-string 1) n (string-to-number s)) (cond ((setq a (assoc s replace)) - (replace-match (concat key (cdr a)) t t)) + (replace-match (concat key (cdr a)) t t) + (message msg)) ((and limit (> n limit)) - (replace-match (concat key (int-to-string (+ n delta))) - t t))))))))) + (replace-match (concat key (int-to-string (+ n delta))) t t) + (message msg))))))))) (defun org-table-get-specials () "Get the column names and local parameters for this table." @@ -2234,8 +2250,8 @@ For all numbers larger than LIMIT, shift them by DELTA." (setq v (pop fields1) col (1+ col)) (when (and (stringp field) (stringp v) (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field)) - (push (cons field v) org-table-local-parameters) - (push (list field line col) org-table-named-field-locations)))) + (push (cons field v) org-table-local-parameters) + (push (list field line col) org-table-named-field-locations)))) ;; Analyse the line types (goto-char beg) (setq org-table-current-begin-line (org-current-line) @@ -2275,7 +2291,7 @@ If yes, store the formula and apply it." (when org-table-formula-evaluate-inline (let* ((field (org-trim (or (org-table-get-field) ""))) named eq) - (when (string-match "^:?=\\(.*\\)" field) + (when (string-match "^:?=\\(.*[^=]\\)$" field) (setq named (equal (string-to-char field) ?:) eq (match-string 1 field)) (if (or (fboundp 'calc-eval) @@ -2292,8 +2308,8 @@ Will be filled automatically during use.") '((" " . "Unmarked: no special line, no automatic recalculation") ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") - ("!" . "Column name definition line. Reference in formula as $name.") - ("$" . "Parameter definition line name=value. Reference in formula as $name.") + ("!" . "Column name definition line. Reference in formula as $name.") + ("$" . "Parameter definition line name=value. Reference in formula as $name.") ("_" . "Names for values in row below this one.") ("^" . "Names for values in row above this one."))) @@ -2489,8 +2505,7 @@ not overwrite the stored one." (setq orig (or (get-text-property 1 :orig-formula formula) "?")) (while (> ndown 0) (setq fields (org-split-string - (org-no-properties - (buffer-substring (point-at-bol) (point-at-eol))) + (buffer-substring-no-properties (point-at-bol) (point-at-eol)) " *| *")) ;; replace fields with duration values if relevant (if duration @@ -2589,10 +2604,17 @@ not overwrite the stored one." duration-output-format) ev)) (or (fboundp 'calc-eval) (error "Calc does not seem to be installed, and is needed to evaluate the formula")) - (setq ev (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num)) + ;; "Inactivate" time-stamps so that Calc can handle them + (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form)) + (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) + form + (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num))) ev (if duration (org-table-time-seconds-to-string - (string-to-number ev) - duration-output-format) ev))) + (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) + (string-to-number (org-table-time-string-to-seconds ev)) + (string-to-number ev)) + duration-output-format) + ev))) (when org-table-formula-debug (with-output-to-temp-buffer "*Substitution History*" @@ -2666,7 +2688,7 @@ in the buffer and column1 and column2 are table column numbers." (if (equal r2 "") (setq r2 nil)) (if r1 (setq r1 (org-table-get-descriptor-line r1))) (if r2 (setq r2 (org-table-get-descriptor-line r2))) -; (setq r2 (or r2 r1) c2 (or c2 c1)) + ; (setq r2 (or r2 r1) c2 (or c2 c1)) (if (not r1) (setq r1 thisline)) (if (not r2) (setq r2 thisline)) (if (or (not c1) (= 0 c1)) (setq c1 col)) @@ -2881,7 +2903,7 @@ known that the table will be realigned a little later anyway." (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a)) (nth 2 a)))) (when (member name1 seen-fields) - (error "Several field/range formulas try to set %s" name1)) + (error "Several field/range formulas try to set %s" name1)) (push name1 seen-fields) (and (not a) @@ -2961,6 +2983,7 @@ with the prefix ARG." (throw 'exit t))) (error "No convergence after %d iterations" i)))) +;;;###autoload (defun org-table-recalculate-buffer-tables () "Recalculate all tables in the current buffer." (interactive) @@ -2969,27 +2992,28 @@ with the prefix ARG." (widen) (org-table-map-tables (lambda () (org-table-recalculate t)) t)))) +;;;###autoload (defun org-table-iterate-buffer-tables () "Iterate all tables in the buffer, to converge inter-table dependencies." - (interactive) - (let* ((imax 10) - (checksum (md5 (buffer-string))) - - c1 - (i imax)) - (save-excursion - (save-restriction - (widen) - (catch 'exit - (while (> i 0) - (setq i (1- i)) - (org-table-map-tables (lambda () (org-table-recalculate t)) t) - (if (equal checksum (setq c1 (md5 (buffer-string)))) - (progn - (message "Convergence after %d iterations" (- imax i)) - (throw 'exit t)) - (setq checksum c1))) - (error "No convergence after %d iterations" imax)))))) + (interactive) + (let* ((imax 10) + (checksum (md5 (buffer-string))) + + c1 + (i imax)) + (save-excursion + (save-restriction + (widen) + (catch 'exit + (while (> i 0) + (setq i (1- i)) + (org-table-map-tables (lambda () (org-table-recalculate t)) t) + (if (equal checksum (setq c1 (md5 (buffer-string)))) + (progn + (message "Convergence after %d iterations" (- imax i)) + (throw 'exit t)) + (setq checksum c1))) + (error "No convergence after %d iterations" imax)))))) (defun org-table-expand-lhs-ranges (equations) "Expand list of formulas. @@ -2999,7 +3023,7 @@ them to individual field equations for each field." (while (setq e (pop equations)) (setq lhs (car e) rhs (cdr e)) (cond - ((string-match "^@-?[-+I0-9]+\\$-?[0-9]+$" lhs) + ((string-match "^@-?[-+0-9]+\\$-?[0-9]+$" lhs) ;; This just refers to one fixed field (push e res)) ((string-match "^[a-zA-Z][_a-zA-Z0-9]*$" lhs) @@ -3143,7 +3167,7 @@ Parameters get priority." (defun org-table-edit-formulas () "Edit the formulas of the current table in a separate buffer." (interactive) - (when (save-excursion (beginning-of-line 1) (looking-at "[ \t]*#\\+TBLFM")) + (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM"))) (beginning-of-line 0)) (unless (org-at-table-p) (error "Not at a table")) (org-table-get-specials) @@ -3217,7 +3241,7 @@ Parameters get priority." Works for single references, but also for entire formulas and even the full TBLFM line." (let ((start 0)) - (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^)]*)\\)" s start) + (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^,)]*)\\)" s start) (cond ((match-end 3) ;; format match, just advance @@ -3268,8 +3292,8 @@ For example: AB -> 28." (let ((n 0)) (setq s (upcase s)) (while (> (length s) 0) - (setq n (+ (* n 26) (string-to-char s) (- ?A) 1) - s (substring s 1))) + (setq n (+ (* n 26) (string-to-char s) (- ?A) 1) + s (substring s 1))) n)) (defun org-number-to-letters (n) @@ -3285,26 +3309,28 @@ For example: 28 -> AB." "Convert a time string into numerical duration in seconds. S can be a string matching either -?HH:MM:SS or -?HH:MM. If S is a string representing a number, keep this number." - (let (hour minus min sec res) - (cond - ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s)) - (setq minus (< 0 (length (match-string 1 s))) - hour (string-to-number (match-string 2 s)) - min (string-to-number (match-string 3 s)) - sec (string-to-number (match-string 4 s))) - (if minus - (setq res (- (+ (* hour 3600) (* min 60) sec))) - (setq res (+ (* hour 3600) (* min 60) sec)))) - ((and (not (string-match org-ts-regexp-both s)) - (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s)) - (setq minus (< 0 (length (match-string 1 s))) - hour (string-to-number (match-string 2 s)) - min (string-to-number (match-string 3 s))) - (if minus - (setq res (- (+ (* hour 3600) (* min 60)))) - (setq res (+ (* hour 3600) (* min 60))))) - (t (setq res (string-to-number s)))) - (number-to-string res))) + (if (equal s "") + s + (let (hour minus min sec res) + (cond + ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s)) + (setq minus (< 0 (length (match-string 1 s))) + hour (string-to-number (match-string 2 s)) + min (string-to-number (match-string 3 s)) + sec (string-to-number (match-string 4 s))) + (if minus + (setq res (- (+ (* hour 3600) (* min 60) sec))) + (setq res (+ (* hour 3600) (* min 60) sec)))) + ((and (not (string-match org-ts-regexp-both s)) + (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s)) + (setq minus (< 0 (length (match-string 1 s))) + hour (string-to-number (match-string 2 s)) + min (string-to-number (match-string 3 s))) + (if minus + (setq res (- (+ (* hour 3600) (* min 60)))) + (setq res (+ (* hour 3600) (* min 60))))) + (t (setq res (string-to-number s)))) + (number-to-string res)))) (defun org-table-time-seconds-to-string (secs &optional output-format) "Convert a number of seconds to a time string. @@ -3570,7 +3596,7 @@ With prefix ARG, apply the new formulas to the table." (if (get-buffer-window (marker-buffer pos)) (select-window (get-buffer-window (marker-buffer pos))) (org-switch-to-buffer-other-window (get-buffer-window - (marker-buffer pos))))) + (marker-buffer pos))))) (goto-char pos) (org-table-force-dataline) (when dest @@ -3779,7 +3805,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." "Toggle the display of Row/Column numbers in tables." (interactive) (setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) - (message "Row/Column number display turned %s" + (message "Tables Row/Column numbers display turned %s" (if org-table-overlay-coordinates "on" "off")) (if (and (org-at-table-p) org-table-overlay-coordinates) (org-table-align)) @@ -3835,7 +3861,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." "Local variable used by `orgtbl-mode'.") (defconst orgtbl-line-start-regexp - "[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\|TBLNAME\\):\\)" + "[ \t]*\\(|\\|#\\+\\(tblfm\\|orgtbl\\|tblname\\):\\)" "Matches a line belonging to an orgtbl.") (defconst orgtbl-extra-font-lock-keywords @@ -3853,7 +3879,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." :lighter " OrgTbl" :keymap orgtbl-mode-map (org-load-modules-maybe) (cond - ((eq major-mode 'org-mode) + ((derived-mode-p 'org-mode) ;; Exit without error, in case some hook functions calls this ;; by accident in org-mode. (message "Orgtbl-mode is not useful in org-mode, command ignored")) @@ -3975,37 +4001,37 @@ to execute outside of tables." ;; Special treatment needed for TAB and RET (org-defkey orgtbl-mode-map [(return)] - (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) + (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) (org-defkey orgtbl-mode-map "\C-m" - (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) + (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) (org-defkey orgtbl-mode-map [(tab)] - (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) + (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) (org-defkey orgtbl-mode-map "\C-i" - (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) + (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) (org-defkey orgtbl-mode-map [(shift tab)] - (orgtbl-make-binding 'org-table-previous-field 104 - [(shift tab)] [(tab)] "\C-i")) + (orgtbl-make-binding 'org-table-previous-field 104 + [(shift tab)] [(tab)] "\C-i")) (unless (featurep 'xemacs) (org-defkey orgtbl-mode-map [S-iso-lefttab] - (orgtbl-make-binding 'org-table-previous-field 107 - [S-iso-lefttab] [backtab] [(shift tab)] - [(tab)] "\C-i"))) + (orgtbl-make-binding 'org-table-previous-field 107 + [S-iso-lefttab] [backtab] [(shift tab)] + [(tab)] "\C-i"))) (org-defkey orgtbl-mode-map [backtab] - (orgtbl-make-binding 'org-table-previous-field 108 - [backtab] [S-iso-lefttab] [(shift tab)] - [(tab)] "\C-i")) + (orgtbl-make-binding 'org-table-previous-field 108 + [backtab] [S-iso-lefttab] [(shift tab)] + [(tab)] "\C-i")) (org-defkey orgtbl-mode-map "\M-\C-m" - (orgtbl-make-binding 'org-table-wrap-region 105 - "\M-\C-m" [(meta return)])) + (orgtbl-make-binding 'org-table-wrap-region 105 + "\M-\C-m" [(meta return)])) (org-defkey orgtbl-mode-map [(meta return)] - (orgtbl-make-binding 'org-table-wrap-region 106 - [(meta return)] "\M-\C-m")) + (orgtbl-make-binding 'org-table-wrap-region 106 + [(meta return)] "\M-\C-m")) (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) (org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region) @@ -4083,13 +4109,13 @@ to execute outside of tables." If it is a table to be sent away to a receiver, do it. With prefix arg, also recompute table." (interactive "P") - (let ((pos (point)) action consts-str consts cst const-str) + (let ((case-fold-search t) (pos (point)) action consts-str consts cst const-str) (save-excursion (beginning-of-line 1) (setq action (cond ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) ((looking-at "[ \t]*|") pos) - ((looking-at "[ \t]*#\\+TBLFM:") 'recalc)))) + ((looking-at "[ \t]*#\\+tblfm:") 'recalc)))) (cond ((integerp action) (goto-char action) @@ -4178,7 +4204,7 @@ overwritten, and the table is not marked as requiring realignment." (setq a (assoc last-input-event function-key-map)) (cdr a)) (vector last-input-event))) - 'self-insert-command))) + 'self-insert-command))) (call-interactively cmd) (if (and org-self-insert-cluster-for-undo (eq cmd 'self-insert-command)) @@ -4298,11 +4324,15 @@ this table." (params (plist-get dest :params)) (skip (plist-get params :skip)) (skipcols (plist-get params :skipcols)) + (no-escape (plist-get params :no-escape)) beg (lines (org-table-clean-before-export (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*")))) (i0 (if org-table-clean-did-remove-column 2 1)) + (lines (if no-escape lines + (mapcar (lambda(l) (replace-regexp-in-string + "\\([&%#_^]\\)" "\\\\\\1{}" l)) lines))) (table (mapcar (lambda (x) (if (string-match org-table-hline-regexp x) @@ -4324,7 +4354,7 @@ this table." (orgtbl-send-replace-tbl name txt)) (setq ntbl (1+ ntbl))) (message "Table converted and installed at %d receiver location%s" - ntbl (if (> ntbl 1) "s" "")) + ntbl (if (> ntbl 1) "s" "")) (if (> ntbl 0) ntbl nil)))) @@ -4344,12 +4374,13 @@ First element has index 0, or I0 if given." (defun orgtbl-toggle-comment () "Comment or uncomment the orgtbl at point." (interactive) - (let* ((re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) + (let* ((case-fold-search t) + (re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) (re2 (concat "^" orgtbl-line-start-regexp)) (commented (save-excursion (beginning-of-line 1) - (cond ((looking-at re1) t) - ((looking-at re2) nil) - (t (error "Not at an org table"))))) + (cond ((looking-at re1) t) + ((looking-at re2) nil) + (t (error "Not at an org table"))))) (re (if commented re1 re2)) beg end) (save-excursion @@ -4458,7 +4489,7 @@ PARAMS is a property list of parameters that can influence the conversion. For the generic converter, some parameters are obligatory: you need to specify either :lfmt, or all of (:lstart :lend :sep). -Valid parameters are +Valid parameters are: :splice When set to t, return only table body lines, don't wrap them into :tstart and :tend. Default is nil. When :splice @@ -4471,9 +4502,9 @@ Valid parameters are :sep Separator between two fields :remove-nil-lines Do not include lines that evaluate to nil. - Each in the following group may be either a string or a function of no arguments returning a string: + :tstart String to start the table. Ignored when :splice is t. :tend String to end the table. Ignored when :splice is t. :lstart String to start a new table line. @@ -4484,6 +4515,7 @@ of no arguments returning a string: Each in the following group may be a string, a function of one argument (the field or line) returning a string, or a plist mapping columns to either of the above: + :lfmt Format for entire line, with enough %s to capture all fields. If this is present, :lstart, :lend, and :sep are ignored. :llfmt Format for the entire last line, defaults to :lfmt. @@ -4491,14 +4523,14 @@ mapping columns to either of the above: %s for the original field value. For example, to wrap everything in dollars, you could use :fmt \"$%s$\". This may also be a property list with column numbers and - formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") - + formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") :hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt Same as above, specific for the header lines in the table. All lines before the first hline are treated as header. If any of these is not present, the data line value is used. This may be either a string or a function of two arguments: + :efmt Use this format to print numbers with exponentials. The format should have %s twice for inserting mantissa and exponent, for example \"%s\\\\times10^{%s}\". This @@ -4507,10 +4539,9 @@ This may be either a string or a function of two arguments: In addition to this, the parameters :skip and :skipcols are always handled directly by `orgtbl-send-table'. See manual." - (interactive) - (let* ((splicep (plist-get params :splice)) (hline (plist-get params :hline)) + (skipheadrule (plist-get params :skipheadrule)) (remove-nil-linesp (plist-get params :remove-nil-lines)) (remove-newlines (plist-get params :remove-newlines)) (*orgtbl-hline* hline) @@ -4556,7 +4587,7 @@ directly by `orgtbl-send-table'. See manual." (*orgtbl-sep* (or (plist-get params :hlsep) *orgtbl-sep*)) (*orgtbl-fmt* (or (plist-get params :hfmt) *orgtbl-fmt*))) (orgtbl-format-section 'hline)) - (if hline (push hline *orgtbl-rtn*)) + (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*)) (pop *orgtbl-table*))) ;; Now format the main section. @@ -4706,7 +4737,37 @@ provide ORGTBL directives for the generated table." :lstart "| " :lend " |")) (params (org-combine-plists params2 params))) - (orgtbl-to-generic table params))) + (with-temp-buffer + (insert (orgtbl-to-generic table params)) + (goto-char (point-min)) + (while (re-search-forward org-table-hline-regexp nil t) + (org-table-align)) + (buffer-substring 1 (buffer-size))))) + +(defun orgtbl-to-table.el (table params) + "Convert the orgtbl-mode TABLE into a table.el table." + (with-temp-buffer + (insert (orgtbl-to-orgtbl table params)) + (org-table-align) + (replace-regexp-in-string + "-|" "-+" + (replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size)))))) + +(defun orgtbl-to-unicode (table params) + "Convert the orgtbl-mode TABLE into a table with unicode characters. +You need the ascii-art-to-unicode.el package for this. You can download +it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." + (with-temp-buffer + (insert (orgtbl-to-table.el table params)) + (goto-char (point-min)) + (if (or (featurep 'ascii-art-to-unicode) + (require 'ascii-art-to-unicode nil t)) + (aa2u) + (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links)) + (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el" + "Link to ascii-art-to-unicode.el") org-stored-links)) + (error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) + (buffer-string))) (defun org-table-get-remote-range (name-or-id form) "Get a field value or a list of values in a range from table at ID. @@ -4722,7 +4783,7 @@ FORM is a field or range descriptor like \"@2$3\" or \"B3\" or The return value is either a single string for a single field, or a list of the fields in the rectangle ." (save-match-data - (let ((id-loc nil) + (let ((case-fold-search t) (id-loc nil) ;; Protect a bunch of variables from being overwritten ;; by the context of the remote table org-table-column-names org-table-column-name-regexp @@ -4741,7 +4802,7 @@ list of the fields in the rectangle ." (save-excursion (goto-char (point-min)) (if (re-search-forward - (concat "^[ \t]*#\\+TBLNAME:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") + (concat "^[ \t]*#\\+tblname:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") nil t) (setq buffer (current-buffer) loc (match-beginning 0)) (setq id-loc (org-id-find name-or-id 'marker)) diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el index 4409013589..aa645d296e 100644 --- a/lisp/org/org-taskjuggler.el +++ b/lisp/org/org-taskjuggler.el @@ -29,7 +29,7 @@ ;; ;; This library implements a TaskJuggler exporter for org-mode. ;; TaskJuggler uses a text format to define projects, tasks and -;; resources, so it is a natural fit for org-mode. It can produce all +;; resources, so it is a natural fit for org-mode. It can produce all ;; sorts of reports for tasks or resources in either HTML, CSV or PDF. ;; The current version of TaskJuggler requires KDE but the next ;; version is implemented in Ruby and should therefore run on any @@ -42,7 +42,7 @@ ;; ;; Instead the TaskJuggler exporter looks for a tree that defines the ;; tasks and a optionally tree that defines the resources for this -;; project. It then creates a TaskJuggler file based on these trees +;; project. It then creates a TaskJuggler file based on these trees ;; and the attributes defined in all the nodes. ;; ;; * Installation @@ -60,8 +60,8 @@ ;; ;; * Tasks ;; -;; Let's illustrate the usage with a small example. Create your tasks -;; as you usually do with org-mode. Assign efforts to each task using +;; Let's illustrate the usage with a small example. Create your tasks +;; as you usually do with org-mode. Assign efforts to each task using ;; properties (it's easiest to do this in the column view). You should ;; end up with something similar to the example by Peter Jones in ;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org. @@ -75,7 +75,7 @@ ;; * Resources ;; ;; Next you can define resources and assign those to work on specific -;; tasks. You can group your resources hierarchically. Tag the top +;; tasks. You can group your resources hierarchically. Tag the top ;; node of the resources with "taskjuggler_resource" (or whatever you ;; customized `org-export-taskjuggler-resource-tag' to). You can ;; optionally assign an identifier (named "resource_id") to the @@ -84,8 +84,8 @@ ;; picks the first word of the headline as the identifier as long as ;; it is unique, see the documentation of ;; `org-taskjuggler-get-unique-id'). Using that identifier you can -;; then allocate resources to tasks. This is again done with the -;; "allocate" property on the tasks. Do this in column view or when on +;; then allocate resources to tasks. This is again done with the +;; "allocate" property on the tasks. Do this in column view or when on ;; the task type ;; ;; C-c C-x p allocate RET <resource_id> RET @@ -110,13 +110,13 @@ ;; The exporter will handle dependencies that are defined in the tasks ;; either with the ORDERED attribute (see TODO dependencies in the Org ;; mode manual) or with the BLOCKER attribute (see org-depend.el) or -;; alternatively with a depends attribute. Both the BLOCKER and the +;; alternatively with a depends attribute. Both the BLOCKER and the ;; depends attribute can be either "previous-sibling" or a reference ;; to an identifier (named "task_id") which is defined for another -;; task in the project. BLOCKER and the depends attribute can define -;; multiple dependencies separated by either space or comma. You can +;; task in the project. BLOCKER and the depends attribute can define +;; multiple dependencies separated by either space or comma. You can ;; also specify optional attributes on the dependency by simply -;; appending it. The following examples should illustrate this: +;; appending it. The following examples should illustrate this: ;; ;; * Training material ;; :PROPERTIES: @@ -144,7 +144,7 @@ ;; org-global-properties-fixed ;; - What about property inheritance and org-property-inherit-p? ;; - Use TYPE_TODO as an way to assign resources -;; - Make sure multiple dependency definitions (i.e. BLOCKER on +;; - Make sure multiple dependency definitions (i.e. BLOCKER on ;; previous-sibling and on a specific task_id) in multiple ;; attributes are properly exported. ;; @@ -211,7 +211,7 @@ with `org-export-taskjuggler-project-tag'" hideresource 1 loadunit shortauto }" -"resourcereport \"Resource Graph\" { + "resourcereport \"Resource Graph\" { headline \"Resource Allocation Graph\" columns no, name, utilization, freeload, chart loadunit shortauto @@ -228,10 +228,10 @@ with `org-export-taskjuggler-project-tag'" workinghours wed, thu, fri off } " - "Default global properties for the project. Here you typically + "Default global properties for the project. Here you typically define global properties such as shifts, accounts, rates, -vacation, macros and flags. Any property that is allowed within -the TaskJuggler file can be inserted. You could for example +vacation, macros and flags. Any property that is allowed within +the TaskJuggler file can be inserted. You could for example include another TaskJuggler file. The global properties are inserted after the project declaration @@ -255,12 +255,12 @@ but before any resource and task declarations." "Export parts of the current buffer as a TaskJuggler file. The exporter looks for a tree with tag, property or todo that matches `org-export-taskjuggler-project-tag' and takes this as -the tasks for this project. The first node of this tree defines +the tasks for this project. The first node of this tree defines the project properties such as project name and project period. If there is a tree with tag, property or todo that matches `org-export-taskjuggler-resource-tag' this three is taken as -resources for the project. If no resources are specified, a -default resource is created and allocated to the project. Also +resources for the project. If no resources are specified, a +default resource is created and allocated to the project. Also the taskjuggler project will be created with default reports as defined in `org-export-taskjuggler-default-reports'." (interactive) @@ -352,7 +352,7 @@ with the TaskJuggler GUI." (defun org-taskjuggler-parent-is-ordered-p () "Return true if the parent of the current node has a property -\"ORDERED\". Return nil otherwise." +\"ORDERED\". Return nil otherwise." (save-excursion (and (org-up-heading-safe) (org-entry-get (point) "ORDERED")))) @@ -373,7 +373,7 @@ information, all the properties, etc." (defun org-taskjuggler-assign-task-ids (tasks) "Given a list of tasks return the same list assigning a unique id -and the full path to each task. Taskjuggler takes hierarchical ids. +and the full path to each task. Taskjuggler takes hierarchical ids. For that reason we have to make ids locally unique and we have to keep a path to the current task." (let ((previous-level 0) @@ -406,7 +406,7 @@ a path to the current task." (defun org-taskjuggler-compute-task-leafiness (tasks) "Figure out if each task is a leaf by looking at it's level, -and the level of its successor. If the successor is higher (ie +and the level of its successor. If the successor is higher (ie deeper), then it's not a leaf." (let (new-list) (while (car tasks) @@ -452,8 +452,8 @@ unique id to each resource." (and depends (org-taskjuggler-tokenize-dependencies depends)) (and blocker (org-taskjuggler-tokenize-dependencies blocker))) tasks)) - previous-sibling) - ; update previous sibling info + previous-sibling) + ; update previous sibling info (cond ((< previous-level level) (dotimes (tmp (- level previous-level)) @@ -466,11 +466,11 @@ unique id to each resource." (pop siblings)) (setq previous-sibling (car siblings)) (setcar siblings task))) - ; insert a dependency on previous sibling if the parent is - ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling" + ; insert a dependency on previous sibling if the parent is + ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling" (when (or (and previous-sibling parent-ordered) blocked-on-previous) (push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies)) - ; store dependency information + ; store dependency information (when dependencies (push (cons "depends" (mapconcat 'identity dependencies ", ")) task)) (setq previous-level level) @@ -480,7 +480,7 @@ unique id to each resource." "Split a dependency property value DEPENDENCIES into the individual dependencies and return them as a list while keeping the optional arguments (such as gapduration) for the -dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'." +dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'." (cond ((string-match "^ *$" dependencies) nil) ((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies) @@ -493,7 +493,7 @@ dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'." "For each dependency in DEPENDENCIES try to find a corresponding task with a matching property \"task_id\" in TASKS. Return a list containing the resolved links for all DEPENDENCIES -where a matching tasks was found. If the dependency is +where a matching tasks was found. If the dependency is \"previous-sibling\" it is ignored (as this is dealt with in `org-taskjuggler-resolve-dependencies'). If there is no matching task the dependency is ignored and a warning is displayed ." @@ -523,7 +523,7 @@ task the dependency is ignored and a warning is displayed ." (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)))))) (defun org-taskjuggler-find-task-with-id (id tasks) - "Find ID in tasks. If found return the path of task. Otherwise + "Find ID in tasks. If found return the path of task. Otherwise return nil." (let ((task-id (cdr (assoc "task_id" (car tasks)))) (path (cdr (assoc "path" (car tasks))))) @@ -541,10 +541,10 @@ finally add more underscore characters (\"_\")." (let* ((headline (cdr (assoc "headline" item))) (parts (split-string headline)) (id (org-taskjuggler-clean-id (downcase (pop parts))))) - ; try to add more parts of the headline to make it unique + ; try to add more parts of the headline to make it unique (while (and (member id unique-ids) (car parts)) (setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts)))))) - ; if its still not unique add "_" + ; if its still not unique add "_" (while (member id unique-ids) (setq id (concat id "_"))) id)) @@ -559,8 +559,8 @@ finally add more underscore characters (\"_\")." (replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id)))) (defun org-taskjuggler-open-project (project) - "Insert the beginning of a project declaration. All valid -attributes from the PROJECT alist are inserted. If no end date is + "Insert the beginning of a project declaration. All valid +attributes from the PROJECT alist are inserted. If no end date is specified it is calculated `org-export-taskjuggler-default-project-duration' days from now." (let* ((unique-id (cdr (assoc "unique-id" project))) @@ -580,9 +580,9 @@ with separator \"\n\"." (and filtered-items (mapconcat 'identity filtered-items "\n")))) (defun org-taskjuggler-get-attributes (item attributes) - "Return all attribute as a single formatted string. ITEM is an -alist representing either a resource or a task. ATTRIBUTES is a -list of symbols. Only entries from ITEM are considered that are + "Return all attribute as a single formatted string. ITEM is an +alist representing either a resource or a task. ATTRIBUTES is a +list of symbols. Only entries from ITEM are considered that are listed in ATTRIBUTES." (org-taskjuggler-filter-and-join (mapcar @@ -603,10 +603,10 @@ If the ATTRIBUTE is not in ITEM return nil." (t (org-taskjuggler-get-attribute (cdr item) attribute)))) (defun org-taskjuggler-open-resource (resource) - "Insert the beginning of a resource declaration. All valid -attributes from the RESOURCE alist are inserted. If the RESOURCE + "Insert the beginning of a resource declaration. All valid +attributes from the RESOURCE alist are inserted. If the RESOURCE defines a property \"resource_id\" it will be used as the id for -this resource. Otherwise it will use the ID property. If neither +this resource. Otherwise it will use the ID property. If neither is defined it will calculate a unique id for the resource using `org-taskjuggler-get-unique-id'." (let ((id (org-taskjuggler-clean-id @@ -622,7 +622,7 @@ is defined it will calculate a unique id for the resource using (defun org-taskjuggler-clean-effort (effort) "Translate effort strings into a format acceptable to taskjuggler, -i.e. REAL UNIT. A valid effort string can be anything that is +i.e. REAL UNIT. A valid effort string can be anything that is accepted by `org-duration-string-to-minutes´." (cond ((null effort) effort) diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index a3bde0fd7f..92aaf1c7bb 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -56,6 +56,22 @@ When 0, the user is prompted for a value." :version "24.1" :type 'number) +(defcustom org-timer-display 'mode-line + "When a timer is running, org-mode can display it in the mode +line and/or frame title. +Allowed values are: + +both displays in both mode line and frame title +mode-line displays only in mode line (default) +frame-title displays only in frame title +nil current timer is not displayed" + :group 'org-time + :type '(choice + (const :tag "Mode line" mode-line) + (const :tag "Frame title" frame-title) + (const :tag "Both" both) + (const :tag "None" nil))) + (defvar org-timer-start-hook nil "Hook run after relative timer is started.") @@ -66,7 +82,7 @@ When 0, the user is prompted for a value." "Hook run before relative timer is paused.") (defvar org-timer-continue-hook nil - "Hook run after relative timer is continued.") + "Hook run after relative timer is continued.") (defvar org-timer-set-hook nil "Hook run after countdown timer is set.") @@ -114,6 +130,7 @@ the region 0:00:00." (org-timer-secs-to-hms (or delta 0))) (run-hooks 'org-timer-start-hook)))) +;;;###autoload (defun org-timer-pause-or-continue (&optional stop) "Pause or continue the relative timer. With prefix arg STOP, stop it entirely." @@ -140,6 +157,7 @@ With prefix arg STOP, stop it entirely." (org-timer-set-mode-line 'pause) (message "Timer paused at %s" (org-timer-value-string))))) +;;;###autoload (defun org-timer-stop () "Stop the relative timer." (interactive) @@ -181,7 +199,7 @@ it in the buffer." (defun org-timer-change-times-in-region (beg end delta) "Change all h:mm:ss time in region by a DELTA." (interactive - "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ") + "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ") (let ((re "[-+]?[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}") p) (unless (string-match "\\S-" delta) (save-excursion @@ -224,7 +242,7 @@ it in the buffer." ;; Else, start a new list. (t (beginning-of-line) - (org-indent-line-function) + (org-indent-line) (insert "- ") (org-timer (when arg '(4))) (insert ":: "))))) @@ -270,32 +288,54 @@ If the integer is negative, the string will start with \"-\"." (defun org-timer-set-mode-line (value) "Set the mode-line display of the relative timer. VALUE can be `on', `off', or `pause'." - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-timer-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-timer-mode-line-string)))) + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-timer-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-timer-mode-line-string))))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (or (memq 'org-timer-mode-line-string frame-title-format) + (setq frame-title-format + (append frame-title-format '(org-timer-mode-line-string))))) (cond ((equal value 'off) (when org-timer-mode-line-timer (cancel-timer org-timer-mode-line-timer) (setq org-timer-mode-line-timer nil)) - (setq global-mode-string - (delq 'org-timer-mode-line-string global-mode-string)) + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (setq global-mode-string + (delq 'org-timer-mode-line-string global-mode-string))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (setq frame-title-format + (delq 'org-timer-mode-line-string frame-title-format))) (force-mode-line-update)) ((equal value 'pause) (when org-timer-mode-line-timer (cancel-timer org-timer-mode-line-timer) (setq org-timer-mode-line-timer nil))) ((equal value 'on) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-timer-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-timer-mode-line-string)))) + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-timer-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-timer-mode-line-string))))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (or (memq 'org-timer-mode-line-string frame-title-format) + (setq frame-title-format + (append frame-title-format '(org-timer-mode-line-string))))) (org-timer-update-mode-line) (when org-timer-mode-line-timer - (cancel-timer org-timer-mode-line-timer)) - (setq org-timer-mode-line-timer - (run-with-timer 1 1 'org-timer-update-mode-line))))) + (cancel-timer org-timer-mode-line-timer) + (setq org-timer-mode-line-timer nil)) + (when org-timer-display + (setq org-timer-mode-line-timer + (run-with-timer 1 1 'org-timer-update-mode-line)))))) (defun org-timer-update-mode-line () "Update the timer time in the mode line." @@ -358,48 +398,48 @@ replace any running timer." (number-to-string org-timer-default-timer)))))) (if (not (string-match "[0-9]+" minutes)) (org-timer-show-remaining-time) - (let* ((mins (string-to-number (match-string 0 minutes))) - (secs (* mins 60)) - (hl (cond - ((string-match "Org Agenda" (buffer-name)) - (let* ((marker (or (get-text-property (point) 'org-marker) - (org-agenda-error))) - (hdmarker (or (get-text-property (point) 'org-hd-marker) - marker)) - (pos (marker-position marker))) - (with-current-buffer (marker-buffer marker) - (widen) - (goto-char pos) - (org-show-entry) - (or (ignore-errors (org-get-heading)) - (concat "File:" (file-name-nondirectory (buffer-file-name))))))) - ((eq major-mode 'org-mode) - (or (ignore-errors (org-get-heading)) - (concat "File:" (file-name-nondirectory (buffer-file-name))))) - (t (error "Not in an Org buffer")))) - timer-set) - (if (or (and org-timer-current-timer - (or (equal opt '(16)) - (y-or-n-p "Replace current timer? "))) - (not org-timer-current-timer)) - (progn - (require 'org-clock) - (when org-timer-current-timer - (cancel-timer org-timer-current-timer)) - (setq org-timer-current-timer - (run-with-timer - secs nil `(lambda () - (setq org-timer-current-timer nil) - (org-notify ,(format "%s: time out" hl) t) - (setq org-timer-timer-is-countdown nil) - (org-timer-set-mode-line 'off) - (run-hooks 'org-timer-done-hook)))) - (run-hooks 'org-timer-set-hook) - (setq org-timer-timer-is-countdown t - org-timer-start-time - (time-add (current-time) (seconds-to-time (* mins 60)))) - (org-timer-set-mode-line 'on)) - (message "No timer set")))))) + (let* ((mins (string-to-number (match-string 0 minutes))) + (secs (* mins 60)) + (hl (cond + ((string-match "Org Agenda" (buffer-name)) + (let* ((marker (or (get-text-property (point) 'org-marker) + (org-agenda-error))) + (hdmarker (or (get-text-property (point) 'org-hd-marker) + marker)) + (pos (marker-position marker))) + (with-current-buffer (marker-buffer marker) + (widen) + (goto-char pos) + (org-show-entry) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))))) + ((derived-mode-p 'org-mode) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))) + (t (error "Not in an Org buffer")))) + timer-set) + (if (or (and org-timer-current-timer + (or (equal opt '(16)) + (y-or-n-p "Replace current timer? "))) + (not org-timer-current-timer)) + (progn + (require 'org-clock) + (when org-timer-current-timer + (cancel-timer org-timer-current-timer)) + (setq org-timer-current-timer + (run-with-timer + secs nil `(lambda () + (setq org-timer-current-timer nil) + (org-notify ,(format "%s: time out" hl) t) + (setq org-timer-timer-is-countdown nil) + (org-timer-set-mode-line 'off) + (run-hooks 'org-timer-done-hook)))) + (run-hooks 'org-timer-set-hook) + (setq org-timer-timer-is-countdown t + org-timer-start-time + (time-add (current-time) (seconds-to-time (* mins 60)))) + (org-timer-set-mode-line 'on)) + (message "No timer set")))))) (provide 'org-timer) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el new file mode 100644 index 0000000000..688947def5 --- /dev/null +++ b/lisp/org/org-version.el @@ -0,0 +1,27 @@ +;;; org-version.el --- autogenerated file, do not edit +;; +;;; Code: +;;;###autoload +(defun org-release () + "The release version of org-mode. + Inserted by installing org-mode or when a release is made." + (let ((org-release "7.9.2")) + org-release)) +;;;###autoload +(defun org-git-version () + "The Git version of org-mode. + Inserted by installing org-mode or when a release is made." + (let ((org-git-version "7.9.2-GNU-Emacs-24-3")) + org-git-version)) +;;;###autoload +(defconst org-odt-data-dir "/usr/share/emacs/etc/org" + "The location of ODT styles.") + +(provide 'org-version) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; coding: utf-8 +;; End: +;;; org-version.el ends here diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el index b6975ff115..b919cd19fe 100644 --- a/lisp/org/org-vm.el +++ b/lisp/org/org-vm.el @@ -6,6 +6,10 @@ ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org ;; +;; Support for IMAP folders added +;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net> +;; Requires VM 8.2.0a or later. +;; ;; This file is part of GNU Emacs. ;; ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -42,11 +46,17 @@ (declare-function vm-su-message-id "ext:vm-summary" (m)) (declare-function vm-su-subject "ext:vm-summary" (m)) (declare-function vm-summarize "ext:vm-summary" (&optional display raise)) +(declare-function vm-imap-folder-p "ext:vm-save" ()) +(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer)) +(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec)) +(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec)) +(declare-function vm-imap-spec-for-account "ext:vm-imap" (account)) (defvar vm-message-pointer) (defvar vm-folder-directory) ;; Install the link type (org-add-link-type "vm" 'org-vm-open) +(org-add-link-type "vm-imap" 'org-vm-imap-open) (add-hook 'org-store-link-functions 'org-vm-store-link) ;; Implementation @@ -61,11 +71,11 @@ (save-excursion (vm-select-folder-buffer) (let* ((message (car vm-message-pointer)) - (folder buffer-file-name) - (subject (vm-su-subject message)) + (subject (vm-su-subject message)) (to (vm-get-header-contents message "To")) (from (vm-get-header-contents message "From")) - (message-id (vm-su-message-id message)) + (message-id (vm-su-message-id message)) + (link-type (if (vm-imap-folder-p) "vm-imap" "vm")) (date (vm-get-header-contents message "Date")) (date-ts (and date (format-time-string (org-time-stamp-format t) @@ -73,20 +83,24 @@ (date-ts-ia (and date (format-time-string (org-time-stamp-format t t) (date-to-time date)))) - desc link) - (org-store-link-props :type "vm" :from from :to to :subject subject + folder desc link) + (if (vm-imap-folder-p) + (let ((spec (vm-imap-find-spec-for-buffer (current-buffer)))) + (setq folder (vm-imap-folder-for-spec spec))) + (progn + (setq folder (abbreviate-file-name buffer-file-name)) + (if (and vm-folder-directory + (string-match (concat "^" (regexp-quote vm-folder-directory)) + folder)) + (setq folder (replace-match "" t t folder))))) + (setq message-id (org-remove-angle-brackets message-id)) + (org-store-link-props :type link-type :from from :to to :subject subject :message-id message-id) (when date (org-add-link-props :date date :date-timestamp date-ts :date-timestamp-inactive date-ts-ia)) - (setq message-id (org-remove-angle-brackets message-id)) - (setq folder (abbreviate-file-name folder)) - (if (and vm-folder-directory - (string-match (concat "^" (regexp-quote vm-folder-directory)) - folder)) - (setq folder (replace-match "" t t folder))) (setq desc (org-email-link-description)) - (setq link (org-make-link "vm:" folder "#" message-id)) + (setq link (concat (concat link-type ":") folder "#" message-id)) (org-add-link-props :link link :description desc) link)))) @@ -121,21 +135,46 @@ (setq folder (format "/%s@%s:%s" user host file)))))) (when folder (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) - (sit-for 0.1) (when article - (require 'vm-search) - (vm-select-folder-buffer) - (widen) - (let ((case-fold-search t)) - (goto-char (point-min)) - (if (not (re-search-forward - (concat "^" "message-id: *" (regexp-quote article)))) - (error "Could not find the specified message in this folder")) - (vm-isearch-update) - (vm-isearch-narrow) - (vm-preview-current-message) - (vm-summarize))))) + (org-vm-select-message (org-add-angle-brackets article))))) + +(defun org-vm-imap-open (path) + "Follow a VM link to an IMAP folder." + (require 'vm-imap) + (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path) + (let* ((account-name (match-string 1 path)) + (mailbox-name (match-string 2 path)) + (message-id (match-string 3 path)) + (account-spec (vm-imap-parse-spec-to-list + (vm-imap-spec-for-account account-name))) + (mailbox-spec (mapconcat 'identity + (append (butlast account-spec 4) + (cons mailbox-name + (last account-spec 3))) + ":"))) + (funcall (cdr (assq 'vm-imap org-link-frame-setup)) + mailbox-spec) + (when message-id + (org-vm-select-message (org-add-angle-brackets message-id)))))) + +(defun org-vm-select-message (message-id) + "Go to the message with message-id in the current folder." + (require 'vm-search) + (sit-for 0.1) + (vm-select-folder-buffer) + (widen) + (let ((case-fold-search t)) + (goto-char (point-min)) + (if (not (re-search-forward + (concat "^" "message-id: *" (regexp-quote message-id)))) + (error "Could not find the specified message in this folder")) + (vm-isearch-update) + (vm-isearch-narrow) + (vm-preview-current-message) + (vm-summarize))) (provide 'org-vm) + + ;;; org-vm.el ends here diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index 8a79ec0d76..724b07a288 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -34,9 +34,9 @@ (require 'org) (defgroup org-wl nil - "Options concerning the Wanderlust link." - :tag "Org Startup" - :group 'org-link) + "Options concerning the Wanderlust link." + :tag "Org Startup" + :group 'org-link) (defcustom org-wl-link-to-refile-destination t "Create a link to the refile destination if the message is marked as refile." @@ -161,7 +161,7 @@ ENTITY is a message entity." "Store a link to a WL folder." (let* ((folder (wl-folder-get-entity-from-buffer)) (petname (wl-folder-get-petname folder)) - (link (org-make-link "wl:" folder))) + (link (concat "wl:" folder))) (save-excursion (beginning-of-line) (unless (and (wl-folder-buffer-group-p) @@ -246,7 +246,7 @@ ENTITY is a message entity." :subject subject :message-id message-id :message-id-no-brackets message-id-no-brackets) (setq desc (org-email-link-description)) - (setq link (org-make-link "wl:" folder-name "#" message-id-no-brackets)) + (setq link (concat "wl:" folder-name "#" message-id-no-brackets)) (org-add-link-props :link link :description desc))) (when date (org-add-link-props :date date :date-timestamp date-ts @@ -309,7 +309,7 @@ for namazu index." article)) (or (wl-summary-jump-to-msg (string-to-number article)) (error "No such message: %s" article))) - (wl-summary-redisplay)))))) + (wl-summary-redisplay)))))) (provide 'org-wl) diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el index a282fbf180..ee549627a8 100644 --- a/lisp/org/org-xoxo.el +++ b/lisp/org/org-xoxo.el @@ -49,7 +49,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*" (with-current-buffer (get-buffer buffer) (let* ((pos (point)) (opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) + (org-infile-export-plist))) (filename (concat (file-name-as-directory (org-export-directory :xoxo opt-plist)) (file-name-sans-extension diff --git a/lisp/org/org.el b/lisp/org/org.el index f431c19bf5..cfd86513fb 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -1,4 +1,5 @@ ;;; org.el --- Outline-based notes management and organizer + ;; Carstens outline-mode for keeping track of everything. ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. ;; @@ -6,7 +7,6 @@ ;; Maintainer: Bastien Guerry <bzg at gnu dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.8.11 ;; ;; This file is part of GNU Emacs. ;; @@ -75,8 +75,28 @@ (require 'gnus-sum)) (require 'calendar) +(require 'find-func) (require 'format-spec) +;; `org-outline-regexp' ought to be a defconst but is let-binding in +;; some places -- e.g. see the macro org-with-limited-levels. +;; +;; In Org buffers, the value of `outline-regexp' is that of +;; `org-outline-regexp'. The only function still directly relying on +;; `outline-regexp' is `org-overview' so that `org-cycle' can do its +;; job when `orgstruct-mode' is active. +(defvar org-outline-regexp "\\*+ " + "Regexp to match Org headlines.") + +(defvar org-outline-regexp-bol "^\\*+ " + "Regexp to match Org headlines. +This is similar to `org-outline-regexp' but additionally makes +sure that we are at the beginning of the line.") + +(defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" + "Matches an headline, putting stars and text into groups. +Stars are put in group 1 and the trimmed body in group 2.") + ;; Emacs 22 calendar compatibility: Make sure the new variables are available (when (fboundp 'defvaralias) (unless (boundp 'calendar-view-holidays-initially-flag) @@ -88,22 +108,6 @@ (unless (boundp 'diary-fancy-buffer) (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))) -(require 'outline) (require 'noutline) -;; Other stuff we need. -(require 'time-date) -(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) -(require 'easymenu) -(require 'overlay) - -(require 'org-macs) -(require 'org-entities) -(require 'org-compat) -(require 'org-faces) -(require 'org-list) -(require 'org-pcomplete) -(require 'org-src) -(require 'org-footnote) - (declare-function org-inlinetask-at-task-p "org-inlinetask" ()) (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) @@ -111,15 +115,7 @@ (declare-function org-at-clock-log-p "org-clock" ()) (declare-function org-clock-timestamps-up "org-clock" ()) (declare-function org-clock-timestamps-down "org-clock" ()) - -;; babel -(require 'ob) -(require 'ob-table) -(require 'ob-lob) -(require 'ob-ref) -(require 'ob-tangle) -(require 'ob-comint) -(require 'ob-keys) +(declare-function org-clock-sum-current-item "org-clock" (&optional tstart)) ;; load languages based on value of `org-babel-load-languages' (defvar org-babel-load-languages) @@ -169,11 +165,13 @@ requirements) is loaded." (const :tag "Fortran" fortran) (const :tag "Gnuplot" gnuplot) (const :tag "Haskell" haskell) + (const :tag "IO" io) (const :tag "Java" java) (const :tag "Javascript" js) - (const :tag "Latex" latex) + (const :tag "LaTeX" latex) (const :tag "Ledger" ledger) (const :tag "Lilypond" lilypond) + (const :tag "Lisp" lisp) (const :tag "Maxima" maxima) (const :tag "Matlab" matlab) (const :tag "Mscgen" mscgen) @@ -186,6 +184,7 @@ requirements) is loaded." (const :tag "Python" python) (const :tag "Ruby" ruby) (const :tag "Sass" sass) + (const :tag "Scala" scala) (const :tag "Scheme" scheme) (const :tag "Screen" screen) (const :tag "Shell Script" sh) @@ -205,38 +204,40 @@ identifier." :group 'org-id) ;;; Version - -(defconst org-version "7.8.11" - "The version number of the file org.el.") - +(require 'org-compat) +(org-check-version) ;;;###autoload -(defun org-version (&optional here) +(defun org-version (&optional here full message) "Show the org-mode version in the echo area. -With prefix arg HERE, insert it at point." +With prefix argument HERE, insert it at point. +When FULL is non-nil, use a verbose version string. +When MESSAGE is non-nil, display a message with the version." (interactive "P") - (let* ((origin default-directory) - (version org-version) - (git-version) - (dir (concat (file-name-directory (locate-library "org")) "../" ))) - (when (and (file-exists-p (expand-file-name ".git" dir)) - (executable-find "git")) - (unwind-protect - (progn - (cd dir) - (when (eql 0 (shell-command "git describe --abbrev=4 HEAD")) - (with-current-buffer "*Shell Command Output*" - (goto-char (point-min)) - (setq git-version (buffer-substring (point) (point-at-eol)))) - (subst-char-in-string ?- ?. git-version t) - (when (string-match "\\S-" - (shell-command-to-string - "git diff-index --name-only HEAD --")) - (setq git-version (concat git-version ".dirty"))) - (setq version (concat version " (" git-version ")")))) - (cd origin))) - (setq version (format "Org-mode version %s" version)) - (if here (insert version)) - (message version))) + (let* ((org-dir (ignore-errors (org-find-library-dir "org"))) + (org-install-dir (ignore-errors (org-find-library-dir "org-install.el"))) + (org-trash (or + (and (fboundp 'org-release) (fboundp 'org-git-version)) + (load (concat org-dir "org-version.el") + 'noerror 'nomessage 'nosuffix))) + (org-version (org-release)) + (git-version (org-git-version)) + (version (format "Org-mode version %s (%s @ %s)" + org-version + git-version + (if org-install-dir + (if (string= org-dir org-install-dir) + org-install-dir + (concat "mixed installation! " org-install-dir " and " org-dir)) + "org-install.el can not be found!"))) + (_version (if full version org-version))) + (if (org-called-interactively-p 'interactive) + (if here + (insert version) + (message version)) + (if message (message _version)) + _version))) + +(defconst org-version (org-version)) ;;; Compatibility constants @@ -497,7 +498,7 @@ frequently in plain text. Not all export backends support this, but HTML does. -This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." +This option can also be set with the #+OPTIONS line, e.g. \"^:nil\"." :group 'org-startup :group 'org-export-translation :version "24.1" @@ -673,6 +674,13 @@ Changes become only effective after restarting Emacs." :group 'org-keywords :type 'string) +(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\(" + org-scheduled-string "\\|" + org-deadline-string "\\|" + org-closed-string "\\|" + org-clock-string "\\)") + "Matches a line with planning or clock info.") + (defcustom org-comment-string "COMMENT" "Entries starting with this keyword will never be exported. An entry can be toggled between COMMENT and normal with @@ -691,7 +699,7 @@ An entry can be toggled between QUOTE and normal with :type 'string) (defconst org-repeat-re - "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)" + "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" "Regular expression for specifying repeated events. After a match, group 1 contains the repeat expression.") @@ -815,7 +823,7 @@ commands should be active." (function))) (defcustom org-speed-commands-user nil - "Alist of additional speed commands. + "Alist of additional speed commands. This list will be checked before `org-speed-commands-default' when the variable `org-use-speed-commands' is non-nil and when the cursor is at the beginning of a headline. @@ -826,15 +834,15 @@ to be called, or a form to be evaluated. An entry that is just a list with a single string will be interpreted as a descriptive headline that will be added when listing the speed commands in the Help buffer using the `?' speed command." - :group 'org-structure - :type '(repeat :value ("k" . ignore) - (choice :value ("k" . ignore) - (list :tag "Descriptive Headline" (string :tag "Headline")) - (cons :tag "Letter and Command" - (string :tag "Command letter") - (choice - (function) - (sexp)))))) + :group 'org-structure + :type '(repeat :value ("k" . ignore) + (choice :value ("k" . ignore) + (list :tag "Descriptive Headline" (string :tag "Headline")) + (cons :tag "Letter and Command" + (string :tag "Command letter") + (choice + (function) + (sexp)))))) (defgroup org-cycle nil "Options concerning visibility cycling in Org-mode." @@ -891,13 +899,11 @@ This can also be set in on a per-file basis with (defcustom org-cycle-global-at-bob nil "Cycle globally if cursor is at beginning of buffer and not at a headline. This makes it possible to do global cycling without having to use S-TAB or -\\[universal-argument] TAB. For this special case to work, the first line \ -of the buffer -must not be a headline - it may be empty or some other text. When used in -this way, `org-cycle-hook' is disables temporarily, to make sure the -cursor stays at the beginning of the buffer. -When this option is nil, don't do anything special at the beginning -of the buffer." +\\[universal-argument] TAB. For this special case to work, the first line +of the buffer must not be a headline -- it may be empty or some other text. +When used in this way, `org-cycle-hook' is disabled temporarily to make +sure the cursor stays at the beginning of the buffer. When this option is +nil, don't do anything special at the beginning of the buffer." :group 'org-cycle :type 'boolean) @@ -969,7 +975,7 @@ the values `folded', `children', or `subtree'." The function(s) in this hook must accept a single argument which indicates the new state that was set by the most recent `org-cycle' command. The argument is a symbol. After a global state change, it can have the values -`overview', `content', or `all'. After a local state change, it can have +`overview', `contents', or `all'. After a local state change, it can have the values `folded', `children', or `subtree'." :group 'org-cycle :type 'hook) @@ -1023,23 +1029,25 @@ indentation in a virtual way, i.e. at display time in Emacs." "Non-nil means `C-a' and `C-e' behave specially in headlines and items. When t, `C-a' will bring back the cursor to the beginning of the -headline text, i.e. after the stars and after a possible TODO keyword. -In an item, this will be the position after the bullet. -When the cursor is already at that position, another `C-a' will bring -it to the beginning of the line. - -`C-e' will jump to the end of the headline, ignoring the presence of tags -in the headline. A second `C-e' will then jump to the true end of the -line, after any tags. This also means that, when this variable is -non-nil, `C-e' also will never jump beyond the end of the heading of a -folded section, i.e. not after the ellipses. - -When set to the symbol `reversed', the first `C-a' or `C-e' works normally, -going to the true line boundary first. Only a directly following, identical -keypress will bring the cursor to the special positions. - -This may also be a cons cell where the behavior for `C-a' and `C-e' is -set separately." +headline text, i.e. after the stars and after a possible TODO +keyword. In an item, this will be the position after bullet and +check-box, if any. When the cursor is already at that position, +another `C-a' will bring it to the beginning of the line. + +`C-e' will jump to the end of the headline, ignoring the presence +of tags in the headline. A second `C-e' will then jump to the +true end of the line, after any tags. This also means that, when +this variable is non-nil, `C-e' also will never jump beyond the +end of the heading of a folded section, i.e. not after the +ellipses. + +When set to the symbol `reversed', the first `C-a' or `C-e' works +normally, going to the true line boundary first. Only a directly +following, identical keypress will bring the cursor to the +special positions. + +This may also be a cons cell where the behavior for `C-a' and +`C-e' is set separately." :group 'org-edit-structure :type '(choice (const :tag "off" nil) @@ -1274,7 +1282,8 @@ See also the variable `org-table-auto-blank-field'." (const :tag "on" t) (const :tag "on, optimized" optimized))) -(defcustom org-self-insert-cluster-for-undo t +(defcustom org-self-insert-cluster-for-undo (or (featurep 'xemacs) + (version<= emacs-version "24.1")) "Non-nil means cluster self-insert commands for undo when possible. If this is set, then, like in the Emacs command loop, 20 consecutive characters will be undone together. @@ -1311,9 +1320,12 @@ The 'linkkey' must be a word word, starting with a letter, followed by letters, numbers, '-' or '_'. If REPLACE is a string, the tag will simply be appended to create the link. -If the string contains \"%s\", the tag will be inserted there. Alternatively, -the placeholder \"%h\" will cause a url-encoded version of the tag to -be inserted at that point (see the function `url-hexify-string'). +If the string contains \"%s\", the tag will be inserted there. If the string +contains \"%h\", it will cause a url-encoded version of the tag to be inserted +at that point (see the function `url-hexify-string'). If the string contains +the specifier \"%(my-function)\", then the custom function `my-function' will +be invoked: this function takes the tag as its only argument and must return +a string. REPLACE may also be a function that will be called with the tag as the only argument to create the link, which should be returned as a string. @@ -1383,11 +1395,11 @@ Changing this variable requires a restart of Emacs to become effective." (const :tag "Footnotes" footnote))) (defcustom org-make-link-description-function nil - "Function to use to generate link descriptions from links. -If nil the link location will be used. This function must take -two parameters; the first is the link and the second the -description `org-insert-link' has generated, and should return the -description to use." + "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." :group 'org-link :type 'function) @@ -1396,6 +1408,12 @@ description to use." :tag "Org Store Link" :group 'org-link) +(defcustom org-url-hexify-p t + "When non-nil, hexify URL when creating a link." + :type 'boolean + :version "24.3" + :group 'org-link-store) + (defcustom org-email-link-description-format "Email %c: %.30s" "Format of the description part of a link to an email or usenet message. The following %-escapes will be replaced by corresponding information: @@ -1429,46 +1447,6 @@ It should match if the message is from the user him/herself." :group 'org-link-store :type 'regexp) -(defcustom org-link-to-org-use-id 'create-if-interactive-and-no-custom-id - "Non-nil means storing a link to an Org file will use entry IDs. - -Note that before this variable is even considered, org-id must be loaded, -so please customize `org-modules' and turn it on. - -The variable can have the following values: - -t Create an ID if needed to make a link to the current entry. - -create-if-interactive - If `org-store-link' is called directly (interactively, as a user - command), do create an ID to support the link. But when doing the - job for remember, only use the ID if it already exists. The - purpose of this setting is to avoid proliferation of unwanted - IDs, just because you happen to be in an Org file when you - call `org-remember' that automatically and preemptively - creates a link. If you do want to get an ID link in a remember - template to an entry not having an ID, create it first by - explicitly creating a link to it, using `C-c C-l' first. - -create-if-interactive-and-no-custom-id - Like create-if-interactive, but do not create an ID if there is - a CUSTOM_ID property defined in the entry. This is the default. - -use-existing - Use existing ID, do not create one. - -nil Never use an ID to make a link, instead link using a text search for - the headline text." - :group 'org-link-store - :type '(choice - (const :tag "Create ID to make link" t) - (const :tag "Create if storing link interactively" - create-if-interactive) - (const :tag "Create if storing link interactively and no CUSTOM_ID is present" - create-if-interactive-and-no-custom-id) - (const :tag "Only use existing" use-existing) - (const :tag "Do not use ID to create link" nil))) - (defcustom org-context-in-file-links t "Non-nil means file links from `org-store-link' contain context. A search string will be added to the file name with :: as separator and @@ -1560,6 +1538,7 @@ in the search text." (defcustom org-link-frame-setup '((vm . vm-visit-folder-other-frame) + (vm-imap . vm-visit-imap-folder-other-frame) (gnus . org-gnus-no-new-news) (file . find-file-other-window) (wl . wl-other-frame)) @@ -1833,7 +1812,11 @@ For more examples, see the system specific constants (string :tag "Command") (sexp :tag "Lisp form"))))) - +(defcustom org-doi-server-url "http://dx.doi.org/" + "The URL of the DOI server." + :type 'string + :version "24.3" + :group 'org-link-follow) (defgroup org-refile nil "Options concerning refiling entries in Org-mode." @@ -1846,14 +1829,15 @@ This is just a default location to look for Org files. There is no need at all to put your files into this directory. It is only used in the following situations: -1. When a remember template specifies a target file that is not an +1. When a capture template specifies a target file that is not an absolute path. The path will then be interpreted relative to `org-directory' -2. When a remember note is filed away in an interactive way (when exiting the +2. When a capture note is filed away in an interactive way (when exiting the note buffer with `C-1 C-c C-c'. The user is prompted for an org file, with `org-directory' as the default path." :group 'org-refile :group 'org-remember + :group 'org-capture :type 'directory) (defcustom org-default-notes-file (convert-standard-filename "~/.notes") @@ -1862,6 +1846,7 @@ Used as a fall back file for org-remember.el and org-capture.el, for templates that do not specify a target file." :group 'org-refile :group 'org-remember + :group 'org-capture :type '(choice (const :tag "Default from remember-data-file" nil) file)) @@ -1891,6 +1876,7 @@ When nil, new notes will be filed to the end of a file or entry. This can also be a list with cons cells of regular expressions that are matched against file names, and values." :group 'org-remember + :group 'org-capture :group 'org-refile :type '(choice (const :tag "Reverse always" t) @@ -1967,11 +1953,11 @@ are used, equivalent to the value `((nil . (:level . 1))'." (const :tag "Current buffer" nil) (function) (variable) (file)) (choice :tag "Identify target headline by" - (cons :tag "Specific tag" (const :value :tag) (string)) - (cons :tag "TODO keyword" (const :value :todo) (string)) - (cons :tag "Regular expression" (const :value :regexp) (regexp)) - (cons :tag "Level number" (const :value :level) (integer)) - (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) + (cons :tag "Specific tag" (const :value :tag) (string)) + (cons :tag "TODO keyword" (const :value :todo) (string)) + (cons :tag "Regular expression" (const :value :regexp) (regexp)) + (cons :tag "Level number" (const :value :level) (integer)) + (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) (defcustom org-refile-target-verify-function nil "Function to verify if the headline at point should be a refile target. @@ -2093,9 +2079,9 @@ the special #+SEQ_TODO and #+TYP_TODO lines. Each keyword can optionally specify a character for fast state selection \(in combination with the variable `org-use-fast-todo-selection') -and specifiers for state change logging, using the same syntax -that is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says -that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" +and specifiers for state change logging, using the same syntax that +is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says that +the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" indicates to record a time stamp each time this state is selected. Each keyword may also specify if a timestamp or a note should be @@ -2109,7 +2095,7 @@ define X. You may omit any of the fast-selection key or X or /Y, so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid. For backward compatibility, this variable may also be just a list -of keywords - in this case the interpretation (sequence or type) will be +of keywords. In this case the interpretation (sequence or type) will be taken from the (otherwise obsolete) variable `org-todo-interpretation'." :group 'org-todo :group 'org-keywords @@ -2180,16 +2166,16 @@ selection scheme. When nil, fast selection is never used. -When the symbol `prefix', it will be used when `org-todo' is called with -a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t' -in an agenda buffer. +When the symbol `prefix', it will be used when `org-todo' is called +with a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and +`C-u t' in an agenda buffer. When t, fast selection is used by default. In this case, the prefix argument forces cycling instead. -In all cases, the special interface is only used if access keys have actually -been assigned by the user, i.e. if keywords in the configuration are followed -by a letter in parenthesis, like TODO(t)." +In all cases, the special interface is only used if access keys have +actually been assigned by the user, i.e. if keywords in the configuration +are followed by a letter in parenthesis, like TODO(t)." :group 'org-todo :type '(choice (const :tag "Never" nil) @@ -2321,9 +2307,9 @@ or `done', meaning any not-done or done state, respectively." :group 'org-tags :type '(repeat (cons (choice :tag "When changing to" - (const :tag "Not-done state" todo) - (const :tag "Done state" done) - (string :tag "State")) + (const :tag "Not-done state" todo) + (const :tag "Done state" done) + (string :tag "State")) (repeat (cons :tag "Tag action" (string :tag "Tag") @@ -2449,17 +2435,17 @@ agenda log mode depends on the format of these entries." :group 'org-todo :group 'org-progress :type '(list :greedy t - (cons (const :tag "Heading when closing an item" done) string) - (cons (const :tag - "Heading when changing todo state (todo sequence only)" - state) string) - (cons (const :tag "Heading when just taking a note" note) string) - (cons (const :tag "Heading when clocking out" clock-out) string) - (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) - (cons (const :tag "Heading when rescheduling" reschedule) string) - (cons (const :tag "Heading when changing deadline" redeadline) string) - (cons (const :tag "Heading when deleting a deadline" deldeadline) string) - (cons (const :tag "Heading when refiling" refile) string))) + (cons (const :tag "Heading when closing an item" done) string) + (cons (const :tag + "Heading when changing todo state (todo sequence only)" + state) string) + (cons (const :tag "Heading when just taking a note" note) string) + (cons (const :tag "Heading when clocking out" clock-out) string) + (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) + (cons (const :tag "Heading when rescheduling" reschedule) string) + (cons (const :tag "Heading when changing deadline" redeadline) string) + (cons (const :tag "Heading when deleting a deadline" deldeadline) string) + (cons (const :tag "Heading when refiling" refile) string))) (unless (assq 'note org-log-note-headings) (push '(note . "%t") org-log-note-headings)) @@ -2540,13 +2526,13 @@ through DONE. This variable forces taking a note anyway. nil Don't force a record time Record a time stamp -note Record a note +note Prompt for a note and add it with template `org-log-note-headings' This option can also be set with on a per-file-basis with + #+STARTUP: nologrepeat #+STARTUP: logrepeat #+STARTUP: lognoterepeat - #+STARTUP: nologrepeat You can have local logging settings for a subtree by setting the LOGGING property to one or more of these keywords." @@ -2647,9 +2633,9 @@ and by using a prefix arg to `S-up/down' to specify the exact number of minutes to shift." :group 'org-time :get #'(lambda (var) ; Make sure both elements are there - (if (integerp (default-value var)) - (list (default-value var) 5) - (default-value var))) + (if (integerp (default-value var)) + (list (default-value var) 5) + (default-value var))) :type '(list (integer :tag "when inserting times") (integer :tag "when modifying times"))) @@ -2731,8 +2717,8 @@ This affects the following situations: If you set this variable to the symbol `time', then also the following will work: -3. If the user gives a time, but no day. If the time is before now, - to will be interpreted as tomorrow. +3. If the user gives a time. + If the time is before now, it will be interpreted as tomorrow. Currently none of this works for ISO week specifications. @@ -2822,7 +2808,7 @@ This has influence for the following applications: the time given here, the day recognized as TODAY is actually yesterday. - When a date is read from the user and it is still before the time given here, the current date and time will be assumed to be yesterday, 23:59. - Also, timestamps inserted in remember templates follow this rule. + Also, timestamps inserted in capture templates follow this rule. IMPORTANT: This is a feature whose implementation is and likely will remain incomplete. Really, it is only here because past midnight seems to @@ -3031,7 +3017,7 @@ is better to limit inheritance to certain tags using the variables (const :tag "List them, indented with leading dots" indented))) (defcustom org-tags-sort-function nil - "When set, tags are sorted using this comparison function." + "When set, tags are sorted using this function as a comparator." :group 'org-tags :type '(choice (const :tag "No sorting" nil) @@ -3080,7 +3066,8 @@ and the clock summary: (org-minutes-to-hh:mm-string (- effort clocksum))))))" :group 'org-properties :version "24.1" - :type 'alist) + :type '(alist :key-type (string :tag "Property") + :value-type (function :tag "Function"))) (defcustom org-use-property-inheritance nil "Non-nil means properties apply also for sublevels. @@ -3256,8 +3243,8 @@ than all archive files of all agenda files will be added to the search scope." :group 'org-agenda :type '(set :greedy t - (const :tag "Agenda Archives" agenda-archives) - (repeat :inline t (file)))) + (const :tag "Agenda Archives" agenda-archives) + (repeat :inline t (file)))) (if (fboundp 'defvaralias) (defvaralias 'org-agenda-multi-occur-extra-files @@ -3325,8 +3312,8 @@ points to a file, `org-agenda-diary-entry' will be used instead." (defcustom org-format-latex-options '(:foreground default :background default :scale 1.0 - :html-foreground "Black" :html-background "Transparent" - :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) + :html-foreground "Black" :html-background "Transparent" + :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) "Options for creating images from LaTeX fragments. This is a property list with the following properties: :foreground the foreground color for images embedded in Emacs, e.g. \"Black\". @@ -3353,6 +3340,7 @@ When nil, just push out a message." :group 'org-latex :version "24.1" :type 'boolean) + (defcustom org-latex-to-mathml-jar-file nil "Value of\"%j\" in `org-latex-to-mathml-convert-command'. Use this to specify additional executable file say a jar file. @@ -3383,6 +3371,28 @@ When using MathToWeb as the converter, set this to (const :tag "None" nil) (string :tag "\nShell command"))) +(defcustom org-latex-create-formula-image-program 'dvipng + "Program to convert LaTeX fragments with. + +dvipng Process the LaTeX fragments to dvi file, then convert + dvi files to png files using dvipng. + This will also include processing of non-math environments. +imagemagick Convert the LaTeX fragments to pdf files and use imagemagick + to convert pdf files to png files" + :group 'org-latex + :version "24.1" + :type '(choice + (const :tag "dvipng" dvipng) + (const :tag "imagemagick" imagemagick))) + +(defcustom org-latex-preview-ltxpng-directory "ltxpng/" + "Path to store latex preview images. A relative path here creates many + directories relative to the processed org files paths. An absolute path + puts all preview images at the same place." + :group 'org-latex + :version "24.3" + :type 'string) + (defun org-format-latex-mathml-available-p () "Return t if `org-latex-to-mathml-convert-command' is usable." (save-match-data @@ -3560,6 +3570,15 @@ appear in the buffer without the initial #+TITLE: keyword." (const :tag "#+EMAIL" email) (const :tag "#+TITLE" title))) +(defcustom org-custom-properties nil + "List of properties (as strings) with a special meaning. +The default use of these custom properties is to let the user +hide them with `org-toggle-custom-properties-visibility'." + :group 'org-properties + :group 'org-appearance + :version "24.3" + :type '(repeat (string :tag "Property Name"))) + (defcustom org-fontify-done-headline nil "Non-nil means change the face of a headline if it is marked DONE. Normally, only the TODO/DONE keyword indicates the state of a headline. @@ -3608,7 +3627,7 @@ When nil, the \\name form remains in the buffer." "Regular expression for matching emphasis. After a match, the match groups contain these elements: 0 The match of the full regular expression, including the characters - before and after the proper match + before and after the proper match 1 The character before the proper match, or empty at beginning of line 2 The proper match, including the leading and trailing markers 3 The leading marker like * or /, indicating the type of highlighting @@ -3851,29 +3870,29 @@ This works for both table types.") (eval-and-compile (org-autoload "org-table" '(org-table-align org-table-begin org-table-blank-field - org-table-convert org-table-convert-region org-table-copy-down - org-table-copy-region org-table-create - org-table-create-or-convert-from-region - org-table-create-with-table.el org-table-current-dline - org-table-cut-region org-table-delete-column org-table-edit-field - org-table-edit-formulas org-table-end org-table-eval-formula - org-table-export org-table-field-info - org-table-get-stored-formulas org-table-goto-column - org-table-hline-and-move org-table-import org-table-insert-column - org-table-insert-hline org-table-insert-row org-table-iterate - org-table-justify-field-maybe org-table-kill-row - org-table-maybe-eval-formula org-table-maybe-recalculate-line - org-table-move-column org-table-move-column-left - org-table-move-column-right org-table-move-row - org-table-move-row-down org-table-move-row-up - org-table-next-field org-table-next-row org-table-paste-rectangle - org-table-previous-field org-table-recalculate - org-table-rotate-recalc-marks org-table-sort-lines org-table-sum - org-table-toggle-coordinate-overlays - org-table-toggle-formula-debugger org-table-wrap-region - orgtbl-mode turn-on-orgtbl org-table-to-lisp - orgtbl-to-generic orgtbl-to-tsv orgtbl-to-csv orgtbl-to-latex - orgtbl-to-orgtbl orgtbl-to-html orgtbl-to-texinfo))) + org-table-convert org-table-convert-region org-table-copy-down + org-table-copy-region org-table-create + org-table-create-or-convert-from-region + org-table-create-with-table.el org-table-current-dline + org-table-cut-region org-table-delete-column org-table-edit-field + org-table-edit-formulas org-table-end org-table-eval-formula + org-table-export org-table-field-info + org-table-get-stored-formulas org-table-goto-column + org-table-hline-and-move org-table-import org-table-insert-column + org-table-insert-hline org-table-insert-row org-table-iterate + org-table-justify-field-maybe org-table-kill-row + org-table-maybe-eval-formula org-table-maybe-recalculate-line + org-table-move-column org-table-move-column-left + org-table-move-column-right org-table-move-row + org-table-move-row-down org-table-move-row-up + org-table-next-field org-table-next-row org-table-paste-rectangle + org-table-previous-field org-table-recalculate + org-table-rotate-recalc-marks org-table-sort-lines org-table-sum + org-table-toggle-coordinate-overlays + org-table-toggle-formula-debugger org-table-wrap-region + orgtbl-mode turn-on-orgtbl org-table-to-lisp + orgtbl-to-generic orgtbl-to-tsv orgtbl-to-csv orgtbl-to-latex + orgtbl-to-orgtbl orgtbl-to-html orgtbl-to-texinfo))) (defun org-at-table-p (&optional table-type) "Return t if the cursor is inside an org-type table. @@ -3938,7 +3957,9 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (unless quietly (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))) (beginning-of-line 1) - (when (looking-at org-table-line-regexp) + (when (and (looking-at org-table-line-regexp) + ;; Exclude tables in src/example/verbatim/clocktable blocks + (not (org-in-block-p '("src" "example")))) (save-excursion (funcall function)) (or (looking-at org-table-line-regexp) (forward-char 1))) @@ -3957,13 +3978,13 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." org-table-clean-before-export)) (org-autoload "org-ascii" '(org-export-as-ascii org-export-ascii-preprocess - org-export-as-ascii-to-buffer org-replace-region-by-ascii - org-export-region-as-ascii)) + org-export-as-ascii-to-buffer org-replace-region-by-ascii + org-export-region-as-ascii)) (org-autoload "org-latex" '(org-export-as-latex-batch org-export-as-latex-to-buffer - org-replace-region-by-latex org-export-region-as-latex - org-export-as-latex org-export-as-pdf - org-export-as-pdf-and-open)) + org-replace-region-by-latex org-export-region-as-latex + org-export-as-latex org-export-as-pdf + org-export-as-pdf-and-open)) (org-autoload "org-html" '(org-export-as-html-and-open org-export-as-html-batch org-export-as-html-to-buffer @@ -3971,9 +3992,9 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." org-export-as-html)) (org-autoload "org-docbook" '(org-export-as-docbook-batch org-export-as-docbook-to-buffer - org-replace-region-by-docbook org-export-region-as-docbook - org-export-as-docbook-pdf org-export-as-docbook-pdf-and-open - org-export-as-docbook)) + org-replace-region-by-docbook org-export-region-as-docbook + org-export-as-docbook-pdf org-export-as-docbook-pdf-and-open + org-export-as-docbook)) (org-autoload "org-icalendar" '(org-export-icalendar-this-file org-export-icalendar-all-agenda-files @@ -3986,21 +4007,21 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (eval-and-compile (org-autoload "org-agenda" '(org-agenda org-agenda-list org-search-view - org-todo-list org-tags-view org-agenda-list-stuck-projects - org-diary org-agenda-to-appt - org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))) + org-todo-list org-tags-view org-agenda-list-stuck-projects + org-diary org-agenda-to-appt + org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))) ;; Autoload org-remember (eval-and-compile (org-autoload "org-remember" '(org-remember-insinuate org-remember-annotation - org-remember-apply-template org-remember org-remember-handler))) + org-remember-apply-template org-remember org-remember-handler))) (eval-and-compile (org-autoload "org-capture" '(org-capture org-capture-insert-template-here - org-capture-import-remember-templates))) + org-capture-import-remember-templates))) ;; Autoload org-clock.el @@ -4017,9 +4038,9 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (defvar org-clock-heading "" "The heading of the current clock entry.") (defun org-clock-is-active () - "Return non-nil if clock is currently running. + "Return non-nil if clock is currently running. The return value is actually the clock marker." - (marker-buffer org-clock-marker)) + (marker-buffer org-clock-marker)) (eval-and-compile (org-autoload @@ -4168,6 +4189,15 @@ Here are a few examples: Archive in file ~/org/archive.org (absolute path), under headlines \"From FILENAME\" where file name is the current file name. +\"~/org/datetree.org::datetree/* Finished Tasks\" + The \"datetree/\" string is special, signifying to archive + items to the datetree. Items are placed in either the CLOSED + date of the item, or the current date if there is no CLOSED date. + The heading will be a subentry to the current date. There doesn't + need to be a heading, but there always needs to be a slash after + datetree. For example, to store archived items directly in the + datetree, use \"~/org/datetree.org::datetree/\". + \"basement::** Finished Tasks\" Archive in file ./basement (relative path), as level 3 trees below the level 2 heading \"** Finished Tasks\". @@ -4225,6 +4255,25 @@ collapsed state." :group 'org-sparse-trees :type 'boolean) +(defcustom org-sparse-tree-default-date-type 'scheduled-or-deadline + "The default date type when building a sparse tree. +When this is nil, a date is a scheduled or a deadline timestamp. +Otherwise, these types are allowed: + + all: all timestamps + active: only active timestamps (<...>) + inactive: only inactive timestamps (<...) + scheduled: only scheduled timestamps + deadline: only deadline timestamps" + :type '(choice (const :tag "Scheduled or deadline" 'scheduled-or-deadline) + (const :tag "All timestamps" all) + (const :tag "Only active timestamps" active) + (const :tag "Only inactive timestamps" inactive) + (const :tag "Only scheduled timestamps" scheduled) + (const :tag "Only deadline timestamps" deadline)) + :version "24.3" + :group 'org-sparse-trees) + (defun org-cycle-hide-archived-subtrees (state) "Re-hide all archived subtrees after a visibility state change." (when (and (not org-cycle-open-archived-trees) @@ -4256,6 +4305,8 @@ collapsed state." (org-flag-subtree t) (org-end-of-subtree t)))))) +(declare-function outline-end-of-heading "outline" ()) +(declare-function outline-flag-region "outline" (from to flag)) (defun org-flag-subtree (flag) (save-excursion (org-back-to-heading t) @@ -4268,21 +4319,21 @@ collapsed state." (eval-and-compile (org-autoload "org-archive" - '(org-add-archive-files org-archive-subtree - org-archive-to-archive-sibling org-toggle-archive-tag - org-archive-subtree-default - org-archive-subtree-default-with-confirmation))) + '(org-add-archive-files org-archive-subtree + org-archive-to-archive-sibling org-toggle-archive-tag + org-archive-subtree-default + org-archive-subtree-default-with-confirmation))) ;; Autoload Column View Code -(declare-function org-columns-number-to-string "org-colview") -(declare-function org-columns-get-format-and-top-level "org-colview") -(declare-function org-columns-compute "org-colview") +(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf)) +(declare-function org-columns-get-format-and-top-level "org-colview" ()) +(declare-function org-columns-compute "org-colview" (property)) (org-autoload (if (featurep 'xemacs) "org-colview-xemacs" "org-colview") - '(org-columns-number-to-string org-columns-get-format-and-top-level - org-columns-compute org-agenda-columns org-columns-remove-overlays - org-columns org-insert-columns-dblock org-dblock-write:columnview)) + '(org-columns-number-to-string org-columns-get-format-and-top-level + org-columns-compute org-agenda-columns org-columns-remove-overlays + org-columns org-insert-columns-dblock org-dblock-write:columnview)) ;; Autoload ID code @@ -4291,19 +4342,19 @@ collapsed state." (declare-function org-id-locations-save "org-id") (defvar org-id-track-globally) (org-autoload "org-id" - '(org-id-get-create org-id-new org-id-copy org-id-get - org-id-get-with-outline-path-completion - org-id-get-with-outline-drilling org-id-store-link - org-id-goto org-id-find org-id-store-link)) + '(org-id-get-create org-id-new org-id-copy org-id-get + org-id-get-with-outline-path-completion + org-id-get-with-outline-drilling org-id-store-link + org-id-goto org-id-find org-id-store-link)) ;; Autoload Plotting Code (org-autoload "org-plot" - '(org-plot/gnuplot)) + '(org-plot/gnuplot)) ;;; Variables for pre-computed regular expressions, all buffer local -(defvar org-drawer-regexp nil +(defvar org-drawer-regexp "^[ \t]*:PROPERTIES:[ \t]*$" "Matches first line of a hidden block.") (make-variable-buffer-local 'org-drawer-regexp) (defvar org-todo-regexp nil @@ -4337,7 +4388,7 @@ TODO state, priority and tags.") Also put tags into group 4 if tags are present.") (make-variable-buffer-local 'org-todo-line-tags-regexp) (defvar org-ds-keyword-length 12 - "Maximum length of the Deadline and SCHEDULED keywords.") + "Maximum length of the DEADLINE and SCHEDULED keywords.") (make-variable-buffer-local 'org-ds-keyword-length) (defvar org-deadline-regexp nil "Matches the DEADLINE keyword.") @@ -4367,9 +4418,6 @@ Also put tags into group 4 if tags are present.") (defvar org-maybe-keyword-time-regexp nil "Matches a timestamp, possibly preceded by a keyword.") (make-variable-buffer-local 'org-maybe-keyword-time-regexp) -(defvar org-planning-or-clock-line-re nil - "Matches a line with planning or clock info.") -(make-variable-buffer-local 'org-planning-or-clock-line-re) (defvar org-all-time-keywords nil "List of time keywords.") (make-variable-buffer-local 'org-all-time-keywords) @@ -4467,9 +4515,9 @@ After a match, the following groups carry important information: ("entitiespretty" org-pretty-entities t) ("entitiesplain" org-pretty-entities nil)) "Variable associated with STARTUP options for org-mode. -Each element is a list of three items: The startup options as written -in the #+STARTUP line, the corresponding variable, and the value to -set this variable to if the option is found. An optional forth element PUSH +Each element is a list of three items: the startup options (as written +in the #+STARTUP line), the corresponding variable, and the value to set +this variable to if the option is found. An optional forth element PUSH means to push this value onto the list in the variable.") (defun org-update-property-plist (key val props) @@ -4500,7 +4548,7 @@ but the stars and the body are.") (defun org-set-regexps-and-options () "Precompute regular expressions for current buffer." - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (org-set-local 'org-todo-kwd-alist nil) (org-set-local 'org-todo-key-alist nil) (org-set-local 'org-todo-key-trigger nil) @@ -4571,7 +4619,7 @@ but the stars and the body are.") (mapcar (lambda (x) (org-split-string x ":")) (org-split-string value))))))) ((equal key "DRAWERS") - (setq drawers (org-split-string value splitre))) + (setq drawers (delete-dups (append org-drawers (org-split-string value splitre))))) ((equal key "CONSTANTS") (setq const (append const (org-split-string value splitre)))) ((equal key "STARTUP") @@ -4738,7 +4786,7 @@ but the stars and the body are.") (concat "^\\(\\*+\\)" "\\(?: +" org-todo-regexp "\\)?" "\\(?: +\\(\\[#.\\]\\)\\)?" - "\\(?: +\\(.*?\\)\\)?" + "\\(?: +\\(.*?\\)\\)??" (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?") "[ \t]*$") org-complex-heading-regexp-format @@ -4756,7 +4804,7 @@ but the stars and the body are.") org-todo-line-tags-regexp (concat "^\\(\\*+\\)" "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(.*?\\)\\)?" + "\\(?: +\\(.*?\\)\\)??" (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?") "[ \t]*$") org-deadline-regexp (concat "\\<" org-deadline-string) @@ -4788,12 +4836,6 @@ but the stars and the body are.") "\\|" org-closed-string "\\|" org-clock-string "\\)\\)?" " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") - org-planning-or-clock-line-re - (concat "^[ \t]*\\(" - org-scheduled-string "\\|" - org-deadline-string "\\|" - org-closed-string "\\|" - org-clock-string "\\)") org-all-time-keywords (mapcar (lambda (w) (substring w 0 -1)) (list org-scheduled-string org-deadline-string @@ -4866,14 +4908,14 @@ Respect keys that are already there." "Used in various places to store a window configuration.") (defvar org-finish-function nil "Function to be called when `C-c C-c' is used. -This is for getting out of special buffers like remember.") +This is for getting out of special buffers like capture.") ;; FIXME: Occasionally check by commenting these, to make sure ;; no other functions uses these, forgetting to let-bind them. -(defvar entry) +(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el (defvar org-last-state) -(defvar date) +(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el ;; Defined somewhere in this file, but used before definition. (defvar org-entities) ;; defined in org-entities.el @@ -4883,10 +4925,6 @@ This is for getting out of special buffers like remember.") ;;;; Define the Org-mode -(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22")) - - ;; We use a before-change function to check if a table might need ;; an update. (defvar org-table-may-need-update t @@ -4904,25 +4942,37 @@ This variable is set by `org-before-change-function'. (defvar org-inhibit-blocking nil) ; Dynamically-scoped param. (defvar org-table-buffer-is-an nil) -;; `org-outline-regexp' ought to be a defconst but is let-binding in -;; some places -- e.g. see the macro org-with-limited-levels. -;; -;; In Org buffers, the value of `outline-regexp' is that of -;; `org-outline-regexp'. The only function still directly relying on -;; `outline-regexp' is `org-overview' so that `org-cycle' can do its -;; job when `orgstruct-mode' is active. -(defvar org-outline-regexp "\\*+ " - "Regexp to match Org headlines.") -(defconst org-outline-regexp-bol "^\\*+ " - "Regexp to match Org headlines. -This is similar to `org-outline-regexp' but additionally makes -sure that we are at the beginning of the line.") +(defvar bidi-paragraph-direction) +(defvar buffer-face-mode-face) -(defconst org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Matches an headline, putting stars and text into groups. -Stars are put in group 1 and the trimmed body in group 2.") +(require 'outline) +(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) + (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22")) +(require 'noutline "noutline" 'noerror) ;; stock XEmacs does not have it -(defvar buffer-face-mode-face) +;; Other stuff we need. +(require 'time-date) +(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) +(require 'easymenu) +(require 'overlay) + +(require 'org-macs) +(require 'org-entities) +;; (require 'org-compat) moved higher up in the file before it is first used +(require 'org-faces) +(require 'org-list) +(require 'org-pcomplete) +(require 'org-src) +(require 'org-footnote) + +;; babel +(require 'ob) +(require 'ob-table) +(require 'ob-lob) +(require 'ob-ref) +(require 'ob-tangle) +(require 'ob-comint) +(require 'ob-keys) ;;;###autoload (define-derived-mode org-mode outline-mode "Org" @@ -4979,7 +5029,7 @@ The following commands are available: org-display-table 4 (vconcat (mapcar (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) - org-ellipsis))) + org-ellipsis))) (if (stringp org-ellipsis) org-ellipsis "...")))) (setq buffer-display-table org-display-table)) (org-set-regexps-and-options) @@ -4998,13 +5048,18 @@ The following commands are available: 'local) ;; Check for running clock before killing a buffer (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) - ;; Paragraphs and auto-filling - (org-set-autofill-regexps) - (setq indent-line-function 'org-indent-line-function) + ;; Indentation. + (org-set-local 'indent-line-function 'org-indent-line) + (org-set-local 'indent-region-function 'org-indent-region) + ;; Initialize radio targets. (org-update-radio-target-regexp) + ;; Filling and auto-filling. + (org-setup-filling) + ;; Comments. + (org-setup-comments-handling) ;; Beginning/end of defun - (org-set-local 'beginning-of-defun-function 'org-beginning-of-defun) - (org-set-local 'end-of-defun-function 'org-end-of-defun) + (org-set-local 'beginning-of-defun-function 'org-back-to-heading) + (org-set-local 'end-of-defun-function (lambda () (interactive) (org-end-of-subtree nil t))) ;; Next error for sparse trees (org-set-local 'next-error-function 'org-occur-next-match) ;; Make sure dependence stuff works reliably, even for users who set it @@ -5020,10 +5075,6 @@ The following commands are available: (remove-hook 'org-blocker-hook 'org-block-todo-from-checkboxes)) - ;; Comment characters - (org-set-local 'comment-start "#") - (org-set-local 'comment-padding " ") - ;; Align options lines (org-set-local 'align-mode-rules-list @@ -5076,7 +5127,9 @@ The following commands are available: (require 'org-indent) (org-indent-mode 1)) (unless org-inhibit-startup-visibility-stuff - (org-set-startup-visibility)))) + (org-set-startup-visibility))) + ;; Try to set org-hide correctly + (set-face-foreground 'org-hide (org-find-invisible-foreground))) (when (fboundp 'abbrev-table-put) (abbrev-table-put org-mode-abbrev-table @@ -5084,6 +5137,19 @@ The following commands are available: (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) + +(defun org-find-invisible-foreground () + (let ((candidates (remove + "unspecified-bg" + (list + (face-background 'default) + (face-background 'org-default) + (cdr (assoc 'background-color default-frame-alist)) + (cdr (assoc 'background-color initial-frame-alist)) + (cdr (assoc 'background-color window-system-default-frame-alist)) + (face-foreground 'org-hide))))) + (car (remove nil candidates)))) + (defun org-current-time () "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." (if (> (car org-time-stamp-rounding-minutes) 1) @@ -5115,19 +5181,19 @@ The following commands are available: (defconst org-non-link-chars "]\t\n\r<>") (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" - "shell" "elisp" "doi" "message")) + "shell" "elisp" "doi" "message")) (defvar org-link-types-re nil - "Matches a link that has a url-like prefix like \"http:\"") + "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil - "Matches a link with spaces, optional angular brackets around it.") + "Matches a link with spaces, optional angular brackets around it.") (defvar org-link-re-with-space2 nil - "Matches a link with spaces, optional angular brackets around it.") + "Matches a link with spaces, optional angular brackets around it.") (defvar org-link-re-with-space3 nil - "Matches a link with spaces, only for internal part in bracket links.") + "Matches a link with spaces, only for internal part in bracket links.") (defvar org-angle-link-re nil - "Matches link with angular brackets, spaces are allowed.") + "Matches link with angular brackets, spaces are allowed.") (defvar org-plain-link-re nil - "Matches plain link, without spaces.") + "Matches plain link, without spaces.") (defvar org-bracket-link-regexp nil "Matches a link in double brackets.") (defvar org-bracket-link-analytic-regexp nil @@ -5247,7 +5313,8 @@ This should be called after the variable `org-link-types' has changed." "Regular expression for fast time stamp matching.") (defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]" "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" +(defconst org-ts-regexp0 + "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" "Regular expression matching time strings for analysis. This one does not require the space after the date, so it can be used on a string that terminates immediately after the date.") @@ -5360,19 +5427,18 @@ will be prompted for." "Run through the buffer and add overlays to links." (catch 'exit (let (f) - (if (re-search-forward org-plain-link-re limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (setq f (get-text-property (match-beginning 0) 'face)) - (if (or (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) - nil - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'face 'org-link - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 0))) - t))))) + (when (re-search-forward (concat org-plain-link-re) limit t) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (setq f (get-text-property (match-beginning 0) 'face)) + (if (or (eq f 'org-tag) + (and (listp f) (memq 'org-tag f))) + nil + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'face 'org-link + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 0))) + t)))) (defun org-activate-code (limit) (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) @@ -5389,6 +5455,14 @@ will be prompted for." :group 'org-appearance :group 'org-babel) +(defcustom org-allow-promoting-top-level-subtree nil + "When non-nil, allow promoting a top level subtree. +The leading star of the top level headline will be replaced +by a #." + :type 'boolean + :version "24.1" + :group 'org-appearance) + (defun org-fontify-meta-lines-and-blocks (limit) (condition-case nil (org-fontify-meta-lines-and-blocks-1 limit) @@ -5398,7 +5472,7 @@ will be prompted for." "Fontify #+ lines and blocks, in the correct ways." (let ((case-fold-search t)) (if (re-search-forward - "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" + "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" limit t) (let ((beg (match-beginning 0)) (block-start (match-end 0)) @@ -5409,7 +5483,7 @@ will be prompted for." (dc3 (downcase (match-string 3))) end end1 quoting block-type ovl) (cond - ((member dc1 '("html:" "ascii:" "latex:" "docbook:")) + ((member dc1 '("+html:" "+ascii:" "+latex:" "+docbook:")) ;; a single line of backend-specific content (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (remove-text-properties (match-beginning 0) (match-end 0) @@ -5420,7 +5494,7 @@ will be prompted for." '(font-lock-fontified t face org-block)) ; for backend-specific code t) - ((and (match-end 4) (equal dc3 "begin")) + ((and (match-end 4) (equal dc3 "+begin")) ;; Truly a block (setq block-type (downcase (match-string 5)) quoting (member block-type org-protecting-blocks)) @@ -5463,7 +5537,7 @@ will be prompted for." (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) '(face org-block-end-line)) t)) - ((member dc1 '("title:" "author:" "email:" "date:")) + ((member dc1 '("+title:" "+author:" "+email:" "+date:")) (add-text-properties beg (match-end 3) (if (member (intern (substring dc1 0 -1)) org-hidden-keywords) @@ -5471,19 +5545,14 @@ will be prompted for." '(font-lock-fontified t face org-document-info-keyword))) (add-text-properties (match-beginning 6) (match-end 6) - (if (string-equal dc1 "title:") + (if (string-equal dc1 "+title:") '(font-lock-fontified t face org-document-title) '(font-lock-fontified t face org-document-info)))) - ((not (member (char-after beg) '(?\ ?\t))) - ;; just any other in-buffer setting, but not indented - (add-text-properties - beg (match-end 0) - '(font-lock-fontified t face org-meta-line)) - t) - ((or (member dc1 '("begin:" "end:" "caption:" "label:" - "orgtbl:" "tblfm:" "tblname:" "results:" - "call:" "header:" "headers:" "name:")) - (and (match-end 4) (equal dc3 "attr"))) + ((or (equal dc1 "+results") + (member dc1 '("+begin:" "+end:" "+caption:" "+label:" + "+orgtbl:" "+tblfm:" "+tblname:" "+results:" + "+call:" "+header:" "+headers:" "+name:")) + (and (match-end 4) (equal dc3 "+attr"))) (add-text-properties beg (match-end 0) '(font-lock-fontified t face org-meta-line)) @@ -5492,6 +5561,12 @@ will be prompted for." (add-text-properties beg (match-end 0) '(font-lock-fontified t face font-lock-comment-face))) + ((not (member (char-after beg) '(?\ ?\t))) + ;; just any other in-buffer setting, but not indented + (add-text-properties + beg (match-end 0) + '(font-lock-fontified t face org-meta-line)) + t) (t nil)))))) (defun org-strip-protective-commas (beg end) @@ -5505,7 +5580,7 @@ will be prompted for." "[^[:space:]]" end t) (goto-char (match-beginning 0)) (current-column)))) - (while (re-search-forward "^[ \t]*\\(,\\)\\([*]\\|#\\+\\)" end t) + (while (re-search-forward "^[ \t]*\\(,\\)\\([*]\\|#\\)" end t) (goto-char (match-beginning 1)) (when (= (current-column) front-line) (replace-match "" nil nil nil 1))))))) @@ -5667,8 +5742,7 @@ will be prompted for." ((equal org-export-with-sub-superscripts '{}) (list org-match-substring-with-braces-regexp)) (org-export-with-sub-superscripts - (list org-match-substring-regexp)) - (t nil))) + (list org-match-substring-regexp)))) (re-latex (if org-export-with-LaTeX-fragments (mapcar (lambda (x) (nth 1 x)) latexs))) @@ -5689,7 +5763,7 @@ will be prompted for." nil)) 'words))) ; FIXME )) - ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) + ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) (re-special (if org-export-with-special-strings (mapcar (lambda (x) (car x)) org-export-html-special-string-regexps))) @@ -5793,9 +5867,11 @@ it is installed to be used by font lock. This can be useful if something needs to be inserted at a specific position in the font-lock sequence.") (defun org-font-lock-hook (limit) + "Run `org-font-lock-hook' within LIMIT." (run-hook-with-args 'org-font-lock-hook limit)) (defun org-set-font-lock-defaults () + "Set font lock defaults for the current buffer." (let* ((em org-fontify-emphasized-text) (lk org-activate-links) (org-font-lock-extra-keywords @@ -5869,7 +5945,7 @@ needs to be inserted at a specific position in the font-lock sequence.") (0 (org-get-checkbox-statistics-face) t))) ;; Description list items '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)" - 1 'bold prepend) + 1 'org-list-dt prepend) ;; ARCHIVEd headings (list (concat org-outline-regexp-bol @@ -5887,7 +5963,6 @@ needs to be inserted at a specific position in the font-lock sequence.") org-comment-string "\\|" org-quote-string "\\)")) '(2 'org-special-keyword t)) - '("^#.*" (0 'font-lock-comment-face t)) ;; Blocks and meta lines '(org-fontify-meta-lines-and-blocks) ))) @@ -5911,6 +5986,30 @@ needs to be inserted at a specific position in the font-lock sequence.") (org-decompose-region (point-min) (point-max)) (message "Entities are displayed plain")))) +(defvar org-custom-properties-overlays nil + "List of overlays used for custom properties.") +(make-variable-buffer-local 'org-custom-properties-overlays) + +(defun org-toggle-custom-properties-visibility () + "Display or hide properties in `org-custom-properties'." + (interactive) + (if org-custom-properties-overlays + (progn (mapc 'delete-overlay org-custom-properties-overlays) + (setq org-custom-properties-overlays nil)) + (unless (not org-custom-properties) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward org-property-re nil t) + (mapc (lambda(p) + (when (equal p (substring (match-string 1) 1 -1)) + (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) + (overlay-put o 'invisible t) + (overlay-put o 'org-custom-property t) + (push o org-custom-properties-overlays)))) + org-custom-properties))))))) + (defun org-fontify-entities (limit) "Find an entity to fontify." (let (ee) @@ -5948,16 +6047,16 @@ needs to be inserted at a specific position in the font-lock sequence.") (defvar org-l nil) (defvar org-f nil) (defun org-get-level-face (n) - "Get the right face for match N in font-lock matching of headlines." - (setq org-l (- (match-end 2) (match-beginning 1) 1)) - (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) - (if org-cycle-level-faces - (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) - (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces))) - (cond - ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) - ((eq n 2) org-f) - (t (if org-level-color-stars-only nil org-f)))) + "Get the right face for match N in font-lock matching of headlines." + (setq org-l (- (match-end 2) (match-beginning 1) 1)) + (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) + (if org-cycle-level-faces + (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) + (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces))) + (cond + ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) + ((eq n 2) org-f) + (t (if org-level-color-stars-only nil org-f)))) (defun org-get-todo-face (kwd) @@ -6017,9 +6116,9 @@ If KWD is a number, get the corresponding match group." deactivate-mark buffer-file-name buffer-file-truename) (org-decompose-region beg end) (remove-text-properties beg end - '(mouse-face t keymap t org-linked-text t - invisible t intangible t - org-no-flyspell t org-emphasis t)) + '(mouse-face t keymap t org-linked-text t + invisible t intangible t + org-no-flyspell t org-emphasis t)) (org-remove-font-lock-display-properties beg end))) (defconst org-script-display '(((raise -0.3) (height 0.7)) @@ -6152,11 +6251,11 @@ in special contexts. org-inlinetask-min-level (1- org-inlinetask-min-level)))) (nstars (and limit-level - (if org-odd-levels-only - (and limit-level (1- (* limit-level 2))) - limit-level))) + (if org-odd-levels-only + (and limit-level (1- (* limit-level 2))) + limit-level))) (org-outline-regexp - (if (not (eq major-mode 'org-mode)) + (if (not (derived-mode-p 'org-mode)) outline-regexp (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))) (bob-special (and org-cycle-global-at-bob (not arg) (bobp) @@ -6402,7 +6501,7 @@ With \\[universal-argument] prefix arg, switch to startup visibility. With a numeric prefix, show all headlines up to that level." (interactive "P") (let ((org-cycle-include-plain-lists - (if (eq major-mode 'org-mode) org-cycle-include-plain-lists nil))) + (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil))) (cond ((integerp arg) (show-all) @@ -6612,7 +6711,7 @@ open and agenda-wise Org files." (let ((files (mapcar 'expand-file-name (org-agenda-files)))) (dolist (buf (buffer-list)) (with-current-buffer buf - (if (and (eq major-mode 'org-mode) (buffer-file-name)) + (if (and (derived-mode-p 'org-mode) (buffer-file-name)) (let ((file (expand-file-name (buffer-file-name)))) (unless (member file files) (push file files)))))) @@ -6628,7 +6727,7 @@ open and agenda-wise Org files." (defun org-cycle-hide-drawers (state) "Re-hide all drawers after a visibility state change." - (when (and (eq major-mode 'org-mode) + (when (and (derived-mode-p 'org-mode) (not (memq state '(overview folded contents)))) (save-excursion (let* ((globalp (memq state '(contents all))) @@ -6642,6 +6741,8 @@ open and agenda-wise Org files." (org-flag-drawer t)))))) (defun org-flag-drawer (flag) + "When FLAG is non-nil, hide the drawer we are within. +Otherwise make it visible." (save-excursion (beginning-of-line 1) (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") @@ -6829,7 +6930,7 @@ Optional arguments START and END can be used to limit the range." map)) (defconst org-goto-help -"Browse buffer copy, to find location or copy text. Just type for auto-isearch. + "Browse buffer copy, to find location or copy text. Just type for auto-isearch. RET=jump to location [Q]uit and return to previous location \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") @@ -6839,18 +6940,22 @@ RET=jump to location [Q]uit and return to previous location (defun org-goto (&optional alternative-interface) "Look up a different location in the current file, keeping current visibility. -When you want look-up or go to a different location in a document, the -fastest way is often to fold the entire buffer and then dive into the tree. -This method has the disadvantage, that the previous location will be folded, -which may not be what you want. - -This command works around this by showing a copy of the current buffer -in an indirect buffer, in overview mode. You can dive into the tree in -that copy, use org-occur and incremental search to find a location. -When pressing RET or `Q', the command returns to the original buffer in -which the visibility is still unchanged. After RET it will also jump to -the location selected in the indirect buffer and expose the headline -hierarchy above." +When you want look-up or go to a different location in a +document, the fastest way is often to fold the entire buffer and +then dive into the tree. This method has the disadvantage, that +the previous location will be folded, which may not be what you +want. + +This command works around this by showing a copy of the current +buffer in an indirect buffer, in overview mode. You can dive +into the tree in that copy, use org-occur and incremental search +to find a location. When pressing RET or `Q', the command +returns to the original buffer in which the visibility is still +unchanged. After RET it will also jump to the location selected +in the indirect buffer and expose the headline hierarchy above. + +With a prefix argument, use the alternative interface: e.g. if +`org-goto-interface' is 'outline use 'outline-path-completion." (interactive "P") (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) (org-refile-use-outline-path t) @@ -6945,12 +7050,12 @@ or nil." (defun org-goto-local-auto-isearch () "Start isearch." - (interactive) - (goto-char (point-min)) - (let ((keys (this-command-keys))) - (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) - (isearch-mode t) - (isearch-process-search-char (string-to-char keys))))) + (interactive) + (goto-char (point-min)) + (let ((keys (this-command-keys))) + (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) + (isearch-mode t) + (isearch-process-search-char (string-to-char keys))))) (defun org-goto-ret (&optional arg) "Finish `org-goto' by going to the new location." @@ -6995,8 +7100,9 @@ or nil." (defun org-tree-to-indirect-buffer (&optional arg) "Create indirect buffer and narrow it to current subtree. -With numerical prefix ARG, go up to this level and then take that tree. +With a numerical prefix ARG, go up to this level and then take that tree. If ARG is negative, go up that many levels. + If `org-indirect-buffer-display' is not `new-frame', the command removes the indirect buffer previously made with this command, to avoid proliferation of indirect buffers. However, when you call the command with a \ @@ -7018,7 +7124,7 @@ frame is not changed." (setq level (org-outline-level)) (if (< arg 0) (setq arg (+ level arg))) (while (> (setq level (org-outline-level)) arg) - (outline-up-heading 1 t))) + (org-up-heading-safe))) (setq beg (point) heading (org-get-heading)) (org-end-of-subtree t t) @@ -7434,6 +7540,8 @@ even level numbers will become the next higher odd number." (define-obsolete-function-alias 'org-get-legal-level 'org-get-valid-level "23.1"))) +(defvar org-called-with-limited-levels nil) ;; Dynamically bound in +;; ̀org-with-limited-levels' (defun org-promote () "Promote the current heading higher up the tree. If the region is active in `transient-mark-mode', promote all headings @@ -7441,14 +7549,19 @@ in the region." (org-back-to-heading t) (let* ((level (save-match-data (funcall outline-level))) (after-change-functions (remove 'flyspell-after-change-function - after-change-functions)) + after-change-functions)) (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) (diff (abs (- level (length up-head) -1)))) - (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) - (replace-match up-head nil t) + (cond ((and (= level 1) org-called-with-limited-levels + org-allow-promoting-top-level-subtree) + (replace-match "# " nil t)) + ((= level 1) + (error "Cannot promote to level 0. UNDO to recover if necessary")) + (t (replace-match up-head nil t))) ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation (- diff))) + (unless (= level 1) + (and org-auto-align-tags (org-set-tags nil t)) + (if org-adapt-indentation (org-fixup-indentation (- diff)))) (run-hooks 'org-after-promote-entry-hook))) (defun org-demote () @@ -7458,7 +7571,7 @@ in the region." (org-back-to-heading t) (let* ((level (save-match-data (funcall outline-level))) (after-change-functions (remove 'flyspell-after-change-function - after-change-functions)) + after-change-functions)) (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) (diff (abs (- level (length down-head) -1)))) (replace-match down-head nil t) @@ -7717,7 +7830,7 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (save-excursion (outline-end-of-heading) (setq folded (outline-invisible-p))) (condition-case nil - (org-forward-same-level (1- n) t) + (org-forward-heading-same-level (1- n) t) (error nil)) (org-end-of-subtree t t)) (org-back-over-empty-lines) @@ -7761,8 +7874,8 @@ the inserted text when done." (setq tree (or tree (and kill-ring (current-kill 0)))) (unless (org-kill-is-subtree-p tree) (error "%s" - (substitute-command-keys - "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) + (substitute-command-keys + "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) (org-with-limited-levels (let* ((visp (not (outline-invisible-p))) (txt tree) @@ -7778,8 +7891,7 @@ the inserted text when done." (- (match-end 1) (match-beginning 1))) ((and (bolp) (looking-at org-outline-regexp)) - (- (match-end 0) (point) 1)) - (t nil))) + (- (match-end 0) (point) 1)))) (previous-level (save-excursion (condition-case nil (progn @@ -7920,7 +8032,7 @@ If yes, remember the marker and the distance to BEG." (interactive) (let* ((case-fold-search t) (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*" - "^[ \t]*#\\+end_.*"))) + "^[ \t]*#\\+end_.*"))) (if blockp (narrow-to-region (car blockp) (cdr blockp)) (error "Not in a block")))) @@ -7961,7 +8073,7 @@ and still retain the repeater to cover future instances of the task." (if (not (and (integerp n) (> n 0))) (error "Invalid number of replications %s" n)) (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) - (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'" + (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'" shift))) (error "Invalid shift specification %s" shift)) (when doshift @@ -7979,7 +8091,7 @@ and still retain the repeater to cover future instances of the task." (setq end (point)) (setq template (buffer-substring beg end)) (when (and doshift - (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[dwmy][^<>\n]*>" template)) + (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template)) (delete-region beg end) (setq end beg) (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) @@ -8010,7 +8122,7 @@ and still retain the repeater to cover future instances of the task." (while (re-search-forward org-ts-regexp nil t) (save-excursion (goto-char (match-beginning 0)) - (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[dwmy]\\)") + (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") (delete-region (match-beginning 1) (match-end 1))))))) (setq task (buffer-string))) (insert task)) @@ -8231,8 +8343,7 @@ WITH-CASE, the sorting considers case as well." (cond ((= dcst ?a) 'string<) ((= dcst ?f) compare-func) - ((member dcst '(?p ?t ?s ?d ?c)) '<) - (t nil))))) + ((member dcst '(?p ?t ?s ?d ?c)) '<))))) (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting entries...done"))) @@ -8339,26 +8450,31 @@ C-c C-c Set tags / toggle checkbox" "Unconditionally turn on `orgstruct-mode'." (orgstruct-mode 1)) +(defvar org-fb-vars nil) +(make-variable-buffer-local 'org-fb-vars) (defun orgstruct++-mode (&optional arg) "Toggle `orgstruct-mode', the enhanced version of it. -In addition to setting orgstruct-mode, this also exports all indentation -and autofilling variables from org-mode into the buffer. It will also -recognize item context in multiline items. -Note that turning off orgstruct-mode will *not* remove the -indentation/paragraph settings. This can only be done by refreshing the -major mode, for example with \\[normal-mode]." +In addition to setting orgstruct-mode, this also exports all +indentation and autofilling variables from org-mode into the +buffer. It will also recognize item context in multiline items." (interactive "P") (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) (if (< arg 1) - (orgstruct-mode -1) + (progn (orgstruct-mode -1) + (mapc (lambda(v) + (org-set-local (car v) + (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v)))) + org-fb-vars)) (orgstruct-mode 1) + (setq org-fb-vars nil) (let (var val) (mapc (lambda (x) (when (string-match - "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" + "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)" (symbol-name (car x))) (setq var (car x) val (nth 1 x)) + (push (list var `(quote ,(eval var))) org-fb-vars) (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) org-local-vars) (org-set-local 'orgstruct-is-++ t)))) @@ -8414,6 +8530,9 @@ major mode, for example with \\[normal-mode]." cmd (orgstruct-make-binding fun nfunc key)) (org-defkey orgstruct-mode-map key cmd)) + ;; Prevent an error for users who forgot to make autoloads + (require 'org-element) + ;; Special treatment needed for TAB and RET (org-defkey orgstruct-mode-map [(tab)] (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) @@ -8422,21 +8541,21 @@ major mode, for example with \\[normal-mode]." (org-defkey orgstruct-mode-map "\M-\C-m" (orgstruct-make-binding 'org-insert-heading 105 - "\M-\C-m" [(meta return)])) + "\M-\C-m" [(meta return)])) (org-defkey orgstruct-mode-map [(meta return)] (orgstruct-make-binding 'org-insert-heading 106 - [(meta return)] "\M-\C-m")) + [(meta return)] "\M-\C-m")) (org-defkey orgstruct-mode-map [(shift meta return)] (orgstruct-make-binding 'org-insert-todo-heading 107 - [(meta return)] "\M-\C-m")) + [(meta return)] "\M-\C-m")) (org-defkey orgstruct-mode-map "\e\C-m" (orgstruct-make-binding 'org-insert-heading 108 - "\e\C-m" [?\e (return)])) + "\e\C-m" [?\e (return)])) (org-defkey orgstruct-mode-map [?\e (return)] (orgstruct-make-binding 'org-insert-heading 109 - [?\e (return)] "\e\C-m")) + [?\e (return)] "\e\C-m")) (org-defkey orgstruct-mode-map [?\e (shift return)] (orgstruct-make-binding 'org-insert-todo-heading 110 [?\e (return)] "\e\C-m")) @@ -8474,6 +8593,77 @@ to execute outside of tables." keys) '('orgstruct-error)))))))) +(defun org-contextualize-keys (alist contexts) + "Return valid elements in ALIST depending on CONTEXTS. + +`org-agenda-custom-commands' or `org-capture-templates' are the +values used for ALIST, and `org-agenda-custom-commands-contexts' +or `org-capture-templates-contexts' are the associated contexts +definitions." + (let ((contexts + ;; normalize contexts + (mapcar + (lambda(c) (cond ((listp (cadr c)) + (list (car c) (car c) (cadr c))) + ((string= "" (cadr c)) + (list (car c) (car c) (caddr c))) + (t c))) contexts)) + (a alist) c r s) + ;; loop over all commands or templates + (while (setq c (pop a)) + (let (vrules repl) + (cond + ((not (assoc (car c) contexts)) + (push c r)) + ((and (assoc (car c) contexts) + (setq vrules (org-contextualize-validate-key + (car c) contexts))) + (mapc (lambda (vr) + (when (not (equal (car vr) (cadr vr))) + (setq repl vr))) vrules) + (if (not repl) (push c r) + (push (cadr repl) s) + (push + (cons (car c) + (cdr (or (assoc (cadr repl) alist) + (error "Undefined key `%s' as contextual replacement for `%s'" + (cadr repl) (car c))))) + r)))))) + ;; Return limited ALIST, possibly with keys modified, and deduplicated + (delq + nil + (delete-dups + (mapcar (lambda (x) + (let ((tpl (car x))) + (when (not (delq + nil + (mapcar (lambda(y) + (equal y tpl)) s))) x))) + (reverse r)))))) + +(defun org-contextualize-validate-key (key contexts) + "Check CONTEXTS for agenda or capture KEY." + (let (r rr res) + (while (setq r (pop contexts)) + (mapc + (lambda (rr) + (when + (and (equal key (car r)) + (if (functionp rr) (funcall rr) + (or (and (eq (car rr) 'in-file) + (buffer-file-name) + (string-match (cdr rr) (buffer-file-name))) + (and (eq (car rr) 'in-mode) + (string-match (cdr rr) (symbol-name major-mode))) + (when (and (eq (car rr) 'not-in-file) + (buffer-file-name)) + (not (string-match (cdr rr) (buffer-file-name)))) + (when (eq (car rr) 'not-in-mode) + (not (string-match (cdr rr) (symbol-name major-mode))))))) + (push r res))) + (car (last r)))) + (delete-dups (delq nil res)))) + (defun org-context-p (&rest contexts) "Check if local context is any of CONTEXTS. Possible values in the list of contexts are `table', `headline', and `item'." @@ -8490,7 +8680,7 @@ Possible values in the list of contexts are `table', `headline', and `item'." (goto-char pos)))) (defun org-get-local-variables () - "Return a list of all local variables in an org-mode buffer." + "Return a list of all local variables in an Org mode buffer." (let (varlist) (with-current-buffer (get-buffer-create "*Org tmp*") (erase-buffer) @@ -8505,7 +8695,7 @@ Possible values in the list of contexts are `table', `headline', and `item'." (list x) (list (car x) (list 'quote (cdr x))))) (if (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" + "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" (symbol-name (car x))) x nil)) varlist)))) @@ -8547,7 +8737,9 @@ call CMD." (defun org-refresh-category-properties () "Refresh category text properties in the buffer." - (let ((def-cat (cond + (let ((case-fold-search t) + (inhibit-read-only t) + (def-cat (cond ((null org-category) (if buffer-file-name (file-name-sans-extension @@ -8593,6 +8785,8 @@ call CMD." (setq rpl (cdr as)) (cond ((symbolp rpl) (funcall rpl tag)) + ((string-match "%(\\([^)]+\\))" rpl) + (replace-match (funcall (intern-soft (match-string 1 rpl)) tag) t t rpl)) ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) ((string-match "%h" rpl) (replace-match (url-hexify-string (or tag "")) t t rpl)) @@ -8631,7 +8825,7 @@ Special properties are: this when inserting this link into an Org-mode buffer. In addition to these, any additional properties can be specified -and then used in remember templates.") +and then used in capture templates.") (defun org-add-link-type (type &optional follow export) "Add TYPE to the list of `org-link-types'. @@ -8665,7 +8859,8 @@ type. For a simple example of an export function, see `org-bbdb.el'." (setcdr (assoc type org-link-protocols) (list follow export)) (push (list type follow export) org-link-protocols))) -(defvar org-agenda-buffer-name) +(defvar org-agenda-buffer-name) ; Defined in org-agenda.el +(defvar org-link-to-org-use-id) ; Defined in org-id.el ;;;###autoload (defun org-store-link (arg) @@ -8727,17 +8922,24 @@ For file links, arg negates `org-context-in-file-links'." nil nil nil)))) (org-store-link-props :type "calendar" :date cd))) + ((eq major-mode 'help-mode) + (setq link (concat "help:" (save-excursion + (goto-char (point-min)) + (looking-at "^[^ ]+") + (match-string 0)))) + (org-store-link-props :type "help")) + ((eq major-mode 'w3-mode) (setq cpltxt (if (and (buffer-name) (not (string-match "Untitled" (buffer-name)))) (buffer-name) (url-view-url t)) - link (org-make-link (url-view-url t))) + link (url-view-url t)) (org-store-link-props :type "w3" :url (url-view-url t))) ((eq major-mode 'w3m-mode) (setq cpltxt (or w3m-current-title w3m-current-url) - link (org-make-link w3m-current-url)) + link w3m-current-url) (org-store-link-props :type "w3m" :url (url-view-url t))) ((setq search (run-hook-with-args-until-success @@ -8749,7 +8951,7 @@ For file links, arg negates `org-context-in-file-links'." ((eq major-mode 'image-mode) (setq cpltxt (concat "file:" (abbreviate-file-name buffer-file-name)) - link (org-make-link cpltxt)) + link cpltxt) (org-store-link-props :type "image" :file buffer-file-name)) ((eq major-mode 'dired-mode) @@ -8761,9 +8963,9 @@ For file links, arg negates `org-context-in-file-links'." ;; otherwise, no file so use current directory. default-directory)) (setq cpltxt (concat "file:" file) - link (org-make-link cpltxt)))) + link cpltxt))) - ((and (buffer-file-name (buffer-base-buffer)) (eq major-mode 'org-mode)) + ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) (setq custom-id (org-entry-get nil "CUSTOM_ID")) (cond ((org-in-regexp "<<\\(.*?\\)>>") @@ -8772,22 +8974,19 @@ For file links, arg negates `org-context-in-file-links'." (abbreviate-file-name (buffer-file-name (buffer-base-buffer))) "::" (match-string 1)) - link (org-make-link cpltxt))) + link cpltxt)) ((and (featurep 'org-id) (or (eq org-link-to-org-use-id t) - (and (eq org-link-to-org-use-id 'create-if-interactive) - (org-called-interactively-p 'any)) - (and (eq org-link-to-org-use-id - 'create-if-interactive-and-no-custom-id) - (org-called-interactively-p 'any) - (not custom-id)) - (and org-link-to-org-use-id - (org-entry-get nil "ID")))) + (and (org-called-interactively-p 'any) + (or (eq org-link-to-org-use-id 'create-if-interactive) + (and (eq org-link-to-org-use-id + 'create-if-interactive-and-no-custom-id) + (not custom-id)))) + (and org-link-to-org-use-id (org-entry-get nil "ID")))) ;; We can make a link using the ID. (setq link (condition-case nil (prog1 (org-id-store-link) - (setq desc (plist-get org-store-link-plist - :description))) + (setq desc (plist-get org-store-link-plist :description))) (error ;; probably before first headline, link to file only (concat "file:" @@ -8803,8 +9002,7 @@ For file links, arg negates `org-context-in-file-links'." (setq txt (cond ((org-at-heading-p) nil) ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))) - (t nil))) + (buffer-substring (region-beginning) (region-end))))) (when (or (null txt) (string-match "\\S-" txt)) (setq cpltxt (concat cpltxt "::" @@ -8815,7 +9013,7 @@ For file links, arg negates `org-context-in-file-links'." (org-heading-components))) "NONE")))) (if (string-match "::\\'" cpltxt) (setq cpltxt (substring cpltxt 0 -2))) - (setq link (org-make-link cpltxt))))) + (setq link cpltxt)))) ((buffer-file-name (buffer-base-buffer)) ;; Just link to this file here. @@ -8832,7 +9030,7 @@ For file links, arg negates `org-context-in-file-links'." (setq cpltxt (concat cpltxt "::" (org-make-org-heading-search-string txt)) desc "NONE"))) - (setq link (org-make-link cpltxt))) + (setq link cpltxt)) ((org-called-interactively-p 'interactive) (error "Cannot link to a buffer which is not visiting a file")) @@ -8938,10 +9136,6 @@ according to FMT (default from `org-email-link-description-format')." (reverse slines))) "\n"))))) (mapconcat 'identity (org-split-string s "[ \t]+") " "))) -(defun org-make-link (&rest strings) - "Concatenate STRINGS." - (apply 'concat strings)) - (defun org-make-link-string (link &optional description) "Make a link with brackets, consisting of LINK and DESCRIPTION." (unless (string-match "\\S-" link) @@ -8978,8 +9172,6 @@ according to FMT (default from `org-email-link-description-format')." "List of characters that should be escaped in link. This is the list that is used for internal purposes.") -(defvar org-url-encoding-use-url-hexify nil) - (defconst org-link-escape-chars-browser '(?\ ) "List of escapes for characters that are problematic in links. @@ -8992,25 +9184,24 @@ Optional argument TABLE is a list with characters that should be escaped. When nil, `org-link-escape-chars' is used. If optional argument MERGE is set, merge TABLE into `org-link-escape-chars'." - (if (and org-url-encoding-use-url-hexify (not table)) - (url-hexify-string text) - (cond - ((and table merge) - (mapc (lambda (defchr) - (unless (member defchr table) - (setq table (cons defchr table)))) org-link-escape-chars)) - ((null table) - (setq table org-link-escape-chars))) - (mapconcat - (lambda (char) - (if (or (member char table) - (< char 32) (= char 37) (> char 126)) - (mapconcat (lambda (sequence-element) - (format "%%%.2X" sequence-element)) - (or (encode-coding-char char 'utf-8) - (error "Unable to percent escape character: %s" - (char-to-string char))) "") - (char-to-string char))) text ""))) + (cond + ((and table merge) + (mapc (lambda (defchr) + (unless (member defchr table) + (setq table (cons defchr table)))) org-link-escape-chars)) + ((null table) + (setq table org-link-escape-chars))) + (mapconcat + (lambda (char) + (if (or (member char table) + (and (or (< char 32) (= char 37) (> char 126)) + org-url-hexify-p)) + (mapconcat (lambda (sequence-element) + (format "%%%.2X" sequence-element)) + (or (encode-coding-char char 'utf-8) + (error "Unable to percent escape character: %s" + (char-to-string char))) "") + (char-to-string char))) text "")) (defun org-link-unescape (str) "Unhex hexified Unicode strings as returned from the JavaScript function @@ -9083,6 +9274,14 @@ Note: this function also decodes single byte encodings like (setq s (replace-match "%40" t t s))) s) +(defun org-link-prettify (link) + "Return a human-readable representation of LINK. +The car of LINK must be a raw link the cdr of LINK must be either +a link description or nil." + (let ((desc (or (cadr link) "<no description>"))) + (concat (format "%-45s" (substring desc 0 (min (length desc) 40))) + "<" (car link) ">"))) + ;;;###autoload (defun org-insert-link-global () "Insert a link like Org-mode does. @@ -9091,6 +9290,38 @@ This command can be called in any mode to insert a link in Org-mode syntax." (org-load-modules-maybe) (org-run-like-in-org-mode 'org-insert-link)) +(defun org-insert-all-links (&optional keep) + "Insert all links in `org-stored-links'." + (interactive "P") + (let ((links (copy-sequence org-stored-links)) l) + (while (setq l (if keep (pop links) (pop org-stored-links))) + (insert "- ") + (org-insert-link nil (car l) (cadr l)) + (insert "\n")))) + +(defun org-link-fontify-links-to-this-file () + "Fontify links to the current file in `org-stored-links'." + (let ((f (buffer-file-name)) a b) + (setq a (mapcar (lambda(l) + (let ((ll (car l))) + (when (and (string-match "^file:\\(.+\\)::" ll) + (equal f (expand-file-name (match-string 1 ll)))) + ll))) + org-stored-links)) + (when (featurep 'org-id) + (setq b (mapcar (lambda(l) + (let ((ll (car l))) + (when (and (string-match "^id:\\(.+\\)$" ll) + (equal f (expand-file-name + (or (org-id-find-id-file + (match-string 1 ll)) "")))) + ll))) + org-stored-links))) + (mapcar (lambda(l) + (put-text-property 0 (length l) 'face 'font-lock-comment-face l)) + (delq nil (append a b))))) + +(defvar org-link-links-in-this-file nil) (defun org-insert-link (&optional complete-file link-location default-description) "Insert a link. At the prompt, enter the link. @@ -9139,7 +9370,8 @@ be used as the default description." (desc region) tmphist ; byte-compile incorrectly complains about this (link link-location) - entry file all-prefixes) + (abbrevs org-link-abbrev-alist-local) + entry file all-prefixes auto-desc) (cond (link-location) ; specified by arg, just use it. ((org-in-regexp org-bracket-link-regexp 1) @@ -9160,15 +9392,17 @@ be used as the default description." (setq link (org-file-complete-link complete-file))) (t ;; Read link, with completion for stored links. - (with-output-to-temp-buffer "*Org Links*" - (princ "Insert a link. + (org-link-fontify-links-to-this-file) + (org-switch-to-buffer-other-window "*Org Links*") + (with-current-buffer "*Org Links*" + (erase-buffer) + (insert "Insert a link. Use TAB to complete link prefixes, then RET for type-specific completion support\n") (when org-stored-links - (princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") - (princ (mapconcat - (lambda (x) - (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x))) - (reverse org-stored-links) "\n")))) + (insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") + (insert (mapconcat 'org-link-prettify + (reverse org-stored-links) "\n"))) + (goto-char (point-min))) (let ((cw (selected-window))) (select-window (get-buffer-window "*Org Links*" 'visible)) (with-current-buffer "*Org Links*" (setq truncate-lines t)) @@ -9178,7 +9412,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support ;; Fake a link history, containing the stored links. (setq tmphist (append (mapcar 'car org-stored-links) org-insert-link-history)) - (setq all-prefixes (append (mapcar 'car org-link-abbrev-alist-local) + (setq all-prefixes (append (mapcar 'car abbrevs) (mapcar 'car org-link-abbrev-alist) org-link-types)) (unwind-protect @@ -9191,12 +9425,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (append (mapcar (lambda (x) (list (concat x ":"))) all-prefixes) - (mapcar 'car org-stored-links)) + (mapcar 'car org-stored-links) + (mapcar 'cadr org-stored-links)) nil nil nil 'tmphist - (car (car org-stored-links))))) + (caar org-stored-links)))) (if (not (string-match "\\S-" link)) (error "No link selected")) + (mapc (lambda(l) + (when (equal link (cadr l)) (setq link (car l) auto-desc t))) + org-stored-links) (if (or (member link all-prefixes) (and (equal ":" (substring link -1)) (member (substring link 0 -1) all-prefixes) @@ -9206,15 +9444,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (kill-buffer "*Org Links*")) (setq entry (assoc link org-stored-links)) (or entry (push link org-insert-link-history)) - (if (funcall (if (equal complete-file '(64)) 'not 'identity) - (not org-keep-stored-link-after-insertion)) - (setq org-stored-links (delq (assoc link org-stored-links) - org-stored-links))) (setq desc (or desc (nth 1 entry))))) + (if (funcall (if (equal complete-file '(64)) 'not 'identity) + (not org-keep-stored-link-after-insertion)) + (setq org-stored-links (delq (assoc link org-stored-links) + org-stored-links))) + (if (string-match org-plain-link-re link) ;; URL-like link, normalize the use of angular brackets. - (setq link (org-make-link (org-remove-angle-brackets link)))) + (setq link (org-remove-angle-brackets link))) ;; Check if we are linking to the current file with a search option ;; If yes, simplify the link by using only the search option. @@ -9258,10 +9497,17 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (setq desc path)))) (if org-make-link-description-function - (setq desc (funcall org-make-link-description-function link desc)) - (if default-description (setq desc default-description))) + (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))))) - (setq desc (read-string "Description: " desc)) (unless (string-match "\\S-" desc) (setq desc nil)) (if remove (apply 'delete-region remove)) (insert (org-make-link-string link desc)))) @@ -9282,16 +9528,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (expand-file-name "."))))) (cond ((equal arg '(16)) - (setq link (org-make-link + (setq link (concat "file:" (abbreviate-file-name (expand-file-name file))))) ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) - (setq link (org-make-link "file:" (match-string 1 file)))) + (setq link (concat "file:" (match-string 1 file)))) ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") (expand-file-name file)) - (setq link (org-make-link + (setq link (concat "file:" (match-string 1 (expand-file-name file))))) - (t (setq link (org-make-link "file:" file))))) + (t (setq link (concat "file:" file))))) link)) (defun org-completing-read (&rest args) @@ -9446,24 +9692,24 @@ If the link is in hidden text, expose it." (defun org-translate-link-from-planner (type path) "Translate a link from Emacs Planner syntax so that Org can follow it. This is still an experimental function, your mileage may vary." - (cond - ((member type '("http" "https" "news" "ftp")) - ;; standard Internet links are the same. - nil) - ((and (equal type "irc") (string-match "^//" path)) - ;; Planner has two / at the beginning of an irc link, we have 1. - ;; We should have zero, actually.... - (setq path (substring path 1))) - ((and (equal type "lisp") (string-match "^/" path)) - ;; Planner has a slash, we do not. - (setq type "elisp" path (substring path 1))) - ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path) - ;; A typical message link. Planner has the id after the final slash, - ;; we separate it with a hash mark - (setq path (concat (match-string 1 path) "#" - (org-remove-angle-brackets (match-string 2 path))))) - ) - (cons type path)) + (cond + ((member type '("http" "https" "news" "ftp")) + ;; standard Internet links are the same. + nil) + ((and (equal type "irc") (string-match "^//" path)) + ;; Planner has two / at the beginning of an irc link, we have 1. + ;; We should have zero, actually.... + (setq path (substring path 1))) + ((and (equal type "lisp") (string-match "^/" path)) + ;; Planner has a slash, we do not. + (setq type "elisp" path (substring path 1))) + ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path) + ;; A typical message link. Planner has the id after the final slash, + ;; we separate it with a hash mark + (setq path (concat (match-string 1 path) "#" + (org-remove-angle-brackets (match-string 2 path))))) + ) + (cons type path)) (defun org-find-file-at-mouse (ev) "Open file link or URL at mouse." @@ -9518,6 +9764,7 @@ Functions in this hook must return t if they identify and follow a link at point. If they don't find anything interesting at point, they must return nil.") +(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el (defun org-open-at-point (&optional arg reference-buffer) "Open link at or after point. If there is no link at point, this function will search forward up to @@ -9529,197 +9776,213 @@ application the system uses for this file type." (interactive "P") ;; if in a code block, then open the block's results (unless (call-interactively #'org-babel-open-src-block-result) - (org-load-modules-maybe) - (move-marker org-open-link-marker (point)) - (setq org-window-config-before-follow-link (current-window-configuration)) - (org-remove-occur-highlights nil nil t) - (cond - ((and (org-at-heading-p) - (not (org-in-regexp - (concat org-plain-link-re "\\|" - org-bracket-link-regexp "\\|" - org-angle-link-re "\\|" - "[ \t]:[^ \t\n]+:[ \t]*$"))) - (not (get-text-property (point) 'org-linked-text))) - (or (org-offer-links-in-entry arg) - (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) - ((run-hook-with-args-until-success 'org-open-at-point-functions)) - ((org-at-timestamp-p t) (org-follow-timestamp-link)) - ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) - (not (org-in-regexp org-bracket-link-regexp))) - (org-footnote-action)) - (t - (let (type path link line search (pos (point))) - (catch 'match - (save-excursion - (skip-chars-forward "^]\n\r") - (when (org-in-regexp org-bracket-link-regexp 1) - (setq link (org-extract-attributes - (org-link-unescape (org-match-string-no-properties 1)))) - (while (string-match " *\n *" link) - (setq link (replace-match " " t t link))) - (setq link (org-link-expand-abbrev link)) - (cond - ((or (file-name-absolute-p link) - (string-match "^\\.\\.?/" link)) - (setq type "file" path link)) - ((string-match org-link-re-with-space3 link) - (setq type (match-string 1 link) path (match-string 2 link))) - (t (setq type "thisfile" path link))) - (throw 'match t))) - - (when (get-text-property (point) 'org-linked-text) - (setq type "thisfile" - pos (if (get-text-property (1+ (point)) 'org-linked-text) - (1+ (point)) (point)) - path (buffer-substring - (or (previous-single-property-change pos 'org-linked-text) - (point-min)) - (or (next-single-property-change pos 'org-linked-text) - (point-max)))) - (throw 'match t)) + (org-load-modules-maybe) + (move-marker org-open-link-marker (point)) + (setq org-window-config-before-follow-link (current-window-configuration)) + (org-remove-occur-highlights nil nil t) + (cond + ((and (org-at-heading-p) + (not (org-at-timestamp-p t)) + (not (org-in-regexp + (concat org-plain-link-re "\\|" + org-bracket-link-regexp "\\|" + org-angle-link-re "\\|" + "[ \t]:[^ \t\n]+:[ \t]*$"))) + (not (get-text-property (point) 'org-linked-text))) + (or (org-offer-links-in-entry arg) + (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) + ((run-hook-with-args-until-success 'org-open-at-point-functions)) + ((and (org-at-timestamp-p t) + (not (org-in-regexp org-bracket-link-regexp))) + (org-follow-timestamp-link)) + ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) + (not (org-in-regexp org-bracket-link-regexp))) + (org-footnote-action)) + (t + (let (type path link line search (pos (point))) + (catch 'match + (save-excursion + (skip-chars-forward "^]\n\r") + (when (org-in-regexp org-bracket-link-regexp 1) + (setq link (org-extract-attributes + (org-link-unescape (org-match-string-no-properties 1)))) + (while (string-match " *\n *" link) + (setq link (replace-match " " t t link))) + (setq link (org-link-expand-abbrev link)) + (cond + ((or (file-name-absolute-p link) + (string-match "^\\.\\.?/" link)) + (setq type "file" path link)) + ((string-match org-link-re-with-space3 link) + (setq type (match-string 1 link) path (match-string 2 link))) + ((string-match "^help:+\\(.+\\)" link) + (setq type "help" path (match-string 1 link))) + (t (setq type "thisfile" path link))) + (throw 'match t))) + + (when (get-text-property (point) 'org-linked-text) + (setq type "thisfile" + pos (if (get-text-property (1+ (point)) 'org-linked-text) + (1+ (point)) (point)) + path (buffer-substring + (or (previous-single-property-change pos 'org-linked-text) + (point-min)) + (or (next-single-property-change pos 'org-linked-text) + (point-max)))) + (throw 'match t)) - (save-excursion - (when (or (org-in-regexp org-angle-link-re) - (org-in-regexp org-plain-link-re)) - (setq type (match-string 1) - path (org-link-unescape (match-string 2))) - (throw 'match t))) - (save-excursion - (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) - (setq type "tags" + (save-excursion + (when (or (org-in-regexp org-angle-link-re) + (and (goto-char (car (org-in-regexp org-plain-link-re))) + (save-match-data (not (looking-back "\\[\\["))))) + (setq type (match-string 1) + path (org-link-unescape (match-string 2))) + (throw 'match t))) + (save-excursion + (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) + (setq type "tags" + path (match-string 1)) + (while (string-match ":" path) + (setq path (replace-match "+" t t path))) + (throw 'match t))) + (when (org-in-regexp "<\\([^><\n]+\\)>") + (setq type "tree-match" path (match-string 1)) - (while (string-match ":" path) - (setq path (replace-match "+" t t path))) (throw 'match t))) - (when (org-in-regexp "<\\([^><\n]+\\)>") - (setq type "tree-match" - path (match-string 1)) - (throw 'match t))) - (unless path - (error "No link found")) - - ;; switch back to reference buffer - ;; needed when if called in a temporary buffer through - ;; org-open-link-from-string - (with-current-buffer (or reference-buffer (current-buffer)) - - ;; Remove any trailing spaces in path - (if (string-match " +\\'" path) - (setq path (replace-match "" t t path))) - (if (and org-link-translation-function - (fboundp org-link-translation-function)) - ;; Check if we need to translate the link - (let ((tmp (funcall org-link-translation-function type path))) - (setq type (car tmp) path (cdr tmp)))) + (unless path + (error "No link found")) + + ;; switch back to reference buffer + ;; needed when if called in a temporary buffer through + ;; org-open-link-from-string + (with-current-buffer (or reference-buffer (current-buffer)) + + ;; Remove any trailing spaces in path + (if (string-match " +\\'" path) + (setq path (replace-match "" t t path))) + (if (and org-link-translation-function + (fboundp org-link-translation-function)) + ;; Check if we need to translate the link + (let ((tmp (funcall org-link-translation-function type path))) + (setq type (car tmp) path (cdr tmp)))) - (cond + (cond - ((assoc type org-link-protocols) - (funcall (nth 1 (assoc type org-link-protocols)) path)) - - ((equal type "mailto") - (let ((cmd (car org-link-mailto-program)) - (args (cdr org-link-mailto-program)) args1 - (address path) (subject "") a) - (if (string-match "\\(.*\\)::\\(.*\\)" path) - (setq address (match-string 1 path) - subject (org-link-escape (match-string 2 path)))) - (while args - (cond - ((not (stringp (car args))) (push (pop args) args1)) - (t (setq a (pop args)) - (if (string-match "%a" a) - (setq a (replace-match address t t a))) - (if (string-match "%s" a) - (setq a (replace-match subject t t a))) - (push a args1)))) - (apply cmd (nreverse args1)))) - - ((member type '("http" "https" "ftp" "news")) - (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path) - (org-link-escape - path org-link-escape-chars-browser) - path)))) - - ((string= type "doi") - (browse-url (concat "http://dx.doi.org/" (if (org-string-match-p "[[:nonascii:] ]" path) + ((assoc type org-link-protocols) + (funcall (nth 1 (assoc type org-link-protocols)) path)) + + ((equal type "help") + (let ((f-or-v (intern path))) + (cond ((fboundp f-or-v) + (describe-function f-or-v)) + ((boundp f-or-v) + (describe-variable f-or-v)) + (t (error "Not a known function or variable"))))) + + ((equal type "mailto") + (let ((cmd (car org-link-mailto-program)) + (args (cdr org-link-mailto-program)) args1 + (address path) (subject "") a) + (if (string-match "\\(.*\\)::\\(.*\\)" path) + (setq address (match-string 1 path) + subject (org-link-escape (match-string 2 path)))) + (while args + (cond + ((not (stringp (car args))) (push (pop args) args1)) + (t (setq a (pop args)) + (if (string-match "%a" a) + (setq a (replace-match address t t a))) + (if (string-match "%s" a) + (setq a (replace-match subject t t a))) + (push a args1)))) + (apply cmd (nreverse args1)))) + + ((member type '("http" "https" "ftp" "news")) + (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path) + (org-link-escape + path org-link-escape-chars-browser) + path)))) + + ((string= type "doi") + (browse-url (concat org-doi-server-url (if (org-string-match-p "[[:nonascii:] ]" path) (org-link-escape path org-link-escape-chars-browser) path)))) - ((member type '("message")) - (browse-url (concat type ":" path))) - - ((string= type "tags") - (org-tags-view arg path)) - - ((string= type "tree-match") - (org-occur (concat "\\[" (regexp-quote path) "\\]"))) - - ((string= type "file") - (if (string-match "::\\([0-9]+\\)\\'" path) - (setq line (string-to-number (match-string 1 path)) - path (substring path 0 (match-beginning 0))) - (if (string-match "::\\(.+\\)\\'" path) - (setq search (match-string 1 path) - path (substring path 0 (match-beginning 0))))) - (if (string-match "[*?{]" (file-name-nondirectory path)) - (dired path) - (org-open-file path arg line search))) - - ((string= type "shell") - (let ((cmd path)) - (if (or (and (not (string= org-confirm-shell-link-not-regexp "")) - (string-match org-confirm-shell-link-not-regexp cmd)) - (not org-confirm-shell-link-function) - (funcall org-confirm-shell-link-function - (format "Execute \"%s\" in shell? " - (org-add-props cmd nil - 'face 'org-warning)))) - (progn - (message "Executing %s" cmd) - (shell-command cmd)) - (error "Abort")))) - - ((string= type "elisp") - (let ((cmd path)) - (if (or (and (not (string= org-confirm-elisp-link-not-regexp "")) - (string-match org-confirm-elisp-link-not-regexp cmd)) - (not org-confirm-elisp-link-function) - (funcall org-confirm-elisp-link-function - (format "Execute \"%s\" as elisp? " - (org-add-props cmd nil - 'face 'org-warning)))) - (message "%s => %s" cmd - (if (equal (string-to-char cmd) ?\() - (eval (read cmd)) - (call-interactively (read cmd)))) - (error "Abort")))) - - ((and (string= type "thisfile") - (run-hook-with-args-until-success - 'org-open-link-functions path))) - - ((string= type "thisfile") - (if arg - (switch-to-buffer-other-window - (org-get-buffer-for-internal-link (current-buffer))) - (org-mark-ring-push)) - (let ((cmd `(org-link-search - ,path - ,(cond ((equal arg '(4)) ''occur) - ((equal arg '(16)) ''org-occur) - (t nil)) - ,pos))) - (condition-case nil (let ((org-link-search-inhibit-query t)) - (eval cmd)) - (error (progn (widen) (eval cmd)))))) - - (t - (browse-url-at-point))))))) - (move-marker org-open-link-marker nil) - (run-hook-with-args 'org-follow-link-hook))) + ((member type '("message")) + (browse-url (concat type ":" path))) + + ((string= type "tags") + (org-tags-view arg path)) + + ((string= type "tree-match") + (org-occur (concat "\\[" (regexp-quote path) "\\]"))) + + ((string= type "file") + (if (string-match "::\\([0-9]+\\)\\'" path) + (setq line (string-to-number (match-string 1 path)) + path (substring path 0 (match-beginning 0))) + (if (string-match "::\\(.+\\)\\'" path) + (setq search (match-string 1 path) + path (substring path 0 (match-beginning 0))))) + (if (string-match "[*?{]" (file-name-nondirectory path)) + (dired path) + (org-open-file path arg line search))) + + ((string= type "shell") + (let ((buf (generate-new-buffer "*Org Shell Output")) + (cmd path)) + (if (or (and (not (string= org-confirm-shell-link-not-regexp "")) + (string-match org-confirm-shell-link-not-regexp cmd)) + (not org-confirm-shell-link-function) + (funcall org-confirm-shell-link-function + (format "Execute \"%s\" in shell? " + (org-add-props cmd nil + 'face 'org-warning)))) + (progn + (message "Executing %s" cmd) + (shell-command cmd buf) + (if (featurep 'midnight) + (setq clean-buffer-list-kill-buffer-names + (cons buf clean-buffer-list-kill-buffer-names)))) + (error "Abort")))) + + ((string= type "elisp") + (let ((cmd path)) + (if (or (and (not (string= org-confirm-elisp-link-not-regexp "")) + (string-match org-confirm-elisp-link-not-regexp cmd)) + (not org-confirm-elisp-link-function) + (funcall org-confirm-elisp-link-function + (format "Execute \"%s\" as elisp? " + (org-add-props cmd nil + 'face 'org-warning)))) + (message "%s => %s" cmd + (if (equal (string-to-char cmd) ?\() + (eval (read cmd)) + (call-interactively (read cmd)))) + (error "Abort")))) + + ((and (string= type "thisfile") + (run-hook-with-args-until-success + 'org-open-link-functions path))) + + ((string= type "thisfile") + (if arg + (switch-to-buffer-other-window + (org-get-buffer-for-internal-link (current-buffer))) + (org-mark-ring-push)) + (let ((cmd `(org-link-search + ,path + ,(cond ((equal arg '(4)) ''occur) + ((equal arg '(16)) ''org-occur)) + ,pos))) + (condition-case nil (let ((org-link-search-inhibit-query t)) + (eval cmd)) + (error (progn (widen) (eval cmd)))))) + + (t (browse-url-at-point))))))) + (move-marker org-open-link-marker nil) + (run-hook-with-args 'org-follow-link-hook))) (defun org-offer-links-in-entry (&optional nth zero) "Offer links in the current entry and follow the selected link. @@ -9903,6 +10166,22 @@ visibility around point, thus ignoring pos (match-beginning 0)))) ;; There is an exact target for this (goto-char pos)) + ((save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (format "^[ \t]*#\\+TARGET: %s" (regexp-quote s0)) nil t) + (setq type 'dedicated pos (match-beginning 0)))) + ;; Found an invisible target. + (goto-char pos)) + ((save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t) + (setq type 'dedicated pos (match-beginning 0)))) + ;; Found an element with a matching #+name affiliated keyword. + (goto-char pos)) ((and (string-match "^(\\(.*\\))$" s0) (save-excursion (goto-char (point-min)) @@ -9919,12 +10198,12 @@ visibility around point, thus ignoring ((string-match "^/\\(.*\\)/$" s) ;; A regular expression (cond - ((eq major-mode 'org-mode) + ((derived-mode-p 'org-mode) (org-occur (match-string 1 s))) ;;((eq major-mode 'dired-mode) ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) (t (org-do-occur (match-string 1 s))))) - ((and (eq major-mode 'org-mode) org-link-search-must-match-exact-headline) + ((and (derived-mode-p 'org-mode) org-link-search-must-match-exact-headline) (and (equal (string-to-char s) ?*) (setq s (substring s 1))) (goto-char (point-min)) (cond @@ -9992,7 +10271,7 @@ visibility around point, thus ignoring (goto-char (match-beginning 1)) (goto-char pos) (error "No match")))))) - (and (eq major-mode 'org-mode) + (and (derived-mode-p 'org-mode) (not stealth) (org-show-context 'link-search)) type)) @@ -10073,8 +10352,8 @@ to read." (or pos (point)) (or buffer (current-buffer))) (message "%s" - (substitute-command-keys - "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) + (substitute-command-keys + "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) (defun org-mark-ring-goto (&optional n) "Jump to the previous position in the mark ring. @@ -10110,18 +10389,24 @@ onto the ring." ;;; Following specific links (defun org-follow-timestamp-link () + "Open an agenda view for the time-stamp date/range at point." (cond ((org-at-date-range-p t) (let ((org-agenda-start-on-weekday) (t1 (match-string 1)) - (t2 (match-string 2))) - (setq t1 (time-to-days (org-time-string-to-time t1)) - t2 (time-to-days (org-time-string-to-time t2))) - (org-agenda-list nil t1 (1+ (- t2 t1))))) + (t2 (match-string 2)) tt1 tt2) + (setq tt1 (time-to-days (org-time-string-to-time t1)) + tt2 (time-to-days (org-time-string-to-time t2))) + (let ((org-agenda-buffer-tmp-name + (format "*Org Agenda(a:%s)" + (concat (substring t1 0 10) "--" (substring t2 0 10))))) + (org-agenda-list nil tt1 (1+ (- tt2 tt1)))))) ((org-at-timestamp-p t) - (org-agenda-list nil (time-to-days (org-time-string-to-time - (substring (match-string 1) 0 10))) - 1)) + (let ((org-agenda-buffer-tmp-name + (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10)))) + (org-agenda-list nil (time-to-days (org-time-string-to-time + (substring (match-string 1) 0 10))) + 1))) (t (error "This should not happen")))) @@ -10170,9 +10455,9 @@ If the file does not exist, an error is thrown." (dfile (downcase file)) ;; reconstruct the original file: link from the PATH, LINE and SEARCH args (link (cond ((and (eq line nil) - (eq search nil)) - file) - (line + (eq search nil)) + file) + (line (concat file "::" (number-to-string line))) (search (concat file "::" search)))) @@ -10192,8 +10477,8 @@ If the file does not exist, an error is thrown." (t (setq cmd (or (and remp (cdr (assoc 'remote apps))) (and dirp (cdr (assoc 'directory apps))) - ; first, try matching against apps-dlink - ; if we get a match here, store the match data for later + ; first, try matching against apps-dlink + ; if we get a match here, store the match data for later (let ((match (assoc-default dlink apps-dlink 'string-match))) (if match @@ -10201,8 +10486,8 @@ If the file does not exist, an error is thrown." match) (progn (setq in-emacs (or in-emacs line search)) nil))) ; if we have no match in apps-dlink, - ; always open the file in emacs if line or search - ; is given (for backwards compatibility) + ; always open the file in emacs if line or search + ; is given (for backwards compatibility) (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) 'string-match) (cdr (assoc ext apps)) @@ -10263,7 +10548,7 @@ If the file does not exist, an error is thrown." (set-match-data link-match-data) (eval cmd)))) (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) - (and (eq major-mode 'org-mode) (eq old-mode 'org-mode) + (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode) (or (not (equal old-buffer (current-buffer))) (not (equal old-pos (point)))) (org-mark-ring-push old-pos old-buffer)))) @@ -10328,8 +10613,7 @@ on the system \"/user@host:\"." (tramp-handle-file-remote-p file)) ((and (boundp 'ange-ftp-name-format) (string-match (car ange-ftp-name-format) file)) - t) - (t nil))) + t))) ;;;; Refiling @@ -10587,7 +10871,7 @@ such as the file name." (interactive "P") (let* ((bfn (buffer-file-name (buffer-base-buffer))) (case-fold-search nil) - (path (and (eq major-mode 'org-mode) (org-get-outline-path)))) + (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))) (if current (setq path (append path (save-excursion (org-back-to-heading t) @@ -10634,7 +10918,7 @@ RFLOC can be a refile location obtained in a different way. See also `org-refile-use-outline-path' and `org-completion-use-ido'. If you are using target caching (see `org-refile-use-cache'), -You have to clear the target cache in order to find new targets. +you have to clear the target cache in order to find new targets. This can be done with a 0 prefix (`C-0 C-c C-w') or a triple prefix argument (`C-u C-u C-u C-c C-w')." @@ -10741,7 +11025,9 @@ prefix argument (`C-u C-u C-u C-c C-w')." org-log-refile) (unless (eq org-log-refile 'note) (save-excursion (org-add-log-note)))) - (and org-auto-align-tags (org-set-tags nil t)) + (and org-auto-align-tags + (let ((org-loop-over-headlines-in-active-region nil)) + (org-set-tags nil t))) (bookmark-set "org-refile-last-stored") ;; If we are refiling for capture, make sure that the ;; last-capture pointers point here @@ -10775,7 +11061,7 @@ this is used for the GOTO interface." (let ((org-refile-targets org-refile-targets) (org-refile-use-outline-path org-refile-use-outline-path) excluded-entries) - (when (and (eq major-mode 'org-mode) + (when (and (derived-mode-p 'org-mode) (not org-refile-use-cache) (not no-exclude)) (org-map-tree @@ -10842,6 +11128,7 @@ this is used for the GOTO interface." (org-refile-new-child parent-target child))) (error "Invalid target location"))))) +(declare-function org-string-nw-p "org-macs.el" (s)) (defun org-refile-check-position (refile-pointer) "Check if the refile pointer matches the readline to which it points." (let* ((file (nth 1 refile-pointer)) @@ -10916,8 +11203,7 @@ this is used for the GOTO interface." rtn)) ((eq flag 'lambda) ;; exact match? - (assoc string thetable))) - )) + (assoc string thetable))))) args))) ;;;; Dynamic blocks @@ -10925,20 +11211,20 @@ this is used for the GOTO interface." (defun org-find-dblock (name) "Find the first dynamic block with name NAME in the buffer. If not found, stay at current position and return nil." - (let (pos) + (let ((case-fold-search t) pos) (save-excursion (goto-char (point-min)) - (setq pos (and (re-search-forward (concat "^[ \t]*#\\+BEGIN:[ \t]+" name "\\>") - nil t) + (setq pos (and (re-search-forward + (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t) (match-beginning 0)))) (if pos (goto-char pos)) pos)) (defconst org-dblock-start-re - "^[ \t]*#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" + "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" "Matches the start line of a dynamic block, with parameters.") -(defconst org-dblock-end-re "^[ \t]*#\\+END\\([: \t\r\n]\\|$\\)" +(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" "Matches the end of a dynamic block.") (defun org-create-dblock (plist) @@ -11027,15 +11313,15 @@ the correct writing function." (when (and indent (> indent 0)) (setq indent (make-string indent ?\ )) (save-excursion - (org-beginning-of-dblock) - (forward-line 1) - (while (not (looking-at org-dblock-end-re)) - (insert indent) - (beginning-of-line 2)) - (when (looking-at org-dblock-end-re) - (and (looking-at "[ \t]+") - (replace-match "")) - (insert indent))))))) + (org-beginning-of-dblock) + (forward-line 1) + (while (not (looking-at org-dblock-end-re)) + (insert indent) + (beginning-of-line 2)) + (when (looking-at org-dblock-end-re) + (and (looking-at "[ \t]+") + (replace-match "")) + (insert indent))))))) (defun org-beginning-of-dblock () "Find the beginning of the dynamic block at point. @@ -11051,11 +11337,12 @@ Error if there is no such block at point." (goto-char pos) (error "Not in a dynamic block")))) +;;;###autoload (defun org-update-all-dblocks () "Update all dynamic blocks in the buffer. This function can be used in a hook." (interactive) - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (org-map-dblocks 'org-update-dblock))) @@ -11069,46 +11356,68 @@ This function can be used in a hook." "BEGIN:" "END:" "ORGTBL" "TBLFM:" "TBLNAME:" "BEGIN_EXAMPLE" "END_EXAMPLE" + "BEGIN_VERBATIM" "END_VERBATIM" "BEGIN_QUOTE" "END_QUOTE" "BEGIN_VERSE" "END_VERSE" "BEGIN_CENTER" "END_CENTER" "BEGIN_SRC" "END_SRC" "BEGIN_RESULT" "END_RESULT" + "BEGIN_lstlisting" "END_lstlisting" "NAME:" "RESULTS:" "HEADER:" "HEADERS:" - "CATEGORY:" "COLUMNS:" "PROPERTY:" + "COLUMNS:" "PROPERTY:" "CAPTION:" "LABEL:" "SETUPFILE:" "INCLUDE:" "BIND:" "MACRO:")) +(defconst org-options-keywords + '("TITLE:" "AUTHOR:" "EMAIL:" "DATE:" + "DESCRIPTION:" "KEYWORDS:" "LANGUAGE:" "OPTIONS:" + "EXPORT_SELECT_TAGS:" "EXPORT_EXCLUDE_TAGS:" + "LINK_UP:" "LINK_HOME:" "LINK:" "TODO:" + "XSLT:" "MATHJAX:" "CATEGORY:" "SEQ_TODO:" "TYP_TODO:" + "PRIORITIES:" "DRAWERS:" "STARTUP:" "TAGS:" "STYLE:" + "FILETAGS:" "ARCHIVE:" "INFOJS_OPT:")) + +(defconst org-additional-option-like-keywords-for-flyspell + (delete-dups + (split-string + (mapconcat (lambda(k) + (replace-regexp-in-string + "_\\|:" " " + (concat k " " (downcase k) " " (upcase k)))) + (append org-options-keywords org-additional-option-like-keywords) + " ") + " +" t))) + (defcustom org-structure-template-alist '( - ("s" "#+begin_src ?\n\n#+end_src" - "<src lang=\"?\">\n\n</src>") - ("e" "#+begin_example\n?\n#+end_example" - "<example>\n?\n</example>") - ("q" "#+begin_quote\n?\n#+end_quote" - "<quote>\n?\n</quote>") + ("s" "#+BEGIN_SRC ?\n\n#+END_SRC" + "<src lang=\"?\">\n\n</src>") + ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" + "<example>\n?\n</example>") + ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" + "<quote>\n?\n</quote>") ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" - "<verse>\n?\n</verse>") + "<verse>\n?\n</verse>") ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" - "<center>\n?\n</center>") + "<center>\n?\n</center>") ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX" - "<literal style=\"latex\">\n?\n</literal>") - ("L" "#+latex: " - "<literal style=\"latex\">?</literal>") - ("h" "#+begin_html\n?\n#+end_html" - "<literal style=\"html\">\n?\n</literal>") - ("H" "#+html: " - "<literal style=\"html\">?</literal>") - ("a" "#+begin_ascii\n?\n#+end_ascii") - ("A" "#+ascii: ") - ("i" "#+index: ?" - "#+index: ?") - ("I" "#+include %file ?" - "<include file=%file markup=\"?\">") + "<literal style=\"latex\">\n?\n</literal>") + ("L" "#+LaTeX: " + "<literal style=\"latex\">?</literal>") + ("h" "#+BEGIN_HTML\n?\n#+END_HTML" + "<literal style=\"html\">\n?\n</literal>") + ("H" "#+HTML: " + "<literal style=\"html\">?</literal>") + ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII") + ("A" "#+ASCII: ") + ("i" "#+INDEX: ?" + "#+INDEX: ?") + ("I" "#+INCLUDE: %file ?" + "<include file=%file markup=\"?\">") ) "Structure completion elements. This is a list of abbreviation keys and values. The value gets inserted @@ -11119,8 +11428,7 @@ of the `?` in the template. There are two templates for each key, the first uses the original Org syntax, the second uses Emacs Muse-like syntax tags. These Muse-like tags become the default when the /org-mtags.el/ module has been loaded. See also the -variable `org-mtags-prefer-muse-templates'. -This is an experimental feature, it is undecided if it is going to stay in." +variable `org-mtags-prefer-muse-templates'." :group 'org-completion :type '(repeat (string :tag "Key") @@ -11205,14 +11513,14 @@ nil or a string to be used for the todo mark." ) (defvar org-agenda-headline-snapshot-before-repeat) (defun org-current-effective-time () - "Return current time adjusted for `org-extend-today-until' variable" + "Return current time adjusted for `org-extend-today-until' variable." (let* ((ct (org-current-time)) - (dct (decode-time ct)) - (ct1 - (if (and org-use-effective-time - (< (nth 2 dct) org-extend-today-until)) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) - ct))) + (dct (decode-time ct)) + (ct1 + (if (and org-use-effective-time + (< (nth 2 dct) org-extend-today-until)) + (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) + ct))) ct1)) (defun org-todo-yesterday (&optional arg) @@ -11310,54 +11618,54 @@ For calling through lisp, arg is also interpreted in the following way: ((and (equal arg '(4)) (or (not org-use-fast-todo-selection) (not org-todo-key-trigger))) - ;; Read a state with completion - (org-icompleting-read - "State: " (mapcar (lambda(x) (list x)) - org-todo-keywords-1) - nil t)) - ((eq arg 'right) - (if this - (if tail (car tail) nil) - (car org-todo-keywords-1))) - ((eq arg 'left) - (if (equal member org-todo-keywords-1) - nil - (if this - (nth (- (length org-todo-keywords-1) - (length tail) 2) - org-todo-keywords-1) - (org-last org-todo-keywords-1)))) - ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) - (setq arg nil))) ; hack to fall back to cycling - (arg - ;; user or caller requests a specific state - (cond - ((equal arg "") nil) - ((eq arg 'none) nil) - ((eq arg 'done) (or done-word (car org-done-keywords))) - ((eq arg 'nextset) - (or (car (cdr (member head org-todo-heads))) - (car org-todo-heads))) - ((eq arg 'previousset) - (let ((org-todo-heads (reverse org-todo-heads))) - (or (car (cdr (member head org-todo-heads))) - (car org-todo-heads)))) - ((car (member arg org-todo-keywords-1))) - ((stringp arg) - (error "State `%s' not valid in this file" arg)) - ((nth (1- (prefix-numeric-value arg)) - org-todo-keywords-1)))) - ((null member) (or head (car org-todo-keywords-1))) - ((equal this final-done-word) nil) ;; -> make empty - ((null tail) nil) ;; -> first entry - ((memq interpret '(type priority)) - (if (eq this-command last-command) - (car tail) - (if (> (length tail) 0) - (or done-word (car org-done-keywords)) - nil))) - (t - (car tail)))) + ;; Read a state with completion + (org-icompleting-read + "State: " (mapcar (lambda(x) (list x)) + org-todo-keywords-1) + nil t)) + ((eq arg 'right) + (if this + (if tail (car tail) nil) + (car org-todo-keywords-1))) + ((eq arg 'left) + (if (equal member org-todo-keywords-1) + nil + (if this + (nth (- (length org-todo-keywords-1) + (length tail) 2) + org-todo-keywords-1) + (org-last org-todo-keywords-1)))) + ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) + (setq arg nil))) ; hack to fall back to cycling + (arg + ;; user or caller requests a specific state + (cond + ((equal arg "") nil) + ((eq arg 'none) nil) + ((eq arg 'done) (or done-word (car org-done-keywords))) + ((eq arg 'nextset) + (or (car (cdr (member head org-todo-heads))) + (car org-todo-heads))) + ((eq arg 'previousset) + (let ((org-todo-heads (reverse org-todo-heads))) + (or (car (cdr (member head org-todo-heads))) + (car org-todo-heads)))) + ((car (member arg org-todo-keywords-1))) + ((stringp arg) + (error "State `%s' not valid in this file" arg)) + ((nth (1- (prefix-numeric-value arg)) + org-todo-keywords-1)))) + ((null member) (or head (car org-todo-keywords-1))) + ((equal this final-done-word) nil) ;; -> make empty + ((null tail) nil) ;; -> first entry + ((memq interpret '(type priority)) + (if (eq this-command last-command) + (car tail) + (if (> (length tail) 0) + (or done-word (car org-done-keywords)) + nil))) + (t + (car tail)))) (org-state (or (run-hook-with-args-until-success 'org-todo-get-default-hook org-state org-last-state) @@ -11913,7 +12221,7 @@ This function is run automatically after each state change to a DONE state." (aa (assoc org-last-state org-todo-kwd-alist)) (interpret (nth 1 aa)) (head (nth 2 aa)) - (whata '(("d" . day) ("m" . month) ("y" . year))) + (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year))) (msg "Entry repeats: ") (org-log-done nil) (org-todo-log-states nil) @@ -11949,10 +12257,12 @@ This function is run automatically after each state change to a DONE state." (setq type (if (match-end 1) org-scheduled-string (if (match-end 3) org-deadline-string "Plain:")) ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0)))) - (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts) + (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts) (setq n (string-to-number (match-string 2 ts)) what (match-string 3 ts)) (if (equal what "w") (setq n (* n 7) what "d")) + (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))) + (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) (setq time (save-match-data (org-time-string-to-time ts))) @@ -11978,7 +12288,7 @@ This function is run automatically after each state change to a DONE state." ;; 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]+\\)\\([dwmy]\\)" ts)))) + (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)))) (org-timestamp-change n (cdr (assoc what whata))) (setq msg (concat msg type " " org-last-changed-timestamp " ")))) (setq org-log-post-message msg) @@ -11997,7 +12307,7 @@ of `org-todo-keywords-1'." (cond ((null arg) org-not-done-regexp) ((equal arg '(4)) (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): " - (mapcar 'list org-todo-keywords-1)))) + (mapcar 'list org-todo-keywords-1)))) (concat "\\(" (mapconcat 'identity (org-split-string kwd "|") "\\|") "\\)\\>"))) @@ -12025,7 +12335,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (let* ((old-date (org-entry-get nil "DEADLINE")) (repeater (and old-date (string-match - "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?" + "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" old-date) (match-string 1 old-date)))) (if remove @@ -12073,7 +12383,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (let* ((old-date (org-entry-get nil "SCHEDULED")) (repeater (and old-date (string-match - "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?" + "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" old-date) (match-string 1 old-date)))) (if remove @@ -12281,8 +12591,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (let* ((org-log-into-drawer (org-log-into-drawer)) (drawer (cond ((stringp org-log-into-drawer) org-log-into-drawer) - (org-log-into-drawer "LOGBOOK") - (t nil)))) + (org-log-into-drawer "LOGBOOK")))) (save-restriction (save-excursion (when findpos @@ -12304,9 +12613,9 @@ EXTRA is additional text that will be inserted into the notes buffer." (goto-char (1- (match-beginning 0)))))) (insert "\n:" drawer ":\n:END:") (beginning-of-line 0) - (org-indent-line-function) + (org-indent-line) (beginning-of-line 2) - (org-indent-line-function) + (org-indent-line) (end-of-line 0))) ((and org-log-state-notes-insert-after-drawers (save-excursion @@ -12386,7 +12695,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (note (cdr (assq org-log-note-purpose org-log-note-headings))) lines ind bul) (kill-buffer (current-buffer)) - (while (string-match "\\`#.*\n[ \t\n]*" txt) + (while (string-match "\\`# .*\n[ \t\n]*" txt) (setq txt (replace-match "" t t txt))) (if (string-match "\\s-+\\'" txt) (setq txt (replace-match "" t t txt))) @@ -12471,7 +12780,8 @@ POS may also be a marker." (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2) (replace-match "")))))) -(defun org-sparse-tree (&optional arg) +(defvar org-ts-type nil) +(defun org-sparse-tree (&optional arg type) "Create a sparse tree, prompt for the details. This command can create sparse trees. You first need to select the type of match used to create the tree: @@ -12481,15 +12791,27 @@ T Show entries with a specific TODO keyword. m Show entries selected by a tags/property match. p Enter a property name and its value (both with completion on existing names/values) and show entries with that property. -r Show entries matching a regular expression (`/' can be used as well) -d Show deadlines due within `org-deadline-warning-days'. +r Show entries matching a regular expression (`/' can be used as well). b Show deadlines and scheduled items before a date. -a Show deadlines and scheduled items after a date." +a Show deadlines and scheduled items after a date. +d Show deadlines due within `org-deadline-warning-days'. +D Show deadlines and scheduled items between a date range." (interactive "P") - (let (ans kwd value) - (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range") + (let (ans kwd value ts-type) + (setq type (or type org-sparse-tree-default-date-type)) + (setq org-ts-type type) + (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range\n [c]ycle through date types: %s" + (cond ((eq type 'all) "all timestamps") + ((eq type 'scheduled) "only scheduled") + ((eq type 'deadline) "only deadline") + ((eq type 'active) "only active timestamps") + ((eq type 'inactive) "only inactive timestamps") + ((eq type 'scheduled-or-deadline) "scheduled/deadline") + (t "scheduled/deadline"))) (setq ans (read-char-exclusive)) (cond + ((equal ans ?c) + (org-sparse-tree arg (cadr (member type '(scheduled-or-deadline all scheduled deadline active inactive))))) ((equal ans ?d) (call-interactively 'org-check-deadlines)) ((equal ans ?b) @@ -12506,9 +12828,9 @@ a Show deadlines and scheduled items after a date." (call-interactively 'org-match-sparse-tree)) ((member ans '(?p ?P)) (setq kwd (org-icompleting-read "Property: " - (mapcar 'list (org-buffer-property-keys)))) + (mapcar 'list (org-buffer-property-keys)))) (setq value (org-icompleting-read "Value: " - (mapcar 'list (org-property-values kwd)))) + (mapcar 'list (org-property-values kwd)))) (unless (string-match "\\`{.*}\\'" value) (setq value (concat "\"" value "\""))) (org-match-sparse-tree arg (concat kwd "=" value))) @@ -12693,10 +13015,12 @@ from the `before-change-functions' in the current buffer." (interactive) (org-priority 'down)) -(defun org-priority (&optional action) - "Change the priority of an item by ARG. +(defun org-priority (&optional action show) + "Change the priority of an item. ACTION can be `set', `up', `down', or a character." - (interactive) + (interactive "P") + (if (equal action '(4)) + (org-show-priority) (unless org-enable-priority-commands (error "Priority commands are disabled")) (setq action (or action 'set)) @@ -12773,7 +13097,21 @@ ACTION can be `set', `up', `down', or a character." (org-preserve-lc (org-set-tags nil 'align))) (if remove (message "Priority removed") - (message "Priority of current item set to %s" news)))) + (message "Priority of current item set to %s" news))))) + +(defun org-show-priority () + "Show the priority of the current item. +This priority is composed of the main priority given with the [#A] cookies, +and by additional input from the age of a schedules or deadline entry." + (interactive) + (let ((pri (if (eq major-mode 'org-agenda-mode) + (org-get-at-bol 'priority) + (save-excursion + (save-match-data + (beginning-of-line) + (and (looking-at org-heading-regexp) + (org-get-priority (match-string 0)))))))) + (message "Priority is %d" (if pri pri -1000)))) (defun org-get-priority (s) "Find priority cookie and return priority." @@ -12896,7 +13234,8 @@ headlines matching this string." ;; eval matcher only when the todo condition is OK (and (or (not todo-only) (member todo org-not-done-keywords)) - (let ((case-fold-search t)) (eval matcher))) + (let ((case-fold-search t) (org-trust-scanner-tags t)) + (eval matcher))) ;; Call the skipper, but return t if it does not skip, ;; so that the `and' form continues evaluating @@ -12935,8 +13274,7 @@ headlines matching this string." (make-string (1- level) ?.) "") (org-get-heading)) category - tags-list - ) + tags-list) priority (org-get-priority txt)) (goto-char lspos) (setq marker (org-agenda-new-marker)) @@ -12993,7 +13331,7 @@ MATCH can contain positive and negative selection of tags, like If optional argument TODO-ONLY is non-nil, only select lines that are also TODO lines." (interactive "P") - (org-prepare-agenda-buffers (list (current-buffer))) + (org-agenda-prepare-buffers (list (current-buffer))) (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) (defalias 'org-tags-sparse-tree 'org-match-sparse-tree) @@ -13014,7 +13352,7 @@ also TODO lines." (defun org-global-tags-completion-table (&optional files) "Return the list of all tags in all agenda buffer/files. -Optional FILES argument is a list of files to which can be used +Optional FILES argument is a list of files which can be used instead of the agenda files." (save-excursion (org-uniquify @@ -13034,19 +13372,18 @@ instead of the agenda files." (defun org-make-tags-matcher (match) "Create the TAGS/TODO matcher form for the selection string MATCH. -The variable `todo-only' is scoped dynamically into this function; it will be -set to t if the matcher restricts matching to TODO entries, +The variable `todo-only' is scoped dynamically into this function. +It will be set to t if the matcher restricts matching to TODO entries, otherwise will not be touched. Returns a cons of the selection string MATCH and the constructed -lisp form implementing the matcher. The matcher is to be -evaluated at an Org entry, with point on the headline, -and returns t if the entry matches the -selection string MATCH. The returned lisp form references -two variables with information about the entry, which must be -bound around the form's evaluation: todo, the TODO keyword at the -entry (or nil of none); and tags-list, the list of all tags at the -entry including inherited ones. Additionally, the category +lisp form implementing the matcher. The matcher is to be evaluated +at an Org entry, with point on the headline, and returns t if the +entry matches the selection string MATCH. The returned lisp form +references two variables with information about the entry, which +must be bound around the form's evaluation: todo, the TODO keyword +at the entry (or nil of none); and tags-list, the list of all tags +at the entry including inherited ones. Additionally, the category of the entry (if any) must be specified as the text property 'org-category on the headline. @@ -13226,7 +13563,7 @@ epoch to the beginning of today (00:00)." ((string= s "<today>") (org-time-today)) ((string= s "<tomorrow>") (+ 86400.0 (org-time-today))) ((string= s "<yesterday>") (- (org-time-today) 86400.0)) - ((string-match "^<\\([-+][0-9]+\\)\\([dwmy]\\)>$" s) + ((string-match "^<\\([-+][0-9]+\\)\\([hdwmy]\\)>$" s) (+ (org-time-today) (* (string-to-number (match-string 1 s)) (cdr (assoc (match-string 2 s) @@ -13357,7 +13694,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (defun org-set-tags-command (&optional arg just-align) "Call the set-tags command for the current entry." (interactive "P") - (if (org-at-heading-p) + (if (or (org-at-heading-p) (and arg (org-before-first-heading-p))) (org-set-tags arg just-align) (save-excursion (org-back-to-heading t) @@ -13376,8 +13713,7 @@ If DATA is nil or the empty string, any tags will be removed." (concat ":" (mapconcat 'identity (org-split-string data ":+") ":") ":")) ((listp data) - (concat ":" (mapconcat 'identity data ":") ":")) - (t nil))) + (concat ":" (mapconcat 'identity data ":") ":")))) (when data (save-excursion (org-back-to-heading t) @@ -13410,94 +13746,104 @@ If DATA is nil or the empty string, any tags will be removed." "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." (interactive "P") - (let* ((re org-outline-regexp-bol) - (current (org-get-tags-string)) - (col (current-column)) - (org-setting-tags t) - table current-tags inherited-tags ; computed below when needed - tags p0 c0 c1 rpl di tc level) - (if arg - (save-excursion - (goto-char (point-min)) - (let ((buffer-invisibility-spec (org-inhibit-invisibility))) - (while (re-search-forward re nil t) - (org-set-tags nil t) - (end-of-line 1))) - (message "All tags realigned to column %d" org-tags-column)) - (if just-align - (setq tags current) - ;; Get a new set of tags from the user - (save-excursion - (setq table (append org-tag-persistent-alist - (or org-tag-alist (org-get-buffer-tags)) - (and - org-complete-tags-always-offer-all-agenda-tags - (org-global-tags-completion-table - (org-agenda-files)))) - org-last-tags-completion-table table - current-tags (org-split-string current ":") - inherited-tags (nreverse - (nthcdr (length current-tags) - (nreverse (org-get-tags-at)))) - tags - (if (or (eq t org-use-fast-tag-selection) - (and org-use-fast-tag-selection - (delq nil (mapcar 'cdr table)))) - (org-fast-tag-selection - current-tags inherited-tags table - (if org-fast-tag-selection-include-todo - org-todo-key-alist)) - (let ((org-add-colon-after-tag-completion (< 1 (length table)))) - (org-trim - (org-icompleting-read "Tags: " - 'org-tags-completion-function - nil nil current 'org-tags-history)))))) - (while (string-match "[-+&]+" tags) - ;; No boolean logic, just a list - (setq tags (replace-match ":" t t tags)))) - - (setq tags (replace-regexp-in-string "[,]" ":" tags)) - - (if org-tags-sort-function - (setq tags (mapconcat 'identity - (sort (org-split-string - tags (org-re "[^[:alnum:]_@#%]+")) - org-tags-sort-function) ":"))) - - (if (string-match "\\`[\t ]*\\'" tags) - (setq tags "") - (unless (string-match ":$" tags) (setq tags (concat tags ":"))) - (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) - - ;; Insert new tags at the correct column - (beginning-of-line 1) - (setq level (or (and (looking-at org-outline-regexp) - (- (match-end 0) (point) 1)) - 1)) - (cond - ((and (equal current "") (equal tags ""))) - ((re-search-forward - (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") - (point-at-eol) t) - (if (equal tags "") - (setq rpl "") - (goto-char (match-beginning 0)) - (setq c0 (current-column) - ;; compute offset for the case of org-indent-mode active - di (if org-indent-mode - (* (1- org-indent-indentation-per-level) (1- level)) - 0) - p0 (if (equal (char-before) ?*) (1+ (point)) (point)) - tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) - c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags)))) - rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) - (replace-match rpl t t) - (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) - tags) - (t (error "Tags alignment failed"))) - (org-move-to-column col) - (unless just-align - (run-hooks 'org-after-tags-change-hook))))) + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + ;; We don't use ARG and JUST-ALIGN here these args are not + ;; useful when looping over headlines + `(org-set-tags) + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (let* ((re org-outline-regexp-bol) + (current (unless arg (org-get-tags-string))) + (col (current-column)) + (org-setting-tags t) + table current-tags inherited-tags ; computed below when needed + tags p0 c0 c1 rpl di tc level) + (if arg + (save-excursion + (goto-char (point-min)) + (let ((buffer-invisibility-spec (org-inhibit-invisibility))) + (while (re-search-forward re nil t) + (org-set-tags nil t) + (end-of-line 1))) + (message "All tags realigned to column %d" org-tags-column)) + (if just-align + (setq tags current) + ;; Get a new set of tags from the user + (save-excursion + (setq table (append org-tag-persistent-alist + (or org-tag-alist (org-get-buffer-tags)) + (and + org-complete-tags-always-offer-all-agenda-tags + (org-global-tags-completion-table + (org-agenda-files)))) + org-last-tags-completion-table table + current-tags (org-split-string current ":") + inherited-tags (nreverse + (nthcdr (length current-tags) + (nreverse (org-get-tags-at)))) + tags + (if (or (eq t org-use-fast-tag-selection) + (and org-use-fast-tag-selection + (delq nil (mapcar 'cdr table)))) + (org-fast-tag-selection + current-tags inherited-tags table + (if org-fast-tag-selection-include-todo + org-todo-key-alist)) + (let ((org-add-colon-after-tag-completion (< 1 (length table)))) + (org-trim + (org-icompleting-read "Tags: " + 'org-tags-completion-function + nil nil current 'org-tags-history)))))) + (while (string-match "[-+&]+" tags) + ;; No boolean logic, just a list + (setq tags (replace-match ":" t t tags)))) + + (setq tags (replace-regexp-in-string "[,]" ":" tags)) + + (if org-tags-sort-function + (setq tags (mapconcat 'identity + (sort (org-split-string + tags (org-re "[^[:alnum:]_@#%]+")) + org-tags-sort-function) ":"))) + + (if (string-match "\\`[\t ]*\\'" tags) + (setq tags "") + (unless (string-match ":$" tags) (setq tags (concat tags ":"))) + (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) + + ;; Insert new tags at the correct column + (beginning-of-line 1) + (setq level (or (and (looking-at org-outline-regexp) + (- (match-end 0) (point) 1)) + 1)) + (cond + ((and (equal current "") (equal tags ""))) + ((re-search-forward + (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") + (point-at-eol) t) + (if (equal tags "") + (setq rpl "") + (goto-char (match-beginning 0)) + (setq c0 (current-column) + ;; compute offset for the case of org-indent-mode active + di (if org-indent-mode + (* (1- org-indent-indentation-per-level) (1- level)) + 0) + p0 (if (equal (char-before) ?*) (1+ (point)) (point)) + tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) + c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags)))) + rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) + (replace-match rpl t t) + (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) + tags) + (t (error "Tags alignment failed"))) + (org-move-to-column col) + (unless just-align + (run-hooks 'org-after-tags-change-hook)))))) (defun org-change-tag-in-region (beg end tag off) "Add or remove TAG for each entry in the region. @@ -13505,7 +13851,7 @@ This works in the agenda, and also in an org-mode buffer." (interactive (list (region-beginning) (region-end) (let ((org-last-tags-completion-table - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (org-get-buffer-tags) (org-global-tags-completion-table)))) (org-icompleting-read @@ -13524,7 +13870,7 @@ This works in the agenda, and also in an org-mode buffer." (loop for l from l1 to l2 do (org-goto-line l) (setq m (get-text-property (point) 'org-hd-marker)) - (when (or (and (eq major-mode 'org-mode) (org-at-heading-p)) + (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p)) (and agendap m)) (setq buf (if agendap (marker-buffer m) (current-buffer)) pos (if agendap m (point))) @@ -13683,8 +14029,7 @@ Returns the new tags string, or nil to not change the current settings." ((not (assoc tg table)) (org-get-todo-face tg)) ((member tg current) c-face) - ((member tg inherited) i-face) - (t nil)))) + ((member tg inherited) i-face)))) (if (and (= cnt 0) (not ingroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 (length tg)) ?\ )) @@ -13919,7 +14264,7 @@ a *different* entry, you cannot use these techniques." (if (not scope) (progn - (org-prepare-agenda-buffers + (org-agenda-prepare-buffers (list (buffer-file-name (current-buffer)))) (setq res (org-scan-tags func matcher todo-only start-level))) ;; Get the right scope @@ -13935,7 +14280,7 @@ a *different* entry, you cannot use these techniques." (setq scope (list (buffer-file-name)))) ((eq scope 'file-with-archives) (setq scope (org-add-archive-files (list (buffer-file-name)))))) - (org-prepare-agenda-buffers scope) + (org-agenda-prepare-buffers scope) (while (setq file (pop scope)) (with-current-buffer (org-find-base-buffer-visiting file) (save-excursion @@ -13951,7 +14296,7 @@ a *different* entry, you cannot use these techniques." (defconst org-special-properties '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY" - "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM") + "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM" "CLOCKSUM_T") "The special properties valid in Org-mode. These are properties that are not defined in the property drawer, @@ -13991,10 +14336,15 @@ Being in this list makes sure that they are offered for completion.") "Matches an entire clock drawer.") (defsubst org-re-property (property) - "Return a regexp matching PROPERTY. -Match group 1 will be set to the value " + "Return a regexp matching a PROPERTY line. +Match group 1 will be set to the value." (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)")) +(defsubst org-re-property-keyword (property) + "Return a regexp matching a PROPERTY line, possibly with no +value for the property." + (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)?")) + (defun org-property-action () "Do an action on properties." (interactive) @@ -14013,10 +14363,17 @@ Match group 1 will be set to the value " (call-interactively 'org-compute-property-at-point)) (t (error "No such property action %c" c))))) -(defun org-set-effort (&optional value) +(defun org-inc-effort () + "Increment the value of the effort property in the current entry." + (interactive) + (org-set-effort nil t)) + +(defun org-set-effort (&optional value increment) "Set the effort property of the current entry. -With numerical prefix arg, use the nth allowed value, 0 stands for the 10th -allowed value." +With numerical prefix arg, use the nth allowed value, 0 stands for the +10th allowed value. + +When INCREMENT is non-nil, set the property to the next allowed value." (interactive "P") (if (equal value 0) (setq value 10)) (let* ((completion-ignore-case t) @@ -14030,6 +14387,9 @@ allowed value." ((and allowed (integerp value)) (or (car (nth (1- value) allowed)) (car (org-last allowed)))) + ((and allowed increment) + (or (caadr (member (list cur) allowed)) + (error "Allowed effort values are not set"))) (allowed (message "Select 1-9,0, [RET%s]: %s" (if cur (concat "=" cur) "") @@ -14046,7 +14406,7 @@ allowed value." (let (org-completion-use-ido org-completion-use-iswitchb) (org-completing-read (concat "Effort " (if (and cur (string-match "\\S-" cur)) - (concat "[" cur "]") "") + (concat "[" cur "]") "") ": ") existing nil nil "" nil cur)))))) (unless (equal (org-entry-get nil prop) val) @@ -14066,13 +14426,16 @@ allowed value." (defun org-get-property-block (&optional beg end force) "Return the (beg . end) range of the body of the property drawer. -BEG and END can be beginning and end of subtree, if not given -they will be found. -If the drawer does not exist and FORCE is non-nil, create the drawer." +BEG and END are the beginning and end of the current subtree, or of +the part before the first headline. If they are not given, they will +be found. If the drawer does not exist and FORCE is non-nil, create +the drawer." (catch 'exit (save-excursion - (let* ((beg (or beg (progn (org-back-to-heading t) (point)))) - (end (or end (progn (outline-next-heading) (point))))) + (let* ((beg (or beg (and (org-before-first-heading-p) (point-min)) + (progn (org-back-to-heading t) (point)))) + (end (or end (and (not (outline-next-heading)) (point-max)) + (point)))) (goto-char beg) (if (re-search-forward org-property-start-re end t) (setq beg (1+ (match-end 0))) @@ -14089,7 +14452,7 @@ If the drawer does not exist and FORCE is non-nil, create the drawer." (or force (throw 'exit nil)) (goto-char beg) (setq end beg) - (org-indent-line-function) + (org-indent-line) (insert ":END:\n")) (cons beg end))))) @@ -14110,14 +14473,15 @@ things up because then unnecessary parsing is avoided." (let ((clockstr (substring org-clock-string 0 -1)) (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) (case-fold-search nil) - beg end range props sum-props key key1 value string clocksum) + beg end range props sum-props key key1 value string clocksum clocksumt) (save-excursion (when (condition-case nil - (and (eq major-mode 'org-mode) (org-back-to-heading t)) + (and (derived-mode-p 'org-mode) (org-back-to-heading t)) (error nil)) (setq beg (point)) (setq sum-props (get-text-property (point) 'org-summaries)) - (setq clocksum (get-text-property (point) :org-clock-minutes)) + (setq clocksum (get-text-property (point) :org-clock-minutes) + clocksumt (get-text-property (point) :org-clock-minutes-today)) (outline-next-heading) (setq end (point)) (when (memq which '(all special)) @@ -14152,11 +14516,10 @@ things up because then unnecessary parsing is avoided." (substring (org-match-string-no-properties 1) 0 -1)) string (if (equal key clockstr) - (org-no-properties - (org-trim - (buffer-substring - (match-beginning 3) (goto-char - (point-at-eol))))) + (org-trim + (buffer-substring-no-properties + (match-beginning 3) (goto-char + (point-at-eol)))) (substring (org-match-string-no-properties 3) 1 -1))) ;; Get the correct property name from the key. This is @@ -14177,8 +14540,7 @@ things up because then unnecessary parsing is avoided." ;; no need to search further if match is found (throw 'match t)) (when (or (equal key "CLOCK") (not (assoc key props))) - (push (cons key string) props)))))) - ) + (push (cons key string) props))))))) (when (memq which '(all standard)) ;; Get the standard properties, like :PROP: ... @@ -14195,14 +14557,19 @@ things up because then unnecessary parsing is avoided." (if clocksum (push (cons "CLOCKSUM" (org-columns-number-to-string (/ (float clocksum) 60.) - 'add_times)) + 'add_times)) + props)) + (if clocksumt + (push (cons "CLOCKSUM_T" + (org-columns-number-to-string (/ (float clocksumt) 60.) + 'add_times)) props)) (unless (assoc "CATEGORY" props) (push (cons "CATEGORY" (org-get-category)) props)) (append sum-props (nreverse props))))))) (defun org-entry-get (pom property &optional inherit literal-nil) - "Get value of PROPERTY for entry at point-or-marker POM. + "Get value of PROPERTY for entry or content at point-or-marker POM. If INHERIT is non-nil and the entry does not have the property, then also check higher levels of the hierarchy. If INHERIT is the symbol `selective', use inheritance only if the setting @@ -14222,13 +14589,11 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy." ;; We need a special property. Use `org-entry-properties' to ;; retrieve it, but specify the wanted property (cdr (assoc property (org-entry-properties nil 'special property))) - (let ((range (unless (org-before-first-heading-p) - (org-get-property-block))) - (props (list (or (assoc property org-file-properties) - (assoc property org-global-properties) - (assoc property org-global-properties-fixed)))) - val) - (flet ((ap (key) + (let* ((range (org-get-property-block)) + (props (list (or (assoc property org-file-properties) + (assoc property org-global-properties) + (assoc property org-global-properties-fixed)))) + (ap (lambda (key) (when (re-search-forward (org-re-property key) (cdr range) t) (setq props @@ -14237,12 +14602,13 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy." (if (match-end 1) (org-match-string-no-properties 1) "") props))))) - (when (and range (goto-char (car range))) - (ap property) - (goto-char (car range)) - (while (ap (concat property "+"))) - (setq val (cdr (assoc property props))) - (when val (if literal-nil val (org-not-nil val)))))))))) + val) + (when (and range (goto-char (car range))) + (funcall ap property) + (goto-char (car range)) + (while (funcall ap (concat property "+"))) + (setq val (cdr (assoc property props))) + (when val (if literal-nil val (org-not-nil val))))))))) (defun org-property-or-variable-value (var &optional inherit) "Check if there is a property fixing the value of VAR. @@ -14337,24 +14703,25 @@ Note that also `org-entry-get' calls this function, if the INHERIT flag is set.") (defun org-entry-get-with-inheritance (property &optional literal-nil) - "Get entry property, and search higher levels if not present. + "Get PROPERTY of entry or content at point, search higher levels if needed. The search will stop at the first ancestor which has the property defined. If the value found is \"nil\", return nil to show that the property should be considered as undefined (this is the meaning of nil here). However, if LITERAL-NIL is set, return the string value \"nil\" instead." (move-marker org-entry-property-inherited-from nil) (let (tmp) - (unless (org-before-first-heading-p) - (save-excursion - (save-restriction - (widen) - (catch 'ex - (while t - (when (setq tmp (org-entry-get nil property nil 'literal-nil)) - (org-back-to-heading t) - (move-marker org-entry-property-inherited-from (point)) - (throw 'ex tmp)) - (or (org-up-heading-safe) (throw 'ex nil))))))) + (save-excursion + (save-restriction + (widen) + (catch 'ex + (while t + (when (setq tmp (org-entry-get nil property nil 'literal-nil)) + (or (ignore-errors (org-back-to-heading t)) + (goto-char (point-min))) + (move-marker org-entry-property-inherited-from (point)) + (throw 'ex tmp)) + (or (ignore-errors (org-up-heading-safe)) + (throw 'ex nil)))))) (setq tmp (or tmp (cdr (assoc property org-file-properties)) (cdr (assoc property org-global-properties)) @@ -14384,7 +14751,7 @@ and the new value.") (org-set-tags nil 'align)) ((equal property "PRIORITY") (org-priority (if (and value (stringp value) (string-match "\\S-" value)) - (string-to-char value) ?\ )) + (string-to-char value) ?\ )) (org-set-tags nil 'align)) ((equal property "SCHEDULED") (if (re-search-forward org-scheduled-time-regexp end t) @@ -14408,17 +14775,17 @@ and the new value.") (setq range (org-get-property-block beg end 'force)) (goto-char (car range)) (if (re-search-forward - (org-re-property property) (cdr range) t) + (org-re-property-keyword property) (cdr range) t) (progn (delete-region (match-beginning 0) (match-end 0)) (goto-char (match-beginning 0))) (goto-char (cdr range)) (insert "\n") (backward-char 1) - (org-indent-line-function)) + (org-indent-line)) (insert ":" property ":") (and value (insert " " value)) - (org-indent-line-function))))) + (org-indent-line))))) (run-hook-with-args 'org-property-changed-functions property value))) (defun org-buffer-property-keys (&optional include-specials include-defaults include-columns) @@ -14484,11 +14851,10 @@ formats in the current buffer." (defun org-insert-property-drawer () "Insert a property drawer into the current entry." - (interactive) (org-back-to-heading t) (looking-at org-outline-regexp) (let ((indent (if org-adapt-indentation - (- (match-end 0)(match-beginning 0)) + (- (match-end 0) (match-beginning 0)) 0)) (beg (point)) (re (concat "^[ \t]*" org-keyword-time-regexp)) @@ -14522,6 +14888,71 @@ formats in the current buffer." (hide-entry)) (org-flag-drawer t)))) +(defun org-insert-drawer (&optional arg drawer) + "Insert a drawer at point. + +Optional argument DRAWER, when non-nil, is a string representing +drawer's name. Otherwise, the user is prompted for a name. + +If a region is active, insert the drawer around that region +instead. + +Point is left between drawer's boundaries." + (interactive "P") + (let* ((logbook (if (stringp org-log-into-drawer) org-log-into-drawer + "LOGBOOK")) + ;; SYSTEM-DRAWERS is a list of drawer names that are used + ;; internally by Org. They are meant to be inserted + ;; automatically. + (system-drawers `("CLOCK" ,logbook "PROPERTIES")) + ;; Remove system drawers from list. Note: For some reason, + ;; `org-completing-read' ignores the predicate while + ;; `completing-read' handles it fine. + (drawer (if arg "PROPERTIES" + (or drawer + (completing-read + "Drawer: " org-drawers + (lambda (d) (not (member d system-drawers)))))))) + (cond + ;; With C-u, fall back on `org-insert-property-drawer' + (arg (org-insert-property-drawer)) + ;; With an active region, insert a drawer at point. + ((not (org-region-active-p)) + (progn + (unless (bolp) (insert "\n")) + (insert (format ":%s:\n\n:END:\n" drawer)) + (forward-line -2))) + ;; Otherwise, insert the drawer at point + (t + (let ((rbeg (region-beginning)) + (rend (copy-marker (region-end)))) + (unwind-protect + (progn + (goto-char rbeg) + (beginning-of-line) + (when (save-excursion + (re-search-forward org-outline-regexp-bol rend t)) + (error "Drawers cannot contain headlines")) + ;; Position point at the beginning of the first + ;; non-blank line in region. Insert drawer's opening + ;; there, then indent it. + (org-skip-whitespace) + (beginning-of-line) + (insert ":" drawer ":\n") + (forward-line -1) + (indent-for-tab-command) + ;; Move point to the beginning of the first blank line + ;; after the last non-blank line in region. Insert + ;; drawer's closing, then indent it. + (goto-char rend) + (skip-chars-backward " \r\t\n") + (insert "\n:END:") + (deactivate-mark t) + (indent-for-tab-command) + (unless (eolp) (insert "\n"))) + ;; Clear marker, whatever the outcome of insertion is. + (set-marker rend nil))))))) + (defvar org-property-set-functions-alist nil "Property set function alist. Each entry should have the following format: @@ -14595,10 +15026,10 @@ in the current file." (interactive (list nil nil)) (let* ((property (or property (org-read-property-name))) (value (or value (org-read-property-value property))) - (fn (assoc property org-properties-postprocess-alist))) + (fn (cdr (assoc property org-properties-postprocess-alist)))) (setq org-last-set-property property) ;; Possibly postprocess the inserted value: - (when fn (setq value (funcall (cadr fn) value))) + (when fn (setq value (funcall fn value))) (unless (equal (org-entry-get nil property) value) (org-entry-put nil property value)))) @@ -14716,7 +15147,7 @@ completion." (error "Only one allowed value for this property")) (org-at-property-p) (replace-match (concat " :" key ": " nval) t t) - (org-indent-line-function) + (org-indent-line) (beginning-of-line 1) (skip-chars-forward " \t") (run-hook-with-args 'org-property-changed-functions key nval))) @@ -14835,13 +15266,20 @@ Return the position where this entry starts, or nil if there is no such entry." (defun org-time-stamp (arg &optional inactive) "Prompt for a date/time and insert a time stamp. -If the user specifies a time like HH:MM, or if this command is called -with a prefix argument, the time stamp will contain date and time. -Otherwise, only the date will be included. All parts of a date not -specified by the user will be filled in from the current date/time. -So if you press just return without typing anything, the time stamp -will represent the current date/time. If there is already a timestamp -at the cursor, it will be modified." +If the user specifies a time like HH:MM or if this command is +called with at least one prefix argument, the time stamp contains +the date and the time. Otherwise, only the date is be included. + +All parts of a date not specified by the user is filled in from +the current date/time. So if you just press return without +typing anything, the time stamp will represent the current +date/time. + +If there is already a timestamp at the cursor, it will be +modified. + +With two universal prefix arguments, insert an active timestamp +with the current time without prompting the user." (interactive "P") (let* ((ts nil) (default-time @@ -14859,7 +15297,7 @@ at the cursor, it will be modified." (save-match-data (beginning-of-line) (when (re-search-forward - "\\([.+-]+[0-9]+[dwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?" + "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" (save-excursion (progn (end-of-line) (point))) t) (match-string 0))))) org-time-was-given org-end-time-was-given time) @@ -14869,14 +15307,14 @@ at the cursor, it will be modified." (memq this-command '(org-time-stamp org-time-stamp-inactive))) (insert "--") (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil - default-time default-input))) + (org-read-date arg 'totime nil nil + default-time default-input inactive))) (org-insert-time-stamp time (or org-time-was-given arg) inactive)) ((org-at-timestamp-p t) (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time default-input))) + (org-read-date arg 'totime nil nil default-time default-input inactive))) (when (org-at-timestamp-p t) ; just to get the match data -; (setq inactive (eq (char-after (match-beginning 0)) ?\[)) + ; (setq inactive (eq (char-after (match-beginning 0)) ?\[)) (replace-match "") (setq org-last-changed-timestamp (org-insert-time-stamp @@ -14887,9 +15325,11 @@ at the cursor, it will be modified." (concat (substring org-last-inserted-timestamp 0 -1) " " repeater ">")))) (message "Timestamp updated")) + ((equal arg '(16)) + (org-insert-time-stamp (current-time) t)) (t (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time default-input))) + (org-read-date arg 'totime nil nil default-time default-input inactive))) (org-insert-time-stamp time (or org-time-was-given arg) inactive nil nil (list org-end-time-was-given)))))) @@ -14935,9 +15375,10 @@ So these are more for recording a certain time/date." (defvar org-read-date-final-answer nil) (defvar org-read-date-analyze-futurep nil) (defvar org-read-date-analyze-forced-year nil) +(defvar org-read-date-inactive) (defun org-read-date (&optional org-with-time to-time from-string prompt - default-time default-input) + default-time default-input inactive) "Read a date, possibly a time, and make things smooth for the user. The prompt will suggest to enter an ISO date, but you can also enter anything which will at least partially be understood by `parse-time-string'. @@ -14960,7 +15401,7 @@ mean next year. For details, see the manual. A few examples: etc. Furthermore you can specify a relative date by giving, as the *first* thing -in the input: a plus/minus sign, a number and a letter [dwmy] to indicate +in the input: a plus/minus sign, a number and a letter [hdwmy] to indicate change in days weeks, months, years. With a single plus or minus, the date is relative to today. With a double plus or minus, it is relative to the date in DEFAULT-TIME. E.g. @@ -14979,11 +15420,11 @@ If you don't like the calendar, turn it off with With optional argument TO-TIME, the date will immediately be converted to an internal time. -With an optional argument WITH-TIME, the prompt will suggest to also -insert a time. Note that when WITH-TIME is not set, you can still -enter a time, and this function will inform the calling routine about -this change. The calling routine may then choose to change the format -used to insert the time stamp into the buffer to include the time. +With an optional argument ORG-WITH-TIME, the prompt will suggest to +also insert a time. Note that when ORG-WITH-TIME is not set, you can +still enter a time, and this function will inform the calling routine +about this change. The calling routine may then choose to change the +format used to insert the time stamp into the buffer to include the time. With optional argument FROM-STRING, read from this string instead from the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is the time/date that is used for everything that is not specified by the @@ -15018,6 +15459,7 @@ user." (save-excursion (save-window-excursion (calendar) + (org-eval-in-calendar '(setq cursor-type nil) t) (unwind-protect (progn (calendar-forward-day (- (time-to-days org-def) @@ -15084,6 +15526,7 @@ user." (unwind-protect (progn (use-local-map map) + (setq org-read-date-inactive inactive) (add-hook 'post-command-hook 'org-read-date-display) (setq org-ans0 (read-string prompt default-input 'org-read-date-history nil)) @@ -15154,7 +15597,9 @@ user." (and (boundp 'org-time-was-given) org-time-was-given)) (cdr fmts) (car fmts))) - (txt (concat "=> " (format-time-string fmt (apply 'encode-time f))))) + (txt (format-time-string fmt (apply 'encode-time f))) + (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt)) + (txt (concat "=> " txt))) (when (and org-end-time-was-given (string-match org-plain-time-of-day-regexp txt)) (setq txt (concat (substring txt 0 (match-end 0)) "-" @@ -15182,11 +15627,11 @@ user." (setq ans (replace-match "" t t ans) deltan (car delta) deltaw (nth 1 delta) - deltadef (nth 2 delta))) + deltadef (nth 2 delta))) - ;; Check if there is an iso week date in there - ;; If yes, store the info and postpone interpreting it until the rest - ;; of the parsing is done + ;; Check if there is an iso week date in there. If yes, store the + ;; info and postpone interpreting it until the rest of the parsing + ;; is done. (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) (setq iso-year (if (match-end 1) (org-small-year-to-year @@ -15219,7 +15664,7 @@ user." day (string-to-number (match-string 1 ans)) month (string-to-number (match-string 2 ans)) ans (replace-match (format "%04d-%02d-%02d\\5" year month day) - t nil ans))) + t nil ans))) ;; Help matching american dates, like 5/30 or 5/30/7 (when (string-match @@ -15313,15 +15758,15 @@ user." iso-date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list iso-week day year)))) -; FIXME: Should we also push ISO weeks into the future? -; (when (and org-read-date-prefer-future -; (not iso-year) -; (< (calendar-absolute-from-gregorian iso-date) -; (time-to-days (current-time)))) -; (setq year (1+ year) -; iso-date (calendar-gregorian-from-absolute -; (calendar-absolute-from-iso -; (list iso-week day year))))) + ; FIXME: Should we also push ISO weeks into the future? + ; (when (and org-read-date-prefer-future + ; (not iso-year) + ; (< (calendar-absolute-from-gregorian iso-date) + ; (time-to-days (current-time)))) + ; (setq year (1+ year) + ; iso-date (calendar-gregorian-from-absolute + ; (calendar-absolute-from-iso + ; (list iso-week day year))))) (setq month (car iso-date) year (nth 2 iso-date) day (nth 1 iso-date))) @@ -15335,7 +15780,6 @@ user." ((equal deltaw "m") (setq month (+ month deltan))) ((equal deltaw "y") (setq year (+ year deltan))))) ((and wday (not (nth 3 tl))) - (setq futurep nil) ;; Weekday was given, but no day, so pick that day in the week ;; on or after the derived date. (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) @@ -15375,7 +15819,7 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to (concat "\\`[ \t]*\\([-+]\\{0,2\\}\\)" "\\([0-9]+\\)?" - "\\([dwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" + "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" "\\([ \t]\\|$\\)") s) (or (> (match-end 1) (match-beginning 1)) (match-end 4))) (let* ((dir (if (> (match-end 1) (match-beginning 1)) @@ -15409,14 +15853,15 @@ user function argument order change dependent on argument order." (list arg2 arg1 arg3)) ((eq calendar-date-style 'iso) (list arg2 arg3 arg1))) - (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1 - (if (org-bound-and-true-p european-calendar-style) - (list arg2 arg1 arg3) - (list arg1 arg2 arg3))))) + (org-no-warnings ;; european-calendar-style is obsolete as of version 23.1 + (if (org-bound-and-true-p european-calendar-style) + (list arg2 arg1 arg3) + (list arg1 arg2 arg3))))) (defun org-eval-in-calendar (form &optional keepdate) "Eval FORM in the calendar window and return to current window. -Also, store the cursor date in variable org-ans2." +When KEEPDATE is non-nil, update `org-ans2' from the cursor date, +otherwise stick to the current value of `org-ans2'." (let ((sf (selected-frame)) (sw (selected-window))) (select-window (get-buffer-window "*Calendar*" t)) @@ -15492,7 +15937,7 @@ The command returns the inserted time stamp." t1 w1 with-hm tf time str w2 (off 0)) (save-match-data (setq t1 (org-parse-time-string ts t)) - (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)?\\'" ts) + (if (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) @@ -15563,7 +16008,7 @@ Don't touch the rest." ((<= org-deadline-warning-days 0) ;; 0 or negative, enforce this value no matter what (- org-deadline-warning-days)) - ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\| \\)" ts) + ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts) ;; lead time is specified. (floor (* (string-to-number (match-string 1 ts)) (cdr (assoc (match-string 2 ts) @@ -15604,16 +16049,34 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s (org-occur regexp nil callback) org-warn-days))) +(defsubst org-re-timestamp (type) + "Return a regexp for timestamp TYPE. +Allowed values for TYPE are: + + all: all timestamps + active: only active timestamps (<...>) + inactive: only inactive timestamps ([...]) + scheduled: only scheduled timestamps + deadline: only deadline timestamps + +When TYPE is nil, fall back on returning a regexp that matches +both scheduled and deadline timestamps." + (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9>
\n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)") + ((eq type 'active) org-ts-regexp) + ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^
\n>]*?\\)\\]") + ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) + ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) + ((eq type 'scheduled-or-deadline) + (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>")))) + (defun org-check-before-date (date) "Check if there are deadlines or scheduled entries before DATE." (interactive (list (org-read-date))) (let ((case-fold-search nil) - (regexp (concat "\\<\\(" org-deadline-string - "\\|" org-scheduled-string - "\\) *<\\([^>]+\\)>")) + (regexp (org-re-timestamp org-ts-type)) (callback (lambda () (time-less-p - (org-time-string-to-time (match-string 2)) + (org-time-string-to-time (match-string 1)) (org-time-string-to-time date))))) (message "%d entries before %s" (org-occur regexp nil callback) date))) @@ -15622,13 +16085,11 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s "Check if there are deadlines or scheduled entries after DATE." (interactive (list (org-read-date))) (let ((case-fold-search nil) - (regexp (concat "\\<\\(" org-deadline-string - "\\|" org-scheduled-string - "\\) *<\\([^>]+\\)>")) + (regexp (org-re-timestamp org-ts-type)) (callback (lambda () (not (time-less-p - (org-time-string-to-time (match-string 2)) + (org-time-string-to-time (match-string 1)) (org-time-string-to-time date)))))) (message "%d entries after %s" (org-occur regexp nil callback) date))) @@ -15638,12 +16099,10 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s (interactive (list (org-read-date nil nil nil "Range starts") (org-read-date nil nil nil "Range end"))) (let ((case-fold-search nil) - (regexp (concat "\\<\\(" org-deadline-string - "\\|" org-scheduled-string - "\\) *<\\([^>]+\\)>")) + (regexp (org-re-timestamp org-ts-type)) (callback (lambda () - (let ((match (match-string 2))) + (let ((match (match-string 1))) (and (not (time-less-p (org-time-string-to-time match) @@ -15732,6 +16191,7 @@ days in order to avoid rounding problems." (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" @@ -15741,6 +16201,7 @@ days in order to avoid rounding problems." (cdr errdata))))) (defun org-time-string-to-seconds (s) + "Convert a timestamp string to a number of seconds." (org-float-time (org-time-string-to-time s))) (defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos) @@ -15754,7 +16215,7 @@ The variable date is bound by the calendar when this is called." (if (org-diary-sexp-entry (match-string 1 s) "" date) daynr (+ daynr 1000))) - ((and daynr (string-match "\\+[0-9]+[dwmy]" s)) + ((and daynr (string-match "\\+[0-9]+[hdwmy]" s)) (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr (time-to-days (current-time))) (match-string 0 s) prefer show-all)) @@ -15817,8 +16278,7 @@ D may be an absolute day number, or a calendar-type list (month day year)." (stringp (cdr result))) (cdr result)) ((and (consp result) (stringp (car result))) result) - (result entry) - (t nil)))) + (result entry)))) (defun org-diary-to-ical-string (frombuf) "Get iCalendar entries from diary entries in buffer FROMBUF. @@ -15865,7 +16325,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." (if (<= cday sday) (throw 'exit sday)) - (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change) + (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change) (setq dn (string-to-number (match-string 1 change)) dw (cdr (assoc (match-string 2 change) a1))) (error "Invalid change specifier: %s" change)) @@ -15988,22 +16448,22 @@ With prefix ARG, change that many days." (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. - ((or (= pos (1- (match-end 0))) - (= pos (match-end 0))) 'bracket) - ((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)))) + (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)) (defun org-toggle-timestamp-type () @@ -16020,6 +16480,8 @@ With prefix ARG, change that many days." (message "Timestamp is now %sactive" (if (equal (char-after beg) ?<) "" "in"))))) +(defvar org-clock-history) ; defined in org-clock.el +(defvar org-clock-adjust-closest nil) ; defined in org-clock.el (defun org-timestamp-change (n &optional what updown) "Change the date in the time stamp at point. The date will be changed by N times WHAT. WHAT can be `day', `month', @@ -16030,7 +16492,7 @@ in the timestamp determines what will be changed." (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) org-ts-what extra rem - ts time time0) + ts time time0 fixnext clrgx) (if (not (org-at-timestamp-p t)) (error "Not at a timestamp")) (if (and (not what) (eq org-ts-what 'bracket)) @@ -16049,7 +16511,7 @@ in the timestamp determines what will be changed." ts (match-string 0)) (replace-match "") (if (string-match - "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)*\\)[]>]" + "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" ts) (setq extra (match-string 1 ts))) (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) @@ -16112,6 +16574,39 @@ in the timestamp determines what will be changed." (t origin)))) ;; Update clock if on a CLOCK line. (org-clock-update-time-maybe) + ;; Maybe adjust the closest clock in `org-clock-history' + (when org-clock-adjust-closest + (if (not (and (org-at-clock-log-p) + (< 1 (length (delq nil (mapcar (lambda(m) (marker-position m)) + org-clock-history)))))) + (message "No clock to adjust") + (cond ((save-excursion ; fix previous clock? + (re-search-backward org-ts-regexp0 nil t) + (org-looking-back (concat org-clock-string " \\["))) + (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$"))) + ((save-excursion ; fix next clock? + (re-search-backward org-ts-regexp0 nil t) + (looking-at (concat org-ts-regexp0 "\\] =>"))) + (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0)))) + (save-window-excursion + ;; Find closest clock to point, adjust the previous/next one in history + (let* ((p (save-excursion (org-back-to-heading t))) + (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history)) + (clfixnth + (+ fixnext (- (length cl) (or (length (member (apply #'min cl) cl)) 100)))) + (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history)))) + (if (not clfixpos) + (message "No clock to adjust") + (save-excursion + (org-goto-marker-or-bmk clfixpos) + (org-show-subtree) + (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)) + (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. (if (and org-calendar-follow-timestamp-change (get-buffer-window "*Calendar*" t) @@ -16243,7 +16738,7 @@ effort string \"2hours\" is equivalent to 120 minutes." :type '(alist :key-type (string :tag "Modifier") :value-type (number :tag "Minutes"))) -(defun org-duration-string-to-minutes (s) +(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 @@ -16252,15 +16747,16 @@ 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]+\\) *\\(" + (re (concat "\\([0-9.]+\\) *\\(" (regexp-opt (mapcar 'car org-effort-durations)) "\\)"))) (while (string-match re s) (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)) (incf result (org-hh:mm-string-to-minutes s)) - result)) + (if output-to-string (number-to-string result) result))) ;;;; Files @@ -16268,7 +16764,7 @@ Entries containing a colon are interpreted as H:MM by "Save all Org-mode buffers without user confirmation." (interactive) (message "Saving all Org-mode buffers...") - (save-some-buffers t (lambda () (eq major-mode 'org-mode))) + (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) (when (featurep 'org-id) (org-id-locations-save)) (message "Saving all Org-mode buffers... done")) @@ -16292,7 +16788,7 @@ changes from another. I believe the procedure must be like this: (save-window-excursion (mapc (lambda (b) - (when (and (with-current-buffer b (eq major-mode 'org-mode)) + (when (and (with-current-buffer b (derived-mode-p 'org-mode)) (with-current-buffer b buffer-file-name)) (org-pop-to-buffer-same-window b) (revert-buffer t 'no-confirm))) @@ -16344,17 +16840,17 @@ If EXCLUDE-TMP is non-nil, ignore temporary buffers." (filter (cond ((eq predicate 'files) - (lambda (b) (with-current-buffer b (eq major-mode 'org-mode)))) + (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode)))) ((eq predicate 'export) (lambda (b) (string-match "\*Org .*Export" (buffer-name b)))) ((eq predicate 'agenda) (lambda (b) (with-current-buffer b - (and (eq major-mode 'org-mode) + (and (derived-mode-p 'org-mode) (setq bfn (buffer-file-name b)) (member (file-truename bfn) agenda-files))))) (t (lambda (b) (with-current-buffer b - (or (eq major-mode 'org-mode) + (or (derived-mode-p 'org-mode) (string-match "\*Org .*Export" (buffer-name b))))))))) (delq nil @@ -16571,7 +17067,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (with-current-buffer buf (save-buffer))) (kill-buffer buf)))) -(defun org-prepare-agenda-buffers (files) +(defun org-agenda-prepare-buffers (files) "Create buffers for all agenda files, protect archived trees and comments." (interactive) (let ((pa '(:org-archived t)) @@ -16579,7 +17075,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (pall '(:org-archived t :org-comment t)) (inhibit-read-only t) (rea (concat ":" org-archive-tag ":")) - bmp file re) + bmp file re) (save-excursion (save-restriction (while (setq file (pop files)) @@ -16657,7 +17153,7 @@ an embedded LaTeX fragment, let texmathp do its job. (interactive) (let (p) (cond - ((not (eq major-mode 'org-mode)) ad-do-it) + ((not (derived-mode-p 'org-mode)) ad-do-it) ((eq this-command 'cdlatex-math-symbol) (setq ad-return-value t texmathp-why '("cdlatex-math-symbol in org-mode" . 0))) @@ -16806,11 +17302,12 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (narrow-to-region beg end) (goto-char beg) (org-format-latex - (concat "ltxpng/" (file-name-sans-extension - (file-name-nondirectory - buffer-file-name))) - default-directory 'overlays msg at 'forbuffer 'dvipng) - (message msg "done. Use `C-c C-c' to remove images."))))) + (concat org-latex-preview-ltxpng-directory (file-name-sans-extension + (file-name-nondirectory + buffer-file-name))) + default-directory 'overlays msg at 'forbuffer + org-latex-create-formula-image-program) + (message msg "done. Use `C-c C-c' to remove images."))))) (defvar org-latex-regexps '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) @@ -16873,7 +17370,8 @@ Some of the options can be changed using the variable '(org-protected t)))) (add-text-properties (match-beginning n) (match-end n) '(org-protected t)))) - ((eq processing-type 'dvipng) + ((or (eq processing-type 'dvipng) + (eq processing-type 'imagemagick)) ;; Process to an image (setq txt (match-string n) beg (match-beginning n) end (match-end n) @@ -16894,17 +17392,25 @@ Some of the options can be changed using the variable (unless checkdir ; make sure the directory exists (setq checkdir t) (or (file-directory-p todir) (make-directory todir t))) - - (unless executables-checked - (org-check-external-command - "latex" "needed to convert LaTeX fragments to images") - (org-check-external-command - "dvipng" "needed to convert LaTeX fragments to images") - (setq executables-checked t)) - - (unless (file-exists-p movefile) - (org-create-formula-image - txt movefile opt forbuffer)) + (cond + ((eq processing-type 'dvipng) + (unless executables-checked + (org-check-external-command + "latex" "needed to convert LaTeX fragments to images") + (org-check-external-command + "dvipng" "needed to convert LaTeX fragments to images") + (setq executables-checked t)) + (unless (file-exists-p movefile) + (org-create-formula-image-with-dvipng + txt movefile opt forbuffer))) + ((eq processing-type 'imagemagick) + (unless executables-checked + (org-check-external-command + "convert" "you need to install imagemagick") + (setq executables-checked t)) + (unless (file-exists-p movefile) + (org-create-formula-image-with-imagemagick + txt movefile opt forbuffer)))) (if overlays (progn (mapc (lambda (o) @@ -16959,7 +17465,7 @@ write the results in to that file. When invoked as an interactive command, prompt for LATEX-FRAG, with initial value set to the current active region and echo the results for user inspection." - (interactive (list (let ((frag (when (region-active-p) + (interactive (list (let ((frag (when (org-region-active-p) (buffer-substring-no-properties (region-beginning) (region-end))))) (read-string "LaTeX Fragment: " frag nil frag)))) @@ -17040,7 +17546,7 @@ inspection." latex-frag))) ;; This function borrows from Ganesh Swami's latex2png.el -(defun org-create-formula-image (string tofile options buffer) +(defun org-create-formula-image-with-dvipng (string tofile options buffer) "This calls dvipng." (require 'org-latex) (let* ((tmpdir (if (featurep 'xemacs) @@ -17082,11 +17588,11 @@ inspection." (progn (message "Failed to create dvi file from %s" texfile) nil) (condition-case nil (if (featurep 'xemacs) - (call-process "dvipng" nil nil nil - "-fg" fg "-bg" bg - "-T" "tight" - "-o" pngfile - dvifile) + (call-process "dvipng" nil nil nil + "-fg" fg "-bg" bg + "-T" "tight" + "-o" pngfile + dvifile) (call-process "dvipng" nil nil nil "-fg" fg "-bg" bg "-D" dpi @@ -17102,8 +17608,115 @@ inspection." nil) ;; Use the requested file name and clean up (copy-file pngfile tofile 'replace) - (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png") do - (delete-file (concat texfilebase e))) + (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do + (if (file-exists-p (concat texfilebase e)) + (delete-file (concat texfilebase e)))) + pngfile)))) + +(defvar org-latex-to-pdf-process) ;; Defined in org-latex.el +(defun org-create-formula-image-with-imagemagick (string tofile options buffer) + "This calls convert, which is included into imagemagick." + (require 'org-latex) + (let* ((tmpdir (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory)) + (texfilebase (make-temp-name + (expand-file-name "orgtex" tmpdir))) + (texfile (concat texfilebase ".tex")) + (pdffile (concat texfilebase ".pdf")) + (pngfile (concat texfilebase ".png")) + (fnh (if (featurep 'xemacs) + (font-height (face-font 'default)) + (face-attribute 'default :height nil))) + (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) + (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) + (fg (or (plist-get options (if buffer :foreground :html-foreground)) + "black")) + (bg (or (plist-get options (if buffer :background :html-background)) + "white"))) + (if (eq fg 'default) (setq fg (org-latex-color :foreground)) + (setq fg (org-latex-color-format fg))) + (if (eq bg 'default) (setq bg (org-latex-color :background)) + (setq bg (org-latex-color-format + (if (string= bg "Transparent")(setq bg "white"))))) + (with-temp-file texfile + (insert (org-splice-latex-header + org-format-latex-header + org-export-latex-default-packages-alist + org-export-latex-packages-alist t + org-format-latex-header-extra)) + (insert "\n\\begin{document}\n" + "\\definecolor{fg}{rgb}{" fg "}\n" + "\\definecolor{bg}{rgb}{" bg "}\n" + "\n\\pagecolor{bg}\n" + "\n{\\color{fg}\n" + string + "\n}\n" + "\n\\end{document}\n" ) + (require 'org-latex) + (org-export-latex-fix-inputenc)) + (let ((dir default-directory) cmd cmds latex-frags-cmds) + (condition-case nil + (progn + (cd tmpdir) + (setq cmds org-latex-to-pdf-process) + (while cmds + (setq latex-frags-cmds (pop cmds)) + (if (listp latex-frags-cmds) + (setq cmds nil) + (setq latex-frags-cmds (list (car org-latex-to-pdf-process))))) + (while latex-frags-cmds + (setq cmd (pop latex-frags-cmds)) + (while (string-match "%b" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument texfile)) + t t cmd))) + (while (string-match "%f" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument (file-name-nondirectory texfile))) + t t cmd))) + (while (string-match "%o" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument (file-name-directory texfile))) + t t cmd))) + (setq cmd (split-string cmd)) + (eval (append (list 'call-process (pop cmd) nil nil nil) cmd)))) + (error nil)) + (cd dir)) + (if (not (file-exists-p pdffile)) + (progn (message "Failed to create pdf file from %s" texfile) nil) + (condition-case nil + (if (featurep 'xemacs) + (call-process "convert" nil nil nil + "-density" "96" + "-trim" + "-antialias" + pdffile + "-quality" "100" + ;; "-sharpen" "0x1.0" + pngfile) + (call-process "convert" nil nil nil + "-density" dpi + "-trim" + "-antialias" + pdffile + "-quality" "100" + ; "-sharpen" "0x1.0" + pngfile)) + (error nil)) + (if (not (file-exists-p pngfile)) + (if org-format-latex-signal-error + (error "Failed to create png file from %s" texfile) + (message "Failed to create png file from %s" texfile) + nil) + ;; Use the requested file name and clean up + (copy-file pngfile tofile 'replace) + (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do + (if (file-exists-p (concat texfilebase e)) + (delete-file (concat texfilebase e)))) pngfile)))) (defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) @@ -17166,7 +17779,7 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." (if newline (concat pkg "\n") pkg)) (defun org-dvipng-color (attr) - "Return an rgb color specification for dvipng." + "Return a RGB color specification for dvipng." (apply 'format "rgb %s %s %s" (mapcar 'org-normalize-color (if (featurep 'xemacs) @@ -17176,6 +17789,23 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." ((eq attr :background) 'background)))) (color-values (face-attribute 'default attr nil)))))) +(defun org-latex-color (attr) + "Return a RGB color for the LaTeX color package." + (apply 'format "%s,%s,%s" + (mapcar 'org-normalize-color + (if (featurep 'xemacs) + (color-rgb-components + (face-property 'default + (cond ((eq attr :foreground) 'foreground) + ((eq attr :background) 'background)))) + (color-values (face-attribute 'default attr nil)))))) + +(defun org-latex-color-format (color-name) + "Convert COLOR-NAME to a RGB color value." + (apply 'format "%s,%s,%s" + (mapcar 'org-normalize-color + (color-values color-name)))) + (defun org-normalize-color (value) "Return string to be used as color value for an RGB component." (format "%g" (/ value 65535.0))) @@ -17200,6 +17830,14 @@ INCLUDE-LINKED is passed to `org-display-inline-images'." (length org-inline-image-overlays)) (message "No images to display inline")))) +(defun org-redisplay-inline-images () + "Refresh the display of inline images." + (interactive) + (if (not org-inline-image-overlays) + (org-toggle-inline-images) + (org-toggle-inline-images) + (org-toggle-inline-images))) + (defun org-display-inline-images (&optional include-linked refresh beg end) "Display inline images. Normally only links without a description part are inlined, because this @@ -17238,10 +17876,13 @@ BEG and END default to the buffer boundaries." (overlay-put ov 'face 'default) (overlay-put ov 'org-image-overlay t) (overlay-put ov 'modification-hooks - (list 'org-display-inline-modification-hook)) + (list 'org-display-inline-remove-overlay)) (push ov org-inline-image-overlays))))))))) -(defun org-display-inline-modification-hook (ov after beg end &optional len) +(define-obsolete-function-alias + 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") + +(defun org-display-inline-remove-overlay (ov after beg end &optional len) "Remove inline-display overlay if a corresponding region is modified." (let ((inhibit-modification-hooks t)) (when (and ov after) @@ -17261,38 +17902,42 @@ BEG and END default to the buffer boundaries." (define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree) (define-key org-mode-map [remap show-subtree] 'org-show-subtree) (define-key org-mode-map [remap outline-forward-same-level] - 'org-forward-same-level) + 'org-forward-heading-same-level) (define-key org-mode-map [remap outline-backward-same-level] - 'org-backward-same-level) + 'org-backward-heading-same-level) (define-key org-mode-map [remap show-branches] 'org-kill-note-or-show-branches) (define-key org-mode-map [remap outline-promote] 'org-promote-subtree) (define-key org-mode-map [remap outline-demote] 'org-demote-subtree) (define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret) -;; Outline functions from `outline-mode-prefix-map' -;; that can not be remapped in Org: +;; Outline functions from `outline-mode-prefix-map' that can not +;; be remapped in Org: +;; ;; - the column "key binding" shows whether the Outline function is still ;; available in Org mode on the same key that it has been bound to in ;; Outline mode: ;; - "overridden": key used for a different functionality in Org mode ;; - else: key still bound to the same Outline function in Org mode +;; ;; | Outline function | key binding | Org replacement | ;; |------------------------------------+-------------+-----------------------| ;; | `outline-next-visible-heading' | `C-c C-n' | still same function | ;; | `outline-previous-visible-heading' | `C-c C-p' | still same function | +;; | `outline-up-heading' | `C-c C-u' | still same function | +;; | `outline-move-subtree-up' | overridden | better: org-shiftup | +;; | `outline-move-subtree-down' | overridden | better: org-shiftdown | +;; | `show-entry' | overridden | no replacement | ;; | `show-children' | `C-c C-i' | visibility cycling | +;; | `show-branches' | `C-c C-k' | still same function | +;; | `show-subtree' | overridden | visibility cycling | +;; | `show-all' | overridden | no replacement | ;; | `hide-subtree' | overridden | visibility cycling | -;; | `outline-up-heading' | `C-c C-u' | still same function | ;; | `hide-body' | overridden | no replacement | -;; | `show-all' | overridden | no replacement | ;; | `hide-entry' | overridden | visibility cycling | -;; | `show-entry' | overridden | no replacement | ;; | `hide-leaves' | overridden | no replacement | ;; | `hide-sublevels' | overridden | no replacement | ;; | `hide-other' | overridden | no replacement | -;; | `outline-move-subtree-up' | `C-c C-^' | better: org-shiftup | -;; | `outline-move-subtree-down' | overridden | better: org-shiftdown | ;; Make `C-c C-x' a prefix key (org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap)) @@ -17375,7 +18020,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup) (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown)) - ;; All the other keys +;; All the other keys (org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. (org-defkey org-mode-map "\C-c\C-r" 'org-reveal) @@ -17385,11 +18030,20 @@ BEG and END default to the buffer boundaries." (if (boundp 'narrow-map) (org-defkey narrow-map "b" 'org-narrow-to-block) (org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block)) -(org-defkey org-mode-map "\C-c\C-f" 'org-forward-same-level) -(org-defkey org-mode-map "\C-c\C-b" 'org-backward-same-level) +(if (boundp 'narrow-map) + (org-defkey narrow-map "e" 'org-narrow-to-element) + (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element)) +(org-defkey org-mode-map "\C-\M-t" 'org-transpose-element) +(org-defkey org-mode-map "\M-}" 'org-forward-element) +(org-defkey org-mode-map "\M-{" 'org-backward-element) +(org-defkey org-mode-map "\C-c\C-^" 'org-up-element) +(org-defkey org-mode-map "\C-c\C-_" 'org-down-element) +(org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level) +(org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level) (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default) +(org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer) (org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag) (org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling) (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) @@ -17411,6 +18065,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) (org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link) (org-defkey org-mode-map "\C-c\C-l" 'org-insert-link) +(org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links) (org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point) (org-defkey org-mode-map "\C-c%" 'org-mark-ring-push) (org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto) @@ -17454,6 +18109,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) (org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) (org-defkey org-mode-map "\C-c@" 'org-mark-subtree) +(org-defkey org-mode-map "\M-h" 'org-mark-element) (org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree) ;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree) @@ -17464,18 +18120,22 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays) (org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in) +(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-in-last) +(org-defkey org-mode-map "\C-c\C-x\C-z" 'org-resolve-clocks) (org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out) (org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto) -(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel) +(org-defkey org-mode-map "\C-c\C-x\C-q" 'org-clock-cancel) (org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display) (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) (org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images) +(org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images) (org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities) (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) (org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) +(org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort) (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) (org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) @@ -17506,8 +18166,8 @@ BEG and END default to the buffer boundaries." ("Outline Navigation") ("n" . (org-speed-move-safe 'outline-next-visible-heading)) ("p" . (org-speed-move-safe 'outline-previous-visible-heading)) - ("f" . (org-speed-move-safe 'org-forward-same-level)) - ("b" . (org-speed-move-safe 'org-backward-same-level)) + ("f" . (org-speed-move-safe 'org-forward-heading-same-level)) + ("b" . (org-speed-move-safe 'org-backward-heading-same-level)) ("u" . (org-speed-move-safe 'outline-up-heading)) ("j" . org-goto) ("g" . (org-refile t)) @@ -17515,6 +18175,7 @@ BEG and END default to the buffer boundaries." ("c" . org-cycle) ("C" . org-shifttab) (" " . org-display-outline-path) + (":" . org-columns) ("Outline Structure Editing") ("U" . org-shiftmetaup) ("D" . org-shiftmetadown) @@ -17528,17 +18189,22 @@ BEG and END default to the buffer boundaries." ("w" . org-refile) ("a" . org-archive-subtree-default-with-confirmation) ("." . org-mark-subtree) + ("#" . org-toggle-comment) ("Clock Commands") ("I" . org-clock-in) ("O" . org-clock-out) ("Meta Data Editing") ("t" . org-todo) + ("," . (org-priority)) ("0" . (org-priority ?\ )) ("1" . (org-priority ?A)) ("2" . (org-priority ?B)) ("3" . (org-priority ?C)) (";" . org-set-tags-command) ("e" . org-set-effort) + ("E" . org-inc-effort) + ("W" . (lambda(m) (interactive "sMinutes before warning: ") + (org-entry-put (point) "APPT_WARNTIME" m))) ("Agenda Views etc") ("v" . org-agenda) ("/" . org-sparse-tree) @@ -17594,7 +18260,10 @@ If not, return to the original position and throw an error." (defvar org-table-auto-blank-field) ; defined in org-table.el (defvar org-speed-command nil) -(defun org-speed-command-default-hook (keys) +(define-obsolete-function-alias + 'org-speed-command-default-hook 'org-speed-command-activate "24.3") + +(defun org-speed-command-activate (keys) "Hook for activating single-letter speed commands. `org-speed-commands-default' specifies a minimal command set. Use `org-speed-commands-user' for further customization." @@ -17604,7 +18273,10 @@ Use `org-speed-commands-user' for further customization." (cdr (assoc keys (append org-speed-commands-user org-speed-commands-default))))) -(defun org-babel-speed-command-hook (keys) +(define-obsolete-function-alias + 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3") + +(defun org-babel-speed-command-activate (keys) "Hook for activating single-letter code block commands." (when (and (bolp) (looking-at org-babel-src-block-regexp)) (cdr (assoc keys org-babel-key-bindings)))) @@ -17623,8 +18295,9 @@ and return nil or a valid handler as appropriate. Handler could be one of an interactive command, a function, or a form. Set `org-use-speed-commands' to non-nil value to enable this -hook. The default setting is `org-speed-command-default-hook'." +hook. The default setting is `org-speed-command-activate'." :group 'org-structure + :version "24.1" :type 'hook) (defun org-self-insert-command (N) @@ -17658,7 +18331,7 @@ overwritten, and the table is not marked as requiring realignment." (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) ;; got extra space, this field does not determine column width (let (org-table-may-need-update) (org-table-blank-field)) - ;; no extra space, this field may determine column width + ;; no extra space, this field may determine column width (org-table-blank-field))) t) (eq N 1) @@ -17707,29 +18380,31 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." ;; (and (not invisible-at-point) invisible-before-point ;; (memq kind '(insert delete))) ))) - - (when (or (memq invisible-at-point '(outline org-hide-block)) - (memq invisible-before-point '(outline org-hide-block))) + (when (or (memq invisible-at-point '(outline org-hide-block t)) + (memq invisible-before-point '(outline org-hide-block t))) (if (eq org-catch-invisible-edits 'error) (error "Editing in invisible areas is prohibited - make visible first")) - ;; Make the area visible - (save-excursion - (if invisible-before-point - (goto-char (previous-single-char-property-change - (point) 'invisible))) - (org-cycle)) - (cond - ((eq org-catch-invisible-edits 'show) - ;; That's it, we do the edit after showing - (message - "Unfolding invisible region around point before editing") - (sit-for 1)) - ((and (eq org-catch-invisible-edits 'smart) - border-and-ok-direction) - (message "Unfolding invisible region around point before editing")) - (t - ;; Don't do the edit, make the user repeat it in full visibility - (error "Edit in invisible region aborted, repeat to confirm with text visible"))))))) + (if (and org-custom-properties-overlays + (y-or-n-p "Display invisible properties in this buffer? ")) + (org-toggle-custom-properties-visibility) + ;; Make the area visible + (save-excursion + (if invisible-before-point + (goto-char (previous-single-char-property-change + (point) 'invisible))) + (org-cycle)) + (cond + ((eq org-catch-invisible-edits 'show) + ;; That's it, we do the edit after showing + (message + "Unfolding invisible region around point before editing") + (sit-for 1)) + ((and (eq org-catch-invisible-edits 'smart) + border-and-ok-direction) + (message "Unfolding invisible region around point before editing")) + (t + ;; Don't do the edit, make the user repeat it in full visibility + (error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) (defun org-fix-tags-on-the-fly () (when (and (equal (char-after (point-at-bol)) ?*) @@ -18007,27 +18682,31 @@ individual commands for more information." (defun org-shiftmetaup (&optional arg) "Move subtree up or kill table row. Calls `org-move-subtree-up' or `org-table-kill-row' or -`org-move-item-up' depending on context. See the individual commands -for more information." +`org-move-item-up' or `org-timestamp-up', depending on context. +See the individual commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-shiftmetaup-hook)) ((org-at-table-p) (call-interactively 'org-table-kill-row)) ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) ((org-at-item-p) (call-interactively 'org-move-item-up)) + ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) + (call-interactively 'org-timestamp-up))) (t (org-modifier-cursor-error)))) (defun org-shiftmetadown (&optional arg) "Move subtree down or insert table row. Calls `org-move-subtree-down' or `org-table-insert-row' or -`org-move-item-down', depending on context. See the individual -commands for more information." +`org-move-item-down' or `org-timestamp-up', depending on context. +See the individual commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-shiftmetadown-hook)) ((org-at-table-p) (call-interactively 'org-table-insert-row)) ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) ((org-at-item-p) (call-interactively 'org-move-item-down)) + ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) + (call-interactively 'org-timestamp-down))) (t (org-modifier-cursor-error)))) (defsubst org-hidden-tree-error () @@ -18064,14 +18743,16 @@ See the individual commands for more information." (t (call-interactively 'backward-word)))) (defun org-metaright (&optional arg) - "Demote subtree or move table column to right. -Calls `org-do-demote' or `org-table-move-column', depending on context. + "Demote a subtree, a list item or move table column to right. +In front of a drawer or a block keyword, indent it correctly. With no specific context, calls the Emacs default `forward-word'. See the individual commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metaright-hook)) ((org-at-table-p) (call-interactively 'org-table-move-column)) + ((org-at-drawer-p) (call-interactively 'org-indent-drawer)) + ((org-at-block-p) (call-interactively 'org-indent-block)) ((org-with-limited-levels (or (org-at-heading-p) (and (org-region-active-p) @@ -18119,6 +18800,20 @@ this function returns t, nil otherwise." (throw 'exit t)))) nil)))) +(autoload 'org-element-at-point "org-element") + +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-context "org-element" ()) +(declare-function org-element-contents "org-element" (element)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-paragraph-parser "org-element" (limit)) +(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion)) +(declare-function org-element-nested-p "org-element" (elem-a elem-b)) +(declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) +(declare-function org-element--parse-objects "org-element" (beg end acc restriction)) +(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) + (defun org-metaup (&optional arg) "Move subtree up or move table row up. Calls `org-move-subtree-up' or `org-table-move-row' or @@ -18127,10 +18822,19 @@ for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metaup-hook)) + ((org-region-active-p) + (let* ((a (min (region-beginning) (region-end))) + (b (1- (max (region-beginning) (region-end)))) + (c (save-excursion (goto-char a) + (move-beginning-of-line 0))) + (d (save-excursion (goto-char a) + (move-end-of-line 0) (point)))) + (transpose-regions a b c d) + (goto-char c))) ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) ((org-at-item-p) (call-interactively 'org-move-item-up)) - (t (transpose-lines 1) (beginning-of-line -1)))) + (t (org-drag-element-backward)))) (defun org-metadown (&optional arg) "Move subtree down or move table row down. @@ -18140,10 +18844,19 @@ commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metadown-hook)) + ((org-region-active-p) + (let* ((a (min (region-beginning) (region-end))) + (b (max (region-beginning) (region-end))) + (c (save-excursion (goto-char b) + (move-beginning-of-line 1))) + (d (save-excursion (goto-char b) + (move-end-of-line 1) (1+ (point))))) + (transpose-regions a b c d) + (goto-char d))) ((org-at-table-p) (call-interactively 'org-table-move-row)) ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) ((org-at-item-p) (call-interactively 'org-move-item-down)) - (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0)))) + (t (org-drag-element-forward)))) (defun org-shiftup (&optional arg) "Increase item in timestamp or increase priority of current headline. @@ -18329,17 +19042,17 @@ Depending on context, this does one of the following: (defun org-copy-visible (beg end) "Copy the visible parts of the region." - (interactive "r") - (let (snippets s) - (save-excursion - (save-restriction + (interactive "r") + (let (snippets s) + (save-excursion + (save-restriction (narrow-to-region beg end) (setq s (goto-char (point-min))) (while (not (= (point) (point-max))) (goto-char (org-find-invisible)) (push (buffer-substring s (point)) snippets) (setq s (goto-char (org-find-visible)))))) - (kill-new (apply 'concat (nreverse snippets))))) + (kill-new (apply 'concat (nreverse snippets))))) (defun org-copy-special () "Copy region in table or copy current subtree. @@ -18394,7 +19107,7 @@ When in an #+include line, visit the include file. Otherwise call ((or (org-at-table-p) (save-excursion (beginning-of-line 1) - (looking-at "[ \t]*#\\+TBLFM:"))) + (let ((case-fold-search )) (looking-at "[ \t]*#\\+tblfm:")))) (call-interactively 'org-table-edit-formulas)) (t (call-interactively 'ffap)))) @@ -18480,7 +19193,7 @@ This command does many different things, depending on context: (org-footnote-at-definition-p)) (call-interactively 'org-footnote-action)) ((org-at-item-checkbox-p) - ;; Cursor at a checkbox: repair list and update checkboxes. Send + ;; Cursor at a checkbox: repair list and update checkboxes. Send ;; list only if at top item. (let* ((cbox (match-string 1)) (struct (org-list-struct)) @@ -18548,10 +19261,12 @@ This command does many different things, depending on context: (beginning-of-line 1) (save-excursion (org-update-dblock))) ((save-excursion - (beginning-of-line 1) - (looking-at "[ \t]*#\\+\\([A-Z]+\\)")) + (let ((case-fold-search t)) + (beginning-of-line 1) + (looking-at "[ \t]*#\\+\\([a-z]+\\)"))) (cond - ((equal (match-string 1) "TBLFM") + ((or (equal (match-string 1) "TBLFM") + (equal (match-string 1) "tblfm")) ;; Recalculate the table before this line (save-excursion (beginning-of-line 1) @@ -18593,35 +19308,41 @@ Also updates the keyword regular expressions." Calls `org-table-next-row' or `newline', depending on context. See the individual commands for more information." (interactive) - (cond - ((bobp) (if indent (newline-and-indent) (newline))) - ((org-at-table-p) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-row)) - ;; when `newline-and-indent' is called within a list, make sure - ;; text moved stays inside the item. - ((and (org-in-item-p) indent) - (if (and (org-at-item-p) (>= (point) (match-end 0))) - (progn - (save-match-data (newline)) - (org-indent-line-to (length (match-string 0)))) - (let ((ind (org-get-indentation))) - (newline) - (if (org-looking-back org-list-end-re) - (org-indent-line-function) - (org-indent-line-to ind))))) - ((and org-return-follows-link - (let ((tprop (get-text-property (point) 'face))) - (or (eq tprop 'org-link) - (and (listp tprop) (memq 'org-link tprop))))) - (call-interactively 'org-open-at-point)) - ((and (org-at-heading-p) - (looking-at - (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))) - (org-show-entry) - (end-of-line 1) - (newline)) - (t (if indent (newline-and-indent) (newline))))) + (let (org-ts-what) + (cond + ((or (bobp) (org-in-src-block-p)) + (if indent (newline-and-indent) (newline))) + ((org-at-table-p) + (org-table-justify-field-maybe) + (call-interactively 'org-table-next-row)) + ;; when `newline-and-indent' is called within a list, make sure + ;; text moved stays inside the item. + ((and (org-in-item-p) indent) + (if (and (org-at-item-p) (>= (point) (match-end 0))) + (progn + (save-match-data (newline)) + (org-indent-line-to (length (match-string 0)))) + (let ((ind (org-get-indentation))) + (newline) + (if (org-looking-back org-list-end-re) + (org-indent-line) + (org-indent-line-to ind))))) + ((and org-return-follows-link + (org-at-timestamp-p t) + (not (eq org-ts-what 'after))) + (org-follow-timestamp-link)) + ((and org-return-follows-link + (let ((tprop (get-text-property (point) 'face))) + (or (eq tprop 'org-link) + (and (listp tprop) (memq 'org-link tprop))))) + (call-interactively 'org-open-at-point)) + ((and (org-at-heading-p) + (looking-at + (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))) + (org-show-entry) + (end-of-line 1) + (newline)) + (t (if indent (newline-and-indent) (newline)))))) (defun org-return-indent () "Goto next table row or insert a newline and indent. @@ -18741,7 +19462,7 @@ argument ARG, change each line in region into an item." ((not org-adapt-indentation) 0) ((not (outline-previous-heading)) 0) (t (length (match-string 0)))))) - ;; Level of first heading. Further headings will be + ;; Level of first heading. Further headings will be ;; compared to it to determine hierarchy in the list. (ref-level (org-reduced-level (org-outline-level)))) (while (< (point) end) @@ -18792,13 +19513,18 @@ argument ARG, change each line in region into an item." "Convert headings to normal text, or items or text to headings. If there is no active region, only the current line is considered. -If the first non blank line is an headline, remove the stars from -all headlines in the region. +With a \\[universal-argument] prefix, convert the whole list at +point into heading. + +In a region: -If it is a plain list item, turn all plain list items into headings. +- If the first non blank line is an headline, remove the stars + from all headlines in the region. -If it is a normal line, turn each and every normal line (i.e. not -an heading or an item) in the region into a heading. +- If it is a normal line turn each and every normal line (i.e. not an + heading or an item) in the region into a heading. + +- If it is a plain list item, turn all plain list items into headings. When converting a line into a heading, the number of stars is chosen such that the lines become children of the current entry. However, @@ -18812,11 +19538,18 @@ stars to add." (lambda (pos) (save-excursion (goto-char pos) + (while (org-at-comment-p) (forward-line)) (skip-chars-forward " \r\t\n") (point-at-bol))))) - beg end) - ;; Determine boundaries of changes. If region ends at a bol, do - ;; not consider the last line to be in the region. + beg end toggled) + ;; Determine boundaries of changes. If a universal prefix has + ;; been given, put the list in a region. If region ends at a bol, + ;; do not consider the last line to be in the region. + + (when (and current-prefix-arg (org-at-item-p)) + (if (equal current-prefix-arg '(4)) (setq current-prefix-arg 1)) + (org-mark-element)) + (if (org-region-active-p) (setq beg (funcall skip-blanks (region-beginning)) end (copy-marker (save-excursion @@ -18833,7 +19566,8 @@ stars to add." ((org-at-heading-p) (while (< (point) end) (when (org-at-heading-p t) - (looking-at org-outline-regexp) (replace-match "")) + (looking-at org-outline-regexp) (replace-match "") + (setq toggled t)) (forward-line))) ;; Case 2. Started at an item: change items into headlines. ;; One star will be added by `org-list-to-subtree'. @@ -18861,7 +19595,8 @@ stars to add." (org-list-to-subtree (org-list-parse-list t) '(:istart (concat stars add-stars (funcall get-stars depth)) - :icount (concat stars add-stars (funcall get-stars depth)))))))) + :icount (concat stars add-stars (funcall get-stars depth))))))) + (setq toggled t)) (forward-line)))) ;; Case 3. Started at normal text: make every line an heading, ;; skipping headlines and items. @@ -18877,10 +19612,11 @@ stars to add." (t "*"))) ; inside heading, oddeven (rpl (concat stars add-stars " "))) (while (< (point) end) - (when (and (not (org-at-heading-p)) (not (org-at-item-p)) + (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p))) (looking-at "\\([ \t]*\\)\\(\\S-\\)")) - (replace-match (concat rpl (match-string 2)))) - (forward-line))))))))) + (replace-match (concat rpl (match-string 2))) (setq toggled t)) + (forward-line))))))) + (unless toggled (message "Cannot toggle heading from here")))) (defun org-meta-return (&optional arg) "Insert a new heading or wrap a region in a table. @@ -18889,12 +19625,19 @@ See the individual commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metareturn-hook)) + ((or (org-at-drawer-p) (org-at-property-p)) + (newline-and-indent)) ((org-at-table-p) (call-interactively 'org-table-wrap-region)) (t (call-interactively 'org-insert-heading)))) ;;; Menu entries +(defsubst org-in-subtree-not-table-p () + "Are we in a subtree and not in a table?" + (and (not (org-before-first-heading-p)) + (not (org-at-table-p)))) + ;; Define the Org-mode menus (easy-menu-define org-tbl-menu org-mode-map "Tbl menu" '("Tbl" @@ -18977,23 +19720,25 @@ See the individual commands for more information." "--" ["Jump" org-goto t]) ("Edit Structure" - ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] - ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] + ["Refile Subtree" org-refile (org-in-subtree-not-table-p)] "--" - ["Copy Subtree" org-copy-special (not (org-at-table-p))] - ["Cut Subtree" org-cut-special (not (org-at-table-p))] + ["Move Subtree Up" org-shiftmetaup (org-in-subtree-not-table-p)] + ["Move Subtree Down" org-shiftmetadown (org-in-subtree-not-table-p)] + "--" + ["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)] + ["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)] ["Paste Subtree" org-paste-special (not (org-at-table-p))] "--" ["Clone subtree, shift time" org-clone-subtree-with-time-shift t] "--" ["Copy visible text" org-copy-visible t] "--" - ["Promote Heading" org-metaleft (not (org-at-table-p))] - ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] - ["Demote Heading" org-metaright (not (org-at-table-p))] - ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] + ["Promote Heading" org-metaleft (org-in-subtree-not-table-p)] + ["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)] + ["Demote Heading" org-metaright (org-in-subtree-not-table-p)] + ["Demote Subtree" org-shiftmetaright (org-in-subtree-not-table-p)] "--" - ["Sort Region/Children" org-sort (not (org-at-table-p))] + ["Sort Region/Children" org-sort t] "--" ["Convert to odd levels" org-convert-to-odd-levels t] ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) @@ -19004,11 +19749,11 @@ See the individual commands for more information." ["Footnote new/jump" org-footnote-action t] ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"]) ("Archive" - ["Archive (default method)" org-archive-subtree-default t] + ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)] "--" - ["Move Subtree to Archive file" org-advertized-archive-subtree t] - ["Toggle ARCHIVE tag" org-toggle-archive-tag t] - ["Move subtree to Archive sibling" org-archive-to-archive-sibling t] + ["Move Subtree to Archive file" org-advertized-archive-subtree (org-in-subtree-not-table-p)] + ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)] + ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)] ) "--" ("Hyperlinks" @@ -19059,23 +19804,23 @@ See the individual commands for more information." ["Go to the inbox of a feed..." org-feed-goto-inbox t] ["Customize feeds" (customize-variable 'org-feed-alist) t]) ("TAGS and Properties" - ["Set Tags" org-set-tags-command t] + ["Set Tags" org-set-tags-command (not (org-before-first-heading-p))] ["Change tag in region" org-change-tag-in-region (org-region-active-p)] "--" - ["Set property" org-set-property t] + ["Set property" org-set-property (not (org-before-first-heading-p))] ["Column view of properties" org-columns t] ["Insert Column View DBlock" org-insert-columns-dblock t]) ("Dates and Scheduling" - ["Timestamp" org-time-stamp t] - ["Timestamp (inactive)" org-time-stamp-inactive t] + ["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 t] - ["1 Day Earlier" org-shiftleft t] - ["1 ... Later" org-shiftup t] - ["1 ... Earlier" org-shiftdown t]) + ["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)]) ["Compute Time Range" org-evaluate-time-range t] - ["Schedule Item" org-schedule t] - ["Deadline" org-deadline t] + ["Schedule Item" org-schedule (not (org-before-first-heading-p))] + ["Deadline" org-deadline (not (org-before-first-heading-p))] "--" ["Custom time format" org-toggle-time-stamp-overlays :style radio :selected org-display-custom-times] @@ -19175,7 +19920,7 @@ information about your Org-mode version and configuration." (let ((reporter-prompt-for-summary-p "Bug report subject: ")) (reporter-submit-bug-report "emacs-orgmode@gnu.org" - (org-version) + (org-version nil 'full) (let (list) (save-window-excursion (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) @@ -19224,8 +19969,8 @@ Your bug report will be posted to the Org-mode mailing list. (save-excursion (while bl (set-buffer (pop bl)) - (if (eq major-mode 'org-mode) (setq bl nil))) - (when (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (setq bl nil))) + (when (derived-mode-p 'org-mode) (easy-menu-change '("Org") "File List for Agenda" (append @@ -19256,25 +20001,25 @@ Your bug report will be posted to the Org-mode mailing list. With prefix arg UNCOMPILED, load the uncompiled versions." (interactive "P") (require 'find-func) - (let* ((file-re "^\\(org\\|orgtbl\\)\\(\\.el\\|-.*\\.el\\)") - (dir-org (file-name-directory (org-find-library-name "org"))) + (let* ((file-re "^org\\(-.*\\)?\\.el") + (dir-org (file-name-directory (org-find-library-dir "org"))) (dir-org-contrib (ignore-errors - (file-name-directory - (org-find-library-name "org-contribdir")))) + (file-name-directory + (org-find-library-dir "org-contribdir")))) (babel-files (mapcar (lambda (el) (concat "ob" (when el (format "-%s" el)) ".el")) (append (list nil "comint" "eval" "exp" "keys" - "lob" "ref" "table" "tangle") + "lob" "ref" "table" "tangle") (delq nil (mapcar (lambda (lang) (when (cdr lang) (symbol-name (car lang)))) org-babel-load-languages))))) (files - (append (directory-files dir-org t file-re) - babel-files - (and dir-org-contrib - (directory-files dir-org-contrib t file-re)))) + (append babel-files + (and dir-org-contrib + (directory-files dir-org-contrib t file-re)) + (directory-files dir-org t file-re))) (remove-re (concat (if (featurep 'xemacs) "org-colview" "org-colview-xemacs") "\\'"))) @@ -19288,10 +20033,11 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (when (featurep (intern (file-name-nondirectory f))) (if (and (not uncompiled) (file-exists-p (concat f ".elc"))) - (load (concat f ".elc") nil nil t) - (load (concat f ".el") nil nil t)))) - files)) - (org-version)) + (load (concat f ".elc") nil nil 'nosuffix) + (load (concat f ".el") nil nil 'nosuffix)))) + files) + (load (concat dir-org "org-version.el") 'noerror nil 'nosuffix)) + (org-version nil 'full 'message)) ;;;###autoload (defun org-customize () @@ -19527,7 +20273,7 @@ N may optionally be the number of spaces to remove." (setq template (replace-regexp-in-string (concat "%" (regexp-quote (car entry))) - (cdr entry) template t t))) + (or (cdr entry) "") template t t))) template)) (defun org-base-buffer (buffer) @@ -19616,6 +20362,14 @@ and end of string." "Is S an ID created by UUIDGEN?" (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s))) +(defun org-in-src-block-p nil + "Whether point is in a code source block." + (let (ov) + (when (setq ov (overlays-at (point))) + (memq 'org-block-background + (overlay-properties + (car ov)))))) + (defun org-context () "Return a list of contexts of the current cursor position. If several contexts apply, all are returned. @@ -19634,8 +20388,10 @@ contexts are: :table in an org-mode table :table-special on a special filed in a table :table-table in a table.el table +:clocktable in a clocktable +:src-block in a source block :link on a hyperlink -:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE. +:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT, QUOTE. :target on a <<target>> :radio-target on a <<<radio-target>>> :latex-fragment on a LaTeX fragment @@ -19646,6 +20402,7 @@ faces as a help to recognize the following contexts: :table-special, :link, and :keyword." (let* ((f (get-text-property (point) 'face)) (faces (if (listp f) f (list f))) + (case-fold-search t) (p (point)) clist o) ;; First the large context (cond @@ -19680,6 +20437,24 @@ and :keyword." (push (list :table-table) clist))) (goto-char p) + (let ((case-fold-search t)) + ;; New the "medium" contexts: clocktables, source blocks + (cond ((org-in-clocktable-p) + (push (list :clocktable + (and (or (looking-at "#\\+BEGIN: clocktable") + (search-backward "#+BEGIN: clocktable" nil t)) + (match-beginning 0)) + (and (re-search-forward "#\\+END:?" nil t) + (match-end 0))) clist)) + ((org-in-src-block-p) + (push (list :src-block + (and (or (looking-at "#\\+BEGIN_SRC") + (search-backward "#+BEGIN_SRC" nil t)) + (match-beginning 0)) + (and (search-forward "#+END_SRC" nil t) + (match-beginning 0))) clist)))) + (goto-char p) + ;; Now the small context (cond ((org-at-timestamp-p) @@ -19826,18 +20601,18 @@ block from point." ;; Emacs 23 (add-hook 'occur-mode-find-occurrence-hook (lambda () - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (org-reveal)))) ;; Emacs 22 (defadvice occur-mode-goto-occurrence (after org-occur-reveal activate) - (and (eq major-mode 'org-mode) (org-reveal))) + (and (derived-mode-p 'org-mode) (org-reveal))) (defadvice occur-mode-goto-occurrence-other-window (after org-occur-reveal activate) - (and (eq major-mode 'org-mode) (org-reveal))) + (and (derived-mode-p 'org-mode) (org-reveal))) (defadvice occur-mode-display-occurrence (after org-occur-reveal activate) - (when (eq major-mode 'org-mode) + (when (derived-mode-p 'org-mode) (let ((pos (occur-mode-find-occurrence))) (with-current-buffer (marker-buffer pos) (save-excursion @@ -19910,7 +20685,7 @@ Taken from `reduce' in cl-seq.el with all keyword arguments but Returns the number of empty lines passed." (let ((pos (point))) (if (cdr (assoc 'heading org-blank-before-new-entry)) - (skip-chars-backward " \t\n\r") + (skip-chars-backward " \t\n\r") (unless (eobp) (forward-line -1))) (beginning-of-line 2) @@ -19954,32 +20729,6 @@ ones and overrule settings in the other lists." (setq rtn (plist-put rtn p v)))) rtn)) -(defun org-move-line-down (arg) - "Move the current line down. With prefix argument, move it past ARG lines." - (interactive "p") - (let ((col (current-column)) - beg end pos) - (beginning-of-line 1) (setq beg (point)) - (beginning-of-line 2) (setq end (point)) - (beginning-of-line (+ 1 arg)) - (setq pos (move-marker (make-marker) (point))) - (insert (delete-and-extract-region beg end)) - (goto-char pos) - (org-move-to-column col))) - -(defun org-move-line-up (arg) - "Move the current line up. With prefix argument, move it past ARG lines." - (interactive "p") - (let ((col (current-column)) - beg end pos) - (beginning-of-line 1) (setq beg (point)) - (beginning-of-line 2) (setq end (point)) - (beginning-of-line (- arg)) - (setq pos (move-marker (make-marker) (point))) - (insert (delete-and-extract-region beg end)) - (goto-char pos) - (org-move-to-column col))) - (defun org-replace-escapes (string table) "Replace %-escapes in STRING with values in TABLE. TABLE is an association list with keys like \"%a\" and string values. @@ -20078,34 +20827,24 @@ which make use of the date at the cursor." (message "Entry marked for action; press `k' at desired date in agenda or calendar")) -(defun org-mark-subtree () +(defun org-mark-subtree (&optional up) "Mark the current subtree. -This puts point at the start of the current subtree, and mark at the end. - -If point is in an inline task, mark that task instead." - (interactive) - (let ((inline-task-p - (and (featurep 'org-inlinetask) - (org-inlinetask-in-task-p))) - (beg)) - ;; Get beginning of subtree - (cond - (inline-task-p (org-inlinetask-goto-beginning)) - ((org-at-heading-p) (beginning-of-line)) - (t (org-with-limited-levels (outline-previous-visible-heading 1)))) - (setq beg (point)) - ;; Get end of it - (if inline-task-p - (org-inlinetask-goto-end) - (org-end-of-subtree)) - ;; Mark zone - (push-mark (point) nil t) - (goto-char beg))) +This puts point at the start of the current subtree, and mark at +the end. If a numeric prefix UP is given, move up into the +hierarchy of headlines by UP levels before marking the subtree." + (interactive "P") + (org-with-limited-levels + (cond ((org-at-heading-p) (beginning-of-line)) + ((org-before-first-heading-p) (error "Not in a subtree")) + (t (outline-previous-visible-heading 1)))) + (when up (while (and (> up 0) (org-up-heading-safe)) (decf up))) + (if (org-called-interactively-p 'any) + (call-interactively 'org-mark-element) + (org-mark-element))) -;;; Paragraph filling stuff. -;; We want this to be just right, so use the full arsenal. +;;; Indentation -(defun org-indent-line-function () +(defun org-indent-line () "Indent line depending on context." (interactive) (let* ((pos (point)) @@ -20117,283 +20856,475 @@ If point is in an inline task, mark that task instead." (inline-re (and inline-task-p (org-inlinetask-outline-regexp))) column) - (beginning-of-line 1) - (cond - ;; Comments - ((looking-at "# ") (setq column 0)) - ;; Headings - ((looking-at org-outline-regexp) (setq column 0)) - ;; Included files - ((looking-at "#\\+include:") (setq column 0)) - ;; Footnote definition - ((looking-at org-footnote-definition-re) (setq column 0)) - ;; Literal examples - ((looking-at "[ \t]*:\\( \\|$\\)") - (setq column (org-get-indentation))) ; do nothing - ;; Lists - ((ignore-errors (goto-char (org-in-item-p))) - (setq column (if itemp - (org-get-indentation) - (org-list-item-body-column (point)))) - (goto-char pos)) - ;; Drawers - ((and (looking-at "[ \t]*:END:") - (save-excursion (re-search-backward org-drawer-regexp nil t))) - (save-excursion - (goto-char (1- (match-beginning 1))) - (setq column (current-column)))) - ;; Special blocks - ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") - (save-excursion - (re-search-backward - (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) - (setq column (org-get-indentation (match-string 0)))) - ((and (not (looking-at "[ \t]*#\\+begin_")) - (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) - (save-excursion - (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) - (setq column - (cond ((equal (downcase (match-string 1)) "src") - ;; src blocks: let `org-edit-src-exit' handle them - (org-get-indentation)) - ((equal (downcase (match-string 1)) "example") - (max (org-get-indentation) - (org-get-indentation (match-string 0)))) - (t - (org-get-indentation (match-string 0)))))) - ;; This line has nothing special, look at the previous relevant - ;; line to compute indentation - (t - (beginning-of-line 0) - (while (and (not (bobp)) - (not (looking-at org-drawer-regexp)) - ;; When point started in an inline task, do not move - ;; above task starting line. - (not (and inline-task-p (looking-at inline-re))) - ;; Skip drawers, blocks, empty lines, verbatim, - ;; comments, tables, footnotes definitions, lists, - ;; inline tasks. - (or (and (looking-at "[ \t]*:END:") - (re-search-backward org-drawer-regexp nil t)) - (and (looking-at "[ \t]*#\\+end_") - (re-search-backward "[ \t]*#\\+begin_"nil t)) - (looking-at "[ \t]*[\n:#|]") - (looking-at org-footnote-definition-re) - (and (ignore-errors (goto-char (org-in-item-p))) - (goto-char - (org-list-get-top-point (org-list-struct)))) - (and (not inline-task-p) - (featurep 'org-inlinetask) - (org-inlinetask-in-task-p) - (or (org-inlinetask-goto-beginning) t)))) - (beginning-of-line 0)) + (if (and orgstruct-is-++ (eq pos (point))) + (let ((indent-line-function (cadadr (assoc 'indent-line-function org-fb-vars)))) + (indent-according-to-mode)) + (beginning-of-line 1) (cond - ;; There was an heading above. - ((looking-at "\\*+[ \t]+") - (if (not org-adapt-indentation) - (setq column 0) - (goto-char (match-end 0)) + ;; Headings + ((looking-at org-outline-regexp) (setq column 0)) + ;; Included files + ((looking-at "#\\+include:") (setq column 0)) + ;; Footnote definition + ((looking-at org-footnote-definition-re) (setq column 0)) + ;; Literal examples + ((looking-at "[ \t]*:\\( \\|$\\)") + (setq column (org-get-indentation))) ; do nothing + ;; Lists + ((ignore-errors (goto-char (org-in-item-p))) + (setq column (if itemp + (org-get-indentation) + (org-list-item-body-column (point)))) + (goto-char pos)) + ;; Drawers + ((and (looking-at "[ \t]*:END:") + (save-excursion (re-search-backward org-drawer-regexp nil t))) + (save-excursion + (goto-char (1- (match-beginning 1))) (setq column (current-column)))) - ;; A drawer had started and is unfinished - ((looking-at org-drawer-regexp) - (goto-char (1- (match-beginning 1))) - (setq column (current-column))) - ;; Else, nothing noticeable found: get indentation and go on. - (t (setq column (org-get-indentation)))))) - ;; Now apply indentation and move cursor accordingly - (goto-char pos) - (if (<= (current-column) (current-indentation)) - (org-indent-line-to column) - (save-excursion (org-indent-line-to column))) - ;; Special polishing for properties, see `org-property-format' - (setq column (current-column)) - (beginning-of-line 1) - (if (looking-at - "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") - (replace-match (concat (match-string 1) - (format org-property-format - (match-string 2) (match-string 3))) - t t)) - (org-move-to-column column))) - -(defvar org-adaptive-fill-regexp-backup adaptive-fill-regexp - "Variable to store copy of `adaptive-fill-regexp'. -Since `adaptive-fill-regexp' is set to never match, we need to -store a backup of its value before entering `org-mode' so that -the functionality can be provided as a fall-back.") - -(defun org-set-autofill-regexps () + ;; Special blocks + ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") + (save-excursion + (re-search-backward + (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) + (setq column (org-get-indentation (match-string 0)))) + ((and (not (looking-at "[ \t]*#\\+begin_")) + (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) + (save-excursion + (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) + (setq column + (cond ((equal (downcase (match-string 1)) "src") + ;; src blocks: let `org-edit-src-exit' handle them + (org-get-indentation)) + ((equal (downcase (match-string 1)) "example") + (max (org-get-indentation) + (org-get-indentation (match-string 0)))) + (t + (org-get-indentation (match-string 0)))))) + ;; This line has nothing special, look at the previous relevant + ;; line to compute indentation + (t + (beginning-of-line 0) + (while (and (not (bobp)) + (not (looking-at org-drawer-regexp)) + ;; When point started in an inline task, do not move + ;; above task starting line. + (not (and inline-task-p (looking-at inline-re))) + ;; Skip drawers, blocks, empty lines, verbatim, + ;; comments, tables, footnotes definitions, lists, + ;; inline tasks. + (or (and (looking-at "[ \t]*:END:") + (re-search-backward org-drawer-regexp nil t)) + (and (looking-at "[ \t]*#\\+end_") + (re-search-backward "[ \t]*#\\+begin_"nil t)) + (looking-at "[ \t]*[\n:#|]") + (looking-at org-footnote-definition-re) + (and (ignore-errors (goto-char (org-in-item-p))) + (goto-char + (org-list-get-top-point (org-list-struct)))) + (and (not inline-task-p) + (featurep 'org-inlinetask) + (org-inlinetask-in-task-p) + (or (org-inlinetask-goto-beginning) t)))) + (beginning-of-line 0)) + (cond + ;; There was an heading above. + ((looking-at "\\*+[ \t]+") + (if (not org-adapt-indentation) + (setq column 0) + (goto-char (match-end 0)) + (setq column (current-column)))) + ;; A drawer had started and is unfinished + ((looking-at org-drawer-regexp) + (goto-char (1- (match-beginning 1))) + (setq column (current-column))) + ;; Else, nothing noticeable found: get indentation and go on. + (t (setq column (org-get-indentation)))))) + ;; Now apply indentation and move cursor accordingly + (goto-char pos) + (if (<= (current-column) (current-indentation)) + (org-indent-line-to column) + (save-excursion (org-indent-line-to column))) + ;; Special polishing for properties, see `org-property-format' + (setq column (current-column)) + (beginning-of-line 1) + (if (looking-at + "\\([ \t]*\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") + (replace-match (concat (match-string 1) + (format org-property-format + (match-string 2) (match-string 3))) + t t)) + (org-move-to-column column)))) + +(defun org-indent-drawer () + "Indent the drawer at point." + (interactive) + (let ((p (point)) + (e (and (save-excursion (re-search-forward ":END:" nil t)) + (match-end 0))) + (folded + (save-excursion + (end-of-line) + (when (overlays-at (point)) + (member 'invisible (overlay-properties + (car (overlays-at (point))))))))) + (when folded (org-cycle)) + (indent-for-tab-command) + (while (and (move-beginning-of-line 2) (< (point) e)) + (indent-for-tab-command)) + (goto-char p) + (when folded (org-cycle))) + (message "Drawer at point indented")) + +(defun org-indent-block () + "Indent the block at point." + (interactive) + (let ((p (point)) + (case-fold-search t) + (e (and (save-excursion (re-search-forward "#\\+end_?\\(?:[a-z]+\\)?" nil t)) + (match-end 0))) + (folded + (save-excursion + (end-of-line) + (when (overlays-at (point)) + (member 'invisible (overlay-properties + (car (overlays-at (point))))))))) + (when folded (org-cycle)) + (indent-for-tab-command) + (while (and (move-beginning-of-line 2) (< (point) e)) + (indent-for-tab-command)) + (goto-char p) + (when folded (org-cycle))) + (message "Block at point indented")) + +(defun org-indent-region (start end) + "Indent region." + (interactive "r") + (save-excursion + (let ((line-end (org-current-line end))) + (goto-char start) + (while (< (org-current-line) line-end) + (cond ((org-in-src-block-p) (org-src-native-tab-command-maybe)) + (t (call-interactively 'org-indent-line))) + (move-beginning-of-line 2))))) + + +;;; Filling + +;; We use our own fill-paragraph and auto-fill functions. + +;; `org-fill-paragraph' relies on adaptive filling and context +;; checking. Appropriate `fill-prefix' is computed with +;; `org-adaptive-fill-function'. + +;; `org-auto-fill-function' takes care of auto-filling. It calls +;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with +;; `org-adaptive-fill-function' value. Internally, +;; `org-comment-line-break-function' breaks the line. + +;; `org-setup-filling' installs filling and auto-filling related +;; variables during `org-mode' initialization. + +(defun org-setup-filling () (interactive) - ;; In the paragraph separator we include headlines, because filling - ;; text in a line directly attached to a headline would otherwise - ;; fill the headline as well. - (org-set-local 'comment-start-skip "^#+[ \t]*") - (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|#]") - ;; The paragraph starter includes hand-formatted lists. - (org-set-local - 'paragraph-start - (concat - "\f" "\\|" - "[ ]*$" "\\|" - org-outline-regexp "\\|" - "[ \t]*#" "\\|" - (org-item-re) "\\|" - "[ \t]*[:|]" "\\|" - "\\$\\$" "\\|" - "\\\\\\(begin\\|end\\|[][]\\)")) - ;; Inhibit auto-fill for headers, tables and fixed-width lines. - ;; But only if the user has not turned off tables or fixed-width regions - (org-set-local - 'auto-fill-inhibit-regexp - (concat org-outline-regexp - "\\|#\\+" - "\\|[ \t]*" org-keyword-time-regexp - (if (or org-enable-table-editor org-enable-fixed-width-editor) - (concat - "\\|[ \t]*[" - (if org-enable-table-editor "|" "") - (if org-enable-fixed-width-editor ":" "") - "]")))) - ;; We use our own fill-paragraph function, to make sure that tables - ;; and fixed-width regions are not wrapped. That function will pass - ;; through to `fill-paragraph' when appropriate. - (org-set-local 'fill-paragraph-function 'org-fill-paragraph) ;; Prevent auto-fill from inserting unwanted new items. - (if (boundp 'fill-nobreak-predicate) - (org-set-local 'fill-nobreak-predicate - (if (memq 'org-fill-item-nobreak-p fill-nobreak-predicate) - fill-nobreak-predicate - (cons 'org-fill-item-nobreak-p fill-nobreak-predicate)))) - ;; Adaptive filling: To get full control, first make sure that - ;; `adaptive-fill-regexp' never matches. Then install our own matcher. - (unless (local-variable-p 'adaptive-fill-regexp (current-buffer)) - (org-set-local 'org-adaptive-fill-regexp-backup - adaptive-fill-regexp)) - (org-set-local 'adaptive-fill-regexp "\000") + (when (boundp 'fill-nobreak-predicate) + (org-set-local + 'fill-nobreak-predicate + (org-uniquify + (append fill-nobreak-predicate + '(org-fill-paragraph-separate-nobreak-p + org-fill-line-break-nobreak-p))))) + (org-set-local 'fill-paragraph-function 'org-fill-paragraph) + (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) - (org-set-local 'adaptive-fill-function - 'org-adaptive-fill-function) - (org-set-local - 'align-mode-rules-list - '((org-in-buffer-settings - (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") - (modes . '(org-mode)))))) + (org-set-local 'comment-line-break-function 'org-comment-line-break-function)) -(defun org-fill-item-nobreak-p () +(defvar org-element-paragraph-separate) ; org-element.el +(defun org-fill-paragraph-separate-nobreak-p () "Non-nil when a line break at point would insert a new item." - (and (looking-at (org-item-re)) (org-list-in-valid-context-p))) + (looking-at (substring org-element-paragraph-separate 1))) -(defun org-fill-paragraph (&optional justify) - "Re-align a table, pass through to fill-paragraph if no table." - (let ((table-p (org-at-table-p)) - (table.el-p (org-at-table.el-p)) - (itemp (org-in-item-p))) - (cond ((and (equal (char-after (point-at-bol)) ?*) - (save-excursion (goto-char (point-at-bol)) - (looking-at org-outline-regexp))) - t) ; skip headlines - (table.el-p t) ; skip table.el tables - (table-p (org-table-align) t) ; align Org tables - (itemp ; align text in items - (let* ((struct (save-excursion (goto-char itemp) - (org-list-struct))) - (parents (org-list-parents-alist struct)) - (children (org-list-get-children itemp struct parents)) - beg end prev next prefix) - ;; Determine in which part of item point is: before - ;; first child, after last child, between two - ;; sub-lists, or simply in item if there's no child. - (cond - ((not children) - (setq prefix (make-string (org-list-item-body-column itemp) ?\ ) - beg itemp - end (org-list-get-item-end itemp struct))) - ((< (point) (setq next (car children))) - (setq prefix (make-string (org-list-item-body-column itemp) ?\ ) - beg itemp - end next)) - ((> (point) (setq prev (car (last children)))) - (setq beg (org-list-get-item-end prev struct) - end (org-list-get-item-end itemp struct) - prefix (save-excursion - (goto-char beg) - (skip-chars-forward " \t") - (make-string (current-column) ?\ )))) - (t (catch 'exit - (while (setq next (pop children)) - (if (> (point) next) - (setq prev next) - (setq beg (org-list-get-item-end prev struct) - end next - prefix (save-excursion - (goto-char beg) - (skip-chars-forward " \t") - (make-string (current-column) ?\ ))) - (throw 'exit nil)))))) - ;; Use `fill-paragraph' with buffer narrowed to item - ;; without any child, and with our computed PREFIX. - (flet ((fill-context-prefix (from to &optional flr) prefix)) - (save-restriction - (narrow-to-region beg end) - (save-excursion (fill-paragraph justify)))) t)) - ;; Special case where point is not in a list but is on - ;; a paragraph adjacent to a list: make sure this paragraph - ;; doesn't get merged with the end of the list by narrowing - ;; buffer first. - ((save-excursion (forward-paragraph -1) - (setq itemp (org-in-item-p))) - (let ((struct (save-excursion (goto-char itemp) - (org-list-struct)))) - (save-restriction - (narrow-to-region (org-list-get-bottom-point struct) - (save-excursion (forward-paragraph 1) - (point))) - (fill-paragraph justify) t))) - ;; Else simply call `fill-paragraph'. - (t nil)))) - -;; For reference, this is the default value of adaptive-fill-regexp -;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" +(defun org-fill-line-break-nobreak-p () + "Non-nil when a line break at point would create an Org line break." + (save-excursion + (skip-chars-backward "[ \t]") + (skip-chars-backward "\\\\") + (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)"))) +(declare-function message-in-body-p "message" ()) +(defvar org-element--affiliated-re) ; From org-element.el (defun org-adaptive-fill-function () - "Return a fill prefix for org-mode files." - (let (itemp) + "Compute a fill prefix for the current line. +Return fill prefix, as a string, or nil if current line isn't +meant to be filled." + (org-with-wide-buffer + (unless (and (derived-mode-p 'message-mode) (not (message-in-body-p))) + ;; FIXME: This is really the job of orgstruct++-mode + (let* ((p (line-beginning-position)) + (element (save-excursion (beginning-of-line) + (org-element-at-point))) + (type (org-element-type element)) + (post-affiliated + (save-excursion + (goto-char (org-element-property :begin element)) + (while (looking-at org-element--affiliated-re) (forward-line)) + (point)))) + (unless (< p post-affiliated) + (case type + (comment (looking-at "[ \t]*# ?") (match-string 0)) + (footnote-definition "") + ((item plain-list) + (make-string (org-list-item-body-column post-affiliated) ? )) + (paragraph + ;; Fill prefix is usually the same as the current line, + ;; except if the paragraph is at the beginning of an item. + (let ((parent (org-element-property :parent element))) + (cond ((eq (org-element-type parent) 'item) + (make-string (org-list-item-body-column + (org-element-property :begin parent)) + ? )) + ((save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0)) + (t "")))) + (comment-block + ;; Only fill contents if P is within block boundaries. + (let* ((cbeg (save-excursion (goto-char post-affiliated) + (forward-line) + (point))) + (cend (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (when (and (>= p cbeg) (< p cend)) + (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0) + "")))))))))) + +(declare-function message-goto-body "message" ()) +(defvar message-cite-prefix-regexp) ; From message.el +(defvar org-element-all-objects) ; From org-element.el +(defun org-fill-paragraph (&optional justify) + "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. + +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. + +For convenience, when point is at a plain list, an item or +a footnote definition, try to fill the first paragraph within." + ;; Falls back on message-fill-paragraph when necessary + (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)))) + (let ((fill-paragraph-function + (cadadr (assoc 'fill-paragraph-function org-fb-vars))) + (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars))) + (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars))) + (paragraph-separate + (cadadr (assoc 'paragraph-separate org-fb-vars)))) + (fill-paragraph nil)) (save-excursion - (cond - ;; Comment line - ((looking-at "#[ \t]+") - (match-string-no-properties 0)) - ;; Plain list item - ((org-at-item-p) - (make-string (org-list-item-body-column (point-at-bol)) ?\ )) - ;; Point is in a list after `backward-paragraph': original - ;; point wasn't in the list, or filling would have been taken - ;; care of by `org-auto-fill-function', but the list and the - ;; real paragraph are not separated by a blank line. Thus, move - ;; point after the list to go back to real paragraph and - ;; determine fill-prefix. - ((setq itemp (org-in-item-p)) - (goto-char itemp) - (let* ((struct (org-list-struct)) - (bottom (org-list-get-bottom-point struct))) - (goto-char bottom) - (make-string (org-get-indentation) ?\ ))) - ;; Other text - ((looking-at org-adaptive-fill-regexp-backup) - (match-string-no-properties 0)))))) + ;; Move to end of line in order to get the first paragraph + ;; within a plain list or a footnote definition. + (end-of-line) + (let ((element (org-element-at-point))) + ;; First check if point is in a blank line at the beginning of + ;; the buffer. In that case, ignore filling. + (if (< (point) (org-element-property :begin element)) t + (case (org-element-type element) + ;; Align Org tables, leave table.el tables as-is. + (table-row (org-table-align) t) + (table + (when (eq (org-element-property :type element) 'org) + (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 (< (point) 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 + ;; consideration. For that, slice the paragraph + ;; using line breaks as separators, and fill the + ;; parts in reverse order to avoid messing with + ;; markers. + (save-excursion + (goto-char end) + (mapc + (lambda (pos) + (fill-region-as-paragraph pos (point) justify) + (goto-char pos)) + ;; Find the list of ending positions for line + ;; breaks in the current paragraph. Add paragraph + ;; beginning to include first slice. + (nreverse + (cons + beg + (org-element-map + (org-element--parse-objects + beg end nil org-element-all-objects) + 'line-break + (lambda (lb) (org-element-property :end lb))))))) + 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)))) + (when (and (>= (point) beg) (< (point) end)) + (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))) + t) + ;; Fill comments. + (comment (fill-comment-paragraph justify)) + ;; Ignore every other element. + (otherwise t))))))) (defun org-auto-fill-function () "Auto-fill function." - (let (itemp prefix) - ;; When in a list, compute an appropriate fill-prefix and make - ;; sure it will be used by `do-auto-fill'. - (if (setq itemp (org-in-item-p)) - (progn - (setq prefix (make-string (org-list-item-body-column itemp) ?\ )) - (flet ((fill-context-prefix (from to &optional flr) prefix)) - (do-auto-fill))) - ;; Else just use `do-auto-fill'. - (do-auto-fill)))) + ;; Check if auto-filling is meaningful. + (let ((fc (current-fill-column))) + (when (and fc (> (current-column) fc)) + (let ((fill-prefix (org-adaptive-fill-function))) + (when fill-prefix (do-auto-fill)))))) + +(defun org-comment-line-break-function (&optional soft) + "Break line at point and indent, continuing comment if within one. +The inserted newline is marked hard if variable +`use-hard-newlines' is true, unless optional argument SOFT is +non-nil." + (if soft (insert-and-inherit ?\n) (newline 1)) + (save-excursion (forward-char -1) (delete-horizontal-space)) + (delete-horizontal-space) + (indent-to-left-margin) + (insert-before-markers-and-inherit fill-prefix)) + + +;;; Comments + +;; 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 +;; example-block) don't accept comments. Usual Emacs comment commands +;; cannot cope with those requirements. Therefore, Org replaces them. + +;; Org still relies on `comment-dwim', but cannot trust +;; `comment-only-p'. So, `comment-region-function' and +;; `uncomment-region-function' both point +;; to`org-comment-or-uncomment-region'. Eventually, +;; `org-insert-comment' takes care of insertion of comments at the +;; beginning of line. + +;; `org-setup-comments-handling' install comments related variables +;; during `org-mode' initialization. + +(defun org-setup-comments-handling () + (interactive) + (org-set-local 'comment-use-syntax nil) + (org-set-local 'comment-start "# ") + (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)") + (org-set-local 'comment-insert-comment-function 'org-insert-comment) + (org-set-local 'comment-region-function 'org-comment-or-uncomment-region) + (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region)) + +(defun org-insert-comment () + "Insert an empty comment above current line. +If the line is empty, insert comment at its beginning." + (beginning-of-line) + (if (looking-at "\\s-*$") (replace-match "") (open-line 1)) + (org-indent-line) + (insert "# ")) + +(defvar comment-empty-lines) ; From newcomment.el. +(defun org-comment-or-uncomment-region (beg end &rest ignore) + "Comment or uncomment each non-blank line in the region. +Uncomment each non-blank line between BEG and END if it only +contains commented lines. Otherwise, comment them." + (save-restriction + ;; Restrict region + (narrow-to-region (save-excursion (goto-char beg) + (skip-chars-forward " \r\t\n" end) + (line-beginning-position)) + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n" beg) + (line-end-position))) + (let ((uncommentp + ;; UNCOMMENTP is non-nil when every non blank line between + ;; BEG and END is a comment. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) + (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'comment) + (goto-char (min (point-max) + (org-element-property + :end element))))))) + (eobp)))) + (if uncommentp + ;; Only blank lines and comments in region: uncomment it. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") + (replace-match "" nil nil nil 1)) + (forward-line))) + ;; Comment each line in region. + (let ((min-indent (point-max))) + ;; First find the minimum indentation across all lines. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) (not (zerop min-indent))) + (unless (looking-at "[ \t]*$") + (setq min-indent (min min-indent (current-indentation)))) + (forward-line))) + ;; Then loop over all lines. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) + (org-move-to-column min-indent t) + (insert comment-start)) + (forward-line)))))))) + ;;; Other stuff. @@ -20620,7 +21551,8 @@ depending on context." (if (or (eq org-ctrl-k-protect-subtree 'error) (not (y-or-n-p "Kill hidden subtree along with headline? "))) (error "C-k aborted - would kill hidden subtree"))) - (call-interactively 'kill-line)) + (call-interactively + (if (and (boundp 'visual-line-mode) visual-line-mode) 'kill-visual-line 'kill-line))) ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) (kill-region (point) (match-beginning 1)) (org-set-tags nil t)) @@ -20683,7 +21615,7 @@ interactive command with similar behavior." end) (if (and subtreep org-yank-adjusted-subtrees) (org-paste-subtree nil nil 'for-yank) - (call-interactively command)) + (call-interactively command)) (setq end (point)) (goto-char beg) @@ -20712,7 +21644,7 @@ interactive command with similar behavior." (org-paste-subtree nil nil 'for-yank) (push-mark beg 'nomsg))) (t - (call-interactively command)))))) + (call-interactively command)))))) (defun org-yank-folding-would-swallow-text (beg end) "Would hide-subtree at BEG swallow any text after END?" @@ -20756,13 +21688,6 @@ This version does not only check the character property, but also (error (error "Before first headline at position %d in buffer %s" (point) (current-buffer))))) -(defun org-beginning-of-defun () - "Go to the beginning of the subtree, i.e. back to the heading." - (org-back-to-heading)) -(defun org-end-of-defun () - "Go to the end of the subtree." - (org-end-of-subtree nil t)) - (defun org-before-first-heading-p () "Before first heading?" (save-excursion @@ -20774,12 +21699,24 @@ This version does not only check the character property, but also ;; Compatibility alias with Org versions < 7.8.03 (defalias 'org-on-heading-p 'org-at-heading-p) +(defun org-at-comment-p nil + "Is cursor in a line starting with a # character?" + (save-excursion + (beginning-of-line) + (looking-at "^#"))) + (defun org-at-drawer-p nil - "Whether point is at a drawer." + "Is cursor at a drawer keyword?" (save-excursion (move-beginning-of-line 1) (looking-at org-drawer-regexp))) +(defun org-at-block-p nil + "Is cursor at a block keyword?" + (save-excursion + (move-beginning-of-line 1) + (looking-at org-block-regexp))) + (defun org-point-at-end-of-empty-headline () "If point is at the end of an empty headline, return t, else nil. If the heading only contains a TODO keyword, it is still still considered @@ -20927,18 +21864,19 @@ If there is no such heading, return nil." nil (point))))) -(defun org-end-of-subtree (&optional invisible-OK to-heading) +(defun org-end-of-subtree (&optional invisible-ok to-heading) + "Goto to the end of a subtree." ;; This contains an exact copy of the original function, but it uses ;; `org-back-to-heading', to make it work also in invisible - ;; trees. And is uses an invisible-OK argument. + ;; trees. And is uses an invisible-ok argument. ;; Under Emacs this is not needed, but the old outline.el needs this fix. ;; Furthermore, when used inside Org, finding the end of a large subtree ;; with many children and grandchildren etc, this can be much faster ;; than the outline version. - (org-back-to-heading invisible-OK) + (org-back-to-heading invisible-ok) (let ((first t) (level (funcall outline-level))) - (if (and (eq major-mode 'org-mode) (< level 1000)) + (if (and (derived-mode-p 'org-mode) (< level 1000)) ;; A true heading (not a plain list item), in Org-mode ;; This means we can easily find the end by looking ;; only for the right number of stars. Using a regexp to do @@ -20963,7 +21901,7 @@ If there is no such heading, return nil." (defadvice outline-end-of-subtree (around prefer-org-version activate compile) "Use Org version in org-mode, for dramatic speed-up." - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (progn (org-end-of-subtree nil t) (unless (eobp) (backward-char 1))) @@ -20988,11 +21926,11 @@ clocking lines, and drawers." (and (re-search-forward "[^\n]" nil t) (backward-char 1)) (point))) -(defun org-forward-same-level (arg &optional invisible-ok) +(defun org-forward-heading-same-level (arg &optional invisible-ok) "Move forward to the arg'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. -Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil -it wil also look at invisible ones." +Normally this only looks at visible headings, but when INVISIBLE-OK is +non-nil it will also look at invisible ones." (interactive "p") (org-back-to-heading invisible-ok) (org-at-heading-p) @@ -21010,7 +21948,7 @@ it wil also look at invisible ones." (setq arg (1- arg))) (beginning-of-line 1))) -(defun org-backward-same-level (arg &optional invisible-ok) +(defun org-backward-heading-same-level (arg &optional invisible-ok) "Move backward to the arg'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading." (interactive "p") @@ -21028,6 +21966,211 @@ Stop at the first and last subheadings of a superior heading." (if (< l level) (setq arg 1))) (setq arg (1- arg))))) +;;;###autoload +(defun org-forward-element () + "Move forward by one element. +Move to the next element at the same level, when possible." + (interactive) + (cond ((eobp) (error "Cannot move further down")) + ((org-with-limited-levels (org-at-heading-p)) + (let ((origin (point))) + (org-forward-heading-same-level 1) + (unless (org-with-limited-levels (org-at-heading-p)) + (goto-char origin) + (error "Cannot move further down")))) + (t + (let* ((elem (org-element-at-point)) + (end (org-element-property :end elem)) + (parent (org-element-property :parent elem))) + (if (and parent (= (org-element-property :contents-end parent) end)) + (goto-char (org-element-property :end parent)) + (goto-char end)))))) + +;;;###autoload +(defun org-backward-element () + "Move backward by one element. +Move to the previous element at the same level, when possible." + (interactive) + (cond ((bobp) (error "Cannot move further up")) + ((org-with-limited-levels (org-at-heading-p)) + ;; At an headline, move to the previous one, if any, or stay + ;; here. + (let ((origin (point))) + (org-backward-heading-same-level 1) + (unless (org-with-limited-levels (org-at-heading-p)) + (goto-char origin) + (error "Cannot move further up")))) + (t + (let* ((trail (org-element-at-point 'keep-trail)) + (elem (car trail)) + (prev-elem (nth 1 trail)) + (beg (org-element-property :begin elem))) + (cond + ;; Move to beginning of current element if point isn't + ;; there already. + ((/= (point) beg) (goto-char beg)) + (prev-elem (goto-char (org-element-property :begin prev-elem))) + ((org-before-first-heading-p) (goto-char (point-min))) + (t (org-back-to-heading))))))) + +;;;###autoload +(defun org-up-element () + "Move to upper element." + (interactive) + (if (org-with-limited-levels (org-at-heading-p)) + (unless (org-up-heading-safe) (error "No surrounding element")) + (let* ((elem (org-element-at-point)) + (parent (org-element-property :parent elem))) + (if parent (goto-char (org-element-property :begin parent)) + (if (org-with-limited-levels (org-before-first-heading-p)) + (error "No surrounding element") + (org-with-limited-levels (org-back-to-heading))))))) + +;;;###autoload +(defvar org-element-greater-elements) +(defun org-down-element () + "Move to inner element." + (interactive) + (let ((element (org-element-at-point))) + (cond + ((memq (org-element-type element) '(plain-list table)) + (goto-char (org-element-property :contents-begin element)) + (forward-char)) + ((memq (org-element-type element) org-element-greater-elements) + ;; If contents are hidden, first disclose them. + (when (org-element-property :hiddenp element) (org-cycle)) + (goto-char (or (org-element-property :contents-begin element) + (error "No content for this element")))) + (t (error "No inner element"))))) + +;;;###autoload +(defun org-drag-element-backward () + "Move backward element at point." + (interactive) + (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up) + (let* ((trail (org-element-at-point 'keep-trail)) + (elem (car trail)) + (prev-elem (nth 1 trail))) + ;; Error out if no previous element or previous element is + ;; a parent of the current one. + (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) + (error "Cannot drag element backward") + (let ((pos (point))) + (org-element-swap-A-B prev-elem elem) + (goto-char (+ (org-element-property :begin prev-elem) + (- pos (org-element-property :begin elem))))))))) + +;;;###autoload +(defun org-drag-element-forward () + "Move forward element at point." + (interactive) + (let* ((pos (point)) + (elem (org-element-at-point))) + (when (= (point-max) (org-element-property :end elem)) + (error "Cannot drag element forward")) + (goto-char (org-element-property :end elem)) + (let ((next-elem (org-element-at-point))) + (when (or (org-element-nested-p elem next-elem) + (and (eq (org-element-type next-elem) 'headline) + (not (eq (org-element-type elem) 'headline)))) + (goto-char pos) + (error "Cannot drag element forward")) + ;; Compute new position of point: it's shifted by NEXT-ELEM + ;; body's length (without final blanks) and by the length of + ;; blanks between ELEM and NEXT-ELEM. + (let ((size-next (- (save-excursion + (goto-char (org-element-property :end next-elem)) + (skip-chars-backward " \r\t\n") + (forward-line) + ;; Small correction if buffer doesn't end + ;; with a newline character. + (if (and (eolp) (not (bolp))) (1+ (point)) (point))) + (org-element-property :begin next-elem))) + (size-blank (- (org-element-property :end elem) + (save-excursion + (goto-char (org-element-property :end elem)) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))))) + (org-element-swap-A-B elem next-elem) + (goto-char (+ pos size-next size-blank)))))) + +;;;###autoload +(defun org-mark-element () + "Put point at beginning of this element, mark at end. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next element after the +ones already marked." + (interactive) + (let (deactivate-mark) + (if (and (org-called-interactively-p 'any) + (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active))) + (set-mark + (save-excursion + (goto-char (mark)) + (goto-char (org-element-property :end (org-element-at-point))))) + (let ((element (org-element-at-point))) + (end-of-line) + (push-mark (org-element-property :end element) t t) + (goto-char (org-element-property :begin element)))))) + +;;;###autoload +(defun org-narrow-to-element () + "Narrow buffer to current element." + (interactive) + (let ((elem (org-element-at-point))) + (cond + ((eq (car elem) 'headline) + (narrow-to-region + (org-element-property :begin elem) + (org-element-property :end elem))) + ((memq (car elem) org-element-greater-elements) + (narrow-to-region + (org-element-property :contents-begin elem) + (org-element-property :contents-end elem))) + (t + (narrow-to-region + (org-element-property :begin elem) + (org-element-property :end elem)))))) + +;;;###autoload +(defun org-transpose-element () + "Transpose current and previous elements, keeping blank lines between. +Point is moved after both elements." + (interactive) + (org-skip-whitespace) + (let ((end (org-element-property :end (org-element-at-point)))) + (org-drag-element-backward) + (goto-char end))) + +;;;###autoload +(defun org-unindent-buffer () + "Un-indent the visible part of the buffer. +Relative indentation (between items, inside blocks, etc.) isn't +modified." + (interactive) + (unless (eq major-mode 'org-mode) + (error "Cannot un-indent a buffer not in Org mode")) + (let* ((parse-tree (org-element-parse-buffer 'greater-element)) + unindent-tree ; For byte-compiler. + (unindent-tree + (function + (lambda (contents) + (mapc + (lambda (element) + (if (memq (org-element-type element) '(headline section)) + (funcall unindent-tree (org-element-contents element)) + (save-excursion + (save-restriction + (narrow-to-region + (org-element-property :begin element) + (org-element-property :end element)) + (org-do-remove-indentation))))) + (reverse contents)))))) + (funcall unindent-tree (org-element-contents parse-tree)))) + (defun org-show-subtree () "Show everything after this heading at deeper levels." (interactive) @@ -21059,12 +22202,10 @@ Show the heading too, if it is currently invisible." (defun org-make-options-regexp (kwds &optional extra) "Make a regular expression for keyword lines." (concat - "^" - "#?[ \t]*\\+\\(" + "^#\\+\\(" (mapconcat 'regexp-quote kwds "\\|") (if extra (concat "\\|" extra)) - "\\):[ \t]*" - "\\(.*\\)")) + "\\):[ \t]*\\(.*\\)")) ;; Make isearch reveal the necessary context (defun org-isearch-end () @@ -21136,7 +22277,7 @@ Show the heading too, if it is currently invisible." '(progn (add-hook 'imenu-after-jump-hook (lambda () - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (org-show-context 'org-goto)))))) (defun org-link-display-format (link) @@ -21144,11 +22285,11 @@ Show the heading too, if it is currently invisible." if no description is present" (save-match-data (if (string-match org-bracket-link-analytic-regexp link) - (replace-match (if (match-end 5) - (match-string 5 link) - (concat (match-string 1 link) - (match-string 3 link))) - nil t link) + (replace-match (if (match-end 5) + (match-string 5 link) + (concat (match-string 1 link) + (match-string 3 link))) + nil t link) link))) (defun org-toggle-link-display () @@ -21167,9 +22308,9 @@ if no description is present" (defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1) "Overlay marking the agenda restriction line in speedbar.") (overlay-put org-speedbar-restriction-lock-overlay - 'face 'org-agenda-restriction-lock) + 'face 'org-agenda-restriction-lock) (overlay-put org-speedbar-restriction-lock-overlay - 'help-echo "Agendas are currently limited to this item.") + 'help-echo "Agendas are currently limited to this item.") (org-detach-overlay org-speedbar-restriction-lock-overlay) (defun org-speedbar-set-agenda-restriction () @@ -21197,7 +22338,7 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (with-current-buffer (find-file-noselect (let ((default-directory dir)) (expand-file-name txt))) - (unless (eq major-mode 'org-mode) + (unless (derived-mode-p 'org-mode) (error "Cannot restrict to non-Org-mode file")) (org-agenda-set-restriction-lock 'file))) (t (error "Don't know how to restrict Org-mode's agenda"))) @@ -21214,7 +22355,7 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) (add-hook 'speedbar-visiting-tag-hook - (lambda () (and (eq major-mode 'org-mode) (org-show-context 'org-goto)))))) + (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto)))))) ;;; Fixes and Hacks for problems with other packages @@ -21228,7 +22369,9 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (not (get-text-property pos 'org-no-flyspell)) (not (member word org-todo-keywords-1)) (not (member word org-all-time-keywords)) - (not (member word org-additional-option-like-keywords))))) + (not (member word org-options-keywords)) + (not (member word (mapcar 'car org-startup-options))) + (not (member word org-additional-option-like-keywords-for-flyspell))))) (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region." @@ -21257,12 +22400,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (eval-after-load "ecb" '(defadvice ecb-method-clicked (after esf/org-show-context activate) "Make hierarchy visible when jumping into location from ECB tree buffer." - (if (eq major-mode 'org-mode) + (if (derived-mode-p 'org-mode) (org-show-context)))) (defun org-bookmark-jump-unhide () "Unhide the current position, to show the bookmark location." - (and (eq major-mode 'org-mode) + (and (derived-mode-p 'org-mode) (or (outline-invisible-p) (save-excursion (goto-char (max (point-min) (1- (point)))) (outline-invisible-p))) |