From f65024c0e09eef4781e808ab2b028a87e5ff483d Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sun, 9 Jun 2024 13:06:28 -0400 Subject: [PATCH] Update to Org 9.7.3 (cherry picked from commit 5a125fb5a9736bd3c67cf6ff9acc185d8e2260e2) --- doc/misc/org.org | 2412 ++++++++----- etc/ORG-NEWS | 1697 +++++++++- etc/refcards/orgcard.tex | 23 +- lisp/org/ob-C.el | 57 +- lisp/org/ob-R.el | 51 +- lisp/org/ob-awk.el | 16 +- lisp/org/ob-calc.el | 32 +- lisp/org/ob-clojure.el | 170 +- lisp/org/ob-comint.el | 149 +- lisp/org/ob-core.el | 640 ++-- lisp/org/ob-css.el | 2 +- lisp/org/ob-ditaa.el | 4 +- lisp/org/ob-dot.el | 11 +- lisp/org/ob-emacs-lisp.el | 22 +- lisp/org/ob-eshell.el | 5 +- lisp/org/ob-eval.el | 17 +- lisp/org/ob-exp.el | 444 +-- lisp/org/ob-forth.el | 5 +- lisp/org/ob-fortran.el | 34 +- lisp/org/ob-gnuplot.el | 35 +- lisp/org/ob-groovy.el | 8 +- lisp/org/ob-haskell.el | 224 +- lisp/org/ob-java.el | 6 +- lisp/org/ob-js.el | 15 +- lisp/org/ob-julia.el | 35 +- lisp/org/ob-latex.el | 34 +- lisp/org/ob-lilypond.el | 123 +- lisp/org/ob-lisp.el | 70 +- lisp/org/ob-lob.el | 4 +- lisp/org/ob-lua.el | 98 +- lisp/org/ob-makefile.el | 3 +- lisp/org/ob-maxima.el | 123 +- lisp/org/ob-ocaml.el | 7 +- lisp/org/ob-octave.el | 41 +- lisp/org/ob-org.el | 16 +- lisp/org/ob-plantuml.el | 1 + lisp/org/ob-processing.el | 7 +- lisp/org/ob-python.el | 450 ++- lisp/org/ob-ref.el | 12 +- lisp/org/ob-ruby.el | 56 +- lisp/org/ob-scheme.el | 119 +- lisp/org/ob-screen.el | 4 +- lisp/org/ob-shell.el | 120 +- lisp/org/ob-sql.el | 10 +- lisp/org/ob-sqlite.el | 21 +- lisp/org/ob-table.el | 24 +- lisp/org/ob-tangle.el | 133 +- lisp/org/oc-basic.el | 186 +- lisp/org/oc-biblatex.el | 36 +- lisp/org/oc-bibtex.el | 2 +- lisp/org/oc-csl.el | 186 +- lisp/org/oc-natbib.el | 23 +- lisp/org/oc.el | 222 +- lisp/org/ol-bbdb.el | 10 +- lisp/org/ol-bibtex.el | 61 +- lisp/org/ol-docview.el | 13 +- lisp/org/ol-doi.el | 3 +- lisp/org/ol-eshell.el | 11 +- lisp/org/ol-eww.el | 3 +- lisp/org/ol-gnus.el | 36 +- lisp/org/ol-info.el | 20 +- lisp/org/ol-irc.el | 2 +- lisp/org/ol-man.el | 50 +- lisp/org/ol-mhe.el | 2 +- lisp/org/ol-rmail.el | 2 +- lisp/org/ol.el | 663 ++-- lisp/org/org-agenda.el | 2195 ++++++------ lisp/org/org-archive.el | 30 +- lisp/org/org-attach.el | 161 +- lisp/org/org-capture.el | 105 +- lisp/org/org-clock.el | 267 +- lisp/org/org-colview.el | 243 +- lisp/org/org-compat.el | 236 +- lisp/org/org-crypt.el | 62 +- lisp/org/org-ctags.el | 109 +- lisp/org/org-cycle.el | 73 +- lisp/org/org-datetree.el | 65 +- lisp/org/org-duration.el | 207 +- lisp/org/org-element-ast.el | 1150 +++++++ lisp/org/org-element.el | 6344 +++++++++++++++++++---------------- lisp/org/org-entities.el | 8 +- lisp/org/org-faces.el | 8 + lisp/org/org-feed.el | 12 +- lisp/org/org-fold-core.el | 347 +- lisp/org/org-fold.el | 170 +- lisp/org/org-footnote.el | 73 +- lisp/org/org-goto.el | 24 +- lisp/org/org-habit.el | 11 +- lisp/org/org-id.el | 297 +- lisp/org/org-indent.el | 15 +- lisp/org/org-inlinetask.el | 13 +- lisp/org/org-keys.el | 160 +- lisp/org/org-lint.el | 617 +++- lisp/org/org-list.el | 394 ++- lisp/org/org-macro.el | 40 +- lisp/org/org-macs.el | 561 +++- lisp/org/org-mobile.el | 14 +- lisp/org/org-mouse.el | 41 +- lisp/org/org-num.el | 10 +- lisp/org/org-pcomplete.el | 61 +- lisp/org/org-persist.el | 635 +++- lisp/org/org-plot.el | 8 +- lisp/org/org-protocol.el | 27 +- lisp/org/org-refile.el | 195 +- lisp/org/org-src.el | 343 +- lisp/org/org-table.el | 570 ++-- lisp/org/org-tempo.el | 6 +- lisp/org/org-timer.el | 61 +- lisp/org/org-version.el | 4 +- lisp/org/org.el | 5309 +++++++++++++++++------------ lisp/org/ox-ascii.el | 134 +- lisp/org/ox-beamer.el | 154 +- lisp/org/ox-html.el | 318 +- lisp/org/ox-icalendar.el | 425 ++- lisp/org/ox-koma-letter.el | 22 +- lisp/org/ox-latex.el | 656 ++-- lisp/org/ox-man.el | 56 +- lisp/org/ox-md.el | 66 +- lisp/org/ox-odt.el | 320 +- lisp/org/ox-org.el | 43 +- lisp/org/ox-publish.el | 160 +- lisp/org/ox-texinfo.el | 161 +- lisp/org/ox.el | 1934 ++++++----- 123 files changed, 21853 insertions(+), 12998 deletions(-) create mode 100644 lisp/org/org-element-ast.el diff --git a/doc/misc/org.org b/doc/misc/org.org index 05ab5b36ca0..5423cf59759 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -2,6 +2,7 @@ #+subtitle: Release {{{version}}} #+author: The Org Mode Developers #+language: en +#+startup: literallinks #+texinfo: @insertcopying @@ -22,6 +23,9 @@ Org Mode is an authoring tool and a TODO lists manager for GNU Emacs. It relies on a lightweight plain-text markup language used in files with the =.org= extension. +Authoring Org files is best supported by Emacs, but you can view, +understand, and change them with any text editor. + As an authoring tool, Org helps you write structured documents and provides exporting facilities. Org files can also be used for literate programming and reproducible research. As a TODO lists manager, Org @@ -96,6 +100,10 @@ When installing Org on top of the pre-packaged version, please note that Org stable versions are meant to be fully compatible with the last three stable versions of Emacs but not with older Emacsen. +Some Org components also depend on third-party packages available +through package archives. Org is only guaranteed to be compatible +with the latest stable versions of these third-party packages. + *** Using Emacs packaging system :PROPERTIES: :UNNUMBERED: notoc @@ -112,6 +120,16 @@ visited, i.e., where no Org built-in function have been loaded. Otherwise autoload Org functions will mess up the installation. #+end_quote +To avoid interference with built-in Org mode, you can use command line: + +#+begin_src sh +emacs -Q -batch -eval "(progn (require 'package) (package-initialize) (package-refresh-contents) (package-upgrade 'org))" +#+end_src + +This approach has the advantage of isolating the upgrade process from +a running Emacs session, ensuring that version conflicts can not +arise. + *** Using Org's git repository :PROPERTIES: :UNNUMBERED: notoc @@ -184,7 +202,7 @@ For a better experience, the three Org commands ~org-store-link~, Emacs, not just in Org buffers. To that effect, you need to bind them to globally available keys, like the ones reserved for users (see [[info:elisp::Key Binding Conventions]]). Here are suggested bindings, -please modify the keys to your own liking. +please modify the keys to your own liking in your [[info:emacs#Init File][personal init file]]. #+begin_src emacs-lisp (global-set-key (kbd "C-c l") #'org-store-link) @@ -215,8 +233,12 @@ region by using the mouse to select a region, or pressing :DESCRIPTION: Bug reports, ideas, patches, etc. :END: #+cindex: feedback +#+cindex: contact #+cindex: bug reports #+cindex: reporting a bug +#+cindex: request a feature +#+cindex: feature requests +#+cindex: ideas #+cindex: maintainer #+cindex: author @@ -295,8 +317,17 @@ information about: 2. What did you expect to happen? 3. What happened instead? -Thank you for helping to improve this program. +#+cindex: performance +#+cindex: profile +#+cindex: slow +#+cindex: slowdown +#+cindex: laggy +#+cindex: not responsive +If you experience degraded performance, you can record a "profile" and +share it on the Org mailing list. See below for the instructions how +to record a useful profile. +Thank you for helping to improve this program. *** How to create a useful backtrace :PROPERTIES: :UNNUMBERED: notoc @@ -332,6 +363,67 @@ error occurred. Here is how to produce a useful backtrace: screen. Save this buffer to a file---for example using {{{kbd(C-x C-w)}}}---and attach it to your bug report. +*** How to profile Org performance +:PROPERTIES: +:UNNUMBERED: notoc +:END: + +#+cindex: profiler +Sometimes, Org is becoming slow for no apparent reason. Such slowdown +is often caused by interaction between third-party packages and Org +mode. However, identifying the root cause is not always straightforward. + +Emacs is able to record performance statistics, which can then be used +to find out which functions are taking most of the time to execute. +To record the statistics, one can use so-called profiler. To use the +Emacs profiler, we recommend the following steps: + +1. Make sure that no profiler is currently active: + + : M-x profiler-stop + +2. Start a new CPU profiler session: + + : M-x profiler-start cpu + +3. Use Emacs as usual, performing the actions that are deemed slow. + +4. Display and examine the recorded performance statistics: + + : M-x profiler-report + + This command will display a summary of the commands and functions + that have been executed between ~profiler-start~ and + ~profiler-report~ invocations, with command taking most of the time + displayed on top. + + == key can be used to fold and unfold lines in the profiler + buffer. The child items revealed upon unfolding are the functions + and commands called by the unfolded parent. + + The root causes are often buried deep inside sub-children items in + the profiler. You can press =B= (~profiler-report-render-reversed-calltree~) + to quickly reveal the actual function/command that takes most of + the time to run. + + Pressing =C= ~profiler-report-render-calltree~ will recover the + original view. + +5. If you need further help, you can share the statistics data. + + Just save the data by issuing + + : M-x profiler-report-write-profile + : /path/to/profile-file-to-be-saved + + Then, you can attached the saved file to your email to the Org + mailing list, alongside with details about what you did to trigger + the slowdown. + + Note that the saved statistics will only contain the function names + and how long their execution takes. No private data will be + recorded. + ** Typesetting Conventions Used in this Manual :PROPERTIES: :DESCRIPTION: Typesetting conventions used in this manual. @@ -430,7 +522,7 @@ as a title for your own headings. Some people find the many stars too noisy and would prefer an outline that has whitespace followed by a single star as headline starters. -This can be achieved using a Org Indent minor mode. See [[*A Cleaner +This can be achieved using an Org Indent minor mode. See [[*A Cleaner Outline View]] for more information. Headlines are not numbered. However, you may want to dynamically @@ -618,11 +710,17 @@ for this property are =folded=, =children=, =content=, and =all=. #+cindex: edits, catching invisible #+vindex: org-fold-catch-invisible-edits +#+vindex: org-fold-catch-invisible-edits-commands Sometimes you may inadvertently edit an invisible part of the buffer and be confused on what has been edited and how to undo the mistake. -Setting ~org-fold-catch-invisible-edits~ to non-~nil~ helps preventing -this. See the docstring of this option on how Org should catch -invisible edits and process them. +By default, Org prevents such edits for a limited set of user +commands. Users can control which commands are affected by +customizing ~org-fold-catch-invisible-edits-commands~. + +The strategy used to decide if a given edit is dangerous is controlled +by ~org-fold-catch-invisible-edits~. See the docstring of this option +on the available strategies. Set the option to ~nil~ to disable +catching invisible edits completely. ** Motion :PROPERTIES: @@ -833,7 +931,9 @@ The following commands jump to other headlines in the buffer. Yank subtree from kill ring. This does modify the level of the subtree to make sure the tree fits in nicely at the yank position. The yank level can also be specified with a numeric prefix argument, - or by yanking after a headline marker like =****=. + or by yanking after a headline marker like =****=. With + {{{kbd(C-u)}}} prefix, force inserting as a sibling. With + {{{kbd(C-u C-u)}}} prefix argument, force inserting as a child. - {{{kbd(C-y)}}} (~org-yank~) :: @@ -1062,6 +1162,7 @@ My favorite scenes are (in this order) 3. Peter Jackson being shot by Legolas - on DVD only He makes a really funny face when it happens. +8. [@8] But in the end, no individual scenes matter but the film as a whole. Important actors in this film are: - Elijah Wood :: He plays Frodo @@ -2255,6 +2356,17 @@ to read than the equivalent: : '(substring $1 (string-to-number $2) (string-to-number $3)) +When the formula itself contains =;= symbol, Org mode may incorrectly +interpret everything past =;= as format specifier: + +: '(concat $1 ";") + +#+texinfo: @noindent +You can put an extra tailing =;= to indicate that all the earlier +instances of =;= belong to the formula itself: + +: '(concat $1 ";"); + *** Durations and time values :PROPERTIES: :DESCRIPTION: How to compute durations and time values. @@ -2903,6 +3015,11 @@ For more information and examples see the [[https://orgmode.org/worg/org-tutoria Specify which column of the table to use as the =x= axis. +- =timeind= :: + + Specify which column of the table to use as the =x= axis as a time + value. + - =deps= :: Specify the columns to graph as a Lisp style list, surrounded by @@ -2910,7 +3027,7 @@ For more information and examples see the [[https://orgmode.org/worg/org-tutoria the third and fourth columns. Defaults to graphing all other columns aside from the =ind= column. -- transpose :: +- =transpose= :: When =y=, =yes=, or =t= attempt to transpose the table data before plotting. Also recognizes the shorthand option =trans=. @@ -2945,21 +3062,21 @@ For more information and examples see the [[https://orgmode.org/worg/org-tutoria When plotting =3d= or =grid= types, set this to =t= to graph a flat mapping rather than a =3d= slope. -- min :: +- =min= :: Provides a minimum axis value that may be used by a plot type. Implicitly assumes the =y= axis is being referred to. Can explicitly provide a value for a either the =x= or =y= axis with =xmin= and =ymin=. -- max :: +- =max= :: Provides a maximum axis value that may be used by a plot type. Implicitly assumes the =y= axis is being referred to. Can explicitly provide a value for a either the =x= or =y= axis with =xmax= and =ymax=. -- ticks :: +- =ticks= :: Provides a desired number of axis ticks to display, that may be used by a plot type. If none is given a plot type that requires ticks @@ -3088,7 +3205,8 @@ precise behavior depends on how point arrived there---see incomplete and the internals are again displayed as plain text. Inserting the missing bracket hides the link internals again. To show the internal structure of all links, use the menu: Org \rarr -Hyperlinks \rarr Literal links. +Hyperlinks \rarr Literal links, customize ~org-link-descriptive~, or use +=literallinks= [[*Summary of In-Buffer Settings][startup option]]. ** Internal Links :PROPERTIES: @@ -3212,10 +3330,6 @@ Here is the full set of built-in link types: File links. File name may be remote, absolute, or relative. - Additionally, you can specify a line number, or a text search. - In Org files, you may link to a headline name, a custom ID, or a - code reference instead. - As a special case, "file" prefix may be omitted if the file name is complete, e.g., it starts with =./=, or =/=. @@ -3279,44 +3393,50 @@ Here is the full set of built-in link types: Execute a shell command upon activation. + +For =file:= and =id:= links, you can additionally specify a line +number, or a text search string, separated by =::=. In Org files, you +may link to a headline name, a custom ID, or a code reference instead. + The following table illustrates the link types above, along with their options: -| Link Type | Example | -|------------+----------------------------------------------------------| -| http | =http://staff.science.uva.nl/c.dominik/= | -| https | =https://orgmode.org/= | -| doi | =doi:10.1000/182= | -| file | =file:/home/dominik/images/jupiter.jpg= | -| | =/home/dominik/images/jupiter.jpg= (same as above) | -| | =file:papers/last.pdf= | -| | =./papers/last.pdf= (same as above) | -| | =file:/ssh:me@some.where:papers/last.pdf= (remote) | -| | =/ssh:me@some.where:papers/last.pdf= (same as above) | -| | =file:sometextfile::NNN= (jump to line number) | -| | =file:projects.org= | -| | =file:projects.org::some words= (text search)[fn:12] | -| | =file:projects.org::*task title= (headline search) | -| | =file:projects.org::#custom-id= (headline search) | -| attachment | =attachment:projects.org= | -| | =attachment:projects.org::some words= (text search) | -| docview | =docview:papers/last.pdf::NNN= | -| id | =id:B7423F4D-2E8A-471B-8810-C40F074717E9= | -| news | =news:comp.emacs= | -| mailto | =mailto:adent@galaxy.net= | -| mhe | =mhe:folder= (folder link) | -| | =mhe:folder#id= (message link) | -| rmail | =rmail:folder= (folder link) | -| | =rmail:folder#id= (message link) | -| gnus | =gnus:group= (group link) | -| | =gnus:group#id= (article link) | -| bbdb | =bbdb:R.*Stallman= (record with regexp) | -| irc | =irc:/irc.com/#emacs/bob= | -| help | =help:org-store-link= | -| info | =info:org#External links= | -| shell | =shell:ls *.org= | -| elisp | =elisp:(find-file "Elisp.org")= (Elisp form to evaluate) | -| | =elisp:org-agenda= (interactive Elisp command) | +| Link Type | Example | +|------------+--------------------------------------------------------------------| +| http | =http://staff.science.uva.nl/c.dominik/= | +| https | =https://orgmode.org/= | +| doi | =doi:10.1000/182= | +| file | =file:/home/dominik/images/jupiter.jpg= | +| | =/home/dominik/images/jupiter.jpg= (same as above) | +| | =file:papers/last.pdf= | +| | =./papers/last.pdf= (same as above) | +| | =file:/ssh:me@some.where:papers/last.pdf= (remote) | +| | =/ssh:me@some.where:papers/last.pdf= (same as above) | +| | =file:sometextfile::NNN= (jump to line number) | +| | =file:projects.org= | +| | =file:projects.org::some words= (text search)[fn:12] | +| | =file:projects.org::*task title= (headline search) | +| | =file:projects.org::#custom-id= (headline search) | +| attachment | =attachment:projects.org= | +| | =attachment:projects.org::some words= (text search) | +| docview | =docview:papers/last.pdf::NNN= | +| id | =id:B7423F4D-2E8A-471B-8810-C40F074717E9= | +| | =id:B7423F4D-2E8A-471B-8810-C40F074717E9::*task= (headline search) | +| news | =news:comp.emacs= | +| mailto | =mailto:adent@galaxy.net= | +| mhe | =mhe:folder= (folder link) | +| | =mhe:folder#id= (message link) | +| rmail | =rmail:folder= (folder link) | +| | =rmail:folder#id= (message link) | +| gnus | =gnus:group= (group link) | +| | =gnus:group#id= (article link) | +| bbdb | =bbdb:R.*Stallman= (record with regexp) | +| irc | =irc:/irc.com/#emacs/bob= | +| help | =help:org-store-link= | +| info | =info:org#External links= | +| shell | =shell:ls *.org= | +| elisp | =elisp:(find-file "Elisp.org")= (Elisp form to evaluate) | +| | =elisp:org-agenda= (interactive Elisp command) | #+cindex: VM links #+cindex: Wanderlust links @@ -3377,8 +3497,9 @@ current buffer: - /Org mode buffers/ :: For Org files, if there is a =<>= at point, the link points - to the target. Otherwise it points to the current headline, which - is also the description. + to the target. If there is a named block (using =#+name:=) at + point, the link points to that name. Otherwise it points to the + current headline, which is also the description. #+vindex: org-id-link-to-org-use-id #+cindex: @samp{CUSTOM_ID}, property @@ -3396,6 +3517,32 @@ current buffer: timestamp, depending on ~org-id-method~. Later, when inserting the link, you need to decide which one to use. + #+vindex: org-id-link-consider-parent-id + #+vindex: org-id-link-use-context + #+vindex: org-link-context-for-files + When ~org-id-link-consider-parent-id~ is ~t~[fn:: Also, + ~org-link-context-for-files~ and ~org-id-link-use-context~ should be + both enabled (which they are, by default).], parent =ID= properties + are considered. This allows linking to specific targets, named + blocks, or headlines (which may not have a globally unique =ID= + themselves) within the context of a parent headline or file which + does. + + For example, given this org file: + + #+begin_src org + ,* Parent + :PROPERTIES: + :ID: abc + :END: + ,** Child 1 + ,** Child 2 + #+end_src + + Storing a link with point at "Child 1" will produce a link + ==, which precisely links to the "Child 1" + headline even though it does not have its own ID. + - /Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus/ :: #+vindex: org-link-email-description-format @@ -3675,7 +3822,9 @@ the link completion function like this: :ALT_TITLE: Search Options :END: #+cindex: search option in file links +#+cindex: search option in id links #+cindex: file links, searching +#+cindex: id links, searching #+cindex: attachment links, searching File links can contain additional information to make Emacs jump to a @@ -3687,8 +3836,8 @@ example, when the command ~org-store-link~ creates a link (see line as a search string that can be used to find this line back later when following the link with {{{kbd(C-c C-o)}}}. -Note that all search options apply for Attachment links in the same -way that they apply for File links. +Note that all search options apply for Attachment and ID links in the +same way that they apply for File links. Here is the syntax of the different ways to attach a search to a file link, together with explanations for each: @@ -4023,10 +4172,9 @@ meaning here.]. For example: (sequence "|" "CANCELED(c)"))) #+end_src -#+vindex: org-fast-tag-selection-include-todo If you then press {{{kbd(C-c C-t)}}} followed by the selection key, the entry is switched to this state. {{{kbd(SPC)}}} can be used to -remove any TODO keyword from an entry[fn:15]. +remove any TODO keyword from an entry. *** Setting up keywords for individual files :PROPERTIES: @@ -4282,7 +4430,7 @@ example, with the setting You not only define global TODO keywords and fast access keys, but also request that a time is recorded when the entry is set to =DONE=, and that a note is recorded when switching to =WAIT= or -=CANCELED=[fn:16]. The setting for =WAIT= is even more special: the +=CANCELED=[fn:15]. The setting for =WAIT= is even more special: the =!= after the slash means that in addition to the note taken when entering the state, a timestamp should be recorded when /leaving/ the =WAIT= state, if and only if the /target/ state does not configure @@ -4344,8 +4492,10 @@ A habit has the following properties: 3. The TODO has a scheduled date, usually with a =.+= style repeat interval. A =++= style may be appropriate for habits with time - constraints, e.g., must be done on weekends, or a =+= style for an - unusual habit that can have a backlog, e.g., weekly reports. + constraints, e.g., must be done on specific days of week (=++1w=), + or a =+= style for an unusual habit that can have a backlog, e.g., + weekly reports. See [[*Repeated tasks]] for more details about repeat + intervals. 4. The TODO may also have minimum and maximum ranges specified by using the syntax =.+2d/3d=, which says that you want to do the task @@ -4578,7 +4728,7 @@ of) a large number of subtasks (see [[*Checkboxes]]). #+cindex: checkboxes #+vindex: org-list-automatic-rules -Every item in a plain list[fn:17] (see [[*Plain Lists]]) can be made into +Every item in a plain list[fn:16] (see [[*Plain Lists]]) can be made into a checkbox by starting it with the string =[ ]=. This feature is similar to TODO items (see [[*TODO Items]]), but is more lightweight. Checkboxes are not included into the global TODO list, so they are @@ -4598,11 +4748,6 @@ Here is an example of a checkbox list. - [X] talk to the neighbors #+end_example -Checkboxes work hierarchically, so if a checkbox item has children -that are checkboxes, toggling one of the children checkboxes makes the -parent checkbox reflect if none, some, or all of the children are -checked. - #+cindex: statistics, for checkboxes #+cindex: checkbox statistics #+cindex: @samp{COOKIE_DATA}, property @@ -4633,6 +4778,37 @@ If the current outline node has an =ORDERED= property, checkboxes must be checked off in sequence, and an error is thrown if you try to check off a box while there are unchecked boxes above it. +A checkbox can be in one of the three states: +1. not checked =[ ]= +2. partially checked =[-]= +3. checked =[X]= + +Checkboxes work hierarchically, so if a checkbox item has children +that are checkboxes, toggling one of the children checkboxes makes the +parent checkbox reflect if none, some, or all of the children are +checked. + +If all child checkboxes are not checked, the parent checkbox is also not checked. +#+begin_example +- [ ] call people + - [ ] Peter + - [ ] Sarah +#+end_example + +If some but not all child checkboxes are checked, the parent checkbox is partially checked. +#+begin_example +- [-] call people + - [X] Peter + - [ ] Sarah +#+end_example + +If all child checkboxes are checked, the parent checkbox is also checked. +#+begin_example +- [X] call people + - [X] Peter + - [X] Sarah +#+end_example + The following commands work with checkboxes: - {{{kbd(C-c C-c)}}} (~org-toggle-checkbox~) :: @@ -4769,15 +4945,6 @@ To limit tag inheritance to specific tags, or to turn it off entirely, use the variables ~org-use-tag-inheritance~ and ~org-tags-exclude-from-inheritance~. -#+vindex: org-tags-match-list-sublevels -When a headline matches during a tags search while tag inheritance is -turned on, all the sublevels in the same tree---for a simple match -form---match as well[fn:: This is only true if the search does not -involve more complex tests including properties (see [[*Property -Searches]]).]. The list of matches may then become very long. If you -only want to see the first tags match in a subtree, configure the -variable ~org-tags-match-list-sublevels~ (not recommended). - #+vindex: org-agenda-use-tag-inheritance Tag inheritance is relevant when the agenda search tries to match a tag, either in the ~tags~ or ~tags-todo~ agenda types. In other @@ -4987,6 +5154,11 @@ effect: start selection with {{{kbd(C-c C-c C-c)}}} instead of the special window is not even shown for single-key tag selection, it comes up only when you press an extra {{{kbd(C-c)}}}. +#+vindex: org-fast-tag-selection-maximum-tags +The number of tags displayed in the fast tag selection interface is +limited by ~org-fast-tag-selection-maximum-tags~ to avoid running out +of keyboard keys. You can customize this variable. + ** Tag Hierarchy :PROPERTIES: :DESCRIPTION: Create a hierarchy of tags. @@ -5120,10 +5292,8 @@ related information into special lists. - {{{kbd(M-x org-agenda M)}}} (~org-tags-view~) :: #+kindex: M @r{(Agenda dispatcher)} - #+vindex: org-tags-match-list-sublevels Create a global list of tag matches from all agenda files, but check - only TODO items and force checking subitems (see the option - ~org-tags-match-list-sublevels~). + only TODO items. These commands all prompt for a match string which allows basic Boolean logic like =+boss+urgent-project1=, to find entries with tags @@ -5205,10 +5375,10 @@ disks in a box like this: :END: #+end_example -Properties can be inserted on buffer level. That means they apply +Properties can be inserted at the buffer level. That means they apply before the first headline and can be inherited by all entries in a -file. Property blocks defined before first headline needs to be -located at the top of the buffer, allowing only comments above. +file. Property blocks defined before the first headline must be at +the top of the buffer with only comments above them. Properties can also be defined using lines like: @@ -5358,8 +5528,8 @@ not be used as keys in the properties drawer: | =PRIORITY= | The priority of the entry, a string with a single letter. | | =SCHEDULED= | The scheduling timestamp. | | =TAGS= | The tags defined directly in the headline. | -| =TIMESTAMP= | The first keyword-less timestamp in the entry. | -| =TIMESTAMP_IA= | The first inactive timestamp in the entry. | +| =TIMESTAMP= | The first active keyword-less timestamp in the entry.[fn:17] | +| =TIMESTAMP_IA= | The first inactive keyword-less timestamp in the entry. | | =TODO= | The TODO keyword of the entry. | ** Property Searches @@ -5391,10 +5561,8 @@ Searches]]). - {{{kbd(M-x org-agenda M)}}} (~org-tags-view~) :: #+kindex: M @r{(Agenda dispatcher)} - #+vindex: org-tags-match-list-sublevels Create a global list of tag matches from all agenda files, but check - only TODO items and force checking of subitems (see the option - ~org-tags-match-list-sublevels~). + only TODO items. The syntax for the search string is described in [[*Matching tags and properties]]. @@ -5757,6 +5925,30 @@ either for all clocks or just for today. #+findex: org-columns-delete Delete the current column. +- {{{kbd(M-LEFT)}}} (~org-columns-move-left~) :: + + #+kindex: M-LEFT + #+findex: org-columns-move-left + Move the current column left. + +- {{{kbd(M-RIGHT)}}} (~org-columns-move-right~) :: + + #+kindex: M-RIGHT + #+findex: org-columns-move-right + Move the current column right. + +- {{{kbd(M-UP)}}} (~org-columns-move-row-up~) :: + + #+kindex: M-UP + #+findex: org-columns-move-row-up + Move the current row up. + +- {{{kbd(M-DOWN)}}} (~org-columns-move-row-down~) :: + + #+kindex: M-DOWN + #+findex: org-columns-move-row-down + Move the current row down. + *** Capturing column view :PROPERTIES: :DESCRIPTION: A dynamic block for column view. @@ -5838,11 +6030,23 @@ This dynamic block has the following parameters: When non-~nil~, indent each =ITEM= field according to its level. +- =:link= :: + + When non-~nil~, link the =ITEM= headlines in the table to their + origins. + - =:format= :: Specify a column attribute (see [[*Column attributes]]) for the dynamic block. +- =:formatter= :: + + #+cindex: @samp{formatter}, dynamic block parameter + #+vindex: org-columns-dblock-formatter + A function to format column view data and insert it into the buffer. + See the option ~org-columns-dblock-formatter~. + The following commands insert or update the dynamic block: - ~org-columns-insert-dblock~ :: @@ -5861,7 +6065,7 @@ The following commands insert or update the dynamic block: #+kindex: C-c C-c #+kindex: C-c C-x C-u #+findex: org-dblock-update - Update dynamic block at point. point needs to be in the =#+BEGIN= + Update dynamic block at point. Point needs to be on the =#+BEGIN= line of the dynamic block. - {{{kbd(C-u C-c C-x C-u)}}} (~org-update-all-dblocks~) :: @@ -5901,6 +6105,11 @@ a little confusing because timestamp is often used as indicating when something was created or last changed. However, in Org mode this term is used in a much wider sense. +Timestamps can be used to plan appointments, schedule tasks, set +deadlines, track time, and more. The following sections describe +the timestamp format and tooling that Org mode provides for common +use cases dealing with time and time intervals. + ** Timestamps :PROPERTIES: :DESCRIPTION: Assigning a time to a tree entry. @@ -5911,8 +6120,8 @@ is used in a much wider sense. #+cindex: deadlines #+cindex: scheduling -A timestamp is a specification of a date (possibly with a time or -a range of times) in a special format, either =<2003-09-16 Tue>= or +A timestamp is a specification of a date---possibly with a time or +time range---in a special format, either =<2003-09-16 Tue>= or =<2003-09-16 Tue 09:39>= or =<2003-09-16 Tue 12:00-12:30>=[fn:19]. A timestamp can appear anywhere in the headline or body of an Org tree entry. Its presence causes entries to be shown on specific dates in @@ -5925,13 +6134,17 @@ the agenda (see [[*Weekly/daily agenda]]). We distinguish: A simple timestamp just assigns a date/time to an item. This is just like writing down an appointment or event in a paper agenda. In the agenda display, the headline of an entry associated with - a plain timestamp is shown exactly on that date. + a plain timestamp is shown exactly on that date. There can be + multiple timestamps in an item. #+begin_example ,* Meet Peter at the movies <2006-11-01 Wed 19:15> ,* Discussion on climate change - <2006-11-02 Thu 20:00-22:00> + <2006-11-02 Thu 10:00-12:00> + ,* My days off + <2006-11-03 Fri> + <2006-11-06 Mon> #+end_example - Timestamp with repeater interval :: @@ -5964,20 +6177,35 @@ the agenda (see [[*Weekly/daily agenda]]). We distinguish: #+begin_example ,* 22:00-23:00 The nerd meeting on every 2nd Thursday of the month - <%%(diary-float t 4 2)> + <%%(diary-float t 4 2) 22:00-23:00> + #+end_example + +- Time range :: + #+cindex: time range + + Time range is a timestamp having two time units connected by =-= + + #+begin_example +,* Discussion on climate change + <2006-11-02 Thu 10:00-12:00> #+end_example - Time/Date range :: + #+cindex: time range #+cindex: timerange #+cindex: date range - Two timestamps connected by =--= denote a range. The headline is - shown on the first and last day of the range, and on any dates that - are displayed and fall in the range. Here is an example: + Two timestamps connected by =--= denote a range. In the agenda, the + headline is shown on the first and last day of the range, and on any + dates that are displayed and fall in the range. The first example + specifies just the dates of the range while the second example + specifies a time range for each date. #+begin_example ,** Meeting in Amsterdam <2004-08-23 Mon>--<2004-08-26 Thu> + ,** This weeks committee meetings + <2004-08-23 Mon 10:00-11:00>--<2004-08-26 Thu 10:00-11:00> #+end_example - Inactive timestamp :: @@ -6003,10 +6231,11 @@ format. All commands listed below produce timestamps in the correct format. #+attr_texinfo: :sep , -- {{{kbd(C-c .)}}} (~org-time-stamp~) :: +- {{{kbd(C-c .)}}} (~org-timestamp~) :: #+kindex: C-c . #+findex: org-time-stamp + #+findex: org-timestamp Prompt for a date and insert a corresponding timestamp. When point is at an existing timestamp in the buffer, the command is used to modify this timestamp instead of inserting a new one. When this @@ -6014,21 +6243,23 @@ format. #+kindex: C-u C-c . #+vindex: org-time-stamp-rounding-minutes + #+vindex: org-timestamp-rounding-minutes When called with a prefix argument, use the alternative format which contains date and time. The default time can be rounded to multiples of 5 minutes. See the option - ~org-time-stamp-rounding-minutes~. + ~org-timestamp-rounding-minutes~. #+kindex: C-u C-u C-c . With two prefix arguments, insert an active timestamp with the current time without prompting. -- {{{kbd(C-c !)}}} (~org-time-stamp-inactive~) :: +- {{{kbd(C-c !)}}} (~org-timestamp-inactive~) :: #+kindex: C-c ! #+kindex: C-u C-c ! #+kindex: C-u C-u C-c ! #+findex: org-time-stamp-inactive + #+findex: org-timestamp-inactive Like {{{kbd(C-c .)}}}, but insert an inactive timestamp that does not cause an agenda entry. @@ -6232,16 +6463,18 @@ turn off the display with ~org-read-date-display-live~.]. #+vindex: org-display-custom-times #+vindex: org-time-stamp-custom-formats +#+vindex: org-timestamp-custom-formats Org mode uses the standard ISO notation for dates and times as it is defined in ISO 8601. If you cannot get used to this and require another representation of date and time to keep you happy, you can get it by customizing the variables ~org-display-custom-times~ and -~org-time-stamp-custom-formats~. +~org-timestamp-custom-formats~. -- {{{kbd(C-c C-x C-t)}}} (~org-toggle-time-stamp-overlays~) :: +- {{{kbd(C-c C-x C-t)}}} (~org-toggle-timestamp-overlays~) :: #+kindex: C-c C-x C-t #+findex: org-toggle-time-stamp-overlays + #+findex: org-toggle-timestamp-overlays Toggle the display of custom formats for dates and times. Org mode needs the default format for scanning, so the custom @@ -6470,6 +6703,9 @@ state to =DONE= would actually switch the date like this: DEADLINE: <2005-11-01 Tue +1m> #+end_example +When task contains multiple timestamps with repeater interval, all +these timestamps are shifted. + To mark a task with a repeater as DONE, use {{{kbd(C-- 1 C-c C-t)}}}, i.e., ~org-todo~ with a numeric prefix argument of =-1=. @@ -6516,16 +6752,16 @@ special repeaters =++= and =.+=. For example: Marking this DONE shifts the date to exactly one hour from now. #+end_example -#+vindex: org-agenda-skip-scheduled-if-deadline-is-shown +#+vindex: org-agenda-skip-scheduled-repeats-after-deadline You may have both scheduling and deadline information for a specific task. If the repeater is set for the scheduling information only, you probably want the repeater to be ignored after the deadline. If so, -set the variable ~org-agenda-skip-scheduled-if-deadline-is-shown~ to -~repeated-after-deadline~. However, any scheduling information -without a repeater is no longer relevant once the task is done, and -thus, removed upon repeating the task. If you want both scheduling -and deadline information to repeat after the same interval, set the -same repeater for both timestamps. +set the variable ~org-agenda-skip-scheduled-repeats-after-deadline~ to +~t~. However, any scheduling information without a repeater is no +longer relevant once the task is done, and thus, removed upon +repeating the task. If you want both scheduling and deadline +information to repeat after the same interval, set the same repeater +for both timestamps. An alternative to using a repeater is to create a number of copies of a task subtree, with dates shifted in each copy. The command @@ -6654,23 +6890,30 @@ about what to do with it. #+kindex: C-S-UP #+findex: org-clock-timestamps-up + #+findex: org-shiftcontrolup #+kindex: C-S-DOWN #+findex: org-clock-timestamps-down + #+findex: org-shiftcontroldown On CLOCK log lines, increase/decrease both timestamps so that the clock duration keeps the same value. - {{{kbd(S-M-UP)}}} (~org-timestamp-up~), {{{kbd(S-M-DOWN)}}} (~org-timestamp-down~) :: #+kindex: S-M-UP - #+findex: org-clock-timestamp-up + #+findex: org-timestamp-up + #+findex: org-shiftmetaup #+kindex: S-M-DOWN - #+findex: org-clock-timestamp-down + #+findex: org-timestamp-down + #+findex: org-shiftmetadown On =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-UP)}}} to increase a clocked-out timestamp by five minutes, then the clocked-in timestamp of the next clock is increased by five minutes. + Only =CLOCK= logs created during current Emacs session are + considered when adjusting next/previous timestamp. + - {{{kbd(C-c C-t)}}} (~org-todo~) :: #+kindex: C-c C-t @@ -6802,16 +7045,16 @@ be selected: absolutely, or relative to the current time and may be any of these formats: - | =2007-12-31= | New year eve 2007 | - | =2007-12= | December 2007 | - | =2007-W50= | ISO-week 50 in 2007 | - | =2007-Q2= | 2nd quarter in 2007 | - | =2007= | the year 2007 | - | =today=, =yesterday=, =today-N= | a relative day | - | =thisweek=, =lastweek=, =thisweek-N= | a relative week | - | =thismonth=, =lastmonth=, =thismonth-N= | a relative month | - | =thisyear=, =lastyear=, =thisyear-N= | a relative year | - | =untilnow=[fn:: When using ~:step~, ~untilnow~ starts from the beginning of 2003, not the beginning of time.] | all clocked time ever | + | =2007-12-31= | New year eve 2007 | + | =2007-12= | December 2007 | + | =2007-W50= | ISO-week 50 in 2007 | + | =2007-Q2= | 2nd quarter in 2007 | + | =2007= | the year 2007 | + | =today=, =yesterday=, =today-N= | a relative day | + | =thisweek=, =lastweek=, =thisweek-N= | a relative week | + | =thismonth=, =lastmonth=, =thismonth-N= | a relative month | + | =thisyear=, =lastyear=, =thisyear-N= | a relative year | + | =untilnow=[fn:28] | all clocked time ever | #+vindex: org-clock-display-default-range When this option is not set, Org falls back to the value in @@ -7017,7 +7260,7 @@ current clock, or applying it to another one. #+vindex: org-clock-x11idle-program-name By customizing the variable ~org-clock-idle-time~ to some integer, such as 10 or 15, Emacs can alert you when you get back to your -computer after being idle for that many minutes[fn:28], and ask what +computer after being idle for that many minutes[fn:29], 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 @@ -7651,10 +7894,10 @@ with prefix commands: Visit the last stored capture item in its buffer. -#+vindex: org-capture-bookmark +#+vindex: org-bookmark-names-plist #+vindex: org-capture-last-stored You can also jump to the bookmark ~org-capture-last-stored~, which is -automatically created unless you set ~org-capture-bookmark~ to ~nil~. +automatically created unless you customize ~org-bookmark-names-plist~. To insert the capture at point in an Org buffer, call ~org-capture~ with a {{{kbd(C-0)}}} prefix argument. @@ -7810,7 +8053,7 @@ Now lets look at the elements of a template definition. Each entry in - =(file+olp+datetree "filename" [ "Level 1 heading" ...])= :: - This target[fn:29] creates a heading in a date tree[fn:30] for + This target[fn:30] creates a heading in a date tree[fn:31] for today's date. If the optional outline path is given, the tree will be built under the node it is pointing to, instead of at top level. Check out the ~:time-prompt~ and ~:tree-type~ properties @@ -7824,6 +8067,10 @@ Now lets look at the elements of a template definition. Each entry in File to the entry that is currently being clocked. + - =(here)= :: + + The position of =point=. + - =(function function-finding-location)= :: Most general way: write your own function which both visits the @@ -8076,6 +8323,12 @@ given here: Prompt the user for a value for property {{{var(PROP)}}}. You may specify a default value with =%^{PROP|default}=. +- =%^{PROMPT}X=, X is one of g,G,t,T,u,U,C,L :: + + Prompt the user as in =%^X=, but use the custom prompt string. You + may specify a default value and completions with + =%^{PROMPT|default|completion1|completion2|completion3...}X=. + - =%^{PROMPT}= :: Prompt the user for a string and replace this sequence with it. You @@ -8109,7 +8362,7 @@ capture templates in a similar way.]: | | =%:date= (message date header field) | | | =%:date-timestamp= (date as active timestamp) | | | =%:date-timestamp-inactive= (date as inactive timestamp) | -| | =%:fromto= (either "to NAME" or "from NAME")[fn:31] | +| | =%:fromto= (either "to NAME" or "from NAME")[fn:32] | | gnus | =%:group=, for messages also all email fields | | w3, w3m | =%:url= | | info | =%:file=, =%:node= | @@ -8724,10 +8977,9 @@ commands: #+kindex: < < @r{(Agenda dispatcher)} If there is an active region, restrict the following agenda command - to the region. Otherwise, restrict it to the current subtree[fn:: - 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. + to the region. Otherwise, restrict it to the current subtree. + After pressing {{{kbd(< <)}}}, you still need to press the character + selecting the command. - {{{kbd(*)}}} :: @@ -8776,7 +9028,7 @@ a paper agenda, showing all the tasks for the current week or day. #+cindex: org-agenda, command Compile an agenda for the current week from a list of Org files. The agenda shows the entries for each day. With a numeric prefix - argument[fn:32]---like {{{kbd(C-u 2 1 M-x org-agenda a)}}}---you may + argument[fn:33]---like {{{kbd(C-u 2 1 M-x org-agenda a)}}}---you may set the number of days to be displayed. #+vindex: org-agenda-span @@ -9040,14 +9292,12 @@ sparse trees with {{{kbd(C-c / m)}}}. #+kindex: M @r{(Agenda dispatcher)} #+findex: org-tags-view - #+vindex: org-tags-match-list-sublevels #+vindex: org-agenda-tags-todo-honor-ignore-options Like {{{kbd(m)}}}, but only select headlines that are also TODO - items and force checking subitems (see the variable - ~org-tags-match-list-sublevels~). To exclude scheduled/deadline - items, see the variable ~org-agenda-tags-todo-honor-ignore-options~. - Matching specific TODO keywords together with a tags match is also - possible, see [[*Tag Searches]]. + items. To exclude scheduled/deadline items, see the variable + ~org-agenda-tags-todo-honor-ignore-options~. Matching specific TODO + keywords together with a tags match is also possible, see [[*Tag + Searches]]. The commands available in the tags list are described in [[*Commands in the Agenda Buffer]]. @@ -9120,16 +9370,18 @@ When matching properties, a number of different operators can be used to test the value of a property. Here is a complex example: #+begin_example -+work-boss+PRIORITY="A"+Coffee="unlimited"+Effort<2 ++work-boss+PRIORITY="A"+Coffee="unlimited"+Effort<*2 +With={Sarah\|Denny}+SCHEDULED>="<2008-10-11>" #+end_example +#+cindex: operator, for property search #+texinfo: @noindent The type of comparison depends on how the comparison value is written: - If the comparison value is a plain number, a numerical comparison is done, and the allowed operators are =<=, ===, =>=, =<==, =>==, and - =<>=. + =<>=. As a synonym for the equality operator ===, there is also + ====; =!== and =/== are synonyms of the inequality operator =<>=. - If the comparison value is enclosed in double-quotes, a string comparison is done, and the same operators are allowed. @@ -9147,6 +9399,13 @@ The type of comparison depends on how the comparison value is written: is performed, with === meaning that the regexp matches the property value, and =<>= meaning that it does not match. +- All operators may be optionally followed by an asterisk =*=, like in + =<*=, =!=*=, etc. Such /starred operators/ work like their regular, + unstarred counterparts except that they match only headlines where + the tested property is actually present. This is most useful for + search terms that logically exclude results, like the inequality + operator. + So the search string in the example finds entries tagged =work= but not =boss=, which also have a priority value =A=, a =Coffee= property with the value =unlimited=, an =EFFORT= property that is numerically @@ -9154,6 +9413,28 @@ smaller than 2, a =With= property that is matched by the regular expression =Sarah\|Denny=, and that are scheduled on or after October 11, 2008. +Note that the test on the =EFFORT= property uses operator =<*=, so +that the search result will include only entries that actually have an +=EFFORT= property defined and with numerical value smaller than 2. +With the regular =<= operator, the search would handle entries without +an =EFFORT= property as having a zero effort and would include them in +the result as well. + +You can use all characters valid in property names when matching +properties. However, you have to quote some characters in property +names with backslashes when using them in search strings, namely all +characters different from alphanumerics and underscores[fn:: If you +quote alphanumeric characters or underscores with a backslash, that +backslash is ignored.]. For example, to search for all entries having +a property =boss-prio=, =boss:prio=, or =boss\prio=, respectively, +with value =C=, use search strings + +#+begin_example +boss\-prio="C" +boss\:prio="C" +boss\\prio="C" +#+end_example + You can configure Org mode to use property inheritance during a search, but beware that this can slow down searches considerably. See [[*Property Inheritance]], for details. @@ -9402,16 +9683,16 @@ done depends on the type of view. time-of-day specification. These entries are shown at the beginning of the list, as a /schedule/ for the day. After that, items remain grouped in categories, in the sequence given by ~org-agenda-files~. - Within each category, items are sorted by priority (see - [[*Priorities]]), which is composed of the base priority (2000 for - priority =A=, 1000 for =B=, and 0 for =C=), plus additional - increments for overdue scheduled or deadline items. + Within each category, items are sorted by urgency, which is composed + of the base priority (see [[*Priorities]]; 2000 for priority =A=, 1000 + for =B=, and 0 for =C=), plus additional increments for overdue + scheduled or deadline items. - For the TODO list, items remain in the order of categories, but - within each category, sorting takes place according to priority (see - [[*Priorities]]). The priority used for sorting derives from the - priority cookie, with additions depending on how close an item is to - its due or scheduled date. + within each category, sorting takes place according to urgency. The + urgency used for sorting derives from the priority cookie, with + additions depending on how close an item is to its due or scheduled + date. - For tags matches, items are not sorted at all, but just appear in the sequence in which they are found in the agenda files. @@ -9435,7 +9716,7 @@ filters and limits allow flexibly narrowing down the list of agenda entries. /Filters/ only change the visibility of items, are very fast and are -mostly used interactively[fn:33]. You can switch quickly between +mostly used interactively[fn:34]. You can switch quickly between different filters without having to recreate the agenda. /Limits/ on the other hand take effect before the agenda buffer is populated, so they are mostly useful when defined as local variables within custom @@ -9877,9 +10158,13 @@ the other commands, point needs to be in the desired line. #+kindex: v a #+findex: org-agenda-archives-mode + #+vindex: org-agenda-start-with-archives-mode Toggle Archives mode. In Archives mode, trees that are archived (see [[*Internal archiving]]) are also scanned when producing the - agenda. To exit archives mode, press {{{kbd(v a)}}} again. + agenda. To exit archives mode, press {{{kbd(v a)}}} again. The + initial setting for this mode in new agenda buffers can set with the + variable ~org-agenda-start-with-archives-mode~, which can be set + with the same values as ~org-agenda-archives-mode~. - {{{kbd(v A)}}} :: @@ -10517,7 +10802,7 @@ used for the matching. The example above will therefore define: - {{{kbd(x)}}} :: - as a global search for agenda entries planned[fn:34] this week/day. + as a global search for agenda entries planned[fn:35] this week/day. - {{{kbd(y)}}} :: @@ -10703,7 +10988,7 @@ export custom agenda views as plain text, HTML[fn:: For HTML you need to install Hrvoje NikÅ¡ić's =htmlize.el= as an Emacs package from [[https://elpa.nongnu.org/][NonGNU ELPA]] or from [[https://github.com/hniksic/emacs-htmlize][Hrvoje NikÅ¡ić's repository]].], -Postscript, PDF[fn:35], and iCalendar files. If you +Postscript, PDF[fn:36], and iCalendar files. If you want to do this only occasionally, use the following command: - {{{kbd(C-x C-w)}}} (~org-agenda-write~) :: @@ -10981,12 +11266,28 @@ but not any simpler You can make words =*bold*=, =/italic/=, =_underlined_=, ==verbatim== and =~code~=, and, if you must, =+strike-through+=. Text in the code and verbatim string is not processed for Org specific syntax; it is -exported verbatim. +exported verbatim. Org provides a single command as entry point for +inserting the marker character. + +- {{{kbd(C-c C-x C-f)}}} (~org-emphasize~) :: + + #+kindex: C-c C-x C-f + #+findex: org-emphasize + Prompt for a marker character and insert or change an emphasis. If + there is an active region, change that region to a new emphasis. If + there is no region, just insert the marker characters and position + the cursor between them. #+vindex: org-fontify-emphasized-text To turn off fontification for marked up text, you can set ~org-fontify-emphasized-text~ to ~nil~. To narrow down the list of -available markup syntax, you can customize ~org-emphasis-alist~. +the fontified markup syntax, you can customize +~org-emphasis-alist~[fn:: The markup will still be recognized. Just +not highlighted visually in Emacs.]. + +#+vindex: org-hide-emphasis-markers +To hide the emphasis markup characters in your buffers, set +~org-hide-emphasis-markers~ to ~t~. Sometimes, when marked text also contains the marker character itself, the result may be unsettling. For example, @@ -11018,15 +11319,20 @@ the radius of Alpha Centauri is R_{Alpha Centauri} = 1.28 x R_{sun}. #+end_example #+vindex: org-use-sub-superscripts +#+vindex: org-export-with-sub-superscripts If you write a text where the underscore is often used in a different context, Org's convention to always interpret these as subscripts can -get in your way. Configure the variable ~org-use-sub-superscripts~ to -change this convention. For example, when setting this variable to -~{}~, =a_b= is not interpreted as a subscript, but =a_{b}= is. - -You can set ~org-use-sub-superscripts~ in a file using the export -option =^:= (see [[*Export Settings][Export Settings]]). For example, =#+OPTIONS: ^:{}= -sets ~org-use-sub-superscripts~ to ~{}~ and limits super- and +get in your way. Configure the variable ~org-use-sub-superscripts~ +and/or ~org-export-with-sub-superscripts~ to change this convention. +For example, when setting these variables to ~{}~, =a_b= is not +displayed/exported[fn::The underlying markup still remains a +sub/superscript. Only the visual display and export behavior +changes.] as a subscript, but =a_{b}= is. + +You can set both ~org-use-sub-superscripts~ +~org-export-with-sub-superscripts~ in a file using the export option +=^:= (see [[*Export Settings][Export Settings]]). For example, +=#+OPTIONS: ^:{}= sets the two options to ~{}~ and limits super- and subscripts to the curly bracket notation. You can also toggle the visual display of super- and subscripts: @@ -11073,7 +11379,7 @@ possible to provide your own special symbols in the variable ~org-entities-user~. During export, these symbols are transformed into the native format of -the exporter back-end. Strings like =\alpha= are exported as =α= in +the exporter backend. Strings like =\alpha= are exported as =α= in the HTML output, and as =\(\alpha\)= in the LaTeX output. Similarly, =\nbsp= becomes = = in HTML and =~= in LaTeX. @@ -11109,11 +11415,11 @@ converted into dashes, and =...= becomes a compact set of dots. Plain ASCII is normally sufficient for almost all note taking. Exceptions include scientific notes, which often require mathematical -symbols and the occasional formula. LaTeX[fn:36] is widely used to +symbols and the occasional formula. LaTeX[fn:37] is widely used to typeset scientific documents. Org mode supports embedding LaTeX code into its files, because many academics are used to writing and reading LaTeX source code, and because it can be readily processed to produce -pretty output for a number of export back-ends. +pretty output for a number of export backends. *** LaTeX fragments :PROPERTIES: @@ -11123,7 +11429,7 @@ pretty output for a number of export back-ends. #+vindex: org-format-latex-header Org mode can contain LaTeX math fragments, and it supports ways to -process these for several export back-ends. When exporting to LaTeX, +process these for several export backends. When exporting to LaTeX, the code is left as it is. When exporting to HTML, Org can use either [[https://www.mathjax.org][MathJax]] (see [[*Math formatting in HTML export]]) or transcode the math into images (see [[*Previewing LaTeX fragments]]). @@ -11131,26 +11437,31 @@ into images (see [[*Previewing LaTeX fragments]]). LaTeX fragments do not need any special marking at all. The following snippets are identified as LaTeX source code: -- Environments of any kind[fn:37]. The only requirement is that the +- Environments of any kind[fn:38]. The only requirement is that the =\begin= statement appears on a new line, preceded by only whitespace. -- Text within the usual LaTeX math delimiters. To avoid conflicts - with currency specifications, single =$= characters are only - recognized as math delimiters if the enclosed text contains at most - two line breaks, is directly attached to the =$= characters with no - whitespace in between, and if the closing =$= is followed by - whitespace, punctuation or a dash. For the other delimiters, there - is no such restriction, so when in doubt, use =\(...\)= as inline - math delimiters. +- Text within the usual LaTeX math delimiters. Prefer =\(...\)= for + inline fragments. The =$...$= alternative has some restrictions and + may be a source of confusion. To avoid conflicts with currency + specifications, single =$= characters are only recognized as math + delimiters if the enclosed text contains at most two line breaks, is + directly attached to the =$= characters with no whitespace in + between, and if the closing =$= is followed by whitespace or + punctuation (but not a dash). + + Sometimes, it may necessary to have a literal dollar symbol even + when it is recognized as LaTeX math delimiter. Org provides =\dollar= and + =\USD= entities (see [[*Special Symbols]]) that are rendered as =$= for + such scenarios. Also, see [[*Escape Character]]. #+texinfo: @noindent For example: #+begin_example \begin{equation} % arbitrary environments, -x=\sqrt{b} % even tables, figures -\end{equation} % etc +x=\sqrt{b} % even tables, figures, etc +\end{equation} If $a^2=b$ and \( b=2 \), then the solution must be either $$ a=+\sqrt{2} $$ or \[ a=-\sqrt{2} \]. @@ -11159,7 +11470,7 @@ either $$ a=+\sqrt{2} $$ or \[ a=-\sqrt{2} \]. #+vindex: org-export-with-latex LaTeX processing can be configured with the variable ~org-export-with-latex~. The default setting is ~t~ which means -MathJax for HTML, and no processing for ASCII and LaTeX back-ends. +MathJax for HTML, and no processing for ASCII and LaTeX backends. You can also set this variable on a per-file basis using one of these lines: @@ -11175,7 +11486,7 @@ lines: #+vindex: org-preview-latex-default-process If you have a working LaTeX installation and =dvipng=, =dvisvgm= or -=convert= installed[fn:38], LaTeX fragments can be processed to +=convert= installed[fn:39], LaTeX fragments can be processed to produce images of the typeset expressions to be used for inclusion while exporting to HTML (see [[*LaTeX fragments]]), or for inline previewing within Org mode. @@ -11331,9 +11642,9 @@ Here is an example #+vindex: org-latex-src-block-backend If the example is source code from a programming language, or any other text that can be marked up by Font Lock in Emacs, you can ask -for the example to look like the fontified Emacs buffer[fn:39]. This +for the example to look like the fontified Emacs buffer[fn:40]. This is done with the code block, where you also need to specify the name -of the major mode that should be used to fontify the example[fn:40], +of the major mode that should be used to fontify the example[fn:41], see [[*Structure Templates]] for shortcuts to easily insert code blocks. #+cindex: @samp{BEGIN_SRC} @@ -11343,17 +11654,19 @@ see [[*Structure Templates]] for shortcuts to easily insert code blocks. (defun org-xor (a b) "Exclusive or." (if a (not b) b)) - ,#+END_SRC +,#+END_SRC #+end_example Both in =example= and in =src= snippets, you can add a =-n= switch to -the end of the =#+BEGIN= line, to get the lines of the example -numbered. The =-n= takes an optional numeric argument specifying the -starting line number of the block. If you use a =+n= switch, the -numbering from the previous numbered snippet is continued in the -current one. The =+n= switch can also take a numeric argument. This -adds the value of the argument to the last line of the previous block -to determine the starting line number. +the =#+BEGIN= line[fn::In the =src= snippets, switches must be placed +right after the language name and before the [[*Structure of Code +Blocks][header arguments]]], to get the lines of the example numbered. +The =-n= takes an optional numeric argument specifying the starting +line number of the block. If you use a =+n= switch, the numbering +from the previous numbered snippet is continued in the current one. +The =+n= switch can also take a numeric argument. This adds the value +of the argument to the last line of the previous block to determine +the starting line number. #+begin_example ,#+BEGIN_SRC emacs-lisp -n 20 @@ -11369,9 +11682,12 @@ to determine the starting line number. In literal examples, Org interprets strings like =(ref:name)= as labels, and use them as targets for special hyperlinks like -=[[(name)]]=---i.e., the reference name enclosed in single parenthesis. -In HTML, hovering the mouse over such a link remote-highlights the -corresponding code line, which is kind of cool. +=[[(name)]]=---i.e., the reference name enclosed in single +parentheses. In HTML, hovering the mouse over such a link +remote-highlights the corresponding code line[fn:: This requires some +Javascript which is /not/ automatically included in the HTML output: +you have to customize the variable =org-html-head-include-scripts= to +~t~ to have it included (it is ~nil~ by default).], which is kind of cool. You can also add a =-r= switch which /removes/ the labels from the source code[fn:: Adding =-k= to =-n -r= /keeps/ the labels in the @@ -11478,14 +11794,19 @@ command: #+vindex: org-image-actual-width + #+vindex: org-image-max-width #+cindex: @samp{ORG-IMAGE-ACTUAL-WIDTH}, property By default, Org mode displays inline images according to their - actual width. You can customize the displayed image width using + actual width, but no wider than ~fill-column~ characters. + + You can customize the displayed image width using ~org-image-actual-width~ variable (globally) or =ORG-IMAGE-ACTUAL-WIDTH= property (subtree-level)[fn:: The width can be customized in Emacs >= 24.1, built with imagemagick support.]. Their value can be the following: - - (default) Non-nil, use the actual width of images when inlining them. + - (default) Non-~nil~, use the actual width of images when inlining + them. If the actual width is too wide, limit it according to + ~org-image-max-width~. - When set to a number, use imagemagick (when available) to set the image's width to this value. - When set to a number in a list, try to get the width from any @@ -11494,9 +11815,51 @@ command: ,#+ATTR_HTML: :width 300px #+end_example and fall back on that number if none is found. - - When set to nil, try to get the width from an =#+ATTR.*= keyword - and fall back on the original width if none is found. + - When set to ~nil~, try to get the width from an =#+ATTR.*= keyword + and fall back on the original width or ~org-image-max-width~ if + none is found. + + ~org-image-max-width~ limits the maximum displayed image width, but + only when the image width is not set explicitly. Possible maximum + width can be set to: + - (default) ~fill-column~, limit width to ~fill-column~ number of + characters. + - ~window~, limit width to current window width. + - integer number, limit width to that specified number of pixels. + - ~nil~, do not limit the width. + + #+vindex: org-image-align + Org mode can left-align, center or right-align the display of inline + images. This setting is controlled (globally) by ~org-image-align~. + Only standalone images are affected, corresponding to links with no + surrounding text in their paragraph except for whitespace. Its + value can be the following: + - (default) The symbol ~left~, which inserts the image where the + link appears in the buffer. + - The symbol ~center~, which will preview links centered in the + Emacs window. + - The symbol ~right~, which will preview links right-aligned in the + Emacs window. + + Inline image alignment can be specified for each link using the + =#+ATTR.*= keyword if it matches an alignment specification like: + #+begin_example + ,#+ATTR_HTML: :align center + #+end_example + Org will use the alignment specification from any =#+ATTR.*= + keyword, such as =#+ATTR_HTML= or =#+ATTR_LATEX=, but =#+ATTR_ORG= + (if present) will override the others. For instance, this link + #+begin_example + ,#+ATTR_HTML: :align right + ,#+ATTR_ORG: :align center + [[/path/to/image/file.png]] + #+end_example + will be displayed centered in Emacs but exported right-aligned to + HTML. + When =#+ATTR_ORG= is not set, inline image alignment is also read + from the =:center= attribute supported by some export backends (like + HTML, LaTeX and Beamer.) #+vindex: org-cycle-inline-images-display Inline images can also be displayed when cycling the folding state. @@ -11526,7 +11889,7 @@ Optionally, the caption can take the form: Even though images and tables are prominent examples of captioned structures, the same caption mechanism can apply to many others---e.g., LaTeX equations, source code blocks. Depending on the -export back-end, those may or may not be handled. +export backend, those may or may not be handled. ** Horizontal Rules :PROPERTIES: @@ -11552,7 +11915,7 @@ text. Markers always start with =fn:=. For example: #+begin_example The Org website[fn:1] now looks a lot better than it used to. ... -[fn:55] The link is: https://orgmode.org +[fn:50] The link is: https://orgmode.org #+end_example Org mode extends the number-based syntax to /named/ footnotes and @@ -11643,10 +12006,11 @@ export documents to a variety of other formats while retaining as much structure (see [[*Document Structure]]) and markup (see [[*Markup for Rich Contents]]) as possible. +#+cindex: export backend #+cindex: export back-end The libraries responsible for translating Org files to other formats -are called /back-ends/. Org ships with support for the following -back-ends: +are called /backends/. Org ships with support for the following +backends: - /ascii/ (ASCII format) - /beamer/ (LaTeX Beamer format) @@ -11662,15 +12026,15 @@ back-ends: Users can install libraries for additional formats from the Emacs packaging system. For easy discovery, these packages have a common naming scheme: ~ox-NAME~, where {{{var(NAME)}}} is a format. For -example, ~ox-koma-letter~ for /koma-letter/ back-end. More libraries +example, ~ox-koma-letter~ for /koma-letter/ backend. More libraries can be found in the =org-contrib= repository (see [[*Installation]]). #+vindex: org-export-backends -Org only loads back-ends for the following formats by default: ASCII, -HTML, iCalendar, LaTeX, and ODT. Additional back-ends can be loaded +Org only loads backends for the following formats by default: ASCII, +HTML, iCalendar, LaTeX, and ODT. Additional backends can be loaded in either of two ways: by configuring the ~org-export-backends~ variable, or by requiring libraries in the Emacs init file. For -example, to load the Markdown back-end, add this to your Emacs config: +example, to load the Markdown backend, add this to your Emacs config: #+begin_src emacs-lisp (require 'ox-md) @@ -11732,9 +12096,27 @@ further alter what is exported, and how. #+kindex: C-c C-e C-b Toggle body-only export. Useful for excluding headers and footers - in the export. Affects only those back-end formats that have + in the export. Affects only those backend formats that have sections like =...= in HTML. + #+vindex: org-export-body-only + To make body-only export the default, customize the variable + ~org-export-body-only~. + +- {{{kbd(C-f)}}} :: + #+kindex: C-c C-e C-f + + Toggle force-publishing export. Publish functions normally only + publish changed files (see [[**Triggering Publication]]). Forced + publishing causes files to be published even if their timestamps do + not indicate the file has been changed. + + #+vindex: org-export-force-publishing + To make forced publishing the default, customize the variable + ~org-export-force-publishing~. (This is similar to + ~org-publish-use-timestamps-flag~, but only affects the export + dispatcher.) + - {{{kbd(C-s)}}} :: #+kindex: C-c C-e C-s @@ -11756,6 +12138,10 @@ further alter what is exported, and how. certain parts of an Org document by adjusting the visibility of particular headings. See also [[*Sparse Trees]]. + #+vindex: org-export-visible-only + To make visible-only export the default, customize the variable + ~org-export-visible-only~. + ** Export Settings :PROPERTIES: :DESCRIPTION: Common export settings. @@ -11774,14 +12160,14 @@ set at a specific level override options set at a more general level. #+cindex: @samp{SETUPFILE}, keyword In-buffer settings may appear anywhere in the file, either directly or indirectly through a file included using =#+SETUPFILE: filename or -URL= syntax. Option keyword sets tailored to a particular back-end +URL= syntax. Option keyword sets tailored to a particular backend can be inserted from the export dispatcher (see [[*The Export Dispatcher]]) using the =Insert template= command by pressing {{{kbd(#)}}}. To insert keywords individually, a good way to make sure the keyword is correct is to type =#+= and then to use {{{kbd(M-TAB)}}}[fn:6] for completion. -The export keywords available for every back-end, and their equivalent +The export keywords available for every backend, and their equivalent global variables, include: - =AUTHOR= :: @@ -11801,7 +12187,7 @@ global variables, include: #+cindex: @samp{DATE}, keyword #+vindex: org-export-date-timestamp-format - A date or a time-stamp[fn:: The variable + A date or a timestamp[fn:: The variable ~org-export-date-timestamp-format~ defines how this timestamp are exported.]. @@ -11818,28 +12204,44 @@ global variables, include: Language to use for translating certain strings (~org-export-default-language~). With =#+LANGUAGE: fr=, for example, Org translates =Table of contents= to the French =Table des - matières=[fn:41]. + matières=[fn:42]. - =SELECT_TAGS= :: #+cindex: @samp{SELECT_TAGS}, keyword #+vindex: org-export-select-tags - The default value is =("export")=. When a tree is tagged with - =export= (~org-export-select-tags~), Org selects that tree and its - subtrees for export. Org excludes trees with =noexport= tags, see - below. When selectively exporting files with =export= tags set, Org - does not export any text that appears before the first headline. + List of tags that will, if present, be selected for export. The + default value is ~org-export-select-tags~ =("export")=. When a tree + is tagged with =export=, Org selects that tree and its subtrees for + export, ignoring all the other sections that do not possess the + =export= tag. + + When selectively exporting files with =export= tags set, Org does + not export any text that appears before the first headline. + + Note that a file without the =export= tags will export all its + sections. + + To select non-default tags for export, customize + ~org-export-select-tags~ (globally) or add =#+SELECT_TAGS: tag1 + tag2= to the document. - =EXCLUDE_TAGS= :: #+cindex: @samp{EXCLUDE_TAGS}, keyword #+vindex: org-export-exclude-tags - The default value is =("noexport")=. When a tree is tagged with - =noexport= (~org-export-exclude-tags~), Org excludes that tree and - its subtrees from export. Entries tagged with =noexport= are - unconditionally excluded from the export, even if they have an - =export= tag. Even if a subtree is not exported, Org executes any - code blocks contained there. + List of tags that will be excluded from export. The default value is + ~org-export-exclude-tags~ =("noexport")=. When a tree is tagged + with =noexport=, Org excludes that tree and its subtrees from + export. + + Entries tagged with =noexport= are unconditionally excluded from the + export, even if they have an =export= tag. Even if a subtree is not + exported, Org executes any code blocks contained there. + + To select non-default tags for the exclusion, customize + ~org-export-exclude-tags~ (globally) or add =#+EXCLUDE_TAGS: tag1 + tag2= to the document. - =TITLE= :: @@ -11853,7 +12255,7 @@ global variables, include: #+cindex: @samp{EXPORT_FILE_NAME}, keyword The name of the output file to be generated. Otherwise, Org generates the file name based on the buffer name and the extension - based on the back-end format. + based on the backend format. The =OPTIONS= keyword is a compact form. To configure multiple options, use several =OPTIONS= lines. =OPTIONS= recognizes the @@ -11915,6 +12317,12 @@ following arguments. Toggle inclusion of author name into exported file (~org-export-with-author~). +- ~expand-links~ :: + + #+vindex: org-export-expand-links + Toggle expansion of environment variables in file paths + (~org-export-expand-links~). + - ~broken-links~ :: #+vindex: org-export-with-broken-links @@ -11966,7 +12374,7 @@ following arguments. #+vindex: org-export-headline-levels Set the number of headline levels for export (~org-export-headline-levels~). Below that level, headlines are - treated differently. In most back-ends, they become list items. + treated differently. In most backends, they become list items. - ~inline~ :: @@ -12032,8 +12440,9 @@ following arguments. - ~timestamp~ :: #+vindex: org-export-time-stamp-file + #+vindex: org-export-timestamp-file Toggle inclusion of the creation time in the exported file - (~org-export-time-stamp-file~). + (~org-export-timestamp-file~). - ~title~ :: @@ -12095,7 +12504,7 @@ keyword: #+cindex: excluding entries from table of contents #+cindex: table of contents, exclude entries Org includes both numbered and unnumbered headlines in the table of -contents[fn:42]. If you need to exclude an unnumbered headline, +contents[fn:43]. If you need to exclude an unnumbered headline, along with all its children, set the =UNNUMBERED= property to =notoc= value. @@ -12107,11 +12516,11 @@ value. #+end_example #+cindex: @samp{TOC}, keyword -Org normally inserts the table of contents directly before the first -headline of the file. To move the table of contents to a different -location, first turn off the default with ~org-export-with-toc~ -variable or with =#+OPTIONS: toc:nil=. Then insert =#+TOC: headlines -N= at the desired location(s). +Org normally inserts the table of contents in front of the exported +document. To move the table of contents to a different location, +first turn off the default with ~org-export-with-toc~ variable or with +=#+OPTIONS: toc:nil=. Then insert =#+TOC: headlines N= at the desired +location(s). #+begin_example ,#+OPTIONS: toc:nil @@ -12171,22 +12580,21 @@ the table of contents. #+cindex: export, include files #+cindex: @samp{INCLUDE}, keyword -During export, you can include the content of another file. For +[[*Summary of the export process][During export]], you can include the content of another file. For example, to include your =.emacs= file, you could use: : #+INCLUDE: "~/.emacs" src emacs-lisp #+texinfo: @noindent -The first parameter is the file name to include. The optional second -parameter specifies the block type: =example=, =export= or =src=. The -optional third parameter specifies the source code language to use for -formatting the contents. This is relevant to both =export= and =src= -block types. - -If an included file is specified as having a markup language, Org -neither checks for valid syntax nor changes the contents in any way. -For example and source blocks, Org code-escapes the contents before -inclusion. +There are three positional arguments after the include keyword, they are: +1. The file name, this is the sole mandatory argument. Org neither + checks for correctness or validates the content in any way. +2. The block name to wrap the file content in. When this is + =example=, =export=, or =src= the content is escaped by + ~org-escape-code-in-string~. Arbitrary block names may be given, + however block names starting with =:= must be quoted, i.e. =":name"=. +3. The source code language to use for formatting the contents. This is relevant + to both =export= and =src= block types. #+cindex: @samp{minlevel}, include If an included file is not specified as having any markup language, @@ -12214,11 +12622,11 @@ be omitted to use the obvious defaults. | =#+INCLUDE: "~/.emacs" :lines "10-"= | Include lines from 10 to EOF | Inclusions may specify a file-link to extract an object matched by -~org-link-search~[fn:43] (see [[*Search Options in File Links]]). The +~org-link-search~[fn:44] (see [[*Search Options in File Links]]). The ranges for =:lines= keyword are relative to the requested element. Therefore, -: #+INCLUDE: "./paper.org::*conclusion" :lines 1-20 +: #+INCLUDE: "./paper.org::*conclusion" :lines "1-20" #+texinfo: @noindent includes the first 20 lines of the headline named =conclusion=. @@ -12254,7 +12662,7 @@ following syntax: : #+MACRO: name replacement text; $1, $2 are arguments #+texinfo: @noindent -which can be referenced using ={{{name(arg1, arg2)}}}=[fn:44]. For +which can be referenced using ={{{name(arg1, arg2)}}}=[fn:45]. For example #+begin_example @@ -12280,7 +12688,7 @@ turns ={{{gnustamp(linux)}}}= into =GNU/Linux= during export. Org recognizes macro references in following Org markup areas: paragraphs, headlines, verse blocks, tables cells and lists. Org also recognizes macro references in keywords, such as =CAPTION=, =TITLE=, -=AUTHOR=, =DATE=, and for some back-end specific export options. +=AUTHOR=, =DATE=, and for some backend specific export options. Org comes with following pre-defined macros: @@ -12437,7 +12845,7 @@ See the variable ~org-ascii-links-to-notes~ for details. :UNNUMBERED: notoc :END: -The ASCII export back-end has one extra keyword for customizing ASCII +The ASCII export backend has one extra keyword for customizing ASCII output. Setting this keyword works similar to the general options (see [[*Export Settings]]). @@ -12462,7 +12870,7 @@ cut-off point where levels become lists, see [[*Export Settings]]. :UNNUMBERED: notoc :END: -To insert text within the Org file by the ASCII back-end, use one the +To insert text within the Org file by the ASCII backend, use one the following constructs, inline, keyword, or export block: #+cindex: @samp{ASCII}, keyword @@ -12473,7 +12881,7 @@ Inline text @@ascii:and additional text@@ within a paragraph. ,#+ASCII: Some text ,#+BEGIN_EXPORT ascii -Org exports text in this block only when using ASCII back-end. +Org exports text in this block only when using ASCII backend. ,#+END_EXPORT #+end_example @@ -12484,7 +12892,7 @@ Org exports text in this block only when using ASCII back-end. #+cindex: @samp{ATTR_ASCII}, keyword #+cindex: horizontal rules, in ASCII export -ASCII back-end recognizes only one attribute, =:width=, which +ASCII backend recognizes only one attribute, =:width=, which specifies the width of a horizontal rule in number of characters. The keyword and syntax for specifying widths is: @@ -12501,7 +12909,7 @@ keyword and syntax for specifying widths is: #+cindex: @samp{BEGIN_JUSTIFYLEFT} #+cindex: @samp{BEGIN_JUSTIFYRIGHT} -Besides =#+BEGIN_CENTER= blocks (see [[*Paragraphs]]), ASCII back-end has +Besides =#+BEGIN_CENTER= blocks (see [[*Paragraphs]]), ASCII backend has these two left and right justification blocks: #+begin_example @@ -12560,7 +12968,7 @@ popular display formats. :DESCRIPTION: For customizing Beamer export. :END: -Beamer export back-end has several additional keywords for customizing +Beamer export backend has several additional keywords for customizing Beamer output. These keywords work similar to the general options settings (see [[*Export Settings]]). @@ -12646,7 +13054,7 @@ should in principle be exportable as a Beamer presentation. - Org exports a Beamer frame's objects as block environments. Org can enforce wrapping in special block types when =BEAMER_ENV= property - is set[fn:45]. For valid values see + is set[fn:46]. For valid values see ~org-beamer-environments-default~. To add more values, see ~org-beamer-environments-extra~. #+vindex: org-beamer-environments-default @@ -12673,7 +13081,7 @@ should in principle be exportable as a Beamer presentation. headline as an overlay or action specification. When enclosed in square brackets, Org export makes the overlay specification a default. Use =BEAMER_OPT= to set any options applicable to the - current Beamer frame or block. The Beamer export back-end wraps + current Beamer frame or block. The Beamer export backend wraps with appropriate angular or square brackets. It also adds the =fragile= option for any code that may require a verbatim block. @@ -12695,8 +13103,8 @@ should in principle be exportable as a Beamer presentation. :DESCRIPTION: For using in Org documents. :END: -Since Org's Beamer export back-end is an extension of the LaTeX -back-end, it recognizes other LaTeX specific syntax---for example, +Since Org's Beamer export backend is an extension of the LaTeX +backend, it recognizes other LaTeX specific syntax---for example, =#+LATEX:= or =#+ATTR_LATEX:=. See [[*LaTeX Export]], for details. Beamer export wraps the table of contents generated with =toc:t= @@ -12714,7 +13122,7 @@ Insert Beamer-specific code using the following constructs: ,#+BEAMER: \pause ,#+BEGIN_EXPORT beamer - Only Beamer export back-end exports this. + Only Beamer export backend exports this. ,#+END_EXPORT Text @@beamer:some code@@ within a paragraph. @@ -12965,7 +13373,7 @@ introduced with the HTML5 standard. To enable them, set ~org-html-html5-fancy~ to non-~nil~. Or use an =OPTIONS= line in the file to set =html5-fancy=. -HTML5 documents can now have arbitrary =#+BEGIN= ... =#+END= blocks. +HTML5 documents can have arbitrary =#+BEGIN= ... =#+END= blocks. For example: #+begin_example @@ -13046,13 +13454,39 @@ a postamble from looking up author's name, email address, creator's name, and date. +*** Exporting to minimal HTML +:PROPERTIES: +:DESCRIPTION: Exporting HTML without CSS, Javascript, etc. +:ALT_TITLE: Bare HTML +:END: + +If you want to output a minimal HTML file, with no CSS, no Javascript, +no preamble or postamble, here are the variable you would need to set: + +#+vindex: org-html-head +#+vindex: org-html-head-extra +#+vindex: org-html-head-include-default-style +#+vindex: org-html-head-include-scripts +#+vindex: org-html-preamble +#+vindex: org-html-postamble +#+vindex: org-html-use-infojs +#+begin_src emacs-lisp +(setq org-html-head "" + org-html-head-extra "" + org-html-head-include-default-style nil + org-html-head-include-scripts nil + org-html-preamble nil + org-html-postamble nil + org-html-use-infojs nil) +#+end_src + *** Quoting HTML tags :PROPERTIES: :DESCRIPTION: Using direct HTML in Org files. :END: -The HTML export back-end transforms =<= and =>= to =<= and =>=. -To include raw HTML code in the Org file so the HTML export back-end +The HTML export backend transforms =<= and =>= to =<= and =>=. +To include raw HTML code in the Org file so the HTML export backend can insert that HTML code in the output, use this inline syntax: =@@html:...@@=. For example: @@ -13093,25 +13527,25 @@ a =href= attribute making the headlines link to themselves. #+cindex: internal links, in HTML export #+cindex: external links, in HTML export -The HTML export back-end transforms Org's internal links (see -[[*Internal Links]]) to equivalent HTML links in the output. The back-end +The HTML export backend transforms Org's internal links (see +[[*Internal Links]]) to equivalent HTML links in the output. The backend similarly handles Org's automatic links created by radio targets (see [[*Radio Targets]]) similarly. For Org links to external files, the -back-end transforms the links to /relative/ paths. +backend transforms the links to /relative/ paths. #+vindex: org-html-link-org-files-as-html -For Org links to other =.org= files, the back-end automatically +For Org links to other =.org= files, the backend automatically changes the file extension to =.html= and makes file paths relative. If the =.org= files have an equivalent =.html= version at the same location, then the converted links should work without any further manual intervention. However, to disable this automatic path translation, set ~org-html-link-org-files-as-html~ to ~nil~. When -disabled, the HTML export back-end substitutes the ID-based links in +disabled, the HTML export backend substitutes the ID-based links in the HTML output. For more about linking files when publishing to a directory, see [[*Publishing links]]. Org files can also have special directives to the HTML export -back-end. For example, by using =#+ATTR_HTML= lines to specify new +backend. For example, by using =#+ATTR_HTML= lines to specify new format attributes to ~~ or ~~ tags. This example shows changing the link's title and style: @@ -13128,7 +13562,7 @@ changing the link's title and style: #+cindex: tables, in HTML #+vindex: org-export-html-table-tag -The HTML export back-end uses ~org-html-table-default-attributes~ when +The HTML export backend uses ~org-html-table-default-attributes~ when exporting Org tables to HTML. By default, the exporter does not draw frames and cell borders. To change for this for a table, use the following lines before the table in the Org file: @@ -13140,7 +13574,7 @@ following lines before the table in the Org file: ,#+ATTR_HTML: :border 2 :rules all :frame border #+end_example -The HTML export back-end preserves column groupings in Org tables (see +The HTML export backend preserves column groupings in Org tables (see [[*Column Groups]]) when exporting to HTML. Additional options for customizing tables for HTML export. @@ -13188,20 +13622,20 @@ Additional options for customizing tables for HTML export. #+cindex: images, inline in HTML #+cindex: inlining images in HTML -The HTML export back-end has features to convert Org image links to +The HTML export backend has features to convert Org image links to HTML inline images and HTML clickable image links. #+vindex: org-html-inline-images When the link in the Org file has no description, the HTML export -back-end by default in-lines that image. For example: +backend by default in-lines that image. For example: =[[file:myimg.jpg]]= is in-lined, while =[[file:myimg.jpg][the image]]= links to the text, =the image=. For more details, see the variable ~org-html-inline-images~. On the other hand, if the description part of the Org link is itself another link, such as =file:= or =http:= URL pointing to an image, the -HTML export back-end in-lines this image and links to the main image. -This Org syntax enables the back-end to link low-resolution thumbnail +HTML export backend in-lines this image and links to the main image. +This Org syntax enables the backend to link low-resolution thumbnail to the high-resolution version of the image, as shown in this example: : [[file:highres.jpg][file:thumb.jpg]] @@ -13219,7 +13653,7 @@ accessibility standards. [[./img/a.jpg]] #+end_example -The HTML export back-end copies the =http= links from the Org file +The HTML export backend copies the =http= links from the Org file as-is. *** Math formatting in HTML export @@ -13238,7 +13672,7 @@ different ways on HTML pages. The default is to use the with Org[fn:: By default, Org loads MathJax from [[https://www.jsdelivr.com/][jsDelivr]], as recommended in [[https://docs.mathjax.org/en/latest/web/start.html][Getting Started -with MathJax Components]].][fn:46]. Some MathJax display options can +with MathJax Components]].][fn:47]. Some MathJax display options can be configured via ~org-html-mathjax-options~, or in the buffer. For example, with the following settings, @@ -13282,12 +13716,12 @@ HTML was by using =:textarea=. The advantage of this approach was that copying and pasting was built into browsers with simple JavaScript commands. Even editing before pasting was made simple. -The HTML export back-end can create such text areas. It requires an +The HTML export backend can create such text areas. It requires an =#+ATTR_HTML= line as shown in the example below with the =:textarea= option. This must be followed by either an example or a source code block. Other Org block types do not honor the =:textarea= option. -By default, the HTML export back-end creates a text area 80 characters +By default, the HTML export backend creates a text area 80 characters wide and height just enough to fit the content. Override these defaults with =:width= and =:height= options on the =#+ATTR_HTML= line. @@ -13354,7 +13788,7 @@ classes like for headlines, tables, etc. #+vindex: org-html-head #+vindex: org-html-head-extra #+cindex: @samp{HTML_INCLUDE_STYLE}, keyword -The HTML export back-end includes a compact default style in each +The HTML export backend includes a compact default style in each exported HTML file. To override the default style with another style, use these keywords in the Org file. They will replace the global defaults the HTML exporter uses. @@ -13483,7 +13917,7 @@ to your pages, configure the variable ~org-export-html-use-infojs~. #+cindex: @LaTeX{} export #+cindex: PDF export -The LaTeX export back-end can handle complex documents, incorporate +The LaTeX export backend can handle complex documents, incorporate standard or custom LaTeX document classes, generate documents using alternate LaTeX engines, and produce fully linked PDF files with indexes, bibliographies, and tables of contents, destined for @@ -13495,10 +13929,17 @@ quick references to variables for the impatient: for engines, see ~org-latex-pdf-process~; for packages, see ~org-latex-default-packages-alist~ and ~org-latex-packages-alist~. -An important note about the LaTeX export back-end: it is sensitive to +An important note about the LaTeX export backend: it is sensitive to blank lines in the Org document. That's because LaTeX itself depends on blank lines to tell apart syntactical elements, such as paragraphs. +The following sections expect users to be familiar with common LaTeX +terminology. You may refer to https://tug.org/begin.html to get +familiar with LaTeX basics. Users with LaTeX installed may also run +=texdoc latex= from terminal to open LaTeX introduction [fn:: The +command will open a PDF file, which is also available for download +from http://mirrors.ctan.org/info/latex-doc-ptr/latex-doc-ptr.pdf] + *** LaTeX/PDF export commands :PROPERTIES: :DESCRIPTION: For producing @LaTeX{} and PDF documents. @@ -13542,22 +13983,22 @@ on blank lines to tell apart syntactical elements, such as paragraphs. #+cindex: xelatex #+cindex: lualatex #+cindex: @samp{LATEX_COMPILER}, keyword -The LaTeX export back-end can use any of these LaTeX engines: +The LaTeX export backend can use any of these LaTeX engines: =pdflatex=, =xelatex=, and =lualatex=. These engines compile LaTeX files with different compilers, packages, and output options. The -LaTeX export back-end finds the compiler version to use from +LaTeX export backend finds the compiler version to use from ~org-latex-compiler~ variable or the =#+LATEX_COMPILER= keyword in the Org file. See the docstring for the ~org-latex-default-packages-alist~ for loading packages with certain compilers. Also see ~org-latex-bibtex-compiler~ to set the -bibliography compiler[fn:47]. +bibliography compiler[fn:48]. *** LaTeX specific export settings :PROPERTIES: -:DESCRIPTION: Unique to this @LaTeX{} back-end. +:DESCRIPTION: Unique to this @LaTeX{} backend. :END: -The LaTeX export back-end has several additional keywords for +The LaTeX export backend has several additional keywords for customizing LaTeX output. Setting these keywords works similar to the general options (see [[*Export Settings]]). @@ -13577,8 +14018,11 @@ general options (see [[*Export Settings]]). #+cindex: @samp{LANGUAGE}, keyword #+vindex: org-latex-packages-alist #+vindex: org-latex-language-alist + #+vindex: org-export-default-language - Language code of the primary document language. + Language code of the primary document language. When =LANGUAGE= + keyword is not not specified use the value of + ~org-export-default-language~ (by default - =en=, American English) The list of language codes supported by Org is stored in the variable ~org-latex-language-alist~. @@ -13604,7 +14048,7 @@ general options (see [[*Export Settings]]). #+vindex: org-latex-classes This is LaTeX document class, such as /article/, /report/, /book/, and so on, which contain predefined preamble and headline level - mapping that the LaTeX export back-end needs. The back-end reads + mapping that the LaTeX export backend needs. The backend reads the default class name from the ~org-latex-default-class~ variable. Org has /article/ as the default class. A valid default class must be an element of ~org-latex-classes~. @@ -13612,7 +14056,7 @@ general options (see [[*Export Settings]]). - =LATEX_CLASS_OPTIONS= :: #+cindex: @samp{LATEX_CLASS_OPTIONS}, keyword - Options the LaTeX export back-end uses when calling the LaTeX + Options the LaTeX export backend uses when calling the LaTeX document class. - =LATEX_COMPILER= :: @@ -13668,12 +14112,12 @@ The following sections have further details. #+cindex: header, for @LaTeX{} files #+cindex: sectioning structure, for @LaTeX{} export -The LaTeX export back-end converts the first three of Org's outline +The LaTeX export backend converts the first three of Org's outline levels into LaTeX headlines. The remaining Org levels are exported as lists. To change this globally for the cut-off point between levels and lists, (see [[*Export Settings]]). -By default, the LaTeX export back-end uses the /article/ class. +By default, the LaTeX export backend uses the /article/ class. #+vindex: org-latex-default-class #+vindex: org-latex-classes @@ -13693,7 +14137,7 @@ custom sectioning or custom classes. #+cindex: @samp{LATEX_CLASS_OPTIONS}, keyword #+cindex: @samp{EXPORT_LATEX_CLASS}, property #+cindex: @samp{EXPORT_LATEX_CLASS_OPTIONS}, property -The LaTeX export back-end sends the =LATEX_CLASS_OPTIONS= keyword and +The LaTeX export backend sends the =LATEX_CLASS_OPTIONS= keyword and =EXPORT_LATEX_CLASS_OPTIONS= property as options to the LaTeX ~\documentclass~ macro. The options and the syntax for specifying them, including enclosing them in square brackets, follow LaTeX @@ -13703,10 +14147,10 @@ conventions. #+cindex: @samp{LATEX_HEADER}, keyword #+cindex: @samp{LATEX_HEADER_EXTRA}, keyword -The LaTeX export back-end appends values from =LATEX_HEADER= and +The LaTeX export backend appends values from =LATEX_HEADER= and =LATEX_HEADER_EXTRA= keywords to the LaTeX header. The docstring for ~org-latex-classes~ explains in more detail. Also note that LaTeX -export back-end does not append =LATEX_HEADER_EXTRA= to the header +export backend does not append =LATEX_HEADER_EXTRA= to the header when previewing LaTeX snippets (see [[*Previewing LaTeX fragments]]). A sample Org file with the above headers: @@ -13775,9 +14219,10 @@ This would produce in LaTeX (with the actual =polyglossia= syntax): :DESCRIPTION: Incorporating literal @LaTeX{} code. :END: -The LaTeX export back-end can insert any arbitrary LaTeX code, see -[[*Embedded LaTeX]]. There are three ways to embed such code in the Org -file and they all use different quoting syntax. +When the available LaTeX export customizations are not sufficient to +fine-tune the desired output, it is possible to insert any arbitrary +LaTeX code (see [[*Embedded LaTeX]]). There are three ways to embed such +code in the Org file and they all use different quoting syntax. #+cindex: inline, in @LaTeX{} export Inserting in-line quoted with @ symbols: @@ -13790,7 +14235,7 @@ Inserting as one or more keyword lines in the Org file: : #+LATEX: any arbitrary LaTeX code #+cindex: @samp{BEGIN_EXPORT latex} -Inserting as an export block in the Org file, where the back-end +Inserting as an export block in the Org file, where the backend exports any code between begin and end markers: #+begin_example @@ -13805,7 +14250,7 @@ exports any code between begin and end markers: :END: #+cindex: tables, in @LaTeX{} export -The LaTeX export back-end can pass several LaTeX attributes for table +The LaTeX export backend can pass several LaTeX attributes for table contents and layout. Besides specifying a label (see [[*Internal Links]]) and a caption (see [[*Captions]]), the other valid LaTeX attributes include: @@ -13814,27 +14259,27 @@ include: - =:mode= :: #+vindex: org-latex-default-table-mode - The LaTeX export back-end wraps the table differently depending on + The LaTeX export backend wraps the table differently depending on the mode for accurate rendering of math symbols. Mode is either =table=, =math=, =inline-math=, =verbatim= or =tabbing=. - For =math= or =inline-math= mode, LaTeX export back-end wraps the + For =math= or =inline-math= mode, LaTeX export backend wraps the table in a math environment, but every cell in it is exported as-is. For =tabbing= the LaTeX tabbing environment is used and the correct tabbing delimiters =\>= are used. - The LaTeX export back-end determines the default mode from - ~org-latex-default-table-mode~. The LaTeX export back-end merges + The LaTeX export backend determines the default mode from + ~org-latex-default-table-mode~. The LaTeX export backend merges contiguous tables in the same mode into a single environment. - =:environment= :: #+vindex: org-latex-default-table-environment Set the default LaTeX table environment for the LaTeX export - back-end to use when exporting Org tables. Common LaTeX table + backend to use when exporting Org tables. Common LaTeX table environments are provided by these packages: tabularx, longtable, array, tabu, and bmatrix. For packages, such as tabularx and tabu, or any newer replacements, include them in the - ~org-latex-packages-alist~ variable so the LaTeX export back-end can + ~org-latex-packages-alist~ variable so the LaTeX export backend can insert the appropriate load package headers in the converted LaTeX file. Look in the docstring for the ~org-latex-packages-alist~ variable for configuring these packages for LaTeX snippet previews, @@ -13860,11 +14305,11 @@ include: LaTeX floats can also have additional layout =:placement= attributes. These are the usual =[h t b p ! H]= permissions specified in square brackets. Note that for =:float sideways= - tables, the LaTeX export back-end ignores =:placement= attributes. + tables, the LaTeX export backend ignores =:placement= attributes. - =:align=, =:font=, =:width= :: - The LaTeX export back-end uses these attributes for regular tables + The LaTeX export backend uses these attributes for regular tables to set their alignments, fonts, and widths. - =:options= :: @@ -13877,7 +14322,7 @@ include: - =:spread= :: - When =:spread= is non-~nil~, the LaTeX export back-end spreads or + When =:spread= is non-~nil~, the LaTeX export backend spreads or shrinks the table by the =:width= for tabu and longtabu environments. =:spread= has no effect if =:width= is not set. @@ -13894,10 +14339,10 @@ include: - =:math-prefix=, =:math-suffix=, =:math-arguments= :: - The LaTeX export back-end inserts =:math-prefix= string value in - a math environment before the table. The LaTeX export back-end + The LaTeX export backend inserts =:math-prefix= string value in + a math environment before the table. The LaTeX export backend inserts =:math-suffix= string value in a math environment after the - table. The LaTeX export back-end inserts =:math-arguments= string + table. The LaTeX export backend inserts =:math-arguments= string value between the macro name and the table's contents. =:math-arguments= comes in use for matrix macros that require more than one argument, such as =qbordermatrix=. @@ -13935,13 +14380,13 @@ Set the caption with the LaTeX command #+cindex: inlining images in LaTeX #+cindex: @samp{ATTR_LATEX}, keyword -The LaTeX export back-end processes image links in Org files that do +The LaTeX export backend processes image links in Org files that do not have descriptions, such as these links =[[file:img.jpg]]= or =[[./img.jpg]]=, as direct image insertions in the final PDF output. In the PDF, they are no longer links but actual images embedded on the -page. The LaTeX export back-end uses =\includegraphics= macro to +page. The LaTeX export backend uses =\includegraphics= macro to insert the image. But for TikZ (https://sourceforge.net/projects/pgf/) -images, the back-end uses an ~\input~ macro wrapped within +images, the backend uses an ~\input~ macro wrapped within a ~tikzpicture~ environment. For specifying image =:width=, =:height=, =:scale= and other =:options=, @@ -13963,7 +14408,7 @@ overrides the default =#+CAPTION= value: #+end_example When captions follow the method as described in [[*Captions]], the LaTeX -export back-end wraps the picture in a floating =figure= environment. +export backend wraps the picture in a floating =figure= environment. To float an image without specifying a caption, set the =:float= attribute to one of the following: @@ -13973,7 +14418,7 @@ attribute to one of the following: - =multicolumn= :: - To span the image across multiple columns of a page; the back-end + To span the image across multiple columns of a page; the backend wraps the image in a =figure*= environment. - =wrap= :: @@ -14007,12 +14452,12 @@ placement. #+vindex: org-latex-images-centered #+cindex: center image in LaTeX export #+cindex: image, centering in LaTeX export -The LaTeX export back-end centers all images by default. Setting +The LaTeX export backend centers all images by default. Setting =:center= to =nil= disables centering. To disable centering globally, set ~org-latex-images-centered~ to =nil=. Set the =:comment-include= attribute to non-~nil~ value for the LaTeX -export back-end to comment out the =\includegraphics= macro. +export backend to comment out the =\includegraphics= macro. *** Plain lists in LaTeX export :PROPERTIES: @@ -14021,7 +14466,7 @@ export back-end to comment out the =\includegraphics= macro. #+cindex: plain lists, in @LaTeX{} export #+cindex: @samp{ATTR_LATEX}, keyword -The LaTeX export back-end accepts the =environment= and =options= +The LaTeX export backend accepts the =environment= and =options= attributes for plain lists. Both attributes work together for customizing lists, as shown in the examples: @@ -14057,7 +14502,16 @@ four: #+cindex: source blocks, in @LaTeX{} export #+cindex: @samp{ATTR_LATEX}, keyword -The LaTeX export back-end can make source code blocks into floating +#+vindex: org-latex-src-block-backend +LaTeX export backend provides multiple ways to render src blocks in +LaTeX, according to the value of ~org-latex-src-block-backend~. The +default value =verbatim= renders the src code verbatim, without any +extra styling. Alternative values allow more colorful styling, but +require additional LaTeX (=listings=, =minted=), system (=minted=), or +Emacs (=engraved=) packages. See the ~org-latex-src-block-backend~ +docstring for more details. + +The LaTeX export backend can make source code blocks into floating objects through the attributes =:float= and =:options=. For =:float=: - =t= :: @@ -14084,7 +14538,7 @@ objects through the attributes =:float= and =:options=. For =:float=: #+vindex: org-latex-listings-options #+vindex: org-latex-minted-options #+vindex: org-latex-engraved-options -The LaTeX export back-end passes string values in =:options= to LaTeX +The LaTeX export backend passes string values in =:options= to LaTeX packages for customization of that specific source block. In the example below, the =:options= are set for Engraved or Minted. Minted is a source code highlighting LaTeX package with many configurable @@ -14115,7 +14569,7 @@ variables. #+cindex: verbatim blocks, in @LaTeX{} export #+cindex: @samp{ATTR_LATEX}, keyword -The LaTeX export back-end wraps the contents of example blocks in +The LaTeX export backend wraps the contents of example blocks in a =verbatim= environment. To change this behavior to use another environment globally, specify an appropriate export filter (see [[*Advanced Export Configuration]]). To change this behavior to use @@ -14139,8 +14593,8 @@ to specify a custom environment. #+cindex: proof, in @LaTeX{} export #+cindex: @samp{ATTR_LATEX}, keyword -For other special blocks in the Org file, the LaTeX export back-end -makes a special environment of the same name. The back-end also takes +For other special blocks in the Org file, the LaTeX export backend +makes a special environment of the same name. The backend also takes =:options=, if any, and appends as-is to that environment's opening string. For example: @@ -14188,7 +14642,7 @@ example: #+cindex: horizontal rules, in @LaTeX{} export #+cindex: @samp{ATTR_LATEX}, keyword -The LaTeX export back-end converts horizontal rules by the specified +The LaTeX export backend converts horizontal rules by the specified =:width= and =:thickness= attributes. For example: #+begin_example @@ -14204,10 +14658,10 @@ The LaTeX export back-end converts horizontal rules by the specified #+cindex: verse blocks, in @LaTeX{} export #+cindex: @samp{ATTR_LATEX}, keyword -The LaTeX export back-end accepts four attributes for verse blocks: -=:lines=, =:center=, =:versewidth= and =:latexcode=. The three first -require the external LaTeX package =verse.sty=, which is an extension -of the standard LaTeX environment. +The LaTeX export backend accepts five attributes for verse blocks: +=:lines=, =:center=, =:versewidth=, =:latexcode= and =:literal=. The +three first require the external LaTeX package =verse.sty=, which is +an extension of the standard LaTeX environment. - =:lines= :: To add marginal verse numbering. Its value is an integer, the sequence in which the verses should be numbered. @@ -14219,6 +14673,16 @@ of the standard LaTeX environment. verse. - =:latexcode= :: It accepts any arbitrary LaTeX code that can be included within a LaTeX =verse= environment. +- =:literal= :: With value t, all blank lines are preserved and + exported as =\vspace*{\baselineskip}=, including the blank lines + before or after contents. Note that without the =:literal= + attribute, one or more blank lines between stanzas are exported as a + single blank line, and any blank lines before or after the content + are removed, which is more consistent with the syntax of the LaTeX + `verse' environment, and the one provided by the =verse= package. + If the =verse= package is loaded, the vertical spacing between all + stanzas can be controlled by the global length =\stanzaskip= (see + https://www.ctan.org/pkg/verse). A complete example with Shakespeare's first sonnet: @@ -14252,7 +14716,7 @@ To eat the world’s due, by the grave and thee. #+cindex: @samp{ATTR_LATEX}, keyword #+cindex: org-latex-default-quote-environment -The LaTeX export back-end accepts two attributes for quote blocks: +The LaTeX export backend accepts two attributes for quote blocks: =:environment=, for an arbitrary quoting environment (the default value is that of ~org-latex-default-quote-environment~: ~"quote"~) and =:options=. For example, to choose the environment =quotation=, @@ -14291,12 +14755,18 @@ some text in German... :END: #+cindex: Markdown export -The Markdown export back-end, "md", converts an Org file to Markdown +The Markdown export backend, "md", converts an Org file to Markdown format, as defined at https://daringfireball.net/projects/markdown/. +This is the original Markdown specification, developed by John Gruber +and Aaron Swartz. + +Since "md" backend is built on top of the HTML backend (see [[*HTML +Export]]), it converts every Org construct not defined in Markdown +syntax, such as tables, to HTML. -Since it is built on top of the HTML back-end (see [[*HTML Export]]), it -converts every Org construct not defined in Markdown syntax, such as -tables, to HTML. +Do note that the original markdown syntax has differences with other +commonly used Markdown flavors. See +https://en.wikipedia.org/wiki/Markdown for more details. *** Markdown export commands :PROPERTIES: @@ -14328,10 +14798,12 @@ tables, to HTML. #+vindex: org-md-headline-style Based on ~org-md-headline-style~, Markdown export can generate -headlines of both /atx/ and /setext/ types. /atx/ limits headline -levels to two whereas /setext/ limits headline levels to six. Beyond -these limits, the export back-end converts headlines to lists. To set -a limit to a level before the absolute limit (see [[*Export Settings]]). +headlines of both /atx/ and /setext/ types. /setext/ limits headline +levels to two whereas /atx/ limits headline levels to six. /mixed/ +exports headline levels one and two in /setext/-style, and headline +levels three through six as /atx/-style headlines. Beyond these +limits, the export backend converts headlines to lists. To set a +limit to a level before the absolute limit (see [[*Export Settings]]). ** OpenDocument Text Export :PROPERTIES: @@ -14342,7 +14814,7 @@ a limit to a level before the absolute limit (see [[*Export Settings]]). #+cindex: export, OpenDocument #+cindex: LibreOffice -The ODT export back-end handles creating of OpenDocument Text (ODT) +The ODT export backend handles creating of OpenDocument Text (ODT) format. Documents created by this exporter use the {{{cite(OpenDocument-v1.2 specification)}}}[fn:: See [[https://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open @@ -14355,7 +14827,7 @@ and are compatible with LibreOffice 3.4. :END: #+cindex: zip -The ODT export back-end relies on the zip program to create the final +The ODT export backend relies on the zip program to create the final compressed ODT output. Check if =zip= is locally available and executable. Without it, export cannot finish. @@ -14374,16 +14846,16 @@ executable. Without it, export cannot finish. #+vindex: org-odt-preferred-output-format If ~org-odt-preferred-output-format~ is specified, the ODT export - back-end automatically converts the exported file to that format. + backend automatically converts the exported file to that format. For =myfile.org=, Org exports to =myfile.odt=, overwriting without - warning. The ODT export back-end exports a region only if a region + warning. The ODT export backend exports a region only if a region was active. - If the selected region is a single tree, the ODT export back-end + If the selected region is a single tree, the ODT export backend makes the tree head the document title. Incidentally, {{{kbd(C-c @)}}} selects the current subtree. If the tree head entry has, or - inherits, an =EXPORT_FILE_NAME= property, the ODT export back-end + inherits, an =EXPORT_FILE_NAME= property, the ODT export backend uses that for file name. - {{{kbd(C-c C-e o O)}}} :: @@ -14401,21 +14873,21 @@ executable. Without it, export cannot finish. :DESCRIPTION: Configuration options. :END: -The ODT export back-end has several additional keywords for +The ODT export backend has several additional keywords for customizing ODT output. Setting these keywords works similar to the general options (see [[*Export Settings]]). - =DESCRIPTION= :: #+cindex: @samp{DESCRIPTION}, keyword - This is the document's description, which the ODT export back-end + This is the document's description, which the ODT export backend inserts as document metadata. For long descriptions, use multiple lines, prefixed with =DESCRIPTION=. - =KEYWORDS= :: #+cindex: @samp{KEYWORDS}, keyword - The keywords for the document. The ODT export back-end inserts the + The keywords for the document. The ODT export backend inserts the description along with author name, keywords, and related file metadata as metadata in the output file. Use multiple =KEYWORDS= if necessary. @@ -14424,7 +14896,7 @@ general options (see [[*Export Settings]]). #+cindex: @samp{ODT_STYLES_FILE}, keyword #+vindex: org-odt-styles-file - The ODT export back-end uses the ~org-odt-styles-file~ by default. + The ODT export backend uses the ~org-odt-styles-file~ by default. See [[*Applying custom styles]] for details. - =SUBTITLE= :: @@ -14437,7 +14909,7 @@ general options (see [[*Export Settings]]). :DESCRIPTION: Producing DOC, PDF files. :END: -The ODT export back-end can produce documents in other formats besides +The ODT export backend can produce documents in other formats besides ODT using a specialized ODT converter process. Its common interface works with popular converters to produce formats such as =doc=, or convert a document from one format, say =csv=, to another format, say @@ -14459,7 +14931,7 @@ a document converter]]. #+vindex: org-odt-preferred-output-format If ODT format is just an intermediate step to get to other formats, such as =doc=, =docx=, =rtf=, or =pdf=, etc., then extend the ODT -export back-end to directly produce that format. Specify the final +export backend to directly produce that format. Specify the final format in the ~org-odt-preferred-output-format~ variable. This is one way to extend (see [[*ODT export commands]]). @@ -14468,7 +14940,7 @@ way to extend (see [[*ODT export commands]]). :UNNUMBERED: notoc :END: -The Org export back-end is made to be inter-operable with a wide range +The Org export backend is made to be inter-operable with a wide range of text document format converters. Newer generation converters, such as LibreOffice and Pandoc, can handle hundreds of formats at once. Org provides a consistent interaction with whatever converter is @@ -14487,7 +14959,7 @@ installed. Here are some generic commands: #+cindex: styles, custom #+cindex: template, custom -The ODT export back-end comes with many OpenDocument styles (see +The ODT export backend comes with many OpenDocument styles (see [[*Working with OpenDocument style files]]). To expand or further customize these built-in style sheets, either edit the style sheets directly or generate them using an application such as LibreOffice. @@ -14530,7 +15002,7 @@ The example here shows creating a style using LibreOffice. :UNNUMBERED: notoc :END: -The ODT export back-end relies on many templates and style names. +The ODT export backend relies on many templates and style names. Using third-party styles and templates can lead to mismatches. Templates derived from built-in ODT templates and styles seem to have fewer problems. @@ -14559,18 +15031,18 @@ with a cross-reference and sequence number of the labeled entity. See #+cindex: tables, in ODT export -The ODT export back-end handles native Org mode tables (see [[*Tables]]) +The ODT export backend handles native Org mode tables (see [[*Tables]]) and simple =table.el= tables. Complex =table.el= tables having column or row spans are not supported. Such tables are stripped from the exported document. -By default, the ODT export back-end exports a table with top and +By default, the ODT export backend exports a table with top and bottom frames and with ruled lines separating row and column groups (see [[*Column Groups]]). All tables are typeset to occupy the same -width. The ODT export back-end honors any table alignments and +width. The ODT export backend honors any table alignments and relative widths for columns (see [[*Column Width and Alignment]]). -Note that the ODT export back-end interprets column widths as weighted +Note that the ODT export backend interprets column widths as weighted ratios, the default weight being 1. #+cindex: @samp{ATTR_ODT}, keyword @@ -14612,7 +15084,7 @@ tables in ODT export]]. :UNNUMBERED: notoc :END: -The ODT export back-end processes image links in Org files that do not +The ODT export backend processes image links in Org files that do not have descriptions, such as these links =[[file:img.jpg]]= or =[[./img.jpg]]=, as direct image insertions in the final output. Either of these examples works: @@ -14645,13 +15117,13 @@ attribute. #+cindex: identify, ImageMagick #+vindex: org-odt-pixels-per-inch -The ODT export back-end starts with establishing the size of the image +The ODT export backend starts with establishing the size of the image in the final document. The dimensions of this size are measured in -centimeters. The back-end then queries the image file for its -dimensions measured in pixels. For this measurement, the back-end +centimeters. The backend then queries the image file for its +dimensions measured in pixels. For this measurement, the backend relies on ImageMagick's identify program or Emacs ~create-image~ and ~image-size~ API. ImageMagick is the preferred choice for large file -sizes or frequent batch operations. The back-end then converts the +sizes or frequent batch operations. The backend then converts the pixel dimensions using ~org-odt-pixels-per-inch~ into the familiar 72 dpi or 96 dpi. The default value for this is in ~display-pixels-per-inch~, which can be tweaked for better results @@ -14702,7 +15174,7 @@ image scaling operations: :END: #+cindex: @samp{ATTR_ODT}, keyword -The ODT export back-end can anchor images to =as-char=, =paragraph=, +The ODT export backend can anchor images to =as-char=, =paragraph=, or =page=. Set the preferred anchor using the =:anchor= property of the =ATTR_ODT= line. @@ -14765,7 +15237,7 @@ document in one of the following ways: #+begin_src emacs-lisp (setq org-latex-to-mathml-convert-command - "latexmlmath \"%i\" --presentationmathml=%o") + "latexmlmath %i --presentationmathml=%o") #+end_src To quickly verify the reliability of the LaTeX-to-MathML @@ -14863,9 +15335,9 @@ With the above modification, the previous example changes to: :DESCRIPTION: For source code and example blocks. :END: -The ODT export back-end supports literal examples (see [[*Literal +The ODT export backend supports literal examples (see [[*Literal Examples]]) with full fontification. Internally, the ODT export -back-end relies on =htmlfontify.el= to generate the style definitions +backend relies on =htmlfontify.el= to generate the style definitions needed for fancy listings. The auto-generated styles get =OrgSrc= prefix and inherit colors from the faces used by Emacs Font Lock library for that source language. @@ -14883,7 +15355,7 @@ To turn off fontification of literal examples, customize the :DESCRIPTION: For power users. :END: -The ODT export back-end has extensive features useful for power users +The ODT export backend has extensive features useful for power users and frequent uses of ODT formats. **** Configuring a document converter @@ -14895,7 +15367,7 @@ and frequent uses of ODT formats. #+cindex: doc, docx, rtf #+cindex: converter -The ODT export back-end works with popular converters with little or +The ODT export backend works with popular converters with little or no extra configuration. See [[*Extending ODT export]]. The following is for unsupported converters or tweaking existing defaults. @@ -14969,7 +15441,7 @@ factory styles used by the exporter. - ~org-odt-styles-file~ :: - The ODT export back-end uses the file pointed to by this variable, + The ODT export backend uses the file pointed to by this variable, such as =styles.xml=, for the final output. It can take one of the following values: @@ -15006,7 +15478,7 @@ factory styles used by the exporter. :UNNUMBERED: notoc :END: -The ODT export back-end can read embedded raw OpenDocument XML from +The ODT export backend can read embedded raw OpenDocument XML from the Org file. Such direct formatting is useful for one-off instances. - Embedding ODT tags as part of regular text :: @@ -15032,7 +15504,7 @@ the Org file. Such direct formatting is useful for one-off instances. - Embedding a one-line OpenDocument XML :: #+cindex: @samp{ODT}, keyword - The ODT export back-end can read one-liner options with =#+ODT:= in + The ODT export backend can read one-liner options with =#+ODT:= in the Org file. For example, to force a page break: #+begin_example @@ -15052,7 +15524,7 @@ the Org file. Such direct formatting is useful for one-off instances. - Embedding a block of OpenDocument XML :: - The ODT export back-end can also read ODT export blocks for + The ODT export backend can also read ODT export blocks for OpenDocument XML. Such blocks use the =#+BEGIN_EXPORT odt= ... =#+END_EXPORT= constructs. @@ -15216,7 +15688,7 @@ schema-sensitive editing---of XML files: [[info:nxml-mode::Introduction]]. #+vindex: org-export-odt-schema-dir Customize ~org-odt-schema-dir~ to point to a directory with OpenDocument RNC files and the needed schema-locating rules. The ODT -export back-end takes care of updating the +export backend takes care of updating the ~rng-schema-locating-files~. ** Org Export @@ -15225,9 +15697,9 @@ export back-end takes care of updating the :END: #+cindex: Org export -/org/ export back-end creates a normalized version of the Org document +/org/ export backend creates a normalized version of the Org document in current buffer. The exporter evaluates Babel code (see [[*Evaluating -Code Blocks]]) and removes content specific to other back-ends. +Code Blocks]]) and removes content specific to other backends. *** Org export commands :PROPERTIES: @@ -15277,7 +15749,7 @@ Code Blocks]]) and removes content specific to other back-ends. :DESCRIPTION: Setting the environment. :END: -The Texinfo export back-end has several additional keywords for +The Texinfo export backend has several additional keywords for customizing Texinfo output. Setting these keywords works similar to the general options (see [[*Export Settings]]). @@ -15316,17 +15788,26 @@ the general options (see [[*Export Settings]]). - =TEXINFO_DIR_CATEGORY= :: #+cindex: @samp{TEXINFO_DIR_CATEGORY}, keyword - The directory category of the document. + The directory category of the document. Defaults to ~Misc~. -- =TEXINFO_DIR_TITLE= :: +- =TEXINFO_DIR_NAME= :: - #+cindex: @samp{TEXINFO_DIR_TITLE}, keyword - The directory title of the document. + #+cindex: @samp{TEXINFO_DIR_NAME}, keyword + The directory name of the document. + This is the short name under which the ~m~ command will find your + manual in the main Info directory. It defaults to the base name of + the Texinfo file. + + The full form of the Texinfo entry is ~* DIRNAME: NODE.~ where ~NODE~ + is usually just ~(FILENAME)~. Normally this option only provides the + ~DIRNAME~ part, but if you need more control, it can also be the full + entry (recognized by the presence of parentheses or a leading ~* ~). - =TEXINFO_DIR_DESC= :: #+cindex: @samp{TEXINFO_DIR_DESC}, keyword The directory description of the document. + Defaults to the title of the document. - =TEXINFO_PRINTED_TITLE= :: @@ -15339,7 +15820,7 @@ the general options (see [[*Export Settings]]). :END: #+cindex: @samp{TEXINFO_FILENAME}, keyword -After creating the header for a Texinfo file, the Texinfo back-end +After creating the header for a Texinfo file, the Texinfo backend automatically generates a name and destination path for the Info file. To override this default with a more sensible path and name, specify the =TEXINFO_FILENAME= keyword. @@ -15383,7 +15864,7 @@ keywords. They have to be set in raw Texinfo code. #+cindex: @samp{COPYING}, property Copying material is defined in a dedicated headline with a non-~nil~ -=COPYING= property. The back-end inserts the contents within +=COPYING= property. The backend inserts the contents within a =@copying= command at the beginning of the document. The heading itself does not appear in the structure of the document. @@ -15410,11 +15891,11 @@ Copyright information is printed on the back of the title page. #+cindex: @code{install-info}, in Texinfo export #+cindex: @samp{TEXINFO_DIR_CATEGORY}, keyword -#+cindex: @samp{TEXINFO_DIR_TITLE}, keyword +#+cindex: @samp{TEXINFO_DIR_NAME}, keyword #+cindex: @samp{TEXINFO_DIR_DESC}, keyword The end result of the Texinfo export process is the creation of an Info file. This Info file's metadata has variables for category, -title, and description: =TEXINFO_DIR_CATEGORY=, =TEXINFO_DIR_TITLE=, +title, and description: =TEXINFO_DIR_CATEGORY=, =TEXINFO_DIR_NAME=, and =TEXINFO_DIR_DESC= keywords that establish where in the Info hierarchy the file fits. @@ -15422,7 +15903,7 @@ Here is an example that writes to the Info directory file: #+begin_example ,#+TEXINFO_DIR_CATEGORY: Emacs -,#+TEXINFO_DIR_TITLE: Org Mode: (org) +,#+TEXINFO_DIR_NAME: Org Mode ,#+TEXINFO_DIR_DESC: Outline-based notes management and organizer #+end_example @@ -15434,7 +15915,7 @@ Here is an example that writes to the Info directory file: #+vindex: org-texinfo-classes #+vindex: org-texinfo-default-class #+cindex: @samp{TEXINFO_CLASS}, keyword -The Texinfo export back-end uses a pre-defined scheme to convert Org +The Texinfo export backend uses a pre-defined scheme to convert Org headlines to equivalent Texinfo structuring commands. A scheme like this maps top-level headlines to numbered chapters tagged as ~@chapter~ and lower-level headlines to unnumbered chapters tagged as @@ -15442,21 +15923,21 @@ this maps top-level headlines to numbered chapters tagged as other Texinfo structuring commands, define a new class in ~org-texinfo-classes~. Activate the new class with the =TEXINFO_CLASS= keyword. When no new class is defined and activated, -the Texinfo export back-end defaults to the +the Texinfo export backend defaults to the ~org-texinfo-default-class~. If an Org headline's level has no associated Texinfo structuring command, or is below a certain threshold (see [[*Export Settings]]), then -the Texinfo export back-end makes it into a list item. +the Texinfo export backend makes it into a list item. #+cindex: @samp{APPENDIX}, property -The Texinfo export back-end makes any headline with a non-~nil~ +The Texinfo export backend makes any headline with a non-~nil~ =APPENDIX= property into an appendix. This happens independent of the Org headline level or the =TEXINFO_CLASS= keyword. #+cindex: @samp{ALT_TITLE}, property #+cindex: @samp{DESCRIPTION}, property -The Texinfo export back-end creates a menu entry after the Org +The Texinfo export backend creates a menu entry after the Org headline for each regular sectioning structure. To override this with a shorter menu entry, use the =ALT_TITLE= property (see [[*Table of Contents]]). Texinfo menu entries also have an option for a longer @@ -15494,7 +15975,7 @@ file. See [[info:texinfo::The Top Node]], for more information. #+cindex: data type index, in Texinfo export #+cindex: @samp{VINDEX}, keyword #+cindex: variable index, in Texinfo export -The Texinfo export back-end recognizes these indexing keywords if used +The Texinfo export backend recognizes these indexing keywords if used in the Org file: =CINDEX=, =FINDEX=, =KINDEX=, =PINDEX=, =TINDEX= and =VINDEX=. Write their value as verbatim Texinfo code; in particular, ={=, =}= and =@= characters need to be escaped with =@= if they do not @@ -15503,10 +15984,10 @@ belong to a Texinfo command. : #+CINDEX: Defining indexing entries #+cindex: @samp{INDEX}, property -For the back-end to generate an index entry for a headline, set the +For the backend to generate an index entry for a headline, set the =INDEX= property to =cp= or =vr=. These abbreviations come from Texinfo that stand for concept index and variable index. The Texinfo -manual has abbreviations for all other kinds of indexes. The back-end +manual has abbreviations for all other kinds of indexes. The backend exports the headline as an unnumbered chapter or section command, and then inserts the index after its contents. @@ -15546,7 +16027,7 @@ This paragraph is preceded by... #+cindex: lettered lists, in Texinfo export #+cindex: enum, Texinfo attribute -The Texinfo export back-end converts unordered and ordered lists in +The Texinfo export backend converts unordered and ordered lists in the Org file using the default command =@itemize=. Ordered lists are numbered when exported to Texinfo format. Such @@ -15564,7 +16045,7 @@ specific number, or switch to a lettered list, as illustrated here: #+cindex: @samp{ATTR_TEXINFO}, keyword #+cindex: two-column tables, in Texinfo export #+cindex: table-type, Texinfo attribute -The Texinfo export back-end by default converts description lists in +The Texinfo export backend by default converts description lists in the Org file using the default command =@table=, which results in a table with two columns. To change this behavior, set =:table-type= attribute to either =ftable= or =vtable= value. For more information, @@ -15572,7 +16053,7 @@ see [[info:texinfo::Two-column Tables]]. #+vindex: org-texinfo-table-default-markup #+cindex: indic, Texinfo attribute -The Texinfo export back-end by default also applies a text highlight +The Texinfo export backend by default also applies a text highlight based on the defaults stored in ~org-texinfo-table-default-markup~. To override the default highlight command, specify another one with the =:indic= attribute. @@ -15580,7 +16061,7 @@ the =:indic= attribute. #+cindex: multiple items in Texinfo lists #+cindex: sep, Texinfo attribute Org syntax is limited to one entry per list item. Nevertheless, the -Texinfo export back-end can split that entry according to any text +Texinfo export backend can split that entry according to any text provided through the =:sep= attribute. Each part then becomes a new entry in the first column of the table. @@ -15604,9 +16085,9 @@ This is the common text for variables foo and bar. The =:compact= attribute is an alternative to the =:sep= attribute, which allows writing each entry on its own line. If this attribute is -non-nil and an item in a description list has no body but is followed -by another item, then the second item is transcoded to =@itemx=. This -example is transcoded to the same output as above. +non-~nil~ and an item in a description list has no body but is +followed by another item, then the second item is transcoded to +=@itemx=. This example is transcoded to the same output as above. #+begin_example ,#+ATTR_TEXINFO: :table-type vtable :indic asis :compact t @@ -15619,12 +16100,12 @@ Support for this compact syntax can also be enabled for all lists in a file using the =compact-itemx= export option, or globally using the variable ~org-texinfo-compact-itemx~. -The Texinfo export back-end also supports two approaches to writing +The Texinfo export backend also supports two approaches to writing Texinfo definition commands (see [[info:texinfo::Definition Commands]]). One of them uses description lists and is described below, the other relies on special blocks (see [[*Special blocks in Texinfo export]]). -Items in a description list in a Org file that begin with =Function:= +Items in a description list in an Org file that begin with =Function:= or certain other prefixes are converted using Texinfo definition commands. This works even if other items in the same list do not have such a prefix; if necessary a single description list is converted @@ -15691,7 +16172,7 @@ Command in parenthesis, as done above, is optional. :END: #+cindex: @samp{ATTR_TEXINFO}, keyword -When exporting tables, the Texinfo export back-end uses the widest +When exporting tables, the Texinfo export backend uses the widest cell width in each column. To override this and instead specify as fractions of line length, use the =:columns= attribute. See example below. @@ -15708,7 +16189,7 @@ below. #+cindex: @samp{ATTR_TEXINFO}, keyword Insert a file link to the image in the Org file, and the Texinfo -export back-end inserts the image. These links must have the usual +export backend inserts the image. These links must have the usual supported image extensions and no descriptions. To scale the image, use =:width= and =:height= attributes. For alternate text, use =:alt= and specify the text using Texinfo code, as shown in the example: @@ -15779,13 +16260,13 @@ Type @kbd{C-c @key{SPC}}. :DESCRIPTION: Special block attributes. :END: -The Texinfo export back-end supports two approaches to writing Texinfo +The Texinfo export backend supports two approaches to writing Texinfo definition commands. One of them is described here, the other in [[*Plain lists in Texinfo export]]. #+cindex: @samp{ATTR_TEXINFO}, keyword -The Texinfo export back-end converts special blocks to commands with +The Texinfo export backend converts special blocks to commands with the same name. It also adds any =:options= attributes to the end of the command, as shown in this example: @@ -15830,7 +16311,7 @@ Texinfo code. ,#+TEXINFO_HEADER: @syncodeindex pg cp ,#+TEXINFO_DIR_CATEGORY: Texinfo documentation system -,#+TEXINFO_DIR_TITLE: sample: (sample) +,#+TEXINFO_DIR_NAME: sample ,#+TEXINFO_DIR_DESC: Invoking sample ,#+TEXINFO_PRINTED_TITLE: GNU Sample @@ -15887,24 +16368,35 @@ This manual is for GNU Sample (version {{{version}}}, A large part of Org mode's interoperability success is its ability to easily export to or import from external applications. The iCalendar -export back-end takes calendar data from Org files and exports to the +export backend takes calendar data from Org files and exports to the standard iCalendar format. +#+vindex: icalendar-export-sexp-enumeration-days +By default, iCalendar export only includes headings that contain +active timestamps or diary sexps[fn:: Diary sexp events, except +certain built-in types (see ~icalendar-export-sexp-enumerate-all~), +are exported up to ~icalendar-export-sexp-enumeration-days~ into +future.]. + #+vindex: org-icalendar-include-todo -#+vindex: org-icalendar-use-deadline -#+vindex: org-icalendar-use-scheduled -The iCalendar export back-end can also incorporate TODO entries based +The iCalendar export backend can also incorporate TODO entries based on the configuration of the ~org-icalendar-include-todo~ variable. -The back-end exports plain timestamps as =VEVENT=, TODO items as +The backend exports plain timestamps as =VEVENT=, TODO items as =VTODO=, and also create events from deadlines that are in non-TODO -items. The back-end uses the deadlines and scheduling dates in Org -TODO items for setting the start and due dates for the iCalendar TODO -entry. Consult the ~org-icalendar-use-deadline~ and -~org-icalendar-use-scheduled~ variables for more details. +items. + +#+vindex: org-icalendar-use-deadline +#+vindex: org-icalendar-use-scheduled +#+vindex: org-icalendar-todo-unscheduled-start +The backend uses the deadlines and scheduling dates in Org TODO items +for setting the start and due dates for the iCalendar TODO entry. +Consult the ~org-icalendar-use-deadline~, +~org-icalendar-use-scheduled~, and +~org-icalendar-todo-unscheduled-start~ variables for more details. #+vindex: org-icalendar-categories #+vindex: org-icalendar-alarm-time -For tags on the headline, the iCalendar export back-end makes them +For tags on the headline, the iCalendar export backend makes them into iCalendar categories. To tweak the inheritance of tags and TODO states, configure the variable ~org-icalendar-categories~. To assign clock alarms based on time, configure the ~org-icalendar-alarm-time~ @@ -15913,9 +16405,9 @@ variable. #+vindex: org-icalendar-store-UID #+cindex: @samp{ID}, property The iCalendar format standard requires globally unique identifier---or -UID---for each entry. The iCalendar export back-end creates UIDs +UID---for each entry. The iCalendar export backend creates UIDs during export. To save a copy of the UID in the Org file set the -variable ~org-icalendar-store-UID~. The back-end looks for the =ID= +variable ~org-icalendar-store-UID~. The backend looks for the =ID= property of the entry for re-using the same UID for subsequent exports. @@ -15954,15 +16446,27 @@ connections. #+cindex: @samp{LOCATION}, property #+cindex: @samp{TIMEZONE}, property #+cindex: @samp{CLASS}, property -The iCalendar export back-end includes =SUMMARY=, =DESCRIPTION=, +The iCalendar export backend includes =SUMMARY=, =DESCRIPTION=, =LOCATION=, =TIMEZONE= and =CLASS= properties from the Org entries -when exporting. To force the back-end to inherit the =LOCATION=, +when exporting. To force the backend to inherit the =LOCATION=, =TIMEZONE= and =CLASS= properties, configure the ~org-use-property-inheritance~ variable. +=SUMMARY=, =LOCATION=, and =DESCRIPTION= properties can define +multi-line summary, location, or description using =+= +syntax (see [[*Property Syntax]]): + +: * Meeting at location with multi-line address +: <2024-01-08 Mon 14:20-15:00> +: :PROPERTIES: +: :LOCATION: Someplace +: :LOCATION+: Some Street 5 +: :LOCATION+: 12345 Small Town +: :END: + #+vindex: org-icalendar-include-body When Org entries do not have =SUMMARY=, =DESCRIPTION=, =LOCATION= and -=CLASS= properties, the iCalendar export back-end derives the summary +=CLASS= properties, the iCalendar export backend derives the summary from the headline, and derives the description from the body of the Org item. The ~org-icalendar-include-body~ variable limits the maximum number of characters of the content are turned into its @@ -15984,23 +16488,32 @@ information. The iCalendar standard defines three visibility classes: The server should treat unknown class properties the same as =PRIVATE=. +#+cindex: @samp{ICAL-TTL}, keyword +#+vindex: org-icalendar-ttl +The exported iCalendar file can advise clients how often to check for +updates. This duration can be set globally with the +~org-icalendar-ttl~ variable, or on a per-document basis with the +=ICAL-TTL= keyword. This option should be set using the iCalendar +notation for time durations; consult the docstring of +~org-icalendar-ttl~ for more details. + Exporting to iCalendar format depends in large part on the capabilities of the destination application. Some are more lenient than others. Consult the Org mode FAQ for advice on specific applications. -** Other Built-in Back-ends +** Other Built-in Backends :PROPERTIES: :DESCRIPTION: Exporting to a man page. :END: -Other export back-ends included with Org are: +Other export backends included with Org are: - =ox-man.el=: Export to a man page. -To activate such back-ends, either customize ~org-export-backends~ or +To activate such backends, either customize ~org-export-backends~ or load directly with =(require 'ox-man)=. On successful load, the -back-end adds new keys in the export dispatcher (see [[*The Export +backend adds new keys in the export dispatcher (see [[*The Export Dispatcher]]). Follow the comment section of such files, for example, =ox-man.el=, @@ -16017,22 +16530,24 @@ for usage and configuration details. :END: #+vindex: org-export-before-processing-hook +#+vindex: org-export-before-processing-functions #+vindex: org-export-before-parsing-hook The export process executes two hooks before the actual exporting -begins. The first hook, ~org-export-before-processing-hook~, runs -before any expansions of macros, Babel code, and include keywords in -the buffer. The second hook, ~org-export-before-parsing-hook~, runs -before the buffer is parsed. +begins. The first hook, ~org-export-before-processing-functions~, +runs before any expansions of macros, Babel code, and include keywords +in the buffer. The second hook, +~org-export-before-parsing-functions~, runs before the buffer is +parsed. Functions added to these hooks are called with a single argument: the -export back-end actually used, as a symbol. You may use them for +export backend actually used, as a symbol. You may use them for heavy duty structural modifications of the document. For example, you can remove every headline in the buffer during export like this: #+begin_src emacs-lisp (defun my-headline-removal (backend) "Remove all headlines in the current buffer. -BACKEND is the export back-end being used, as a symbol." +BACKEND is the export backend being used, as a symbol." (org-map-entries (lambda () (delete-region (point) (line-beginning-position 2)) @@ -16041,7 +16556,7 @@ BACKEND is the export back-end being used, as a symbol." ;; the docstring of `org-map-entries' for details. (setq org-map-continue-from (point))))) -(add-hook 'org-export-before-parsing-hook #'my-headline-removal) +(add-hook 'org-export-before-parsing-functions #'my-headline-removal) #+end_src *** Filters @@ -16051,7 +16566,7 @@ BACKEND is the export back-end being used, as a symbol." #+cindex: Filters, exporting Filters are lists of functions to be applied to certain parts for -a given back-end. The output from the first function in the filter is +a given backend. The output from the first function in the filter is passed on to the next function in the filter. The final output is the output from the final function in the filter. @@ -16082,7 +16597,7 @@ is the type targeted by the filter. Valid types are: | underline | verbatim | verse-block | Here is an example filter that replaces non-breaking spaces ~ ~ in the -Org buffer with =~= for the LaTeX back-end. +Org buffer with =~= for the LaTeX backend. #+begin_src emacs-lisp (defun my-latex-filter-nobreaks (text backend info) @@ -16095,10 +16610,10 @@ Org buffer with =~= for the LaTeX back-end. #+end_src A filter requires three arguments: the code to be transformed, the -name of the back-end, and some optional information about the export +name of the backend, and some optional information about the export process. The third argument can be safely ignored. Note the use of ~org-export-derived-backend-p~ predicate that tests for /latex/ -back-end or any other back-end, such as /beamer/, derived from +backend or any other backend, such as /beamer/, derived from /latex/. *** Defining filters for individual files @@ -16106,7 +16621,7 @@ back-end or any other back-end, such as /beamer/, derived from :UNNUMBERED: notoc :END: -The Org export can filter not just for back-ends, but also for +The Org export can filter not just for backends, but also for specific files through the =BIND= keyword. Here is an example with two filters; one removes brackets from time stamps, and the other removes strike-through text. The filter functions are defined in @@ -16123,26 +16638,179 @@ debugging. ,#+END_SRC #+end_example -*** Extending an existing back-end +*** Summary of the export process +:PROPERTIES: +:UNNUMBERED: notoc +:END: + +#+findex: org-export-as +Org mode export is a multi-step process that works on a temporary copy +of the buffer. The export process consists of 4 major steps: + +1. Process the temporary copy, making necessary changes to the buffer + text; + +2. Parse the buffer, converting plain Org markup into an abstract + syntax tree (AST); + +3. Convert the AST to text, as prescribed by the selected export + backend; + +4. Post-process the resulting exported text. + + +#+texinfo: @noindent +Process temporary copy of the source Org buffer [fn::Unless +otherwise specified, each step of the export process only operates on +the accessible portion of the buffer. When subtree export is selected +(see [[*The Export Dispatcher]]), the buffer is narrowed to the body of +the selected subtree, so that the rest of the buffer text, except +export keywords, does not contribute to the export output.]: + +1. Execute ~org-export-before-processing-functions~ (see [[*Export hooks]]); + +2. Expand =#+include= keywords in the whole buffer (see + [[*Include Files]]); + +3. Remove commented subtrees in the whole buffer (see [[*Comment + Lines]]); + +4. Replace macros in the whole buffer (see [[*Macro Replacement]]); + +5. When ~org-export-use-babel~ is non-nil (default), process code + blocks: + + - Leave code blocks inside archived subtrees (see [[*Internal + archiving]]) as is; + + - Evaluate all the other code blocks according to code block + headers (see [[*Limit code block evaluation]]); + + - Remove code, results of evaluation, both, or neither according + to =:exports= header argument (see [[*Exporting Code Blocks]]). + + +#+texinfo: @noindent +Parse the temporary buffer, creating AST: + +1. Execute ~org-export-before-parsing-functions~ (see [[*Export hooks]]). + The hook functions may still modify the buffer; + +2. Calculate export option values according to subtree-specific export + settings, in-buffer keywords, =#+BIND= keywords, and buffer-local + and global customization. The whole buffer is considered; + +3. When ~org-org-with-cite-processors~ is non-nil (default), determine + contributing bibliographies and record them into export options + (see [[*Citations]]). The whole buffer is considered; + +4. Execute ~org-export-filter-options-functions~; + +5. Parse the accessible portion of the temporary buffer to generate an + AST. The AST is a nested list of lists representing Org syntax + elements (see [[https://orgmode.org/worg/dev/org-element-api.html][Org Element API]] for more details): + + : (org-data ... + : (heading + : (section + : (paragraph (plain-text) (bold (plain-text)))) + : (heading) + : (heading (section ...)))) + + Past this point, modifications to the temporary buffer no longer + affect the export; Org export works only with the AST; + +6. Remove elements that are not exported from the AST: + + - Headings according to =SELECT_TAGS= and =EXCLUDE_TAGS= export + keywords; =task=, =inline=, =arch= export options (see + [[*Export Settings]]); + + - Comments; + + - Clocks, drawers, fixed-width environments, footnotes, LaTeX + environments and fragments, node properties, planning lines, + property drawers, statistics cookies, timestamps, etc according + to =#+OPTIONS= keyword (see [[*Export Settings]]); + + - Table rows containing width and alignment markers, unless the + selected export backend changes ~:with-special-rows~ export option + to non-nil (see [[*Column Width and Alignment]]); + + - Table columns containing recalc marks (see [[*Advanced features]]). + +7. Expand environment variables in file link AST nodes according to + the =expand-links= export option (see [[*Export Settings]]); + +8. Execute ~org-export-filter-parse-tree-functions~. These + functions can modify the AST by side effects; + +9. When ~org-org-with-cite-processors~ is non-nil (default), replace + citation AST nodes and =#+print_bibliography= keyword AST nodes as + prescribed by the selected citation export processor (see [[*Citation + export processors]]). + + +#+texinfo: @noindent +Convert the AST to text by traversing the AST nodes, depth-first: + +1. Convert the leaf nodes (without children) to text as prescribed + by "transcoders" in the selected export backend + [fn:: See transcoders and ~:translate-alist~ in the docstrings + of ~org-export-define-backend~ and ~org-export-define-derived-backend~.]; + +2. Pass the converted nodes through the corresponding export + filters (see [[*Filters]]); + +3. Concatenate all the converted child nodes to produce parent + node contents; + +4. Convert the nodes with children to text, passing the nodes + themselves and their exported contents to the corresponding + transcoders and then to the export filters (see [[*Filters]]). + + +#+texinfo: @noindent +Post-process the exported text: + + 1. Post-process the converted AST, as prescribed by the export + backend. [fn:: See ~inner-template~ in the docstring of ~org-export-define-backend~.] + This step usually adds generated content (like Table of Contents) + to the exported text; + + 2. Execute ~org-export-filter-body-functions~; + + 3. Unless body-only export is selected (see [[*The Export Dispatcher]]), + add the necessary metadata to the final document, as prescribed + by the export backend. Examples: Document author/title; HTML + headers/footers; LaTeX preamble; + + 4. When ~org-org-with-cite-processors~ is non-nil (default), add + bibliography metadata, as prescribed by the citation export + processor; + + 5. Execute ~org-export-filter-final-output-functions~. + +*** Extending an existing backend :PROPERTIES: :UNNUMBERED: notoc :END: Some parts of the conversion process can be extended for certain elements so as to introduce a new or revised translation. That is how -the HTML export back-end was extended to handle Markdown format. The +the HTML export backend was extended to handle Markdown format. The extensions work seamlessly so any aspect of filtering not done by the -extended back-end is handled by the original back-end. Of all the +extended backend is handled by the original backend. Of all the export customization in Org, extending is very powerful as it operates at the parser level. -For this example, make the /ascii/ back-end display the language used +For this example, make the /ascii/ backend display the language used in a source code block. Also make it display only when some attribute is non-~nil~, like the following: : #+ATTR_ASCII: :language t -Then extend ASCII back-end with a custom "my-ascii" back-end. +Then extend ASCII backend with a custom "my-ascii" backend. #+begin_src emacs-lisp (defun my-ascii-src-block (src-block contents info) @@ -16164,13 +16832,13 @@ channel." #+end_src The ~my-ascii-src-block~ function looks at the attribute above the -current element. If not true, hands over to /ascii/ back-end. If +current element. If not true, hands over to /ascii/ backend. If true, which it is in this example, it creates a box around the code and leaves room for the inserting a string for language. The last -form creates the new back-end that springs to action only when +form creates the new backend that springs to action only when translating ~src-block~ type elements. -To use the newly defined back-end, evaluate the following from an Org +To use the newly defined backend, evaluate the following from an Org buffer: #+begin_src emacs-lisp @@ -16179,79 +16847,60 @@ buffer: Further steps to consider would be an interactive function, self-installing an item in the export dispatcher menu, and other -user-friendly improvements. +user-friendly improvements. See + for more +details. -** Export in Foreign Buffers +** Export Region :PROPERTIES: :DESCRIPTION: Author tables and lists in Org syntax. :END: -The export back-ends in Org often include commands to convert selected -regions. A convenient feature of this in-place conversion is that the -exported output replaces the original source. Here are such -functions: +Some export backends include commands to convert a region of Org +formatted text to another format, such as HTML or LaTeX. The +conversion replaces the original source. Here are such commands: -- ~org-ascii-convert-region-to-ascii~ :: +- ~org-export-region-to-ascii~ :: #+findex: org-ascii-convert-region-to-ascii + #+findex: org-export-region-to-ascii Convert the selected region into ASCII. -- ~org-ascii-convert-region-to-utf8~ :: +- ~org-export-region-to-utf8~ :: #+findex: org-ascii-convert-region-to-utf8 + #+findex: org-export-region-to-utf8 Convert the selected region into UTF-8. -- ~org-html-convert-region-to-html~ :: +- ~org-export-region-to-html~ :: #+findex: org-html-convert-region-to-html + #+findex: org-export-region-to-html Convert the selected region into HTML. -- ~org-latex-convert-region-to-latex~ :: +- ~org-export-region-to-latex~ :: #+findex: org-latex-convert-region-to-latex + #+findex: org-export-region-to-latex Convert the selected region into LaTeX. -- ~org-texinfo-convert-region-to-texinfo~ :: +- ~org-export-region-to-texinfo~ :: #+findex: org-texinfo-convert-region-to-texinfo + #+findex: org-export-region-to-texinfo Convert the selected region into Texinfo. -- ~org-md-convert-region-to-md~ :: +- ~org-export-region-to-md~ :: #+findex: org-md-convert-region-to-md + #+findex: org-export-region-to-md Convert the selected region into Markdown. -In-place conversions are particularly handy for quick conversion of -tables and lists in foreign buffers. For example, in an HTML buffer, +The in-place conversion is particularly handy for quick conversion of +tables and lists in non-Org buffers. For example, in an HTML buffer, write a list in Org syntax, select it, and convert it to HTML with {{{kbd(M-x org-html-convert-region-to-html)}}}. -*** Exporting to minimal HTML -:PROPERTIES: -:DESCRIPTION: Exporting HTML without CSS, Javascript, etc. -:ALT_TITLE: Bare HTML -:END: - -If you want to output a minimal HTML file, with no CSS, no Javascript, -no preamble or postamble, here are the variable you would need to set: - -#+vindex: org-html-head -#+vindex: org-html-head-extra -#+vindex: org-html-head-include-default-style -#+vindex: org-html-head-include-scripts -#+vindex: org-html-preamble -#+vindex: org-html-postamble -#+vindex: org-html-use-infojs -#+begin_src emacs-lisp -(setq org-html-head "" - org-html-head-extra "" - org-html-head-include-default-style nil - org-html-head-include-scripts nil - org-html-preamble nil - org-html-postamble nil - org-html-use-infojs nil) -#+end_src - * Publishing :PROPERTIES: :DESCRIPTION: Create a web site of linked Org files. @@ -16446,228 +17095,107 @@ Settings]]), however, override everything. :UNNUMBERED: notoc :END: -| ~:archived-trees~ | ~org-export-with-archived-trees~ | -| ~:exclude-tags~ | ~org-export-exclude-tags~ | -| ~:headline-levels~ | ~org-export-headline-levels~ | -| ~:language~ | ~org-export-default-language~ | -| ~:preserve-breaks~ | ~org-export-preserve-breaks~ | -| ~:section-numbers~ | ~org-export-with-section-numbers~ | -| ~:select-tags~ | ~org-export-select-tags~ | -| ~:with-author~ | ~org-export-with-author~ | -| ~:with-broken-links~ | ~org-export-with-broken-links~ | -| ~:with-clocks~ | ~org-export-with-clocks~ | -| ~:with-creator~ | ~org-export-with-creator~ | -| ~:with-date~ | ~org-export-with-date~ | -| ~:with-drawers~ | ~org-export-with-drawers~ | -| ~:with-email~ | ~org-export-with-email~ | -| ~:with-emphasize~ | ~org-export-with-emphasize~ | -| ~:with-fixed-width~ | ~org-export-with-fixed-width~ | -| ~:with-footnotes~ | ~org-export-with-footnotes~ | -| ~:with-latex~ | ~org-export-with-latex~ | -| ~:with-planning~ | ~org-export-with-planning~ | -| ~:with-priority~ | ~org-export-with-priority~ | -| ~:with-properties~ | ~org-export-with-properties~ | -| ~:with-special-strings~ | ~org-export-with-special-strings~ | -| ~:with-sub-superscript~ | ~org-export-with-sub-superscripts~ | -| ~:with-tables~ | ~org-export-with-tables~ | -| ~:with-tags~ | ~org-export-with-tags~ | -| ~:with-tasks~ | ~org-export-with-tasks~ | -| ~:with-timestamps~ | ~org-export-with-timestamps~ | -| ~:with-title~ | ~org-export-with-title~ | -| ~:with-toc~ | ~org-export-with-toc~ | -| ~:with-todo-keywords~ | ~org-export-with-todo-keywords~ | +#+NAME: org-manual-get-export-props-customizations +#+begin_src emacs-lisp :exports none :results table +(require 'ox) +(let (result) + (dolist (spec alist) + (when (and (nth 3 spec) (symbolp (nth 3 spec))) ; has customization + (push (list (format "~%s~" (car spec)) (format "~%s~" (nth 3 spec))) result))) + (nreverse result)) +#+end_src + +#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes +(require 'ox) +(let ((alist org-export-options-alist)) +<> +) +#+end_src + **** ASCII specific properties :PROPERTIES: :UNNUMBERED: notoc :END: -| ~:ascii-bullets~ | ~org-ascii-bullets~ | -| ~:ascii-caption-above~ | ~org-ascii-caption-above~ | -| ~:ascii-charset~ | ~org-ascii-charset~ | -| ~:ascii-global-margin~ | ~org-ascii-global-margin~ | -| ~:ascii-format-drawer-function~ | ~org-ascii-format-drawer-function~ | -| ~:ascii-format-inlinetask-function~ | ~org-ascii-format-inlinetask-function~ | -| ~:ascii-headline-spacing~ | ~org-ascii-headline-spacing~ | -| ~:ascii-indented-line-width~ | ~org-ascii-indented-line-width~ | -| ~:ascii-inlinetask-width~ | ~org-ascii-inlinetask-width~ | -| ~:ascii-inner-margin~ | ~org-ascii-inner-margin~ | -| ~:ascii-links-to-notes~ | ~org-ascii-links-to-notes~ | -| ~:ascii-list-margin~ | ~org-ascii-list-margin~ | -| ~:ascii-paragraph-spacing~ | ~org-ascii-paragraph-spacing~ | -| ~:ascii-quote-margin~ | ~org-ascii-quote-margin~ | -| ~:ascii-table-keep-all-vertical-lines~ | ~org-ascii-table-keep-all-vertical-lines~ | -| ~:ascii-table-use-ascii-art~ | ~org-ascii-table-use-ascii-art~ | -| ~:ascii-table-widen-columns~ | ~org-ascii-table-widen-columns~ | -| ~:ascii-text-width~ | ~org-ascii-text-width~ | -| ~:ascii-underline~ | ~org-ascii-underline~ | -| ~:ascii-verbatim-format~ | ~org-ascii-verbatim-format~ | +#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes +(require 'ox-ascii) +(let ((alist (org-export-backend-options (org-export-get-backend 'ascii)))) +<> +) +#+end_src **** Beamer specific properties :PROPERTIES: :UNNUMBERED: notoc :END: -| ~:beamer-theme~ | ~org-beamer-theme~ | -| ~:beamer-column-view-format~ | ~org-beamer-column-view-format~ | -| ~:beamer-environments-extra~ | ~org-beamer-environments-extra~ | -| ~:beamer-frame-default-options~ | ~org-beamer-frame-default-options~ | -| ~:beamer-outline-frame-options~ | ~org-beamer-outline-frame-options~ | -| ~:beamer-outline-frame-title~ | ~org-beamer-outline-frame-title~ | -| ~:beamer-subtitle-format~ | ~org-beamer-subtitle-format~ | +#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes +(require 'ox-beamer) +(let ((alist (org-export-backend-options (org-export-get-backend 'beamer)))) +<> +) +#+end_src **** HTML specific properties :PROPERTIES: :UNNUMBERED: notoc :END: -| ~:html-allow-name-attribute-in-anchors~ | ~org-html-allow-name-attribute-in-anchors~ | -| ~:html-checkbox-type~ | ~org-html-checkbox-type~ | -| ~:html-container~ | ~org-html-container-element~ | -| ~:html-divs~ | ~org-html-divs~ | -| ~:html-doctype~ | ~org-html-doctype~ | -| ~:html-extension~ | ~org-html-extension~ | -| ~:html-footnote-format~ | ~org-html-footnote-format~ | -| ~:html-footnote-separator~ | ~org-html-footnote-separator~ | -| ~:html-footnotes-section~ | ~org-html-footnotes-section~ | -| ~:html-format-drawer-function~ | ~org-html-format-drawer-function~ | -| ~:html-format-headline-function~ | ~org-html-format-headline-function~ | -| ~:html-format-inlinetask-function~ | ~org-html-format-inlinetask-function~ | -| ~:html-head-extra~ | ~org-html-head-extra~ | -| ~:html-head-include-default-style~ | ~org-html-head-include-default-style~ | -| ~:html-head-include-scripts~ | ~org-html-head-include-scripts~ | -| ~:html-head~ | ~org-html-head~ | -| ~:html-home/up-format~ | ~org-html-home/up-format~ | -| ~:html-html5-fancy~ | ~org-html-html5-fancy~ | -| ~:html-indent~ | ~org-html-indent~ | -| ~:html-infojs-options~ | ~org-html-infojs-options~ | -| ~:html-infojs-template~ | ~org-html-infojs-template~ | -| ~:html-inline-image-rules~ | ~org-html-inline-image-rules~ | -| ~:html-inline-images~ | ~org-html-inline-images~ | -| ~:html-link-home~ | ~org-html-link-home~ | -| ~:html-link-org-files-as-html~ | ~org-html-link-org-files-as-html~ | -| ~:html-link-up~ | ~org-html-link-up~ | -| ~:html-link-use-abs-url~ | ~org-html-link-use-abs-url~ | -| ~:html-mathjax-options~ | ~org-html-mathjax-options~ | -| ~:html-mathjax-template~ | ~org-html-mathjax-template~ | -| ~:html-equation-reference-format~ | ~org-html-equation-reference-format~ | -| ~:html-metadata-timestamp-format~ | ~org-html-metadata-timestamp-format~ | -| ~:html-postamble-format~ | ~org-html-postamble-format~ | -| ~:html-postamble~ | ~org-html-postamble~ | -| ~:html-preamble-format~ | ~org-html-preamble-format~ | -| ~:html-preamble~ | ~org-html-preamble~ | -| ~:html-self-link-headlines~ | ~org-html-self-link-headlines~ | -| ~:html-table-align-individual-field~ | ~org-html-table-align-individual-fields~ | -| ~:html-table-attributes~ | ~org-html-table-default-attributes~ | -| ~:html-table-caption-above~ | ~org-html-table-caption-above~ | -| ~:html-table-data-tags~ | ~org-html-table-data-tags~ | -| ~:html-table-header-tags~ | ~org-html-table-header-tags~ | -| ~:html-table-row-tags~ | ~org-html-table-row-tags~ | -| ~:html-table-use-header-tags-for-first-column~ | ~org-html-table-use-header-tags-for-first-column~ | -| ~:html-tag-class-prefix~ | ~org-html-tag-class-prefix~ | -| ~:html-text-markup-alist~ | ~org-html-text-markup-alist~ | -| ~:html-todo-kwd-class-prefix~ | ~org-html-todo-kwd-class-prefix~ | -| ~:html-toplevel-hlevel~ | ~org-html-toplevel-hlevel~ | -| ~:html-use-infojs~ | ~org-html-use-infojs~ | -| ~:html-validation-link~ | ~org-html-validation-link~ | -| ~:html-viewport~ | ~org-html-viewport~ | -| ~:html-wrap-src-lines~ | ~org-html-wrap-src-lines~ | -| ~:html-xml-declaration~ | ~org-html-xml-declaration~ | +#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes +(require 'ox-html) +(let ((alist (org-export-backend-options (org-export-get-backend 'html)))) +<> +) +#+end_src **** LaTeX specific properties :PROPERTIES: :UNNUMBERED: notoc :END: -| ~:latex-active-timestamp-format~ | ~org-latex-active-timestamp-format~ | -| ~:latex-caption-above~ | ~org-latex-caption-above~ | -| ~:latex-classes~ | ~org-latex-classes~ | -| ~:latex-class~ | ~org-latex-default-class~ | -| ~:latex-compiler~ | ~org-latex-compiler~ | -| ~:latex-default-figure-position~ | ~org-latex-default-figure-position~ | -| ~:latex-default-table-environment~ | ~org-latex-default-table-environment~ | -| ~:latex-default-table-mode~ | ~org-latex-default-table-mode~ | -| ~:latex-diary-timestamp-format~ | ~org-latex-diary-timestamp-format~ | -| ~:latex-engraved-options~ | ~org-latex-engraved-options~ | -| ~:latex-engraved-preamble~ | ~org-latex-engraved-preamble~ | -| ~:latex-engraved-theme~ | ~org-latex-engraved-theme~ | -| ~:latex-footnote-defined-format~ | ~org-latex-footnote-defined-format~ | -| ~:latex-footnote-separator~ | ~org-latex-footnote-separator~ | -| ~:latex-format-drawer-function~ | ~org-latex-format-drawer-function~ | -| ~:latex-format-headline-function~ | ~org-latex-format-headline-function~ | -| ~:latex-format-inlinetask-function~ | ~org-latex-format-inlinetask-function~ | -| ~:latex-hyperref-template~ | ~org-latex-hyperref-template~ | -| ~:latex-image-default-height~ | ~org-latex-image-default-height~ | -| ~:latex-image-default-option~ | ~org-latex-image-default-option~ | -| ~:latex-image-default-width~ | ~org-latex-image-default-width~ | -| ~:latex-images-centered~ | ~org-latex-images-centered~ | -| ~:latex-inactive-timestamp-format~ | ~org-latex-inactive-timestamp-format~ | -| ~:latex-inline-image-rules~ | ~org-latex-inline-image-rules~ | -| ~:latex-link-with-unknown-path-format~ | ~org-latex-link-with-unknown-path-format~ | -| ~:latex-listings-langs~ | ~org-latex-listings-langs~ | -| ~:latex-listings-options~ | ~org-latex-listings-options~ | -| ~:latex-minted-langs~ | ~org-latex-minted-langs~ | -| ~:latex-minted-options~ | ~org-latex-minted-options~ | -| ~:latex-prefer-user-labels~ | ~org-latex-prefer-user-labels~ | -| ~:latex-subtitle-format~ | ~org-latex-subtitle-format~ | -| ~:latex-subtitle-separate~ | ~org-latex-subtitle-separate~ | -| ~:latex-src-block-backend~ | ~org-latex-src-block-backend~ | -| ~:latex-table-scientific-notation~ | ~org-latex-table-scientific-notation~ | -| ~:latex-tables-booktabs~ | ~org-latex-tables-booktabs~ | -| ~:latex-tables-centered~ | ~org-latex-tables-centered~ | -| ~:latex-text-markup-alist~ | ~org-latex-text-markup-alist~ | -| ~:latex-title-command~ | ~org-latex-title-command~ | -| ~:latex-toc-command~ | ~org-latex-toc-command~ | +#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes +(require 'ox-latex) +(let ((alist (org-export-backend-options (org-export-get-backend 'latex)))) +<> +) +#+end_src **** Markdown specific properties :PROPERTIES: :UNNUMBERED: notoc :END: -| ~:md-footnote-format~ | ~org-md-footnote-format~ | -| ~:md-footnotes-section~ | ~org-md-footnotes-section~ | -| ~:md-headline-style~ | ~org-md-headline-style~ | -| ~:md-toplevel-hlevel~ | ~org-md-toplevel-hlevel~ | +#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes +(require 'ox-md) +(let ((alist (org-export-backend-options (org-export-get-backend 'md)))) +<> +) +#+end_src **** ODT specific properties :PROPERTIES: :UNNUMBERED: notoc :END: -| ~:odt-content-template-file~ | ~org-odt-content-template-file~ | -| ~:odt-display-outline-level~ | ~org-odt-display-outline-level~ | -| ~:odt-fontify-srcblocks~ | ~org-odt-fontify-srcblocks~ | -| ~:odt-format-drawer-function~ | ~org-odt-format-drawer-function~ | -| ~:odt-format-headline-function~ | ~org-odt-format-headline-function~ | -| ~:odt-format-inlinetask-function~ | ~org-odt-format-inlinetask-function~ | -| ~:odt-inline-formula-rules~ | ~org-odt-inline-formula-rules~ | -| ~:odt-inline-image-rules~ | ~org-odt-inline-image-rules~ | -| ~:odt-pixels-per-inch~ | ~org-odt-pixels-per-inch~ | -| ~:odt-styles-file~ | ~org-odt-styles-file~ | -| ~:odt-table-styles~ | ~org-odt-table-styles~ | -| ~:odt-use-date-fields~ | ~org-odt-use-date-fields~ | +#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes +(require 'ox-odt) +(let ((alist (org-export-backend-options (org-export-get-backend 'odt)))) +<> +) +#+end_src **** Texinfo specific properties :PROPERTIES: :UNNUMBERED: notoc :END: -| ~:texinfo-active-timestamp-format~ | ~org-texinfo-active-timestamp-format~ | -| ~:texinfo-classes~ | ~org-texinfo-classes~ | -| ~:texinfo-class~ | ~org-texinfo-default-class~ | -| ~:texinfo-compact-itemx | ~org-texinfo-compact-itemx~ | -| ~:texinfo-table-default-markup~ | ~org-texinfo-table-default-markup~ | -| ~:texinfo-diary-timestamp-format~ | ~org-texinfo-diary-timestamp-format~ | -| ~:texinfo-filename~ | ~org-texinfo-filename~ | -| ~:texinfo-format-drawer-function~ | ~org-texinfo-format-drawer-function~ | -| ~:texinfo-format-headline-function~ | ~org-texinfo-format-headline-function~ | -| ~:texinfo-format-inlinetask-function~ | ~org-texinfo-format-inlinetask-function~ | -| ~:texinfo-inactive-timestamp-format~ | ~org-texinfo-inactive-timestamp-format~ | -| ~:texinfo-link-with-unknown-path-format~ | ~org-texinfo-link-with-unknown-path-format~ | -| ~:texinfo-node-description-column~ | ~org-texinfo-node-description-column~ | -| ~:texinfo-table-scientific-notation~ | ~org-texinfo-table-scientific-notation~ | -| ~:texinfo-tables-verbatim~ | ~org-texinfo-tables-verbatim~ | -| ~:texinfo-text-markup-alist~ | ~org-texinfo-text-markup-alist~ | +#+begin_src emacs-lisp :exports results :results table :eval yes :noweb yes +(require 'ox-texinfo) +(let ((alist (org-export-backend-options (org-export-get-backend 'texinfo)))) +<> +) +#+end_src *** Publishing links :PROPERTIES: @@ -16712,6 +17240,7 @@ to HTML, the following links all point to a dedicated anchor in :END: #+cindex: sitemap, of published pages +#+vindex: org-publish-project-alist The following properties may be used to control publishing of a map of files for a given project. @@ -16729,6 +17258,12 @@ a map of files for a given project. Title of sitemap page. Defaults to name of file. +- ~:sitemap-style~ :: + + Can be ~list~ (site-map is just an itemized list of the titles of + the files involved) or ~tree~ (the directory structure of the + source files is reflected in the site-map). Defaults to ~tree~. + - ~:sitemap-format-entry~ :: #+findex: org-publish-find-date @@ -16774,21 +17309,6 @@ a map of files for a given project. Should sorting be case-sensitive? Default ~nil~. -- ~:sitemap-file-entry-format~ :: - - With this option one can tell how a sitemap's entry is formatted in - the sitemap. This is a format string with some escape sequences: - ~%t~ stands for the title of the file, ~%a~ stands for the author of - the file and ~%d~ stands for the date of the file. The date is - retrieved with the ~org-publish-find-date~ function and formatted - with ~org-publish-sitemap-date-format~. Default ~%t~. - -- ~:sitemap-date-format~ :: - - Format string for the ~format-time-string~ function that tells how - a sitemap entry's date is to be formatted. This property bypasses - ~org-publish-sitemap-date-format~ which defaults to ~%Y-%m-%d~. - *** Generating an index :PROPERTIES: :DESCRIPTION: An index that reaches across pages. @@ -16909,12 +17429,12 @@ place on the web server, and publishing images to it. #+begin_src emacs-lisp (setq org-publish-project-alist - '(("orgfiles" + `(("orgfiles" :base-directory "~/org/" :base-extension "org" :publishing-directory "/ssh:user@host:~/html/notebook/" :publishing-function org-html-publish-to-html - :exclude "PrivatePage.org" ;; regexp + :exclude ,(rx (or "PrivateFile.org" (seq line-start "private/"))) ;; regexp :headline-levels 3 :section-numbers nil :with-toc nil @@ -16982,40 +17502,90 @@ keywords. :DESCRIPTION: create, follow and export citations. :END: #+cindex: citation +#+cindex: citation processor -The =oc.el= library provides tooling to handle citations in Org via -"citation processors" that offer some or all of the following -capabilities: +While links (see [[*Hyperlinks]]) are often sufficient to refer to +external or internal information from Org, they have their limitations +when referring to multiple targets or typesetting printed +publications. -- activate :: Fontification, tooltip preview, etc. -- follow :: At-point actions on citations via ~org-open-at-point~. -- insert :: Add and edit citations via ~org-cite-insert~. -- export :: Via different libraries for different target formats. +Org mode provides a more sophisticated markup to "cite" external +resources. For example, consider the following Org mode snippet -To use a "citation processor", the user must load them; for example; +: #+bibliography: citationdata.bib +: +: Org mode is used by various communities [cite:teaching: @orgteaching; +: and TeX: @orgtex]. [cite/author/caps:@orgtex] uses Org mode to simplify +: writing scientific publications, while [cite/author/caps:@orgteaching] +: experiment with Org babel to improve teaching. +: +: #+print_bibliography: -#+begin_src emacs-lisp -(require 'oc-bibtex) -#+end_src +Org mode will gather citation metadata from the =#+bibliography= +database and use it to typeset the exported document in arbitrary +formats. For example, the snippet below shows ASCII export output. -They can then configure them with ~org-cite-activate-processor~, -~org-cite-follow-processor~, ~org-cite-insert-processor~, and -~org-cite-export-processors~ respectively. +: Org mode is used by various communities (teaching: Birkenkrahe, Marcus, +: 2023, and TeX: Somma, Emmanuele F, 2023). Somma, Emmanuele F uses Org +: mode to simplify writing scientific publications, while Birkenkrahe, +: Marcus experiment with Org babel to improve teaching. +: +: Birkenkrahe, Marcus (2023). /Teaching Data Science with Literate +: Programming Tools/, MDPI. +: +: Somma, Emmanuele F (2023). /Simplifying LaTeX with ORG-mode in Emacs/, +: TUGboat volume. + +In addition to export, users can use completion to search and insert +citations from the bibliography (via ~org-cite-insert~). Citations +also act like ordinary links, jumping to the citation metadata when +"following" them using ~org-open-at-point~. + +You can customize every aspect (/capability/) of citation handling +using built-in or external /citation processors/. + +Org mode ships with several built-in citation processors tailored to +work with LaTeX export and BibTeX bibliographies (=bibtex=, +=biblatex=, and =natbib= processors), or with more generic formats +described using [[https://citationstyles.org/][Citation Style +Language]] (=csl= processor). +The default citation processor is =basic= - it works with arbitrary +export formats and recognizes both BibTeX and CSL bibliographies. +More citation processors are distributed as Emacs packages. + +#+vindex: org-cite-activate-processor +#+vindex: org-cite-follow-processor +#+vindex: org-cite-insert-processor +#+vindex: org-cite-export-processor +Multiple citation processors can be mixed to meet your preferences. +Configure ~org-cite-activate-processor~, ~org-cite-follow-processor~, +~org-cite-insert-processor~, and ~org-cite-export-processors~ to +select which processor to use for every citation capability: -The included "basic" processor provides all four capabilities. +- activate :: Fontification, tooltip preview, etc. +- follow :: At-point actions on citations via ~org-open-at-point~. +- insert :: Add and edit citations via ~org-cite-insert~. +- export :: Via different libraries for different target formats. ** Citations +#+cindex: bibliography + +#+vindex: org-cite-global-bibliography Before adding citations, first set one-or-more bibliographies, either globally with ~org-cite-global-bibliography~, or locally using one or more "bibliography" keywords. +#+cindex: @samp{BIBLIOGRAPHY}, keyword #+begin_example #+bibliography: SomeFile.bib #+bibliography: /some/other/file.json #+bibliography: "/some/file/with spaces/in its name.bib" #+end_example +Org mode uses all the local and global bibliographies combined to +search for citation keys. + #+kindex: C-c C-x @@ #+findex: org-cite-insert One can then insert and edit citations using ~org-cite-insert~, called @@ -17028,20 +17598,40 @@ identifying a reference in the bibliography. - Each key starts with the character =@=. + : [cite:@key] + - Each key can be qualified by a /prefix/ (e.g.\nbsp{}"see ") and/or a /suffix/ (e.g.\nbsp{}"p.\nbsp{}123"), giving information useful or necessary for the comprehension of the citation but not included in the reference. + : [cite:see @key p. 123] + - A single citation can cite more than one reference ; the keys are separated by semicolons ; the formatting of such citation groups is specified by the style. + : [cite:@key1;@key2;@key3] + - One can also specify a stylistic variation for the citations by inserting a =/= and a style name between the =cite= keyword and the colon; this usually makes sense only for the author-year styles. -: [cite/style:common prefix ;prefix @key suffix; ... ; common suffix] + : [cite/style:common prefix ;prefix @key suffix; ... ; common suffix] + + When =style= is not specified, one of the two default styles are + used + + + either the default style specified in the =CITE_EXPORT= keyword + (see [[*Citation export processors]]) + + : #+cite_export: basic numeric noauthor/bare + : [cite:@key] is the same as [cite/noauthor/bare:@key] + + + or, if =CITE_EXPORT= is not set, using the default =nil= style + + : [cite:@key] is the same as [cite/nil:@key] + The only mandatory elements are: @@ -17060,8 +17650,10 @@ Org currently includes the following export processors: where backward compatibility is not a requirement and formatting needs are minimal; - - csl :: this export processor uses format files written in [[https://en.wikipedia.org/wiki/Citation_Style_Language][Citation - Style Language]] via [[https://github.com/andras-simonyi/citeproc-el][citeproc-el]]; + - csl :: this export processor uses format files written in + [[https://en.wikipedia.org/wiki/Citation_Style_Language][Citation + Style Language]] via + [[https://github.com/andras-simonyi/citeproc-el][citeproc-el]]; - In contrast, three other processors target LaTeX and LaTeX-derived formats exclusively: @@ -17081,20 +17673,22 @@ Org currently includes the following export processors: with LaTeX, which overcomes some serious BibTeX limitations, but has not (yet?)\nbsp{}been widely adopted by publishers. -The =CITE_EXPORT= keyword specifies the export processor and the -citation (and possibly reference) style(s); for example (all arguments -are optional) +#+cindex: @samp{CITE_EXPORT}, keyword +The =CITE_EXPORT= keyword specifies the export processor, citation +style, and bibliography style; for example (all arguments are +optional) -: #+cite_export: basic author author-year +: #+cite_export: [export processor name] [bibliography style] [default citation style] +: #+cite_export: basic author-year author #+texinfo: @noindent -specifies the "basic" export processor with citations inserted as +specifies the =basic= export processor with citations inserted as author's name and references indexed by author's names and year; : #+cite_export: csl /some/path/to/vancouver-brackets.csl #+texinfo: @noindent -specifies the "csl" processor and CSL style, which in this case +specifies the =csl= processor and CSL style, which in this case defines numeric citations and numeric references according to the =Vancouver= specification (as style used in many medical journals), following a typesetting variation putting citations between brackets; @@ -17107,16 +17701,33 @@ conformant to the Harvard style and the specification of the Wolkers-Kluwer publisher; since it relies on the ~bibtex~ processor of your LaTeX installation, it won't export to anything but PDF. +: #+cite_export: biblatex numeric,backend=bibtex + +#+vindex: org-cite-biblatex-options +#+texinfo: @noindent +specifies the =biblatex= export processor with the default =numeric= +style and the =bibtex= backend. Always define the style first and then +the rest of load-time options for the =biblatex= +package. Alternatively, you can use the ~key=val,key=val~ format for +the options as documented in the =biblatex= package documentation: + +: #+cite_export: biblatex backend=bibtex,style=numeric + +The ~org-cite-biblatex-options~ variable in your Emacs configuration +uses this format. It will only export to PDF, since it relies on the +~biblatex~ processor of your LaTeX installation. + ** Bibliography printing +#+cindex: @samp{PRINT_BIBLIOGRAPHY}, keyword The =PRINT_BIBLIOGRAPHY= keyword specifies where the bibliography should be printed (note the colon): : #+print_bibliography: The bibliography printed by the LaTeX-based export processors -"bibtex", "natbib" and "biblatex" has a chapter or section heading by -default, while the "basic" and "csl" processors print the list of +=bibtex=, =natbib= and =biblatex= has a chapter or section heading by +default, while the =basic= and =csl= processors print the list of bibliography entries without a heading. A document may contain more than one =PRINT_BIBLIOGRAPHY= keywords. @@ -17129,23 +17740,24 @@ certain category or to control formatting. The set of supported the different citation export processors. Some export processors do not support passing options. -*** Bibliography options in the "biblatex" and "csl" export processors +*** Bibliography options in the =biblatex= and =csl= export processors -The "biblatex" and "csl" export processors support bibliography +The =biblatex= and =csl= export processors support bibliography options through a property list attached to the =PRINT_BIBLIOGRAPHY= keyword. For example, -: #print_bibliography: :keyword algebra :type book +: #+print_bibliography: :keyword algebra :type book Values including spaces must be surrounded with double quotes. If you need to use a key multiple times, you can separate its values with commas, but without any space in-between: -: #print_bibliography: :keyword "algebraic logic" :nottype article,book +: #+print_bibliography: :keyword "algebraic logic" :nottype article,book + +The =biblatex= export processor accepts all options supported by +BibLaTeX's ~\printbibliography~ command. -The "biblatex" export processor accepts all options supported by -BibLaTeX's ~\printbibliography~ command, while the "csl" processor -accepts the following ones: +The =csl= processor accepts the following options: - =:keyword = :: Print only entries whose keyword field contains all given keywords. @@ -17231,7 +17843,7 @@ Org can extract one or more source code blocks and write them to one or more source files---a process known as /tangling/ in literate programming terminology. -For exporting and publishing, Org's back-ends can format a source code +For exporting and publishing, Org's backends can format a source code block appropriately, often with native syntax highlighting. For executing and compiling a source code block, the user can @@ -17306,7 +17918,8 @@ or from table formulas (see [[*The Spreadsheet]]) can use the name to reference a source block. This naming serves the same purpose as naming Org tables. Org mode requires unique names. For duplicate - names, Org mode's behavior is undefined. + names, Org mode's behavior is undefined. Inline code blocks cannot + have a name. - =#+BEGIN_SRC= ... =#+END_SRC= :: @@ -17317,9 +17930,16 @@ or - == :: #+cindex: language, in code blocks - Mandatory. It is the identifier of the source code language in the + Optional. It is the identifier of the source code language in the block. See [[*Languages]], for identifiers of supported languages. + When == identifier is omitted, the block also cannot + have == and =
=. + + Language identifier is also used to fontify code blocks in Org + buffers, when ~org-src-fontify-natively~ is set to non-~nil~. See + [[*Editing Source Code]]. + - == :: #+cindex: switches, in code blocks @@ -17591,6 +18211,10 @@ from the reference. : :var NAME=FILE:REFERENCE +When =FILE= does not exist, the reference is searched in the current +file, using the verbatim reference. This way, +=:var table=tbl:example= will be searched inside the current buffer. + Here are examples of passing values by reference: - table :: @@ -17623,10 +18247,12 @@ Here are examples of passing values by reference: names---because the second row is a horizontal rule---then Org removes the column names, processes the table, puts back the column names, and then writes the table to the results block. Using =yes=, - Org does the same to the first row, even if the initial table does - not contain any horizontal rule. When set to =no=, Org does not - pre-process column names at all. + Org does the same to the first non-hline row, even if the initial + table does not contain any horizontal rule. When set to =no=, Org + does not pre-process column names at all. + # We keep python blocks unindented on purpose - to keep the example + # working even for users who changed the default value of ~org-src-preserve-indentation~ #+begin_example ,#+NAME: less-cols | a | @@ -17635,7 +18261,7 @@ Here are examples of passing values by reference: | c | ,#+BEGIN_SRC python :var tab=less-cols :colnames nil - return [[val + '*' for val in row] for row in tab] + return [[val + '*' for val in row] for row in tab] ,#+END_SRC ,#+RESULTS: @@ -17660,7 +18286,7 @@ Here are examples of passing values by reference: | two | 6 | 7 | 8 | 9 | 10 | ,#+BEGIN_SRC python :var tab=with-rownames :rownames yes - return [[val + 10 for val in row] for row in tab] + return [[val + 10 for val in row] for row in tab] ,#+END_SRC ,#+RESULTS: @@ -17711,6 +18337,7 @@ a colon, for example: =:var table=other-file.org:example-table=. A code block name, as assigned by =NAME= keyword, followed by parentheses and optional arguments passed within the parentheses. + The block is evaluated with point at its location. #+begin_example ,#+NAME: double @@ -18029,7 +18656,7 @@ block, collects the results, and inserts them in the buffer. #+cindex: @samp{CALL}, keyword #+vindex: org-babel-inline-result-wrap -By calling a named code block[fn:48] from an Org mode buffer or +By calling a named code block[fn:49] from an Org mode buffer or a table. Org can call the named code blocks from the current Org mode buffer or from the "Library of Babel" (see [[*Library of Babel]]). @@ -18237,7 +18864,7 @@ they are mutually exclusive. - =value= :: - Default for most Babel libraries[fn:48]. Functional mode. Org + Default for most Babel libraries[fn:49]. Functional mode. Org gets the value by wrapping the code in a function definition in the language of the source block. That is why when using =:results value=, code should execute like a function and return a value. For @@ -18290,6 +18917,8 @@ described in the documentation for individual languages. See those =hline= symbols raise unbound variable errors. A =yes= accepts such lines, as demonstrated in the following example. + # We keep python blocks unindented on purpose - to keep the example + # working even for users who changed the default value of ~org-src-preserve-indentation~ #+begin_example ,#+NAME: many-cols | a | b | c | @@ -18300,7 +18929,7 @@ described in the documentation for individual languages. See ,#+NAME: no-hline ,#+BEGIN_SRC python :var tab=many-cols :hlines no - return tab + return tab ,#+END_SRC ,#+RESULTS: no-hline @@ -18310,7 +18939,7 @@ described in the documentation for individual languages. See ,#+NAME: hlines ,#+BEGIN_SRC python :var tab=many-cols :hlines yes - return tab + return tab ,#+END_SRC ,#+RESULTS: hlines @@ -18357,6 +18986,9 @@ described in the documentation for individual languages. See from the =file-ext= header argument. In that case, both the name and the extension are mandatory. + Result can also be interpreted as path to file. See =:results + link=. + #+begin_example ,#+name: circle ,#+BEGIN_SRC asymptote :results value file :file-ext pdf @@ -18399,6 +19031,11 @@ Choose one of the options; they are mutually exclusive. The default follows from the type specified above. #+attr_texinfo: :sep , +- =raw= :: + + Interpreted as raw Org mode. Inserted directly into the buffer. + Aligned if it is a table. Usage example: =:results value raw=. + - =code= :: Result enclosed in a code block. Useful for parsing. Usage @@ -18406,8 +19043,9 @@ follows from the type specified above. - =drawer= :: - Result wrapped in a =RESULTS= drawer. Useful for containing =raw= - or =org= results for later scripting and automated processing. + Results are added directly to the Org file as with =raw=, but are + wrapped in a =RESULTS= drawer or results macro (for inline code + blocks), for later scripting and automated processing. Usage example: =:results value drawer=. - =html= :: @@ -18437,6 +19075,9 @@ follows from the type specified above. [[file:org-mode-unicorn.svg]] #+end_example + If =:file= header argument is omitted, interpret source block result + as the file path. + - =org= :: Results enclosed in a =BEGIN_SRC org= block. For comma-escape, @@ -18449,10 +19090,6 @@ follows from the type specified above. block. Languages supported: Emacs Lisp, Python, and Ruby. Usage example: =:results value pp=. -- =raw= :: - - Interpreted as raw Org mode. Inserted directly into the buffer. - Aligned if it is a table. Usage example: =:results value raw=. #+cindex: @samp{wrap}, header argument The =wrap= header argument unconditionally marks the results block by @@ -18503,7 +19140,7 @@ options; they are mutually exclusive. but no processing is performed on the return value. Calling the code block programmatically (see [[*How to evaluate source code]]) or by reference (see [[*Passing arguments]] and [[*Noweb Reference Syntax]]) will - always yield nil. + always yield ~nil~. - =append= :: @@ -18950,6 +19587,9 @@ group ~org-edit-structure~. header line, then the edit buffer uses that major mode. Use this variable to arbitrarily map language identifiers to major modes. + When language identifier is omitted in the src block, Org mode's + behavior is undefined. + - ~org-src-window-setup~ :: #+vindex: org-src-window-setup @@ -18975,10 +19615,13 @@ group ~org-edit-structure~. #+vindex: org-src-fontify-natively #+vindex: org-src-block-faces -Set ~org-src-fontify-natively~ to non-~nil~ to turn on native code -fontification in the /Org/ buffer. Fontification of code blocks can -give visual separation of text and code on the display page. To -further customize the appearance of ~org-block~ for specific +Fontification of code blocks can give visual separation of text and +code on the display page. Set ~org-src-fontify-natively~ to non-~nil~ +to turn on native code fontification in the /Org/ buffer. The +fontification follows the major mode used to edit the code block (see +~org-src-lang-modes~ above). + +To further customize the appearance of ~org-block~ for specific languages, customize ~org-src-block-faces~. The following example shades the background of regular blocks, and colors source blocks only for Python and Emacs Lisp languages. @@ -19084,6 +19727,9 @@ the second code block is expanded as ,#+END_SRC #+end_example +Note that noweb expansion does not automatically carry over =:var= +header arguments[fn:50]. + You may also include the contents of multiple blocks sharing a common =noweb-ref= header argument, which can be set at the file, subtree, or code block level. In the example Org file shown next, the body of @@ -19120,9 +19766,10 @@ By default a newline separates each noweb reference concatenation. To use a different separator, edit the =noweb-sep= header argument. Alternatively, Org can include the results of evaluation of a single -code block rather than its body. Evaluation occurs when parentheses, -possibly including arguments, are appended to the code block name, as -shown below. +code block rather than its body [[fn::The reference is evaluated with +point at the referenced block, using its header arguments (including +inherited)]. Evaluation occurs when parentheses, possibly including +arguments, are appended to the code block name, as shown below. : <> @@ -19134,10 +19781,12 @@ Here is an example that demonstrates how the exported content changes when noweb style references are used with parentheses versus without. Given: +# We keep python blocks unindented on purpose - to keep the example +# working even for users who changed the default value of ~org-src-preserve-indentation~ #+begin_example ,#+NAME: some-code ,#+BEGIN_SRC python :var num=0 :results output :exports none - print(num*10) +print(num*10) ,#+END_SRC #+end_example @@ -19209,15 +19858,17 @@ newlines in them, inline noweb references are acceptable. This feature can also be used for management of indentation in exported code snippets. With: +# We keep python blocks unindented on purpose - to keep the example +# working even for users who changed the default value of ~org-src-preserve-indentation~ #+begin_example ,#+NAME: if-true ,#+BEGIN_SRC python :exports none - print('do things when true') +print('do things when true') ,#+end_src ,#+name: if-false ,#+begin_src python :exports none - print('do things when false') +print('do things when false') ,#+end_src #+end_example @@ -19226,10 +19877,10 @@ this code block: #+begin_example ,#+begin_src python :noweb yes :results output - if true: - <> - else: - <> +if true: + <> +else: + <> ,#+end_src #+end_example @@ -19619,7 +20270,7 @@ in the desired amount with hard spaces and hiding leading stars. To display the buffer in the indented view, activate Org Indent minor mode, using {{{kbd(M-x org-indent-mode)}}}. Text lines that are not headlines are prefixed with virtual spaces to vertically align with -the headline text[fn:49]. +the headline text[fn:51]. #+vindex: org-indent-indentation-per-level To make more horizontal space, the headlines are shifted by two @@ -19647,7 +20298,7 @@ use =STARTUP= keyword as follows: It is possible to use hard spaces to achieve the indentation instead, if the bare ASCII file should have the indented look also outside -Emacs[fn:50]. With Org's support, you have to indent all lines to +Emacs[fn:52]. With Org's support, you have to indent all lines to line up with the outline headers. You would use these settings[fn:: ~org-adapt-indentation~ can also be set to ='headline-data=, in which case only data lines below the headline will be indented.]: @@ -19890,15 +20541,18 @@ changes. #+cindex: @samp{SETUPFILE}, keyword The setup file or a URL pointing to such file is for additional in-buffer settings. Org loads this file and parses it for any - settings in it only when Org opens the main file. If URL is + settings in it when Org opens the main file. If URL is specified, the contents are downloaded and stored in a temporary - file cache. {{{kbd(C-c C-c)}}} on the settings line parses and - loads the file, and also resets the temporary file cache. Org also - parses and loads the document during normal exporting process. Org - parses the contents of this document as if it was included in the - buffer. It can be another Org file. To visit the file---not - a URL---use {{{kbd(C-c ')}}} while point is on the line with the - file name. + file cache. {{{kbd(C-c C-c)}}} on the settings line re-parses and + re-loads the file, and also resets the temporary file cache. + + Org also parses and loads /in-buffer settings/ from the setup file + during normal exporting process. Org parses the /in-buffer + settings/ as if it was included in the containing Org buffer. The + rest of the contents of setup file is ignored. + + To visit the setup file---not a URL---use {{{kbd(C-c ')}}} while point + is on the line with the setup file name. - =#+STARTUP:= :: @@ -19959,6 +20613,17 @@ changes. | =inlineimages= | Show inline images. | | =noinlineimages= | Do not show inline images on startup. | + #+vindex: org-link-descriptive + Bracket links in Org buffers are displayed hiding the link path and + brackets. For example, =[[https://orgmode.org][Org Website]]= is, + by default, displayed as "Org Website", hiding the link itself and + just displaying its description. Alternatively, the links can be + displayed in full. The corresponding variable is + ~org-link-descriptive~. + + | =descriptivelinks= | Hide path and brackets in links. | + | =literallinks= | Do not hide anything. | + #+vindex: org-log-done #+vindex: org-log-note-clock-out #+vindex: org-log-repeat @@ -19999,11 +20664,12 @@ changes. | =odd= | Allow only odd outline levels (1, 3, ...). | | =oddeven= | Allow all outline levels. | - #+vindex: org-put-time-stamp-overlays - #+vindex: org-time-stamp-overlay-formats + #+vindex: org-display-custom-times + #+vindex: org-timestamp-custom-formats + #+vindex: org-time-stamp-custom-formats To turn on custom format overlays over timestamps (variables - ~org-put-time-stamp-overlays~ and - ~org-time-stamp-overlay-formats~), use: + ~org-display-custom-times~ and + ~org-timestamp-custom-formats~), use: | =customtime= | Overlay custom time format. | @@ -20029,6 +20695,7 @@ changes. | =fnconfirm= | Offer automatic label for editing or confirmation. | | =fnadjust= | Automatically renumber and sort footnotes. | | =nofnadjust= | Do not renumber and sort automatically. | + | =fnanon= | Create anonymous footnotes with ~org-footnote-new~. | #+vindex: org-hide-block-startup #+vindex: org-hide-drawer-startup @@ -20088,8 +20755,8 @@ For more information, see [[info:emacs::Regexps][Regular Expressions in Emacs]]. :END: A reference document providing a formal description of Org's syntax is -available as [[https://orgmode.org/worg/dev/org-syntax.html][a draft on Worg]], written and maintained by Nicolas -Goaziou. It defines Org's core internal concepts such as "headlines", +available as [[https://orgmode.org/worg/org-syntax.html][a draft on Worg]], initially written by Nicolas Goaziou. +It defines Org's core internal concepts such as "headlines", "sections", "affiliated keywords", "(greater) elements" and "objects". Each part of an Org document belongs to one of the previous categories. @@ -20295,6 +20962,10 @@ packages are documented here. By default the index is two levels deep---you can modify the depth using the option ~org-imenu-depth~. + Org activates Imenu support only in the buffers opened after loading + Imenu library. To enable Imenu support in an already opened Org + buffer, reload Org. + - =speedbar.el= by Eric\nbsp{}M.\nbsp{}Ludlam :: #+cindex: @file{speedbar.el} @@ -20496,6 +21167,7 @@ further based on their usage needs. For example, the normal | {{{kbd(S-DOWN)}}} | {{{kbd(C-c DOWN)}}} | | | | {{{kbd(C-S-LEFT)}}} | {{{kbd(C-c C-x LEFT)}}} | | | | {{{kbd(C-S-RIGHT)}}} | {{{kbd(C-c C-x RIGHT)}}} | | | +| {{{kbd(C-c C-\,)}}} | {{{kbd(C-c C-x s)}}} | | | ** Protocols for External Access :PROPERTIES: @@ -20754,8 +21426,8 @@ specifying the respective key as property =CRYPTKEY=, e.g.: :END: #+end_example -Note that =CRYPTKEY= property is only effective when ~org-crypt-key~ -is set to non-nil. ~nil~ value of ~org-crypt-key~ makes Org use +Note that the =CRYPTKEY= property is only effective when +~org-crypt-key~ is non-~nil~. If ~org-crypt-key~ is ~nil~, Org uses symmetric encryption unconditionally. Excluding the =crypt= tag from inheritance prevents already encrypted @@ -20793,7 +21465,7 @@ Tags]]) only for those set in these variables. #+vindex: org-mobile-directory The mobile application needs access to a file directory on -a server[fn:51] to interact with Emacs. Pass its location through +a server[fn:53] to interact with Emacs. Pass its location through the ~org-mobile-directory~ variable. If you can mount that directory locally just set the variable to point to that directory: @@ -20837,7 +21509,7 @@ Symbolic links in ~org-directory~ need to have the same name as their targets.]. Push creates a special Org file =agendas.org= with custom agenda views -defined by the user[fn:52]. +defined by the user[fn:54]. Finally, Org writes the file =index.org=, containing links to other files. The mobile application reads this file first from the server @@ -20898,6 +21570,51 @@ most recent since the mobile application searches files that were last pulled. To get an updated agenda view with changes since the last pull, pull again. +** Drag and Drop & ~yank-media~ +:PROPERTIES: +:DESCRIPTION: Dropping and pasting files and images +:END: + +#+cindex: dropping files +#+cindex: dragging files +#+cindex: drag and drop +#+cindex: dnd +#+vindex: org-yank-dnd-method +Org mode supports drag and drop (DnD) of files. By default, Org asks +the user what must be done with the dropped file: attach it, insert +=file:= link, or open the file. Customize ~org-yank-dnd-method~ to +set the default DnD action. + +When DnD method is "attach", Org mode first consults DnD metadata to +decide the attach method. For example, when file/files are dragged +from a file manager, Org may attach by copying or by moving. + +#+vindex: org-yank-dnd-default-attach-method +If Org cannot figure out which attachment method to use from the +metadata, it defaults to ~org-yank-dnd-default-attach-method~ [fn::By +default, ~org-yank-dnd-default-attach-method~ is set to nil -- use the same +value as ~org-attach-method~ (~cp~ by default).] + +#+cindex: pasting files, images from clipboard +Starting from Emacs 29, Org mode supports ~yank-media~ command to yank +images from the clipboard and files from a file manager. + +#+vindex: org-yank-image-save-method +When yanking images from clipboard, Org saves the image on disk and +inserts the image link to Org buffer. Images are either saved as +attachments to heading (default) or to a globally defined directory. +The save location is controlled by ~org-yank-image-save-method~. + +#+vindex: org-yank-image-file-name-function +The yanked images are saved under automatically generated name. You +can customize ~org-yank-image-file-name-function~ to make Org query +the image names or change the naming scheme. + +When yanking files copied from a file manager, Org respects the value +of ~org-yank-dnd-method~. Image files pasted this way also respect +the value of ~org-yank-image-save-method~ when the action to perform +is =attach=. + * Hacking :PROPERTIES: :DESCRIPTION: How to hack your way around. @@ -20914,10 +21631,9 @@ of Org. :END: #+cindex: hooks -Org has a large number of hook variables for adding functionality. -This appendix illustrates using a few. A complete list of hooks with -documentation is maintained by the Worg project at -https://orgmode.org/worg/doc.html#hooks. +Org has a large number of hook variables for adding functionality. A +complete list of hooks with documentation is maintained by the Worg +project at https://orgmode.org/worg/doc.html#hooks. ** Add-on Packages :PROPERTIES: @@ -20965,7 +21681,7 @@ The following =ol-man.el= file implements it PATH should be a topic that can be thrown at the man command." (funcall org-man-command path)) -(defun org-man-store-link () +(defun org-man-store-link (&optional _interactive?) "Store a link to a man page." (when (memq major-mode '(Man-mode woman-mode)) ;; This is a man page, we do make this link. @@ -21025,41 +21741,43 @@ A review of =ol-man.el=: For example, ~org-man-store-link~ is responsible for storing a link when ~org-store-link~ (see [[*Handling Links]]) is called from a buffer - displaying a man page. It first checks if the major mode is - appropriate. If check fails, the function returns ~nil~, which - means it isn't responsible for creating a link to the current - buffer. Otherwise the function makes a link string by combining - the =man:= prefix with the man topic. It also provides a default - description. The function ~org-insert-link~ can insert it back - into an Org buffer later on. + displaying a man page. It is passed an argument ~interactive?~ + which this function does not use, but other store functions use to + behave differently when a link is stored interactively by the user. + It first checks if the major mode is appropriate. If check fails, + the function returns ~nil~, which means it isn't responsible for + creating a link to the current buffer. Otherwise the function + makes a link string by combining the =man:= prefix with the man + topic. It also provides a default description. The function + ~org-insert-link~ can insert it back into an Org buffer later on. -** Adding Export Back-ends +** Adding Export Backends :PROPERTIES: -:DESCRIPTION: How to write new export back-ends. +:DESCRIPTION: How to write new export backends. :END: -#+cindex: Export, writing back-ends +#+cindex: Export, writing backends -Org's export engine makes it easy for writing new back-ends. The +Org's export engine makes it easy for writing new backends. The framework on which the engine was built makes it easy to derive new -back-ends from existing ones. +backends from existing ones. #+findex: org-export-define-backend #+findex: org-export-define-derived-backend The two main entry points to the export engine are: ~org-export-define-backend~ and ~org-export-define-derived-backend~. To grok these functions, see =ox-latex.el= for an example of defining -a new back-end from scratch, and =ox-beamer.el= for an example of +a new backend from scratch, and =ox-beamer.el= for an example of deriving from an existing engine. -For creating a new back-end from scratch, first set its name as +For creating a new backend from scratch, first set its name as a symbol in an alist consisting of elements and export functions. To -make the back-end visible to the export dispatcher, set ~:menu-entry~ -keyword. For export options specific to this back-end, set the +make the backend visible to the export dispatcher, set ~:menu-entry~ +keyword. For export options specific to this backend, set the ~:options-alist~. -For creating a new back-end from an existing one, set +For creating a new backend from an existing one, set ~:translate-alist~ to an alist of export functions. This alist -replaces the parent back-end functions. +replaces the parent backend functions. For complete documentation, see [[https://orgmode.org/worg/dev/org-export-reference.html][the Org Export Reference on Worg]]. @@ -21157,7 +21875,7 @@ of these strategies: To wrap a source table in LaTeX, use the =comment= environment provided by =comment.sty=[fn:: https://www.ctan.org/pkg/comment]. To activate it, put ~\usepackage{comment}~ in the document header. -Orgtbl mode inserts a radio table skeleton[fn:53] with the command +Orgtbl mode inserts a radio table skeleton[fn:55] with the command {{{kbd(M-x orgtbl-insert-radio-table)}}}, which prompts for a table name. For example, if =salesfigures= is the name, the template inserts: @@ -21177,7 +21895,7 @@ The line =#+ORGTBL: SEND= tells Orgtbl mode to use the function ~orgtbl-to-latex~ to convert the table to LaTeX format, then insert the table at the target (receive) location named =salesfigures=. Now the table is ready for data entry. It can even use spreadsheet -features[fn:54]: +features[fn:56]: #+begin_example % BEGIN RECEIVE ORGTBL salesfigures @@ -21269,7 +21987,7 @@ Orgtbl mode has built-in translator functions: ~orgtbl-to-csv~ ~orgtbl-to-latex~, ~orgtbl-to-html~, ~orgtbl-to-texinfo~, ~orgtbl-to-unicode~ and ~orgtbl-to-orgtbl~. They use the generic translator, ~orgtbl-to-generic~, which delegates translations to -various export back-ends. +various export backends. Properties passed to the function through the =ORGTBL SEND= line take precedence over properties defined inside the function. For example, @@ -21396,7 +22114,7 @@ Org provides a special hook to further limit items in agenda views: ~agenda~, ~agenda*~[fn:: The ~agenda*~ view is the same as ~agenda~ except that it only considers /appointments/, i.e., scheduled and deadline items that have a time specification =[h]h:mm= in their -time-stamps.], ~todo~, ~alltodo~, ~tags~, ~tags-todo~, ~tags-tree~. +timestamps.], ~todo~, ~alltodo~, ~tags~, ~tags-todo~, ~tags-tree~. Specify a custom function that tests inclusion of every matched item in the view. This function can also skip as much as is needed. @@ -21538,15 +22256,13 @@ number. Here are tips to speed up: #+end_src #+vindex: org-agenda-ignore-properties -- Disable parsing of some drawer properties: +- Disable parsing of some properties: #+begin_src emacs-lisp - (setq org-agenda-ignore-properties '(effort appt stats category)) + (setq org-agenda-ignore-properties '(stats)) #+end_src - The drawer properties you can disable in the agenda are effort - estimates (~effort~), appointments (~appt~), statistics (~stats~) - and subtree-local categories (~category~). + This will disable parsing and updating statistic cookies. These options can be applied to selected agenda views. For more details about generation of agenda views, see the docstrings for the @@ -21713,7 +22429,7 @@ Get all property keys in the current buffer. #+attr_texinfo: :options org-insert-property-drawer #+begin_defun -Insert a property drawer for the current entry. Also +Insert a property drawer for the current entry. #+end_defun #+attr_texinfo: :options org-entry-put-multivalued-property pom property &rest values @@ -22336,7 +23052,7 @@ modify this GNU manual." #+export_file_name: org.texi #+texinfo_dir_category: Emacs editing modes -#+texinfo_dir_title: Org Mode: (org) +#+texinfo_dir_name: Org Mode: (org) #+texinfo_dir_desc: Outline-based notes management and organizer * Footnotes @@ -22416,20 +23132,20 @@ from the list of stored links. To keep it in the list for later use, use a triple {{{kbd(C-u)}}} prefix argument to {{{kbd(C-c C-l)}}}, or configure the option ~org-link-keep-stored-after-insertion~. -[fn:15] Check also the variable ~org-fast-tag-selection-include-todo~, -it allows you to change the TODO state through the tags interface (see -[[*Setting Tags]]), in case you like to mingle the two concepts. Note -that this means you need to come up with unique keys across both sets -of keywords. - -[fn:16] It is possible that Org mode records two timestamps when you +[fn:15] It is possible that Org mode records two timestamps when you are using both ~org-log-done~ and state change logging. However, it never prompts for two notes: if you have configured both, the state change recording note takes precedence and cancel the closing note. -[fn:17] With the exception of description lists. But you can allow it +[fn:16] With the exception of description lists. But you can allow it by modifying ~org-list-automatic-rules~ accordingly. +[fn:17] For both =TIMESTAMP= and =TIMESTAMP_IA=: the word "first" +refers to the first occurrence in the entry, not the earliest in time; +the prefix =CLOCK:= at the beginning of a clock entry is considered a +keyword in this context; and timestamps inside property drawers are +ignored. + [fn:18] An age can be defined as a duration, using units defined in ~org-duration-units~, e.g., =3d 1h=. If any value in the column is as such, the summary is also expressed as a duration. @@ -22481,7 +23197,10 @@ With =lognoterepeat=, you will also be prompted for a note. than 30 stars. This is a hard-coded limitation of ~lmax~ in ~org-clock-sum~. -[fn:28] On computers using macOS, idleness is based on actual user +[fn:28] When using ~:step~, ~untilnow~ starts from the beginning of +2003, not the beginning of time. + +[fn:29] On computers using macOS, idleness is based on actual user idleness, not just Emacs' idle time. For X11, you can install a utility program =x11idle.c=, available in the =org-contrib/= repository, or install the xprintidle package and set it to the @@ -22489,13 +23208,13 @@ variable ~org-clock-x11idle-program-name~ if you are running Debian, to get the same general treatment of idleness. On other systems, idle time refers to Emacs idle time only. -[fn:29] Org used to offer four different targets for date/week tree +[fn:30] Org used to offer four different targets for date/week tree capture. Now, Org automatically translates these to use ~file+olp+datetree~, applying the ~:time-prompt~ and ~:tree-type~ properties. Please rewrite your date/week-tree targets using ~file+olp+datetree~ since the older targets are now deprecated. -[fn:30] A date tree is an outline structure with years on the highest +[fn:31] A date tree is an outline structure with years on the highest level, months or ISO weeks as sublevels and then dates on the lowest level. @@ -22506,17 +23225,18 @@ level. ,*** 2022-10-08 Saturday #+end_example -Tags are allowed in the tree structure. +TODO state, priority, tags, statistics cookies, and COMMENT keywords +are allowed in the tree structure. -[fn:31] This is always the other, not the user. See the variable +[fn:32] This is always the other, not the user. See the variable ~org-link-from-user-regexp~. -[fn:32] For backward compatibility, the universal prefix argument +[fn:33] For backward compatibility, the universal prefix argument {{{kbd(C-u)}}} causes all TODO entries to be listed before the agenda. This feature is deprecated, use the dedicated TODO list, or a block agenda instead (see [[*Block agenda]]). -[fn:33] Custom agenda commands can preset a filter by binding one of +[fn:34] Custom agenda commands can preset a filter by binding one of the variables ~org-agenda-tag-filter-preset~, ~org-agenda-category-filter-preset~, ~org-agenda-effort-filter-preset~ or ~org-agenda-regexp-filter-preset~ as an option. This filter is @@ -22526,94 +23246,122 @@ property of the entire agenda view---in a block agenda, you should only set this in the global options section, not in the section of an individual block. -[fn:34] /Planned/ means here that these entries have some planning -information attached to them, like a time-stamp, a scheduled or +[fn:35] /Planned/ means here that these entries have some planning +information attached to them, like a timestamp, a scheduled or a deadline string. See ~org-agenda-entry-types~ on how to set what planning information is taken into account. -[fn:35] To create PDF output, the Ghostscript ps2pdf utility must be +[fn:36] To create PDF output, the Ghostscript ps2pdf utility must be installed on the system. Selecting a PDF file also creates the postscript file. -[fn:36] LaTeX is a macro system based on Donald\nbsp{}E.\nbsp{}Knuth's TeX +[fn:37] LaTeX is a macro system based on Donald\nbsp{}E.\nbsp{}Knuth's TeX system. Many of the features described here as "LaTeX" are really from TeX, but for simplicity I am blurring this distinction. -[fn:37] When MathJax is used, only the environments recognized by +[fn:38] When MathJax is used, only the environments recognized by MathJax are processed. When dvipng, dvisvgm, or ImageMagick suite is used to create images, any LaTeX environment is handled. -[fn:38] These are respectively available at +[fn:39] These are respectively available at [[https://sourceforge.net/projects/dvipng/]], [[http://dvisvgm.bplaced.net/]] and from the ImageMagick suite. Choose the converter by setting the variable ~org-preview-latex-default-process~ accordingly. -[fn:39] This works automatically for the HTML backend (it requires +[fn:40] This works automatically for the HTML backend (it requires version 1.34 of the =htmlize.el= package, which you need to install). Fontified code chunks in LaTeX can be achieved using either the [[https://www.ctan.org/pkg/listings][listings]] LaTeX package, [[https://www.ctan.org/pkg/minted][minted]] LaTeX package, or by using [[https://elpa.gnu.org/packages/engrave-faces.html][engrave-faces]] . Refer to ~org-latex-src-block-backend~ for details. -[fn:40] Source code in code blocks may also be evaluated either +[fn:41] Source code in code blocks may also be evaluated either interactively or on export. See [[*Working with Source Code]] for more information on evaluating code blocks. -[fn:41] For export to LaTeX format---or LaTeX-related formats such as +[fn:42] For export to LaTeX format---or LaTeX-related formats such as Beamer---, the =org-latex-package-alist= variable needs further configuration. See [[LaTeX specific export settings]]. -[fn:42] At the moment, some export back-ends do not obey this +[fn:43] At the moment, some export backends do not obey this specification. For example, LaTeX export excludes every unnumbered headline from the table of contents. -[fn:43] Note that ~org-link-search-must-match-exact-headline~ is +[fn:44] Note that ~org-link-search-must-match-exact-headline~ is locally bound to non-~nil~. Therefore, ~org-link-search~ only matches headlines and named elements. -[fn:44] Since commas separate the arguments, commas within arguments +[fn:45] Since commas separate the arguments, commas within arguments have to be escaped with the backslash character. So only those backslash characters before a comma need escaping with another backslash character. -[fn:45] If =BEAMER_ENV= is set, Org export adds =B_environment= tag +[fn:46] If =BEAMER_ENV= is set, Org export adds =B_environment= tag to make it visible. The tag serves as a visual aid and has no semantic relevance. -[fn:46] Please note that exported formulas are part of an HTML +[fn:47] Please note that exported formulas are part of an HTML document, and that signs such as =<=, =>=, or =&= have special meanings. See [[https://docs.mathjax.org/en/latest/input/tex/html.html#tex-and-latex-in-html-documents][MathJax TeX and LaTeX in HTML documents]]. -[fn:47] This does not allow setting different bibliography compilers +[fn:48] This does not allow setting different bibliography compilers for different files. However, "smart" LaTeX compilation systems, such as latexmk, can select the correct bibliography compiler. -[fn:48] Actually, the constructs =call_()= and =src_{}= +[fn:49] Actually, the constructs =call_()= and =src_{}= are not evaluated when they appear in a keyword (see [[*Summary of In-Buffer Settings]]). -[fn:49] Org Indent mode also sets ~wrap-prefix~ correctly for +[fn:50] In the following example, attempting to evaluate +the second code block will give an error, because the variables +defined in the first code block will not be defined in the second +block. + +#+begin_example +,#+NAME: get-prompt +,#+BEGIN_SRC emacs-lisp :var prompt="root> " :var command="ls" + (concat prompt command) +,#+END_SRC + +,#+RESULTS: get-prompt +: root> ls + +,#+BEGIN_SRC emacs-lisp :noweb yes + <> +,#+END_SRC +#+end_example + +The previous block is expanded without setting ~prompt~ and ~command~ +values. + +#+begin_example +,#+BEGIN_SRC emacs-lisp + (concat prompt command) +,#+END_SRC +#+end_example + +[fn:51] Org Indent mode also sets ~wrap-prefix~ correctly for indenting and wrapping long lines of headlines or text. This minor mode also handles Visual Line mode and directly applied settings through ~word-wrap~. -[fn:50] This works, but requires extra effort. Org Indent mode is +[fn:52] This works, but requires extra effort. Org Indent mode is more convenient for most applications. -[fn:51] For a server to host files, consider using a WebDAV server, +[fn:53] For a server to host files, consider using a WebDAV server, such as [[https://nextcloud.com][Nextcloud]]. Additional help is at this [[https://orgmode.org/worg/org-faq.html#mobileorg_webdav][FAQ entry]]. -[fn:52] While creating the agendas, Org mode forces =ID= properties +[fn:54] While creating the agendas, Org mode forces =ID= properties on all referenced entries, so that these entries can be uniquely identified if Org Mobile flags them for further action. To avoid setting properties configure the variable ~org-mobile-force-id-on-agenda-items~ to ~nil~. Org mode then relies on outline paths, assuming they are unique. -[fn:53] By default this works only for LaTeX, HTML, and Texinfo. +[fn:55] By default this works only for LaTeX, HTML, and Texinfo. Configure the variable ~orgtbl-radio-table-templates~ to install templates for other modes. -[fn:54] If the =TBLFM= keyword contains an odd number of dollar +[fn:56] If the =TBLFM= keyword contains an odd number of dollar characters, this may cause problems with Font Lock in LaTeX mode. As shown in the example you can fix this by adding an extra line inside the =comment= environment that is used to balance the dollar diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index d07ce53ab20..26f927d4244 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -11,6 +11,1651 @@ See the end of the file for license conditions. Please send Org bug reports to mailto:emacs-orgmode@gnu.org. +* Version 9.7 + +** Important announcements and breaking changes + +# Here, we list the *most important* changes and changes that _likely_ +# require user action for most Org mode users. +# Sorted from most important to least important. + +*** =python-mode.el (MELPA)= support in =ob-python.el= is removed + +=python-mode.el= support has been removed from =ob-python.el=. The +related customization =org-babel-python-mode= has been changed to a +constant. + +If you still want to use python-mode with ob-python, you might +consider [[https://gitlab.com/jackkamm/ob-python-mode-mode][ob-python-mode-mode]], where the code to support python-mode +has been ported to. + +*** =ox-latex=: ~org-latex-line-break-safe~ is deprecated + +~org-latex-line-break-safe~ constant was previously introduced to deal +with edge cases when LaTeX interprets [...] as LaTeX command +argument. However, it caused a number of other issues and proved +itself not to be as "safe" as it supposed to be. + +We now use a Pandoc's approach to deal with the same problem, +utilizing ={[}= to escape =[...]= instances where needed. + +*** ~tab-width~ value is now assumed to be 8 + +Org mode now assumes tab width to be 8 characters, when calculating +list and other indentation. ~tab-width~ is also set to 8 when Org +major mode is loaded. + +This is done to improve consistency of the markup for lists, where +indentation affects list items. + +Users with non-default values of ~tab-width~ should avoid overriding +the value of 8 set by Org mode. If the custom ~tab-width~ value is +_smaller_ than 8, the existing Org documents can be converted to the +new standard tab width using the following helper command: + +#+begin_src emacs-lisp +(defun org-compat-adjust-tab-width-in-buffer (old-width) + "Adjust visual indentation from `tab-width' equal OLD-WIDTH to 8." + (interactive "nOld `tab-width': ") + (cl-assert (derived-mode-p 'org-mode)) + (unless (= old-width 8) + (org-with-wide-buffer + (goto-char (point-min)) + (let (bound + (repl (if (< old-width 8) + (make-string old-width ?\s) + (concat "\t" (make-string (- old-width 8) ?\s))))) + (while (re-search-forward "^ *\t" nil t) + (skip-chars-forward " \t") + (setq bound (point-marker)) + (forward-line 0) + (while (search-forward "\t" bound t) + (replace-match repl))))))) +#+end_src + +*** ~org-ctags~ is not activated by default any more + +To follow Emacs [[info:elisp#Coding Conventions][coding conventions]] and to avoid confusion of users +who accidentally get ~org-ctags~ autoloaded due to help completion, +the library does not modify ~org-open-link-functions~ during loading +any more. Run ~org-ctags-enable~ to setup hooks and advices: + +#+begin_src emacs-lisp +(with-eval-after-load "org-ctags" + (org-ctags-enable)) +#+end_src + +*** "Priority" used to sort items in agenda is renamed to "urgency" + +Previously, ~priority-up~ and ~priority-down~ in +~org-agenda-sorting-strategy~ used a composite rank depending on +item's priority (=[#A]=, =[#B]=, =[#C]=, etc) and overdue time to +order agenda items (see "11.4.3 Sorting of agenda items" section of +Org manual). + +Now, this composite rank is renamed to =urgency= and the relevant +sorting strategies are renamed to ~urgency-up~ and ~urgency-down~. +~priority-up~ and ~priority-down~ sort by item's priority only. + +Users relying on the previous composite ranking should adjust their +agenda sorting settings. + +*** ~org-priority-show~ command no longer adjusts for scheduled/deadline + +In agenda views, ~org-priority-show~ command previously displayed the +composite rank consisting of the item priority and overdue. This is +no longer the case. The displayed and returned value only depends on +the item priority now. + +The behavior in Org buffers is unchanged. + +*** =ox-icalendar.el= line ending fix may affect downstream packages + +iCalendar export now uses dos-style CRLF ("\r\n") line endings +throughout, as required by the iCalendar specification (RFC 5545). +Previously, the export used an inconsistent mix of dos and unix line +endings. + +This might cause errors in external packages that parse output from +ox-icalendar. In particular, older versions of org-caldav may +encounter issues, and users are advised to update to the most recent +version of org-caldav. See [[https://github.com/dengste/org-caldav/commit/618bf4cdc9be140ca1993901d017b7f18297f1b8][this org-caldav commit]] for more information. + +*** Icalendar export of unscheduled TODOs no longer have start time of today + +For TODOs without a scheduled start time, ox-icalendar no longer +forces them to have a scheduled start time of today when exporting. + +Instead, the new customization ~org-icalendar-todo-unscheduled-start~ +controls the exported start date for unscheduled tasks. Its default +is ~recurring-deadline-warning~ which will export unscheduled tasks +with no start date, unless it has a recurring deadline (in which case +the iCalendar spec demands a start date, and +~org-deadline-warning-days~ is used for that). + +To revert to the old behavior, set +~org-icalendar-todo-unscheduled-start~ to ~current-datetime~. + +*** Built-in HTML, LaTeX, Man, Markdown, ODT, and Texinfo exporters preserve the link protocol during export + +Previously, some link types where not exported as =protocol:uri= but +as bare =uri=. This is now changed. + +When a link is known by Org mode and does not have a custom ~:export~ +parameter (see A.3 Adding Hyperlink Types section of the manual), the +link protocol is now not stripped. + +For example, if one adds a link type =tel=, but does not define +~:export~ parameter +: (org-link-set-parameters "tel") +=[[tel:12345][John Doe]]= link will be correctly exported to LaTeX as +=\href{tel:12345}{John Doe}=, not =\href{12345}{John Doe}=. + +However, links like =[[elisp:(+ 1 2)]]= will be exported as +=\url{elisp:(+ 1 2)}=, which may be somewhat unexpected. + +*** =ox-html=: When exporting footnotes with custom non-number names, the names are used as link anchors + +Previously, link anchors for footnote references and footnote +definitions were based on the footnote number: =fn.1=, =fnr.15=, etc. + +Now, when the footnote has a non-number name, it is used as an anchor: +=fn.name=, =fnr.name=. + +*** =ox-org= disables citation processors by default + +Previously, when exporting to Org, all the citations and +=print_bibliography= keywords, were transformed according to the +chosen citation processor. + +This is no loner the case. All the citation-related markup is now +exported as is. + +The previous behavior can be reverted by setting new custom option +~org-org-with-cite-processors~. + +*** ODT export no longer opens the exported file in the background + +ODT exporter used to open the exported file in ~archive-mode~ "for +examination". This was not documented, was done in the background, +and is not consistent with all other export backends. Now, this +feature is removed. + +*** Inline image width value in =#+attr_org= is preferred over other =#+attr_...= keywords + +Previously, when ~org-image-actual-width~ is a list or nil, Org used the +first =#+attr_...= keyword containing =:width ...= to compute the inline +image width. Now, =#+attr_org=, if present, takes precedence. +In the following example the image preview has width of 75% +while earlier versions pick 33%. + +: #+attr_html: :width 33% +: #+attr_org: :width 0.75 +: [[image.png]] + +*** ~org-latex-to-mathml-convert-command~ and ~org-latex-to-html-convert-command~ may need to be adjusted + +Previously, =%i= placeholders in the +~org-latex-to-mathml-convert-command~ and +~org-latex-to-html-convert-command~ user options were replaced with +raw LaTeX fragment text, potentially triggering shell-expansion and +incorrect result. + +Now, the =%i= placeholders are shell-escaped to prevent shell +expansion. + +If you have single or double quotes around =%i= then update +customizations and remove quotes. + +*** ~org-insert-subheading~ no longer inserts a sub-heading above current when point is at the beginning of line + +Previously, calling ~org-insert-subheading~ on + +: * Heading 1 +: * Heading 2 + +yielded + +: * Heading 1 +: ** +: * Heading 2 + +This is no longer the case. The sub-heading is always created below +current heading (prefix arguments have the same meaning as in +~org-insert-heading~): + +: * Heading 1 +: * Heading 2 +: ** + +*** It is no longer allowed to tangle into the same file as Org source + +Previously, =file.org= with the following contents + +: #+begin_src org :tangle file.org +: Text +: #+end_src + +would overwrite itself. + +Now, an error is thrown. + +** New features + +# We list the most important features, and the features that may +# require user action to be used. + +*** Images and files in clipboard can be pasted + +Org asks the user what must be done when pasting images and files +copied to the clipboard from a file manager using the ~yank-media~ +command. The default action can be set by customizing +~org-yank-dnd-method~. The ~yank-media~ command was added in Emacs 29. + +Images can be saved to a separate directory instead of being attached, +customize ~org-yank-image-save-method~. + +Image filename chosen can be customized by setting +~org-yank-image-file-name-function~ which by default autogenerates a +filename based on the current time. + +*** Files and images can be attached by dropping onto Emacs + +By default, Org asks the user what to do with the dropped file like +for pasted files. The same user option ~org-yank-dnd-method~ is +respected. + +Images dropped also respect the value of ~org-yank-image-save-method~ +when ~org-yank-dnd-method~ is =attach=. + +*** =id:= links support search options; ~org-id-store-link~ adds search option by default + +Adding search option by ~org-id-store-link~ can be disabled by setting +~org-id-link-use-context~ to ~nil~, or toggled for a single call by +passing universal argument. + +When using this feature, IDs should not include =::=, which is used in +links to indicate the start of the search string. For backwards +compability, existing IDs including =::= will still be matched (but +cannot be used together with search option). A new org-lint checker +has been added to warn about this. + +*** Org mode no longer disallows configuring ~display-buffer-alist~ to open Org popups in other frame + +Previously, Org mode disallowed pop-up frames when displaying dispatch buffers. +This is no longer the case. ~display-buffer-alist~ is fully obeyed. + +~org-switch-to-buffer-other-window~ and ~org-no-popups~ are now deprecated. + +*** Asynchronous code evaluatation in ~ob-shell~ + +Running shell blocks with the ~:session~ header freezes Emacs until +execution completes. The new ~:async~ header allows users to continue +editing with Emacs while a ~:session~ block executes. + +*** Add support for repeating tasks in iCalendar export + +Repeating Scheduled and Deadline timestamps in TODOs are now exported +as recurring tasks in iCalendar export. + +In case the TODO has just a single planning timestamp (Scheduled or +Deadline, but not both), its repeater is used as the iCalendar +recurrence rule (RRULE). + +If the TODO has both Scheduled and Deadline planning timestamps, then +the following cases are implemented: + +- If both have the same repeater, then it is used as the RRULE. +- Scheduled has repeater but Deadline does not: the Scheduled repeater + is used as RRULE, and Deadline is used as UNTIL (the end date for + the repeater). This is similar to ~repeated-after-deadline~ in + ~org-agenda-skip-scheduled-if-deadline-is-shown~. + +The following 2 cases are not yet implemented, and the repeater is +skipped (with a warning) if the ox-icalendar export encounters them: + +- Deadline has a repeater but Scheduled does not. +- Scheduled and Deadline have different repeaters. + +Also note that only vanilla repeaters are currently exported; the +special repeaters ~++~ and ~.+~ are skipped. + +*** Babel references =FILE:REFERENCE= now search current buffer when =FILE= does not exist + +When =FILE= does not exist, the reference is searched in the current +file, using the verbatim reference. This way, +=:var table=tbl:example= will be searched inside the current buffer. + +*** Folded lines can now extend their face beyond ellipsis + +Previously, ~:extend t~ face attribute did not make folded headlines, +blocks, and drawers extend their face beyond end of line. + +Now, the ellipsis and trailing newline use the same face as the last +character before the fold. + +*** iCalendar export now supports multiline =SUMMARY=, =LOCATION=, and =DESCRIPTION= properties + +Previously, it was not possible to specify multi-line location, +summary, or description when exporting to iCalendar. + +In the following example, =LOCATION= was exported as "Someplace", +ignoring the other lines. + +#+begin_src org +,* heading with multi-line property +:PROPERTIES: +:LOCATION: Someplace +:LOCATION+: Some Street 5 +:LOCATION+: 12345 Small Town +:END: +#+end_src + +Now, =SUMMARY+=, =LOCATION+=, and =DESCRIPTION+= properties can be +used to create multi-line values. + +In the above example, =LOCATION= is now exported as + +: Someplace +: Some Street 5 +: 12345 Small Town + +*** Org export backends can now disable citation processors + +A new global export option ~:with-cite-processors~, when set to nil, +disables citation processors completely. This option is available to +export backends via ~:options-alist~ when defining the backend. + +The backends disabling citation processors must take care about +exporting citation objects and =print_bibliography= keywords via +transcoders. + +Users can disable citations processors by customizing new +~org-export-process-citations~ option. + +*** Org babel backends are now expected to define an additional API function ~org-babel-session-buffer:~ + +Org babel now uses session buffer (if it exists) to retrieve +~default-directory~ environment during src block evaluation. + +By default, buffer named like session is checked. All the backends +that create sessions inside buffers named differently should provide a +function ~org-babel-session-buffer:~. The function must accept +two arguments - session name and info list (as returned by +~org-babel-get-src-block-info~); and return the session buffer name. + +*** ~org-paste-subtree~ now handles =C-u= and =C-u C-u= prefix arguments specially + +With =C-u= prefix argument, force inserting a sibling heading below. +With =C-u C-u= prefix argument, force inserting a child heading. + +*** ~org-metaup~ and ~org-metadown~ now act on headings in region + +When region is active and starts at a heading, ~org-metaup~ and +~org-metadown~ will move all the selected subtrees. + +*** Many structure editing commands now do not deactivate region + +Moving, promoting, and demoting of headings and items in region now do +not deactivate Transient mark mode. + +Users can thus conveniently select multiple headings/items and use, +for example, =M-=/=M-= repeatedly without losing the +selection. + +*** Capture templates now support ~(here)~ as a target + +A capture template can target ~(here)~ which is the equivalent of +invoking a capture template with a zero prefix. + +*** =colview= dynamic block supports custom formatting function + +The =colview= dynamic block understands a new ~:formatter~ parameter, +which specifies a user-supplied function to format and insert the data +in the dynamic block. + +A global default formatting function for =colview= dynamic blocks can +be set via the new option ~org-columns-dblock-formatter~ which +defaults to the new function ~org-columns-dblock-write-default~, that +implements the previous (fixed) formatting behaviour. Hence, the +default behaviour is identical to previous versions. + +The global default function can be overridden for any given =colview= +dynamic block individually by specifying a custom formatter function +using the new ~:formatter~ parameter on the block's =BEGIN= line. + +This new feature replicates the ~:formatter~ option already available +for =clocktable= dynamic blocks. + +*** =colview= dynamic block can link to headlines + +The =colview= dynamic block understands a new ~:link~ parameter, which +when non-~nil~ causes =ITEM= headlines in the table to be linked to +their origins. + +*** =ob-tangle.el=: New flag to remove tangle targets before writing + +When ~org-babel-tangle-remove-file-before-write~ is set to ~t~ the +tangle target is removed before writing. This will allow overwriting +read-only tangle targets. However, when tangle target is a symlink, +this will convert the tangle target into an ordinary file. + +The default value is ~auto~ -- overwrite tangle targets when they are +read-only. + +*** ~org-bibtex-yank~ accepts a prefix argument + +When called with a prefix argument, ~org-bibtex-yank~ adds data to the +headline of the entry at point instead of creating a new one. + +*** =ob-plantuml.el=: Support tikz file format output + +=ob-plantuml.el= now output =tikz= :file format via +=-tlatex:nopreamble= option. So that the output tikz file can be an +input into the exported latex correctly. + +For example, exporting the following to LaTeX + +#+begin_src plantuml :file test.tikz :exports results +Bob -> Alice : Hello World! +#+end_src + +will include the generated =.tikz= into the exported LaTeX source. + +*** =UNNUMBERED= property inheritance is now honored by ~org-num-mode~ + +When ~org-num-skip-unnumbered~ is non-nil, ~org-num-mode~ now honors +~org-use-property-inheritance~ for =UNNUMBERED= property (see manual +section "Property Inheritance"). Previously, only local =UNNUMBERED= +property was taken into account. + +Users can add ="UNNUMBERED"= to ~org-use-property-inheritance~ and set +~org-numb-skip-unnumbered~ to ~t~ to make ~org-num-mode~ skip +numbering of all the sub-headings with non-nil =UNNUMBERED= property. + +*** ~org-insert-todo-heading-respect-content~ now accepts prefix arguments + +The prefix arguments are passed to ~org-insert-todo-heading~. + +*** Make ~ob-sqlite~ use in-memory databases by default + +~sqlite~ source blocks with no ~:db~ header argument now make SQLite +use a temporary in-memory database instead of throwing an error, +matching the behavior of the official ~sqlite3~ shell. As a result, +~sqlite~ source blocks are now usable out of the box, that is with no +header arguments. + +*** ~org-return~ now acts on citations at point + +When ~org-return-follows-link~ is non-nil and cursor is over an +org-cite citation, ~org-return~ will call ~org-open-at-point~. + +*** ~org-tags-view~ supports more property operators + +It supports inequality operators ~!=~ and ~/=~ in addition to the less +common (BASIC? Pascal? SQL?) ~<>~. And it supports starred versions +of all relational operators (~<*~, ~=*~, ~!=*~, etc.) that work like +the regular, unstarred operators but match a headline only if the +tested property is actually present. + +*** =ob-python.el=: Support for more result types and plotting + +=ob-python= now converts the following objects to org-mode tables when +":results table" header arg is set: + +- Dictionaries +- Numpy arrays +- Pandas DataFrames +- Pandas Series + +When the header argument =:results graphics= is set, =ob-python= will +use matplotlib to save graphics. The behavior depends on whether value +or output results are used. For value results, the last line should +return a matplotlib Figure object to plot. For output results, the +current figure (as returned by =pyplot.gcf()=) is cleared before +evaluation, and then plotted afterwards. + +*** =ob-maxima.el=: Support for ~batch~ and ~draw~ + +=ob-maxima= has two new header arguments: ~:batch~ and +~:graphics-pkg~. + +The ~:batch~ header argument can be set to one of Maxima's file +loaders (~batch~, ~load~ or ~batchload~); the default remains +~batchload~. The ~:graphics-pkg~ header argument can be set to one of +Maxima's graphics packages (~draw~ or ~plot~); the default remains +~plot~. The graphics terminal is now determined from the file-ending +of the file-name set in the ~:file~ header argument. + +*** =ob-calc.el=: Support for tables in ~:var~ + +=ob-calc= now supports tables in ~:var~. They are converted to a +matrix or a vector depending on the dimensionality of the table. A +table with a single row is converted to a vector, the rest are +converted to a matrix. + +*** ox-texinfo always generates a ~@direntry~ + +We use defaults based on the file name and title of the document, and +place the entry in the ~Misc~ category if ~TEXINFO_DIR_CATEGORY~ is missing. + +=TEXINFO_DIR_TITLE= is renamed to =TEXINFO_DIR_NAME=. +The old name is obsolete. + +** New and changed options + +# Chanes deadling with changing default values of customizations, +# adding new customizations, or changing the interpretation of the +# existing customizations. + +*** Org mode faces are now consistently combined, with markup faces taking precedence over the containing element faces + +Previously, fontification of inline source blocks, macros, footnotes, +target links, timestamps, radio targets, targets, inline export +snippets, verbatim code, and COMMENT keyword in headings replaced the +containing element fontification. Now, this is changed - the inner +markup faces and the containing element faces are combined, with +"inner" faces taking precedence; just as for all other markup. + +*** Org mode now fontifies whole table lines (including newline) according to ~org-table~ face + +Previously, leading indentation and trailing newline in table rows +were not fontified using ~org-table~ face. ~default~ face was used instead. +This made it impossible to scale line height when ~org-table~ face has +smaller height than default (Emacs calculates line height using the tallest face). + +Now, new ~org-table-row~ face is used on the whole table row lines, +including indentation and the final newline. This face, by default, +inherits from ~org-table~ face. + +If the new behavior is not desired, ~org-table-row~ face can be +changed to inherit from ~default~ face. See "Customizing Faces" +section of Emacs manual or "Face Attribute Functions" section of Elisp +manual. + +~org-table~ takes precedence over ~org-table-row~ for the parts of +table rows without indentation and newline. + +*** ~org-auto-align-tags~ is now respected universally + +Previously, only a subset of Org editing commands respected +~org-auto-align-tags~ option. Now, it is no longer the case. All the +editing commands, including typing (~org-self-insert-command~) and +deletion respect the option. + +~org-auto-align-tags~ is still enabled by default. For users who +customized ~org-auto-align-tags~ to nil, ~org-edit-headline~, +~org-priority~, ~org-set-tags~, ~org-entry-put~, ~org-kill-line~, and +typing/deleting in headlines will no longer unconditionally auto-align +the tags. + +*** New export option ~org-export-expand-links~ + +The new option makes Org expand environment variables in link and INCLUDE paths. +The option is on by default. + +Users who do not want variable expansion can set +~org-export-expand-links~ variable to nil or provide +=expand-links:nil= in-file export option. + +*** New hook ~org-after-note-stored-hook~ + +This new hook runs when a note has been stored. + +*** New option controlling how Org mode sorts things ~org-sort-function~ + +Sorting of agenda items, tables, menus, headlines, etc can now be +controlled using a new custom option ~org-sort-function~. + +By default, Org mode sorts things according to the operation system +language. However, language sorting rules may or may not produce good +results depending on the use case. For example, multi-language +documents may be sorted weirdly when sorting rules for system language +are applied on the text written using different language. Also, some +operations systems (e.g. MacOS), do not provide accurate string +sorting rules. + +Org mode provides 3 possible values for ~org-sort-function~: +1. (default) Sort using system language rules. +2. Sort using string comparison (~compare-strings~), making use of UTF + case conversion. This may work better for mixed-language documents + and on MacOS. +3. Custom function, if the above does not fit the needs. + +*** =ob-latex= now uses a new option ~org-babel-latex-process-alist~ to generate png output + +Previously, =ob-latex= used ~org-preview-latex-default-process~ from +~org-preview-latex-process-alist~ to produce png output. Now, the +process settings are separated into a new dedicated option +~org-babel-latex-process-alist~. + +The default value is pulled from =dvipng= process type from +~org-preview-latex-process-alist~, preserving the existing behavior. +However, the output is now immune to changes in +~org-preview-latex-default-process~ and can be customized +independently of the image preview settings. + +*** New option ~org-babel-lua-multiple-values-separator~ + +The string that separates the values of multi-valued results returned +from Lua code blocks. + +*** =.avif= images are now recognized in ~org-html-inline-image-rules~ + +In =ox-html=, =.avif= image links are now inlined by default. + +*** New option ~org-beamer-frame-environment~ + +The new option defines name of an alternative environment to be used +for fragile beamer frames. This option is needed to work around +beamer bug with frame contents containing literal =\end{frame}= string +(for example, inside example blocks). See +https://github.com/josephwright/beamer/issues/360 + +The default value is =orgframe=. + +The option should normally not be changed, except when you need to put +=\end{orgframe}= string inside beamer frames. + +A checker has been added to =M-x org-lint= to detect instances of +~org-beamer-frame-environment~ in Org documents. + +*** New option ~org-export-process-citations~ + +The new option controls whether to use citation processors to process +citations. + +*** New option ~org-org-with-cite-processors~ + +The new option controls whether to use citation processors to process +citations when exporting to Org. + +*** New option ~org-org-with-special-rows~ + +The new options controls whether to export special table rows in +Org-Org (=ox-org=) export. The default value is ~t~. + +*** New option ~org-babel-comint-fallback-regexp-threshold~ + +Org babel is often using Emacs' interactive REPL feature to implement +:session functionality in code blocks. However, Emacs' REPLs use +heuristics to detect which lines in the REPL buffer correspond to +output and which lines are user prompts. + +Normally, Org babel changes the default prompt to something unique. It +avoids incorrect detection of code block output. + +Sometimes, the Org-configured prompt is changed manually by users or +when running a sub-REPL (for example, when running ssh/python +interpreter inside shell). + +The new option controls Org mode's heuristics for catching +user-changed prompt in interactive Org babel sessions. When Org mode +cannot find REPL's prompt for more than +~org-babel-comint-fallback-regexp-threshold~ seconds, imprecise +generic prompt is tried to detect whether the code block output has +arrived. + +Users who often work with altering REPL prompts may consider reducing +the default 5 second value of the new option. + +*** ~repeated-after-deadline~ value of ~org-agenda-skip-scheduled-if-deadline-is-shown~ is moved to a new customization + +A new custom option ~org-agenda-skip-scheduled-repeats-after-deadline~ +is introduced in place of ~repeated-after-deadline~ value of +~org-agenda-skip-scheduled-if-deadline-is-shown~. + +The following example would no longer show in the agenda as scheduled +after January 5th with the new customization set to ~t~. + +: * TODO Do me every day until Jan, 5th (inclusive) +: SCHEDULED: <2024-01-03 Wed +1d> DEADLINE: <2024-01-05 Fri> + +The old customization will continue to work, ensuring backwards compatibility. + +*** New custom setting ~org-icalendar-ttl~ for the ~ox-icalendar~ backend + +The option ~org-icalendar-ttl~ allows to advise a subscriber to the +exported =.ics= file to reload after the given time interval. + +This is useful i.e. if a calendar server subscribes to your exported +file and that file is updated regularly. + +See IETF RFC 5545, Section 3.3.6 Duration and +https://en.wikipedia.org/wiki/ICalendar#Other_component_types for +details. + +Default for ~org-icalendar-ttl~ is ~nil~. In that case the setting +will not be used in the exported ICS file. + +The option may also be set using the =ICAL-TTL= keyword. + +*** The default value of ~org-attach-store-link-p~ is now ~attached~ + +Now, after attaching a file, =[[attach:...]]= link to the attached file +is stored. It can later be inserted using =M-x org-insert-link=. + +*** ~org-link-descriptive~ can now be set per-buffer via =#+STARTUP= options + +In addition to ~org-link-descriptive~ custom option, link display can +now be controlled per-buffer as: + +: #+STARTUP: literallinks +: #+STARTUP: descriptivelinks + +*** New option ~org-fast-tag-selection-maximum-tags~ + +You can now limit the total number of tags displayed in the fast tag +selection interface. Useful in buffers with huge number of tags. + +*** New variable ~org-clock-out-removed-last-clock~ + +The variable is intended to be used by ~org-clock-out-hook~. It is a +flag used to signal when the =CLOCK= line has been removed. This can +happen when ~org-clock-out-remove-zero-time-clocks~ is customized to +be non-nil. + +*** ~org-info-other-documents~ is now a custom option + +Users can now extend the value of ~org-info-other-documents~ to +specify Urls to third-party (non-Emacs) online info nodes when +exporting =info:= links. + +*** ~org-export-smart-quotes-alist~ is now a custom option + +Previously, smart quotes rules for different languages where +hard-coded. Now, they can be customized by users. + +*** Commands affected by ~org-fold-catch-invisible-edits~ can now be customized + +New user option ~org-fold-catch-invisible-edits-commands~ controls +which commands trigger checking for invisible edits. + +The full list of affected commands is: +- ~org-self-insert-command~ +- ~org-delete-backward-char~ +- ~org-delete-char~ +- ~org-meta-return~ +- ~org-return~ (not checked in earlier Org versions) + +*** New customization ~org-image-max-width~ limiting the displayed inline image width + +New custom variable ~org-image-max-width~ limits the maximum inline +image width, but only when the inline image width is not explicitly +set via ~org-image-actual-width~, =ORG-IMAGE-ACTUAL-WIDTH= property, +or =#+ATTR*= keyword. + +By default, when ~org-image-actual-width~ is set to t, +~org-image-max-width~ takes effect. Its default value is set to +~fill-column~, limiting the image previews to ~fill-column~ number of +characters. + +To fall back to previous defaults, where the inline image width is not +constrained, set ~org-image-max-width~ to nil. + +*** ~org-src-block-faces~ now accepts empty string ~""~ as language name + +It is now possible to customize face of source blocks without language specifier. + +: #+begin_src +: Source block with no language +: #+end_src + +For example, to set ~highlight~ face, use + +#+begin_src emacs-lisp +(setq org-src-fontify-natively t) +(add-to-list 'org-src-block-faces '("" highlight)) +#+end_src + +*** New ~org-cite-natbib-export-bibliography~ option defining fallback bibliography style + +~natbib~ citation export processor now uses +~org-cite-natbib-export-bibliography~ (defaults to ~unsrtnat~) as a +fallback bibliography style if none is specified by user in +=#+cite_export:= keyword. + +Previously, export would fail without explicitly selected bibliography +style. + +*** New escape in ~org-beamer-environments-extra~ for labels in Beamer export +The escape =%l= in ~org-beamer-environments-extra~ inserts the label +obtained from ~org-beamer--get-label~. This is added to the default +environments =theorem=, =definition=, =example=, and =exampleblock= in +~org-beamer-environments-default~. + +*** ~org-clock-x11idle-program-name~ now defaults to =xprintidle=, when available + +When =xprintidle= executable is available at =org-clock= load time, it +is used as the default value for ~org-clock-x11idle-program-name~. +The old =x11idle= default is used as the fallback. + +=xprintidle= is available as system package in most Linux +distributions, unlike ancient =x11idle= that is distributed via WORG. + +*** New options for the "csl" citation export processor's LaTeX output + +The ~org-cite-csl-latex-label-separator~ and +~org-cite-csl-latex-label-width-per-char~ options allow the user to +control the indentation of entries for labeled bibliography styles +when the "csl" citation processor is used for LaTeX export. The +indentation length is computed as the sum of +~org-cite-csl-latex-label-separator~ and the maximal label width, for +example: + +#+begin_example + indentation length +<-------------------------> +max. label width separator +<---------------><--------> +[Doe22] John Doe. A title... +[DoeSmithJones19] John Doe, Jane Smith and... +[SmithDoe02] Jane Smith and John Doe... +#+end_example + +The maximal label width, in turn, is calculated as the product of +~org-cite-csl-latex-label-width-per-char~ and the maximal label length +measured in characters. + +The ~org-cite-csl-latex-preamble~ option makes it possible to +customize the entire LaTeX fragment that the "csl" citation processor +injects into the preamble. + +*** New ~org-latex-listings-src-omit-language~ option for LaTeX export + +The ~org-latex-listings-src-omit-language~ option allows omitting the +=language= parameter in the exported =lstlisting= environment. This +is necessary when the =listings= backend delegates listing generation +to another package like =fancyvrb= using the following setup in the +document header: + +#+BEGIN_src org +,#+LATEX_HEADER: \RequirePackage{fancyvrb} +,#+LATEX_HEADER: \DefineVerbatimEnvironment{verbatim}{Verbatim}{...whatever...} +,#+LATEX_HEADER: \DefineVerbatimEnvironment{lstlisting}{Verbatim}{...whatever...} +#+END_src + +*** New face: ~org-agenda-calendar-daterange~ +The face ~org-agenda-calendar-daterange~ is used to show entries with +a date range in the agenda. It inherits from the default face in +order to remain backward-compatible. + +*** New ~org-babel-clojurescript-backend~ option to choose ClojureScript backend + +Before, a ClojureScript source block used the same backend as Clojure, +configured in ~org-babel-clojure-backend~ and relied on an undocumented +~:target~ paramter. + +Now, there's ~org-babel-clojurescript-backend~ to determine the +backend used for evaluation of ClojureScript. + +*** Support for Clojure CLI in ~ob-clojure~ + +~ob-clojure~ now supports executing babel source blocks with the +official [[https://clojure.org/guides/deps_and_cli][Clojure CLI tools]]. +The command can be customized with ~ob-clojure-cli-command~. + +*** New customization options for ~org-export-dispatch~ + +New custom variables ~org-export-body-only~, +~org-export-visible-only~, and ~org-export-force-publishing~ allow the +default settings of "Body only", "Visible only", and "Force +publishing" in the ~org-export-dispatch~ UI to be customized, +respectively. + +*** New option ~org-icalendar-todo-unscheduled-start~ to control unscheduled TODOs in ox-icalendar + +~org-icalendar-todo-unscheduled-start~ controls how ox-icalendar +exports the starting datetime for unscheduled TODOs. Note this option +only has an effect when ~org-icalendar-include-todo~ is non-nil. + +By default, ox-icalendar will not export a start datetime for +unscheduled TODOs, except in cases where the iCalendar spec demands a +start (specifically, for recurring deadlines, in which case +~org-deadline-warning-days~ is used). + +Currently implemented options are: + +- ~recurring-deadline-warning~: The default as described above. +- ~deadline-warning~: Use ~org-deadline-warning-days~ to set the start + time if the unscheduled task has a deadline (recurring or not). +- ~current-datetime~: Revert to old behavior, using the current + datetime as the start of unscheduled tasks. +- ~nil~: Never add a start time for unscheduled tasks. For repeating + tasks this technically violates the iCalendar spec, but some + iCalendar programs support this usage. + +*** Capture template expansion now supports ID links + +The capture template expansion element =%K= creates links using +~org-store-link~, which respects the values of ~org-id-link-to-use-id~. + +*** Changes to ~org-babel-python-command~, and new session/nonsession specific options + +The default Python command used by interactive sessions has been +changed to match ~python-shell-interpreter~ and +~python-shell-interpreter-args~ by default. The default Python +command for nonsessions has not changed. + +New options ~org-babel-python-command-nonsession~ and +~org-babel-python-command-session~ control the default Python command +for nonsessions and sessions, respectively. By default, +~org-babel-python-command-session~ is ~auto~, which means to use the +configuration for ~python-shell-interpreter(-args)~ as default. + +The old option ~org-babel-python-command~ has been changed to have +default value of ~auto~. When not ~auto~, it overrides both +~org-babel-python-command-nonsession~ and +~org-babel-python-command-session~. Therefore, users who had +previously set ~org-babel-python-command~ will not experience any +changes. + +Likewise, users who had neither set ~org-babel-python-command~ nor +~python-shell-interpreter(-args)~ will not see any changes -- ~python~ +remains the default command. + +The main change will be for users who did not configure +~org-babel-python-command~, but did configure +~python-shell-interpreter~, e.g. to use IPython. In this case, +~ob-python~ will now start interactive sessions in a more consistent +manner with ~run-python~. + +*** New hook option ~org-indent-post-buffer-init-functions~ + +This allows to run functions after ~org-indent~ intializes a buffer to +enrich its properties. +*** New option ~org-agenda-start-with-archives-mode~ + +This option starts the agenda to automatically include archives, +propagating the value for this variable to ~org-agenda-archives-mode~. +For acceptable values and their meaning, see the value of that variable. + +*** New option ~org-id-link-consider-parent-id~ to allow =id:= links to parent headlines + +For =id:= links, when this option is enabled, ~org-store-link~ will +look for ids from parent/ancestor headlines, if the current headline +does not have an id. + +Combined with the new ability for =id:= links to use search options + [fn:: when =org-id-link-use-context= is =t=, which is the default], +this allows linking to specific headlines without requiring every +headline to have an id property, as long as the headline is unique +within a subtree that does have an id property. + +For example, given this org file: + +#+begin_src org +,* Parent +:PROPERTIES: +:ID: abc +:END: +,** Child 1 +,** Child 2 +#+end_src + +Storing a link with point at "Child 1" will produce a link +==, which precisely links to the "Child 1" headline +even though it does not have its own ID. By giving files top-level id +properties, links to headlines in the file can also be made more +robust by using the file id instead of the file path. + +*** New option ~latex-default-footnote-command~ to customize the LaTeX footnote command + +This new option allows you to define the LaTeX command the Org mode +footnotes are converted to (for example ~\sidenote{%s%s}~ instead of +the default ~\footnote{%s%s}~). + +The option can be customized either by + +1. setting the global variable in the ~org-export-latex~ customization + group or +2. by setting the file local keyword =LATEX_FOOTNOTE_COMMAND= + +*** Options for ~#+cite_export: biblatex~ can use the package's option syntax + +When using =biblatex= to export bibliographies, you can use the format +as specified in the =biblatex= package documentation as +=key=val,key=val,...= + +*** New option ~org-columns-dblock-formatter~ + +=colview= dynamic blocks now understand a new ~:formatter~ parameter +to use a specific function for formatting and inserting the contents +of the dynamic block. This new option can be used to set the global +default formatting function that will be used for =colview= dynamic +blocks that do not specify any ~:formatter~ parameter. Its default +value (the new function ~org-columns-dblock-write-default~) yields the +previous (fixed) formatting behaviour. + +*** New allowed value of ~org-md-headline-style~ to mix ATX and Setext style headlines + +Setting ~org-md-headline-style~ to ~'mixed~ will export headline +levels one and two as Setext style headlines, and headline levels +three through six will be exported as ATX style headlines. + +*** ~org-footnote-new~ can be configured to create anonymous footnotes + +When ~org-footnote-auto-label~ is set to ~'anonymous~, create +anonymous footnotes automatically with ~org-footnote-new~. + +The same can be done via startup options: +: #+STARTUP: fnanon + +*** New final hooks for Modifier-Cursor keys + +Final hooks are added to the following commands: +- ~org-metaleft-final-hook~ to ~org-metaleft~ (bound to =M-=). +- ~org-metaright-final-hook~ to ~org-metaright~ (bound to + =M-=). +- ~org-metaup-final-hook~ to ~org-metaup~ (bound to =M-=). +- ~org-metadown-final-hook~ to ~org-metadown~ (bound to =M-=). +- ~org-shiftmetaleft-final-hook~ to ~org-shiftmetaleft~ (bound to + =M-S-=). +- ~org-shiftmetaright-final-hook~ to ~org-shiftmetaright~ (bound to + =M-S-=). +- ~org-shiftmetaup-final-hook~ to ~org-shiftmetaup~ (bound to + =M-S-=). +- ~org-shiftmetadown-final-hook~ to ~org-shiftmetadown~ (bound to + =M-S-=). + +** Major changes and additions to Org element API and Org syntax +*** Diary type timestamps now support optional time/timerange + +Previously, diary type timestamps could not specify time. +Now, it is allowed to add a time or time range: + +: <%%(diary-float t 4 2) 22:00-23:00> +: <%%(diary-float t 4 2) 10:30> + +The parsed representation of such timestamps will have ~:hour-start~, +~:minute-start~, ~:hour-end~, ~:minute-end~, and ~:range-type~ +properties set appropriately. In addition, a new ~:diary-sexp~ +property will store the diary sexp value. + +For example, + +: <%%(diary-float t 4 2) 22:00-23:00> + +will have the following properties + +#+begin_src emacs-lisp +:type: diary +:range-type: timerange +:raw-value: "<%%(diary-float t 4 2) 22:00-23:00>" +:year-start: nil +:month-start: nil +:day-start: nil +:hour-start: 22 +:minute-start: 0 +:year-end: nil +:month-end: nil +:day-end: nil +:hour-end: 23 +:minute-end: 0 +:diary-sexp: "(diary-float t 4 2)" +#+end_src + +*** Underline syntax now takes priority over subscript when both are applicable + +Previously, Org mode interpreted =(_text_)= as subscript. +Now, the interpretation is changed to underline. + +=(_text_)= matches both subscript and underline markup. The +interpretation is changed to keep consistency with other emphasis like +=(*bold*)=. + +Most of the users should not be affected by this change - it only applies when character immediately preceding =_= is one of =-=, =(=, ='=, and ={=. + +*** New term: "syntax node" + +To reduce confusion with "element" referring to both "syntax element" +and "element/object" class, we now prefer using "syntax node" when +referring to generic Org syntax elements. "Elements" and "objects" +now refer to different syntax node classes of paragraph-like nodes and +markup-like nodes. + +*** New element type ~anonymous~ + +Secondary strings can now be recognized as ~anonymous~ type to +distinguish from non-elements. With a new optional argument, +~org-element-type~ will return ~anonymous~ for secondary strings +instead of nil. + +The new element type can be used in ~org-element-lineage~, +~org-element-map~, and other functions that filter by element type. + +*** Internal structure of Org parse tree has been changed + +The code relying upon the previously used =(TYPE PROPERTIES-PLIST CONTENTS-LIST)= +structure may no longer work. Please use ~org-element-create~, +~org-element-property~, and other Org element API functions to work +with Org syntax trees. + +Some syntax node properties are no longer stored as property list elements. +Instead, they are kept in a special vector value of a new +=:standard-properties= property. This is done to improve performance. + +If there is a need to traverse all the node properties, a new API +function ~org-element-properties-map~ can be used. + +Properties and their values can now be deferred to avoid overheads +when parsing. They are calculated lazily, when the value/property is +requested by ~org-element-property~ and other getter functions. Using +~plist-get~ to retrieve values of =PROPERTIES-PLIST= is not +recommended as deferred properties will not be resolved in such +scenario. + +New special property =:secondary= is used internally to record which +properties store secondary objects. + +New special property =:deferred= is used to keep information how to +calculate property names lazily. + +See the commentary in =lisp/org-element-ast.el= for more details. + +*** Multiple affiliated keyword values are now stored in the order they appear in buffer + +Previously, + +: #+caption: foo +: #+caption: bar +: Paragraph + +would have its =:caption= property set to ~(("bar") ("foo"))~ in reverse order. + +Now, the order is not reversed: ~(("foo") ("bar"))~. + +*** Some property values may now be calculated lazily and require original Org buffer to be live + +~org-element-at-point~, ~org-element-context~, and +~org-element-at-point-no-context~ may now not calculate all the +property values at the call time. Instead, the calculation will be +deferred until ~org-element-property~ or the equivalent getter +function is called. The property names may not all be calculated as +well. + +It may often be necessary to have the original Org buffer open when +resolving the deferred values. + +One can ensure that all the deferred values are resolved using new +function ~org-element-resolve-deferred~ and new optional argument for +~org-element-property~. + +~org-element-parse-buffer~ and ~org-element-parse-secondary-string~ +will resolve all the deferred values by default. No adjustment is +needed for their users. + +*** New API functions and macros +**** New property accessors and setters + +New functions to retrieve and set (via ~setf~) commonly used element properties: +- =:begin= :: ~org-element-begin~ +- =:end= :: ~org-element-end~ +- =:contents-begin= :: ~org-element-contents-begin~ +- =:contents-end= :: ~org-element-contents-end~ +- =:post-affiliated= :: ~org-element-post-affiliated~ +- =:post-blank= :: ~org-element-post-blank~ +- =:parent= :: ~org-element-parent~ + +**** New macro ~org-element-with-enabled-cache~ + +The macro arranges the element cache to be active during =BODY= execution. +When cache is enabled, the macro is identical to ~progn~. When cache +is disabled, the macro arranges a new fresh cache that is discarded +upon completion of =BODY=. + +**** New function ~org-element-property-raw~ + +This function is like ~org-element-property~ but does not try to +resolve deferred properties. + +~org-element-property-raw~ can be used with ~setf~. + +**** New function ~org-element-put-property-2~ + +Like ~org-element-put-property~, but the argument list is changed to have +=NODE= as the last argument. Useful with threading macros like +~thread-last~. + +**** New function ~org-element-properties-resolve~ + +This function resolves all the deferred values in a =NODE=, modifying +the =NODE= for side effect. + +**** New functions ~org-element-properties-map~ and ~org-element-properties-mapc~ + +New functions to map over =NODE= properties. + +**** New function ~org-element-ast-map~ + +This is a more general equivalent of ~org-element-map~. It allows +more precise control over recursion into secondary strings. + +**** New function ~org-element-lineage-map~ + +Traverse syntax tree ancestor list, applying arbitrary function to +each ancestor. + +**** New function ~org-element-property-inherited~ + +Like ~org-element-property~, but can be used to retrieve and combine +multiple different properties for a given =NODE= and its parents. + +*** ~org-element-cache-map~ can now be used even when element cache is disabled + +*** =org-element= API functions and macros can now accept syntax nodes as =POM= argument + +The following functions are updated: +- ~org-agenda-entry-get-agenda-timestamp~ +- ~org-element-at-point~ +- ~org-is-habit-p~ +- ~org-id-get~ +- ~org-with-point-at~ +- ~org-entry-properties~ +- ~org-entry-get~ +- ~org-entry-delete~ +- ~org-entry-add-to-multivalued-property~ +- ~org-entry-remove-from-multivalued-property~ +- ~org-entry-member-in-multivalued-property~ +- ~org-entry-put-multivalued-property~ +- ~org-entry-get-with-inheritance~ +- ~org-entry-put~ +- ~org-read-property-value~ +- ~org-property-get-allowed-values~ + +*** ~org-element-map~ now traverses main value in dual keywords before the secondary value + +The traverse order for dual keywords is reversed. The main value is +now traversed first, followed by the secondary value. + +*** Org parse tree is now non-printable + +Org parser now assigns a new property =:buffer= that holds +non-printable buffer object. This makes syntax tree non-printable. +Using ~print~/~read~ is no longer safe. + +*** Some Org API functions no longer preserve match data + +~org-element-at-point~, ~org-element-context~, ~org-get-category~, and +~org-get-tags~ may modify the match data. + +The relevant function docstrings now explicitly mention that match +data may be modified. + +*** ~org-element-create~ now treats a single ~anonymous~ =CHILDREN= argument as a list of child nodes + +When =CHILDREN= is a single anonymous node, use its contents as children +nodes. This way, + +: (org-element-create 'section nil (org-element-contents node)) + +will yield expected results with contents of another node adopted into +a newly created one. + +Previously, one had to use + +: (apply #'org-element-create 'section nil (org-element-contents node)) +*** New property ~:range-type~ for org-element timestamp object + +~org-element-timestamp-parser~ now adds =:range-type= property to each +timestamp object. Possible values: ~timerange~, ~daterange~, ~nil~. + +~org-element-timestamp-interpreter~ takes into account this property +and returns an appropriate timestamp string. + +*** New properties =:repeater-deadline-value= and =:repeater-deadline-unit= for org-element timestamp object + +~org-element-timestamp-parser~ now adds =:repeater-deadline-value= and +=:repeater-deadline-unit= properties to each timestamp object that has +a repeater deadline. For example, in =<2012-03-29 Thu ++1y/2y>=, =2y= +is the repeater deadline with a value of =2= and unit of =y=. See +"5.3.3 Tracking your habits" section in the manual. + +Possible values for =:repeater-deadline-value=: ~positive integer~, ~nil~. + +Possible values for =:repeater-deadline-unit=: ~hour~, ~day~, ~week~, +~month~, ~year~. + +~org-element-timestamp-interpreter~ takes into account these properties +and returns an appropriate timestamp string. + +*** =org-link= store functions are passed an ~interactive?~ argument + +The ~:store:~ functions set for link types using +~org-link-set-parameters~ are now passed an ~interactive?~ argument, +indicating whether ~org-store-link~ was called interactively. + +Existing store functions will continue to work. + +** New functions and changes in function arguments + +# This also includes changes in function behavior from Elisp perspective. + +*** ~org-babel-lilypond-compile-lilyfile~ ignores optional second argument + +The =TEST= parameter is better served by Emacs debugging tools. + +*** ~org-print-speed-command~ is now an internal function + +The old name is marked obsolete and the new name is +~org--print-speed-command~. + +This function was always aimed for internal use when building speed +command help buffer. Now, it is stated explicitly. + +*** When ~org-link-file-path-type~ is a function, its argument is now a filename as it is read by ~org-insert-link~; not an absolute path + +Previously, when ~org-link-file-path-type~ is set to a function, the +function argument was the filename from the link expanded via +~expand-file-name~. Now, a bare filename is passed to the function. + +*** ~org-create-file-search-functions~ can use ~org-list-store-props~ to suggest link description + +In Org <9.0, ~org-create-file-search-functions~ could set ~description~ +variable to suggest link description for the stored link. However, +this feature stopped working since Org 9.0 switched to lexical binding. + +Now, it is again possible for ~org-create-file-search-functions~ to +supply link descriptions using ~(org-list-store-props :description +"suggested description")~ in the search function body. + +*** New API functions to store data within ~org-element-cache~ + +Elisp programs can now store data inside Org element cache. + +The data will remain stored as long as the Org buffer text associated +with the cached elements remains unchanged. + +Two options are available: + - Store the data until any text within element boundaries is changed + - Store the data, but ignore any changes inside element contents that + do not affect the high-level element structure. For example, + changes inside subheadings can be ignored for the data stored + inside parent heading element. + +The new functions are: ~org-element-cache-store-key~ and +~org-element-cache-get-key~. + +*** New optional argument =UPDATE-HEADING= for ~org-bibtex-yank~ + +When the new argument is non-nil, add data to the headline of the +entry at point. + +*** ~org-fold-hide-drawer-all~ is now interactive + +~org-fold-hide-drawer-all~ is now a command, accepting two optional +arguments - region to act on. + +*** =TYPES= argument in ~org-element-lineage~ can now be a symbol + +When =TYPES= is symbol, only check syntax nodes of that type. + +*** New optional argument =KEEP-CONTENTS= for ~org-element-copy~ + +With the new argument, the contents is copied recursively. + +*** ~org-element-property~ can now be used with ~setf~ + +*** New optional arguments for ~org-element-property~ + +The value of the new optional argument =DFLT= is returned if the +property with given name is not present. Same as =DEFAULT= argument +for ~alist-get~. + +New optional argument =FORCE-UNDEFER= modifies the =NODE=, storing the +resolved deferred values. + +See the top comment in =lisp/org-element-ast.el= for more details +about the deferred values. + +*** New optional argument =NO-UNDEFER= in ~org-element-map~ and changed argument conventions + +New optional argument =NO-UNDEFER=, when non-nil, will make +~org-element-map~ keep deferred secondary string values in their raw +form. See the top comment in =lisp/org-element-ast.el= for more +details about the deferred values. + +=TYPES= argument can now be set to ~t~. This will match all the +syntax nodes when traversing the tree. + +~FUN~ can now be a lisp form that will be evaluated with symbol ~node~ +assigned to the current syntax node. + +~FUN~ can now throw ~:org-element-skip~ signal to skip recursing into +current element children and secondary strings. + +*** New optional argument =KEEP-DEFERRED= in ~org-element-parse-buffer~ + +When non-nil, the deferred values and properties will not be resolved. +See the top comment in =lisp/org-element-ast.el= for more details +about the deferred values. + +*** New optional argument =ANONYMOUS= for ~org-element-type~ + +When the new argument is non-nil, return symbol ~anonymous~ for anonymous elements. +Previously, ~nil~ would be returned. + +*** ~org-element-adopt-elements~ is renamed to ~org-element-adopt~ + +The old name is kept as an alias. The new name creates less confusion +as the function can also act on objects. + +*** ~org-element-extract-element~ is renamed to ~org-element-extract~ + +The old name is kept as an alias. The new name creates less confusion +as the function can also act on objects. + +*** ~org-element-set-element~ is renamed to ~org-element-set~ + +The old name is kept as an alias. The new name creates less confusion +as the function can also act on objects. + +*** ~org-export-get-parent~ is renamed to ~org-element-parent~ and moved to =lisp/org-element.el= + +*** ~org-export-get-parent-element~ is renamed to ~org-element-parent-element~ and moved to =lisp/org-element.el= + +*** ~org-insert-heading~ optional argument =TOP= is now =LEVEL= + +A numeric value forces a heading at that level to be inserted. For +backwards compatibility, non-numeric non-nil values insert level 1 +headings as before. + +*** New optional argument for ~org-id-get~ + +New optional argument =INHERIT= means inherited ID properties from +parent entries are considered when getting an entry's ID (see +~org-id-link-consider-parent-id~ option). + +*** New optional argument for ~org-link-search~ + +If a missing heading is created to match the search string, the new +optional argument =NEW-HEADING-CONTAINER= specifies where in the +buffer it will be added. If not specified, new headings are created +at level 1 at the end of the accessible part of the buffer, as before. + +** Miscellaneous +*** Add completion for links to man pages + +Completion is enabled for links to man pages added using ~org-insert-link~: +=C-c C-l man RET emacscl TAB= to get =emacsclient=. Of course, the ~ol-man~ +library should be loaded first. + +*** Datetree structure headlines can now be complex + +TODO state, priority, tags, statistics cookies, and COMMENT keywords +are allowed in the tree structure. + +*** Org links now support ~thing-at-point~ + +You can now retrieve the destination of a link by calling +~(thing-at-point 'url)~. Requires Emacs 28 or newer. + +In Emacs 30 or newer, ~forward-thing~ and ~bounds-of-thing-at-point~ +is also supported for links. + +*** Add support for ~logind~ idle time in ~org-user-idle-seconds~ + +When Emacs is built with =dbus= support and +the =org.freedesktop.login1= interface is available, fallback to +checking the =IdleSinceHint= property when +determining =org-user-idle-seconds= as the penultimate step. + +*** =colview= dynamic block now writes column width specifications + +When column format contains width specifications, =colview= dynamic +block now writes these specifications as column width in the generated +tables and automatically shrinks the columns on display. + +Example: + +: * PROYECTO EMACS +: :PROPERTIES: +: :COLUMNS: %10ITEM(PROJECT) +: :END: +: +: Before +: +: #+BEGIN: columnview :id local +: | PROJECT | +: |----------------| +: | PROYECTO EMACS | +: #+END: +: +: After +: +: #+BEGIN: columnview :id local +: | <10> | +: | PROJECT | +: |----------------| +: | PROYECTO EMACS | +: #+END: + +*** =ob-lua=: Support all types and multiple values in results + +Lua code blocks can now return values of any type and can also return +multiple values. Previously, values of certain types were incorrectly +converted to the empty string =""=, which broke HTML export for inline +code blocks, and multiple values were incorrectly concatenated, where +~return 1, 2, 3~ was evaluated as =123=. + +Multiple values are comma-separated by default, so that they work well +with inline code blocks. To change the string used as the separator, +customize ~org-babel-lua-multiple-values-separator~. + +*** ~org-store-link~ now moves an already stored link to front of the ~org-stored-links~ + +Previously, when the link to be stored were stored already, +~org-store-link~ displayed a message and did nothing. + +Now, ~org-store-link~ moves the stored link to front of the list of +stored links. This way, the link will show up first in the completion +and when inserting all the stored links with ~org-insert-all-links~. + +*** ob-python now sets ~python-shell-buffer-name~ in Org edit buffers + +When editing a Python src block, the editing buffer is now associated +with the Python shell specified by the src block's ~:session~ header, +which means users can now send code directly from the edit buffer, +e.g., using ~C-c C-c~, to the session specified in the Org buffer. + +*** ~org-edit-special~ no longer force-starts session in R and Julia source blocks + +Previously, when R/Julia source block had =:session= header argument +set to a session name with "earmuffs" (like =*session-name*=), +~org-edit-special~ always started a session, if it does not exist. + +Now, ~org-edit-special~ arranges that a new session with correct name +is initiated only when user explicitly executes R/Julia-mode commands +that trigger session interactions (requires ESS 24.01.0 or newer). +The same session will remain available in the context of Org babel. + +*** ~org-store-link~ behaviour storing additional =CUSTOM_ID= links has changed + +Previously, when storing =id:= link, ~org-store-link~ stored an +additional "human readable" link using a node's =CUSTOM_ID= property. + +This behaviour has been expanded to store an additional =CUSTOM_ID= +link when storing any type of external link type in an Org file, not +just =id:= links. + +*** =org-habit.el= now optionally inherits ~:STYLE: habit~ properties + +Currently, the ~STYLE~ property of habits is not inherited when searching +for entries. + +This change allows the property to be inherited optionally by customizing +the ~org-use-property-inheritance~ variable. + +This change aims to provide more flexibility in managing habits, allowing +users to dedicate separate subtrees or files to habits without manually +setting the ~STYLE~ property for each sub-task. + +The change is breaking when ~org-use-property-inheritance~ is set to ~t~. + +*** =ox-org= preserves header arguments in src blocks + +Previously, all the header arguments where stripped from src blocks +during export. Now, header arguments are preserved. + +*** =ox-org= now exports special table rows by default + +Previously, when exporting to Org, special table rows (for example, +width cookies) were not exported. Now, they are exported by default. + +You can customize new option ~org-org-with-special-rows~ to fall back to previous behavior. + +*** ~org-agenda-search-headline-for-time~ now ignores all the timestamp in headings + +Previously, ~org-agenda-search-headline-for-time~ made Org agenda +match anything resembling time inside headings. Even when the time +was a part of a timestamp. + +Now, all the timestamps in headings are ignored when searching the time. + +*** =org-crypt.el= now applies initial visibility settings to decrypted entries + +Previously, all the text was unfolded unconditionally, including property drawers. + +*** Blank lines after removed objects are now retained during export + +When certain objects in Org document are to be excluded from export, +spaces after these objects were previously removed as well. + +For example, if ~org-export-with-footnotes~ is set to nil, the footnote in + +: Pellentesque dapibus suscipit ligula.[fn:1] Donec posuere augue in quam. + +would be removed, leading to the following exported ASCII document + +: Pellentesque dapibus suscipit ligula.Donec posuere augue in quam. + +This is because spaces after footnote (and other markup) are +considered a part of the preceding AST object in Org. + +Now, unless there is a whitespace before an object to be removed, +spaces are preserved during export: + +: Pellentesque dapibus suscipit ligula. Donec posuere augue in quam. + +*** Remove undocumented ~:target~ header parameter in ~ob-clojure~ + +The ~:target~ header was only used internally to distinguish +from Clojure and ClojureScript. +This is now handled with an optional function parameter in +the respective functions that need this information. + +*** New org-entity alias: =\P= for =\para= + +For symmetry with =\S= and =\sect= for the section symbol, =\P= has +been added as an another form for the pilcrow symbol currently +available as =\para=. + +*** ~org-table-to-lisp~ no longer clobbers the regexp global state + +It does no longer use regexps. + +It is also faster. Large tables can be read quickly. + * Version 9.6 ** Important announcements and breaking changes @@ -220,7 +1865,13 @@ After: : ("simple" "list") #+end_src + ** New features +*** Column view: new commands to move rows up & down +You can move rows up & down in column view with +~org-columns-move-row-up~ and ~org-columns-move-row-down~. +Keybindings are the same as ~org-move-subtree-up~ and ~org-move-subtree-down~ +=M-= and =M-=. *** Clock table can now produce quarterly reports =:step= clock table parameter can now be set to =quarter=. @@ -432,6 +2083,13 @@ following properties: ~:hook~, ~:prepare-finalize~, prior to their global counterparts for the selected template. ** New options +*** New option ~org-columns-checkbox-allowed-values~ + +This would allow to use more than two states ("[ ]", "[X]") in +columns with SUMMARY-TYPE that use checkbox ("X", "X/", "X%"). +For example you can add an intermediate state ("[-]"). +Or empty state ("") to remove checkbox. + *** A new option for custom setting ~org-refile-use-outline-path~ to show document title in refile targets Setting ~org-refile-use-outline-path~ to ~'title~ will show title @@ -731,8 +2389,8 @@ following snippet to allow multiple different ID formats in Org files. ;; `org-attach-id-uuid-folder-format'. (lambda (id) (and (or (org-uuidgen-p id) - (string-match-p "[0-9a-z]\\{12\\}" id)) - (org-attach-id-uuid-folder-format id))) + (string-match-p "[0-9a-z]\\{12\\}" id)) + (org-attach-id-uuid-folder-format id))) ;; When ID looks like a timestamp-based ID. Group by year-month ;; folders. (lambda (id) @@ -746,7 +2404,6 @@ following snippet to allow multiple different ID formats in Org files. org-attach-id-uuid-folder-format org-attach-id-ts-folder-format)) #+end_src - * Version 9.5 ** Important announcements and breaking changes @@ -1346,7 +3003,7 @@ Go through the buffer and ask for the replacement." (goto-char (match-beginning 0)) (looking-at-p org-link-bracket-re)) (y-or-n-p "Fix link (remove TODO keyword)? ")) - (replace-match "[[*"))))) + (replace-match "[[*"))))) (visible-mode -1)) #+end_src @@ -2038,12 +3695,12 @@ removed. "Change properties for Org-Attach." (interactive) (org-with-point-at 1 - (while (outline-next-heading) - (let ((DIR (org--property-local-values "ATTACH_DIR" nil))) - (when DIR - (org-set-property "DIR" (car DIR)) - (org-delete-property "ATTACH_DIR")))) - (org-delete-property-globally "ATTACH_DIR_INHERIT"))) + (while (outline-next-heading) + (let ((DIR (org--property-local-values "ATTACH_DIR" nil))) + (when DIR + (org-set-property "DIR" (car DIR)) + (org-delete-property "ATTACH_DIR")))) + (org-delete-property-globally "ATTACH_DIR_INHERIT"))) #+end_src For those who hate breaking changes, even though the changes are made @@ -2568,14 +4225,14 @@ conditional on another entry. E.g. given this configuration: (defun custom/org-collect-confirmed (property) "Return `PROPERTY' for `CONFIRMED' entries" (let ((prop (org-entry-get nil property)) - (confirmed (org-entry-get nil "CONFIRMED"))) + (confirmed (org-entry-get nil "CONFIRMED"))) (if (and prop (string= "[X]" confirmed)) - prop - "0"))) + prop + "0"))) (setq org-columns-summary-types - '(("X+" org-columns--summary-sum - custom/org-collect-confirmed))) + '(("X+" org-columns--summary-sum + custom/org-collect-confirmed))) #+END_SRC You can have a file =bananas.org= containing: @@ -2810,11 +4467,11 @@ to the following #+BEGIN_SRC elisp (lambda (entry style project) (cond ((not (directory-name-p entry)) - (format "[[file:%s][%s]]" - (file-name-sans-extension entry) - (org-publish-find-title entry project))) - ((eq style 'tree) (file-name-nondirectory (directory-file-name entry))) - (t entry))) + (format "[[file:%s][%s]]" + (file-name-sans-extension entry) + (org-publish-find-title entry project))) + ((eq style 'tree) (file-name-nondirectory (directory-file-name entry))) + (t entry))) #+END_SRC *** Change signature for ~:sitemap-function~ diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 705ab62d69d..4d605fe7704 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,6 +1,6 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.6.15} -\def\versionyear{2023} % latest update +\def\orgversionnumber{9.7.3} +\def\versionyear{2024} % latest update \input emacsver.tex %**start of header @@ -11,10 +11,14 @@ % Specify how many you want here. \columnsperpage=3 +% Set letterpaper to 0 for A4 paper, 1 for letter (US) paper. Useful +% only when columnsperpage is 2 or 3. +\letterpaper=1 + % PDF output layout. 0 for A4, 1 for letter (US), a `l' is added for % a landscape layout. \input pdflayout.sty -\pdflayout=(0l) +\pdflayout=(1l) % Nothing else needs to be changed below this line. % Copyright (C) 1987, 1993, 1996--1997, 2001--2024 Free Software @@ -113,17 +117,14 @@ \footline{\hss\folio} \def\makefootline{\baselineskip10pt\hsize6.5in\line{\the\footline}} \else %2 or 3 columns uses prereduced size + \hsize 3.2in \if 1\the\letterpaper - \hsize 3.2in \vsize 7.95in - \hoffset -.75in - \voffset -.745in \else - \hsize 3.2in \vsize 7.65in - \hoffset -.25in - \voffset -.745in \fi + \hoffset -.75in + \voffset -.745in \font\titlefont=cmbx10 \scaledmag2 \font\headingfont=cmbx10 \scaledmag1 \font\smallfont=cmr6 @@ -280,7 +281,7 @@ %**end of header -\title{Org-Mode Reference Card (1/2)} +\title{Org-Mode Reference Card} \centerline{(for version \orgversionnumber)} @@ -482,7 +483,7 @@ after ``{\tt :}'', and dictionary words elsewhere. \newcolumn -\title{Org-Mode Reference Card (2/2)} +\title{Org-Mode Reference Card} \centerline{(for version \orgversionnumber)} diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index 1a25306570e..d13c65d260a 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -93,44 +93,45 @@ parameter may be used, like rdmd --chatty" is currently being evaluated.") (defun org-babel-execute:cpp (body params) - "Execute BODY according to PARAMS. + "Execute BODY according to its header arguments PARAMS. This function calls `org-babel-execute:C++'." (org-babel-execute:C++ body params)) (defun org-babel-expand-body:cpp (body params) - "Expand a block of C++ code with org-babel according to its header arguments." + "Expand C++ BODY with org-babel according to its header arguments PARAMS." (org-babel-expand-body:C++ body params)) (defun org-babel-execute:C++ (body params) - "Execute a block of C++ code with org-babel. + "Execute C++ BODY with org-babel according to its header arguments PARAMS. This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) (defun org-babel-expand-body:C++ (body params) - "Expand a block of C++ code with org-babel according to its header arguments." + "Expand C++ BODY with org-babel according to its header arguments PARAMS." (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand-C++ body params))) (defun org-babel-execute:D (body params) - "Execute a block of D code with org-babel. + "Execute D BODY with org-babel according to its header arguments PARAMS. This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'd)) (org-babel-C-execute body params))) (defun org-babel-expand-body:D (body params) - "Expand a block of D code with org-babel according to its header arguments." + "Expand D BODY with org-babel according to its header arguments PARAMS." (let ((org-babel-c-variant 'd)) (org-babel-C-expand-D body params))) (defun org-babel-execute:C (body params) - "Execute a block of C code with org-babel. + "Execute a C BODY according to its header arguments PARAMS. This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params))) (defun org-babel-expand-body:C (body params) - "Expand a block of C code with org-babel according to its header arguments." + "Expand C BODY according to its header arguments PARAMS." (let ((org-babel-c-variant 'c)) (org-babel-C-expand-C body params))) (defun org-babel-C-execute (body params) - "This function should only be called by `org-babel-execute:C' -or `org-babel-execute:C++' or `org-babel-execute:D'." + "Execute C/C++/D BODY according to its header arguments PARAMS. +This function should only be called by `org-babel-execute:C' or +`org-babel-execute:C++' or `org-babel-execute:D'." (let* ((tmp-src-file (org-babel-temp-file "C-src-" (pcase org-babel-c-variant @@ -196,11 +197,11 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." ))) (defun org-babel-C-expand-C++ (body params) - "Expand a block of C/C++ code with org-babel according to its header arguments." + "Expand C/C++ BODY with according to its header arguments PARAMS." (org-babel-C-expand-C body params)) (defun org-babel-C-expand-C (body params) - "Expand a block of C/C++ code with org-babel according to its header arguments." + "Expand C/C++ BODY according to its header arguments PARAMS." (let ((vars (org-babel--get-vars params)) (colnames (cdr (assq :colname-names params))) (main-p (not (string= (cdr (assq :main params)) "no"))) @@ -212,7 +213,9 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." nil)) (namespaces (org-babel-read (cdr (assq :namespaces params)) - nil))) + nil)) + (prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params)))) (when (stringp includes) (setq includes (split-string includes))) (when (stringp namespaces) @@ -226,6 +229,11 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." (nconc result (list (concat y " " x))) (setq y nil))) (setq defines (cdr result)))) + (setq body + (concat + (and prologue (concat prologue "\n")) + body + (and epilogue (concat "\n" epilogue "\n")))) (mapconcat 'identity (list ;; includes @@ -269,7 +277,7 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." body) "\n") "\n"))) (defun org-babel-C-expand-D (body params) - "Expand a block of D code with org-babel according to its header arguments." + "Expand D BODY according to its header arguments PARAMS." (let ((vars (org-babel--get-vars params)) (colnames (cdr (assq :colname-names params))) (main-p (not (string= (cdr (assq :main params)) "no"))) @@ -313,13 +321,15 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." (format "int main() {\n%s\nreturn 0;\n}\n" body))) (defun org-babel-prep-session:C (_session _params) - "This function does nothing as C is a compiled language with no -support for sessions." + "Throw and error that sessions are not supported. +This function does nothing as C is a compiled language with no support +for sessions." (error "C is a compiled language -- no support for sessions")) (defun org-babel-load-session:C (_session _body _params) - "This function does nothing as C is a compiled language with no -support for sessions." + "Throw and error that sessions are not supported. +This function does nothing as C is a compiled language with no support +for sessions." (error "C is a compiled language -- no support for sessions")) ;; helper functions @@ -379,10 +389,11 @@ FORMAT can be either a format string or a function which is called with VAL." type)))) (defun org-babel-C-val-to-base-type (val) - "Determine the base type of VAL which may be -`integerp' if all base values are integers -`floatp' if all base values are either floating points or integers -`stringp' otherwise." + "Determine the base type of VAL. +The type is: +- `integerp' if all base values are integers; +- `floatp' if all base values are either floating points or integers; +- `stringp' otherwise." (cond ((integerp val) 'integerp) ((floatp val) 'floatp) @@ -401,7 +412,7 @@ FORMAT can be either a format string or a function which is called with VAL." (t 'stringp))) (defun org-babel-C-var-to-C (pair) - "Convert an elisp val into a string of C code specifying a var of the same value." + "Convert PAIR of (var . val) C variable assignment." ;; TODO list support (let ((var (car pair)) (val (cdr pair))) diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index 670be050bf2..f365a68da81 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -64,6 +64,7 @@ (colormodel . :any) (useDingbats . :any) (horizontal . :any) + (async . ((yes no))) (results . ((file list vector table scalar verbatim) (raw html latex org code pp drawer) (replace silent none append prepend) @@ -91,15 +92,6 @@ this variable.") :version "24.1" :type 'string) -(defvar ess-current-process-name) ; dynamically scoped -(defvar ess-local-process-name) ; dynamically scoped -(defun org-babel-edit-prep:R (info) - (let ((session (cdr (assq :session (nth 2 info))))) - (when (and session - (string-prefix-p "*" session) - (string-suffix-p "*" session)) - (org-babel-R-initiate-session session nil)))) - ;; The usage of utils::read.table() ensures that the command ;; read.table() can be found even in circumstances when the utils ;; package is not in the search path from R. @@ -156,7 +148,7 @@ This function is used when the table does not contain a header.") "\n")) (defun org-babel-execute:R (body params) - "Execute a block of R code. + "Execute a block of R code BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (save-excursion (let* ((result-params (cdr (assq :result-params params))) @@ -215,7 +207,8 @@ 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. +Retrieve variables from PARAMS." (let ((vars (org-babel--get-vars params))) (mapcar (lambda (pair) @@ -261,42 +254,44 @@ This function is called by `org-babel-execute-src-block'." (t (format "%s <- %S" name (prin1-to-string value)))))) +(defvar ess-current-process-name) ; dynamically scoped +(defvar ess-local-process-name) ; dynamically scoped (defvar ess-ask-for-ess-directory) ; dynamically scoped +(defvar ess-gen-proc-buffer-name-function) ; defined in ess-inf.el (defun org-babel-R-initiate-session (session params) - "If there is not a current R process then create one." + "Create or return the current R SESSION buffer. +Use PARAMS to set default directory when creating a new session." (unless (string= session "none") - (let ((session (or session "*R*")) - (ess-ask-for-ess-directory - (and (boundp 'ess-ask-for-ess-directory) - ess-ask-for-ess-directory - (not (cdr (assq :dir params)))))) + (let* ((session (or session "*R*")) + (ess-ask-for-ess-directory + (and (boundp 'ess-ask-for-ess-directory) + ess-ask-for-ess-directory + (not (cdr (assq :dir params))))) + ;; Make ESS name the process buffer as SESSION. + (ess-gen-proc-buffer-name-function + (lambda (_) session))) (if (org-babel-comint-buffer-livep session) session (save-window-excursion (when (get-buffer session) ;; Session buffer exists, but with dead process (set-buffer session)) - (require 'ess-r-mode) + (org-require-package 'ess-r-mode "ESS") (set-buffer (run-ess-r)) (let ((R-proc (get-process (or ess-local-process-name ess-current-process-name)))) (while (process-get R-proc 'callbacks) (ess-wait-for-process R-proc))) - (rename-buffer - (if (bufferp session) - (buffer-name session) - (if (stringp session) - session - (buffer-name)))) (current-buffer)))))) (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 current code buffer." - (setq ess-local-process-name - (process-name (get-buffer-process session))) - (ess-make-buffer-current)) + (when-let ((process (get-buffer-process session))) + (setq ess-local-process-name (process-name process)) + (ess-make-buffer-current)) + (setq-local ess-gen-proc-buffer-name-function (lambda (_) session))) (defvar org-babel-R-graphics-devices '((:bmp "bmp" "filename") @@ -520,7 +515,7 @@ by `org-babel-comint-async-filter'." (ess-eval-buffer nil))) tmp-file)) (output - (let ((uuid (md5 (number-to-string (random 100000000)))) + (let ((uuid (org-id-uuid)) (ess-local-process-name (process-name (get-buffer-process session))) (ess-eval-visibly-p nil)) diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el index 777baa04234..9577a39ee67 100644 --- a/lisp/org/ob-awk.el +++ b/lisp/org/ob-awk.el @@ -48,12 +48,18 @@ (defvar org-babel-awk-command "awk" "Name of the awk executable command.") -(defun org-babel-expand-body:awk (body _params) +(defun org-babel-expand-body:awk (body params) "Expand BODY according to PARAMS, return the expanded body." - body) + (let ((prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params)))) + (concat + (and prologue (concat prologue "\n")) + body + (and epilogue (concat "\n" epilogue "\n"))))) (defun org-babel-execute:awk (body params) - "Execute a block of Awk code with org-babel. + "Execute a block of Awk code BODY with org-babel. +PARAMS is a plist of src block parameters . This function is called by `org-babel-execute-src-block'." (message "Executing Awk source code block") (let* ((result-params (cdr (assq :result-params params))) @@ -100,7 +106,9 @@ This function is called by `org-babel-execute-src-block'." (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (defun org-babel-awk-var-to-awk (var &optional sep) - "Return a printed value of VAR suitable for parsing with awk." + "Return a printed value of VAR suitable for parsing with awk. +SEP, when non-nil is a separator used when converting list values to awk +table." (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) (cond ((and (listp var) (listp (car var))) diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el index f834f05cb6d..171fd1b0432 100644 --- a/lisp/org/ob-calc.el +++ b/lisp/org/ob-calc.el @@ -44,13 +44,19 @@ (defvar org-babel-default-header-args:calc nil "Default arguments for evaluating a calc source block.") -(defun org-babel-expand-body:calc (body _params) - "Expand BODY according to PARAMS, return the expanded body." body) +(defun org-babel-expand-body:calc (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params)))) + (concat + (and prologue (concat prologue "\n")) + body + (and epilogue (concat "\n" epilogue "\n"))))) (defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc (defun org-babel-execute:calc (body params) - "Execute a block of calc code with Babel." + "Execute BODY of calc code with Babel using PARAMS." (unless (get-buffer "*Calculator*") (save-window-excursion (calc) (calc-quit))) (let* ((vars (org-babel--get-vars params)) @@ -58,7 +64,23 @@ (var-names (mapcar #'symbol-name org--var-syms))) (mapc (lambda (pair) - (calc-push-list (list (cdr pair))) + (let ((val (cdr pair))) + (calc-push-list + (list + (cond + ;; For a vector, Calc follows the format (vec 1 2 3 ...) so + ;; a matrix becomes (vec (vec 1 2 3) (vec 4 5 6) ...). See + ;; the comments in "Arithmetic routines." section of + ;; calc.el. + ((listp val) + (cons 'vec + (if (null (cdr val)) + (car val) + (mapcar (lambda (x) (if (listp x) (cons 'vec x) x)) + val)))) + ((numberp val) + (math-read-number (number-to-string val))) + (t val))))) (calc-store-into (car pair))) vars) (mapc @@ -99,6 +121,8 @@ (calc-pop 1))))) (defun org-babel-calc-maybe-resolve-var (el) +"Resolve user variables in EL. +EL is taken from the output of `math-read-exprs'." (if (consp el) (if (and (eq 'var (car el)) (member (cadr el) org--var-syms)) (progn diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index f6d57c01316..4a54acc51b3 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -25,20 +25,21 @@ ;;; Commentary: -;; Support for evaluating Clojure code +;; Support for evaluating Clojure / ClojureScript code. ;; Requirements: ;; - Clojure (at least 1.2.0) ;; - clojure-mode -;; - inf-clojure, Cider, SLIME, babashka or nbb +;; - babashka, nbb, Clojure CLI tools, Cider, inf-clojure or SLIME ;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode -;; For inf-clojure, see https://github.com/clojure-emacs/inf-clojure -;; For Cider, see https://github.com/clojure-emacs/cider -;; For SLIME, see https://slime.common-lisp.dev ;; For babashka, see https://github.com/babashka/babashka ;; For nbb, see https://github.com/babashka/nbb +;; For Clojure CLI tools, see https://clojure.org/guides/deps_and_cli +;; For Cider, see https://github.com/clojure-emacs/cider +;; For inf-clojure, see https://github.com/clojure-emacs/inf-clojure +;; For SLIME, see https://slime.common-lisp.dev ;; For SLIME, the best way to install its components is by following ;; the directions as set out by Phil Hagelberg (Technomancy) on the @@ -78,20 +79,33 @@ (defcustom org-babel-clojure-backend (cond ((executable-find "bb") 'babashka) - ((executable-find "nbb") 'nbb) + ((executable-find "clojure") 'clojure-cli) ((featurep 'cider) 'cider) ((featurep 'inf-clojure) 'inf-clojure) ((featurep 'slime) 'slime) (t nil)) "Backend used to evaluate Clojure code blocks." :group 'org-babel - :package-version '(Org . "9.6") + :package-version '(Org . "9.7") :type '(choice - (const :tag "inf-clojure" inf-clojure) + (const :tag "babashka" babashka) + (const :tag "clojure-cli" clojure-cli) (const :tag "cider" cider) + (const :tag "inf-clojure" inf-clojure) (const :tag "slime" slime) - (const :tag "babashka" babashka) + (const :tag "Not configured yet" nil))) + +(defcustom org-babel-clojurescript-backend + (cond + ((or (executable-find "nbb") (executable-find "npx")) 'nbb) + ((featurep 'cider) 'cider) + (t nil)) + "Backend used to evaluate ClojureScript code blocks." + :group 'org-babel + :package-version '(Org . "9.7") + :type '(choice (const :tag "nbb" nbb) + (const :tag "cider" cider) (const :tag "Not configured yet" nil))) (defcustom org-babel-clojure-default-ns "user" @@ -100,19 +114,29 @@ :group 'org-babel) (defcustom ob-clojure-babashka-command (executable-find "bb") - "Path to the babashka executable." + "Babashka command used by the Clojure `babashka' backend." :type '(choice file (const nil)) :group 'org-babel :package-version '(Org . "9.6")) -(defcustom ob-clojure-nbb-command (executable-find "nbb") - "Path to the nbb executable." - :type '(choice file (const nil)) +(defcustom ob-clojure-nbb-command (or (executable-find "nbb") + (when-let (npx (executable-find "npx")) + (concat npx " nbb"))) + "Nbb command used by the ClojureScript `nbb' backend." + :type '(choice string (const nil)) :group 'org-babel - :package-version '(Org . "9.6")) + :package-version '(Org . "9.7")) -(defun org-babel-expand-body:clojure (body params) - "Expand BODY according to PARAMS, return the expanded body." +(defcustom ob-clojure-cli-command (when-let (cmd (executable-find "clojure")) + (concat cmd " -M")) + "Clojure CLI command used by the Clojure `clojure-cli' backend." + :type 'string + :group 'org-babel + :package-version '(Org . "9.7")) + +(defun org-babel-expand-body:clojure (body params &optional cljs-p) + "Expand BODY according to PARAMS, return the expanded body. +When CLJS-P is non-nil, expand in a cljs context instead of clj." (let* ((vars (org-babel--get-vars params)) (backend-override (cdr (assq :backend params))) (org-babel-clojure-backend @@ -146,10 +170,26 @@ or set the `:backend' header argument")))) vars "\n ") body)))))) - (if (or (member "code" result-params) - (member "pp" result-params)) - (format "(clojure.pprint/pprint (do %s))" body) - body))) + ;; If the result param is set to "output" we don't have to do + ;; anything special and just let the backend handle everything + (if (member "output" result-params) + body + + ;; If the result is not "output" (i.e. it's "value"), disable + ;; stdout output and print the last returned value. Use pprint + ;; instead of prn when results param is "pp" or "code". + (concat + (if (or (member "code" result-params) + (member "pp" result-params)) + (concat (if cljs-p + "(require '[cljs.pprint :refer [pprint]])" + "(require '[clojure.pprint :refer [pprint]])") + " (pprint ") + "(prn ") + (if cljs-p + "(binding [cljs.core/*print-fn* (constantly nil)]" + "(binding [*out* (java.io.StringWriter.)]") + body "))")))) (defvar ob-clojure-inf-clojure-filter-out) (defvar ob-clojure-inf-clojure-tmp-output) @@ -186,8 +226,7 @@ or set the `:backend' header argument")))) (defvar inf-clojure-comint-prompt-regexp) (defun ob-clojure-eval-with-inf-clojure (expanded params) "Evaluate EXPANDED code block with PARAMS using inf-clojure." - (condition-case nil (require 'inf-clojure) - (user-error "inf-clojure not available")) + (org-require-package 'inf-clojure) ;; Maybe initiate the inf-clojure session (unless (and inf-clojure-buffer (buffer-live-p (get-buffer inf-clojure-buffer))) @@ -198,7 +237,9 @@ or set the `:backend' header argument")))) "clojure" (format "clojure -A%s" alias) cmd0) cmd0))) - (setq comint-prompt-regexp inf-clojure-comint-prompt-regexp) + (setq + org-babel-comint-prompt-regexp-old comint-prompt-regexp + comint-prompt-regexp inf-clojure-comint-prompt-regexp) (funcall-interactively #'inf-clojure cmd) (goto-char (point-max)))) (sit-for 1)) @@ -226,38 +267,24 @@ or set the `:backend' header argument")))) s)) (reverse ob-clojure-inf-clojure-tmp-output))))) -(defun ob-clojure-eval-with-cider (expanded params) - "Evaluate EXPANDED code block with PARAMS using cider." - (condition-case nil (require 'cider) - (user-error "cider not available")) - (let ((connection (cider-current-connection (cdr (assq :target params)))) - (result-params (cdr (assq :result-params params))) - result0) +(defun ob-clojure-eval-with-cider (expanded _params &optional cljs-p) + "Evaluate EXPANDED code block using cider. +When CLJS-P is non-nil, use a cljs connection instead of clj. +The PARAMS from Babel are not used in this function." + (org-require-package 'cider "Cider") + (let ((connection (cider-current-connection (if cljs-p "cljs" "clj")))) (unless connection (sesman-start-session 'CIDER)) (if (not connection) ;; Display in the result instead of using `user-error' - (setq result0 "Please reevaluate when nREPL is connected") - (ob-clojure-with-temp-expanded expanded params - (let ((response (nrepl-sync-request:eval exp connection))) - (push (or (nrepl-dict-get response "root-ex") - (nrepl-dict-get response "ex") - (nrepl-dict-get - response (if (or (member "output" result-params) - (member "pp" result-params)) - "out" - "value"))) - result0))) - (ob-clojure-string-or-list - ;; Filter out s-expressions that return nil (string "nil" - ;; from nrepl eval) or comment forms (actual nil from nrepl) - (reverse (delete "" (mapcar (lambda (r) - (replace-regexp-in-string "nil" "" (or r ""))) - result0))))))) + "Please reevaluate when nREPL is connected" + (let ((response (nrepl-sync-request:eval expanded connection))) + (or (nrepl-dict-get response "root-ex") + (nrepl-dict-get response "ex") + (nrepl-dict-get response "out")))))) (defun ob-clojure-eval-with-slime (expanded params) "Evaluate EXPANDED code block with PARAMS using slime." - (condition-case nil (require 'slime) - (user-error "slime not available")) + (org-require-package 'slime "SLIME") (with-temp-buffer (insert expanded) (slime-eval @@ -265,39 +292,54 @@ or set the `:backend' header argument")))) ,(buffer-substring-no-properties (point-min) (point-max))) (cdr (assq :package params))))) -(defun ob-clojure-eval-with-babashka (bb expanded) - "Evaluate EXPANDED code block using BB (babashka or nbb)." - (let ((script-file (org-babel-temp-file "clojure-bb-script-" ".clj"))) +(defun ob-clojure-eval-with-cmd (cmd expanded) + "Evaluate EXPANDED code block using CMD (babashka, clojure or nbb)." + (let ((script-file (org-babel-temp-file "clojure-cmd-script-" ".clj"))) (with-temp-file script-file (insert expanded)) (org-babel-eval - (format "%s %s" bb (org-babel-process-file-name script-file)) + (format "%s %s" cmd (org-babel-process-file-name script-file)) ""))) -(defun org-babel-execute:clojure (body params) - "Execute the BODY block of Clojure code with PARAMS using Babel." +(defun org-babel-execute:clojure (body params &optional cljs-p) + "Execute the BODY block of Clojure code with PARAMS using Babel. +When CLJS-P is non-nil, execute with a ClojureScript backend +instead of Clojure." (let* ((backend-override (cdr (assq :backend params))) (org-babel-clojure-backend (cond (backend-override (intern backend-override)) - (org-babel-clojure-backend org-babel-clojure-backend) - (t (user-error "You need to customize `org-babel-clojure-backend' -or set the `:backend' header argument"))))) - (let* ((expanded (org-babel-expand-body:clojure body params)) + (org-babel-clojure-backend (if cljs-p + org-babel-clojurescript-backend + org-babel-clojure-backend)) + (t (user-error "You need to customize `%S' +or set the `:backend' header argument" + (if cljs-p + org-babel-clojurescript-backend + org-babel-clojure-backend))))) + ;; We allow a Clojure source block to be evaluated with the + ;; nbb backend and therefore have to expand the body with + ;; ClojureScript syntax when we either evaluate a + ;; ClojureScript source block or use the nbb backend. + (cljs-p (or cljs-p (eq org-babel-clojure-backend 'nbb)))) + (let* ((expanded (org-babel-expand-body:clojure body params cljs-p)) (result-params (cdr (assq :result-params params))) result) (setq result (cond ((eq org-babel-clojure-backend 'inf-clojure) (ob-clojure-eval-with-inf-clojure expanded params)) + ((eq org-babel-clojure-backend 'clojure-cli) + (ob-clojure-eval-with-cmd ob-clojure-cli-command expanded)) ((eq org-babel-clojure-backend 'babashka) - (ob-clojure-eval-with-babashka ob-clojure-babashka-command expanded)) + (ob-clojure-eval-with-cmd ob-clojure-babashka-command expanded)) ((eq org-babel-clojure-backend 'nbb) - (ob-clojure-eval-with-babashka ob-clojure-nbb-command expanded)) + (ob-clojure-eval-with-cmd ob-clojure-nbb-command expanded)) ((eq org-babel-clojure-backend 'cider) - (ob-clojure-eval-with-cider expanded params)) + (ob-clojure-eval-with-cider expanded params cljs-p)) ((eq org-babel-clojure-backend 'slime) - (ob-clojure-eval-with-slime expanded params)))) + (ob-clojure-eval-with-slime expanded params)) + (t (user-error "Invalid backend")))) (org-babel-result-cond result-params result (condition-case nil (org-babel-script-escape result) @@ -305,7 +347,7 @@ or set the `:backend' header argument"))))) (defun org-babel-execute:clojurescript (body params) "Evaluate BODY with PARAMS as ClojureScript code." - (org-babel-execute:clojure body (cons '(:target . "cljs") params))) + (org-babel-execute:clojure body params t)) (provide 'ob-clojure) diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index 66861a54ffc..764927af748 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -58,6 +58,48 @@ executed inside the protection of `save-excursion' and (let ((comint-input-filter (lambda (_input) nil))) ,@body)))))) +(defvar-local org-babel-comint-prompt-regexp-old nil + "Fallback regexp used to detect prompt.") + +(defcustom org-babel-comint-fallback-regexp-threshold 5.0 + "Waiting time until trying to use fallback regexp to detect prompt. +This is useful when prompt unexpectedly changes." + :type 'float + :group 'org-babel + :package-version '(Org . "9.7")) + +(defun org-babel-comint--set-fallback-prompt () + "Swap `comint-prompt-regexp' and `org-babel-comint-prompt-regexp-old'." + (when org-babel-comint-prompt-regexp-old + (let ((tmp comint-prompt-regexp)) + (setq comint-prompt-regexp org-babel-comint-prompt-regexp-old + org-babel-comint-prompt-regexp-old tmp)))) + +(defun org-babel-comint--prompt-filter (string &optional prompt-regexp) + "Remove PROMPT-REGEXP from STRING. + +PROMPT-REGEXP defaults to `comint-prompt-regexp'." + (let* ((prompt-regexp (or prompt-regexp comint-prompt-regexp)) + ;; We need newline in case if we do progressive replacement + ;; of agglomerated comint prompts with `comint-prompt-regexp' + ;; containing ^. + (separator "org-babel-comint--prompt-filter-separator\n")) + (while (string-match-p prompt-regexp string) + (setq string + (replace-regexp-in-string + (format "\\(?:%s\\)?\\(?:%s\\)[ \t]*" separator prompt-regexp) + separator string))) + (delete "" (split-string string separator)))) + +(defun org-babel-comint--echo-filter (string &optional echo) + "Remove ECHO from STRING." + (and echo string + (string-match + (replace-regexp-in-string "\n" "[\r\n]+" (regexp-quote echo)) + string) + (setq string (substring string (match-end 0)))) + string) + (defmacro org-babel-comint-with-output (meta &rest body) "Evaluate BODY in BUFFER and return process output. Will wait until EOE-INDICATOR appears in the output, then return @@ -74,9 +116,7 @@ or user `keyboard-quit' during execution of body." (let ((buffer (nth 0 meta)) (eoe-indicator (nth 1 meta)) (remove-echo (nth 2 meta)) - (full-body (nth 3 meta)) - (org-babel-comint-prompt-separator - "org-babel-comint-prompt-separator")) + (full-body (nth 3 meta))) `(org-babel-comint-in-buffer ,buffer (let* ((string-buffer "") (comint-output-filter-functions @@ -93,43 +133,39 @@ or user `keyboard-quit' during execution of body." ;; 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)))) + (let ((start-time (current-time))) + (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)) + org-babel-comint-fallback-regexp-threshold) + (when (and org-babel-comint-prompt-regexp-old + (> (float-time (time-since start-time)) + org-babel-comint-fallback-regexp-threshold) + (progn + (goto-char comint-last-input-end) + (save-excursion + (and + (re-search-forward + (regexp-quote ,eoe-indicator) nil t) + (re-search-forward + org-babel-comint-prompt-regexp-old nil t))))) + (org-babel-comint--set-fallback-prompt)))) ;; replace cut dangling text (goto-char (process-mark (get-buffer-process (current-buffer)))) (insert dangling-text) + ;; remove echo'd FULL-BODY from input + (and ,remove-echo ,full-body + (setq string-buffer (org-babel-comint--echo-filter string-buffer ,full-body))) + ;; Filter out prompts. - (setq string-buffer - (replace-regexp-in-string - ;; Sometimes, we get multiple agglomerated - ;; prompts together in a single output: - ;; "prompt prompt prompt output" - ;; Remove them progressively, so that - ;; possible "^" in the prompt regexp gets to - ;; work as we remove the heading prompt - ;; instance. - (if (string-prefix-p "^" comint-prompt-regexp) - (format "^\\(%s\\)+" (substring comint-prompt-regexp 1)) - comint-prompt-regexp) - ,org-babel-comint-prompt-separator - string-buffer)) - ;; remove echo'd FULL-BODY from input - (when (and ,remove-echo ,full-body - (string-match - (replace-regexp-in-string - "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) - string-buffer)) - (setq string-buffer (substring string-buffer (match-end 0)))) - (delete "" (split-string - string-buffer - ,org-babel-comint-prompt-separator)))))) + (org-babel-comint--prompt-filter string-buffer))))) (defun org-babel-comint-input-command (buffer cmd) "Pass CMD to BUFFER. @@ -145,11 +181,23 @@ The input will not be echoed." Note: this is only safe when waiting for the result of a single statement (not large blocks of code)." (org-babel-comint-in-buffer buffer - (while (progn - (goto-char comint-last-input-end) - (not (and (re-search-forward comint-prompt-regexp nil t) - (goto-char (match-beginning 0))))) - (accept-process-output (get-buffer-process buffer))))) + (let ((start-time (current-time))) + (while (progn + (goto-char comint-last-input-end) + (not (and (re-search-forward comint-prompt-regexp nil t) + (goto-char (match-beginning 0))))) + (accept-process-output + (get-buffer-process buffer) + org-babel-comint-fallback-regexp-threshold) + (when (and org-babel-comint-prompt-regexp-old + (> (float-time (time-since start-time)) + org-babel-comint-fallback-regexp-threshold) + (progn + (goto-char comint-last-input-end) + (save-excursion + (re-search-forward + org-babel-comint-prompt-regexp-old nil t)))) + (org-babel-comint--set-fallback-prompt)))))) (defun org-babel-comint-eval-invisibly-and-wait-for-file (buffer file string &optional period) @@ -192,8 +240,8 @@ comint process. It should return a string that will be passed to `org-babel-insert-result'.") (defvar-local org-babel-comint-async-dangling nil - "Dangling piece of the last process output, in case -`org-babel-comint-async-indicator' is spread across multiple + "Dangling piece of the last process output, as a string. +Used when `org-babel-comint-async-indicator' is spread across multiple comint outputs due to buffering.") (defun org-babel-comint-use-async (params) @@ -221,6 +269,8 @@ STRING contains the output originally inserted into the comint buffer." (file-callback org-babel-comint-async-file-callback) (combined-string (concat org-babel-comint-async-dangling string)) (new-dangling combined-string) + ;; Assumes comint filter called with session buffer current + (session-dir default-directory) ;; list of UUID's matched by `org-babel-comint-async-indicator' uuid-list) (with-temp-buffer @@ -245,7 +295,8 @@ STRING contains the output originally inserted into the comint buffer." (let* ((info (org-babel-get-src-block-info)) (params (nth 2 info)) (result-params - (cdr (assq :result-params params)))) + (cdr (assq :result-params params))) + (default-directory session-dir)) (org-babel-insert-result (funcall file-callback (nth @@ -268,16 +319,17 @@ STRING contains the output originally inserted into the comint buffer." (res-str-raw (buffer-substring ;; move point to beginning of indicator - (- (match-beginning 0) 1) + (match-beginning 0) ;; find the matching start indicator (cl-loop do (re-search-backward indicator) until (and (equal (match-string 1) "start") (equal (match-string 2) uuid)) finally return (+ 1 (match-end 0))))) - ;; Apply callback to clean up the result - (res-str (funcall org-babel-comint-async-chunk-callback - res-str-raw))) + ;; Remove prompt + (res-promptless (org-trim (string-join (mapcar #'org-trim (org-babel-comint--prompt-filter res-str-raw)) "\n") "\n")) + ;; Apply user callback + (res-str (funcall org-babel-comint-async-chunk-callback res-promptless))) ;; Search for uuid in associated org-buffers to insert results (cl-loop for buf in org-buffers until (with-current-buffer buf @@ -288,7 +340,8 @@ STRING contains the output originally inserted into the comint buffer." (let* ((info (org-babel-get-src-block-info)) (params (nth 2 info)) (result-params - (cdr (assq :result-params params)))) + (cdr (assq :result-params params))) + (default-directory session-dir)) (org-babel-insert-result res-str result-params info)) t)))) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 0367b11330d..c5dd20b0ed9 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -43,7 +43,6 @@ (defvar org-edit-src-content-indentation) (defvar org-link-file-path-type) (defvar org-src-lang-modes) -(defvar org-src-preserve-indentation) (defvar org-babel-tangle-uncomment-comments) (declare-function org-attach-dir "org-attach" (&optional create-if-not-exists-p no-fs-check)) @@ -60,16 +59,26 @@ (declare-function org-cycle "org-cycle" (&optional arg)) (declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name)) (declare-function org-edit-src-exit "org-src" ()) +(declare-function org-src-preserve-indentation-p "org-src" (node)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-element-at-point-no-context "org-element" (&optional pom)) (declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-normalize-string "org-element" (s)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-begin "org-element" (node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-post-affiliated "org-element" (node)) +(declare-function org-element-contents-begin "org-element" (node)) +(declare-function org-element-contents-end "org-element" (node)) +(declare-function org-element-parent "org-element-ast" (node)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) +(declare-function org-element-type-p "org-element-ast" (node &optional types)) +(declare-function org-element-interpret-data "org-element" (data)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-escape-code-in-region "org-src" (beg end)) (declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) +(declare-function org-indent-block "org" ()) (declare-function org-indent-line "org" ()) (declare-function org-list-get-list-end "org-list" (item struct prevs)) (declare-function org-list-prevs-alist "org-list" (struct)) @@ -212,7 +221,7 @@ When matching, reference is stored in match group 1." ;; (4) header arguments "\\([^\n]*\\)\n" ;; (5) body - "\\([^\000]*?\n\\)??[ \t]*#\\+end_src") + "\\(\\(?:.\\|\n\\)*?\n\\)??[ \t]*#\\+end_src") "Regexp used to identify code blocks.") (defun org-babel--get-vars (params) @@ -305,11 +314,15 @@ environment, to override this check." ;;;###autoload (defun org-babel-execute-safely-maybe () + "Maybe `org-babel-execute-maybe'. +This function does nothing unless `org-babel-no-eval-on-ctrl-c-ctrl-c' +is non-nil." (unless org-babel-no-eval-on-ctrl-c-ctrl-c (org-babel-execute-maybe))) ;;;###autoload (defun org-babel-execute-maybe () +"Execute src block or babel call at point." (interactive) (or (org-babel-execute-src-block-maybe) (org-babel-lob-execute-maybe))) @@ -318,8 +331,7 @@ environment, to override this check." "Execute BODY if point is in a source block and return t. Otherwise do nothing and return nil." - `(if (memq (org-element-type (org-element-context)) - '(inline-src-block src-block)) + `(if (org-element-type-p (org-element-context) '(inline-src-block src-block)) (progn ,@body t) @@ -434,7 +446,46 @@ then run `org-babel-switch-to-session'." (tangle . ((tangle yes no :any))) (tangle-mode . ((#o755 #o555 #o444 :any))) (var . :any) - (wrap . :any))) + (wrap . :any)) + "Alist defining common header args and their allowed values. + +Keys of the alist are header arg symbols. +Values of the alist are either a symbol `:any' or a list of allowed +values as symbols: + + (header-name . :any) + (header-name . ((value1 value2 value3 ...)) + (header-name . ((value1 value2 value3 ... :any)) + +When Org considers header-arg property inheritance, the innermost +value from the list is considered. + +Symbol `:any' in the value list implies that any value is allowed. +Yet the explicitly listed values from the list will be offered as +completion candidates. + +FIXME: This is currently just supported for `results' and `exports'. +Values in the alist can also be a list of lists. The inner lists +define exclusive groups of values that can be set at the same time for +a given header argument. + + (results . ((file list ...) + (raw html ...)) + +The above example allows multi-component header arguments like + + #+begin_src bash :results file raw + <:results will combine the two values \"file raw\".> + + #+begin_src bash :results file list + <:results will only use the last value \"list\".> + + #+property: header-args :results file html + ... + #+begin_src bash :results list + <:results will inherit with partial override \"list html\".> + +See info node `(org)Results of evaluation' for more details.") (defconst org-babel-header-arg-names (mapcar #'car org-babel-common-header-args-w-values) @@ -611,14 +662,12 @@ Remove final newline character and spurious indentation." (body (if (string-suffix-p "\n" value) (substring value 0 -1) value))) - (cond ((eq (org-element-type datum) 'inline-src-block) + (cond ((org-element-type-p datum 'inline-src-block) ;; Newline characters and indentation in an inline ;; src-block are not meaningful, since they could come from ;; some paragraph filling. Treat them as a white space. (replace-regexp-in-string "\n[ \t]*" " " body)) - ((or org-src-preserve-indentation - (org-element-property :preserve-indent datum)) - body) + ((org-src-preserve-indentation-p datum) body) (t (org-remove-indentation body))))) ;;; functions @@ -653,8 +702,9 @@ By default, consider the block at point. However, when optional argument DATUM is provided, extract information from that parsed object instead. -Return nil if point is not on a source block. Otherwise, return -a list with the following pattern: +Return nil if point is not on a source block (blank lines after a +source block are considered a part of that source block). +Otherwise, return a list with the following pattern: (language body arguments switches name start coderef)" (let* ((datum (or datum (org-element-context))) @@ -677,7 +727,7 @@ a list with the following pattern: ;; If DATUM is provided, make sure we get node ;; properties applicable to its location within ;; the document. - (org-with-point-at (org-element-property :begin datum) + (org-with-point-at (org-element-begin datum) (org-babel-params-from-properties lang no-eval)) (mapcar (lambda (h) (org-babel-parse-header-arguments h no-eval)) @@ -694,7 +744,9 @@ a list with the following pattern: info)))) (defun org-babel--expand-body (info) - "Expand noweb references in body and remove any coderefs." + "Expand noweb references in src block and remove any coderefs. +The src block is defined by its INFO, as returned by +`org-babel-get-src-block-info'." (let ((coderef (nth 6 info)) (expand (if (org-babel-noweb-p (nth 2 info) :eval) @@ -705,14 +757,43 @@ a list with the following pattern: (org-src-coderef-regexp coderef) "" expand nil nil 1)))) (defun org-babel--file-desc (params result) - "Retrieve file description." + "Retrieve description for file link result of evaluation. +PARAMS is header argument values. RESULT is the file link as returned +by the code block. + +When `:file-desc' header argument is provided use its value or +duplicate RESULT in the description. + +When `:file-desc' is missing, return nil." (pcase (assq :file-desc params) (`nil nil) (`(:file-desc) result) (`(:file-desc . ,(and (pred stringp) val)) val))) -(defvar *this*) ; Dynamically bound in `org-babel-execute-src-block' - ; and `org-babel-read' +(defvar *this*) +;; Dynamically bound in `org-babel-execute-src-block' +;; and `org-babel-read' + +(defun org-babel-session-buffer (&optional info) + "Return buffer name for session associated with current code block. +Return nil when no such live buffer with process exists. +When INFO is non-nil, it should be a list returned by +`org-babel-get-src-block-info'. +This function uses org-babel-session-buffer: function to +retrieve backend-specific session buffer name." + (declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) + (when-let* ((info (or info (org-babel-get-src-block-info 'no-eval))) + (lang (nth 0 info)) + (session (cdr (assq :session (nth 2 info)))) + (cmd (intern (concat "org-babel-session-buffer:" lang))) + (buffer-name + (if (fboundp cmd) + (funcall cmd session info) + ;; Use session name as buffer name by default. + session))) + (require 'ob-comint) + (when (org-babel-comint-buffer-livep buffer-name) + buffer-name))) ;;;###autoload (defun org-babel-execute-src-block (&optional arg info params executor-type) @@ -784,14 +865,16 @@ guess will be made." (dir (cdr (assq :dir params))) (mkdirp (cdr (assq :mkdirp params))) (default-directory - (cond - ((not dir) default-directory) - ((member mkdirp '("no" "nil" nil)) - (file-name-as-directory (expand-file-name dir))) - (t - (let ((d (file-name-as-directory (expand-file-name dir)))) - (make-directory d 'parents) - d)))) + (cond + ((not dir) default-directory) + ((when-let ((session (org-babel-session-buffer info))) + (buffer-local-value 'default-directory (get-buffer session)))) + ((member mkdirp '("no" "nil" nil)) + (file-name-as-directory (expand-file-name dir))) + (t + (let ((d (file-name-as-directory (expand-file-name dir)))) + (make-directory d 'parents) + d)))) (cmd (intern (concat "org-babel-execute:" lang))) result exec-start-time) (unless (fboundp cmd) @@ -849,10 +932,13 @@ guess will be made." (setq result (org-babel-ref-resolve post)) (when file (setq result-params (remove "file" result-params)))))) - (if (member "none" result-params) - (message "result silenced") + (unless (member "none" result-params) (org-babel-insert-result - result result-params info new-hash lang + result result-params info + ;; append/prepend cannot handle hash as we accumulate + ;; multiple outputs together. + (when (member "replace" result-params) new-hash) + lang (time-subtract (current-time) exec-start-time)))) (run-hooks 'org-babel-after-execute-hook) result))))))) @@ -862,7 +948,10 @@ guess will be made." Expand a block of code with org-babel according to its header arguments. This generic implementation of body expansion is called for languages which have not defined their own specific -org-babel-expand-body:lang function." +org-babel-expand-body:lang function. + +VAR-LINES is a list of lines that define variable environment. These +lines will be added after `:prologue' parameter and before BODY." (let ((pro (cdr (assq :prologue params))) (epi (cdr (assq :epilogue params)))) (mapconcat #'identity @@ -874,7 +963,10 @@ org-babel-expand-body:lang function." ;;;###autoload (defun org-babel-expand-src-block (&optional _arg info params) - "Expand the current source code block. + "Expand the current source code block or block specified by INFO. +INFO is the output of `org-babel-get-src-block-info'. +PARAMS defines inherited header arguments. + Expand according to the source code block's header arguments and pop open the results in a preview buffer." (interactive) @@ -901,7 +993,7 @@ arguments and pop open the results in a preview buffer." expanded))) (defun org-babel-combine-header-arg-lists (original &rest others) - "Combine a number of lists of header argument names and arguments." + "Combine ORIGINAL and OTHERS lists of header argument names and arguments." (let ((results (copy-sequence original))) (dolist (new-list others) (dolist (arg-pair new-list) @@ -936,7 +1028,10 @@ arguments and pop open the results in a preview buffer." ;;;###autoload (defun org-babel-insert-header-arg (&optional header-arg value) - "Insert a header argument selecting from lists of common args and values." + "Insert a header argument and its value. +HEADER-ARG and VALUE, when provided, are the header argument name and +its value. When HEADER-ARG or VALUE are nil, offer interactive +completion from lists of common args and values." (interactive) (let* ((info (org-babel-get-src-block-info 'no-eval)) (lang (car info)) @@ -1000,6 +1095,9 @@ arguments and pop open the results in a preview buffer." ;;;###autoload (defun org-babel-load-in-session (&optional _arg info) "Load the body of the current source-code block. +When optional argument INFO is non-nil, use source block defined in +INFO, as returned by `org-babel-get-src-block-info'. + Evaluate the header arguments for the source block before entering the session. After loading the body this pops open the session." @@ -1025,8 +1123,8 @@ session." ;;;###autoload (defun org-babel-initiate-session (&optional arg info) - "Initiate session for current code block. -If called with a prefix argument then resolve any variable + "Initiate session for current code block or the block defined by INFO. +If called with a prefix argument ARG, 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." (interactive "P") @@ -1054,9 +1152,9 @@ 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. + "Switch to the session of the current code block or block defined by INFO. Uses `org-babel-initiate-session' to start the session. If called -with a prefix argument then this is passed on to +with a prefix argument ARG, then this is passed on to `org-babel-initiate-session'." (interactive "P") (pop-to-buffer (org-babel-initiate-session arg info)) @@ -1068,7 +1166,8 @@ with a prefix argument then this is passed on to ;;;###autoload (defun org-babel-switch-to-session-with-code (&optional arg _info) - "Switch to code buffer and display session." + "Switch to code buffer and display session. +Prefix argument ARG is passed to `org-babel-switch-to-session'." (interactive "P") (let ((swap-windows (lambda () @@ -1096,18 +1195,23 @@ Return t if a code block was found at point, nil otherwise." ;; we want to restore this location after executing BODY. (outside-position (and (<= (line-beginning-position) - (org-element-property :post-affiliated element)) + (org-element-post-affiliated element)) (point-marker))) (org-src-window-setup 'switch-invisibly)) (when (and (org-babel-where-is-src-block-head element) - (org-edit-src-code)) + (condition-case nil + (org-edit-src-code) + (t + (org-edit-src-exit) + (when outside-position (goto-char outside-position)) + nil))) (unwind-protect (progn ,@body) (org-edit-src-exit) (when outside-position (goto-char outside-position))) t))) (defun org-babel-do-key-sequence-in-edit-buffer (key) - "Read key sequence and execute the command in edit buffer. + "Read key sequence KEY 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 Org code block according to the effect of TAB in the language @@ -1123,8 +1227,10 @@ evaluation mechanisms." (defvar org-link-bracket-re) (defun org-babel-active-location-p () - (memq (org-element-type (save-match-data (org-element-context))) - '(babel-call inline-babel-call inline-src-block src-block))) + "Return non-nil, when at executable element." + (org-element-type-p + (save-match-data (org-element-context)) + '(babel-call inline-babel-call inline-src-block src-block))) ;;;###autoload (defun org-babel-open-src-block-result (&optional re-run) @@ -1235,10 +1341,10 @@ buffer." (setq ,to-be-removed (current-buffer)) (goto-char (point-min)) (while (re-search-forward "src_\\S-" nil t) - (let ((,datum (save-match-data (org-element-context)))) - (when (eq (org-element-type ,datum) 'inline-src-block) - (goto-char (match-beginning 0)) - (let ((,end (copy-marker (org-element-property :end ,datum)))) + (let ((,datum (org-element-context))) + (when (org-element-type-p ,datum 'inline-src-block) + (goto-char (org-element-begin ,datum)) + (let ((,end (copy-marker (org-element-end ,datum)))) ,@body (goto-char ,end) (set-marker ,end nil)))))) @@ -1263,11 +1369,11 @@ buffer." (setq ,to-be-removed (current-buffer)) (goto-char (point-min)) (while (re-search-forward "call_\\S-\\|^[ \t]*#\\+CALL:" nil t) - (let ((,datum (save-match-data (org-element-context)))) - (when (memq (org-element-type ,datum) - '(babel-call inline-babel-call)) - (goto-char (match-beginning 0)) - (let ((,end (copy-marker (org-element-property :end ,datum)))) + (let ((,datum (org-element-context))) + (when (org-element-type-p ,datum '(babel-call inline-babel-call)) + (goto-char (or (org-element-post-affiliated datum) + (org-element-begin datum))) + (let ((,end (copy-marker (org-element-end ,datum)))) ,@body (goto-char ,end) (set-marker ,end nil)))))) @@ -1293,12 +1399,13 @@ buffer." (goto-char (point-min)) (while (re-search-forward "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)" nil t) - (let ((,datum (save-match-data (org-element-context)))) - (when (memq (org-element-type ,datum) - '(babel-call inline-babel-call inline-src-block - src-block)) - (goto-char (match-beginning 0)) - (let ((,end (copy-marker (org-element-property :end ,datum)))) + (let ((,datum (org-element-context))) + (when (org-element-type-p + ,datum + '(babel-call inline-babel-call inline-src-block src-block)) + (goto-char (or (org-element-post-affiliated ,datum) + (org-element-begin ,datum))) + (let ((,end (copy-marker (org-element-end ,datum)))) ,@body (goto-char ,end) (set-marker ,end nil)))))) @@ -1308,14 +1415,15 @@ buffer." ;;;###autoload (defun org-babel-execute-buffer (&optional arg) "Execute source code blocks in a buffer. +Prefix argument ARG is passed to `org-babel-execute-src-block'. Call `org-babel-execute-src-block' on every source block in the current buffer." (interactive "P") (org-babel-eval-wipe-error-buffer) (org-save-outline-visibility t (org-babel-map-executables nil - (if (memq (org-element-type (org-element-context)) - '(babel-call inline-babel-call)) + (if (org-element-type-p + (org-element-context) '(babel-call inline-babel-call)) (org-babel-lob-execute-maybe) (org-babel-execute-src-block arg))))) @@ -1323,7 +1431,7 @@ the current buffer." (defun org-babel-execute-subtree (&optional arg) "Execute source code blocks in a subtree. Call `org-babel-execute-src-block' on every source block in -the current subtree." +the current subtree, passing over the prefix argument ARG." (interactive "P") (save-restriction (save-excursion @@ -1391,9 +1499,9 @@ CONTEXT specifies the context of evaluation. It can be `:eval', (when (called-interactively-p 'interactive) (message hash)) hash)))) -(defun org-babel-current-result-hash (&optional info) +(defun org-babel-current-result-hash (&optional _info) "Return the current in-buffer hash." - (let ((result (org-babel-where-is-src-block-result nil info))) + (let ((result (org-babel-where-is-src-block-result nil))) (when result (org-with-point-at result (let ((case-fold-search t)) (looking-at org-babel-result-regexp)) @@ -1477,14 +1585,16 @@ portions of results lines." (progn (org-babel-hide-result-toggle) t)))) (defun org-babel-hide-result-toggle (&optional force) - "Toggle the visibility of the current result." + "Toggle the visibility of the current result. +When FORCE is symbol `off', unconditionally display the result. +Otherwise, when FORCE is non-nil, unconditionally hide the result." (interactive) (save-excursion - (beginning-of-line) + (forward-line 0) (let ((case-fold-search t)) (unless (re-search-forward org-babel-result-regexp nil t) (error "Not looking at a result line"))) - (let ((start (progn (beginning-of-line 2) (1- (point)))) + (let ((start (progn (forward-line 1) (1- (point)))) (end (progn (while (looking-at org-babel-multi-line-header-regexp) (forward-line 1)) @@ -1622,7 +1732,8 @@ balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)." (nreverse result)))) (defun org-babel-join-splits-near-ch (ch list) - "Join splits where \"=\" is on either end of the split." + "Join strings in LIST where CH is on either end of the strings. +This function will join list elements like \"a=\" \"2\" into \"a=2\"." (let ((last= (lambda (str) (= ch (aref str (1- (length str)))))) (first= (lambda (str) (= ch (aref str 0))))) (reverse @@ -1659,13 +1770,17 @@ in parameters. Return an alist." This allows expression of multiple variables with one :var as shown below. -#+PROPERTY: var foo=1, bar=2" +#+PROPERTY: var foo=1, bar=2 + +HEADER-ARGUMENTS is alist of all the arguments." (let (results) (mapc (lambda (pair) (if (eq (car pair) :var) - (mapcar (lambda (v) (push (cons :var (org-trim v)) results)) - (org-babel-join-splits-near-ch - 61 (org-babel-balanced-split (cdr pair) 32))) + (or + (mapcar (lambda (v) (push (cons :var (org-trim v)) results)) + (org-babel-join-splits-near-ch + 61 (org-babel-balanced-split (or (cdr pair) "") 32))) + (push `(:var) results)) (push pair results))) header-arguments) (nreverse results))) @@ -1719,6 +1834,8 @@ shown below. 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." + ;; Skip over leading hlines. + (while (eq 'hline (car table)) (pop table)) (if (eq 'hline (nth 1 table)) (cons (cddr table) (car table)) (cons (cdr table) (car table)))) @@ -1780,9 +1897,16 @@ of the vars, cnames and rnames." (when (and (not (equal colnames "no")) ;; Compatibility note: avoid `length>', which ;; isn't available until Emacs 28. - (or colnames (and (> (length (cdr var)) 1) - (eq (nth 1 (cdr var)) 'hline) - (not (member 'hline (cddr (cdr var))))))) + (or colnames + ;; :colnames nil (default) + ;; Auto-assign column names when the table + ;; has hline as the second line after + ;; non-hline row. + (and (> (length (cdr var)) 1) + (not (eq (car (cdr var)) 'hline)) ; first row + (eq (nth 1 (cdr var)) 'hline) ; second row + (not (member 'hline (cddr (cdr var)))) ; other rows + ))) (let ((both (org-babel-get-colnames (cdr var)))) (setq cnames (cons (cons (car var) (cdr both)) cnames)) @@ -1818,18 +1942,18 @@ its current beginning instead. Return the point at the beginning of the current source block. Specifically at the beginning of the #+BEGIN_SRC line. Also set -match-data relatively to `org-babel-src-block-regexp', which see. +`match-data' relatively to `org-babel-src-block-regexp', which see. If the point is not on a source block or within blank lines after an src block, then return nil." (let ((element (or src-block (org-element-at-point)))) - (when (eq (org-element-type element) 'src-block) - (let ((end (org-element-property :end element))) + (when (org-element-type-p element 'src-block) + (let ((end (org-element-end element))) (org-with-wide-buffer ;; Ensure point is not on a blank line after the block. - (beginning-of-line) + (forward-line 0) (skip-chars-forward " \r\t\n" end) (when (< (point) end) - (prog1 (goto-char (org-element-property :post-affiliated element)) + (prog1 (goto-char (org-element-post-affiliated element)) (looking-at org-babel-src-block-regexp)))))))) ;;;###autoload @@ -1841,7 +1965,7 @@ src block, then return nil." ;;;###autoload (defun org-babel-goto-named-src-block (name) - "Go to a named source-code block." + "Go to a source-code block with NAME." (interactive (let ((completion-ignore-case t) (case-fold-search t) @@ -1894,14 +2018,14 @@ to `org-babel-named-src-block-regexp'." (names nil)) (while (re-search-forward regexp nil t) (let ((element (org-element-at-point))) - (when (eq 'src-block (org-element-type element)) + (when (org-element-type-p element 'src-block) (let ((name (org-element-property :name element))) (when name (push name names)))))) names)))) ;;;###autoload (defun org-babel-goto-named-result (name) - "Go to a named result." + "Go to a result with NAME." (interactive (let ((completion-ignore-case t)) (list (completing-read "Source-block name: " @@ -1925,9 +2049,9 @@ buffer or nil if no such result exists." (catch :found (while (re-search-forward re nil t) (let ((element (org-element-at-point))) - (when (or (eq (org-element-type element) 'keyword) + (when (or (org-element-type-p element 'keyword) (< (point) - (org-element-property :post-affiliated element))) + (org-element-post-affiliated element))) (throw :found (line-beginning-position))))))))) (defun org-babel-result-names (&optional file) @@ -1968,48 +2092,86 @@ With optional prefix argument ARG, jump backward ARG many source blocks." (goto-char (match-beginning 5))))) (defun org-babel-demarcate-block (&optional arg) - "Wrap or split the code in the region or on the point. + "Wrap or split the code in an active region or at point. + +With prefix argument ARG, also create a new heading at point. + When called from inside of a code block the current block is split. When called from outside of a code block a new code block is created. In both cases if the region is demarcated and if the region is not active then the point is demarcated. When called within blank lines after a code block, create a new code -block of the same language with the previous." +block of the same language as the previous." (interactive "P") (let* ((info (org-babel-get-src-block-info 'no-eval)) (start (org-babel-where-is-src-block-head)) ;; `start' will be nil when within space lines after src block. (block (and start (match-string 0))) - (headers (and start (match-string 4))) + (body-beg (and start (match-beginning 5))) + (body-end (and start (match-end 5))) (stars (concat (make-string (or (org-current-level) 1) ?*) " ")) (upper-case-p (and block (let (case-fold-search) (string-match-p "#\\+BEGIN_SRC" block))))) (if (and info start) ;; At src block, but not within blank lines after it. - (mapc - (lambda (place) - (save-excursion - (goto-char place) - (let ((lang (nth 0 info)) - (indent (make-string (org-current-text-indentation) ?\s))) - (when (string-match "^[[:space:]]*$" - (buffer-substring (line-beginning-position) - (line-end-position))) - (delete-region (line-beginning-position) (line-end-position))) - (insert (concat - (if (looking-at "^") "" "\n") - indent (if upper-case-p "#+END_SRC\n" "#+end_src\n") - (if arg stars indent) "\n" - indent (if upper-case-p "#+BEGIN_SRC " "#+begin_src ") - lang - (if (> (length headers) 1) - (concat " " headers) headers) - (if (looking-at "[\n\r]") - "" - (concat "\n" (make-string (current-column) ? ))))))) - (move-end-of-line 2)) - (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>)) + (let* ((copy (org-element-copy (org-element-at-point))) + (before (org-element-begin copy)) + (beyond (org-element-end copy)) + (parts + (if (org-region-active-p) + (list body-beg (region-beginning) (region-end) body-end) + (list body-beg (point) body-end))) + (pads ;; To calculate left-side white-space padding. + (if (org-region-active-p) + (list (region-beginning) (region-end)) + (list (point)))) + (n (- (length parts) 2)) ;; 1 or 2 parts in `dolist' below. + ;; `post-blank' caches the property before setting it to 0. + (post-blank (org-element-property :post-blank copy))) + ;; Point or region are within body when parts is in increasing order. + (unless (apply #'<= parts) + (user-error "Select within the source block body to split it")) + (setq parts (mapcar (lambda (p) (buffer-substring (car p) (cdr p))) + (seq-mapn #'cons parts (cdr parts)))) + ;; Map positions to columns for white-space padding. + (setq pads (mapcar (lambda (p) (save-excursion + (goto-char p) + (current-column))) + pads)) + (push 0 pads) ;; The 1st part never requires white-space padding. + (setq parts (mapcar (lambda (p) (string-join + (list (make-string (car p) ?\s) + (cdr p)))) + (seq-mapn #'cons pads parts))) + (delete-region before beyond) + ;; Set `:post-blank' to 0. We take care of spacing between blocks. + (org-element-put-property copy :post-blank 0) + (org-element-put-property copy :value (car parts)) + (insert (org-element-interpret-data copy)) + ;; `org-indent-block' may see another `org-element' (e.g. paragraph) + ;; immediately after the block. Ensure to indent the inserted block + ;; and move point to its end. + (org-babel-previous-src-block 1) + (org-indent-block) + (goto-char (org-element-end (org-element-at-point))) + (org-element-put-property copy :caption nil) + (org-element-put-property copy :name nil) + ;; Insert the 2nd block, and the 3rd block when region is active. + (dolist (part (cdr parts)) + (org-element-put-property copy :value part) + (insert (if arg (concat stars "\n") "\n")) + (cl-decf n) + (when (= n 0) + ;; Use `post-blank' to reset the property of the last block. + (org-element-put-property copy :post-blank post-blank)) + (insert (org-element-interpret-data copy)) + ;; Ensure to indent the inserted block and move point to its end. + (org-babel-previous-src-block 1) + (org-indent-block) + (goto-char (org-element-end (org-element-at-point)))) + ;; Leave point at the last inserted block. + (goto-char (org-babel-previous-src-block 1))) (let ((start (point)) (lang (or (car info) ; Reuse language from previous block. (completing-read @@ -2059,7 +2221,7 @@ the results hash, or nil. Leave point before the keyword." ;; ;; : fixed-width area, unrelated to the above. (unless (looking-at "^[ \t]*$") (save-excursion (insert "\n"))) - (beginning-of-line 0) + (forward-line -1) (when hash (org-babel-hide-hash))) (defun org-babel--clear-results-maybe (hash) @@ -2074,11 +2236,11 @@ leave point where new results should be inserted." (let ((case-fold-search t)) (looking-at org-babel-result-regexp)) (unless (string= (match-string 1) hash) (let* ((e (org-element-at-point)) - (post (copy-marker (org-element-property :post-affiliated e)))) + (post (copy-marker (org-element-post-affiliated e)))) ;; Delete contents. (delete-region post (save-excursion - (goto-char (org-element-property :end e)) + (goto-char (org-element-end e)) (skip-chars-backward " \t\n") (line-beginning-position 2))) ;; Delete RESULT keyword. However, if RESULTS keyword is @@ -2113,32 +2275,29 @@ to HASH." ((or `inline-babel-call `inline-src-block) ;; Results for inline objects are located right after them. ;; There is no RESULTS line to insert either. - (let ((limit (pcase (org-element-type (org-element-property :parent context)) - (`section (org-element-property - :end (org-element-property :parent context))) - (_ (org-element-property - :contents-end (org-element-property :parent context)))))) - (goto-char (org-element-property :end context)) + (let ((limit (or (org-element-contents-end (org-element-parent context)) + (org-element-end (org-element-parent context))))) + (goto-char (org-element-end context)) (skip-chars-forward " \t\n" limit) (throw :found (and (< (point) limit) (let ((result (org-element-context))) - (and (eq (org-element-type result) 'macro) + (and (org-element-type-p result 'macro) (string= (org-element-property :key result) "results") (if (not insert) (point) (delete-region (point) (progn - (goto-char (org-element-property :end result)) + (goto-char (org-element-end result)) (skip-chars-backward " \t") (point))) (point)))))))) ((or `babel-call `src-block) (let* ((name (org-element-property :name context)) (named-results (and name (org-babel-find-named-result name)))) - (goto-char (or named-results (org-element-property :end context))) + (goto-char (or named-results (org-element-end context))) (cond ;; Existing results named after the current source. (named-results @@ -2150,23 +2309,23 @@ to HASH." ;; No possible anonymous results at the very end of ;; buffer or outside CONTEXT parent. ((eq (point) - (or (pcase (org-element-type (org-element-property :parent context)) - ((or `section `org-data) (org-element-property - :end (org-element-property :parent context))) - (_ (org-element-property - :contents-end (org-element-property :parent context)))) + (or (pcase (org-element-type (org-element-parent context)) + ((or `section `org-data) + (org-element-end (org-element-parent context))) + (_ (org-element-contents-end + (org-element-parent context)))) (point-max)))) ;; Check if next element is an anonymous result below ;; the current block. ((let* ((next (org-element-at-point)) (end (save-excursion (goto-char - (org-element-property :post-affiliated next)) + (org-element-post-affiliated next)) (line-end-position))) (empty-result-re (concat org-babel-result-regexp "$")) (case-fold-search t)) (re-search-forward empty-result-re end t)) - (beginning-of-line) + (forward-line 0) (when (org-babel--clear-results-maybe hash) (org-babel--insert-results-keyword nil hash)) (throw :found (point)))))) @@ -2177,7 +2336,7 @@ to HASH." ;; after the previous element. (when insert (save-excursion - (goto-char (min (org-element-property :end context) (point-max))) + (goto-char (min (org-element-end context) (point-max))) (skip-chars-backward " \t\n") (forward-line) (unless (bolp) (insert "\n")) @@ -2190,7 +2349,7 @@ to HASH." "Read ELEMENT into emacs-lisp. Return nil if ELEMENT cannot be read." (org-with-wide-buffer - (goto-char (org-element-property :post-affiliated element)) + (goto-char (org-element-post-affiliated element)) (pcase (org-element-type element) (`fixed-width (let ((v (org-trim (org-element-property :value element)))) @@ -2199,9 +2358,7 @@ Return nil if ELEMENT cannot be read." (`plain-list (org-babel-read-list)) ((or `example-block `src-block) (let ((v (org-element-property :value element))) - (if (or org-src-preserve-indentation - (org-element-property :preserve-indent element)) - v + (if (org-src-preserve-indentation-p element) v (org-remove-indentation v)))) (`export-block (org-remove-indentation (org-element-property :value element))) @@ -2212,24 +2369,24 @@ Return nil if ELEMENT cannot be read." (save-excursion (goto-char (match-end 0)) (skip-chars-forward " \r\t\n") - (<= (org-element-property :end element) + (<= (org-element-end element) (point)))) (org-babel-read-link) (buffer-substring-no-properties - (org-element-property :contents-begin element) - (org-element-property :contents-end element)))) + (org-element-contents-begin element) + (org-element-contents-end element)))) ((or `center-block `quote-block `verse-block `special-block) (org-remove-indentation (buffer-substring-no-properties - (org-element-property :contents-begin element) - (org-element-property :contents-end element)))) + (org-element-contents-begin element) + (org-element-contents-end element)))) (_ nil)))) (defun org-babel-read-result () "Read the result at point into emacs-lisp." (and (not (save-excursion - (beginning-of-line) - (looking-at-p "[ \t]*$"))) + (forward-line 0) + (looking-at-p "[ \t]*$"))) (org-babel-read-element (org-element-at-point)))) (defun org-babel-read-table () @@ -2269,7 +2426,9 @@ If the path of the link is a file path it is expanded using (t raw)))) (defun org-babel-format-result (result &optional sep) - "Format RESULT for writing to file." + "Format RESULT for writing to file. +When RESULT is a list, write it as a table, use tab or SEP as column +separator." (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r))))) (if (listp result) ;; table result @@ -2301,7 +2460,7 @@ silent -- no results are inserted into the Org buffer but process). none ---- no results are inserted into the Org buffer nor - echoed to the minibuffer. they are not processed into + echoed to the minibuffer. They are not processed into Emacs-lisp objects at all. file ---- the results are interpreted as a file path, and are @@ -2372,12 +2531,13 @@ INFO may provide the values of these header arguments (in the (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result) (let ((inline (let ((context (org-element-context))) - (and (memq (org-element-type context) - '(inline-babel-call inline-src-block)) + (and (org-element-type-p + context '(inline-babel-call inline-src-block)) context)))) (when inline (let ((warning (or (and (member "table" result-params) "`:results table'") + (and (member "drawer" result-params) "`:results drawer'") (and result (listp result) "list result") (and result (string-match-p "\n." result) "multiline result") (and (member "list" result-params) "`:results list'")))) @@ -2386,10 +2546,6 @@ INFO may provide the values of these header arguments (in the (save-excursion (let* ((visible-beg (point-min-marker)) (visible-end (copy-marker (point-max) t)) - (inline (let ((context (org-element-context))) - (and (memq (org-element-type context) - '(inline-babel-call inline-src-block)) - context))) (existing-result (org-babel-where-is-src-block-result t nil hash)) (results-switches (cdr (assq :results_switches (nth 2 info)))) ;; When results exist outside of the current visible @@ -2409,7 +2565,7 @@ INFO may provide the values of these header arguments (in the (progn (when outside-scope (widen)) (if existing-result (goto-char existing-result) - (goto-char (org-element-property :end inline)) + (goto-char (org-element-end inline)) (skip-chars-backward " \t")) (unless inline (setq indent (current-indentation)) @@ -2620,7 +2776,10 @@ INFO may provide the values of these header arguments (in the (set-marker visible-end nil))))))) (defun org-babel-remove-result (&optional info keep-keyword) - "Remove the result of the current source block." + "Remove the result of the current source block. +INFO argument is currently ignored. +When KEEP-KEYWORD is non-nil, keep the #+RESULT keyword and just remove +the rest of the result." (interactive) (let ((location (org-babel-where-is-src-block-result nil info)) (case-fold-search t)) @@ -2636,35 +2795,35 @@ INFO may provide the values of these header arguments (in the (progn (forward-line) (org-babel-result-end)))))))) (defun org-babel-remove-inline-result (&optional datum) - "Remove the result of the current inline-src-block or babel call. + "Remove the result of DATUM or the current inline-src-block or babel call. The result must be wrapped in a `results' macro to be removed. Leading white space is trimmed." (interactive) (let* ((el (or datum (org-element-context)))) - (when (memq (org-element-type el) '(inline-src-block inline-babel-call)) + (when (org-element-type-p el '(inline-src-block inline-babel-call)) (org-with-wide-buffer - (goto-char (org-element-property :end el)) + (goto-char (org-element-end el)) (skip-chars-backward " \t") (let ((result (save-excursion (skip-chars-forward " \t\n" - (org-element-property - :contents-end (org-element-property :parent el))) + (org-element-contents-end + (org-element-parent el))) (org-element-context)))) - (when (and (eq (org-element-type result) 'macro) + (when (and (org-element-type-p result 'macro) (string= (org-element-property :key result) "results")) (delete-region ; And leading whitespace. (point) - (progn (goto-char (org-element-property :end result)) + (progn (goto-char (org-element-end result)) (skip-chars-backward " \t\n") (point))))))))) -(defun org-babel-remove-result-one-or-many (x) +(defun org-babel-remove-result-one-or-many (arg) "Remove the result of the current source block. -If called with a prefix argument, remove all result blocks -in the buffer." +If called with prefix argument ARG, remove all result blocks in the +buffer." (interactive "P") - (if x + (if arg (org-babel-map-src-blocks nil (org-babel-remove-result)) (org-babel-remove-result))) @@ -2675,14 +2834,15 @@ in the buffer." (line-beginning-position 2)) (t (let ((element (org-element-at-point))) - (if (memq (org-element-type element) - ;; Possible results types. - '(drawer example-block export-block fixed-width - special-block src-block item plain-list table - latex-environment)) + (if (org-element-type-p + element + ;; Possible results types. + '(drawer example-block export-block fixed-width + special-block src-block item plain-list table + latex-environment)) (save-excursion (goto-char (min (point-max) ;for narrowed buffers - (org-element-property :end element))) + (org-element-end element))) (skip-chars-backward " \r\t\n") (line-beginning-position 2)) (point)))))) @@ -2698,7 +2858,7 @@ specified as an an \"attachment:\" style link." (when (stringp result) (let* ((result-file-name (expand-file-name result)) (base-file-name (buffer-file-name (buffer-base-buffer))) - (base-directory (and buffer-file-name + (base-directory (and base-file-name (file-name-directory base-file-name))) (same-directory? (and base-file-name @@ -2735,7 +2895,10 @@ specified as an an \"attachment:\" style link." (if description (concat "[" description "]") ""))))) (defun org-babel-examplify-region (beg end &optional results-switches inline) - "Comment out region using the inline `==' or `: ' org example quote." + "Comment out region BEG..END using the inline `==' or `: ' org example quote. +When INLINE is non-nil, use the inline verbatim markup. +When INLINE is nil and RESULTS-SWITCHES is non-nil, RESULTS-SWITCHES is +used as a string to be appended to #+begin_example line." (interactive "*r") (let ((maybe-cap (lambda (str) @@ -2751,7 +2914,7 @@ specified as an an \"attachment:\" style link." ((< size org-babel-min-lines-for-block-output) (goto-char beg) (dotimes (_ size) - (beginning-of-line 1) (insert ": ") (forward-line 1))) + (forward-line 0) (insert ": ") (forward-line 1))) (t (goto-char beg) (insert (if results-switches @@ -2767,15 +2930,13 @@ specified as an an \"attachment:\" style link." (defun org-babel-update-block-body (new-body) "Update the body of the current code block to NEW-BODY." (let ((element (org-element-at-point))) - (unless (eq (org-element-type element) 'src-block) + (unless (org-element-type-p element 'src-block) (error "Not in a source block")) (goto-char (org-babel-where-is-src-block-head element)) (let* ((ind (org-current-text-indentation)) (body-start (line-beginning-position 2)) (body (org-element-normalize-string - (if (or org-src-preserve-indentation - (org-element-property :preserve-indent element)) - new-body + (if (org-src-preserve-indentation-p element) new-body (with-temp-buffer (insert (org-remove-indentation new-body)) (indent-rigidly @@ -2785,7 +2946,7 @@ specified as an an \"attachment:\" style link." (buffer-string)))))) (delete-region body-start (org-with-wide-buffer - (goto-char (org-element-property :end element)) + (goto-char (org-element-end element)) (skip-chars-backward " \t\n") (line-beginning-position))) (goto-char body-start) @@ -2920,6 +3081,12 @@ See `org-babel-expand-noweb-references--cache'.") (defun org-babel-expand-noweb-references (&optional info parent-buffer) "Expand Noweb references in the body of the current source code block. +When optional argument INFO is non-nil, use the block defined by INFO +instead. + +The block is assumed to be located in PARENT-BUFFER or current buffer +\(when PARENT-BUFFER is nil). + For example the following reference would be replaced with the body of the source-code block named `example-block'. @@ -2969,47 +3136,47 @@ block but are passed literally to the \"example-block\"." (with-current-buffer parent-buffer (buffer-chars-modified-tick))))) (cl-macrolet ((c-wrap - (s) - ;; Comment string S, according to LANG mode. Return new - ;; string. - `(unless org-babel-tangle-uncomment-comments - (with-temp-buffer - (funcall (org-src-get-lang-mode lang)) - (comment-region (point) - (progn (insert ,s) (point))) - (org-trim (buffer-string))))) + (s) + ;; Comment string S, according to LANG mode. Return new + ;; string. + `(unless org-babel-tangle-uncomment-comments + (with-temp-buffer + (funcall (org-src-get-lang-mode lang)) + (comment-region (point) + (progn (insert ,s) (point))) + (org-trim (buffer-string))))) (expand-body - (i) - ;; Expand body of code represented by block info I. - `(let ((b (if (org-babel-noweb-p (nth 2 ,i) :eval) - (org-babel-expand-noweb-references ,i) - (nth 1 ,i)))) - (if (not comment) b - (let ((cs (org-babel-tangle-comment-links ,i))) - (concat (c-wrap (car cs)) "\n" - b "\n" - (c-wrap (cadr cs))))))) + (i) + ;; Expand body of code represented by block info I. + `(let ((b (if (org-babel-noweb-p (nth 2 ,i) :eval) + (org-babel-expand-noweb-references ,i) + (nth 1 ,i)))) + (if (not comment) b + (let ((cs (org-babel-tangle-comment-links ,i))) + (concat (c-wrap (car cs)) "\n" + b "\n" + (c-wrap (cadr cs)) "\n"))))) (expand-references - (ref) - `(pcase (gethash ,ref org-babel-expand-noweb-references--cache) - (`(,last . ,previous) - ;; Ignore separator for last block. - (let ((strings (list (expand-body last)))) - (dolist (i previous) - (let ((parameters (nth 2 i))) - ;; Since we're operating in reverse order, first - ;; push separator, then body. - (push (or (cdr (assq :noweb-sep parameters)) "\n") - strings) - (push (expand-body i) strings))) - (mapconcat #'identity strings ""))) - ;; Raise an error about missing reference, or return the - ;; empty string. - ((guard (or org-babel-noweb-error-all-langs - (member lang org-babel-noweb-error-langs))) - (error "Cannot resolve %s (see `org-babel-noweb-error-langs')" - (org-babel-noweb-wrap ,ref))) - (_ "")))) + (ref) + `(pcase (gethash ,ref org-babel-expand-noweb-references--cache) + (`(,last . ,previous) + ;; Ignore separator for last block. + (let ((strings (list (expand-body last)))) + (dolist (i previous) + (let ((parameters (nth 2 i))) + ;; Since we're operating in reverse order, first + ;; push separator, then body. + (push (or (cdr (assq :noweb-sep parameters)) "\n") + strings) + (push (expand-body i) strings))) + (mapconcat #'identity strings ""))) + ;; Raise an error about missing reference, or return the + ;; empty string. + ((guard (or org-babel-noweb-error-all-langs + (member lang org-babel-noweb-error-langs))) + (error "Cannot resolve %s (see `org-babel-noweb-error-langs')" + (org-babel-noweb-wrap ,ref))) + (_ "")))) (replace-regexp-in-string noweb-re (lambda (m) @@ -3193,10 +3360,22 @@ situations in which is it not appropriate." (string= cell "*this*"))) ;; FIXME: Arbitrary code evaluation. (eval (read cell) t)) - ((save-match-data - (and (string-match "^[[:space:]]*\"\\(.*\\)\"[[:space:]]*$" cell) - (not (string-match "[^\\]\"" (match-string 1 cell))))) - (read cell)) + ((let (read-val) + (and (string-match-p + (rx bos (0+ (any space ?\n)) + ?\" (0+ anychar) ?\" + (0+ (any space ?\n)) eos) + cell) + ;; CELL is a single string + (with-temp-buffer + (insert cell) + (goto-char 1) + (when (setq read-val + (ignore-errors + (read (current-buffer)))) + (skip-chars-forward "[:space:]") + (eobp))) + read-val))) (t (org-no-properties cell)))) (defun org-babel--string-to-number (string) @@ -3210,7 +3389,8 @@ Otherwise return nil." (defun org-babel-import-elisp-from-file (file-name &optional separator) "Read the results located at FILE-NAME into an elisp table. -If the table is trivial, then return it as a scalar." +If the table is trivial, then return it as a scalar. +SEPARATOR is passed to `org-table-convert-region', which see." (let ((result (with-temp-buffer (condition-case err @@ -3221,7 +3401,9 @@ If the table is trivial, then return it as a scalar." ;; If the file was empty, don't bother trying to ;; convert the table. (when (> pmax 1) - (org-table-convert-region (point-min) pmax separator) + (org-table-convert-region + (point-min) pmax + (or separator 'babel-auto)) (delq nil (mapcar (lambda (row) (and (not (eq row 'hline)) @@ -3239,7 +3421,8 @@ If the table is trivial, then return it as a scalar." (_ result)))) (defun org-babel-string-read (cell) - "Strip nested \"s from around strings." + "Strip nested \"s from around CELL string. +When CELL is not a string, return CELL." (org-babel-read (or (and (stringp cell) (string-match "^[[:space:]]*\"\\(.+\\)\"[[:space:]]*$" cell) (match-string 1 cell)) @@ -3291,7 +3474,10 @@ Emacs shutdown.") :type 'string) (defmacro org-babel-result-cond (result-params scalar-form &rest table-forms) - "Call the code to parse raw string results according to RESULT-PARAMS." + "Call the code to parse raw string results according to RESULT-PARAMS. +Do nothing with :results discard. +Execute SCALAR-FORM when result should be treated as a string. +Execute TABLE-FORMS when result should be considered sexp and parsed." (declare (indent 1) (debug t)) (org-with-gensyms (params) `(let ((,params ,result-params)) @@ -3323,8 +3509,8 @@ Emacs shutdown.") (defun org-babel-temp-file (prefix &optional suffix) "Create a temporary file in the `org-babel-temporary-directory'. Passes PREFIX and SUFFIX directly to `make-temp-file' with the -value of `temporary-file-directory' temporarily set to the value -of `org-babel-temporary-directory'." +value of function `temporary-file-directory' temporarily set to the +value of `org-babel-temporary-directory'." (make-temp-file (concat (file-name-as-directory (org-babel-temp-directory)) prefix) nil @@ -3338,13 +3524,13 @@ of `org-babel-temporary-directory'." (defun org-babel-temp-stable-file (data prefix &optional suffix) "Create a temporary file in the `org-babel-remove-temporary-stable-directory'. The file name is stable with respect to DATA. The file name is -constructed like the following: PREFIXDATAhashSUFFIX." +constructed like the following: ." (let ((path (format "%s%s%s%s" (file-name-as-directory (org-babel-temp-stable-directory)) prefix - (sxhash data) + (org-sxhash-safe data) (or suffix "")))) ;; Create file. (with-temp-file path) diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el index 4806d80c5b8..68f2e1f2556 100644 --- a/lisp/org/ob-css.el +++ b/lisp/org/ob-css.el @@ -36,7 +36,7 @@ (defvar org-babel-default-header-args:css '()) (defun org-babel-execute:css (body _params) - "Execute a block of CSS code. + "Execute BODY of CSS code. This function is called by `org-babel-execute-src-block'." body) diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el index b8ead656fac..ba8e65394f9 100644 --- a/lisp/org/ob-ditaa.el +++ b/lisp/org/ob-ditaa.el @@ -83,11 +83,11 @@ Do not leave leading or trailing spaces in this string." :type 'string) (defun org-babel-execute:ditaa (body params) - "Execute a block of Ditaa code with org-babel. + "Execute BODY of Ditaa code with org-babel according to PARAMS. This function is called by `org-babel-execute-src-block'." (let* ((out-file (or (cdr (assq :file params)) (error - "ditaa code block requires :file header argument"))) + "Ditaa code block requires :file header argument"))) (cmdline (cdr (assq :cmdline params))) (java (cdr (assq :java params))) (in-file (org-babel-temp-file "ditaa-")) diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el index ed2955ba512..5a3239516f0 100644 --- a/lisp/org/ob-dot.el +++ b/lisp/org/ob-dot.el @@ -51,7 +51,9 @@ (defun org-babel-expand-body:dot (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (org-babel--get-vars params))) + (let ((vars (org-babel--get-vars params)) + (prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params)))) (mapc (lambda (pair) (let ((name (symbol-name (car pair))) @@ -64,10 +66,13 @@ t t)))) vars) - body)) + (concat + (and prologue (concat prologue "\n")) + body + (and epilogue (concat "\n" epilogue "\n"))))) (defun org-babel-execute:dot (body params) - "Execute a block of Dot code with org-babel. + "Execute Dot BODY with org-babel according to PARAMS. This function is called by `org-babel-execute-src-block'." (let* ((out-file (cdr (or (assq :file params) (error "You need to specify a :file parameter")))) diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index 2adb6725c3c..e89bbae8cb9 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -53,18 +53,23 @@ by `org-edit-src-code'.") "Expand BODY according to PARAMS, return the expanded body." (let ((vars (org-babel--get-vars params)) (print-level nil) - (print-length nil)) + (print-length nil) + (prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params)))) (if (null vars) (concat body "\n") - (format "(let (%s)\n%s\n)" + (format "(let (%s)\n%s%s%s\n)" (mapconcat (lambda (var) (format "%S" `(,(car var) ',(cdr var)))) vars "\n ") - body)))) + (if prologue (concat prologue "\n ") "") + body + (if epilogue (concat "\n " epilogue "\n") ""))))) (defun org-babel-execute:emacs-lisp (body params) - "Execute a block of emacs-lisp code with Babel." + "Execute emacs-lisp code BODY according to PARAMS." (let* ((lexical (cdr (assq :lexical params))) + (session (cdr (assq :session params))) (result-params (cdr (assq :result-params params))) (body (format (if (member "output" result-params) "(with-output-to-string %s\n)" @@ -75,6 +80,8 @@ by `org-edit-src-code'.") (concat "(pp " body ")") body)) (org-babel-emacs-lisp-lexical lexical)))) + (when (and session (not (equal session "none"))) + (error "ob-emacs-lisp backend does not support sessions")) (org-babel-result-cond result-params (let ((print-level nil) (print-length nil)) @@ -100,12 +107,17 @@ and the LEXICAL argument to `eval'." (defun org-babel-edit-prep:emacs-lisp (info) "Set `lexical-binding' in Org edit buffer. Set `lexical-binding' in Org edit buffer according to the -corresponding :lexical source block argument." +corresponding :lexical source block argument provide in the INFO +channel, as returned by `org-babel-get-src-block-info'." (setq lexical-binding (org-babel-emacs-lisp-lexical (org-babel-read (cdr (assq :lexical (nth 2 info))))))) +(defun org-babel-prep-session:emacs-lisp (_session _params) + "Return an error because we do not support sessions." + (error "ob-emacs-lisp backend does not support sessions")) + (org-babel-make-language-alias "elisp" "emacs-lisp") (provide 'ob-emacs-lisp) diff --git a/lisp/org/ob-eshell.el b/lisp/org/ob-eshell.el index eefb43dc1a9..940e5d76032 100644 --- a/lisp/org/ob-eshell.el +++ b/lisp/org/ob-eshell.el @@ -95,10 +95,11 @@ The PARAMS argument is passed to session)) (defun org-babel-variable-assignments:eshell (params) - "Convert ob-eshell :var specified variables into Eshell variables assignments." + "Convert ob-eshell variables from PARAMS into Eshell variables assignments." (mapcar (lambda (pair) - (format "(setq %s %S)" (car pair) (cdr pair))) + ;; Use `ignore' to suppress value in the command output. + (format "(ignore (setq %s %S))" (car pair) (cdr pair))) (org-babel--get-vars params))) (defun org-babel-load-session:eshell (session body params) diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el index 62c558642a0..64673938718 100644 --- a/lisp/org/ob-eval.el +++ b/lisp/org/ob-eval.el @@ -37,16 +37,21 @@ (declare-function org-babel-temp-file "ob-core" (prefix &optional suffix)) (defun org-babel-eval-error-notify (exit-code stderr) - "Open a buffer to display STDERR and a message with the value of EXIT-CODE." + "Open a buffer to display STDERR and a message with the value of EXIT-CODE. +If EXIT-CODE is nil, display the message without a code." (let ((buf (get-buffer-create org-babel-error-buffer-name))) (with-current-buffer buf (goto-char (point-max)) (save-excursion (unless (bolp) (insert "\n")) (insert stderr) - (insert (format "[ Babel evaluation exited with code %S ]" exit-code)))) + (if exit-code + (insert (format "[ Babel evaluation exited with code %S ]" exit-code)) + (insert "[ Babel evaluation exited abnormally ]")))) (display-buffer buf)) - (message "Babel evaluation exited with code %S" exit-code)) + (if exit-code + (message "Babel evaluation exited with code %S" exit-code) + (message "Babel evaluation exited abnormally"))) (defun org-babel-eval (command query) "Run COMMAND on QUERY. @@ -59,6 +64,7 @@ Writes QUERY into a temp-buffer that is processed with (let ((error-buffer (get-buffer-create " *Org-Babel Error*")) exit-code) (with-current-buffer error-buffer (erase-buffer)) (with-temp-buffer + ;; Ensure trailing newline. It is required for cmdproxy.exe. (insert query "\n") (setq exit-code (org-babel--shell-command-on-region @@ -100,11 +106,6 @@ returned." (error-file (if error-buffer (org-babel-temp-file "ob-error-") nil)) (shell-file-name (org-babel--get-shell-file-name)) exit-status) - ;; There is an error in `process-file' when `error-file' exists. - ;; This is fixed in Emacs trunk as of 2012-12-21; let's use this - ;; workaround for now. - (unless (file-remote-p default-directory) - (delete-file error-file)) ;; we always call this with 'replace, remove conditional ;; Replace specified region with output from command. (org-babel--write-temp-buffer-input-file input-file) diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 489ffdb330b..657cb2b5265 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -32,8 +32,10 @@ (declare-function org-babel-lob-get-info "ob-lob" (&optional datum no-eval)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-begin "org-element" (node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) (declare-function org-escape-code-in-string "org-src" (s)) (declare-function org-export-copy-buffer "ox" (&optional buffer drop-visibility @@ -41,8 +43,7 @@ drop-locals)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance element)) (declare-function org-in-archived-heading-p "org" (&optional no-inheritance element)) - -(defvar org-src-preserve-indentation) +(declare-function org-src-preserve-indentation-p "org-src" (node)) (defcustom org-export-use-babel t "Switch controlling code evaluation and header processing during export. @@ -140,217 +141,236 @@ this template." "Execute all Babel blocks in current buffer." (interactive) (when org-export-use-babel - (save-window-excursion - (let ((case-fold-search t) - (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)") - ;; Get a pristine copy of current buffer so Babel - ;; references are properly resolved and source block - ;; context is preserved. - (org-babel-exp-reference-buffer (org-export-copy-buffer)) - element) - (unwind-protect - (save-excursion - ;; First attach to every source block their original - ;; position, so that they can be retrieved within - ;; `org-babel-exp-reference-buffer', even after heavy - ;; modifications on current buffer. - ;; - ;; False positives are harmless, so we don't check if - ;; we're really at some Babel object. Moreover, - ;; `line-end-position' ensures that we propertize - ;; a noticeable part of the object, without affecting - ;; multiple objects on the same line. - (goto-char (point-min)) + (let ((case-fold-search t) + (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)") + ;; Get a pristine copy of current buffer so Babel + ;; references are properly resolved and source block + ;; context is preserved. + (org-babel-exp-reference-buffer (org-export-copy-buffer)) + element) + (unwind-protect + (save-excursion + ;; First attach to every source block their original + ;; position, so that they can be retrieved within + ;; `org-babel-exp-reference-buffer', even after heavy + ;; modifications on current buffer. + ;; + ;; False positives are harmless, so we don't check if + ;; we're really at some Babel object. Moreover, + ;; `line-end-position' ensures that we propertize + ;; a noticeable part of the object, without affecting + ;; multiple objects on the same line. + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let ((s (match-beginning 0))) + (put-text-property s (line-end-position) 'org-reference s))) + ;; Evaluate from top to bottom every Babel block + ;; encountered. + (goto-char (point-min)) + ;; We are about to do a large number of changes in + ;; buffer, but we do not care about folding in this + ;; buffer. + (org-fold-core-ignore-modifications (while (re-search-forward regexp nil t) - (let ((s (match-beginning 0))) - (put-text-property s (line-end-position) 'org-reference s))) - ;; Evaluate from top to bottom every Babel block - ;; encountered. - (goto-char (point-min)) - ;; We are about to do a large number of changes in - ;; buffer, but we do not care about folding in this - ;; buffer. - (org-fold-core-ignore-modifications - (while (re-search-forward regexp nil t) - (setq element (org-element-at-point)) - (unless (save-match-data - (or (org-in-commented-heading-p nil element) - (org-in-archived-heading-p nil element))) - (let* ((object? (match-end 1)) - (element (save-match-data - (if object? - (org-element-context element) - ;; No deep inspection if we're - ;; just looking for an element. - element))) - (type - (pcase (org-element-type element) - ;; Discard block elements if we're looking - ;; for inline objects. False results - ;; happen when, e.g., "call_" syntax is - ;; located within affiliated keywords: - ;; - ;; #+name: call_src - ;; #+begin_src ... - ((and (or `babel-call `src-block) (guard object?)) - nil) - (type type))) - (begin - (copy-marker (org-element-property :begin element))) - (end - (copy-marker - (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (point))))) - (pcase type - (`inline-src-block - (let* ((info - (org-babel-get-src-block-info nil element)) - (params (nth 2 info))) - (setf (nth 1 info) - (if (and (cdr (assq :noweb params)) - (string= "yes" - (cdr (assq :noweb params)))) - (org-babel-expand-noweb-references - info org-babel-exp-reference-buffer) - (nth 1 info))) - (goto-char begin) - (let ((replacement - (org-babel-exp-do-export info 'inline))) - (if (equal replacement "") - ;; Replacement code is empty: remove - ;; inline source block, including extra - ;; white space that might have been - ;; created when inserting results. - (delete-region begin - (progn (goto-char end) - (skip-chars-forward " \t") - (point))) - ;; Otherwise: remove inline source block - ;; but preserve following white spaces. - ;; Then insert value. - (unless (string= replacement - (buffer-substring begin end)) - (delete-region begin end) - (insert replacement)))))) - ((or `babel-call `inline-babel-call) - (org-babel-exp-do-export - (or (org-babel-lob-get-info element) - (user-error "Unknown Babel reference: %s" - (org-element-property :call element))) - 'lob) - (let ((rep - (org-fill-template - org-babel-exp-call-line-template - `(("line" . - ,(org-element-property :value element)))))) - ;; If replacement is empty, completely remove - ;; the object/element, including any extra - ;; white space that might have been created - ;; when including results. - (if (equal rep "") - (delete-region - begin - (progn (goto-char end) - (if (not (eq type 'babel-call)) - (progn (skip-chars-forward " \t") - (point)) - (skip-chars-forward " \r\t\n") - (line-beginning-position)))) - ;; Otherwise, preserve trailing - ;; spaces/newlines and then, insert - ;; replacement string. - (goto-char begin) + (setq element (save-match-data (org-element-at-point))) + (unless (save-match-data + (or (org-in-commented-heading-p nil element) + (org-in-archived-heading-p nil element))) + (let* ((object? (match-end 1)) + (element (save-match-data + (if object? + (org-element-context element) + ;; No deep inspection if we're + ;; just looking for an element. + element))) + (type + (pcase (org-element-type element) + ;; Discard block elements if we're looking + ;; for inline objects. False results + ;; happen when, e.g., "call_" syntax is + ;; located within affiliated keywords: + ;; + ;; #+name: call_src + ;; #+begin_src ... + ((and (or `babel-call `src-block) (guard object?)) + nil) + (type type))) + (begin + (copy-marker (org-element-begin element))) + (end + (copy-marker + (save-excursion + (goto-char (org-element-end element)) + (skip-chars-backward " \r\t\n") + (point))))) + (pcase type + (`inline-src-block + (let* ((info + (org-babel-get-src-block-info nil element)) + (params (nth 2 info))) + (setf (nth 1 info) + (if (and (cdr (assq :noweb params)) + (string= "yes" + (cdr (assq :noweb params)))) + (org-babel-expand-noweb-references + info org-babel-exp-reference-buffer) + (nth 1 info))) + (goto-char begin) + (let ((replacement + (org-babel-exp-do-export info 'inline))) + (cond + ((equal replacement "") + ;; Replacement code is empty: remove + ;; inline source block, including extra + ;; white space that might have been + ;; created when inserting results. + (delete-region begin + (progn (goto-char end) + (skip-chars-forward " \t") + (point)))) + ((not replacement) + ;; Replacement code cannot be determined. + ;; Leave the code block as is. + (goto-char end)) + ;; Otherwise: remove inline source block + ;; but preserve following white spaces. + ;; Then insert value. + ((not (string= replacement + (buffer-substring begin end))) (delete-region begin end) - (insert rep)))) - (`src-block - (let ((match-start (copy-marker (match-beginning 0))) - (ind (org-current-text-indentation))) - ;; Take care of matched block: compute - ;; replacement string. In particular, a nil - ;; REPLACEMENT means the block is left as-is - ;; while an empty string removes the block. - (let ((replacement - (progn (goto-char match-start) - (org-babel-exp-src-block element)))) - (cond ((not replacement) (goto-char end)) - ((equal replacement "") - (goto-char end) - (skip-chars-forward " \r\t\n") - (beginning-of-line) - (delete-region begin (point))) - (t - (if (or org-src-preserve-indentation - (org-element-property - :preserve-indent element)) - ;; Indent only code block - ;; markers. - (with-temp-buffer - ;; Do not use tabs for block - ;; indentation. - (when (fboundp 'indent-tabs-mode) - (indent-tabs-mode -1) - ;; FIXME: Emacs 26 - ;; compatibility. - (setq-local indent-tabs-mode nil)) - (insert replacement) - (skip-chars-backward " \r\t\n") - (indent-line-to ind) - (goto-char 1) - (indent-line-to ind) - (setq replacement (buffer-string))) - ;; Indent everything. - (with-temp-buffer - ;; Do not use tabs for block - ;; indentation. - (when (fboundp 'indent-tabs-mode) - (indent-tabs-mode -1) - ;; FIXME: Emacs 26 - ;; compatibility. - (setq-local indent-tabs-mode nil)) - (insert replacement) - (indent-rigidly - 1 (point) ind) - (setq replacement (buffer-string)))) - (goto-char match-start) - (let ((rend (save-excursion - (goto-char end) - (line-end-position)))) - (if (string-equal replacement - (buffer-substring match-start rend)) - (goto-char rend) - (delete-region match-start - (save-excursion - (goto-char end) - (line-end-position))) - (insert replacement)))))) - (set-marker match-start nil)))) - (set-marker begin nil) - (set-marker end nil)))))) - (kill-buffer org-babel-exp-reference-buffer) - (remove-text-properties (point-min) (point-max) - '(org-reference nil))))))) + (insert replacement)) + ;; Replacement is the same as the source + ;; block. Continue onwards. + (t (goto-char end)))))) + ((or `babel-call `inline-babel-call) + (org-babel-exp-do-export + (or (org-babel-lob-get-info element) + (user-error "Unknown Babel reference: %s" + (org-element-property :call element))) + 'lob) + (let ((rep + (org-fill-template + org-babel-exp-call-line-template + `(("line" . + ,(org-element-property :value element)))))) + ;; If replacement is empty, completely remove + ;; the object/element, including any extra + ;; white space that might have been created + ;; when including results. + (cond + ((equal rep "") + (delete-region + begin + (progn (goto-char end) + (if (not (eq type 'babel-call)) + (progn (skip-chars-forward " \t") + (point)) + (skip-chars-forward " \r\t\n") + (line-beginning-position))))) + ((not rep) + ;; Replacement code cannot be determined. + ;; Leave the code block as is. + (goto-char end)) + (t + ;; Otherwise, preserve trailing + ;; spaces/newlines and then, insert + ;; replacement string. + (goto-char begin) + (delete-region begin end) + (insert rep))))) + (`src-block + (let ((match-start (copy-marker (match-beginning 0))) + (ind (org-current-text-indentation))) + ;; Take care of matched block: compute + ;; replacement string. In particular, a nil + ;; REPLACEMENT means the block is left as-is + ;; while an empty string removes the block. + (let ((replacement + (progn (goto-char match-start) + (org-babel-exp-src-block element)))) + (cond ((not replacement) (goto-char end)) + ((equal replacement "") + (goto-char end) + (skip-chars-forward " \r\t\n") + (forward-line 0) + (delete-region begin (point))) + (t + (if (org-src-preserve-indentation-p element) + ;; Indent only code block + ;; markers. + (with-temp-buffer + ;; Do not use tabs for block + ;; indentation. + (when (fboundp 'indent-tabs-mode) + (indent-tabs-mode -1) + ;; FIXME: Emacs 26 + ;; compatibility. + (setq-local indent-tabs-mode nil)) + (insert replacement) + (skip-chars-backward " \r\t\n") + (indent-line-to ind) + (goto-char 1) + (indent-line-to ind) + (setq replacement (buffer-string))) + ;; Indent everything. + (with-temp-buffer + ;; Do not use tabs for block + ;; indentation. + (when (fboundp 'indent-tabs-mode) + (indent-tabs-mode -1) + ;; FIXME: Emacs 26 + ;; compatibility. + (setq-local indent-tabs-mode nil)) + (insert replacement) + (indent-rigidly + 1 (point) ind) + (setq replacement (buffer-string)))) + (goto-char match-start) + (let ((rend (save-excursion + (goto-char end) + (line-end-position)))) + (if (string-equal replacement + (buffer-substring match-start rend)) + (goto-char rend) + (delete-region match-start + (save-excursion + (goto-char end) + (line-end-position))) + (insert replacement)))))) + (set-marker match-start nil)))) + (set-marker begin nil) + (set-marker end nil)))))) + (kill-buffer org-babel-exp-reference-buffer) + (remove-text-properties (point-min) (point-max) + '(org-reference nil)))))) (defun org-babel-exp-do-export (info type &optional hash) - "Return a string with the exported content of a code block. + "Return a string with the exported content of a code block defined by INFO. +TYPE is the code block type: `block', `inline', or `lob'. HASH is the +result hash. + +Return nil when exported content cannot be determined. + The function respects the value of the :exports header argument." (let ((silently (lambda () (let ((session (cdr (assq :session (nth 2 info))))) - (unless (equal "none" session) - (org-babel-exp-results info type 'silent))))) + (unless (equal "none" session) + (org-babel-exp-results info type 'silent))))) (clean (lambda () (if (eq type 'inline) - (org-babel-remove-inline-result) - (org-babel-remove-result info))))) + (org-babel-remove-inline-result) + (org-babel-remove-result info))))) (pcase (or (cdr (assq :exports (nth 2 info))) "code") ("none" (funcall silently) (funcall clean) "") ("code" (funcall silently) (funcall clean) (org-babel-exp-code info type)) ("results" (org-babel-exp-results info type nil hash) "") ("both" (org-babel-exp-results info type nil hash) - (org-babel-exp-code info type))))) + (org-babel-exp-code info type)) + (unknown-value + (warn "Unknown value of src block parameter :exports %S" unknown-value) + nil)))) (defcustom org-babel-exp-code-template - "#+begin_src %lang%switches%flags\n%body\n#+end_src" + "#+begin_src %lang%switches%header-args\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 @@ -361,17 +381,17 @@ and the following %keys may be used. name ------ the name of the code block body ------ the body of the code block switches -- the switches associated to the code block - flags ----- the flags passed to the code block + header-args the header arguments of 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 - :package-version '(Org . "9.6")) + :package-version '(Org . "9.7")) (defcustom org-babel-exp-inline-code-template - "src_%lang[%switches%flags]{%body}" + "src_%lang[%switches%header-args]{%body}" "Template used to export the body of inline code blocks. This template may be customized to include additional information such as the code block name, or the values of particular header @@ -382,18 +402,17 @@ and the following %keys may be used. name ------ the name of the code block body ------ the body of the code block switches -- the switches associated to the code block - flags ----- the flags passed to the code block + header-args the header arguments of 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 - :version "26.1" - :package-version '(Org . "8.3")) + :package-version '(Org . "9.7")) (defun org-babel-exp-code (info type) - "Return the original code block formatted for export." + "Return the original code block of TYPE defined by INFO, formatted for export." (setf (nth 1 info) (if (string= "strip-export" (cdr (assq :noweb (nth 2 info)))) (replace-regexp-in-string @@ -415,6 +434,11 @@ replaced with its value." (and (org-string-nw-p f) (concat " " f)))) ("flags" . ,(let ((f (assq :flags (nth 2 info)))) (and f (concat " " (cdr f))))) + ("header-args" + . + ,(org-babel-exp--at-source + (when-let ((params (org-element-property :parameters (org-element-context)))) + (concat " " params)))) ,@(mapcar (lambda (pair) (cons (substring (symbol-name (car pair)) 1) (format "%S" (cdr pair)))) @@ -423,6 +447,9 @@ replaced with its value." (defun org-babel-exp-results (info type &optional silent hash) "Evaluate and return the results of the current code block for export. +INFO is as returned by `org-babel-get-src-block-info'. TYPE is the +code block type. HASH is the result hash. + Results are prepared in a manner suitable for export by Org mode. This function is called by `org-babel-exp-do-export'. The code block will be evaluated. Optional argument SILENT can be used to @@ -436,7 +463,8 @@ inhibit insertion of results into the buffer." (info (copy-sequence info)) (org-babel-current-src-block-location (point-marker))) ;; Skip code blocks which we can't evaluate. - (when (fboundp (intern (concat "org-babel-execute:" lang))) + (if (not (fboundp (intern (concat "org-babel-execute:" lang)))) + (warn "org-export: No org-babel-execute function for %s. Not updating exported results." lang) (org-babel-eval-wipe-error-buffer) (setf (nth 1 info) body) (setf (nth 2 info) diff --git a/lisp/org/ob-forth.el b/lisp/org/ob-forth.el index c39cce32f11..07f00c2a1a7 100644 --- a/lisp/org/ob-forth.el +++ b/lisp/org/ob-forth.el @@ -45,7 +45,7 @@ "Default header arguments for forth code blocks.") (defun org-babel-execute:forth (body params) - "Execute a block of Forth code with org-babel. + "Execute Forth BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (if (string= "none" (cdr (assq :session params))) (error "Non-session evaluation not supported for Forth code blocks") @@ -55,7 +55,8 @@ This function is called by `org-babel-execute-src-block'." (car (last all-results)))))) (defun org-babel-forth-session-execute (body params) - (require 'forth-mode) + "Execute Forth BODY in session defined via PARAMS." + (org-require-package 'forth-mode) (let ((proc (forth-proc)) (rx " \\(\n:\\|compiled\n\\|ok\n\\)") (result-start)) diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el index d1bc06b2bd7..f2047d767a0 100644 --- a/lisp/org/ob-fortran.el +++ b/lisp/org/ob-fortran.el @@ -51,7 +51,8 @@ :type 'string) (defun org-babel-execute:fortran (body params) - "This function should only be called by `org-babel-execute:fortran'." + "Execute Fortran BODY according to PARAMS. +This function is called by `org-babel-execute-src-block'." (let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90")) (tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext)) (cmdline (cdr (assq :cmdline params))) @@ -82,9 +83,10 @@ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))) (defun org-babel-expand-body:fortran (body params) - "Expand a block of fortran or fortran code with org-babel according to -its header arguments." + "Expand a fortran BODY according to its header arguments defined in PARAMS." (let ((vars (org-babel--get-vars params)) + (prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params))) (main-p (not (string= (cdr (assq :main params)) "no"))) (includes (or (cdr (assq :includes params)) (org-babel-read (org-entry-get nil "includes" t)))) @@ -107,12 +109,20 @@ its header arguments." (concat ;; variables (mapconcat 'org-babel-fortran-var-to-fortran vars "\n") - body) + (and prologue (concat prologue "\n")) + body + (and prologue (concat prologue "\n"))) params) - body) "\n") "\n"))) + (concat + (and prologue (concat prologue "\n")) + body + (and epilogue (concat "\n" epilogue "\n")))) + "\n") + "\n"))) (defun org-babel-fortran-ensure-main-wrap (body params) - "Wrap body in a \"program ... end program\" block if none exists." + "Wrap BODY in a \"program ... end program\" block if none exists. +Variable assignments are derived from PARAMS." (if (string-match "^[ \t]*program\\>" (capitalize body)) (let ((vars (org-babel--get-vars params))) (when vars (error "Cannot use :vars if `program' statement is present")) @@ -120,20 +130,22 @@ its header arguments." (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 + "Do nothing. +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")) (defun org-babel-load-session:fortran (_session _body _params) - "This function does nothing as fortran is a compiled language with no + "Do nothing. +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")) ;; helper functions (defun org-babel-fortran-var-to-fortran (pair) - "Convert an elisp val into a string of fortran code specifying a var -of the same value." + "Convert PAIR of (VAR . VAL) into a string of fortran code. +The fortran code will assign VAL to VAR variable." ;; TODO list support (let ((var (car pair)) (val (cdr pair))) @@ -164,7 +176,7 @@ of the same value." (error "The type of parameter %s is not supported by ob-fortran" var))))) (defun org-babel-fortran-transform-list (val) - "Return a fortran representation of enclose syntactic lists." + "Return a fortran representation of enclose syntactic list VAL." (if (listp val) (concat "(/" (mapconcat #'org-babel-fortran-transform-list val ", ") "/)") (format "%S" val))) diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index 8d7e62928a2..dc5cd0e5217 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2009-2024 Free Software Foundation, Inc. ;; Author: Eric Schulte -;; Maintainer: Ihor Radchenko +;; Maintainer: Ihor Radchenko ;; Keywords: literate programming, reproducible research ;; URL: https://orgmode.org @@ -45,6 +45,7 @@ (require 'ob) (require 'org-macs) +(require 'ox-ascii) (declare-function org-time-string-to-time "org" (s)) (declare-function orgtbl-to-generic "org-table" (table params)) @@ -186,7 +187,7 @@ code." ;; value of the variable (mapc (lambda (pair) (setq body (replace-regexp-in-string - (format "\\$%s" (car pair)) (cdr pair) body))) + (format "\\$%s" (car pair)) (cdr pair) body t t))) vars) (when prologue (funcall add-to-body prologue)) (when epilogue (setq body (concat body "\n" epilogue))) @@ -196,9 +197,9 @@ code." body)) (defun org-babel-execute:gnuplot (body params) - "Execute a block of Gnuplot code. + "Execute Gnuplot BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." - (require 'gnuplot) + (org-require-package 'gnuplot) (let ((session (cdr (assq :session params))) (result-type (cdr (assq :results params))) (body (org-babel-expand-body:gnuplot body params)) @@ -251,7 +252,8 @@ 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. +PARAMS is src block parameters alist defining variable assignments." (mapcar (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) (org-babel-gnuplot-process-vars params))) @@ -262,7 +264,7 @@ This function is called by `org-babel-execute-src-block'." If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session. The current `gnuplot-mode' doesn't provide support for multiple sessions." - (require 'gnuplot) + (org-require-package 'gnuplot) (unless (string= session "none") (save-window-excursion (gnuplot-send-string-to-gnuplot "" "line") @@ -295,14 +297,29 @@ Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." (require 'ox-org) (with-temp-file data-file (insert (let ((org-babel-gnuplot-timestamp-fmt - (or (plist-get params :timefmt) "%Y-%m-%d-%H:%M:%S"))) + (or (plist-get params :timefmt) "%Y-%m-%d-%H:%M:%S")) + ;; Create custom limited backend that will disable + ;; advanced ASCII export features that may alter the + ;; original data. + (ob-gnuplot-data + (org-export-create-backend + :parent 'ascii + :transcoders + `(;; Do not try to resolve links. Export them verbatim. + (link . (lambda (link _ _) (org-element-interpret-data link))) + ;; Drop emphasis markers from verbatim and code. + ;; This way, data can use verbatim when escaping + ;; is necessary and yet be readable by Gnuplot, + ;; which is not aware about Org's markup. + (verbatim . (lambda (verbatim _ _) (org-element-property :value verbatim))) + (code . (lambda (code _ _) (org-element-property :value code))))))) (orgtbl-to-generic table (org-combine-plists - '( :sep "\t" :fmt org-babel-gnuplot-quote-tsv-field + `( :sep "\t" :fmt org-babel-gnuplot-quote-tsv-field ;; Two setting below are needed to make :fmt work. :raw t - :backend ascii) + :backend ,ob-gnuplot-data) params))))) data-file) diff --git a/lisp/org/ob-groovy.el b/lisp/org/ob-groovy.el index 6e5208f5edc..908df93372a 100644 --- a/lisp/org/ob-groovy.el +++ b/lisp/org/ob-groovy.el @@ -50,7 +50,7 @@ parameters may be used, like groovy -v" :type 'string) (defun org-babel-execute:groovy (body params) - "Execute a block of Groovy code with org-babel. + "Execute Groovy BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (message "Executing Groovy source code block") (let* ((processed-params (org-babel-process-params params)) @@ -81,6 +81,7 @@ println(new Runner().run()) (defun org-babel-groovy-evaluate (session body &optional result-type result-params) "Evaluate BODY in external Groovy process. +SESSION must be nil as sessions are not yet supported. 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." @@ -107,9 +108,8 @@ in BODY as elisp." (error "Sessions are not (yet) supported for Groovy")) (defun org-babel-groovy-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 Groovy." + "Do nothing. +Sessions are not supported in Groovy." nil) (provide 'ob-groovy) diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index c891e94283e..05f340fa0fb 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -61,7 +61,7 @@ (defvar org-babel-haskell-lhs2tex-command "lhs2tex") -(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"") +(defvar org-babel-haskell-eoe "org-babel-haskell-eoe") (defvar haskell-prompt-regexp) @@ -77,8 +77,35 @@ a parameter, such as \"ghc -v\"." (defconst org-babel-header-args:haskell '((compile . :any)) "Haskell-specific header arguments.") + +(defun org-babel-haskell-with-session--worker (params todo) + "See `org-babel-haskell-with-session'." + (let* ((sn (cdr (assq :session params))) + (session (org-babel-haskell-initiate-session sn params)) + (one-shot (equal sn "none"))) + (unwind-protect + (funcall todo session) + (when (and one-shot (buffer-live-p session)) + ;; As we don't control how the session temporary buffer is + ;; created, we need to explicitly work around the hooks and + ;; query functions. + (with-current-buffer session + (let ((kill-buffer-query-functions nil) + (kill-buffer-hook nil)) + (kill-buffer session))))))) + +(defmacro org-babel-haskell-with-session (session-symbol params &rest body) + "Get the session identified by PARAMS and run BODY with it. + +Get or create a session, as needed to match PARAMS. Assign the session to +SESSION-SYMBOL. Execute BODY. Destroy the session if needed. +Return the value of the last form of BODY." + (declare (indent 2) (debug (symbolp form body))) + `(org-babel-haskell-with-session--worker ,params (lambda (,session-symbol) ,@body))) + (defun org-babel-haskell-execute (body params) - "This function should only be called by `org-babel-execute:haskell'." + "Execute Haskell BODY according to PARAMS. +This function should only be called by `org-babel-execute:haskell'." (let* ((tmp-src-file (org-babel-temp-file "Haskell-src-" ".hs")) (tmp-bin-file (org-babel-process-file-name @@ -122,39 +149,63 @@ a parameter, such as \"ghc -v\"." (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))) (defun org-babel-interpret-haskell (body params) - (require 'inf-haskell) + (org-require-package 'inf-haskell "haskell-mode") (add-hook 'inferior-haskell-hook (lambda () - (setq-local comint-prompt-regexp - (concat haskell-prompt-regexp "\\|^λ?> ")))) - (let* ((session (cdr (assq :session params))) - (result-type (cdr (assq :result-type params))) - (full-body (org-babel-expand-body:generic - body params - (org-babel-variable-assignments:haskell params))) - (session (org-babel-haskell-initiate-session session params)) - (comint-preoutput-filter-functions - (cons 'ansi-color-filter-apply comint-preoutput-filter-functions)) - (raw (org-babel-comint-with-output - (session org-babel-haskell-eoe nil full-body) - (insert (org-trim full-body)) - (comint-send-input nil t) - (insert org-babel-haskell-eoe) - (comint-send-input nil t))) - (results (mapcar #'org-strip-quotes - (cdr (member org-babel-haskell-eoe - (reverse (mapcar #'org-trim raw))))))) - (org-babel-reassemble-table - (let ((result - (pcase result-type - (`output (mapconcat #'identity (reverse results) "\n")) - (`value (car results))))) - (org-babel-result-cond (cdr (assq :result-params params)) - result (when result (org-babel-script-escape result)))) - (org-babel-pick-name (cdr (assq :colname-names params)) - (cdr (assq :colname-names params))) - (org-babel-pick-name (cdr (assq :rowname-names params)) - (cdr (assq :rowname-names params)))))) + (setq-local + org-babel-comint-prompt-regexp-old comint-prompt-regexp + comint-prompt-regexp + (concat haskell-prompt-regexp "\\|^λ?> ")))) + (org-babel-haskell-with-session session params + (cl-labels + ((send-txt-to-ghci (txt) + (insert txt) (comint-send-input nil t)) + (send-eoe () + (send-txt-to-ghci (concat "putStrLn \"" org-babel-haskell-eoe "\"\n"))) + (comint-with-output (todo) + (let ((comint-preoutput-filter-functions + (cons 'ansi-color-filter-apply + comint-preoutput-filter-functions))) + (org-babel-comint-with-output + (session org-babel-haskell-eoe nil nil) + (funcall todo))))) + (let* ((result-type (cdr (assq :result-type params))) + (full-body (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:haskell params))) + (raw (pcase result-type + (`output + (comint-with-output + (lambda () (send-txt-to-ghci (org-trim full-body)) (send-eoe)))) + (`value + ;; We first compute the value and store it, + ;; ignoring any output. + (comint-with-output + (lambda () + (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__=()::()\n") + (send-txt-to-ghci (org-trim full-body)) + (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__=it\n") + (send-eoe))) + ;; We now display and capture the value. + (comint-with-output + (lambda() + (send-txt-to-ghci "__LAST_VALUE_IMPROBABLE_NAME__\n") + (send-eoe)))))) + (results (mapcar #'org-strip-quotes + (cdr (member org-babel-haskell-eoe + (reverse (mapcar #'org-trim raw))))))) + (org-babel-reassemble-table + (let ((result + (pcase result-type + (`output (mapconcat #'identity (reverse results) "\n")) + (`value (car results))))) + (org-babel-result-cond (cdr (assq :result-params params)) + result (when result (org-babel-script-escape result)))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colname-names params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rowname-names params)))))))) + (defun org-babel-execute:haskell (body params) "Execute a block of Haskell code." @@ -163,13 +214,65 @@ a parameter, such as \"ghc -v\"." (org-babel-interpret-haskell body params) (org-babel-haskell-execute body params)))) -(defun org-babel-haskell-initiate-session (&optional _session _params) + + + +;; Variable defined in inf-haskell (haskell-mode package). +(defvar inferior-haskell-buffer) +(defvar inferior-haskell-root-dir) + +(defun org-babel-haskell-initiate-session (&optional session-name _params) "Initiate a haskell session. -If there is not a current inferior-process-buffer in SESSION -then create one. Return the initialized session." - (require 'inf-haskell) - (or (get-buffer "*haskell*") - (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer)))) +Return the initialized session, i.e. the buffer for this session. +When SESSION-NAME is nil, use a global session named +\"*ob-haskell*\". When SESSION-NAME is the string \"none\", use +a temporary buffer. Else, (re)use the session named +SESSION-NAME. The buffer name is the session name. See also +`org-babel-haskell-with-session'." + (org-require-package 'inf-haskell "haskell-mode") + (cond + ((equal "none" session-name) + ;; Temporary buffer name. + (setq session-name (generate-new-buffer-name " *ob-haskell-tmp*"))) + ((eq nil session-name) + ;; The global default session. As haskell-mode is using the buffer + ;; named "*haskell*", we stay away from it. + (setq session-name "*ob-haskell*")) + ((not (stringp session-name)) + (error "session-name must be a string"))) + (let ((session (get-buffer session-name))) + ;; NOTE: By construction, as SESSION-NAME is a string, session is + ;; either nil or a live buffer. + (save-window-excursion + (or (org-babel-comint-buffer-livep session) + (let ((inferior-haskell-buffer session)) + ;; As inferior-haskell expects the buffer to be named + ;; "*haskell*", we temporarily rename it while executing + ;; `run-haskell' (unless the user explicitly requested to + ;; use the name "*haskell*"). + (when (not (equal "*haskell*" session-name)) + (when (bufferp session) + (when (bufferp "*haskell*") + (user-error "Conflicting buffer '*haskell*', rename it or kill it")) + (with-current-buffer session (rename-buffer "*haskell*")))) + (unwind-protect + (let ((inferior-haskell-root-dir default-directory)) + (run-haskell) + (sleep-for 0.25) + (setq session inferior-haskell-buffer)) + (when (and (not (equal "*haskell*" session-name)) + (bufferp session)) + (with-current-buffer session (rename-buffer session-name)))) + ;; Disable secondary prompt: If we do not do this, + ;; org-comint may treat secondary prompts as a part of + ;; output. + (org-babel-comint-input-command + session + ":set prompt-cont \"\"") + session) + )) + session)) + (defun org-babel-load-session:haskell (session body params) "Load BODY into SESSION." @@ -226,7 +329,7 @@ constructs (header arguments, no-web syntax etc...) are ignored." (let* ((contents (buffer-string)) (haskell-regexp (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)[\r\n]" - "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*")) + "\\(\\(?:.\\|\n\\)*?\\)[\r\n][ \t]*#\\+end_src.*")) (base-name (file-name-sans-extension (buffer-file-name))) (tmp-file (org-babel-temp-file "haskell-")) (tmp-org-file (concat tmp-file ".org")) @@ -255,26 +358,27 @@ constructs (header arguments, no-web syntax etc...) are ignored." t t) (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) (save-excursion - ;; export to latex w/org and save as .lhs - (require 'ox-latex) - (find-file tmp-org-file) - ;; Ensure we do not clutter kill ring with incomplete results. - (let (org-export-copy-to-kill-ring) - (org-export-to-file 'latex tmp-tex-file)) - (kill-buffer nil) - (delete-file tmp-org-file) - (find-file tmp-tex-file) - (goto-char (point-min)) (forward-line 2) - (insert "%include polycode.fmt\n") - ;; ensure all \begin/end{code} statements start at the first column - (while (re-search-forward "^[ \t]+\\\\begin{code}[^\000]+\\\\end{code}" nil t) - (replace-match (save-match-data (org-remove-indentation (match-string 0))) - t t)) - (setq contents (buffer-string)) - (save-buffer) (kill-buffer nil)) - (delete-file tmp-tex-file) - ;; save org exported latex to a .lhs file - (with-temp-file lhs-file (insert contents)) + (unwind-protect + (with-temp-buffer + ;; Export to latex w/org and save as .lhs + (require 'ox-latex) + (insert-file-contents tmp-org-file) + ;; Ensure we do not clutter kill ring with incomplete results. + (let (org-export-copy-to-kill-ring) + (org-export-to-file 'latex tmp-tex-file))) + (delete-file tmp-org-file)) + (unwind-protect + (with-temp-buffer + (insert-file-contents tmp-tex-file) + (goto-char (point-min)) (forward-line 2) + (insert "%include polycode.fmt\n") + ;; ensure all \begin/end{code} statements start at the first column + (while (re-search-forward "^[ \t]+\\\\begin{code}\\(?:.\\|\n\\)+\\\\end{code}" nil t) + (replace-match (save-match-data (org-remove-indentation (match-string 0))) + t t)) + ;; save org exported latex to a .lhs file + (write-region nil nil lhs-file)) + (delete-file tmp-tex-file))) (if (not arg) (find-file lhs-file) ;; process .lhs file with lhs2tex diff --git a/lisp/org/ob-java.el b/lisp/org/ob-java.el index c0dafbdceba..fd62063577a 100644 --- a/lisp/org/ob-java.el +++ b/lisp/org/ob-java.el @@ -341,9 +341,13 @@ is simplest to expand the code block from the inside out." (imports-val (assq :imports params)) (imports (if imports-val (split-string (org-babel-read (cdr imports-val) nil) " ") - nil))) + nil)) + (prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params)))) (with-temp-buffer + (when prologue (insert prologue "\n")) (insert body) + (when epilogue (insert "\n" epilogue)) ;; wrap main. If there are methods defined, but no main method ;; and no class, wrap everything in a generic main method. diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index eb53f3730cf..451a92eb4d3 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -76,7 +76,7 @@ "Javascript code to print value of body.") (defun org-babel-execute:js (body params) - "Execute a block of Javascript code with org-babel. + "Execute Javascript BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (let* ((org-babel-js-cmd (or (cdr (assq :cmd params)) org-babel-js-cmd)) (session (cdr (assq :session params))) @@ -99,7 +99,7 @@ This function is called by `org-babel-execute-src-block'." ;; Indium Node REPL. Separate case because Indium ;; REPL is not inherited from Comint mode. ((string= session "*JS REPL*") - (require 'indium-repl) + (org-require-package 'indium-repl "indium") (unless (get-buffer session) (indium-run-node org-babel-js-cmd)) (indium-eval full-body)) @@ -158,7 +158,8 @@ 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. +The variables are defined in PARAMS." (mapcar (lambda (pair) (format "var %s=%s;" (car pair) (org-babel-js-var-to-js (cdr pair)))) @@ -171,7 +172,7 @@ Return the initialized session." ((string= session "none") (warn "Session evaluation of ob-js is not supported")) ((string= "*skewer-repl*" session) - (require 'skewer-repl) + (org-require-package 'skewer-repl "skewer-mode") (let ((session-buffer (get-buffer "*skewer-repl*"))) (if (and session-buffer (org-babel-comint-buffer-livep (get-buffer session-buffer)) @@ -183,7 +184,7 @@ Return the initialized session." (skewer-repl) session-buffer))) ((string= "*Javascript REPL*" session) - (require 'js-comint) + (org-require-package 'js-comint) (let ((session-buffer "*Javascript REPL*")) (if (and (org-babel-comint-buffer-livep (get-buffer session-buffer)) (comint-check-proc session-buffer)) @@ -192,7 +193,9 @@ Return the initialized session." (sit-for .5) session-buffer))) ((string= "mozrepl" org-babel-js-cmd) - (require 'moz) + ;; FIXME: According to https://github.com/bard/mozrepl, this REPL + ;; is outdated and does not work for Firefox >54. + (org-require-package 'moz "mozrepl") (let ((session-buffer (save-window-excursion (run-mozilla nil) (rename-buffer session) diff --git a/lisp/org/ob-julia.el b/lisp/org/ob-julia.el index 7a90d16408d..10a331e54d5 100644 --- a/lisp/org/ob-julia.el +++ b/lisp/org/ob-julia.el @@ -70,12 +70,15 @@ (defvar ess-local-process-name) ; dynamically scoped (defvar ess-eval-visibly-p) ; dynamically scoped (defvar ess-local-customize-alist); dynamically scoped -(defun org-babel-edit-prep:julia (info) - (let ((session (cdr (assq :session (nth 2 info))))) - (when (and session - (string-prefix-p "*" session) - (string-suffix-p "*" session)) - (org-babel-julia-initiate-session session nil)))) +(defvar ess-gen-proc-buffer-name-function) ; defined in ess-inf.el +(defun org-babel-julia-associate-session (session) + "Associate R code buffer with an R session. +Make SESSION be the inferior ESS process associated with the +current code buffer." + (when-let ((process (get-buffer-process session))) + (setq ess-local-process-name (process-name process)) + (ess-make-buffer-current)) + (setq-local ess-gen-proc-buffer-name-function (lambda (_) session))) (defun org-babel-expand-body:julia (body params &optional _graphics-file) "Expand BODY according to PARAMS, return the expanded body." @@ -181,10 +184,13 @@ end" (defun org-babel-julia-initiate-session (session params) "If there is not a current julia process then create one." (unless (string= session "none") - (let ((session (or session "*Julia*")) - (ess-ask-for-ess-directory - (and (bound-and-true-p ess-ask-for-ess-directory) - (not (cdr (assq :dir params)))))) + (let* ((session (or session "*Julia*")) + (ess-ask-for-ess-directory + (and (bound-and-true-p ess-ask-for-ess-directory) + (not (cdr (assq :dir params))))) + ;; Make ESS name the process buffer as SESSION. + (ess-gen-proc-buffer-name-function + (lambda (_) session))) (if (org-babel-comint-buffer-livep session) session ;; FIXME: Depending on `display-buffer-alist', (julia) may end up @@ -196,13 +202,8 @@ end" (when (get-buffer session) ;; Session buffer exists, but with dead process (set-buffer session)) - (require 'ess) (set-buffer (julia)) - (rename-buffer - (if (bufferp session) - (buffer-name session) - (if (stringp session) - session - (buffer-name)))) + (org-require-package 'ess "ESS") + (set-buffer (julia)) (current-buffer)))))) (defun org-babel-julia-graphical-output-file (params) diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el index 3be59494032..58051fae197 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -52,6 +52,7 @@ (defvar org-format-latex-options) ; From org.el (defvar org-latex-default-packages-alist) ; From org.el (defvar org-latex-packages-alist) ; From org.el +(defvar org-preview-latex-process-alist) ; From org.el (defvar org-babel-default-header-args:latex '((:results . "latex") (:exports . "results")) @@ -128,6 +129,18 @@ exporting the literal LaTeX source." :group 'org-babel :type '(repeat (string))) +(defcustom org-babel-latex-process-alist + `(,(cons 'png (alist-get 'dvipng org-preview-latex-process-alist))) + "Definitions of external processes for LaTeX result generation. +See `org-preview-latex-process-alist' for more details. + +The following process symbols are recognized: +- `png' :: Process used to produce .png output." + :group 'org-babel + :package-version '(Org . "9.7") + :type '(alist :tag "LaTeX to image backends" + :value-type (plist))) + (defun org-babel-expand-body:latex (body params) "Expand BODY according to PARAMS, return the expanded body." (mapc (lambda (pair) ;; replace variables @@ -136,12 +149,18 @@ exporting the literal LaTeX source." (regexp-quote (format "%S" (car pair))) (if (stringp (cdr pair)) (cdr pair) (format "%S" (cdr pair))) - body))) + body t t))) (org-babel--get-vars params)) - (org-trim body)) + (let ((prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params)))) + (org-trim + (concat + (and prologue (concat prologue "\n")) + body + (and epilogue (concat "\n" epilogue "\n")))))) (defun org-babel-execute:latex (body params) - "Execute a block of LaTeX code with Babel. + "Execute LaTeX BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (setq body (org-babel-expand-body:latex body params)) (if (cdr (assq :file params)) @@ -163,9 +182,10 @@ This function is called by `org-babel-execute-src-block'." ((and (string-suffix-p ".png" out-file) (not imagemagick)) (let ((org-format-latex-header (concat org-format-latex-header "\n" - (mapconcat #'identity headers "\n")))) + (mapconcat #'identity headers "\n"))) + (org-preview-latex-process-alist org-babel-latex-process-alist)) (org-create-formula-image - body out-file org-format-latex-options in-buffer))) + body out-file org-format-latex-options in-buffer 'png))) ((string= "svg" extension) (with-temp-file tex-file (insert (concat (funcall org-babel-latex-preamble params) @@ -273,7 +293,9 @@ This function is called by `org-babel-execute-src-block'." body)) (defun org-babel-latex-convert-pdf (pdffile out-file im-in-options im-out-options) - "Generate a file from a pdf file using imagemagick." + "Generate OUT-FILE from PDFFILE using imagemagick. +IM-IN-OPTIONS are command line options for input file, as a string; +and IM-OUT-OPTIONS are the output file options." (let ((cmd (concat "convert " im-in-options " " pdffile " " im-out-options " " out-file))) (message "Converting pdffile file %s..." cmd) diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el index d3c7a45933f..35df76fc964 100644 --- a/lisp/org/ob-lilypond.el +++ b/lisp/org/ob-lilypond.el @@ -40,10 +40,8 @@ (declare-function org-fold-show-all "org-fold" (&optional types)) -;; FIXME: Doesn't this rather belong in lilypond-mode.el? -(defalias 'lilypond-mode 'LilyPond-mode) - (add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly")) +(add-to-list 'org-src-lang-modes '("lilypond" . "LilyPond")) (defvar org-babel-default-header-args:lilypond '() "Default header arguments for lilypond code blocks. @@ -60,23 +58,13 @@ and stored in `org-babel-default-header-args:lilypond' See `org-babel-lilypond-set-header-args'.") (defvar org-babel-lilypond-compile-post-tangle t - "Following the org-babel-tangle (C-c C-v t) command, -org-babel-lilypond-compile-post-tangle determines whether ob-lilypond should -automatically attempt to compile the resultant tangled file. -If the value is nil, no automated compilation takes place. -Default value is t.") + "When non-nil, compile tangled file after `org-babel-tangle'.") (defvar org-babel-lilypond-display-pdf-post-tangle t - "Following a successful LilyPond compilation -org-babel-lilypond-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.") + "When non-nil, display pdf after successful LilyPond compilation.") (defvar org-babel-lilypond-play-midi-post-tangle t - "Following a successful LilyPond compilation -org-babel-lilypond-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") + "When non-nil, play midi file after successful LilyPond compilation.") (defvar org-babel-lilypond-ly-command "" "Command to execute lilypond on your system. @@ -143,7 +131,9 @@ blocks.") (defun org-babel-expand-body:lilypond (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (org-babel--get-vars params))) + (let ((vars (org-babel--get-vars params)) + (prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params)))) (mapc (lambda (pair) (let ((name (symbol-name (car pair))) @@ -152,54 +142,75 @@ blocks.") (replace-regexp-in-string (concat "$" (regexp-quote name)) (if (stringp value) value (format "%S" value)) - body)))) + body t t)))) vars) - body)) + (concat + (and prologue (concat prologue "\n")) + body + (and epilogue (concat "\n" epilogue "\n"))))) (defun org-babel-execute:lilypond (body params) - "This function is called by `org-babel-execute-src-block'. -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)" + "Execute LilyPond src block according to arrange mode. +See `org-babel-execute-src-block' for BODY and PARAMS. +When in arrange mode, tangle all blocks and process the result. +Otherwise, execute block according to header settings." (org-babel-lilypond-set-header-args org-babel-lilypond-arrange-mode) (if org-babel-lilypond-arrange-mode (org-babel-lilypond-tangle) (org-babel-lilypond-process-basic body params))) (defun org-babel-lilypond-tangle () - "ob-lilypond specific tangle, attempts to invoke -=ly-execute-tangled-ly= if tangle is successful. Also passes -specific arguments to =org-babel-tangle=." + "Tangle lilypond blocks, then `org-babel-liypond-execute-tangled-ly'." (interactive) (if (org-babel-tangle nil "yes" "lilypond") (org-babel-lilypond-execute-tangled-ly) nil)) +;; https://lilypond.org/doc/v2.24/Documentation/usage/other-programs +(defvar org-babel-lilypond-paper-settings + "#(if (ly:get-option 'use-paper-size-for-page) + (begin (ly:set-option 'use-paper-size-for-page #f) + (ly:set-option 'tall-page-formats '%s))) +\\paper { + indent=0\\mm + tagline=\"\" + oddFooterMarkup=##f + oddHeaderMarkup=##f + bookTitleMarkup=##f + scoreTitleMarkup=##f +}\n" + "The paper settings required to generate music fragments. +They are needed for mixing music and text in basic-mode.") + (defun org-babel-lilypond-process-basic (body params) - "Execute a lilypond block in basic mode." + "Execute a lilypond block in basic mode. +See `org-babel-execute-src-block' for BODY and PARAMS." (let* ((out-file (cdr (assq :file params))) + (file-type (file-name-extension out-file)) (cmdline (or (cdr (assq :cmdline params)) "")) (in-file (org-babel-temp-file "lilypond-"))) (with-temp-file in-file - (insert (org-babel-expand-body:generic body params))) + (insert + (format org-babel-lilypond-paper-settings file-type) + (org-babel-expand-body:generic body params))) (org-babel-eval (concat org-babel-lilypond-ly-command " -dbackend=eps " "-dno-gs-load-fonts " "-dinclude-eps-fonts " - (or (cdr (assoc (file-name-extension out-file) - '(("pdf" . "--pdf ") - ("ps" . "--ps ") - ("png" . "--png ")))) + (or (assoc-default file-type + '(("pdf" . "--pdf ") + ("eps" . "--eps "))) "--png ") "--output=" (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." @@ -219,7 +230,7 @@ If error in compilation, attempt to mark the error in lilypond org file." (delete-file org-babel-lilypond-temp-file)) (rename-file org-babel-lilypond-tangled-file org-babel-lilypond-temp-file)) - (org-switch-to-buffer-other-window "*lilypond*") + (switch-to-buffer-other-window "*lilypond*") (erase-buffer) (org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file) (goto-char (point-min)) @@ -229,27 +240,20 @@ If error in compilation, attempt to mark the error in lilypond org file." (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file) (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file))))) -(defun org-babel-lilypond-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 org-babel-lilypond-ly-command) ;program - ;; (arg-2 nil) ;infile - (arg-3 "*lilypond*") ;buffer - (arg-4 t) ;display - (arg-5 (if org-babel-lilypond-gen-png "--png" "")) ;&rest... - (arg-6 (if org-babel-lilypond-gen-html "--html" "")) - (arg-7 (if org-babel-lilypond-gen-pdf "--pdf" "")) - (arg-8 (if org-babel-lilypond-use-eps "-dbackend=eps" "")) - (arg-9 (if org-babel-lilypond-gen-svg "-dbackend=svg" "")) - (arg-10 (concat "--output=" (file-name-sans-extension file-name))) - (arg-11 file-name)) - (if test - `(,arg-1 ,nil ,arg-3 ,arg-4 ,arg-5 ,arg-6 ;; arg-2 - ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11) - (call-process - arg-1 nil arg-3 arg-4 arg-5 arg-6 ;; arg-2 - arg-7 arg-8 arg-9 arg-10 arg-11)))) +;;Ignoring second arg for pre Org 9.7 compatibility +(defun org-babel-lilypond-compile-lilyfile (filename &optional _) + "Compile Lilypond FILENAME and check for compile errors." + (message "Compiling %s..." filename) + (let ((args (delq nil (list + (and org-babel-lilypond-gen-png "--png") + (and org-babel-lilypond-gen-html "--html") + (and org-babel-lilypond-gen-pdf "--pdf") + (and org-babel-lilypond-use-eps "-dbackend=eps") + (and org-babel-lilypond-gen-svg "-dbackend=svg") + (concat "--output=" (file-name-sans-extension filename)) + filename)))) + (apply #'call-process org-babel-lilypond-ly-command nil + "*lilypond*" 'display args))) (defun org-babel-lilypond-check-for-compile-error (file-name &optional test) "Check for compile error. @@ -276,7 +280,7 @@ 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." - (org-switch-to-buffer-other-window + (switch-to-buffer-other-window (concat (file-name-nondirectory (org-babel-lilypond-switch-extension file-name ".org")))) (let ((temp (point))) @@ -290,7 +294,7 @@ LINE is the erroneous line." (goto-char temp)))) (defun org-babel-lilypond-parse-line-num (&optional buffer) - "Extract error line number." + "Extract error line number in BUFFER or `current-buffer'." (when buffer (set-buffer buffer)) (let ((start (and (search-backward ":" nil t) @@ -423,8 +427,7 @@ These depend upon whether we are in Arrange mode i.e. MODE is t." ob-lilypond-header-args))) (defun org-babel-lilypond-set-header-args (mode) - "Set org-babel-default-header-args:lilypond -dependent on ORG-BABEL-LILYPOND-ARRANGE-MODE." + "Set lilypond babel header according to MODE." (setq org-babel-default-header-args:lilypond (org-babel-lilypond-get-header-args mode))) diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index da2d6cf8d61..0e416ad9f43 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -74,13 +74,19 @@ current directory string." (let* ((vars (org-babel--get-vars params)) (result-params (cdr (assq :result-params params))) (print-level nil) (print-length nil) + (prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params))) (body (if (null vars) (org-trim body) (concat "(let (" (mapconcat (lambda (var) (format "(%S (quote %S))" (car var) (cdr var))) vars "\n ") - ")\n" body ")")))) + ")\n" + (and prologue (concat prologue "\n")) + body + (and epilogue (concat "\n" epilogue "\n")) + ")")))) (if (or (member "code" result-params) (member "pp" result-params)) (format "(pprint %s)" body) @@ -90,37 +96,41 @@ current directory string." "Execute a block of Common Lisp code with Babel. BODY is the contents of the block, as a string. PARAMS is a property list containing the parameters of the block." - (require (pcase org-babel-lisp-eval-fn - (`slime-eval 'slime) - (`sly-eval 'sly))) - (org-babel-reassemble-table - (let ((result - (funcall (if (member "output" (cdr (assq :result-params params))) - #'car #'cadr) - (with-temp-buffer - (insert (org-babel-expand-body:lisp body params)) - (funcall org-babel-lisp-eval-fn - `(swank:eval-and-grab-output - ,(let ((dir (if (assq :dir params) - (cdr (assq :dir params)) - default-directory))) - (format - (if dir (format org-babel-lisp-dir-fmt dir) - "(progn %s\n)") - (buffer-substring-no-properties - (point-min) (point-max))))) - (cdr (assq :package params))))))) - (org-babel-result-cond (cdr (assq :result-params params)) - (org-strip-quotes result) - (condition-case nil - (read (org-babel-lisp-vector-to-list result)) - (error result)))) - (org-babel-pick-name (cdr (assq :colname-names params)) - (cdr (assq :colnames params))) - (org-babel-pick-name (cdr (assq :rowname-names params)) - (cdr (assq :rownames params))))) + (let (eval-and-grab-output) + (pcase org-babel-lisp-eval-fn + (`slime-eval (org-require-package 'slime "SLIME") + (setq eval-and-grab-output 'swank:eval-and-grab-output)) + (`sly-eval (org-require-package 'sly "SLY") + (setq eval-and-grab-output 'slynk:eval-and-grab-output))) + (org-babel-reassemble-table + (let ((result + (funcall (if (member "output" (cdr (assq :result-params params))) + #'car #'cadr) + (with-temp-buffer + (insert (org-babel-expand-body:lisp body params)) + (funcall org-babel-lisp-eval-fn + `(,eval-and-grab-output + ,(let ((dir (if (assq :dir params) + (cdr (assq :dir params)) + default-directory))) + (format + (if dir (format org-babel-lisp-dir-fmt dir) + "(progn %s\n)") + (buffer-substring-no-properties + (point-min) (point-max))))) + (cdr (assq :package params))))))) + (org-babel-result-cond (cdr (assq :result-params params)) + (org-strip-quotes result) + (condition-case nil + (read (org-babel-lisp-vector-to-list result)) + (error result)))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params)))))) (defun org-babel-lisp-vector-to-list (results) + "Convert #(...) values in RESULTS string into a (...) list." ;; TODO: better would be to replace #(...) with [...] (replace-regexp-in-string "#(" "(" results)) diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index cf1183f40f4..110675fc561 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -34,8 +34,8 @@ (declare-function org-babel-ref-split-args "ob-ref" (arg-string)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) (defvar org-babel-library-of-babel nil "Library of source-code blocks. diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el index 6d60538e8ab..041abfabcd0 100644 --- a/lisp/org/ob-lua.el +++ b/lisp/org/ob-lua.el @@ -81,8 +81,14 @@ This will typically be `lua-mode'." :package-version '(Org . "8.3") :type 'symbol) +(defcustom org-babel-lua-multiple-values-separator ", " + "Separate multiple values with this string." + :group 'org-babel + :package-version '(Org . "9.7") + :type 'string) + (defun org-babel-execute:lua (body params) - "Execute a block of Lua code with Babel. + "Execute Lua BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-lua-initiate-session (cdr (assq :session params)))) @@ -129,7 +135,8 @@ VARS contains resolved variable references." ;; helper functions (defun org-babel-variable-assignments:lua (params) - "Return a list of Lua statements assigning the block's variables." + "Return a list of Lua statements assigning the block's variables. +The variable definitions are defining in PARAMS." (mapcar (lambda (pair) (format "%s=%s" @@ -176,13 +183,20 @@ Emacs-lisp table, otherwise return the results as a string." (cdr (assoc session org-babel-lua-buffers))) (defun org-babel-lua-with-earmuffs (session) + "Return buffer name for SESSION, as *SESSION*." (let ((name (if (stringp session) session (format "%s" session)))) (if (and (string= "*" (substring name 0 1)) (string= "*" (substring name (- (length name) 1)))) name (format "*%s*" name)))) +(defun org-babel-session-buffer:lua (session &optional _) + "Return session buffer name for SESSION." + (or (org-babel-lua-session-buffer session) + (org-babel-lua-with-earmuffs session))) + (defun org-babel-lua-without-earmuffs (session) +"Remove stars around *SESSION*, leaving SESSION." (let ((name (if (stringp session) session (format "%s" session)))) (if (and (string= "*" (substring name 0 1)) (string= "*" (substring name (- (length name) 1)))) @@ -243,45 +257,55 @@ function main() %s end -fd=io.open(\"%s\", \"w\") -fd:write( main() ) -fd:close()") -(defvar org-babel-lua-pp-wrapper-method - " --- table to string -function t2s(t, indent) +function dump(it, indent) if indent == nil then - indent = \"\" + indent = '' end - if type(t) == \"table\" then - ts = \"\" - for k,v in pairs(t) do - if type(v) == \"table\" then - ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \\n\" .. - t2s(v, indent .. \" \") - else - ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \" .. - t2s(v, indent .. \" \") .. \"\\n\" + if type(it) == 'table' and %s then + local count = 0 + for _ in pairs(it) do + count = count + 1 + end + local result = '' + if #indent ~= 0 then + result = result .. '\\n' + end + for key, value in pairs(it) do + result = result + .. indent + .. dump(key) + .. ' = ' + .. dump(value, indent .. ' ') + count = count - 1 + if count ~= 0 then + result = result .. '\\n' end end - return ts + return result else - return tostring(t) + return tostring(it) end end - -function main() -%s +function combine(...) + local result = {} + for index = 1, select('#', ...) do + result[index] = dump(select(index, ...)) + end + return table.concat(result, '%s') end -fd=io.open(\"%s\", \"w\") -fd:write(t2s(main())) -fd:close()") +output = io.open('%s', 'w') +output:write(combine(main())) +output:close()") (defun org-babel-lua-evaluate (session body &optional result-type result-params preamble) - "Evaluate BODY as Lua code." + "Evaluate BODY in SESSION as Lua code. +RESULT-TYPE and RESULT-PARAMS are passed to +`org-babel-lua-evaluate-session' or +`org-babel-lua-evaluate-external-process'. +PREAMBLE is passed to `org-babel-lua-evaluate-external-process'." (if session (org-babel-lua-evaluate-session session body result-type result-params) @@ -290,10 +314,12 @@ fd:close()") (defun org-babel-lua-evaluate-external-process (body &optional result-type result-params preamble) - "Evaluate BODY in external lua process. + "Evaluate BODY in external Lua 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." +last statement in BODY, as elisp. +RESULT-PARAMS list all the :result header arg parameters. +PREAMBLE string is appended to BODY." (let ((raw (pcase result-type (`output (org-babel-eval org-babel-lua-command @@ -305,15 +331,17 @@ last statement in BODY, as elisp." (concat preamble (and preamble "\n") (format - (if (member "pp" result-params) - org-babel-lua-pp-wrapper-method - org-babel-lua-wrapper-method) + org-babel-lua-wrapper-method (mapconcat (lambda (line) (format "\t%s" line)) (split-string (org-remove-indentation (org-trim body)) - "[\r\n]") "\n") + "[\r\n]") + "\n") + (if (member "pp" result-params) + "true" "false") + org-babel-lua-multiple-values-separator (org-babel-process-file-name tmp-file 'noquote)))) (org-babel-eval-read-file tmp-file)))))) (org-babel-result-cond result-params @@ -399,7 +427,7 @@ fd:close()" (org-babel-lua-table-or-string results))))) (defun org-babel-lua-read-string (string) - "Strip single quotes from around Lua string." + "Strip single quotes from around Lua STRING." (org-unbracket-string "'" "'" string)) (provide 'ob-lua) diff --git a/lisp/org/ob-makefile.el b/lisp/org/ob-makefile.el index 636108615a5..9ff545b7eb9 100644 --- a/lisp/org/ob-makefile.el +++ b/lisp/org/ob-makefile.el @@ -36,7 +36,8 @@ (defvar org-babel-default-header-args:makefile '()) (defun org-babel-execute:makefile (body _params) - "Execute a block of makefile code. + "Execute makefile BODY. +Second function argument is ignored. This function is called by `org-babel-execute-src-block'." body) diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el index 86f59a08702..1103317a883 100644 --- a/lisp/org/ob-maxima.el +++ b/lisp/org/ob-maxima.el @@ -37,6 +37,11 @@ (require 'ob) +(defconst org-babel-header-args:maxima + '((batch . ((batchload batch load))) + (graphics-pkg . ((plot draw)))) + "Maxima-specific header arguments.") + (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("maxima" . "max")) @@ -48,43 +53,102 @@ :group 'org-babel :type 'string) +(defvar org-babel-maxima--command-arguments-default + "--very-quiet" + "Command-line arguments sent to Maxima by default. +If the `:batch' header argument is set to `batchload' or unset, +then the `:cmdline' header argument is appended to this default; +otherwise, if the `:cmdline' argument is set, it over-rides this +default. See `org-babel-maxima-command' and +`org-babel-execute:maxima'.") + +(defvar org-babel-maxima--graphic-package-options + '((plot . "(set_plot_option ('[gnuplot_term, %s]), set_plot_option ('[gnuplot_out_file, %S]))$") + (draw . "(load(draw), set_draw_defaults(terminal='%s,file_name=%S))$")) + "An alist of graphics packages and Maxima code. +Each element is a cons (PACKAGE-NAME . FORMAT-STRING). +FORMAT-STRING contains Maxima code to configure the graphics +package; it must contain `%s' to set the terminal and `%S' to set +the filename, in that order. The default graphics package is +`plot'; `draw' is also supported. See +`org-babel-maxima-expand'.") + +(defvar org-babel-maxima--default-epilogue + '((graphical-output . "gnuplot_close ()$") + (non-graphical-output . "")) + "The final Maxima code executed in a source block. +An alist with the epilogue for graphical and non-graphical +output. See `org-babel-maxima-expand'.") + (defun org-babel-maxima-expand (body params) - "Expand a block of Maxima code according to its header arguments." - (let ((vars (org-babel--get-vars params)) - (epilogue (cdr (assq :epilogue params))) - (prologue (cdr (assq :prologue params)))) + "Expand Maxima BODY according to its header arguments from PARAMS." + (let* ((vars (org-babel--get-vars params)) + (graphic-file (ignore-errors (org-babel-graphical-output-file params))) + (epilogue (cdr (assq :epilogue params))) + (prologue (cdr (assq :prologue params)))) (mapconcat 'identity - (list - ;; Any code from the specified prologue at the start. - prologue - ;; graphic output - (let ((graphic-file (ignore-errors (org-babel-graphical-output-file params)))) - (if graphic-file - (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 - ;; Any code from the specified epilogue at the end. - epilogue - "gnuplot_close ()$") + (delq nil + (list + ;; Any code from the specified prologue at the start. + prologue + ;; graphic output + (if graphic-file + (let* ((graphics-pkg (intern (or (cdr (assq :graphics-pkg params)) "plot"))) + (graphic-format-string (cdr (assq graphics-pkg org-babel-maxima--graphic-package-options))) + (graphic-terminal (file-name-extension graphic-file)) + (graphic-file (if (eq graphics-pkg 'plot) graphic-file (file-name-sans-extension graphic-file)))) + (format graphic-format-string graphic-terminal graphic-file))) + ;; variables + (mapconcat 'org-babel-maxima-var-to-maxima vars "\n") + ;; body + body + ;; Any code from the specified epilogue at the end. + epilogue + (if graphic-file + (cdr (assq :graphical-output org-babel-maxima--default-epilogue)) + (cdr (assq :non-graphical-output org-babel-maxima--default-epilogue))))) "\n"))) +(defvar org-babel-maxima--output-filter-regexps + '("batch" ;; remove the `batch' or `batchload' line + "^rat: replaced .*$" ;; remove notices from `rat' + "^;;; Loading #P" ;; remove notices from the lisp implementation + "^read and interpret" ;; remove notice from `batch' + "^(%\\([i]-?[0-9]+\\))[ ]$" ;; remove empty input lines from `batch'-ing + ) + "Regexps to remove extraneous lines from Maxima's output. +See `org-babel-maxima--output-filter'.") + +(defun org-babel-maxima--output-filter (line) + "Filter empty or undesired lines from Maxima output. +Return nil if LINE is zero-length or it matches a regexp in +`org-babel-maxima--output-filter'; otherwise, return LINE." + (unless (or (= 0 (length line)) + (cl-some #'(lambda(r) (string-match r line)) + org-babel-maxima--output-filter-regexps)) + line)) + (defun org-babel-execute:maxima (body params) - "Execute a block of Maxima entries with org-babel. + "Execute Maxima BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (message "Executing Maxima source code block") (let ((result-params (split-string (or (cdr (assq :results params)) ""))) (result (let* ((cmdline (or (cdr (assq :cmdline params)) "")) + (batch/load (or (cdr (assq :batch params)) "batchload")) + (cmdline (if (or (equal cmdline "") (equal batch/load "batchload")) + ;; legacy behaviour: + ;; ensure that --very-quiet is on command-line by default + (concat cmdline " " org-babel-maxima--command-arguments-default) + ;; if using an alternate loader, :cmdline overwrites default + cmdline)) (in-file (org-babel-temp-file "maxima-" ".max")) - (cmd (format "%s --very-quiet -r %s %s" + (cmd (format "%s -r %s %s" org-babel-maxima-command (shell-quote-argument - (format "batchload(%S)$" in-file)) + ;; bind linenum to 0 so the first line + ;; of in-file has line number 1 + (format "(linenum:0, %s(%S))$" batch/load in-file)) cmdline))) (with-temp-file in-file (insert (org-babel-maxima-expand body params))) (message cmd) @@ -93,12 +157,7 @@ This function is called by `org-babel-execute-src-block'." (mapconcat #'identity (delq nil - (mapcar (lambda (line) - (unless (or (string-match "batch" line) - (string-match "^rat: replaced .*$" line) - (string-match "^;;; Loading #P" line) - (= 0 (length line))) - line)) + (mapcar #'org-babel-maxima--output-filter (split-string raw "[\r\n]"))) "\n"))))) (if (ignore-errors (org-babel-graphical-output-file params)) nil @@ -110,11 +169,11 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-prep-session:maxima (_session _params) +"Throw an error. Maxima does not support sessions." (error "Maxima does not support sessions")) (defun org-babel-maxima-var-to-maxima (pair) - "Convert an elisp val into a string of maxima code specifying a var -of the same value." + "Convert an elisp variable-value PAIR to maxima code." (let ((var (car pair)) (val (cdr pair))) (when (symbolp val) diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el index 48e2d7b76fd..6554193a7ef 100644 --- a/lisp/org/ob-ocaml.el +++ b/lisp/org/ob-ocaml.el @@ -63,7 +63,7 @@ :type 'string) (defun org-babel-execute:ocaml (body params) - "Execute a block of Ocaml code with Babel." + "Execute Ocaml BODY according to PARAMS." (let* ((full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:ocaml params))) @@ -109,7 +109,7 @@ (defvar tuareg-interactive-buffer-name) (defun org-babel-prep-session:ocaml (session _params) "Prepare SESSION according to the header arguments in PARAMS." - (require 'tuareg) + (org-require-package 'tuareg) (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none")) (not (string= session "default")) (stringp session)) @@ -121,7 +121,8 @@ (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. +The variables are defined in PARAMS." (mapcar (lambda (pair) (format "let %s = %s;;" (car pair) (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index 75f0ad79e02..005990f2002 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -70,11 +70,12 @@ end") (defvar org-babel-octave-eoe-output "ans = org_babel_eoe") (defun org-babel-execute:matlab (body params) - "Execute a block of matlab code with Babel." + "Execute Matlab BODY according to PARAMS." (org-babel-execute:octave body params 'matlab)) (defun org-babel-execute:octave (body params &optional matlabp) - "Execute a block of octave code with Babel." + "Execute Octave or Matlab BODY according to PARAMS. +When MATLABP is non-nil, execute Matlab. Otherwise, execute Octave." (let* ((session (funcall (intern (format "org-babel-%s-initiate-session" (if matlabp "matlab" "octave"))) @@ -109,7 +110,8 @@ 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. +The variables are taken from PARAMS." (mapcar (lambda (pair) (format "%s=%s;" @@ -120,21 +122,22 @@ end") (defalias 'org-babel-variable-assignments:matlab 'org-babel-variable-assignments:octave) -(defun org-babel-octave-var-to-octave (var) - "Convert an emacs-lisp value into an octave variable. +(defun org-babel-octave-var-to-octave (value) + "Convert an emacs-lisp VALUE into an octave variable. Converts an emacs-lisp variable into a string of octave code specifying a variable of the same value." - (if (listp var) - (concat "[" (mapconcat #'org-babel-octave-var-to-octave var - (if (listp (car var)) "; " ",")) "]") + (if (listp value) + (concat "[" (mapconcat #'org-babel-octave-var-to-octave value + (if (listp (car value)) "; " ",")) "]") (cond - ((stringp var) - (format "'%s'" var)) + ((stringp value) + (format "'%s'" value)) (t - (format "%s" var))))) + (format "%s" value))))) (defun org-babel-prep-session:octave (session params &optional matlabp) - "Prepare SESSION according to the header arguments specified in PARAMS." + "Prepare SESSION according to the header arguments specified in PARAMS. +The session will be an Octave session, unless MATLABP is non-nil." (let* ((session (org-babel-octave-initiate-session session params matlabp)) (var-lines (org-babel-variable-assignments:octave params))) (org-babel-comint-in-buffer session @@ -147,15 +150,18 @@ 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. PARAMS are src block parameters." (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." - (if matlabp (require 'matlab) (or (require 'octave-inf nil 'noerror) - (require 'octave))) +create. Return the initialized session. The session will be an +Octave session, unless MATLABP is non-nil." + (if matlabp + (org-require-package 'matlab "matlab-mode") + (or (require 'octave-inf nil 'noerror) + (require 'octave))) (unless (string= session "none") (let ((session (or session (if matlabp "*Inferior Matlab*" "*Inferior Octave*")))) @@ -178,7 +184,8 @@ value of the last statement in BODY, as elisp." (org-babel-octave-evaluate-external-process body result-type matlabp))) (defun org-babel-octave-evaluate-external-process (body result-type matlabp) - "Evaluate BODY in an external octave process." + "Evaluate BODY in an external Octave or Matalab process. +Process the result as RESULT-TYPE. Use Octave, unless MATLABP is non-nil." (let ((cmd (if matlabp org-babel-matlab-shell-command org-babel-octave-shell-command))) diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el index 9f6bae6a587..302f61bcf31 100644 --- a/lisp/org/ob-org.el +++ b/lisp/org/ob-org.el @@ -45,15 +45,25 @@ "Default header inserted during export of org blocks.") (defun org-babel-expand-body:org (body params) + "Expand Org BODY according to PARAMS. +$VAR instances are replaced by VAR values defined in PARAMS." (dolist (var (org-babel--get-vars params)) (setq body (replace-regexp-in-string (regexp-quote (format "$%s" (car var))) (format "%s" (cdr var)) - body nil 'literal))) - body) + body 'fixedcase 'literal))) + + (let ((prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params)))) + (concat + (and prologue (concat prologue "\n")) + body + (and epilogue (concat "\n" epilogue "\n"))))) (defun org-babel-execute:org (body params) - "Execute a block of Org code with. + "Execute a Org BODY according to PARAMS. +The BODY is returned expanded as is or exported, if PARAMS define +latex/html/ascii result type. This function is called by `org-babel-execute-src-block'." (let ((result-params (split-string (or (cdr (assq :results params)) ""))) (body (org-babel-expand-body:org diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el index aad210d61e5..17b9d140832 100644 --- a/lisp/org/ob-plantuml.el +++ b/lisp/org/ob-plantuml.el @@ -143,6 +143,7 @@ This function is called by `org-babel-execute-src-block'." ("eps" '("-teps")) ("pdf" '("-tpdf")) ("tex" '("-tlatex")) + ("tikz" '("-tlatex:nopreamble")) ("vdx" '("-tvdx")) ("xmi" '("-txmi")) ("scxml" '("-tscxml")) diff --git a/lisp/org/ob-processing.el b/lisp/org/ob-processing.el index 9b055768c9b..2733b1d1f6d 100644 --- a/lisp/org/ob-processing.el +++ b/lisp/org/ob-processing.el @@ -78,7 +78,7 @@ (defun org-babel-processing-view-sketch () "Show the sketch of the Processing block under point in an external viewer." (interactive) - (require 'processing-mode) + (org-require-package 'processing-mode) (let ((info (org-babel-get-src-block-info))) (if (string= (nth 0 info) "processing") (let* ((body (nth 1 info)) @@ -118,7 +118,7 @@ (message "Not inside a Processing source block.")))) (defun org-babel-execute:processing (body params) - "Execute a block of Processing code. + "Execute Processing code BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (let ((sketch-code (org-babel-expand-body:generic @@ -144,7 +144,8 @@ Processing does not support sessions." (error "Processing does not support sessions")) (defun org-babel-variable-assignments:processing (params) - "Return list of processing statements assigning the block's variables." + "Return list of processing statements assigning the block's variables. +The variable assignments are defined in PARAMS." (mapcar #'org-babel-processing-var-to-processing (org-babel--get-vars params))) diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index 1a442a5a08f..89cdf4c4795 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -36,53 +36,70 @@ (require 'org-macs) (require 'python) -(declare-function py-shell "ext:python-mode" (&rest args)) -(declare-function py-choose-shell "ext:python-mode" (&optional shell)) -(declare-function py-shell-send-string "ext:python-mode" (strg &optional process)) - (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) (defvar org-babel-default-header-args:python '()) -(defcustom org-babel-python-command "python" - "Name of the command for executing Python code." - :version "24.4" - :package-version '(Org . "8.0") +(defconst org-babel-header-args:python + '((return . :any) + (python . :any) + (async . ((yes no)))) + "Python-specific header arguments.") + +(defcustom org-babel-python-command 'auto + "Command (including arguments) for interactive and non-interactive Python code. +When not `auto', it overrides `org-babel-python-command-session' +and `org-babel-python-command-nonsession'." + :package-version '(Org . "9.7") :group 'org-babel - :type 'string) + :type '(choice string (const auto))) + +(defcustom org-babel-python-command-session 'auto + "Command (including arguments) for starting interactive Python sessions. +If `auto' (the default), uses the values from +`python-shell-interpreter' and `python-shell-interpreter-args'. +If `org-babel-python-command' is set, then it overrides this +option." + :package-version '(Org . "9.7") + :group 'org-babel + :type '(choice string (const auto))) -(defcustom org-babel-python-mode - (if (featurep 'python-mode) 'python-mode 'python) - "Preferred python mode for use in running python interactively. -This will typically be either `python' or `python-mode'." +(defcustom org-babel-python-command-nonsession "python" + "Command (including arguments) for executing non-interactive Python code. +If `org-babel-python-command' is set, then it overrides this option." + :package-version '(Org . "9.7") :group 'org-babel - :version "24.4" - :package-version '(Org . "8.0") - :type 'symbol) + :type 'string) (defcustom org-babel-python-hline-to "None" "Replace hlines in incoming tables with this when translating to python." :group 'org-babel - :version "24.4" :package-version '(Org . "8.0") :type 'string) (defcustom org-babel-python-None-to 'hline "Replace `None' in python tables with this before returning." :group 'org-babel - :version "24.4" :package-version '(Org . "8.0") :type 'symbol) +(defun org-babel-python-associate-session (session) + "Associate Python code buffer with an Python session. +Make SESSION without earmuffs be the Python buffer name." + (setq-local python-shell-buffer-name + (org-babel-python-without-earmuffs session))) + (defun org-babel-execute:python (body params) - "Execute a block of Python code with Babel. + "Execute Python BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (let* ((org-babel-python-command (or (cdr (assq :python params)) org-babel-python-command)) (session (org-babel-python-initiate-session (cdr (assq :session params)))) + (graphics-file (and (member "graphics" (assq :result-params params)) + (org-babel-graphical-output-file params))) (result-params (cdr (assq :result-params params))) (result-type (cdr (assq :result-type params))) (return-val (when (eq result-type 'value) @@ -98,7 +115,7 @@ This function is called by `org-babel-execute-src-block'." (format (if session "\n%s" "\nreturn %s") return-val)))) (result (org-babel-python-evaluate session full-body result-type - result-params preamble async))) + result-params preamble async graphics-file))) (org-babel-reassemble-table result (org-babel-pick-name (cdr (assq :colname-names params)) @@ -130,8 +147,63 @@ VARS contains resolved variable references." ;; helper functions +(defconst org-babel-python--output-graphics-wrapper "\ +import matplotlib.pyplot +matplotlib.pyplot.gcf().clear() +%s +matplotlib.pyplot.savefig('%s')" + "Format string for saving Python graphical output. +Has two %s escapes, for the Python code to be evaluated, and the +file to save the graphics to.") + +(defconst org-babel-python--def-format-value "\ +def __org_babel_python_format_value(result, result_file, result_params): + with open(result_file, 'w') as f: + if 'graphics' in result_params: + result.savefig(result_file) + elif 'pp' in result_params: + import pprint + f.write(pprint.pformat(result)) + elif 'list' in result_params and isinstance(result, dict): + f.write(str(['{} :: {}'.format(k, v) for k, v in result.items()])) + else: + if not set(result_params).intersection(\ +['scalar', 'verbatim', 'raw']): + def dict2table(res): + if isinstance(res, dict): + return [(k, dict2table(v)) for k, v in res.items()] + elif isinstance(res, list) or isinstance(res, tuple): + return [dict2table(x) for x in res] + else: + return res + if 'table' in result_params: + result = dict2table(result) + try: + import pandas + except ImportError: + pass + else: + if isinstance(result, pandas.DataFrame) and 'table' in result_params: + result = [[result.index.name or ''] + list(result.columns)] + \ +[None] + [[i] + list(row) for i, row in result.iterrows()] + elif isinstance(result, pandas.Series) and 'table' in result_params: + result = list(result.items()) + try: + import numpy + except ImportError: + pass + else: + if isinstance(result, numpy.ndarray): + if 'table' in result_params: + result = result.tolist() + else: + result = repr(result) + f.write(str(result))" + "Python function to format value result and save it to file.") + (defun org-babel-variable-assignments:python (params) - "Return a list of Python statements assigning the block's variables." + "Return a list of Python statements assigning the block's variables. +The assignments are defined in PARAMS." (mapcar (lambda (pair) (format "%s=%s" @@ -153,9 +225,13 @@ specifying a variable of the same value." (defun org-babel-python-table-or-string (results) "Convert RESULTS into an appropriate elisp value. -If the results look like a list or tuple, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (let ((res (org-babel-script-escape results))) +If the results look like a list or tuple (but not a dict), then +convert them into an Emacs-lisp table. Otherwise return the +results as a string." + (let ((res (if (and (> (length results) 0) + (string-equal "{" (substring results 0 1))) + results ;don't covert dicts to elisp + (org-babel-script-escape results)))) (if (listp res) (mapcar (lambda (el) (if (eq el 'None) org-babel-python-None-to el)) @@ -169,6 +245,7 @@ Emacs-lisp table, otherwise return the results as a string." (cdr (assoc session org-babel-python-buffers))) (defun org-babel-python-with-earmuffs (session) + "Return SESSION name as string, ensuring *...* around." (let ((name (if (stringp session) session (format "%s" session)))) (if (and (string= "*" (substring name 0 1)) (string= "*" (substring name (- (length name) 1)))) @@ -176,74 +253,113 @@ Emacs-lisp table, otherwise return the results as a string." (format "*%s*" name)))) (defun org-babel-python-without-earmuffs (session) + "Return SESSION name as string, without *...* around." (let ((name (if (stringp session) session (format "%s" session)))) (if (and (string= "*" (substring name 0 1)) (string= "*" (substring name (- (length name) 1)))) (substring name 1 (- (length name) 1)) name))) -(defvar py-which-bufname) -(defvar python-shell-buffer-name) +(defun org-babel-session-buffer:python (session &optional _) + "Return session buffer name for SESSION." + (or (org-babel-python-session-buffer session) + (org-babel-python-with-earmuffs session))) + +(defun org-babel-python--python-util-comint-end-of-output-p () + "Return non-nil if the last prompt matches input prompt. +Backport of `python-util-comint-end-of-output-p' to emacs28. To +be removed after minimum supported version reaches emacs29." + (when-let ((prompt (python-util-comint-last-prompt))) + (python-shell-comint-end-of-output-p + (buffer-substring-no-properties + (car prompt) (cdr prompt))))) + +(defun org-babel-python--command (is-session) + "Helper function to return the Python command. +This checks `org-babel-python-command', and then +`org-babel-python-command-session' (if IS-SESSION) or +`org-babel-python-command-nonsession' (if not IS-SESSION). If +IS-SESSION, this might return `nil', which means to use +`python-shell-calculate-command'." + (or (unless (eq org-babel-python-command 'auto) + org-babel-python-command) + (if is-session + (unless (eq org-babel-python-command-session 'auto) + org-babel-python-command-session) + org-babel-python-command-nonsession))) + (defvar-local org-babel-python--initialized nil "Flag used to mark that python session has been initialized.") +(defun org-babel-python--setup-session () + "Babel Python session setup code, to be run once per session. +Function should be run from within the Python session buffer. +This is often run as a part of `python-shell-first-prompt-hook', +unless the Python session was created outside Org." + (python-shell-send-string-no-output org-babel-python--def-format-value) + (setq-local org-babel-python--initialized t)) (defun org-babel-python-initiate-session-by-key (&optional session) "Initiate a python session. -If there is not a current inferior-process-buffer in SESSION -then create. Return the initialized session." +If there is not a current inferior-process-buffer matching +SESSION then create it. If inferior process already +exists (e.g. if it was manually started with `run-python'), make +sure it's configured to work with ob-python. If session has +already been configured as such, do nothing. Return the +initialized session." (save-window-excursion (let* ((session (if session (intern session) :default)) - (py-buffer (org-babel-python-session-buffer session)) - (cmd (if (member system-type '(cygwin windows-nt ms-dos)) - (concat org-babel-python-command " -i") - org-babel-python-command))) - (cond - ((eq 'python org-babel-python-mode) ; python.el - (unless py-buffer - (setq py-buffer (org-babel-python-with-earmuffs session))) - (let ((python-shell-buffer-name - (org-babel-python-without-earmuffs py-buffer))) - (run-python cmd) - (with-current-buffer py-buffer - (add-hook - 'python-shell-first-prompt-hook - (lambda () - (setq-local org-babel-python--initialized t) - (message "I am running!!!")) - nil 'local)))) - ((and (eq 'python-mode org-babel-python-mode) - (fboundp 'py-shell)) ; python-mode.el - (require 'python-mode) - ;; Make sure that py-which-bufname is initialized, as otherwise - ;; it will be overwritten the first time a Python buffer is - ;; created. - (py-choose-shell) - ;; `py-shell' creates a buffer whose name is the value of - ;; `py-which-bufname' with '*'s at the beginning and end - (let* ((bufname (if (and py-buffer (buffer-live-p py-buffer)) - (replace-regexp-in-string ;; zap surrounding * - "^\\*\\([^*]+\\)\\*$" "\\1" py-buffer) - (concat "Python-" (symbol-name session)))) - (py-which-bufname bufname)) - (setq py-buffer (org-babel-python-with-earmuffs bufname)) - (py-shell nil nil t org-babel-python-command py-buffer nil nil t nil))) - (t - (error "No function available for running an inferior Python"))) - ;; Wait until Python initializes. - (if (eq 'python org-babel-python-mode) ; python.el - ;; This is more reliable compared to - ;; `org-babel-comint-wait-for-output' as python may emit - ;; multiple prompts during initialization. - (with-current-buffer py-buffer - (while (not org-babel-python--initialized) - (sleep-for 0.01))) - (org-babel-comint-wait-for-output py-buffer)) + (py-buffer (org-babel-session-buffer:python session)) + (python-shell-buffer-name + (org-babel-python-without-earmuffs py-buffer)) + (existing-session-p (comint-check-proc py-buffer)) + (cmd (org-babel-python--command t))) + (if cmd + (let* ((cmd-split (split-string-and-unquote cmd)) + (python-shell-interpreter (car cmd-split)) + (python-shell-interpreter-args + (combine-and-quote-strings + (append (cdr cmd-split) + (when (member system-type + '(cygwin windows-nt ms-dos)) + (list "-i")))))) + (run-python)) + (run-python)) + (with-current-buffer py-buffer + (if existing-session-p + ;; Session was created outside Org. Assume first prompt + ;; already happened; run session setup code directly + (unless org-babel-python--initialized + ;; Ensure first prompt. Based on python-tests.el + ;; (`python-tests-shell-wait-for-prompt') + (while (not (org-babel-python--python-util-comint-end-of-output-p)) + (sit-for 0.1)) + (org-babel-python--setup-session)) + ;; Adding to `python-shell-first-prompt-hook' immediately + ;; after `run-python' should be safe from race conditions, + ;; because subprocess output only arrives when Emacs is + ;; waiting (see elisp manual, "Output from Processes") + (add-hook + 'python-shell-first-prompt-hook + #'org-babel-python--setup-session + nil 'local))) + ;; Wait until Python initializes + ;; This is more reliable compared to + ;; `org-babel-comint-wait-for-output' as python may emit + ;; multiple prompts during initialization. + (with-current-buffer py-buffer + (while (not org-babel-python--initialized) + (sleep-for 0.010))) (setq org-babel-python-buffers (cons (cons session py-buffer) (assq-delete-all session org-babel-python-buffers))) session))) (defun org-babel-python-initiate-session (&optional session _params) - "Create a session named SESSION according to PARAMS." + "Initiate Python session named SESSION according to PARAMS. +If there is not a current inferior-process-buffer matching +SESSION then create it. If inferior process already +exists (e.g. if it was manually started with `run-python'), make +sure it's configured to work with ob-python. If session has +already been configured as such, do nothing." (unless (string= session "none") (org-babel-python-session-buffer (org-babel-python-initiate-session-by-key session)))) @@ -251,31 +367,10 @@ then create. Return the initialized session." (defvar org-babel-python-eoe-indicator "org_babel_python_eoe" "A string to indicate that evaluation has completed.") -(defconst org-babel-python-wrapper-method - " -def main(): -%s - -open('%s', 'w').write( str(main()) )") -(defconst org-babel-python-pp-wrapper-method - " -import pprint -def main(): -%s - -open('%s', 'w').write( pprint.pformat(main()) )") - -(defconst org-babel-python--exec-tmpfile "\ -with open('%s') as __org_babel_python_tmpfile: - exec(compile(__org_babel_python_tmpfile.read(), __org_babel_python_tmpfile.name, 'exec'))" - "Template for Python session command with output results. - -Has a single %s escape, the tempfile containing the source code -to evaluate.") - (defun org-babel-python-format-session-value (src-file result-file result-params) - "Return Python code to evaluate SRC-FILE and write result to RESULT-FILE." + "Return Python code to evaluate SRC-FILE and write result to RESULT-FILE. +RESULT-PARAMS defines the result type." (format "\ import ast with open('%s') as __org_babel_python_tmpfile: @@ -286,30 +381,25 @@ if isinstance(__org_babel_python_final, ast.Expr): exec(compile(__org_babel_python_ast, '', 'exec')) __org_babel_python_final = eval(compile(ast.Expression( __org_babel_python_final.value), '', 'eval')) - with open('%s', 'w') as __org_babel_python_tmpfile: - if %s: - import pprint - __org_babel_python_tmpfile.write(pprint.pformat(__org_babel_python_final)) - else: - __org_babel_python_tmpfile.write(str(__org_babel_python_final)) else: exec(compile(__org_babel_python_ast, '', 'exec')) - __org_babel_python_final = None" + __org_babel_python_final = None +__org_babel_python_format_value(__org_babel_python_final, '%s', %s)" (org-babel-process-file-name src-file 'noquote) (org-babel-process-file-name result-file 'noquote) - (if (member "pp" result-params) "True" "False"))) + (org-babel-python-var-to-python result-params))) (defun org-babel-python-evaluate - (session body &optional result-type result-params preamble async) + (session body &optional result-type result-params preamble async graphics-file) "Evaluate BODY as Python code." (if session (if async (org-babel-python-async-evaluate-session - session body result-type result-params) + session body result-type result-params graphics-file) (org-babel-python-evaluate-session - session body result-type result-params)) + session body result-type result-params graphics-file)) (org-babel-python-evaluate-external-process - body result-type result-params preamble))) + body result-type result-params preamble graphics-file))) (defun org-babel-python--shift-right (body &optional count) (with-temp-buffer @@ -325,33 +415,40 @@ else: (buffer-string))) (defun org-babel-python-evaluate-external-process - (body &optional result-type result-params preamble) + (body &optional result-type result-params preamble graphics-file) "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 -last statement in BODY, as elisp." +string. If RESULT-TYPE equals `value' then return the value of +the last statement in BODY, as elisp. If GRAPHICS-FILE is +non-nil, then save graphical results to that file instead." (let ((raw (pcase result-type - (`output (org-babel-eval org-babel-python-command + (`output (org-babel-eval (org-babel-python--command nil) (concat preamble (and preamble "\n") - body))) - (`value (let ((tmp-file (org-babel-temp-file "python-"))) - (org-babel-eval - org-babel-python-command + (if graphics-file + (format org-babel-python--output-graphics-wrapper + body graphics-file) + body)))) + (`value (let ((results-file (or graphics-file + (org-babel-temp-file "python-")))) + (org-babel-eval (org-babel-python--command nil) (concat preamble (and preamble "\n") (format - (if (member "pp" result-params) - org-babel-python-pp-wrapper-method - org-babel-python-wrapper-method) - (org-babel-python--shift-right body) - (org-babel-process-file-name tmp-file 'noquote)))) - (org-babel-eval-read-file tmp-file)))))) + (concat org-babel-python--def-format-value " +def main(): +%s + +__org_babel_python_format_value(main(), '%s', %s)") + (org-babel-python--shift-right body) + (org-babel-process-file-name results-file 'noquote) + (org-babel-python-var-to-python result-params)))) + (org-babel-eval-read-file results-file)))))) (org-babel-result-cond result-params raw - (org-babel-python-table-or-string (org-trim raw))))) + (org-babel-python-table-or-string raw)))) -(defun org-babel-python--send-string (session body) +(defun org-babel-python-send-string (session body) "Pass BODY to the Python process in SESSION. Return output." (with-current-buffer session @@ -369,48 +466,54 @@ finally: print('%s')" (org-babel-python--shift-right body 4) org-babel-python-eoe-indicator))) - (if (not (eq 'python-mode org-babel-python-mode)) - (let ((python-shell-buffer-name - (org-babel-python-without-earmuffs session))) - (python-shell-send-string body)) - (require 'python-mode) - (py-shell-send-string body (get-buffer-process session))) + (let ((python-shell-buffer-name + (org-babel-python-without-earmuffs session))) + (python-shell-send-string body)) ;; same as `python-shell-comint-end-of-output-p' in emacs-25.1+ - (while (not (string-match - org-babel-python-eoe-indicator - string-buffer)) + (while (not (and (python-shell-comint-end-of-output-p string-buffer) + (string-match + org-babel-python-eoe-indicator + string-buffer))) (accept-process-output (get-buffer-process (current-buffer)))) (org-babel-chomp (substring string-buffer 0 (match-beginning 0)))))) (defun org-babel-python-evaluate-session - (session body &optional result-type result-params) + (session body &optional result-type result-params graphics-file) "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 -last statement in BODY, as elisp." +string. If RESULT-TYPE equals `value' then return the value of +the last statement in BODY, as elisp. If GRAPHICS-FILE is +non-nil, then save graphical results to that file instead." (let* ((tmp-src-file (org-babel-temp-file "python-")) (results (progn - (with-temp-file tmp-src-file (insert body)) + (with-temp-file tmp-src-file + (insert (if (and graphics-file (eq result-type 'output)) + (format org-babel-python--output-graphics-wrapper + body graphics-file) + body))) (pcase result-type (`output - (let ((body (format org-babel-python--exec-tmpfile + (let ((body (format "\ +with open('%s') as f: + exec(compile(f.read(), f.name, 'exec'))" (org-babel-process-file-name tmp-src-file 'noquote)))) - (org-babel-python--send-string session body))) + (org-babel-python-send-string session body))) (`value - (let* ((tmp-results-file (org-babel-temp-file "python-")) + (let* ((results-file (or graphics-file + (org-babel-temp-file "python-"))) (body (org-babel-python-format-session-value - tmp-src-file tmp-results-file result-params))) - (org-babel-python--send-string session body) - (sleep-for 0.01) - (org-babel-eval-read-file tmp-results-file))))))) + tmp-src-file results-file result-params))) + (org-babel-python-send-string session body) + (sleep-for 0.010) + (org-babel-eval-read-file results-file))))))) (org-babel-result-cond result-params results (org-babel-python-table-or-string results)))) (defun org-babel-python-read-string (string) - "Strip \\='s from around Python string." + "Strip \\='s from around Python STRING." (if (and (string-prefix-p "'" string) (string-suffix-p "'" string)) (substring string 1 -1) @@ -428,7 +531,7 @@ last statement in BODY, as elisp." (org-babel-python-table-or-string results)))) (defun org-babel-python-async-evaluate-session - (session body &optional result-type result-params) + (session body &optional result-type result-params graphics-file) "Asynchronously evaluate BODY in SESSION. Returns a placeholder string for insertion, to later be replaced by `org-babel-comint-async-filter'." @@ -436,28 +539,37 @@ by `org-babel-comint-async-filter'." session (current-buffer) "ob_comint_async_python_\\(.+\\)_\\(.+\\)" 'org-babel-chomp 'org-babel-python-async-value-callback) - (let ((python-shell-buffer-name (org-babel-python-without-earmuffs session))) - (pcase result-type - (`output - (let ((uuid (md5 (number-to-string (random 100000000))))) - (with-temp-buffer - (insert (format org-babel-python-async-indicator "start" uuid)) - (insert "\n") - (insert body) - (insert "\n") - (insert (format org-babel-python-async-indicator "end" uuid)) - (python-shell-send-buffer)) - uuid)) - (`value - (let ((tmp-results-file (org-babel-temp-file "python-")) - (tmp-src-file (org-babel-temp-file "python-"))) - (with-temp-file tmp-src-file (insert body)) - (with-temp-buffer - (insert (org-babel-python-format-session-value tmp-src-file tmp-results-file result-params)) - (insert "\n") - (insert (format org-babel-python-async-indicator "file" tmp-results-file)) - (python-shell-send-buffer)) - tmp-results-file))))) + (pcase result-type + (`output + (let ((uuid (org-id-uuid))) + (with-temp-buffer + (insert (format org-babel-python-async-indicator "start" uuid)) + (insert "\n") + (insert (if graphics-file + (format org-babel-python--output-graphics-wrapper + body graphics-file) + body)) + (insert "\n") + (insert (format org-babel-python-async-indicator "end" uuid)) + (let ((python-shell-buffer-name + (org-babel-python-without-earmuffs session))) + (python-shell-send-buffer))) + uuid)) + (`value + (let ((results-file (or graphics-file + (org-babel-temp-file "python-"))) + (tmp-src-file (org-babel-temp-file "python-"))) + (with-temp-file tmp-src-file (insert body)) + (with-temp-buffer + (insert (org-babel-python-format-session-value + tmp-src-file results-file result-params)) + (insert "\n") + (unless graphics-file + (insert (format org-babel-python-async-indicator "file" results-file))) + (let ((python-shell-buffer-name + (org-babel-python-without-earmuffs session))) + (python-shell-send-buffer))) + results-file)))) (provide 'ob-python) diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 219a3694452..f6327a361c1 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -59,8 +59,9 @@ (declare-function org-babel-lob-get-info "ob-lob" (&optional datum no-eval)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-post-affiliated "org-element" (node)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) (declare-function org-end-of-meta-data "org" (&optional full)) (declare-function org-find-property "org" (property &optional value)) (declare-function org-id-find-id-file "org-id" (id)) @@ -155,8 +156,9 @@ Emacs Lisp representation of the value of the variable." (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)) + (when (file-exists-p split-file) + (find-file split-file) + (setq ref split-ref))) (org-with-wide-buffer (goto-char (point-min)) (let* ((params (append args '((:results . "none")))) @@ -171,7 +173,7 @@ Emacs Lisp representation of the value of the variable." (let ((e (org-element-at-point))) (when (equal (org-element-property :name e) ref) (goto-char - (org-element-property :post-affiliated e)) + (org-element-post-affiliated e)) (pcase (org-element-type e) (`babel-call (throw :found diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index ef65ea20d06..d920fb585a7 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -73,7 +73,7 @@ It's possible to override it by using a header argument `:ruby'") :type 'symbol) (defun org-babel-execute:ruby (body params) - "Execute a block of Ruby code with Babel. + "Execute Ruby BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-ruby-initiate-session (cdr (assq :session params)) params)) @@ -86,7 +86,7 @@ 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) + (org-require-package 'rcodetools "rcodetools (gem package)") (insert full-body) (xmp (cdr (assq :xmp-option params))) (buffer-string)) @@ -127,7 +127,8 @@ 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. +The assignments are defined in PARAMS." (mapcar (lambda (pair) (format "%s=%s" @@ -140,7 +141,7 @@ This function is called by `org-babel-execute-src-block'." Convert an elisp value into a string of ruby source code specifying a variable of the same value." (if (listp var) - (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]") + (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", \n") "]") (if (eq var 'hline) org-babel-ruby-hline-to (format "%S" var)))) @@ -152,20 +153,28 @@ Emacs-lisp table, otherwise return the results as a string." (let ((res (org-babel-script-escape results))) (if (listp res) (mapcar (lambda (el) (if (not el) - org-babel-ruby-nil-to el)) + org-babel-ruby-nil-to el)) res) res))) +(defvar org-babel-ruby-prompt "_org_babel_ruby_prompt " + "String used for unique prompt.") + +(defvar org-babel-ruby-define-prompt + (format "IRB.conf[:PROMPT][:CUSTOM] = { :PROMPT_I => \"%s\" }" org-babel-ruby-prompt)) + (defun org-babel-ruby-initiate-session (&optional session params) "Initiate a ruby session. If there is not a current inferior-process-buffer in SESSION -then create one. Return the initialized session." +then create one. Return the initialized session. +Session settings (`:ruby' header arg value) are taken from PARAMS." (unless (string= session "none") - (require 'inf-ruby) + (org-require-package 'inf-ruby) (let* ((command (cdr (or (assq :ruby params) (assoc inf-ruby-default-implementation inf-ruby-implementations)))) (buffer (get-buffer (format "*%s*" session))) + (new-session? (not buffer)) (session-buffer (or buffer (save-window-excursion (run-ruby-or-pop-to-buffer (if (functionp command) @@ -176,16 +185,32 @@ then create one. Return the initialized session." (inf-ruby-buffer))) (current-buffer))))) (if (org-babel-comint-buffer-livep session-buffer) - (progn (sit-for .25) session-buffer) + (progn + (sit-for .25) + ;; Setup machine-readable prompt: no echo, prompts matching + ;; uniquely by regexp. + (when new-session? + (with-current-buffer session-buffer + (setq-local + org-babel-comint-prompt-regexp-old comint-prompt-regexp + comint-prompt-regexp (concat "^" org-babel-ruby-prompt)) + (insert org-babel-ruby-define-prompt ";") + (insert "_org_prompt_mode=conf.prompt_mode;conf.prompt_mode=:CUSTOM;") + (insert "conf.echo=false\n") + (comint-send-input nil t))) + session-buffer) (sit-for .5) (org-babel-ruby-initiate-session session))))) (defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe" "String to indicate that evaluation has completed.") + (defvar org-babel-ruby-f-write "File.open('%s','w'){|f| f.write((_.class == String) ? _ : _.inspect)}") + (defvar org-babel-ruby-pp-f-write "File.open('%s','w'){|f| $stdout = f; pp(results); $stdout = orig_out}") + (defvar org-babel-ruby-wrapper-method " def main() @@ -194,6 +219,7 @@ end results = main() File.open('%s', 'w'){ |f| f.write((results.class == String) ? results : results.inspect) } ") + (defvar org-babel-ruby-pp-wrapper-method " require 'pp' @@ -237,7 +263,6 @@ return the value of the last statement in BODY, as elisp." (org-babel-comint-with-output (buffer org-babel-ruby-eoe-indicator t eoe-string) (insert eoe-string) (comint-send-input nil t)) - ;; Now we can start the evaluation. (mapconcat #'identity (butlast @@ -246,14 +271,9 @@ return the value of the last statement in BODY, as elisp." #'org-trim (org-babel-comint-with-output (buffer org-babel-ruby-eoe-indicator t body) - (mapc - (lambda (line) - (insert (org-babel-chomp line)) (comint-send-input nil t)) - (list "conf.echo=false;_org_prompt_mode=conf.prompt_mode;conf.prompt_mode=:NULL" - body - "conf.prompt_mode=_org_prompt_mode;conf.echo=true" - eoe-string))) - "\n") "[\r\n]") 4) "\n"))) + (insert (org-babel-chomp body) "\n" eoe-string) + (comint-send-input nil t)) + "\n") "[\r\n]")) "\n"))) (`value (let* ((tmp-file (org-babel-temp-file "ruby-")) (ppp (or (member "code" result-params) @@ -273,7 +293,7 @@ return the value of the last statement in BODY, as elisp." "results=_" "require 'pp'" "orig_out = $stdout" (format org-babel-ruby-pp-f-write (org-babel-process-file-name tmp-file 'noquote)))) - (list org-babel-ruby-eoe-indicator))) + (list (format "puts \"%s\"" org-babel-ruby-eoe-indicator)))) (comint-send-input nil t)) (org-babel-eval-read-file tmp-file)))))) diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el index d13b975084c..3f04667f276 100644 --- a/lisp/org/ob-scheme.el +++ b/lisp/org/ob-scheme.el @@ -54,7 +54,7 @@ (defvar geiser-debug-jump-to-debug-p) ; Defined in geiser-debug.el (defvar geiser-repl-use-other-window) ; Defined in geiser-repl.el (defvar geiser-repl-window-allow-split) ; Defined in geiser-repl.el - +(declare-function geiser-connect "ext:geiser-repl" (impl &optional host port)) (declare-function run-geiser "ext:geiser-repl" (impl)) (declare-function geiser "ext:geiser-repl" (impl)) (declare-function geiser-mode "ext:geiser-mode" ()) @@ -65,6 +65,9 @@ (declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg)) (declare-function geiser-eval--retort-output "ext:geiser-eval" (ret)) (declare-function geiser-eval--retort-result-str "ext:geiser-eval" (ret prefix)) +(declare-function geiser-eval--retort-error "ext:geiser-eval" (ret)) +(declare-function geiser-eval--retort-error-msg "ext:geiser-eval" (err)) +(declare-function geiser-eval--error-msg "ext:geiser-eval" (err)) (defcustom org-babel-scheme-null-to 'hline "Replace `null' and empty lists in scheme tables with this before returning." @@ -75,6 +78,17 @@ (defvar org-babel-default-header-args:scheme '() "Default header arguments for scheme code blocks.") +(defconst org-babel-header-args:scheme '((host . :any) + (port . :any)) + "Header arguments supported in Scheme.") + +(defun org-babel-scheme-expand-header-arg-vars (vars) + "Expand :var header arguments given as VARS." + (mapconcat + (lambda (var) + (format "(define %S %S)" (car var) (cdr var))) + vars + "\n")) (defun org-babel-expand-body:scheme (body params) "Expand BODY according to PARAMS, return the expanded body." @@ -83,13 +97,7 @@ (postpends (cdr (assq :epilogue params)))) (concat (and prepends (concat prepends "\n")) (if (null vars) body - (format "(let (%s)\n%s\n)" - (mapconcat - (lambda (var) - (format "%S" (print `(,(car var) ',(cdr var))))) - vars - "\n ") - body)) + (concat (org-babel-scheme-expand-header-arg-vars vars) "\n" body)) (and postpends (concat "\n" postpends))))) @@ -116,13 +124,17 @@ (with-current-buffer (set-buffer buffer) geiser-impl--implementation)) -(defun org-babel-scheme-get-repl (impl name) - "Switch to a scheme REPL, creating it if it doesn't exist." +(defun org-babel-scheme-get-repl (impl name &optional host port) + "Switch to a Scheme REPL, creating it if it doesn't exist. + +If the variables HOST and PORT are set, connect to the running Scheme REPL." (let ((buffer (org-babel-scheme-get-session-buffer name))) (or buffer (progn (if (fboundp 'geiser) - (geiser impl) + (if (and host port) + (geiser-connect impl host port) + (geiser impl)) ;; Obsolete since Geiser 0.26. (run-geiser impl)) (when name @@ -159,7 +171,7 @@ org-babel-scheme-execute-with-geiser will use a temporary session." ,@body (current-message)))) -(defun org-babel-scheme-execute-with-geiser (code output impl repl) +(defun org-babel-scheme-execute-with-geiser (code output impl repl &optional host port) "Execute code in specified REPL. If the REPL doesn't exist, create it using the given scheme implementation. @@ -170,45 +182,58 @@ is true; otherwise returns the last value." (with-temp-buffer (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl)) (newline) - (insert code) - (geiser-mode) - (let ((geiser-repl-window-allow-split nil) - (geiser-repl-use-other-window nil)) - (let ((repl-buffer (save-current-buffer - (org-babel-scheme-get-repl impl repl)))) - (when (not (eq impl (org-babel-scheme-get-buffer-impl + (let ((beg (point))) + (insert code) + (geiser-mode) + (let ((geiser-repl-window-allow-split nil) + (geiser-repl-use-other-window nil)) + (let ((repl-buffer (save-current-buffer + (org-babel-scheme-get-repl impl repl host port)))) + (when (not (eq impl (org-babel-scheme-get-buffer-impl (current-buffer)))) - (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) - (org-babel-scheme-get-buffer-impl (current-buffer)) - (symbolp (org-babel-scheme-get-buffer-impl - (current-buffer))))) - (setq geiser-repl--repl repl-buffer) - (setq geiser-impl--implementation nil) - (let ((geiser-debug-jump-to-debug-p nil) - (geiser-debug-show-debug-p nil)) - ;; `geiser-eval-region/wait' was introduced to await the - ;; result of async evaluation in geiser version 0.22. - (let ((ret (funcall (if (fboundp 'geiser-eval-region/wait) - #'geiser-eval-region/wait - #'geiser-eval-region) - (point-min) - (point-max)))) - (setq result (if output - (or (geiser-eval--retort-output ret) - "Geiser Interpreter produced no output") - (geiser-eval--retort-result-str ret ""))))) - (when (not repl) - (save-current-buffer (set-buffer repl-buffer) - (geiser-repl-exit)) - (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) - (kill-buffer repl-buffer))))) + (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) + (org-babel-scheme-get-buffer-impl (current-buffer)) + (symbolp (org-babel-scheme-get-buffer-impl + (current-buffer))))) + (setq geiser-repl--repl repl-buffer) + (setq geiser-impl--implementation nil) + (let ((geiser-debug-jump-to-debug-p nil) + (geiser-debug-show-debug-p nil)) + ;; `geiser-eval-region/wait' was introduced to await the + ;; result of async evaluation in geiser version 0.22. + (let ((ret (funcall (if (fboundp 'geiser-eval-region/wait) + #'geiser-eval-region/wait + #'geiser-eval-region) + ;; Do not include top comment into evaluation. + ;; Apparently, mit-scheme has + ;; problems with the top comment we add: + ;; "Unexpected read restart on: #[textual-i/o-port 27 for console]" + beg + (point-max)))) + (let ((err (geiser-eval--retort-error ret))) + (setq result (cond + (output + (or (geiser-eval--retort-output ret) + "Geiser Interpreter produced no output")) + (err nil) + (t (geiser-eval--retort-result-str ret "")))) + (when (not repl) + (save-current-buffer (set-buffer repl-buffer) + (geiser-repl-exit)) + (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) + (kill-buffer repl-buffer)) + (when err + (let ((msg (geiser-eval--error-msg err))) + (org-babel-eval-error-notify + nil + (concat (if (listp msg) (car msg) msg) "\n"))))))))))) result)) (defun org-babel-scheme--table-or-string (results) "Convert RESULTS into an appropriate elisp value. If the results look like a list or tuple, then convert them into an Emacs-lisp table, otherwise return the results as a string." - (let ((res (org-babel-script-escape results))) + (let ((res (and results (org-babel-script-escape results)))) (cond ((listp res) (mapcar (lambda (el) (if (or (null el) (eq el 'null)) @@ -231,6 +256,8 @@ This function is called by `org-babel-execute-src-block'." geiser-scheme-implementation geiser-default-implementation (car geiser-active-implementations))) + (host (cdr (assq :host params))) + (port (cdr (assq :port params))) (session (org-babel-scheme-make-session-name source-buffer-name (cdr (assq :session params)) impl)) (full-body (org-babel-expand-body:scheme body params)) @@ -240,7 +267,9 @@ This function is called by `org-babel-execute-src-block'." full-body ; code (string= result-type "output") ; output? impl ; implementation - (and (not (string= session "none")) session)))) ; session + (and (not (string= session "none")) session) ; session + host ; REPL host + port))) ; REPL port (let ((table (org-babel-reassemble-table result diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index 5a9c36065e6..ffb66d65967 100644 --- a/lisp/org/ob-screen.el +++ b/lisp/org/ob-screen.el @@ -50,8 +50,8 @@ In case you want to use a different screen than one selected by your $PATH") "Default arguments to use when running screen source blocks.") (defun org-babel-execute:screen (body params) - "Send a block of code via screen to a terminal using Babel. -\"default\" session is used when none is specified." + "Send BODY via screen to a terminal using Babel, according to PARAMS. +\"default\" session is used when none is specified in the PARAMS." (message "Sending source code block to interactive terminal session...") (save-window-excursion (let* ((session (cdr (assq :session params))) diff --git a/lisp/org/ob-shell.el b/lisp/org/ob-shell.el index 0c17f466223..35d9e93761b 100644 --- a/lisp/org/ob-shell.el +++ b/lisp/org/ob-shell.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2009-2024 Free Software Foundation, Inc. ;; Author: Eric Schulte +;; Maintainer: Matthew Trzcinski ;; Keywords: literate programming, reproducible research ;; URL: https://orgmode.org @@ -44,6 +45,11 @@ (declare-function orgtbl-to-generic "org-table" (table params)) (defvar org-babel-default-header-args:shell '()) + +(defconst org-babel-header-args:shell + '((async . ((yes no)))) + "Shell-specific header arguments.") + (defvar org-babel-shell-names) (defconst org-babel-shell-set-prompt-commands @@ -51,8 +57,6 @@ ("fish" . "function fish_prompt\n\techo \"%s\"\nend") ;; prompt2 is like PS2 in POSIX shells. ("csh" . "set prompt=\"%s\"\nset prompt2=\"\"") - ;; PowerShell, similar to fish, does not have PS2 equivalent. - ("posh" . "function prompt { \"%s\" }") ;; PROMPT_COMMAND can override PS1 settings. Disable it. ;; Disable PS2 to avoid garbage in multi-line inputs. (t . "PROMPT_COMMAND=;PS1=\"%s\";PS2=")) @@ -66,28 +70,32 @@ that will be called with a single additional argument: prompt string. The fallback association template is defined in (t . \"template\") alist element.") -(defvar org-babel-prompt-command) - (defun org-babel-shell-initialize () "Define execution functions associated to shell names. This function has to be called whenever `org-babel-shell-names' is modified outside the Customize interface." (interactive) (dolist (name org-babel-shell-names) - (eval `(defun ,(intern (concat "org-babel-execute:" name)) - (body params) - ,(format "Execute a block of %s commands with Babel." name) - (let ((shell-file-name ,name) - (org-babel-prompt-command - (or (cdr (assoc ,name org-babel-shell-set-prompt-commands)) - (alist-get t org-babel-shell-set-prompt-commands)))) - (org-babel-execute:shell body params)))) - (eval `(defalias ',(intern (concat "org-babel-variable-assignments:" name)) - 'org-babel-variable-assignments:shell - ,(format "Return list of %s statements assigning to the block's \ + (let ((fname (intern (concat "org-babel-execute:" name)))) + (defalias fname + (lambda (body params) + (:documentation + (format "Execute a block of %s commands with Babel." name)) + (let ((explicit-shell-file-name name) + (shell-file-name name)) + (org-babel-execute:shell body params)))) + (put fname 'definition-name 'org-babel-shell-initialize)) + (defalias (intern (concat "org-babel-variable-assignments:" name)) + #'org-babel-variable-assignments:shell + (format "Return list of %s statements assigning to the block's \ variables." - name))) - (eval `(defvar ,(intern (concat "org-babel-default-header-args:" name)) '())))) + name)) + (funcall (if (fboundp 'defvar-1) #'defvar-1 #'set) ;Emacs-29 + (intern (concat "org-babel-default-header-args:" name)) + nil) + (funcall (if (fboundp 'defvar-1) #'defvar-1 #'set) ;Emacs-29 + (intern (concat "org-babel-header-args:" name)) + nil))) (defcustom org-babel-shell-names '("sh" "bash" "zsh" "fish" "csh" "ash" "dash" "ksh" "mksh" "posh") @@ -114,7 +122,7 @@ a shell execution being its exit code." :package-version '(Org . "9.4")) (defun org-babel-execute:shell (body params) - "Execute a block of Shell commands with Babel. + "Execute Shell BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-sh-initiate-session (cdr (assq :session params)))) @@ -261,22 +269,38 @@ var of the same value." (org-babel-comint-wait-for-output (current-buffer)) (org-babel-comint-input-command (current-buffer) - (format org-babel-prompt-command org-babel-sh-prompt)) - (setq-local comint-prompt-regexp - (concat "^" (regexp-quote org-babel-sh-prompt) - " *")) + (format + (or (cdr (assoc (file-name-nondirectory shell-file-name) + org-babel-shell-set-prompt-commands)) + (alist-get t org-babel-shell-set-prompt-commands)) + org-babel-sh-prompt)) + (setq-local + org-babel-comint-prompt-regexp-old comint-prompt-regexp + comint-prompt-regexp + (concat "^" (regexp-quote org-babel-sh-prompt) + " *")) ;; Needed for Emacs 23 since the marker is initially ;; undefined and the filter functions try to use it without ;; checking. (set-marker comint-last-output-start (point)) (get-buffer (current-buffer))))))) +(defconst ob-shell-async-indicator "echo 'ob_comint_async_shell_%s_%s'" + "Session output delimiter template. +See `org-babel-comint-async-indicator'.") + +(defun ob-shell-async-chunk-callback (string) + "Filter applied to results before insertion. +See `org-babel-comint-async-chunk-callback'." + (replace-regexp-in-string comint-prompt-regexp "" string)) + (defun org-babel-sh-evaluate (session body &optional params stdin cmdline) "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." (let* ((shebang (cdr (assq :shebang params))) + (async (org-babel-comint-use-async params)) (results-params (cdr (assq :result-params params))) (value-is-exit-status (or (and @@ -308,19 +332,37 @@ return the value of the last statement in BODY." (concat (file-local-name script-file) " " cmdline))))) (buffer-string)))) (session ; session evaluation - (mapconcat - #'org-babel-sh-strip-weird-long-prompt - (mapcar - #'org-trim - (butlast ; Remove eoe indicator - (org-babel-comint-with-output - (session org-babel-sh-eoe-output t body) - (insert (org-trim body) "\n" - org-babel-sh-eoe-indicator) - (comint-send-input nil t)) - ;; Remove `org-babel-sh-eoe-indicator' output line. - 1)) - "\n")) + (if async + (progn + (let ((uuid (org-id-uuid))) + (org-babel-comint-async-register + session + (current-buffer) + "ob_comint_async_shell_\\(.+\\)_\\(.+\\)" + 'ob-shell-async-chunk-callback + nil) + (org-babel-comint-async-delete-dangling-and-eval + session + (insert (format ob-shell-async-indicator "start" uuid)) + (comint-send-input nil t) + (insert (org-trim body)) + (comint-send-input nil t) + (insert (format ob-shell-async-indicator "end" uuid)) + (comint-send-input nil t)) + uuid)) + (mapconcat + #'org-babel-sh-strip-weird-long-prompt + (mapcar + #'org-trim + (butlast ; Remove eoe indicator + (org-babel-comint-with-output + (session org-babel-sh-eoe-output t body) + (insert (org-trim body) "\n" + org-babel-sh-eoe-indicator) + (comint-send-input nil t)) + ;; Remove `org-babel-sh-eoe-indicator' output line. + 1)) + "\n"))) ;; External shell script, with or without a predefined ;; shebang. ((org-string-nw-p shebang) @@ -331,7 +373,13 @@ return the value of the last statement in BODY." (when padline (insert "\n")) (insert body)) (set-file-modes script-file #o755) - (org-babel-eval script-file ""))) + (if (file-remote-p script-file) + ;; Run remote script using its local path as COMMAND. + ;; The remote execution is ensured by setting + ;; correct `default-directory'. + (let ((default-directory (file-name-directory script-file))) + (org-babel-eval (file-local-name script-file) "")) + (org-babel-eval script-file "")))) (t (org-babel-eval shell-file-name (org-trim body)))))) (when (and results value-is-exit-status) (setq results (car (reverse (split-string results "\n" t))))) diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 319d864a051..dc067a41719 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -113,9 +113,7 @@ Set `sql-product' in Org edit buffer according to the corresponding :engine source block header argument." (let ((product (cdr (assq :engine (nth 2 info))))) - (condition-case nil - (sql-set-product product) - (user-error "Cannot set `sql-product' in Org Src edit buffer")))) + (sql-set-product product))) (defun org-babel-sql-dbstring-mysql (host port user password database) "Make MySQL cmd line args for database connection. Pass nil to omit that arg." @@ -409,11 +407,11 @@ argument mechanism." val (if sqlite nil '(:fmt (lambda (el) (if (stringp el) - el - (format "%S" el)))))))) + el + (format "%S" el)))))))) data-file) (if (stringp val) val (format "%S" val)))) - body))) + body t t))) vars) body) diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el index 296c9e3e703..96d93b815b9 100644 --- a/lisp/org/ob-sqlite.el +++ b/lisp/org/ob-sqlite.el @@ -57,13 +57,20 @@ (defun org-babel-expand-body:sqlite (body params) "Expand BODY according to the values of PARAMS." - (org-babel-sql-expand-vars - body (org-babel--get-vars params) t)) + (let ((prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params)))) + (mapconcat 'identity + (list + prologue + (org-babel-sql-expand-vars + body (org-babel--get-vars params) t) + epilogue) + "\n"))) (defvar org-babel-sqlite3-command "sqlite3") (defun org-babel-execute:sqlite (body params) - "Execute a block of Sqlite code with Babel. + "Execute Sqlite BODY according to PARAMS. This function is called by `org-babel-execute-src-block'." (let ((result-params (split-string (or (cdr (assq :results params)) ""))) (db (cdr (assq :db params))) @@ -74,7 +81,6 @@ This function is called by `org-babel-execute-src-block'." (lambda (arg) (car (assq arg params))) (list :header :echo :bail :column :csv :html :line :list))))) - (unless db (error "ob-sqlite: can't evaluate without a database")) (with-temp-buffer (insert (org-babel-eval @@ -97,7 +103,7 @@ This function is called by `org-babel-execute-src-block'." (member :html others) separator) "" "-csv")) - (cons "db " db))) + (cons "db" (or db "")))) ;; body of the code block (org-babel-expand-body:sqlite body params))) (org-babel-result-cond result-params @@ -122,7 +128,8 @@ This function is called by `org-babel-execute-src-block'." (org-babel-sql-expand-vars body vars t)) (defun org-babel-sqlite-table-or-scalar (result) - "If RESULT looks like a trivial table, then unwrap it." + "Cleanup cells in the RESULT table. +If RESULT is a trivial 1x1 table, then unwrap it." (if (and (equal 1 (length result)) (equal 1 (length (car result)))) (org-babel-read (caar result) t) @@ -133,7 +140,7 @@ This function is called by `org-babel-execute-src-block'." result))) (defun org-babel-sqlite-offset-colnames (table headers-p) - "If HEADERS-P is non-nil then offset the first row as column names." + "If HEADERS-P is non-nil then offset the first row as column names in TABLE." (if headers-p (cons (car table) (cons 'hline (cdr table))) table)) diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el index c96875df08b..1ebf10dd3c8 100644 --- a/lisp/org/ob-table.el +++ b/lisp/org/ob-table.el @@ -87,18 +87,20 @@ is the equivalent of the following source code block: results #+end_src -NOTE: The quotation marks around the function name, -`source-block', are optional. +The quotation marks around the function name, `source-block', are +optional. -NOTE: By default, string variable names are interpreted as -references to source-code blocks, to force interpretation of a -cell's value as a string, prefix the identifier a \"$\" (e.g., -\"$$2\" instead of \"$2\" or \"$@2$2\" instead of \"@2$2\"). +By default, string variable names are interpreted as references to +source-code blocks, to force interpretation of a cell's value as a +string, prefix the identifier a \"$\" (e.g., \"$$2\" instead of \"$2\" +or \"$@2$2\" instead of \"@2$2\"). \"$\" will also force interpreting +string value literally: $\"value\" will refer to a string, not a +source block name. -NOTE: It is also possible to pass header arguments to the code -block. In this case a table cell should hold the string value of -the header argument which can then be passed before all variables -as shown in the example below. +It is also possible to pass header arguments to the code block. In +this case a table cell should hold the string value of the header +argument which can then be passed before all variables as shown in the +example below. | 1 | 2 | :file nothing.png | nothing.png | #+TBLFM: @1$4=\\='(org-sbe test-sbe $3 (x $1) (y $2))" @@ -117,7 +119,7 @@ as shown in the example below. (prog1 nil (setq quote t)) (prog1 (cond - (quote (format "\"%s\"" el)) + (quote (format "%S" el)) ((stringp el) (org-no-properties el)) (t el)) (setq quote nil)))) diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index 13c928df316..c89763efad7 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -40,11 +40,11 @@ (declare-function org-babel-update-block-body "ob-core" (new-body)) (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-before-first-heading-p "org" ()) -(declare-function org-element--cache-active-p "org-element" ()) -(declare-function org-element-lineage "org-element" (datum &optional types with-self)) -(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-lineage "org-element-ast" (datum &optional types with-self)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-begin "org-element" (node)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-heading-components "org" ()) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-in-archived-heading-p "org" (&optional no-inheritance)) @@ -166,6 +166,23 @@ read-write permissions for the user, read-only for everyone else." :package-version '(Org . "9.6") :type 'integer) +(defcustom org-babel-tangle-remove-file-before-write 'auto + "How to overwrite the existing tangle target. +When set to nil, `org-babel-tangle' will replace contents of an existing +tangle target (and fail when tangle target is read-only). +When set to t, the tangle target (including read-only) will be deleted +first and a new file, possibly with different ownership and +permissions, will be created. +When set to symbol `auto', overwrite read-only tangle targets and +replace contents otherwise." + :group 'org-babel-tangle + :package-version '(Org . "9.7") + :type '(choice + (const :tag "Replace contents, but keep the same file" nil) + (const :tag "Re-create file" t) + (const :tag "Re-create when read-only" auto)) + :safe t) + (defun org-babel-find-file-noselect-refresh (file) "Find file ensuring that the latest changes on disk are represented in the file." @@ -205,21 +222,20 @@ source code blocks by languages matching a regular expression. Return list of the tangled file names." (interactive "fFile to tangle: \nP") - (let* ((visited (find-buffer-visiting file)) - (buffer (or visited (find-file-noselect file)))) - (prog1 - (with-current-buffer buffer - (org-with-wide-buffer - (mapcar #'expand-file-name - (org-babel-tangle nil target-file lang-re)))) - (unless visited (kill-buffer buffer))))) + (org-with-file-buffer file + (org-with-wide-buffer + (mapcar #'expand-file-name + (org-babel-tangle nil target-file lang-re))))) (defun org-babel-tangle-publish (_ filename pub-dir) "Tangle FILENAME and place the results in PUB-DIR." (unless (file-exists-p pub-dir) (make-directory pub-dir t)) (setq pub-dir (file-name-as-directory pub-dir)) - (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) + ;; Rename files to avoid copying to same file when publishing to ./ + ;; `copy-file' would throw an error when copying file to self. + (mapc (lambda (el) (rename-file el pub-dir t)) + (org-babel-tangle-file filename))) ;;;###autoload (defun org-babel-tangle (&optional arg target-file lang-re) @@ -253,7 +269,8 @@ matching a regular expression." (when (equal arg '(16)) (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'no-eval)))) (user-error "Point is not in a source code block")))) - path-collector) + path-collector + (source-file buffer-file-name)) (mapc ;; map over file-names (lambda (by-fn) (let ((file-name (car by-fn))) @@ -310,10 +327,28 @@ matching a regular expression." (compare-buffer-substrings nil nil nil tangle-buf nil nil))))))) - ;; erase previous file - (when (file-exists-p file-name) + (when (equal (if (file-name-absolute-p file-name) + file-name + (expand-file-name file-name)) + (if (file-name-absolute-p source-file) + source-file + (expand-file-name source-file))) + (error "Not allowed to tangle into the same file as self")) + ;; We do not erase, but overwrite previous file + ;; to preserve any existing symlinks. + ;; This behavior is modified using + ;; `org-babel-tangle-remove-file-before-write' to + ;; tangle to read-only files. + (when (and + (file-exists-p file-name) + (pcase org-babel-tangle-remove-file-before-write + (`auto (not (file-writable-p file-name))) + (`t t) + (`nil nil) + (_ (error "Invalid value of `org-babel-tangle-remove-file-before-write': %S" + org-babel-tangle-remove-file-before-write)))) (delete-file file-name)) - (write-region nil nil file-name) + (write-region nil nil file-name) (mapc (lambda (mode) (set-file-modes file-name mode)) modes)) (push file-name path-collector)))))) (if (equal arg '(4)) @@ -378,7 +413,7 @@ references." (goto-char (point-min)) (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t) (re-search-forward (org-babel-noweb-wrap) nil t)) - (delete-region (save-excursion (beginning-of-line 1) (point)) + (delete-region (save-excursion (forward-line) (point)) (save-excursion (end-of-line 1) (forward-char 1) (point))))) (defun org-babel-spec-to-string (spec) @@ -427,17 +462,19 @@ that the appropriate major-mode is set. SPEC has the form: org-babel-tangle-comment-format-end link-data))))) (defun org-babel-effective-tangled-filename (buffer-fn src-lang src-tfile) - "Return effective tangled filename of a source-code block. -BUFFER-FN is the name of the buffer, SRC-LANG the language of the -block and SRC-TFILE is the value of the :tangle header argument, -as computed by `org-babel-tangle-single-block'." - (let ((base-name (cond - ((string= "yes" src-tfile) - ;; Use the buffer name - (file-name-sans-extension buffer-fn)) - ((string= "no" src-tfile) nil) - ((> (length src-tfile) 0) src-tfile))) - (ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang))) + "Return effective tangled absolute filename of a source-code block. +BUFFER-FN is the absolute file name of the buffer, SRC-LANG the +language of the block and SRC-TFILE is the value of the :tangle +header argument, as computed by `org-babel-tangle-single-block'." + (let* ((fnd (file-name-directory buffer-fn)) + (base-name (cond + ((string= "yes" src-tfile) + ;; Use the buffer name + (file-name-sans-extension buffer-fn)) + ((string= "no" src-tfile) nil) + ((> (length src-tfile) 0) + (expand-file-name src-tfile fnd)))) + (ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang))) (when base-name ;; decide if we want to add ext to base-name (if (and ext (string= "yes" src-tfile)) @@ -454,13 +491,16 @@ source code blocks by languages matching a regular expression. Optional argument TANGLE-FILE can be used to limit the collected code blocks by target file." - (let ((counter 0) last-heading-pos blocks) + (let ((counter 0) + (buffer-fn (buffer-file-name (buffer-base-buffer))) + last-heading-pos blocks) (org-babel-map-src-blocks (buffer-file-name) (let ((current-heading-pos - (if (org-element--cache-active-p) - (or (org-element-property :begin (org-element-lineage (org-element-at-point) '(headline) t)) 1) - (org-with-wide-buffer - (org-with-limited-levels (outline-previous-heading)))))) + (or (org-element-begin + (org-element-lineage + (org-element-at-point) + 'headline t)) + 1))) (if (eq last-heading-pos current-heading-pos) (cl-incf counter) (setq counter 1) (setq last-heading-pos current-heading-pos))) @@ -470,6 +510,7 @@ code blocks by target file." (src-lang (nth 0 info)) (src-tfile (cdr (assq :tangle (nth 2 info))))) (unless (or (string= src-tfile "no") + (not src-lang) ;; src block without lang (and tangle-file (not (equal tangle-file src-tfile))) (and lang-re (not (string-match-p lang-re src-lang)))) ;; Add the spec for this block to blocks under its tangled @@ -477,7 +518,7 @@ code blocks by target file." (let* ((block (org-babel-tangle-single-block counter)) (src-tfile (cdr (assq :tangle (nth 4 block)))) (file-name (org-babel-effective-tangled-filename - (nth 1 block) src-lang src-tfile)) + buffer-fn src-lang src-tfile)) (by-fn (assoc file-name blocks))) (if by-fn (setcdr by-fn (cons (cons src-lang block) (cdr by-fn))) (push (cons file-name (list (cons src-lang block))) blocks))))))) @@ -491,12 +532,7 @@ code blocks by target file." The PARAMS are the 3rd element of the info for the same src block." (unless (string= "no" (cdr (assq :comments params))) (save-match-data - (let* (;; The created link is transient. Using ID is not necessary, - ;; but could have side-effects if used. An ID property may - ;; be added to existing entries thus creating unexpected file - ;; modifications. - (org-id-link-to-org-use-id nil) - (l (org-no-properties + (let* ((l (org-no-properties (cl-letf (((symbol-function 'org-store-link-functions) (lambda () nil))) (org-store-link nil)))) @@ -589,13 +625,12 @@ non-nil, return the full association list to be used by link source-name params - (if org-src-preserve-indentation - (org-trim body t) + (if (org-src-preserve-indentation-p) (org-trim body t) (org-trim (org-remove-indentation body))) comment))) (if only-this-block (let* ((file-name (org-babel-effective-tangled-filename - (nth 1 result) src-lang src-tfile))) + file src-lang src-tfile))) (list (cons file-name (list (cons src-lang result))))) result))) @@ -616,9 +651,12 @@ by `org-babel-get-src-block-info'." ;; de-tangling functions (defun org-babel-detangle (&optional source-code-file) - "Propagate changes in source file back original to Org file. + "Propagate changes from current source buffer back to the original Org file. This requires that code blocks were tangled with link comments -which enable the original code blocks to be found." +which enable the original code blocks to be found. + +Optional argument SOURCE-CODE-FILE is the file path to be used instead +of the current buffer." (interactive) (save-excursion (when source-code-file (find-file source-code-file)) @@ -673,8 +711,7 @@ which enable the original code blocks to be found." (org-back-to-heading t)) ;; Do not skip the first block if it begins at point min. (cond ((or (org-at-heading-p) - (not (eq (org-element-type (org-element-at-point)) - 'src-block))) + (not (org-element-type-p (org-element-at-point) 'src-block))) (org-babel-next-src-block n)) ((= n 1)) (t (org-babel-next-src-block (1- n))))) diff --git a/lisp/org/oc-basic.el b/lisp/org/oc-basic.el index f05a4da8aab..6e3142fa12b 100644 --- a/lisp/org/oc-basic.el +++ b/lisp/org/oc-basic.el @@ -1,4 +1,4 @@ -;;; oc-basic.el --- basic back-end for citations -*- lexical-binding: t; -*- +;;; oc-basic.el --- basic backend for citations -*- lexical-binding: t; -*- ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. @@ -78,9 +78,19 @@ (declare-function org-open-at-point "org" (&optional arg)) (declare-function org-open-file "org" (path &optional in-emacs line search)) +(declare-function org-element-create "org-element-ast" (type &optional props &rest children)) +(declare-function org-element-set "org-element-ast" (old new &optional keep-props)) + (declare-function org-element-interpret-data "org-element" (data)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) +(declare-function org-element-map "org-element" + ( data types fun + &optional + info first-match no-recursion + with-affiliated no-undefer)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-type-p "org-element-ast" (node types)) +(declare-function org-element-contents "org-element-ast" (node)) (declare-function org-export-data "org-export" (data info)) (declare-function org-export-derived-backend-p "org-export" (backend &rest backends)) @@ -272,6 +282,9 @@ Optional argument INFO is the export state, as a property list." (plist-get info :cite-basic/bibliography) (let ((results nil)) (dolist (file (org-cite-list-bibliography-files)) + ;; Follow symlinks, to look into modification time of the + ;; actual file, not its symlink. + (setq file (file-truename file)) (when (file-readable-p file) (with-temp-buffer (when (or (org-file-has-changed-p file) @@ -330,9 +343,11 @@ FIELD is a symbol. ENTRY-OR-KEY is either an association list, as returned by Optional argument INFO is the export state, as a property list. -Return value may be nil or a string. If current export back-end is derived -from `latex', return a raw string instead, unless optional argument RAW is -non-nil." +Return value may be nil or a string. If current export backend is derived +from `latex', return a raw string object instead, unless optional +argument RAW is non-nil. + +Throw an error if the field value is non-string and non-nil." (let ((value (cdr (assq field @@ -343,6 +358,8 @@ non-nil." entry-or-key) (_ (error "Wrong value for ENTRY-OR-KEY: %S" entry-or-key))))))) + (when (and value (not (stringp value))) + (error "Non-string bibliography field value: %S" value)) (if (and value (not raw) (org-export-derived-backend-p (plist-get info :back-end) 'latex)) @@ -351,17 +368,27 @@ non-nil." (defun org-cite-basic--shorten-names (names) "Return a list of family names from a list of full NAMES. +NAMES can be a string or raw string object. To better accomomodate corporate names, this will only shorten personal names of the form \"family, given\"." - (when (stringp names) - (mapconcat - (lambda (name) - (if (eq 1 (length name)) - (cdr (split-string name)) - (car (split-string name ", ")))) - (split-string names " and ") - ", "))) + (let (names-string raw-p) + (cond + ((stringp names) (setq names-string names)) + ((org-element-type-p names 'raw) + (setq names-string (mapconcat #'identity (org-element-contents names) "") + raw-p t))) + (when names-string + (setq names-string + (mapconcat + (lambda (name) + (if (eq 1 (length name)) + (cdr (split-string name)) + (car (split-string name ", ")))) + (split-string names-string " and ") + ", ")) + (if raw-p (org-export-raw-string names-string) + names-string)))) (defun org-cite-basic--number-to-suffix (n) "Compute suffix associated to number N. @@ -417,7 +444,7 @@ necessary, unless optional argument NO-SUFFIX is non-nil." (year (or (org-cite-basic--get-field 'year entry-or-key info 'raw) (let ((date - (org-cite-basic--get-field 'date entry-or-key info t))) + (org-cite-basic--get-field 'date entry-or-key info 'raw))) (and (stringp date) (string-match (rx string-start (group (= 4 digit)) @@ -445,6 +472,38 @@ necessary, unless optional argument NO-SUFFIX is non-nil." new)))) (if no-suffix year (concat year suffix))))))) +(defun org-cite-basic--print-bibtex-string (element &optional info) + "Print Bibtex formatted string ELEMENT, according to Bibtex syntax. +Remove all the {...} that are not a part of LaTeX macros and parse the +LaTeX fragments. Do nothing when current backend is derived from +LaTeX, according to INFO. + +Return updated ELEMENT." + (if (org-export-derived-backend-p (plist-get info :back-end) 'latex) + ;; Derived from LaTeX, no need to use manual ad-hoc LaTeX + ;; parser. + element + ;; Convert ELEMENT to anonymous when ELEMENT is string. + ;; Otherwise, we cannot modify ELEMENT by side effect. + (when (org-element-type-p element 'plain-text) + (setq element (org-element-create 'anonymous nil element))) + ;; Approximately parse LaTeX fragments, assuming Org mode syntax + ;; (it is close to original LaTeX, and we do not want to + ;; re-implement complete LaTeX parser here)) + (org-element-map element t + (lambda (str) + (when (stringp str) + (org-element-set + str + (org-element-parse-secondary-string + str '(latex-fragment entity)))))) + ;; Strip the remaining { and }. + (org-element-map element t + (lambda (str) + (when (stringp str) + (org-element-set str (replace-regexp-in-string "[{}]" "" str))))) + element)) + (defun org-cite-basic--print-entry (entry style &optional info) "Format ENTRY according to STYLE string. ENTRY is an alist, as returned by `org-cite-basic--get-entry'. @@ -456,27 +515,29 @@ Optional argument INFO is the export state, as a property list." (org-cite-basic--get-field 'journal entry info) (org-cite-basic--get-field 'institution entry info) (org-cite-basic--get-field 'school entry info)))) - (pcase style - ("plain" - (let ((year (org-cite-basic--get-year entry info 'no-suffix))) - (org-cite-concat - (org-cite-basic--shorten-names author) ". " - title (and from (list ", " from)) ", " year "."))) - ("numeric" - (let ((n (org-cite-basic--key-number (cdr (assq 'id entry)) info)) - (year (org-cite-basic--get-year entry info 'no-suffix))) - (org-cite-concat - (format "[%d] " n) author ", " - (org-cite-emphasize 'italic title) - (and from (list ", " from)) ", " - year "."))) - ;; Default to author-year. Use year disambiguation there. - (_ - (let ((year (org-cite-basic--get-year entry info))) - (org-cite-concat - author " (" year "). " - (org-cite-emphasize 'italic title) - (and from (list ", " from)) ".")))))) + (org-cite-basic--print-bibtex-string + (pcase style + ("plain" + (let ((year (org-cite-basic--get-year entry info 'no-suffix))) + (org-cite-concat + (org-cite-basic--shorten-names author) ". " + title (and from (list ", " from)) ", " year "."))) + ("numeric" + (let ((n (org-cite-basic--key-number (cdr (assq 'id entry)) info)) + (year (org-cite-basic--get-year entry info 'no-suffix))) + (org-cite-concat + (format "[%d] " n) author ", " + (org-cite-emphasize 'italic title) + (and from (list ", " from)) ", " + year "."))) + ;; Default to author-year. Use year disambiguation there. + (_ + (let ((year (org-cite-basic--get-year entry info))) + (org-cite-concat + author " (" year "). " + (org-cite-emphasize 'italic title) + (and from (list ", " from)) ".")))) + info))) ;;; "Activate" capability @@ -580,8 +641,8 @@ INFO is the export state, as a property list." (suffix (org-element-property :suffix ref))) (funcall format-ref prefix - (org-cite-basic--get-author k info) - (org-cite-basic--get-year k info) + (or (org-cite-basic--get-author k info) "??") + (or (org-cite-basic--get-year k info) "????") suffix))) (org-cite-get-references citation) org-cite-basic-author-year-separator) @@ -619,7 +680,7 @@ INFO is the export state as a property list." INFO is the export state, as a property list." (and field (lambda (a b) - (string-collate-lessp + (org-string< (org-cite-basic--get-field field a info 'raw) (org-cite-basic--get-field field b info 'raw) nil t)))) @@ -649,20 +710,30 @@ export communication channel, as a property list." ;; "author" style. (`(,(or "author" "a") . ,variant) (let ((caps (member variant '("caps" "c")))) - (org-export-data - (mapconcat - (lambda (key) - (let ((author (org-cite-basic--get-author key info))) - (if caps (capitalize author) author))) - (org-cite-get-references citation t) - org-cite-basic-author-year-separator) + (org-cite-basic--format-author-year + citation + (lambda (p c s) (org-cite-concat p c s)) + (lambda (prefix author _ suffix) + (org-cite-concat + prefix + (if caps (org-cite-capitalize author) author) + suffix)) info))) ;; "noauthor" style. (`(,(or "noauthor" "na") . ,variant) - (format (if (funcall has-variant-p variant 'bare) "%s" "(%s)") - (mapconcat (lambda (key) (org-cite-basic--get-year key info)) - (org-cite-get-references citation t) - org-cite-basic-author-year-separator))) + (let ((bare? (funcall has-variant-p variant 'bare))) + (org-cite-basic--format-author-year + citation + (lambda (prefix contents suffix) + (org-cite-concat + (unless bare? "(") + prefix + contents + suffix + (unless bare? ")"))) + (lambda (prefix _ year suffix) + (org-cite-concat prefix year suffix)) + info))) ;; "nocite" style. (`(,(or "nocite" "n") . ,_) nil) ;; "text" and "note" styles. @@ -678,10 +749,11 @@ export communication channel, as a property list." (lambda (p c s) (org-cite-concat p c s)) (lambda (p a y s) (org-cite-concat p - (if caps (capitalize a) a) + (if caps (org-cite-capitalize a) a) (if bare " " " (") - y s - (and (not bare) ")"))) + y + (and (not bare) ")") + s)) info))) ;; "numeric" style. ;; @@ -702,7 +774,7 @@ export communication channel, as a property list." (lambda (p c s) (org-cite-concat (and (not bare) "(") p c s (and (not bare) ")"))) (lambda (p a y s) - (org-cite-concat p (if caps (capitalize a) a) ", " y s)) + (org-cite-concat p (if caps (org-cite-capitalize a) a) ", " y s)) info))) ;; This should not happen. (_ (error "Invalid style: %S" style))))) @@ -710,7 +782,7 @@ export communication channel, as a property list." (defun org-cite-basic-export-bibliography (keys _files style _props backend info) "Generate bibliography. KEYS is the list of cited keys, as strings. STYLE is the expected bibliography -style, as a string. BACKEND is the export back-end, as a symbol. INFO is the +style, as a string. BACKEND is the export backend, as a symbol. INFO is the export state, as a property list." (mapconcat (lambda (entry) @@ -734,7 +806,7 @@ When DATUM is a citation reference, open bibliography entry referencing the citation key. Otherwise, select which key to follow among all keys present in the citation." (let* ((key - (if (eq 'citation-reference (org-element-type datum)) + (if (org-element-type-p datum 'citation-reference) (org-element-property :key datum) (pcase (org-cite-get-references datum t) (`(,key) key) @@ -806,7 +878,7 @@ Return nil if there are no bibliography files or no entries." (let ((date (org-cite-basic--get-year entry nil 'no-suffix))) (format "%4s" (or date ""))) org-cite-basic-column-separator - (org-cite-basic--get-field 'title entry nil t)))) + (org-cite-basic--get-field 'title entry nil 'raw)))) (puthash completion key org-cite-basic--completion-cache))) (unless (map-empty-p org-cite-basic--completion-cache) ;no key (puthash entries t org-cite-basic--completion-cache) diff --git a/lisp/org/oc-biblatex.el b/lisp/org/oc-biblatex.el index 098a37bd850..4755ac6b286 100644 --- a/lisp/org/oc-biblatex.el +++ b/lisp/org/oc-biblatex.el @@ -70,7 +70,8 @@ (require 'org-macs) (require 'oc) -(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-parent "org-element-ast" (node)) (declare-function org-export-data "org-export" (data info)) @@ -189,20 +190,23 @@ INITIAL is an initial style of comma-separated options, as a string or nil. STYLE is the style definition as a string or nil. Return a string." - (let ((options-no-style - (and initial - (let ((re (rx string-start (or "bibstyle" "citestyle" "style")))) - (seq-filter - (lambda (option) (not (string-match re option))) - (split-string (org-unbracket-string "[" "]" initial) - "," t " \t"))))) - (style-options - (cond - ((null style) nil) - ((not (string-match "/" style)) (list (concat "style=" style))) - (t - (list (concat "bibstyle=" (substring style nil (match-beginning 0))) - (concat "citestyle=" (substring style (match-end 0)))))))) + (let* ((options-no-style + (and initial + (let ((re (rx string-start (or "bibstyle" "citestyle" "style")))) + (seq-filter + (lambda (option) (not (string-match re option))) + (split-string (org-unbracket-string "[" "]" initial) + "," t " \t"))))) + ;; Check whether the string is in key=val,... + (biblatex-options-p (and (stringp style) (string-match-p "\\`[^,=]+=[^,]+\\(,[^=]+=[^,]+\\)\\'" style))) + (style-options + (cond + ((null style) nil) + ;; Assume it is a valid options string for biblatex if it is in key=val,... format + ((not (string-match "/" style)) (list (if biblatex-options-p style (concat "style=" style)))) + (t + (list (concat "bibstyle=" (substring style nil (match-beginning 0))) + (concat "citestyle=" (substring style (match-end 0)))))))) (if (or options-no-style style-options) (format "[%s]" (mapconcat #'identity @@ -231,7 +235,7 @@ When NO-OPT argument is non-nil, only provide mandatory arguments." (let* ((origin (pcase references (`(,reference) reference) (`(,reference . ,_) - (org-element-property :parent reference)))) + (org-element-parent reference)))) (suffix (org-element-property :suffix origin)) (prefix (org-element-property :prefix origin))) (concat (and prefix diff --git a/lisp/org/oc-bibtex.el b/lisp/org/oc-bibtex.el index 8d04daef97b..5e65df5fe61 100644 --- a/lisp/org/oc-bibtex.el +++ b/lisp/org/oc-bibtex.el @@ -41,7 +41,7 @@ (require 'oc) -(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-property "org-element-ast" (property node)) (declare-function org-export-data "org-export" (data info)) diff --git a/lisp/org/oc-csl.el b/lisp/org/oc-csl.el index ccdf028339e..b8691bf6f54 100644 --- a/lisp/org/oc-csl.el +++ b/lisp/org/oc-csl.el @@ -134,11 +134,12 @@ (declare-function citeproc-render-bib "ext:citeproc") (declare-function citeproc-hash-itemgetter-from-any "ext:citeproc") (declare-function citeproc-add-subbib-filters "ext:citeproc") +(declare-function citeproc-style-cite-superscript-p "ext:citeproc") (declare-function org-element-interpret-data "org-element" (data)) (declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-put-property "org-element" (element property value)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-put-property "org-element-ast" (node property value)) (declare-function org-export-data "org-export" (data info)) (declare-function org-export-derived-backend-p "org-export" (backend &rest backends)) @@ -184,8 +185,8 @@ looks for style files in this directory, too." :safe #'booleanp) (defcustom org-cite-csl-no-citelinks-backends '(ascii) - "List of export back-ends for which cite linking is disabled. -Cite linking for export back-ends derived from any of the back-ends listed here, + "List of export backends for which cite linking is disabled. +Cite linking for export backends derived from any of the backends listed here, is also disabled." :group 'org-cite :package-version '(Org . "9.5") @@ -214,6 +215,112 @@ Used only when `second-field-align' is activated by the used CSL style." :type 'string :safe #'stringp) +(defcustom org-cite-csl-latex-label-separator "0.6em" + "Distance between citation label and bibliography item for LaTeX output. +The value is a string representing the distance in valid LaTeX units. +Used only when `second-field-align' is activated by the used CSL +style. + +The indentation length in these cases is computed as the sum of +`org-cite-csl-latex-label-separator' and the maximal label width, for +example, + + indentation length +<-------------------------> +max. label width separator +<---------------><--------> +[Doe22] John Doe. A title... +[DoeSmithJones19] John Doe, Jane Smith and... +[SmithDoe02] Jane Smith and John Doe... + +The maximal label width, in turn, is calculated as the product of +`org-cite-csl-latex-label-width-per-char' and the maximal label +length measured in characters." + :group 'org-cite + :package-version '(Org . "9.7") + :type 'string + :safe #'stringp) + +(defcustom org-cite-csl-latex-label-width-per-char "0.45em" + "Character width in LaTeX units for calculating entry label widths. +Used only when `second-field-align' is activated by the used CSL +style. + +See the documentation of `org-cite-csl-latex-label-separator' for +details." + :group 'org-cite + :package-version '(Org . "9.7") + :type 'string + :safe #'stringp) + +;; The following was inspired by and in many details follows how +;; Pandoc's () default LaTeX template +;; handles CSL output. Many thanks to the author, John MacFarlane! +(defcustom org-cite-csl-latex-preamble + "\\usepackage{calc} +\\newlength{\\cslhangindent} +\\setlength{\\cslhangindent}{[CSL-HANGINDENT]} +\\newlength{\\csllabelsep} +\\setlength{\\csllabelsep}{[CSL-LABELSEP]} +\\newlength{\\csllabelwidth} +\\setlength{\\csllabelwidth}{[CSL-LABELWIDTH-PER-CHAR] * [CSL-MAXLABEL-CHARS]} +\\newenvironment{cslbibliography}[2] % 1st arg. is hanging-indent, 2nd entry spacing. + {% By default, paragraphs are not indented. + \\setlength{\\parindent}{0pt} + % Hanging indent is turned on when first argument is 1. + \\ifodd #1 + \\let\\oldpar\\par + \\def\\par{\\hangindent=\\cslhangindent\\oldpar} + \\fi + % Set entry spacing based on the second argument. + \\setlength{\\parskip}{\\parskip + #2\\baselineskip} + }% + {} +\\newcommand{\\cslblock}[1]{#1\\hfill\\break} +\\newcommand{\\cslleftmargin}[1]{\\parbox[t]{\\csllabelsep + \\csllabelwidth}{#1}} +\\newcommand{\\cslrightinline}[1] + {\\parbox[t]{\\linewidth - \\csllabelsep - \\csllabelwidth}{#1}\\break} +\\newcommand{\\cslindent}[1]{\\hspace{\\cslhangindent}#1} +\\newcommand{\\cslbibitem}[2] + {\\leavevmode\\vadjust pre{\\hypertarget{citeproc_bib_item_#1}{}}#2} +\\makeatletter +\\newcommand{\\cslcitation}[2] + {\\protect\\hyper@linkstart{cite}{citeproc_bib_item_#1}#2\\hyper@linkend} +\\makeatother" + "LaTeX preamble content inserted by the `csl' citation processor. + +This preamble can be anything as long as it provides definitions +for the environment and commands that Citeproc's `org-latex' +formatter uses for formatting citations and bibliographies. In +particular, it has to define +- the commands \\cslblock{}, \\cslleftmargin{}, + \\cslrightinline{} and \\cslindent{} for formatting + text that have, respectively, the CSL display attributes + `block', `left-margin', `right-inline' and `indent'; +- the commands \\cslcitation{}{} and + \\cslbibitem{}{}, which are used to + format individual citations and bibliography items, including + hyperlinking citations to the corresponding bibliography entry + using their numerical id, which is passed as the first, + argument; +- and the environment \\cslbibliography{}{}, + in which bibliographies are wrapped; the value of the + argument is 1 if hanging indent should be + applied and 0 if not, while the argument is an + integer specifying the number of extra line-heights + required between bibliography entries in addition to normal + line spacing. + +When present, the placeholders [CSL-HANGINDENT], [CSL-LABELSEP], +[CSL-LABELWIDTH-PER-CHAR] and [CSL-MAXLABEL-CHARS] are replaced, +respectively, by the contents of the customizable variables +`org-cite-csl-latex-hanging-indent', `org-cite-csl-latex-label-separator', +`org-cite-csl-latex-label-width-per-char', and the maximal label length +in the bibliography measured in characters." + :group 'org-cite + :type 'string + :package-version '(Org . "9.7")) + ;;; Internal variables (defconst org-cite-csl--etc-dir @@ -277,13 +384,17 @@ If nil then the Chicago author-date style is used as a fallback.") ("paragraph" . "paragraph") ("para." . "paragraph") ("paras." . "paragraph") + ("\\P" . "paragraph") ("¶" . "paragraph") + ("\\P\\P" . "paragraph") ("¶¶" . "paragraph") ("part" . "part") ("pt." . "part") ("pts." . "part") ("§" . "section") + ("\\S" . "section") ("§§" . "section") + ("\\S\\S" . "section") ("section" . "section") ("sec." . "section") ("secs." . "section") @@ -312,10 +423,6 @@ Label is in match group 1.") ;;; Internal functions -(defun org-cite-csl--barf-without-citeproc () - "Raise an error if Citeproc library is not loaded." - (unless (featurep 'citeproc) - (error "Citeproc library is not loaded"))) (defun org-cite-csl--note-style-p (info) "Non-nil when bibliography style implies wrapping citations in footnotes. @@ -324,6 +431,13 @@ INFO is the export state, as a property list." (citeproc-proc-style (org-cite-csl--processor info)))) +(defun org-cite-csl--style-cite-superscript-p (info) + "Non-nil when bibliography style produces citations in superscript. +INFO is the export state, as a property list." + (citeproc-style-cite-superscript-p + (citeproc-proc-style + (org-cite-csl--processor info)))) + (defun org-cite-csl--nocite-p (citation info) "Non-nil when CITATION object's style is nocite. INFO is the export state, as a property list." @@ -332,8 +446,8 @@ INFO is the export state, as a property list." (defun org-cite-csl--create-structure-params (citation info) "Return citeproc structure creation params for CITATION object. -STYLE is the citation style, as a string or nil. INFO is the export state, as -a property list." +STYLE is the citation style, as a string or nil. INFO is the export +state, as a property list." (let ((style (org-cite-citation-style citation info))) (pcase style ;; "author" style. @@ -393,7 +507,8 @@ a property list." (_ (error "Invalid style: %S" style))))) (defun org-cite-csl--no-citelinks-p (info) - "Non-nil when export BACKEND should not create cite-reference links." + "Non-nil when export backend should not create cite-reference links. +INFO is the info channel plist." (or (not org-cite-csl-link-cites) (and org-cite-csl-no-citelinks-backends (apply #'org-export-derived-backend-p @@ -413,7 +528,7 @@ corresponding to one of the output formats supported by Citeproc: `html', (let ((backend (plist-get info :back-end))) (cond ((org-export-derived-backend-p backend 'html) 'html) - ((org-export-derived-backend-p backend 'latex) 'latex) + ((org-export-derived-backend-p backend 'latex) 'org-latex) (t 'org)))) (defun org-cite-csl--style-file (info) @@ -569,6 +684,9 @@ INFO is the export state, as a property list." (when (and (not footnote) (org-cite-csl--note-style-p info)) (org-cite-adjust-note citation info) (setq footnote (org-cite-wrap-citation citation info))) + ;; Remove white space before CITATION when it is in superscript. + (when (org-cite-csl--style-cite-superscript-p info) + (org-cite--set-previous-post-blank citation 0 info)) ;; Return structure. (apply #'citeproc-citation-create `(:note-index @@ -670,12 +788,27 @@ value is the bibliography as rendered by Citeproc." (plist-put info :cite-citeproc-rendered-bibliographies result) result))))) +(defun org-cite-csl--generate-latex-preamble (info) + "Generate the CSL-related part of the LaTeX preamble. +INFO is the export state, as a property list." + (let* ((parameters (cadr (org-cite-csl--rendered-bibliographies info))) + (max-offset (cdr (assq 'max-offset parameters))) + (result org-cite-csl-latex-preamble)) + (map-do (lambda (placeholder replacement) + (when (string-match placeholder result) + (setq result (replace-match replacement t t result)))) + `("\\[CSL-HANGINDENT\\]" ,org-cite-csl-latex-hanging-indent + "\\[CSL-LABELSEP\\]" ,org-cite-csl-latex-label-separator + "\\[CSL-LABELWIDTH-PER-CHAR\\]" ,org-cite-csl-latex-label-width-per-char + "\\[CSL-MAXLABEL-CHARS\\]" ,(number-to-string max-offset))) + result)) + ;;; Export capability (defun org-cite-csl-render-citation (citation _style _backend info) "Export CITATION object. INFO is the export state, as a property list." - (org-cite-csl--barf-without-citeproc) + (org-require-package 'citeproc) (let ((output (cdr (assq citation (org-cite-csl--rendered-citations info))))) (if (not (eq 'org (org-cite-csl--output-format info))) output @@ -686,10 +819,10 @@ INFO is the export state, as a property list." (defun org-cite-csl-render-bibliography (_keys _files _style props _backend info) "Export bibliography. INFO is the export state, as a property list." - (org-cite-csl--barf-without-citeproc) + (org-require-package 'citeproc) (pcase-let* ((format (org-cite-csl--output-format info)) - (`(,outputs ,parameters) (org-cite-csl--rendered-bibliographies info)) - (output (cdr (assoc props outputs)))) + (`(,outputs ,parameters) (org-cite-csl--rendered-bibliographies info)) + (output (cdr (assoc props outputs)))) (pcase format ('html (concat @@ -714,12 +847,7 @@ INFO is the export state, as a property list." org-cite-csl-html-hanging-indent org-cite-csl-html-hanging-indent)) output)) - ('latex - (if (cdr (assq 'hanging-indent parameters)) - (format "\\begin{hangparas}{%s}{1}\n%s\n\\end{hangparas}" - org-cite-csl-latex-hanging-indent - output) - output)) + ('org-latex output) (_ ;; Parse Org output to re-export it during the regular export ;; process. @@ -729,19 +857,15 @@ INFO is the export state, as a property list." "Add \"hanging\" package if missing from LaTeX output. OUTPUT is the export document, as a string. INFO is the export state, as a property list." - (org-cite-csl--barf-without-citeproc) - (if (not (eq 'latex (org-cite-csl--output-format info))) + (org-require-package 'citeproc) + (if (not (eq 'org-latex (org-cite-csl--output-format info))) output (with-temp-buffer (save-excursion (insert output)) (when (search-forward "\\begin{document}" nil t) - (goto-char (match-beginning 0)) - ;; Ensure that \citeprocitem is defined for citeproc-el. - (insert "\\makeatletter\n\\newcommand{\\citeprocitem}[2]{\\hyper@linkstart{cite}{citeproc_bib_item_#1}#2\\hyper@linkend}\n\\makeatother\n\n") - ;; Ensure there is a \usepackage{hanging} somewhere or add one. - (let ((re (rx "\\usepackage" (opt "[" (*? nonl) "]") "{hanging}"))) - (unless (re-search-backward re nil t) - (insert "\\usepackage[notquote]{hanging}\n")))) + (goto-char (match-beginning 0)) + ;; Insert the CSL-specific parts of the LaTeX preamble. + (insert (org-cite-csl--generate-latex-preamble info))) (buffer-string)))) diff --git a/lisp/org/oc-natbib.el b/lisp/org/oc-natbib.el index 0dddca0e2b4..e6b971c0598 100644 --- a/lisp/org/oc-natbib.el +++ b/lisp/org/oc-natbib.el @@ -48,7 +48,7 @@ (require 'oc) -(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-property "org-element-ast" (property node)) (declare-function org-export-data "org-export" (data info)) @@ -77,6 +77,15 @@ If \"natbib\" package is already required in the document, e.g., through (const :tag "redefine \\thebibliography to issue \\section* instead of \\chapter*" sectionbib) (const :tag "keep all the authors' names in a citation on one line" nonamebreak))) +(defcustom org-cite-natbib-bibliography-style 'unsrtnat + "Default bibliography style." + :group 'org-cite + :package-version '(Org . "9.7") + :type + '(choice + (const unsrtnat) + (symbol :tag "Other"))) + ;;; Internal functions (defun org-cite-natbib--style-to-command (style) @@ -143,11 +152,13 @@ CITATION is the citation object. INFO is the export state, as a property list." "Print references from bibliography FILES. FILES is a list of absolute file names. STYLE is the bibliography style, as a string or nil." - (concat (and style (format "\\bibliographystyle{%s}\n" style)) - (format "\\bibliography{%s}" - (mapconcat #'file-name-sans-extension - files - ",")))) + (concat + (format "\\bibliographystyle{%s}\n" + (or style org-cite-natbib-bibliography-style)) + (format "\\bibliography{%s}" + (mapconcat #'file-name-sans-extension + files + ",")))) (defun org-cite-natbib-export-citation (citation style _ info) "Export CITATION object. diff --git a/lisp/org/oc.el b/lisp/org/oc.el index 4270d67787a..af7f380295d 100644 --- a/lisp/org/oc.el +++ b/lisp/org/oc.el @@ -46,8 +46,8 @@ ;; The "export" capability is slightly more involved as one need to ;; select the processor providing it, but may also provide a default ;; style for citations and bibliography. Also, the choice of an -;; export processor may depend of the current export back-end. The -;; association between export back-ends and triplets of parameters can +;; export processor may depend of the current export backend. The +;; association between export backends and triplets of parameters can ;; be set in `org-cite-export-processors' variable, or in a document, ;; through the "cite_export" keyword. @@ -71,25 +71,33 @@ (declare-function org-at-heading-p "org" (&optional _)) (declare-function org-collect-keywords "org" (keywords &optional unique directory)) -(declare-function org-element-adopt-elements "org-element" (parent &rest children)) +(declare-function org-element-adopt "org-element-ast" (parent &rest children)) (declare-function org-element-citation-parser "org-element" ()) (declare-function org-element-citation-reference-parser "org-element" ()) (declare-function org-element-class "org-element" (datum &optional parent)) -(declare-function org-element-contents "org-element" (element)) -(declare-function org-element-create "org-element" (type &optional props &rest children)) -(declare-function org-element-extract-element "org-element" (element)) -(declare-function org-element-insert-before "org-element" (element location)) -(declare-function org-element-lineage "org-element" (datum &optional types with-self)) +(declare-function org-element-contents "org-element-ast" (node)) +(declare-function org-element-create "org-element-ast" (type &optional props &rest children)) +(declare-function org-element-extract "org-element-ast" (node)) +(declare-function org-element-insert-before "org-element-ast" (node location)) +(declare-function org-element-lineage "org-element-ast" (datum &optional types with-self)) (declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated)) (declare-function org-element-normalize-string "org-element" (s)) -(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) +(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only keep-deferred)) (declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) (declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-put-property "org-element" (element property value)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-begin "org-element" (node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-post-affiliated "org-element" (node)) +(declare-function org-element-post-blank "org-element" (node)) +(declare-function org-element-contents-begin "org-element" (node)) +(declare-function org-element-contents-end "org-element" (node)) +(declare-function org-element-parent "org-element-ast" (node)) +(declare-function org-element-put-property "org-element-ast" (node property value)) (declare-function org-element-restriction "org-element" (element)) -(declare-function org-element-set-element "org-element" (old new)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-set "org-element-ast" (old new)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-export-derived-backend-p "org-export" (backend &rest backends)) (declare-function org-export-get-next-element "org-export" (blob info &optional n)) @@ -143,12 +151,12 @@ File names must be absolute." When nil, citations and bibliography are not exported. -When non-nil, the value is an association list between export back-ends and +When non-nil, the value is an association list between export backends and citation export processors: - (BACK-END . PROCESSOR) + (BACKEND . PROCESSOR) -where BACK-END is the name of an export back-end or t, and PROCESSOR is a +where BACKEND is the name of an export backend or t, and PROCESSOR is a triplet following the pattern (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) @@ -160,7 +168,7 @@ exporting a citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and CITATION-STYLE are optional. NAME is mandatory. The export process selects the citation processor associated to the current -export back-end, or the most specific back-end the current one is derived from, +export backend, or the most specific backend the current one is derived from, or, if all are inadequate, to the processor associated to t. For example, with the following value @@ -168,9 +176,9 @@ the following value (latex biblatex) (t csl)) -exporting with `beamer' or any back-end derived from it will use `natbib', -whereas exporting with `latex' or any back-end derived from it but different -from `beamer' will use `biblatex' processor. Any other back-end, such as +exporting with `beamer' or any backend derived from it will use `natbib', +whereas exporting with `latex' or any backend derived from it but different +from `beamer' will use `biblatex' processor. Any other backend, such as `html', will use `csl' processor. CITATION-STYLE is overridden by adding a style to any citation object. A nil @@ -187,7 +195,7 @@ or #+CITE_EXPORT: basic In that case, `basic' processor is used on every export, independently on the -back-end." +backend." :group 'org-cite :package-version '(Org . "9.5") :type '(choice (const :tag "No export" nil) @@ -345,7 +353,7 @@ optional keys can be set: arguments: the list of citation keys used in the document, as strings, a list of bibliography files, the style, as a string or nil, the local properties, as a property list, the export - back-end, as a symbol, and the communication channel, as a + backend, as a symbol, and the communication channel, as a property list. It is called at each \"print_bibliography\" keyword in the @@ -358,7 +366,7 @@ optional keys can be set: Function rendering citations. It is called with four arguments: a citation object, the style, as a pair, the - export back-end, as a symbol, and the communication channel, + export backend, as a symbol, and the communication channel, as a property list. It is called on each citation object in the parse tree. It @@ -373,7 +381,7 @@ optional keys can be set: six arguments: the output, as a string, a list of citation keys used in the document, a list of bibliography files, the expected bibliography style, as a string or nil, the export - back-end, as a symbol, and the communication channel, as a + backend, as a symbol, and the communication channel, as a property list. It must return a string, which will become the final output @@ -468,11 +476,11 @@ PROCESSOR is the name of a cite processor, as a symbol. CAPABILITY is "Set `:post-blank' property from element or object before DATUM to BLANKS. DATUM is an element or object. BLANKS is an integer. DATUM is modified by side-effect." - (if (not (eq 'plain-text (org-element-type datum))) + (if (not (org-element-type-p datum 'plain-text)) (org-element-put-property datum :post-blank blanks) ;; Remove any blank from string before DATUM so it is exported ;; with exactly BLANKS white spaces. - (org-element-set-element + (org-element-set datum (replace-regexp-in-string "[ \t\n]*\\'" (make-string blanks ?\s) datum)))) @@ -492,11 +500,11 @@ S is split at beginning of match group N upon matching REGEXP against it. This function assumes S precedes CITATION." ;; When extracting the citation, remove white spaces before it, but ;; preserve those after it. - (let ((post-blank (org-element-property :post-blank citation))) + (let ((post-blank (org-element-post-blank citation))) (when (and post-blank (> post-blank 0)) (org-element-insert-before (make-string post-blank ?\s) citation))) (org-element-insert-before - (org-element-put-property (org-element-extract-element citation) + (org-element-put-property (org-element-extract citation) :post-blank 0) s) (string-match regexp s) @@ -510,21 +518,21 @@ This function assumes S precedes CITATION." (substring s split)))) (when (org-string-nw-p first-part) (org-element-insert-before first-part citation)) - (org-element-set-element s last-part))) + (org-element-set s last-part))) (defun org-cite--move-punct-before (punct citation s info) "Move punctuation PUNCT before CITATION object. String S contains PUNCT. INFO is the export state, as a property list. The function assumes S follows CITATION. Parse tree is modified by side-effect." (if (equal s punct) - (org-element-extract-element s) ;it would be empty anyway - (org-element-set-element s (substring s (length punct)))) + (org-element-extract s) ;it would be empty anyway + (org-element-set s (substring s (length punct)))) ;; Remove blanks before citation. (org-cite--set-previous-post-blank citation 0 info) (org-element-insert-before ;; Blanks between citation and punct are now before punct and ;; citation. - (concat (make-string (or (org-element-property :post-blank citation) 0) ?\s) + (concat (make-string (or (org-element-post-blank citation) 0) ?\s) punct) citation)) @@ -602,7 +610,18 @@ to (adaptive outside after)." (append (mapcar (lambda (value) (pcase value (`(,f . ,d) - (expand-file-name (org-strip-quotes f) d)))) + (setq f (org-strip-quotes f)) + (if (or (file-name-absolute-p f) + (file-remote-p f) + (equal d default-directory)) + ;; Keep absolute paths, remote paths, and + ;; local relative paths. + f + ;; Adjust relative bibliography path for + ;; #+SETUP files located in other directory. + ;; Also, see `org-export--update-included-link'. + (file-relative-name + (expand-file-name f d) default-directory))))) (pcase (org-collect-keywords '("BIBLIOGRAPHY") nil '("BIBLIOGRAPHY")) (`(("BIBLIOGRAPHY" . ,pairs)) pairs))) @@ -619,12 +638,12 @@ or from the current buffer." (let ((contents (org-element-contents citation))) (cond ((null contents) - (org-with-point-at (org-element-property :contents-begin citation) - (narrow-to-region (point) (org-element-property :contents-end citation)) + (org-with-point-at (org-element-contents-begin citation) + (narrow-to-region (point) (org-element-contents-end citation)) (let ((references nil)) (while (not (eobp)) (let ((reference (org-element-citation-reference-parser))) - (goto-char (org-element-property :end reference)) + (goto-char (org-element-end reference)) (push (if keys-only (org-element-property :key reference) reference) @@ -636,8 +655,8 @@ or from the current buffer." (defun org-cite-boundaries (citation) "Return the beginning and end strict position of CITATION. Returns a (BEG . END) pair." - (let ((beg (org-element-property :begin citation)) - (end (org-with-point-at (org-element-property :end citation) + (let ((beg (org-element-begin citation)) + (end (org-with-point-at (org-element-end citation) (skip-chars-backward " \t") (point)))) (cons beg end))) @@ -646,15 +665,15 @@ Returns a (BEG . END) pair." "Return citation REFERENCE's key boundaries as buffer positions. The function returns a pair (START . END) where START and END denote positions in the current buffer. Positions include leading \"@\" character." - (org-with-point-at (org-element-property :begin reference) - (let ((end (org-element-property :end reference))) + (org-with-point-at (org-element-begin reference) + (let ((end (org-element-end reference))) (re-search-forward org-element-citation-key-re end t) (cons (match-beginning 0) (match-end 0))))) (defun org-cite-main-affixes (citation) "Return main affixes for CITATION object. -Some export back-ends only support a single pair of affixes per +Some export backends only support a single pair of affixes per citation, even if it contains multiple keys. This function decides what affixes are the most appropriate. @@ -730,7 +749,7 @@ When removing the last reference, also remove the whole citation." (org-with-point-at begin (skip-chars-backward " \t") (point))) - (pos-after-blank (org-element-property :end datum)) + (pos-after-blank (org-element-end datum)) (first-on-line? (= pos-before-blank (line-beginning-position))) (last-on-line? @@ -753,22 +772,22 @@ When removing the last reference, also remove the whole citation." (when (= pos-after-blank end) (org-with-point-at pos-before-blank (insert " "))))))) ('citation-reference - (let* ((citation (org-element-property :parent datum)) + (let* ((citation (org-element-parent datum)) (references (org-cite-get-references citation)) - (begin (org-element-property :begin datum)) - (end (org-element-property :end datum))) + (begin (org-element-begin datum)) + (end (org-element-end datum))) (cond ;; Single reference. ((= 1 (length references)) (org-cite-delete-citation citation)) ;; First reference, no prefix. - ((and (= begin (org-element-property :contents-begin citation)) + ((and (= begin (org-element-contents-begin citation)) (not (org-element-property :prefix citation))) - (org-with-point-at (org-element-property :begin datum) + (org-with-point-at (org-element-begin datum) (skip-chars-backward " \t") (delete-region (point) end))) ;; Last reference, no suffix. - ((and (= end (org-element-property :contents-end citation)) + ((and (= end (org-element-contents-end citation)) (not (org-element-property :suffix citation))) (delete-region (1- begin) (1- (cdr (org-cite-boundaries citation))))) ;; Somewhere in-between. @@ -838,6 +857,11 @@ tokens. Spurious spaces are ignored." s)) (nreverse result)))) +(defun org-cite-processor (info) + "Return expected citation/bibliography processor. +INFO is a plist used as a communication channel." + (car (plist-get info :cite-export))) + (defun org-cite-bibliography-style (info) "Return expected bibliography style. INFO is a plist used as a communication channel." @@ -937,11 +961,12 @@ the sole contents of the footnote, e.g., after calling `org-cite-wrap-citation'. When non-nil, the return value if the footnote container." (let ((footnote - (org-element-lineage citation - '(footnote-definition footnote-reference)))) + (org-element-lineage + citation + '(footnote-definition footnote-reference)))) (and footnote (or (not strict) - (equal (org-element-contents (org-element-property :parent citation)) + (equal (org-element-contents (org-element-parent citation)) (list citation))) ;; Return value. footnote))) @@ -959,15 +984,15 @@ Return newly created footnote object." (list 'footnote-reference (list :label nil :type 'inline - :contents-begin (org-element-property :begin citation) - :contents-end (org-element-property :end citation) - :post-blank (org-element-property :post-blank citation))))) + :contents-begin (org-element-begin citation) + :contents-end (org-element-end citation) + :post-blank (org-element-post-blank citation))))) ;; Remove any white space before citation. (org-cite--set-previous-post-blank citation 0 info) ;; Footnote swallows citation. (org-element-insert-before footnote citation) - (org-element-adopt-elements footnote - (org-element-extract-element citation)))) + (org-element-adopt footnote + (org-element-extract citation)))) (defun org-cite-adjust-note (citation info &optional rule punct) "Adjust note number location for CITATION object, and punctuation around it. @@ -1046,8 +1071,8 @@ the same object, call `org-cite-adjust-note' first." ;; as an argument is not available. (rx-to-string `(seq string-start ,final-punct) t) "" next))) - (org-element-set-element previous new-prev) - (org-element-set-element next new-next) + (org-element-set previous new-prev) + (org-element-set next new-next) (setq previous new-prev) (setq next new-next) (setq punct final-punct) @@ -1066,15 +1091,15 @@ the same object, call `org-cite-adjust-note' first." (replace-regexp-in-string previous-punct-re "" previous nil nil 1)) (new-next (if (stringp next) (concat punct next) punct))) - (org-element-set-element previous new-prev) + (org-element-set previous new-prev) (cond ((stringp next) - (org-element-set-element next new-next)) + (org-element-set next new-next)) (next (org-element-insert-before new-next next)) (t - (org-element-adopt-elements - (org-element-property :parent citation) + (org-element-adopt + (org-element-parent citation) new-next))) (setq previous new-prev) (setq next new-next) @@ -1141,7 +1166,7 @@ raises an error if S contains a headline." (insert s) (pcase (org-element-contents (org-element-parse-buffer)) ('nil nil) - (`(,(and section (guard (eq 'section (org-element-type section))))) + (`(,(and section (guard (org-element-type-p section 'section)))) (org-element-contents section)) (_ (error "Headlines cannot replace a keyword"))))) @@ -1201,14 +1226,23 @@ and must return either a string, an object, or a secondary string." (org-cite-concat result separator (funcall function datum)))) result))) +(defun org-cite-capitalize (str) + "Capitalize string of raw string object STR." + (cond + ((stringp str) (capitalize str)) + ((org-element-type-p str 'raw) + (org-export-raw-string + (capitalize (mapconcat #'identity (org-element-contents str) "")))) + (t (error "%S must be either a string or raw string object" str)))) + ;;; Internal interface with fontification (activate capability) (defun org-cite-fontify-default (cite) "Fontify CITE with `org-cite' and `org-cite-key' faces. CITE is a citation object. The function applies `org-cite' face on the whole citation, and `org-cite-key' face on each key." - (let ((beg (org-element-property :begin cite)) - (end (org-with-point-at (org-element-property :end cite) + (let ((beg (org-element-begin cite)) + (end (org-with-point-at (org-element-end cite) (skip-chars-backward " \t") (point)))) (add-text-properties beg end '(font-lock-multiline t)) @@ -1237,7 +1271,7 @@ from the processor set in `org-cite-activate-processor'." (save-match-data (funcall activate cite)) ;; Move after cite object and make sure to return ;; a non-nil value. - (goto-char (org-element-property :end cite))))))) + (goto-char (org-element-end cite))))))) ;;; Internal interface with Org Export library (export capability) @@ -1274,12 +1308,12 @@ side-effect." ;; Value is an alist. It must come from ;; `org-cite-export-processors' variable. Find the most ;; appropriate processor according to current export - ;; back-end. + ;; backend. ((and (pred consp) alist) (let* ((backend (plist-get info :back-end)) (candidates ;; Limit candidates to processors associated to - ;; back-ends derived from or equal to the current + ;; backends derived from or equal to the current ;; one. (sort (seq-filter (pcase-lambda (`(,key . ,_)) @@ -1331,7 +1365,7 @@ selected citation processor." (defun org-cite-export-bibliography (keyword _ info) "Return bibliography associated to \"print_bibliography\" KEYWORD. -BACKEND is the export back-end, as a symbol. INFO is a plist +BACKEND is the export backend, as a symbol. INFO is a plist used as a communication channel." (pcase (plist-get info :cite-export) ('nil nil) @@ -1355,7 +1389,7 @@ INFO is the communication channel, as a plist. Parse tree is modified by side-effect." (dolist (cite (org-cite-list-citations info)) (let ((replacement (org-cite-export-citation cite nil info)) - (blanks (or (org-element-property :post-blank cite) 0))) + (blanks (or (org-element-post-blank cite) 0))) (if (null replacement) ;; Before removing the citation, transfer its `:post-blank' ;; property to the object before, if any. @@ -1389,7 +1423,7 @@ by side-effect." (_ (error "Invalid return value from citation export processor: %S" replacement)))) - (org-element-extract-element cite)))) + (org-element-extract cite)))) (defun org-cite-process-bibliography (info) "Replace all \"print_bibliography\" keywords in the parse tree. @@ -1400,18 +1434,18 @@ by side effect." (lambda (keyword) (when (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key keyword)) (let ((replacement (org-cite-export-bibliography keyword nil info)) - (blanks (or (org-element-property :post-blank keyword) 0))) + (blanks (or (org-element-post-blank keyword) 0))) (pcase replacement ;; Before removing the citation, transfer its ;; `:post-blank' property to the element before, if any. ('nil (org-cite--set-previous-post-blank keyword blanks info) - (org-element-extract-element keyword)) + (org-element-extract keyword)) ;; Handle `:post-blank' before replacing keyword with string. ((pred stringp) (let ((output (concat (org-element-normalize-string replacement) (make-string blanks ?\n)))) - (org-element-set-element keyword (org-export-raw-string output)))) + (org-element-set keyword (org-export-raw-string output)))) ;; List of elements: splice contents before keyword and ;; remove the latter. Transfer `:post-blank' to last ;; element. @@ -1421,11 +1455,11 @@ by side effect." (setq last datum) (org-element-insert-before datum keyword)) (org-cite--set-post-blank last blanks) - (org-element-extract-element keyword))) + (org-element-extract keyword))) ;; Single element: replace the keyword. (`(,(pred symbolp) . ,_) (org-cite--set-post-blank replacement blanks) - (org-element-set-element keyword replacement)) + (org-element-set keyword replacement)) (_ (error "Invalid return value from citation export processor: %S" replacement)))))) @@ -1481,7 +1515,7 @@ CONTEXT is the element or object at point, as returned by `org-element-context'. ;; ;; XXX: Inserting citation in a secondary value is not allowed ;; yet. Is it useful? - ((let ((post (org-element-property :post-affiliated context))) + ((let ((post (org-element-post-affiliated context))) (and post (< (point) post))) (let ((case-fold-search t)) (looking-back @@ -1497,14 +1531,14 @@ CONTEXT is the element or object at point, as returned by `org-element-context'. ((memq type '(nil paragraph))) ;; So are contents of verse blocks. ((eq type 'verse-block) - (and (>= (point) (org-element-property :contents-begin context)) - (< (point) (org-element-property :contents-end context)))) + (and (>= (point) (org-element-contents-begin context)) + (< (point) (org-element-contents-end context)))) ;; In an headline or inlinetask, point must be either on the ;; heading itself or on the blank lines below. ((memq type '(headline inlinetask)) (or (not (org-at-heading-p)) (and (save-excursion - (beginning-of-line) + (forward-line 0) (and (let ((case-fold-search t)) (not (looking-at-p "\\*+ END[ \t]*$"))) (let ((case-fold-search nil)) @@ -1523,43 +1557,43 @@ CONTEXT is the element or object at point, as returned by `org-element-context'. ;; White spaces after an object or blank lines after an element ;; are OK. ((>= (point) - (save-excursion (goto-char (org-element-property :end context)) - (skip-chars-backward " \r\t\n") - (if (eq (org-element-class context) 'object) (point) - (line-beginning-position 2))))) + (save-excursion (goto-char (org-element-end context)) + (skip-chars-backward " \r\t\n") + (if (eq (org-element-class context) 'object) (point) + (line-beginning-position 2))))) ;; At the beginning of a footnote definition, right after the ;; label, is OK. ((eq type 'footnote-definition) (looking-at (rx space))) ;; At the start of a list item is fine, as long as the bullet is ;; unaffected. ((eq type 'item) - (> (point) (+ (org-element-property :begin context) + (> (point) (+ (org-element-begin context) (org-current-text-indentation) (if (org-element-property :checkbox context) 5 1)))) ;; Other elements are invalid. ((eq (org-element-class context) 'element) nil) ;; Just before object is fine. - ((= (point) (org-element-property :begin context))) + ((= (point) (org-element-begin context))) ;; Within recursive object too, but not in a link. ((eq type 'link) nil) ((eq type 'table-cell) ;; :contents-begin is not reliable on empty cells, so special ;; case it. (<= (save-excursion (skip-chars-backward " \t") (point)) - (org-element-property :contents-end context))) - ((let ((cbeg (org-element-property :contents-begin context)) - (cend (org-element-property :contents-end context))) + (org-element-contents-end context))) + ((let ((cbeg (org-element-contents-begin context)) + (cend (org-element-contents-end context))) (and cbeg (>= (point) cbeg) (<= (point) cend))))))) (defun org-cite--insert-string-before (string reference) "Insert STRING before citation REFERENCE object." - (org-with-point-at (org-element-property :begin reference) + (org-with-point-at (org-element-begin reference) (insert string ";"))) (defun org-cite--insert-string-after (string reference) "Insert STRING after citation REFERENCE object." - (org-with-point-at (org-element-property :end reference) + (org-with-point-at (org-element-end reference) ;; Make sure to move forward when we're inserting at point, so the ;; insertion can happen multiple times. (if (char-equal ?\; (char-before)) @@ -1630,7 +1664,7 @@ More specifically, ;; action depends on the point. (if arg (org-cite-delete-citation context) - (let* ((begin (org-element-property :begin context)) + (let* ((begin (org-element-begin context)) (style-end (1- (org-with-point-at begin (search-forward ":"))))) (if (>= style-end (point)) ;; On style part, edit the style. @@ -1644,7 +1678,7 @@ More specifically, ;; point. (let* ((references (org-cite-get-references context)) (key (concat "@" (funcall select-key nil)))) - (if (< (point) (org-element-property :contents-begin context)) + (if (< (point) (org-element-contents-begin context)) (org-cite--insert-string-before key (car references)) (org-cite--insert-string-after key (org-last references)))))))) ;; On a citation reference. If ARG is not nil, remove the @@ -1699,7 +1733,7 @@ ARG is the prefix argument received when calling interactively the function." (let ((context (org-element-context)) (insert (org-cite-processor-insert (org-cite-get-processor name)))) (cond - ((memq (org-element-type context) '(citation citation-reference)) + ((org-element-type-p context '(citation citation-reference)) (funcall insert context arg)) ((org-cite--allowed-p context) (funcall insert nil arg)) diff --git a/lisp/org/ol-bbdb.el b/lisp/org/ol-bbdb.el index dba587e345e..573e1ee8679 100644 --- a/lisp/org/ol-bbdb.el +++ b/lisp/org/ol-bbdb.el @@ -226,7 +226,7 @@ date year)." ;;; Implementation -(defun org-bbdb-store-link () +(defun org-bbdb-store-link (&optional _interactive?) "Store a link to a BBDB database entry." (when (eq major-mode 'bbdb-mode) ;; This is BBDB, we make this link! @@ -255,7 +255,7 @@ italicized, in all other cases it is left unchanged." (defun org-bbdb-open (name _) "Follow a BBDB link to NAME." - (require 'bbdb-com) + (org-require-package 'bbdb-com "bbdb") (let ((inhibit-redisplay (not debug-on-error))) (if (fboundp 'bbdb-name) (org-bbdb-open-old name) @@ -369,7 +369,7 @@ This is used by Org to re-create the anniversary hash table." "Extract anniversaries from BBDB for display in the agenda. When called programmatically, this function expects the `date' variable to be globally bound." - (require 'bbdb) + (org-require-package 'bbdb) (require 'diary-lib) (unless (hash-table-p org-bbdb-anniv-hash) (setq org-bbdb-anniv-hash @@ -500,7 +500,7 @@ must be positive")) (defun org-bbdb-complete-link () "Read a bbdb link with name completion." - (require 'bbdb-com) + (org-require-package 'bbdb-com "bbdb") (let ((rec (bbdb-completing-read-record "Name: "))) (concat "bbdb:" (bbdb-record-name (if (listp rec) @@ -509,7 +509,7 @@ must be positive")) (defun org-bbdb-anniv-export-ical () "Extract anniversaries from BBDB and convert them to icalendar format." - (require 'bbdb) + (org-require-package 'bbdb) (require 'diary-lib) (unless (hash-table-p org-bbdb-anniv-hash) (setq org-bbdb-anniv-hash diff --git a/lisp/org/ol-bibtex.el b/lisp/org/ol-bibtex.el index ea4b54cc25a..850a2fc2084 100644 --- a/lisp/org/ol-bibtex.el +++ b/lisp/org/ol-bibtex.el @@ -266,7 +266,7 @@ a missing title field." :type 'boolean) (defcustom org-bibtex-headline-format-function - (lambda (entry) (cdr (assq :title entry))) + #'org-bibtex-headline-format-default "Function returning the headline text for `org-bibtex-write'. It should take a single argument, the bibtex entry (an alist as returned by `org-bibtex-read'). The default value simply returns @@ -507,7 +507,7 @@ ARG, when non-nil, is a universal prefix argument. See `org-open-file' for details." (org-link-open-as-file path arg)) -(defun org-bibtex-store-link () +(defun org-bibtex-store-link (&optional _interactive?) "Store a link to a BibTeX entry." (when (eq major-mode 'bibtex-mode) (let* ((search (org-create-file-search-in-bibtex)) @@ -636,22 +636,27 @@ With prefix argument OPTIONAL also prompt for optional fields." With prefix argument OPTIONAL also prompt for optional fields." (interactive) (org-map-entries (lambda () (org-bibtex-check optional)))) -(defun org-bibtex-create (&optional arg nonew) +(defun org-bibtex-headline-format-default (entry) + "Return headline text according to ENTRY title." + (cdr (assq :title entry))) + +(defun org-bibtex-create (&optional arg update-heading) "Create a new entry at the given level. -With a prefix arg, query for optional fields as well. -If nonew is t, add data to the headline of the entry at point." +With a prefix ARG, query for optional fields as well. +If UPDATE-HEADING is non-nil, add data to the headline of the entry at +point." (interactive "P") (let* ((type (completing-read "Type: " (mapcar (lambda (type) (substring (symbol-name (car type)) 1)) org-bibtex-types) - nil nil (when nonew - (org-bibtex-get org-bibtex-type-property-name)))) + nil nil (when update-heading + (org-bibtex-get org-bibtex-type-property-name)))) (type (if (keywordp type) type (intern (concat ":" type)))) - (org-bibtex-treat-headline-as-title (if nonew nil t))) + (org-bibtex-treat-headline-as-title (if update-heading nil t))) (unless (assoc type org-bibtex-types) (error "Type:%s is not known" type)) - (if nonew + (if update-heading (org-back-to-heading) (org-insert-heading) (let ((title (org-bibtex-ask :title))) @@ -718,29 +723,32 @@ Return the number of saved entries." (interactive "fFile: ") (org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile))) -(defun org-bibtex-write (&optional noindent) +(defun org-bibtex-write (&optional noindent update-heading) "Insert a heading built from the first element of `org-bibtex-entries'. When optional argument NOINDENT is non-nil, do not indent the properties -drawer." +drawer. If UPDATE-HEADING is non-nil, add data to the headline of the +entry at point." (interactive) (unless org-bibtex-entries (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 org-bibtex-headline-format-function entry)) - (insert "\n:PROPERTIES:\n") - (org-bibtex-put "TITLE" (funcall val :title) 'insert) + (togtag (lambda (tag) (org-toggle-tag tag 'on))) + (insert-raw (not update-heading))) + (unless update-heading + (org-insert-heading) + (insert (funcall org-bibtex-headline-format-function entry)) + (insert "\n:PROPERTIES:\n")) + (org-bibtex-put "TITLE" (funcall val :title) insert-raw) (org-bibtex-put org-bibtex-type-property-name (downcase (funcall val :type)) - 'insert) + insert-raw) (dolist (pair entry) (pcase (car pair) (:title nil) (:type nil) - (:key (org-bibtex-put org-bibtex-key-property (cdr pair) 'insert)) + (:key (org-bibtex-put org-bibtex-key-property (cdr pair) insert-raw)) (:keywords (if org-bibtex-tags-are-keywords (dolist (kw (split-string (cdr pair) ", *")) (funcall @@ -748,25 +756,28 @@ drawer." (replace-regexp-in-string "[^[:alnum:]_@#%]" "" (replace-regexp-in-string "[ \t]+" "_" kw)))) - (org-bibtex-put (car pair) (cdr pair) 'insert))) - (_ (org-bibtex-put (car pair) (cdr pair) 'insert)))) - (insert ":END:\n") + (org-bibtex-put (car pair) (cdr pair) insert-raw))) + (_ (org-bibtex-put (car pair) (cdr pair) insert-raw)))) + (unless update-heading + (insert ":END:\n")) (mapc togtag org-bibtex-tags) (unless noindent (org-indent-region (save-excursion (org-back-to-heading t) (point)) (point))))) -(defun org-bibtex-yank () - "If kill ring holds a bibtex entry yank it as an Org headline." - (interactive) +(defun org-bibtex-yank (&optional update-heading) + "If kill ring holds a bibtex entry yank it as an Org headline. +When called with non-nil prefix argument UPDATE-HEADING, add data to the +headline of the entry at point." + (interactive "P") (let (entry) (with-temp-buffer (yank 1) (bibtex-mode) (setf entry (org-bibtex-read))) (if entry - (org-bibtex-write) + (org-bibtex-write nil update-heading) (error "Yanked text does not appear to contain a BibTeX entry")))) (defun org-bibtex-import-from-file (file) diff --git a/lisp/org/ol-docview.el b/lisp/org/ol-docview.el index f12d3558d42..383e3fbabd1 100644 --- a/lisp/org/ol-docview.el +++ b/lisp/org/ol-docview.el @@ -57,20 +57,21 @@ :export #'org-docview-export :store #'org-docview-store-link) -(defun org-docview-export (link description format) - "Export a docview link from Org files." +(defun org-docview-export (link description backend _info) + "Export a docview LINK with DESCRIPTION for BACKEND." (let ((path (if (string-match "\\(.+\\)::.+" link) (match-string 1 link) link)) (desc (or description link))) (when (stringp path) (setq path (expand-file-name path)) (cond - ((eq format 'html) (format "%s" path desc)) - ((eq format 'latex) (format "\\href{%s}{%s}" path desc)) - ((eq format 'ascii) (format "%s (%s)" desc path)) + ((eq backend 'html) (format "%s" path desc)) + ((eq backend 'latex) (format "\\href{%s}{%s}" path desc)) + ((eq backend 'ascii) (format "[%s] (<%s>)" desc path)) (t path))))) (defun org-docview-open (link _) + "Open docview: LINK." (string-match "\\(.*?\\)\\(?:::\\([0-9]+\\)\\)?$" link) (let ((path (match-string 1 link)) (page (and (match-beginning 2) @@ -82,7 +83,7 @@ (error "No such file: %s" path)) (when page (doc-view-goto-page page)))) -(defun org-docview-store-link () +(defun org-docview-store-link (&optional _interactive?) "Store a link to a docview buffer." (when (eq major-mode 'doc-view-mode) ;; This buffer is in doc-view-mode diff --git a/lisp/org/ol-doi.el b/lisp/org/ol-doi.el index 0550a48b63e..64eb6869575 100644 --- a/lisp/org/ol-doi.el +++ b/lisp/org/ol-doi.el @@ -40,7 +40,8 @@ (defun org-link-doi-open (path arg) "Open a \"doi\" type link. -PATH is a the path to search for, as a string." +PATH is a the path to search for, as a string. +ARG is passed to `browse-url'." (browse-url (url-encode-url (concat org-link-doi-server-url path)) arg)) (defun org-link-doi-export (path desc backend info) diff --git a/lisp/org/ol-eshell.el b/lisp/org/ol-eshell.el index dead1aa8a3a..595dd0ee0f8 100644 --- a/lisp/org/ol-eshell.el +++ b/lisp/org/ol-eshell.el @@ -37,8 +37,8 @@ :store #'org-eshell-store-link) (defun org-eshell-open (link _) - "Switch to an eshell buffer and execute a command line. -The link can be just a command line (executed in the default + "Switch to an eshell buffer and execute a command line for LINK. +The LINK can be just a command line (executed in the default eshell buffer) or a command line prefixed by a buffer name followed by a colon." (let* ((buffer-and-command @@ -60,9 +60,10 @@ followed by a colon." (insert command) (eshell-send-input))) -(defun org-eshell-store-link () - "Store a link that, when opened, switches back to the current eshell buffer -and the current working directory." +(defun org-eshell-store-link (&optional _interactive?) + "Store eshell link. +When opened, the link switches back to the current eshell buffer and +the current working directory." (when (eq major-mode 'eshell-mode) (let* ((command (concat "cd " (eshell/pwd))) (link (concat (buffer-name) ":" command))) diff --git a/lisp/org/ol-eww.el b/lisp/org/ol-eww.el index fb711c60527..c13dbf339ea 100644 --- a/lisp/org/ol-eww.el +++ b/lisp/org/ol-eww.el @@ -62,7 +62,7 @@ "Open URL with Eww in the current buffer." (eww url)) -(defun org-eww-store-link () +(defun org-eww-store-link (&optional _interactive?) "Store a link to the url of an EWW buffer." (when (eq major-mode 'eww-mode) (org-link-store-props @@ -162,6 +162,7 @@ keep the structure of the Org file." ;; Additional keys for eww-mode (defun org-eww-extend-eww-keymap () + "Add ol-eww bindings to `eww-mode-map'." (define-key eww-mode-map "\C-c\C-x\M-w" 'org-eww-copy-for-org-mode) (define-key eww-mode-map "\C-c\C-x\C-w" 'org-eww-copy-for-org-mode)) diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el index 91af4d10a25..278c59ed426 100644 --- a/lisp/org/ol-gnus.el +++ b/lisp/org/ol-gnus.el @@ -123,7 +123,7 @@ If `org-store-link' was called with a prefix arg the meaning of (url-encode-url message-id)) (concat "gnus:" group "#" message-id))) -(defun org-gnus-store-link () +(defun org-gnus-store-link (&optional _interactive?) "Store a link to a Gnus folder or message." (pcase major-mode (`gnus-group-mode @@ -137,27 +137,23 @@ If `org-store-link' was called with a prefix arg the meaning of (let* ((group (pcase (gnus-find-method-for-group gnus-newsgroup-name) (`(nnvirtual . ,_) - (save-excursion - (car (nnvirtual-map-article (gnus-summary-article-number))))) + (with-current-buffer gnus-summary-buffer + (save-excursion + (car (nnvirtual-map-article (gnus-summary-article-number)))))) (`(,(or `nnselect `nnir) . ,_) ; nnir is for Emacs < 28. - (save-excursion - (cond - ((fboundp 'nnselect-article-group) - (nnselect-article-group (gnus-summary-article-number))) - ((fboundp 'nnir-article-group) - (nnir-article-group (gnus-summary-article-number))) - (t - (error "No article-group variant bound"))))) + (with-current-buffer gnus-summary-buffer + (save-excursion + (cond + ((fboundp 'nnselect-article-group) + (nnselect-article-group (gnus-summary-article-number))) + ((fboundp 'nnir-article-group) + (nnir-article-group (gnus-summary-article-number))) + (t + (error "No article-group variant bound")))))) (_ gnus-newsgroup-name))) - (header (if (eq major-mode 'gnus-article-mode) - ;; When in an article, first move to summary - ;; buffer, with point on the summary of the - ;; current article before extracting headers. - (save-window-excursion - (save-excursion - (gnus-article-show-summary) - (gnus-summary-article-header))) - (gnus-summary-article-header))) + (header (with-current-buffer gnus-summary-buffer + (save-excursion + (gnus-summary-article-header)))) (from (mail-header-from header)) (message-id (org-unbracket-string "<" ">" (mail-header-id header))) (date (org-trim (mail-header-date header))) diff --git a/lisp/org/ol-info.el b/lisp/org/ol-info.el index 1b8e15fd537..2c2b48ebb88 100644 --- a/lisp/org/ol-info.el +++ b/lisp/org/ol-info.el @@ -50,7 +50,7 @@ :insert-description #'org-info-description-as-command) ;; Implementation -(defun org-info-store-link () +(defun org-info-store-link (&optional _interactive?) "Store a link to an Info file and node." (when (eq major-mode 'Info-mode) (let ((link (concat "info:" @@ -139,13 +139,17 @@ If LINK is not an info link then DESC is returned." "List of Emacs documents available. Taken from ") -(defconst org-info-other-documents +(defcustom org-info-other-documents '(("dir" . "https://www.gnu.org/manual/manual.html") ; index ("libc" . "https://www.gnu.org/software/libc/manual/html_mono/libc.html") ("make" . "https://www.gnu.org/software/make/manual/make.html")) "Alist of documents generated from Texinfo source. When converting info links to HTML, links to any one of these manuals are -converted to use these URL.") +converted to use these URL." + :group 'org-link + :type '(alist :key-type string :value-type string) + :package-version '(Org . "9.7") + :safe t) (defun org-info-map-html-url (filename) "Return URL or HTML file associated to Info FILENAME. @@ -153,11 +157,11 @@ If FILENAME refers to an official GNU document, return a URL pointing to the official page for that document, e.g., use \"gnu.org\" for all Emacs related documents. Otherwise, append \".html\" extension to FILENAME. See `org-info-emacs-documents' and `org-info-other-documents' for details." - (cond ((member filename org-info-emacs-documents) - (format "https://www.gnu.org/software/emacs/manual/html_mono/%s.html" - filename)) - ((cdr (assoc filename org-info-other-documents))) - (t (concat filename ".html")))) + (cond ((cdr (assoc filename org-info-other-documents))) + ((member filename org-info-emacs-documents) + (format "https://www.gnu.org/software/emacs/manual/html_mono/%s.html" + filename)) + (t (concat filename ".html")))) (defun org-info--expand-node-name (node) "Expand Info NODE to HTML cross reference." diff --git a/lisp/org/ol-irc.el b/lisp/org/ol-irc.el index 78c4884b00f..b263e52db61 100644 --- a/lisp/org/ol-irc.el +++ b/lisp/org/ol-irc.el @@ -103,7 +103,7 @@ attributes that are found." parts)) ;;;###autoload -(defun org-irc-store-link () +(defun org-irc-store-link (&optional _interactive?) "Dispatch to the appropriate function to store a link to an IRC session." (cond ((eq major-mode 'erc-mode) diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el index 5ce04330021..7070f48abcf 100644 --- a/lisp/org/ol-man.el +++ b/lisp/org/ol-man.el @@ -24,12 +24,17 @@ ;; ;;; Commentary: +;; This file implements links to man pages from within Org mode. + +;;; Code: + (require 'org-macs) (org-assert-version) (require 'ol) (org-link-set-parameters "man" + :complete #'org-man-complete :follow #'org-man-open :export #'org-man-export :store #'org-man-store-link) @@ -37,15 +42,29 @@ (defcustom org-man-command 'man "The Emacs command to be used to display a man page." :group 'org-link - :type '(choice (const man) (const woman))) + :type '(choice (const man) (const :tag "WoMan (obsolete)" woman))) +(declare-function Man-translate-references "man" (ref)) (defun org-man-open (path _) "Visit the manpage on PATH. PATH should be a topic that can be thrown at the man command. If PATH contains extra ::STRING which will use `occur' to search matched strings in man buffer." + (require 'man) ; For `Man-translate-references' (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path) (let* ((command (match-string 1 path)) + ;; FIXME: Remove after we drop Emacs 29 support. + ;; Working around security bug #66390. + (command (if (not (equal (Man-translate-references ";id") ";id")) + ;; We are on Emacs that escapes man command args + ;; (see Emacs commit 820f0793f0b). + command + ;; Older Emacs without the fix - escape the + ;; arguments ourselves. + (mapconcat 'identity + (mapcar #'shell-quote-argument + (split-string command "\\s-+")) + " "))) (search (match-string 2 path)) (buffer (funcall org-man-command command))) (when search @@ -63,7 +82,7 @@ matched strings in man buffer." (set-window-point window point) (set-window-start window point))))))) -(defun org-man-store-link () +(defun org-man-store-link (&optional _interactive?) "Store a link to a README file." (when (memq major-mode '(Man-mode woman-mode)) ;; This is a man page, we do make this link @@ -82,18 +101,31 @@ matched strings in man buffer." (match-string 1 (buffer-name)) (error "Cannot create link to this man page"))) -(defun org-man-export (link description format) - "Export a man page link from Org files." +(defun org-man-export (link description backend) + "Export a man page LINK with DESCRIPTION. +BACKEND is the current export backend." (let ((path (format "http://man.he.net/?topic=%s§ion=all" link)) (desc (or description link))) (cond - ((eq format 'html) (format "%s" path desc)) - ((eq format 'latex) (format "\\href{%s}{%s}" path desc)) - ((eq format 'texinfo) (format "@uref{%s,%s}" path desc)) - ((eq format 'ascii) (format "%s (%s)" desc path)) - ((eq format 'md) (format "[%s](%s)" desc path)) + ((eq backend 'html) (format "%s" path desc)) + ((eq backend 'latex) (format "\\href{%s}{%s}" path desc)) + ((eq backend 'texinfo) (format "@uref{%s,%s}" path desc)) + ((eq backend 'ascii) (format "[%s] (<%s>)" desc path)) + ((eq backend 'md) (format "[%s](%s)" desc path)) (t path)))) +(defvar Man-completion-cache) ; Defined in `man'. +(defun org-man-complete (&optional _arg) + "Complete man pages for `org-insert-link'." + (require 'man) + (concat + "man:" + (let ((completion-ignore-case t) ; See `man' comments. + (Man-completion-cache)) ; See `man' implementation. + (completing-read + "Manual entry: " + 'Man-completion-table)))) + (provide 'ol-man) ;;; ol-man.el ends here diff --git a/lisp/org/ol-mhe.el b/lisp/org/ol-mhe.el index 52339c0a622..b715f6a08b4 100644 --- a/lisp/org/ol-mhe.el +++ b/lisp/org/ol-mhe.el @@ -80,7 +80,7 @@ supported by MH-E." (org-link-set-parameters "mhe" :follow #'org-mhe-open :store #'org-mhe-store-link) ;; Implementation -(defun org-mhe-store-link () +(defun org-mhe-store-link (&optional _interactive?) "Store a link to an MH-E folder or message." (when (or (eq major-mode 'mh-folder-mode) (eq major-mode 'mh-show-mode)) diff --git a/lisp/org/ol-rmail.el b/lisp/org/ol-rmail.el index a1af1b94915..fb32a450641 100644 --- a/lisp/org/ol-rmail.el +++ b/lisp/org/ol-rmail.el @@ -51,7 +51,7 @@ :store #'org-rmail-store-link) ;; Implementation -(defun org-rmail-store-link () +(defun org-rmail-store-link (&optional _interactive?) "Store a link to an Rmail folder or message." (when (or (eq major-mode 'rmail-mode) (eq major-mode 'rmail-summary-mode)) diff --git a/lisp/org/ol.el b/lisp/org/ol.el index ac0c308da21..20f1b89c060 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -52,17 +52,19 @@ (declare-function org-do-occur "org" (regexp &optional cleanup)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-element-cache-refresh "org-element" (pos)) +(declare-function org-element-cache-reset "org-element" (&optional all no-persistence)) (declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-lineage "org-element" (datum &optional types with-self)) +(declare-function org-element-lineage "org-element-ast" (datum &optional types with-self)) (declare-function org-element-link-parser "org-element" ()) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-begin "org-element" (node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-element-update-syntax "org-element" ()) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-find-property "org" (property &optional value)) (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) (declare-function org-id-find-id-file "org-id" (id)) -(declare-function org-id-store-link "org-id" ()) (declare-function org-insert-heading "org" (&optional arg invisible-ok top)) (declare-function org-load-modules-maybe "org" (&optional force)) (declare-function org-mark-ring-push "org" (&optional pos buffer)) @@ -114,11 +116,11 @@ below. Function that accepts four arguments: - the path, as a string, - the description as a string, or nil, - - the export back-end, + - the export backend, - the export communication channel, as a plist. When nil, export for that type of link is delegated to the - back-end. + backend. `:store' @@ -196,6 +198,16 @@ link. :type '(alist :tag "Link display parameters" :value-type plist)) +(defun org-link--set-link-display (symbol value) + "Set `org-link-descriptive' (SYMBOL) to VALUE. +Also, ensure that links are updated in current buffer. + +This function is intended to be used as a :set function." + (set symbol value) + (dolist (buf (org-buffer-list)) + (with-current-buffer buf + (org-restart-font-lock)))) + (defcustom org-link-descriptive t "Non-nil means Org displays descriptive links. @@ -207,6 +219,7 @@ literally. You can interactively set the value of this variable by calling `org-toggle-link-display' or from the \"Org > Hyperlinks\" menu." :group 'org-link + :set #'org-link--set-link-display :type 'boolean :safe #'booleanp) @@ -234,7 +247,7 @@ adaptive Use relative path for files in the current directory and sub- directories of it. For other files, use an absolute path. Alternatively, users may supply a custom function that takes the -full filename as an argument and returns the path." +filename in the link as an argument and returns the path." :group 'org-link :type '(choice (const relative) @@ -274,10 +287,14 @@ See the manual for examples." (choice (string :tag "Format") (function)))) - :safe (lambda (val) - (pcase val - (`(,(pred stringp) . ,(pred stringp)) t) - (_ nil)))) + :safe (lambda (alist) + (when (listp alist) + (catch :unsafe + (dolist (val alist) + (pcase val + (`(,(pred stringp) . ,(pred stringp)) t) + (_ (throw :unsafe nil)))) + t)))) (defgroup org-link-follow nil "Options concerning following links in Org mode." @@ -291,10 +308,7 @@ or emacs-wiki packages to Org syntax. The function must accept two parameters, a TYPE containing the link protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, which is everything after the link protocol. It should return a cons -with possibly modified values of type and path. -Org contains a function for this, so if you set this variable to -`org-translate-link-from-planner', you should be able follow many -links created by planner." +with possibly modified values of type and path." :group 'org-link-follow :type '(choice (const nil) (function)) :safe #'null) @@ -355,14 +369,17 @@ another window." (const wl-other-frame))))) (defcustom org-link-search-must-match-exact-headline 'query-to-create - "Non-nil means internal fuzzy links can only match headlines. + "Control fuzzy link behaviour when specific matches not found. -When nil, the fuzzy link may point to a target or a named -construct in the document. When set to the special value -`query-to-create', offer to create a new headline when none -matched. +When nil, if a fuzzy link does not match a more specific +target (such as a heading, named block, target, or code ref), +attempt a regular text search. When set to the special value +`query-to-create', offer to create a new heading matching the +link instead. Otherwise, signal an error rather than attempting +a regular text search. -Spaces and statistics cookies are ignored during heading searches." +This option only affects behaviour in Org buffers. Spaces and +statistics cookies are ignored during heading searches." :group 'org-link-follow :version "24.1" :type '(choice @@ -516,6 +533,16 @@ links more efficient." (defvar-local org-target-link-regexp nil "Regular expression matching radio targets in plain text.") +(defconst org-target-link-regexp-limit (ash 2 12) + "Maximum allowed length of regexp. +The number should generally be ~order of magnitude smaller than +MAX_BUF_SIZE in src/regex-emacs.c. The number of regexp-emacs.c is +for processed regexp, which appears to be larger compared to the +original string length.") +(defvar-local org-target-link-regexps nil + "List of regular expressions matching radio targets in plain text. +This list is non-nil, when a single regexp would be too long to match +all the possible targets, exceeding Emacs' regexp length limit.") (defvar org-link-types-re nil "Matches a link that has a url-like prefix like \"http:\".") @@ -563,9 +590,9 @@ taken to make the search successful, another function should be added to the companion hook `org-execute-file-search-functions', which see. -A function in this hook may also use `setq' to set the variable -`description' to provide a suggestion for the descriptive text to -be used for this link when it gets inserted into an Org buffer +A function in this hook may also use `org-link-store-props' and set +`:description' property to provide a suggestion for the descriptive +text to be used for this link when it gets inserted into an Org buffer with \\[org-insert-link].") (defvar org-execute-file-search-functions nil @@ -622,22 +649,6 @@ exact and fuzzy text search.") (defvar org-link--search-failed nil "Non-nil when last link search failed.") - -(defvar-local org-link--link-folding-spec '(org-link - (:global t) - (:ellipsis . nil) - (:isearch-open . t) - (:fragile . org-link--reveal-maybe)) - "Folding spec used to hide invisible parts of links.") - -(defvar-local org-link--description-folding-spec '(org-link-description - (:global t) - (:ellipsis . nil) - (:visible . t) - (:isearch-open . nil) - (:fragile . org-link--reveal-maybe)) - "Folding spec used to reveal link description.") - ;;; Internal Functions @@ -750,8 +761,8 @@ White spaces are not significant." (while (re-search-forward re nil t) (forward-char -1) (let ((object (org-element-context))) - (when (eq (org-element-type object) 'radio-target) - (goto-char (org-element-property :begin object)) + (when (org-element-type-p object 'radio-target) + (goto-char (org-element-begin object)) (org-fold-show-context 'link-search) (throw :radio-match nil)))) (goto-char origin) @@ -802,6 +813,74 @@ spec." (org-with-point-at (car region) (not (org-in-regexp org-link-any-re)))) +(defun org-link--try-link-store-functions (interactive?) + "Try storing external links, prompting if more than one is possible. + +Each function returned by `org-store-link-functions' is called in +turn. If multiple functions return non-nil, prompt for which +link should be stored. + +Argument INTERACTIVE? indicates whether `org-store-link' was +called interactively and is passed to the link store functions. + +Return t when a link has been stored in `org-link-store-props'." + (let ((results-alist nil)) + (dolist (f (org-store-link-functions)) + (when (condition-case nil + (funcall f interactive?) + ;; FIXME: The store function used (< Org 9.7) to accept + ;; no arguments; provide backward compatibility support + ;; for them. + (wrong-number-of-arguments + (funcall f))) + ;; FIXME: return value is not link's plist, so we store the + ;; new value before it is modified. It would be cleaner to + ;; ask store link functions to return the plist instead. + (push (cons f (copy-sequence org-store-link-plist)) + results-alist))) + (pcase results-alist + (`nil nil) + (`((,_ . ,_)) t) ;single choice: nothing to do + (`((,name . ,_) . ,_) + ;; Reinstate link plist associated to the chosen + ;; function. + (apply #'org-link-store-props + (cdr (assoc-string + (completing-read + (format "Store link with (default %s): " name) + (mapcar #'car results-alist) + nil t nil nil (symbol-name name)) + results-alist))) + t)))) + +(defun org-link--add-to-stored-links (link desc) + "Add LINK to `org-stored-links' with description DESC." + (cond + ((not (member (list link desc) org-stored-links)) + (push (list link desc) org-stored-links) + (message "Stored: %s" (or desc link))) + ((equal (list link desc) (car org-stored-links)) + (message "This link has already been stored")) + (t + (setq org-stored-links + (delete (list link desc) org-stored-links)) + (push (list link desc) org-stored-links) + (message "Link moved to front: %s" (or desc link))))) + +(defun org-link--file-link-to-here () + "Return as (LINK . DESC) a file link with search string to here." + (let ((link (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) + desc) + (when org-link-context-for-files + (pcase (org-link-precise-link-target) + (`nil nil) + (`(,search-string ,search-desc ,_position) + (setq link (format "%s::%s" link search-string)) + (setq desc search-desc)))) + (cons link desc))) + ;;; Public API @@ -828,6 +907,13 @@ PARAMETERS should be keyword value pairs. See (org-link-make-regexps) (when (featurep 'org-element) (org-element-update-syntax))))) +;; This way, one can add multiple functions as, say, :follow parameter. +;; For example, +;; (add-function :before-until (org-link-get-parameter "id" :follow) #'my-function) +;; See https://orgmode.org/list/a123389c-8f86-4836-a4fe-1e3f4281d33b@app.fastmail.com +(gv-define-setter org-link-get-parameter (value type key) + `(org-link-set-parameters ,type ,key ,value)) + (defun org-link-make-regexps () "Update the link regular expressions. This should be called after the variable `org-link-parameters' has changed." @@ -840,12 +926,12 @@ This should be called after the variable `org-link-parameters' has changed." org-link-plain-re (let* ((non-space-bracket "[^][ \t\n()<>]") (parenthesis - `(seq "(" + `(seq (any "<([") (0+ (or (regex ,non-space-bracket) - (seq "(" + (seq (any "<([") (0+ (regex ,non-space-bracket)) - ")"))) - ")"))) + (any "])>")))) + (any "])>")))) ;; Heuristics for an URL link inspired by ;; https://daringfireball.net/2010/07/improved_regex_for_matching_urls (rx-to-string @@ -878,7 +964,8 @@ This should be called after the variable `org-link-parameters' has changed." org-link-plain-re "\\)")))) (defun org-link-complete-file (&optional arg) - "Create a file link using completion." + "Create a file link using completion. +With optional ARG \\='(16), abbreviate the file name in the link." (let ((file (read-file-name "File: ")) (pwd (file-name-as-directory (expand-file-name "."))) (pwd1 (file-name-as-directory (abbreviate-file-name @@ -923,7 +1010,7 @@ according to FMT (default from `org-link-email-description-format')." (org-replace-escapes fmt table))) (defun org-link-store-props (&rest plist) - "Store link properties. + "Store link properties PLIST. The properties are pre-processed by extracting names, addresses and dates." (let ((x (plist-get plist :from))) @@ -955,7 +1042,7 @@ and dates." (setq org-store-link-plist plist)) (defun org-link-add-props (&rest plist) - "Add these properties to the link property list." + "Add these properties to the link property list PLIST." (let (key value) (while plist (setq key (pop plist) value (pop plist)) @@ -1027,14 +1114,16 @@ LINK is escaped with backslashes for inclusion in buffer." "List of functions that are called to create and store a link. The functions are defined in the `:store' property of -`org-link-parameters'. +`org-link-parameters'. Each function should accept an argument +INTERACTIVE? which indicates whether the user has initiated +`org-store-link' interactively. -Each function will be called in turn until one returns a non-nil -value. Each function should check if it is responsible for -creating this link (for example by looking at the major mode). -If not, it must exit and return nil. If yes, it should return -a non-nil value after calling `org-link-store-props' with a list -of properties and values. Special properties are: +Each function will be called in turn with a single argument +INTERACTIVE? - non-nil when user interaction is allowed. Each function +should check if it is responsible for creating this link (for example +by looking at the major mode). If not, it must return nil. If yes, +it should return a non-nil value after calling `org-link-store-props' +with a list of properties and values. Special properties are: :type The link prefix, like \"http\". This must be given. :link The link, like \"http://www.astro.uva.nl/~dominik\". @@ -1114,7 +1203,7 @@ for internal and \"file\" links, or stored as a parameter in (_ path)) ;; Prevent fuzzy links from matching themselves. (and (equal type "fuzzy") - (+ 2 (org-element-property :begin link))))) + (+ 2 (org-element-begin link))))) (point)))) (unless (and (<= (point-min) destination) (>= (point-max) destination)) @@ -1128,14 +1217,14 @@ for internal and \"file\" links, or stored as a parameter in ;; argument, as it was mandatory before Org 9.4. This is ;; deprecated, but support it for now. (condition-case nil - (funcall (org-link-get-parameter type :follow) path arg) + (funcall f path arg) (wrong-number-of-arguments - (funcall (org-link-get-parameter type :follow) path))))))))) + (funcall f path))))))))) (defun org-link-open-from-string (s &optional arg) "Open a link in the string S, as if it was in Org mode. -Optional argument is passed to `org-open-file' when S is -a \"file\" link." +Optional argument ARG is passed to `org-open-file' when S is a +\"file\" link." (interactive "sLink: \nP") (pcase (with-temp-buffer (let ((org-inhibit-startup nil)) @@ -1146,8 +1235,8 @@ a \"file\" link." (`nil (user-error "No valid link in %S" s)) (link (org-link-open link arg)))) -(defun org-link-search (s &optional avoid-pos stealth) - "Search for a search string S. +(defun org-link-search (s &optional avoid-pos stealth new-heading-container) + "Search for a search string S in the accessible part of the buffer. If S starts with \"#\", it triggers a custom ID search. @@ -1166,8 +1255,16 @@ When optional argument STEALTH is non-nil, do not modify visibility around point, thus ignoring `org-show-context-detail' variable. +When optional argument NEW-HEADING-CONTAINER is an element, any +new heading that is created (see +`org-link-search-must-match-exact-headline') will be added as a +subheading of NEW-HEADING-CONTAINER. Otherwise, new headings are +created at level 1 at the end of the accessible part of the +buffer. + Search is case-insensitive and ignores white spaces. Return type -of matched result, which is either `dedicated' or `fuzzy'." +of matched result, which is either `dedicated' or `fuzzy'. Search +respects buffer narrowing." (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s)) (let* ((case-fold-search t) (origin (point)) @@ -1194,8 +1291,7 @@ of matched result, which is either `dedicated' or `fuzzy'." (catch :coderef-match (while (re-search-forward re nil t) (let ((element (org-element-at-point))) - (when (and (memq (org-element-type element) - '(example-block src-block)) + (when (and (org-element-type-p element '(example-block src-block)) (org-match-line (concat ".*?" (org-src-coderef-regexp (org-src-coderef-format element) @@ -1219,9 +1315,9 @@ of matched result, which is either `dedicated' or `fuzzy'." (while (re-search-forward target nil t) (backward-char) (let ((context (org-element-context))) - (when (eq (org-element-type context) 'target) + (when (org-element-type-p context 'target) (setq type 'dedicated) - (goto-char (org-element-property :begin context)) + (goto-char (org-element-begin context)) (throw :target-match t)))) nil)))) ;; Look for elements named after S, only if not in a headline @@ -1233,9 +1329,9 @@ of matched result, which is either `dedicated' or `fuzzy'." (while (re-search-forward name nil t) (let* ((element (org-element-at-point)) (name (org-element-property :name element))) - (when (and name (equal words (split-string name))) + (when (and name (equal (mapcar #'upcase words) (mapcar #'upcase (split-string name)))) (setq type 'dedicated) - (beginning-of-line) + (forward-line 0) (throw :name-match t)))) nil)))) ;; Regular text search. Prefer headlines in Org mode buffers. @@ -1250,24 +1346,38 @@ of matched result, which is either `dedicated' or `fuzzy'." (goto-char (point-min)) (catch :found (while (re-search-forward title-re nil t) - (when (equal words - (split-string - (org-link--normalize-string - (org-get-heading t t t t)))) + (when (equal (mapcar #'upcase words) + (mapcar #'upcase + (split-string + (org-link--normalize-string + (org-get-heading t t t t))))) (throw :found t))) nil))) - (beginning-of-line) + (forward-line 0) (setq type 'dedicated)) ;; Offer to create non-existent headline depending on ;; `org-link-search-must-match-exact-headline'. ((and (derived-mode-p 'org-mode) (eq org-link-search-must-match-exact-headline 'query-to-create) (yes-or-no-p "No match - create this as a new heading? ")) - (goto-char (point-max)) - (unless (bolp) (newline)) - (org-insert-heading nil t t) - (insert s "\n") - (beginning-of-line 0)) + (let* ((container-ok (and new-heading-container + (org-element-type-p new-heading-container '(headline)))) + (new-heading-position (if container-ok + (- (org-element-end new-heading-container) 1) + (point-max))) + (new-heading-level (if container-ok + (+ 1 (org-element-property :level new-heading-container)) + 1))) + ;; Need to widen when target is outside accessible portion of + ;; buffer, since the we want the user to end up there. + (unless (and (<= (point-min) new-heading-position) + (>= (point-max) new-heading-position)) + (widen)) + (goto-char new-heading-position) + (unless (bolp) (newline)) + (org-insert-heading nil t new-heading-level) + (insert (if starred (substring s 1) s) "\n") + (forward-line -1))) ;; Only headlines are looked after. No need to process ;; further: throw an error. ((and (derived-mode-p 'org-mode) @@ -1290,7 +1400,7 @@ of matched result, which is either `dedicated' or `fuzzy'." (<= (match-end 3) (point))) (org-element-lineage (save-match-data (org-element-context)) - '(link) t))) + 'link t))) (goto-char (match-beginning 0)) (setq type 'fuzzy) (throw :fuzzy-match t))) @@ -1317,9 +1427,75 @@ priority cookie or tag." (org-link--normalize-string (or string (org-get-heading t t t t))))) -(defun org-link-open-as-file (path arg) +(defun org-link-precise-link-target () + "Determine search string and description for storing a link. + +If a search string (see `org-link-search') is found, return +list (SEARCH-STRING DESC POSITION). Otherwise, return nil. + +If there is an active region, the contents (or a part of it, see +`org-link-context-for-files') is used as the search string. + +In Org buffers, if point is at a named element (such as a source +block), the name is used for the search string. If at a heading, +its CUSTOM_ID is used to form a search string of the form +\"#id\", if present, otherwise the current heading text is used +in the form \"*Heading\". + +If none of those finds a suitable search string, the current line +is used as the search string. + +The description DESC is nil (meaning the user will be prompted +for a description when inserting the link) for search strings +based on a region or the current line. For other cases, DESC is +a cleaned-up version of the name or heading at point. + +POSITION is the buffer position at which the search string +matches." + (let* ((region (org-link--context-from-region)) + (result + (cond + (region + (list (org-link--normalize-string region t) + nil + (region-beginning))) + + ((derived-mode-p 'org-mode) + (let* ((element (org-element-at-point)) + (name (org-element-property :name element)) + (heading (org-element-lineage element '(headline inlinetask) t)) + (custom-id (org-entry-get heading "CUSTOM_ID"))) + (cond + (name + (list name + name + (org-element-begin element))) + ((org-before-first-heading-p) + (list (org-link--normalize-string (org-current-line-string) t) + nil + (line-beginning-position))) + (heading + (list (if custom-id (concat "#" custom-id) + (org-link-heading-search-string)) + (org-link--normalize-string + (org-get-heading t t t t)) + (org-element-begin heading)))))) + + ;; Not in an org-mode buffer, no region + (t + (list (org-link--normalize-string (org-current-line-string) t) + nil + (line-beginning-position)))))) + + ;; Only use search option if there is some text. + (when (org-string-nw-p (car result)) + result))) + +(defun org-link-open-as-file (path in-emacs) "Pretend PATH is a file name and open it. +IN-EMACS is passed to `org-open-file'. + According to \"file\"-link syntax, PATH may include additional search options, separated from the file name with \"::\". @@ -1329,11 +1505,12 @@ This function is meant to be used as a possible tool for (match-string 1 path))) (file-name (if (not option) path (substring path 0 (match-beginning 0))))) - (if (string-match "[*?{]" (file-name-nondirectory file-name)) - (dired file-name) + (if (and (string-match "[*?{]" (file-name-nondirectory file-name)) + (not (file-exists-p file-name))) + (dired file-name) (apply #'org-open-file file-name - arg + in-emacs (cond ((not option) nil) ((string-match-p "\\`[0-9]+\\'" option) (list (string-to-number option))) @@ -1387,7 +1564,7 @@ PATH is a symbol name, as a string." ((and (pred boundp) variable) (describe-variable variable)) (name (user-error "Unknown function or variable: %s" name)))) -(defun org-link--store-help () +(defun org-link--store-help (&optional _interactive?) "Store \"help\" type link." (when (eq major-mode 'help-mode) (let ((symbol @@ -1469,10 +1646,10 @@ is non-nil, move backward." (let ((context (save-excursion (unless search-backward (forward-char -1)) (org-element-context)))) - (pcase (org-element-lineage context '(link) t) + (pcase (org-element-lineage context 'link t) (`nil nil) (link - (goto-char (org-element-property :begin link)) + (goto-char (org-element-begin link)) (when (org-invisible-p) (org-fold-show-context 'link-search)) (throw :found t))))) (goto-char pos) @@ -1486,18 +1663,12 @@ If the link is in hidden text, expose it." (interactive) (org-next-link t)) -(defun org-link-descriptive-ensure () - "Toggle the literal or descriptive display of links in current buffer if needed." - (org-fold-core-set-folding-spec-property - (car org-link--link-folding-spec) - :visible (not org-link-descriptive))) - ;;;###autoload (defun org-toggle-link-display () "Toggle the literal or descriptive display of links in current buffer." (interactive) (setq org-link-descriptive (not org-link-descriptive)) - (org-link-descriptive-ensure)) + (org-restart-font-lock)) ;;;###autoload (defun org-store-link (arg &optional interactive?) @@ -1505,10 +1676,12 @@ If the link is in hidden text, expose it." \\ This link is added to `org-stored-links' and can later be inserted into an Org buffer with `org-insert-link' (`\\[org-insert-link]'). +When optional argument INTERACTIVE? is nil, the link is not stored in +`org-stored-links', but returned as a string. For some link types, a `\\[universal-argument]' prefix ARG is interpreted. \ A single -`\\[universal-argument]' negates `org-context-in-file-links' for file links or +`\\[universal-argument]' negates `org-link-context-for-files' for file links or `org-gnus-prefer-web-links' for links to Usenet articles. A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \ @@ -1520,7 +1693,12 @@ prefix ARG forces storing a link for each line in the active region. Assume the function is called interactively if INTERACTIVE? is -non-nil." +non-nil. + +In Org buffers, an additional \"human-readable\" simple file link +is stored as an alternative to persistent org-id or other links, +if at a heading with a CUSTOM_ID property or an element with a +NAME." (interactive "P\np") (org-load-modules-maybe) (if (and (equal arg '(64)) (org-region-active-p)) @@ -1535,36 +1713,19 @@ non-nil." (move-beginning-of-line 2) (set-mark (point))))) (setq org-store-link-plist nil) - (let (link cpltxt desc search custom-id agenda-link) ;; description + ;; Negate `org-context-in-file-links' when given a single universal arg. + (let ((org-link-context-for-files (org-xor org-link-context-for-files + (equal arg '(4)))) + link desc search agenda-link) ;; description (cond ;; Store a link using an external link type, if any function is - ;; available. If more than one can generate a link from current - ;; location, ask which one to use. + ;; available, unless external link types are skipped for this + ;; call using two universal args. If more than one function + ;; can generate a link from current location, ask the user + ;; which one to use. ((and (not (equal arg '(16))) - (let ((results-alist nil)) - (dolist (f (org-store-link-functions)) - (when (funcall f) - ;; XXX: return value is not link's plist, so we - ;; store the new value before it is modified. It - ;; would be cleaner to ask store link functions to - ;; return the plist instead. - (push (cons f (copy-sequence org-store-link-plist)) - results-alist))) - (pcase results-alist - (`nil nil) - (`((,_ . ,_)) t) ;single choice: nothing to do - (`((,name . ,_) . ,_) - ;; Reinstate link plist associated to the chosen - ;; function. - (apply #'org-link-store-props - (cdr (assoc-string - (completing-read - (format "Store link with (default %s): " name) - (mapcar #'car results-alist) - nil t nil nil (symbol-name name)) - results-alist))) - t)))) - (setq link (plist-get org-store-link-plist :link)) + (org-link--try-link-store-functions interactive?)) + (setq link (plist-get org-store-link-plist :link)) ;; If store function actually set `:description' property, use ;; it, even if it is nil. Otherwise, fallback to nil (ask user). (setq desc (plist-get org-store-link-plist :description))) @@ -1586,7 +1747,7 @@ non-nil." (setq link nil)) ;; A code reference exists. Use it. ((save-excursion - (beginning-of-line) + (forward-line 0) (re-search-forward (org-src-coderef-regexp coderef-format) (line-end-position) t)) @@ -1615,6 +1776,7 @@ non-nil." (org-with-point-at m (setq agenda-link (org-store-link nil interactive?)))))) + ;; Calendar mode ((eq major-mode 'calendar-mode) (let ((cd (calendar-cursor-to-date))) (setq link @@ -1623,10 +1785,10 @@ non-nil." (org-encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)))) (org-link-store-props :type "calendar" :date cd))) + ;; Image mode ((eq major-mode 'image-mode) - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name)) - link cpltxt) + (setq link (concat "file:" + (abbreviate-file-name buffer-file-name))) (org-link-store-props :type "image" :file buffer-file-name)) ;; In dired, store a link to the file of the current line @@ -1637,18 +1799,21 @@ non-nil." (expand-file-name (dired-get-filename nil t))) ;; Otherwise, no file so use current directory. default-directory)) - (setq cpltxt (concat "file:" file) - link cpltxt))) + (setq link (concat "file:" file)))) + ;; Try `org-create-file-search-functions`. If any are + ;; successful, create a file link to the current buffer with + ;; the provided search string. ((setq search (run-hook-with-args-until-success 'org-create-file-search-functions)) (setq link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (setq cpltxt (or link))) ;; description + "::" search) + desc (plist-get org-store-link-plist :description))) + ;; Main logic for storing built-in link types in org-mode + ;; buffers ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) (org-with-limited-levels - (setq custom-id (org-entry-get nil "CUSTOM_ID")) (cond ;; Store a link using the target at point ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1) @@ -1661,75 +1826,19 @@ non-nil." ;; Avoid [[target][file:~/org/test.org::target]] ;; links. Maybe the case of identical target and ;; description should be handled by `org-insert-link'. - cpltxt nil - desc nil - ;; Do not append #CUSTOM_ID link below. - custom-id nil)) - ((and (featurep 'org-id) - (or (eq org-id-link-to-org-use-id t) - (and interactive? - (or (eq org-id-link-to-org-use-id 'create-if-interactive) - (and (eq org-id-link-to-org-use-id - 'create-if-interactive-and-no-custom-id) - (not custom-id)))) - (and org-id-link-to-org-use-id (org-entry-get nil "ID")))) - ;; Store a link using the ID at point - (setq link (condition-case nil - (prog1 (org-id-store-link) - (setq desc (plist-get org-store-link-plist :description))) - (error - ;; Probably before first headline, link only to file - (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer)))))))) - (t + desc nil)) + (t ;; Just link to current headline. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context search string. - (when (org-xor org-link-context-for-files (equal arg '(4))) - (let* ((element (org-element-at-point)) - (name (org-element-property :name element)) - (context - (cond - ((let ((region (org-link--context-from-region))) - (and region (org-link--normalize-string region t)))) - (name) - ((org-before-first-heading-p) - (org-link--normalize-string (org-current-line-string) t)) - (t (org-link-heading-search-string))))) - (when (org-string-nw-p context) - (setq cpltxt (format "%s::%s" cpltxt context)) - (setq desc - (or name - ;; Although description is not a search - ;; string, use `org-link--normalize-string' - ;; to prettify it (contiguous white spaces) - ;; and remove volatile contents (statistics - ;; cookies). - (and (not (org-before-first-heading-p)) - (org-link--normalize-string - (org-get-heading t t t t))) - "NONE"))))) - (setq link cpltxt))))) + (let ((here (org-link--file-link-to-here))) + (setq link (car here)) + (setq desc (cdr here))))))) + ;; Buffer linked to file, but not an org-mode buffer. ((buffer-file-name (buffer-base-buffer)) ;; Just link to this file here. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context search string. - (when (org-xor org-link-context-for-files (equal arg '(4))) - (let ((context (org-link--normalize-string - (or (org-link--context-from-region) - (org-current-line-string)) - t))) - ;; Only use search option if there is some text. - (when (org-string-nw-p context) - (setq cpltxt (format "%s::%s" cpltxt context)) - (setq desc "NONE")))) - (setq link cpltxt)) + (let ((here (org-link--file-link-to-here))) + (setq link (car here)) + (setq desc (cdr here)))) (interactive? (user-error "No method for storing a link from this buffer")) @@ -1737,25 +1846,25 @@ non-nil." (t (setq link nil))) ;; We're done setting link and desc, clean up - (when (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt)) + (when (consp link) (setq link (or (cdr link) (car link)))) (cond ((not desc)) ((equal desc "NONE") (setq desc nil)) (t (setq desc (org-link-display-format desc)))) ;; Store and return the link (if (not (and interactive? link)) (or agenda-link (and link (org-link-make-string link desc))) - (if (member (list link desc) org-stored-links) - (message "This link has already been stored") - (push (list link desc) org-stored-links) - (message "Stored: %s" (or desc link)) - (when custom-id - (setq link (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))) - "::#" custom-id)) - (push (list link desc) org-stored-links))) - (car org-stored-links))))) + (org-link--add-to-stored-links link desc) + ;; In org buffers, store an additional "human-readable" link + ;; using custom id, if available. + (when (and (buffer-file-name (buffer-base-buffer)) + (derived-mode-p 'org-mode) + (org-entry-get nil "CUSTOM_ID")) + (let ((here (org-link--file-link-to-here))) + (setq link (car here)) + (setq desc (cdr here))) + (unless (equal (list link desc) (car org-stored-links)) + (org-link--add-to-stored-links link desc))) + (car org-stored-links))))) ;;;###autoload (defun org-insert-link (&optional complete-file link-location description) @@ -1816,7 +1925,7 @@ non-interactively, don't allow editing the default description." (all-prefixes (append (mapcar #'car abbrevs) (mapcar #'car org-link-abbrev-alist) (org-link-types))) - entry) + entry link-original) (cond (link-location) ; specified by arg, just use it. ((org-in-regexp org-link-bracket-re 1) @@ -1838,18 +1947,34 @@ non-interactively, don't allow editing the default description." (t ;; Read link, with completion for stored links. (org-link--fontify-links-to-this-file) - (org-switch-to-buffer-other-window "*Org Links*") + (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 - (insert "\nStored links are available with / or M-p/n \ -\(most recent with RET):\n\n") - (insert (mapconcat #'org-link--prettify - (reverse org-stored-links) - "\n"))) - (goto-char (point-min))) + (read-only-mode 1) + (let ((inhibit-read-only t) + ;; FIXME Duplicate: Also in 'ox.el'. + (propertize-help-key + (lambda (key) + ;; Add `face' *and* `font-lock-face' to "work + ;; reliably in any buffer", per a comment in + ;; `help--key-description-fontified'. + (propertize key + 'font-lock-face 'help-key-binding + 'face 'help-key-binding)))) + (erase-buffer) + (insert + (apply #'format "Type %s to complete link type, then %s to complete destination.\n" + (mapcar propertize-help-key + (list "TAB" "RET")))) + (when org-stored-links + (insert (apply #'format "\nStored links accessible with %s/%s or %s/%s are:\n\n" + (mapcar propertize-help-key + (list "" "" + "M-p" "M-n" + "RET")))) + (insert (mapconcat #'org-link--prettify + (reverse org-stored-links) + "\n")))) + (goto-char (point-min))) (when (get-buffer-window "*Org Links*" 'visible) (let ((cw (selected-window))) (select-window (get-buffer-window "*Org Links*" 'visible)) @@ -1864,14 +1989,13 @@ Use TAB to complete link prefixes, then RET for type-specific completion support org-link--insert-history))) (setq link (org-completing-read - "Link: " + (org-format-prompt "Insert link" (caar org-stored-links)) (append (mapcar (lambda (x) (concat x ":")) all-prefixes) (mapcar #'car org-stored-links) ;; Allow description completion. Avoid "nil" option - ;; in the case of `completing-read-default' and - ;; an error in `ido-completing-read' when some links - ;; have no description. + ;; in the case of `completing-read-default' when + ;; some links have no description. (delq nil (mapcar 'cadr org-stored-links))) nil nil nil 'org-link--history @@ -1886,17 +2010,16 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (setq link (substring link 0 -1)))) (setq link (with-current-buffer origbuf (org-link--try-special-completion link))))) + (when-let ((window (get-buffer-window "*Org Links*" t))) + (quit-window 'kill window)) (set-window-configuration wcf) - (kill-buffer "*Org Links*")) + (when (get-buffer "*Org Links*") + (kill-buffer "*Org Links*"))) (setq entry (assoc link org-stored-links)) (or entry (push link org-link--insert-history)) (setq desc (or desc (nth 1 entry))))) - (when (funcall (if (equal complete-file '(64)) 'not 'identity) - (not org-link-keep-stored-after-insertion)) - (setq org-stored-links (delq (assoc link org-stored-links) - org-stored-links))) - + (setq link-original link) (when (and (string-match org-link-plain-re link) (not (string-match org-ts-regexp link))) ;; URL-like link, normalize the use of angular brackets. @@ -1939,8 +2062,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support ((eq org-link-file-path-type 'relative) (setq path (file-relative-name path))) ((functionp org-link-file-path-type) - (setq path (funcall org-link-file-path-type - (expand-file-name path)))) + (setq path (funcall org-link-file-path-type path))) (t (save-match-data (if (string-match (concat "^" (regexp-quote @@ -1991,6 +2113,10 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (read-string "Description: " initial-input) initial-input))) + (when (funcall (if (equal complete-file '(64)) 'not 'identity) + (not org-link-keep-stored-after-insertion)) + (setq org-stored-links (delq (assoc link-original org-stored-links) + org-stored-links))) (unless (org-string-nw-p desc) (setq desc nil)) (when remove (apply #'delete-region remove)) (insert (org-link-make-string link desc)) @@ -2035,6 +2161,39 @@ This command can be called in any mode to insert a link in Org syntax." (org-load-modules-maybe) (org-run-like-in-org-mode 'org-insert-link)) +(defun org--re-list-search-forward (regexp-list &optional bound noerror count) + "Like `re-search-forward', but REGEXP-LIST is a list of regexps. +BOUND, NOERROR, and COUNT are passed to `re-search-forward'." + (let (result (min-found most-positive-fixnum) + (pos-found nil) + (min-found-data nil) + (tail regexp-list)) + (while tail + (setq result (save-excursion (re-search-forward (pop tail) bound t count))) + (when (and result (< result min-found)) + (setq min-found result + pos-found (match-end 0) + min-found-data (match-data)))) + (if (= most-positive-fixnum min-found) + (pcase noerror + (`t nil) + (_ (re-search-forward (car regexp-list) bound noerror count))) + (set-match-data min-found-data) + (goto-char pos-found)))) + +(defun org--re-list-looking-at (regexp-list &optional inhibit-modify) + "Like `looking-at', but REGEXP-LIST is a list of regexps. +INHIBIT-MODIFY is passed to `looking-at'." + (catch :found + (while regexp-list + (when + (if inhibit-modify + (looking-at-p (pop regexp-list)) + ;; FIXME: In Emacs <29, `looking-at' does not accept + ;; optional INHIBIT-MODIFY argument. + (looking-at (pop regexp-list))) + (throw :found t))))) + ;;;###autoload (defun org-update-radio-target-regexp () "Find all radio targets in this file and update the regular expression. @@ -2054,7 +2213,7 @@ Also refresh fontification if needed." ;; Make sure point is really within the object. (backward-char) (let ((obj (org-element-context))) - (when (eq (org-element-type obj) 'radio-target) + (when (org-element-type-p obj 'radio-target) (cl-pushnew (org-element-property :value obj) rtn :test #'equal)))) rtn)))) @@ -2072,6 +2231,30 @@ Also refresh fontification if needed." targets "\\|") after-re))) + (setq org-target-link-regexps nil) + (let (current-length sub-targets) + (when (<= org-target-link-regexp-limit (length org-target-link-regexp)) + (while (or targets sub-targets) + (when (and sub-targets + (or (not targets) + (>= (+ current-length (length (car targets))) + org-target-link-regexp-limit))) + (push (concat before-re + (mapconcat + (lambda (x) + (replace-regexp-in-string + " +" "\\s-+" (regexp-quote x) t t)) + (nreverse sub-targets) + "\\|") + after-re) + org-target-link-regexps) + (setq current-length nil + sub-targets nil)) + (unless current-length + (setq current-length (+ (length before-re) (length after-re)))) + (when targets (push (pop targets) sub-targets)) + (cl-incf current-length (length (car sub-targets)))) + (setq org-target-link-regexps (nreverse org-target-link-regexps)))) (unless (equal old-regexp org-target-link-regexp) ;; Clean-up cache. (let ((regexp (cond ((not old-regexp) org-target-link-regexp) @@ -2087,9 +2270,11 @@ Also refresh fontification if needed." after-re))))) (when (and (featurep 'org-element) (not (bound-and-true-p org-mode-loading))) - (org-with-point-at 1 - (while (re-search-forward regexp nil t) - (org-element-cache-refresh (match-beginning 1)))))) + (if org-target-link-regexps + (org-element-cache-reset) + (org-with-point-at 1 + (while (re-search-forward regexp nil t) + (org-element-cache-refresh (match-beginning 1))))))) ;; Re fontify buffer. (when (memq 'radio org-highlight-links) (org-restart-font-lock))))) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 06249ed48fa..10f25be8a8d 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -85,7 +85,7 @@ "org-habit" (&optional line)) (declare-function org-is-habit-p "org-habit" (&optional pom)) (declare-function org-habit-parse-todo "org-habit" (&optional pom)) -(declare-function org-habit-get-priority "org-habit" (habit &optional moment)) +(declare-function org-habit-get-urgency "org-habit" (habit &optional moment)) (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)) @@ -267,6 +267,7 @@ you can \"misuse\" it to also add other text to the header." (const category-keep) (const category-up) (const category-down) (const tag-down) (const tag-up) (const priority-up) (const priority-down) + (const urgency-up) (const urgency-down) (const todo-state-up) (const todo-state-down) (const effort-up) (const effort-down) (const habit-up) (const habit-down) @@ -893,17 +894,14 @@ the entry is scheduled today or was scheduled previously is not shown. When set to the symbol `not-today', skip scheduled previously, -but not scheduled today. - -When set to the symbol `repeated-after-deadline', skip scheduled -items if they are repeated beyond the current deadline." +but not scheduled today." :group 'org-agenda-skip :group 'org-agenda-daily/weekly :type '(choice (const :tag "Never" nil) (const :tag "Always" t) - (const :tag "Not when scheduled today" not-today) - (const :tag "When repeated past deadline" repeated-after-deadline))) + (const :tag "Not when scheduled today" not-today)) + :package-version '(Org . "9.7")) (defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil "Non-nil means skip timestamp line if same entry shows because of deadline. @@ -1101,6 +1099,14 @@ removed from entry text before it is shown in the agenda." :group 'org-agenda :type 'string) +(defcustom org-agenda-start-with-archives-mode nil + "Initial value of archive-mode in a newly created agenda window. +See `org-agenda-archives-mode' for acceptable values and their +meaning." + :group 'org-agenda-startup + :package-version '(Org . "9.7") + :type 'symbol) + (defvar org-agenda-entry-text-cleanup-hook nil "Hook that is run after basic cleanup of entry text to be shown in agenda. This cleanup is done in a temporary buffer, so the function may inspect and @@ -1332,16 +1338,22 @@ When set to the symbol `next' only the first future repeat is shown." (const :tag "Show all repeated entries" t) (const :tag "Show next repeated entry" next) (const :tag "Do not show repeated entries" nil)) - :version "26.1" :package-version '(Org . "9.1") :safe #'symbolp) +(defcustom org-agenda-skip-scheduled-repeats-after-deadline nil + "Non-nil hides scheduled repeated entries past deadline." + :group 'org-agenda-daily/weekly + :type 'boolean + :package-version '(Org . "9.7") + :safe t) + (defcustom org-agenda-prefer-last-repeat nil "Non-nil sets date for repeated entries to their last repeat. When nil, display SCHEDULED and DEADLINE dates at their base date, and in today's agenda, as a reminder. Display plain -time-stamps, on the other hand, at every repeat date in the past +timestamps, on the other hand, at every repeat date in the past in addition to the base date. When non-nil, show a repeated entry at its latest repeat date, @@ -1536,10 +1548,7 @@ value, don't limit agenda view by outline level." "Non-nil means search headline for a time-of-day. If the headline contains a time-of-day in one format or another, it will be used to sort the entry into the time sequence of items for a day. -Some people have time stamps in the headline that refer to the creation -time or so, and then this produces an unwanted side effect. If this is -the case for your, use this variable to turn off searching the headline -for a time." +Timestamps in the headline will be ignored." :group 'org-agenda-time-grid :type 'boolean) @@ -1617,9 +1626,9 @@ will align with agenda items." :group 'org-agenda) (defcustom org-agenda-sorting-strategy - '((agenda habit-down time-up priority-down category-keep) - (todo priority-down category-keep) - (tags priority-down category-keep) + '((agenda habit-down time-up urgency-down category-keep) + (todo urgency-down category-keep) + (tags urgency-down category-keep) (search category-keep)) "Sorting structure for the agenda items of a single day. This is a list of symbols which will be used in sequence to determine @@ -1646,6 +1655,12 @@ tag-up Sort alphabetically by last tag, A-Z. tag-down Sort alphabetically by last tag, Z-A. priority-up Sort numerically by priority, high priority last. priority-down Sort numerically by priority, high priority first. +urgency-up Sort numerically by urgency, high urgency last. + Urgency is calculated based on item's priority, + and proximity to scheduled time and deadline. See + info node `(org)Sorting of agenda items' for + details. +urgency-down Sort numerically by urgency, high urgency first. todo-state-up Sort by todo state, tasks that are done last. todo-state-down Sort by todo state, tasks that are done first. effort-up Sort numerically by estimated effort, high effort last. @@ -1687,7 +1702,8 @@ Custom commands can bind this variable in the options section." (cons (const :tag "Strategy for Tags matches" tags) (repeat ,org-sorting-choice)) (cons (const :tag "Strategy for search matches" search) - (repeat ,org-sorting-choice))))) + (repeat ,org-sorting-choice)))) + :package-version '(Org . "9.7")) (defcustom org-agenda-cmp-user-defined nil "A function to define the comparison `user-defined'. @@ -2368,10 +2384,10 @@ The following commands are available: (setq org-agenda-follow-mode org-agenda-start-with-follow-mode org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode org-agenda-show-log org-agenda-start-with-log-mode - org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode)) + org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode + org-agenda-archives-mode org-agenda-start-with-archives-mode)) (add-to-invisibility-spec '(org-filtered)) - (org-fold-core-initialize `(,org-link--description-folding-spec - ,org-link--link-folding-spec)) + (add-to-invisibility-spec '(org-link)) (easy-menu-change '("Agenda") "Agenda Files" (append @@ -3025,7 +3041,7 @@ Pressing `<' twice means to restrict to the current subtree or region (`todo-tree (org-check-for-org-mode) (org-occur (concat "^" org-outline-regexp "[ \t]*" - (regexp-quote org-match) "\\>"))) + (regexp-quote org-match) "\\(?:[\t ]\\|$\\)"))) (`occur-tree (org-check-for-org-mode) (org-occur org-match)) @@ -3108,8 +3124,7 @@ Agenda views are separated by `org-agenda-block-separator'." c entry key type match prefixes rmheader header-end custom1 desc line lines left right n n1) (save-window-excursion - (delete-other-windows) - (org-switch-to-buffer-other-window " *Agenda Commands*") + (pop-to-buffer " *Agenda Commands*" '(org-display-buffer-split)) (erase-buffer) (insert (eval-when-compile (let ((header @@ -3117,10 +3132,10 @@ Agenda views are separated by `org-agenda-block-separator'." "Press key for an agenda command: -------------------------------- < Buffer, subtree/region restriction a Agenda for current week or day > Remove restriction -t List of all TODO entries e Export agenda views -m Match a TAGS/PROP/TODO query T Entries with special TODO kwd -s Search for keywords M Like m, but only TODO entries -/ Multi-occur S Like s, but only TODO entries +/ Multi-occur 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 ? Find :FLAGGED: entries C Configure custom agenda commands * Toggle sticky agenda views # List stuck projects (!=configure) ")) @@ -3133,169 +3148,172 @@ s Search for keywords M Like m, but only TODO entries '(face bold) header)) header))) (setq header-end (point-marker)) - (while t - (setq custom1 custom) - (when (eq rmheader t) - (org-goto-line 1) - (re-search-forward ":" nil t) - (delete-region (match-end 0) (line-end-position)) - (forward-char 1) - (looking-at "-+") - (delete-region (match-end 0) (line-end-position)) - (move-marker header-end (match-end 0))) - (goto-char header-end) - (delete-region (point) (point-max)) - - ;; Produce all the lines that describe custom commands and prefixes - (setq lines nil) - (while (setq entry (pop custom1)) - (setq key (car entry) desc (nth 1 entry) - type (nth 2 entry) - match (nth 3 entry)) - (if (> (length key) 1) - (cl-pushnew (string-to-char key) prefixes :test #'equal) - (setq line - (format - "%-4s%-14s" - (org-add-props (copy-sequence key) - '(face bold)) - (cond - ((string-match "\\S-" desc) desc) - ((eq type 'agenda) "Agenda for current week or day") - ((eq type 'agenda*) "Appointments for current week or day") - ((eq type 'alltodo) "List of all TODO entries") - ((eq type 'search) "Word search") - ((eq type 'stuck) "List of stuck projects") - ((eq type 'todo) "TODO keyword") - ((eq type 'tags) "Tags query") - ((eq type 'tags-todo) "Tags (TODO)") - ((eq type 'tags-tree) "Tags tree") - ((eq type 'todo-tree) "TODO kwd tree") - ((eq type 'occur-tree) "Occur tree") - ((functionp type) (if (symbolp type) - (symbol-name type) - "Lambda expression")) - (t "???")))) + (unwind-protect + (while t + (setq custom1 custom) + (when (eq rmheader t) + (org-goto-line 1) + (re-search-forward ":" nil t) + (delete-region (match-end 0) (line-end-position)) + (forward-char 1) + (looking-at "-+") + (delete-region (match-end 0) (line-end-position)) + (move-marker header-end (match-end 0))) + (goto-char header-end) + (delete-region (point) (point-max)) + + ;; Produce all the lines that describe custom commands and prefixes + (setq lines nil) + (while (setq entry (pop custom1)) + (setq key (car entry) desc (nth 1 entry) + type (nth 2 entry) + match (nth 3 entry)) + (if (> (length key) 1) + (cl-pushnew (string-to-char key) prefixes :test #'equal) + (setq line + (format + "%-4s%-14s" + (org-add-props (copy-sequence key) + '(face bold)) + (cond + ((string-match "\\S-" desc) desc) + ((eq type 'agenda) "Agenda for current week or day") + ((eq type 'agenda*) "Appointments for current week or day") + ((eq type 'alltodo) "List of all TODO entries") + ((eq type 'search) "Word search") + ((eq type 'stuck) "List of stuck projects") + ((eq type 'todo) "TODO keyword") + ((eq type 'tags) "Tags query") + ((eq type 'tags-todo) "Tags (TODO)") + ((eq type 'tags-tree) "Tags tree") + ((eq type 'todo-tree) "TODO kwd tree") + ((eq type 'occur-tree) "Occur tree") + ((functionp type) (if (symbolp type) + (symbol-name type) + "Lambda expression")) + (t "???")))) + (cond + ((not (org-string-nw-p match)) nil) + (org-agenda-menu-show-matcher + (setq line + (concat line ": " + (cond + ((stringp match) + (propertize match 'face 'org-warning)) + ((listp type) + (format "set of %d commands" (length type))))))) + (t + (org-add-props line nil 'help-echo (concat "Matcher: " match)))) + (push line lines))) + (setq lines (nreverse lines)) + (when prefixes + (mapc (lambda (x) + (push + (format "%s %s" + (org-add-props (char-to-string x) + nil 'face 'bold) + (or (cdr (assoc (concat selstring + (char-to-string x)) + prefix-descriptions)) + "Prefix key")) + lines)) + prefixes)) + + ;; Check if we should display in two columns + (if org-agenda-menu-two-columns + (progn + (setq n (length lines) + n1 (+ (/ n 2) (mod n 2)) + right (nthcdr n1 lines) + left (copy-sequence lines)) + (setcdr (nthcdr (1- n1) left) nil)) + (setq left lines right nil)) + (while left + (insert "\n" (pop left)) + (when right + (if (< (current-column) 40) + (move-to-column 40 t) + (insert " ")) + (insert (pop right)))) + + ;; Make the window the right size + (goto-char (point-min)) + (if second-time + (when (not (pos-visible-in-window-p (point-max))) + (org-fit-window-to-buffer)) + (setq second-time t) + (org-fit-window-to-buffer)) + + ;; Hint to navigation if window too small for all information + (setq header-line-format + (when (not (pos-visible-in-window-p (point-max))) + "Use C-v, M-v, C-n or C-p to navigate.")) + + ;; Ask for selection + (cl-loop + do (progn + (message "Press key for agenda command%s:" + (if (or restrict-ok org-agenda-overriding-restriction) + (if org-agenda-overriding-restriction + " (restriction lock active)" + (if restriction + (format " (restricted to %s)" restriction) + " (unrestricted)")) + "")) + (setq c (read-char-exclusive))) + until (not (memq c '(14 16 22 134217846))) + do (org-scroll c)) + + (message "") (cond - ((not (org-string-nw-p match)) nil) - (org-agenda-menu-show-matcher - (setq line - (concat line ": " - (cond - ((stringp match) - (propertize match 'face 'org-warning)) - ((listp type) - (format "set of %d commands" (length type))))))) - (t - (org-add-props line nil 'help-echo (concat "Matcher: " match)))) - (push line lines))) - (setq lines (nreverse lines)) - (when prefixes - (mapc (lambda (x) - (push - (format "%s %s" - (org-add-props (char-to-string x) - nil 'face 'bold) - (or (cdr (assoc (concat selstring - (char-to-string x)) - prefix-descriptions)) - "Prefix key")) - lines)) - prefixes)) - - ;; Check if we should display in two columns - (if org-agenda-menu-two-columns - (progn - (setq n (length lines) - n1 (+ (/ n 2) (mod n 2)) - right (nthcdr n1 lines) - left (copy-sequence lines)) - (setcdr (nthcdr (1- n1) left) nil)) - (setq left lines right nil)) - (while left - (insert "\n" (pop left)) - (when right - (if (< (current-column) 40) - (move-to-column 40 t) - (insert " ")) - (insert (pop right)))) - - ;; Make the window the right size - (goto-char (point-min)) - (if second-time - (when (not (pos-visible-in-window-p (point-max))) - (org-fit-window-to-buffer)) - (setq second-time t) - (org-fit-window-to-buffer)) - - ;; Hint to navigation if window too small for all information - (setq header-line-format - (when (not (pos-visible-in-window-p (point-max))) - "Use C-v, M-v, C-n or C-p to navigate.")) - - ;; Ask for selection - (cl-loop - do (progn - (message "Press key for agenda command%s:" - (if (or restrict-ok org-agenda-overriding-restriction) - (if org-agenda-overriding-restriction - " (restriction lock active)" - (if restriction - (format " (restricted to %s)" restriction) - " (unrestricted)")) - "")) - (setq c (read-char-exclusive))) - until (not (memq c '(14 16 22 134217846))) - do (org-scroll c)) - - (message "") - (cond - ((assoc (char-to-string c) custom) - (setq selstring (concat selstring (char-to-string c))) - (throw 'exit (cons selstring restriction))) - ((memq c prefixes) - (setq selstring (concat selstring (char-to-string c)) - prefixes nil - rmheader (or rmheader t) - custom (delq nil (mapcar - (lambda (x) - (if (or (= (length (car x)) 1) - (/= (string-to-char (car x)) c)) - 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 buffers") - (ding) (sit-for 1)) - ((eq c ?1) - (org-agenda-remove-restriction-lock 'noupdate) - (setq restriction 'buffer)) - ((eq c ?0) - (org-agenda-remove-restriction-lock 'noupdate) - (setq restriction (if region-p 'region 'subtree))) - ((eq c ?<) - (org-agenda-remove-restriction-lock 'noupdate) - (setq restriction - (cond - ((eq restriction 'buffer) - (if region-p 'region 'subtree)) - ((memq restriction '(subtree region)) - nil) - (t 'buffer)))) - ((eq c ?>) - (org-agenda-remove-restriction-lock 'noupdate) - (setq restriction nil)) - ((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) - (org-agenda-get-restriction-and-command prefix-descriptions)) - - ((equal c ?q) (user-error "Abort")) - (t (user-error "Invalid key %c" c)))))))) + ((assoc (char-to-string c) custom) + (setq selstring (concat selstring (char-to-string c))) + (throw 'exit (cons selstring restriction))) + ((memq c prefixes) + (setq selstring (concat selstring (char-to-string c)) + prefixes nil + rmheader (or rmheader t) + custom (delq nil (mapcar + (lambda (x) + (if (or (= (length (car x)) 1) + (/= (string-to-char (car x)) c)) + 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 buffers") + (ding) (sit-for 1)) + ((eq c ?1) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction 'buffer)) + ((eq c ?0) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction (if region-p 'region 'subtree))) + ((eq c ?<) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction + (cond + ((eq restriction 'buffer) + (if region-p 'region 'subtree)) + ((memq restriction '(subtree region)) + nil) + (t 'buffer)))) + ((eq c ?>) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction nil)) + ((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) + (org-agenda-get-restriction-and-command prefix-descriptions)) + + ((equal c ?q) (user-error "Abort")) + (t (user-error "Invalid key %c" c)))) + ;; Close *Agenda Commands* window. + (quit-window 'kill)))))) (defun org-agenda-fit-window-to-buffer () "Fit the window to the buffer size." @@ -3303,7 +3321,7 @@ s Search for keywords M Like m, but only TODO entries (fboundp 'fit-window-to-buffer) (if (and (= (cdr org-agenda-window-frame-fractions) 1.0) (= (car org-agenda-window-frame-fractions) 1.0)) - (delete-other-windows) + (display-buffer (current-buffer) '(org-display-buffer-full-frame)) (org-fit-window-to-buffer nil (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) @@ -3525,7 +3543,8 @@ This ensures the export commands can easily use it." (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) (pop-up-frames nil) (dir default-directory) - cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname) + cmd thiscmdkey thiscmdcmd match files opts cmd-or-set + seriesp bufname) (save-window-excursion (while cmds (setq cmd (pop cmds) @@ -3537,9 +3556,12 @@ This ensures the export commands can easily use it." (format "*Org Agenda(%s:%s)*" thiscmdkey match)) (format "*Org Agenda(%s)*" thiscmdkey)) org-agenda-buffer-name) + ;; series: (0:key 1:desc 2:(cmd1 cmd2 ...) 3:general-settings 4:files) + ;; non-series: (0:key 1:desc 2:type 3:match 4:settings 5:files) 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)) + seriesp (not (or (symbolp cmd-or-set) (functionp cmd-or-set))) + opts (nth (if seriesp 3 4) cmd) + files (nth (if seriesp 4 5) cmd)) (if (stringp files) (setq files (list files))) (when files (let* ((opts (append org-agenda-exporter-settings opts)) @@ -3619,11 +3641,12 @@ the agenda to write." (goto-char p) (setq m (get-text-property (point) 'org-hd-marker)) (when m - (push (with-current-buffer (marker-buffer m) - (goto-char m) - (org-copy-subtree 1 nil t t) - org-subtree-clip) - content))) + (cl-pushnew (with-current-buffer (marker-buffer m) + (goto-char m) + (org-copy-subtree 1 nil t t) + org-subtree-clip) + content + :test #'equal))) (find-file file) (erase-buffer) (dolist (s content) (org-paste-subtree 1 s)) @@ -3631,8 +3654,7 @@ the agenda to write." (kill-buffer (current-buffer)) (message "Org file written to %s" file))) ((member extension '("html" "htm")) - (or (require 'htmlize nil t) - (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) + (org-require-package 'htmlize) (declare-function htmlize-buffer "htmlize" (&optional buffer)) (set-buffer (htmlize-buffer (current-buffer))) (when org-agenda-export-html-style @@ -3664,13 +3686,8 @@ the agenda to write." "ox-icalendar" (file)) (org-icalendar-export-current-agenda (expand-file-name file))) (t - (let ((bs (buffer-string))) - (find-file file) - (erase-buffer) - (insert bs) - (save-buffer 0) - (kill-buffer (current-buffer)) - (message "Plain text written to %s" file)))))))) + (write-region nil nil file) + (message "Plain text written to %s" file))))))) (set-buffer (or agenda-bufname ;; FIXME: I'm pretty sure called-interactively-p ;; doesn't do what we want here! @@ -3700,7 +3717,7 @@ Drawers will be excluded, also the line with scheduling/deadline info." (goto-char (point-min)) (while (not (eobp)) (if (not (setq m (org-get-at-bol 'org-hd-marker))) - (beginning-of-line 2) + (forward-line 1) (setq txt (org-agenda-get-some-entry-text m org-agenda-add-entry-text-maxlines " > ")) (end-of-line 1) @@ -3768,13 +3785,13 @@ removed from the entry content. Currently only `planning' is allowed here." (while (not (eobp)) (unless (looking-at "[ \t]*$") (setq ind (min ind (org-current-text-indentation)))) - (beginning-of-line 2)) + (forward-line 1)) (goto-char (point-min)) (while (not (eobp)) (unless (looking-at "[ \t]*$") (move-to-column ind) (delete-region (line-beginning-position) (point))) - (beginning-of-line 2)) + (forward-line 1)) (run-hooks 'org-agenda-entry-text-cleanup-hook) @@ -3913,7 +3930,7 @@ FILTER-ALIST is an alist of filters we need to apply when ((eq org-agenda-window-setup 'current-window) (pop-to-buffer-same-window abuf)) ((eq org-agenda-window-setup 'other-window) - (org-switch-to-buffer-other-window abuf)) + (switch-to-buffer-other-window abuf)) ((eq org-agenda-window-setup 'other-frame) (switch-to-buffer-other-frame abuf)) ((eq org-agenda-window-setup 'other-tab) @@ -3921,11 +3938,9 @@ FILTER-ALIST is an alist of filters we need to apply when (switch-to-buffer-other-tab abuf) (user-error "Your version of Emacs does not have tab bar support"))) ((eq org-agenda-window-setup 'only-window) - (delete-other-windows) - (pop-to-buffer-same-window abuf)) + (pop-to-buffer abuf '(org-display-buffer-full-frame))) ((eq org-agenda-window-setup 'reorganize-frame) - (delete-other-windows) - (org-switch-to-buffer-other-window abuf))) + (pop-to-buffer abuf '(org-display-buffer-split)))) (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist))) (setq org-agenda-category-filter (cdr (assq 'cat filter-alist))) (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist))) @@ -3953,7 +3968,6 @@ FILTER-ALIST is an alist of filters we need to apply when (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) (if org-agenda-multi (progn (setq buffer-read-only nil) @@ -3966,6 +3980,7 @@ FILTER-ALIST is an alist of filters we need to apply when (make-string (window-max-chars-per-line) org-agenda-block-separator)) "\n")) (narrow-to-region (point) (point-max))) + (setq org-todo-keywords-for-agenda nil) (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 @@ -4166,7 +4181,9 @@ dimming them." ;FIXME: The arg isn't used, actually! (line-beginning-position)) (line-end-position)))) (when todo-blocked - (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) + (overlay-put ov 'face 'org-agenda-dimmed-todo-face) + ;; Override other overlays. + (overlay-put ov 'priority 50)) (when invisible (org-agenda-filter-hide-line 'todo-blocked))) (if (= (point-max) (line-end-position)) @@ -4233,25 +4250,26 @@ Also moves point to the end of the skipped region, so that search can continue from there. Optional argument ELEMENT contains element at point." - (when (or - (if element - (eq (org-element-type element) 'comment) - (save-excursion - (goto-char (line-beginning-position)) - (looking-at comment-start-skip))) - (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) - (or (and (save-match-data (org-in-archived-heading-p nil element)) - (org-end-of-subtree t element)) - (and (member org-archive-tag org-file-tags) - (goto-char (point-max))))) - (and org-agenda-skip-comment-trees - (org-in-commented-heading-p nil element) - (org-end-of-subtree t element)) - (let ((to (or (org-agenda-skip-eval org-agenda-skip-function-global) - (org-agenda-skip-eval org-agenda-skip-function)))) - (and to (goto-char to))) - (org-in-src-block-p t element)) - (throw :skip t))) + (save-match-data + (when (or + (if element + (org-element-type-p element 'comment) + (save-excursion + (goto-char (line-beginning-position)) + (looking-at comment-start-skip))) + (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) + (or (and (save-match-data (org-in-archived-heading-p nil element)) + (org-end-of-subtree t element)) + (and (member org-archive-tag org-file-tags) + (goto-char (point-max))))) + (and org-agenda-skip-comment-trees + (org-in-commented-heading-p nil element) + (org-end-of-subtree t element)) + (let ((to (or (org-agenda-skip-eval org-agenda-skip-function-global) + (org-agenda-skip-eval org-agenda-skip-function)))) + (and to (goto-char to))) + (org-in-src-block-p t element)) + (throw :skip t)))) (defun org-agenda-skip-eval (form) "If FORM is a function or a list, call (or eval) it and return the result. @@ -4322,11 +4340,11 @@ This check for agenda markers in all agenda buffers currently active." (interactive) (save-excursion (goto-char (point-max)) - (beginning-of-line 1) + (forward-line 0) (while (not (bobp)) (when (org-get-at-bol 'org-hd-marker) (org-agenda-entry-text-show-here)) - (beginning-of-line 0)))) + (forward-line -1)))) (defun org-agenda-entry-text-hide () "Remove any shown entry context." @@ -4879,6 +4897,7 @@ is active." 'org-todo-regexp org-todo-regexp 'level level 'org-complex-heading-regexp org-complex-heading-regexp + 'urgency 1000 'priority 1000 'type "search") (push txt ee) @@ -4931,7 +4950,10 @@ Press `\\[org-agenda-manipulate-query-add]', \ "|")) "\n")) -(defvar org-select-this-todo-keyword nil) +(defvar org-select-this-todo-keyword nil + "Keyword selector for todo agenda. +Should either be a keyword, \"*\", or \"|\"-separated list of todo +keywords.") (defvar org-last-arg nil) (defvar crm-separator) @@ -4946,48 +4968,48 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (interactive "P") (when org-agenda-overriding-arguments (setq arg org-agenda-overriding-arguments)) - (when (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) - (let* ((today (org-today)) - (date (calendar-gregorian-from-absolute today)) + (when (and (stringp arg) (not (string-match "\\S-" arg))) + (setq arg nil)) + (let* ((today (calendar-gregorian-from-absolute (org-today))) (completion-ignore-case t) - kwds org-select-this-todo-keyword rtn rtnall files file pos) + todo-keywords org-select-this-todo-keyword todo-entries all-todo-entries files file pos) (catch 'exit (setq org-agenda-buffer-name (org-agenda--get-buffer-name - (and org-agenda-sticky + (when org-agenda-sticky (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") - (setq kwds org-todo-keywords-for-agenda - org-select-this-todo-keyword (if (stringp arg) arg - (and (integerp arg) - (> arg 0) - (nth (1- arg) kwds)))) + (setq todo-keywords org-todo-keywords-for-agenda + org-select-this-todo-keyword (cond ((stringp arg) arg) + ((and (integerp arg) (> arg 0)) + (nth (1- arg) todo-keywords)))) (when (equal arg '(4)) (setq org-select-this-todo-keyword (mapconcat #'identity (let ((crm-separator "|")) (completing-read-multiple "Keyword (or KWD1|KWD2|...): " - (mapcar #'list kwds) nil nil)) + (mapcar #'list todo-keywords) nil nil)) "|"))) - (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) + (when (equal arg 0) + (setq org-select-this-todo-keyword nil)) (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-todo-list (or (and (numberp current-prefix-arg) current-prefix-arg) ,org-select-this-todo-keyword - current-prefix-arg ,arg))) + current-prefix-arg + ,arg))) (setq files (org-agenda-files nil 'ifmode) - rtnall nil) + all-todo-entries 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)))) + (setq todo-entries (org-agenda-get-day-entries file today :todo)) + (setq all-todo-entries (append all-todo-entries todo-entries)))) (org-agenda--insert-overriding-header (with-temp-buffer (insert "Global list of TODO items of type: ") @@ -5005,7 +5027,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in \\`N \\[org-agenda-redo]' (e.g. `0 \\[org-agenda-redo]') \ to search again: (0)[ALL]")) (let ((n 0)) - (dolist (k kwds) + (dolist (k todo-keywords) (let ((s (format "(%d)%s" (cl-incf n) k))) (when (> (+ (current-column) (string-width s) 1) (window-max-chars-per-line)) (insert "\n ")) @@ -5014,8 +5036,8 @@ to search again: (0)[ALL]")) (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-secondary)) (buffer-string))) (org-agenda-mark-header-line (point-min)) - (when rtnall - (insert (org-agenda-finalize-entries rtnall 'todo) "\n")) + (when all-todo-entries + (insert (org-agenda-finalize-entries all-todo-entries 'todo) "\n")) (goto-char (point-min)) (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (add-text-properties (point-min) (point-max) @@ -5290,8 +5312,8 @@ of what a project is and how to check if it stuck, customize the variable (org-delete-all org-done-keywords-for-agenda (copy-sequence org-todo-keywords-for-agenda)))) (todo-re (and todo - (format "^\\*+[ \t]+\\(%s\\)\\>" - (mapconcat #'identity todo-wds "\\|")))) + (format "^\\*+[ \t]+\\(%s\\)\\(?:[ \t]\\|$\\)" + (mapconcat #'regexp-quote todo-wds "\\|")))) (tags-re (cond ((null tags) nil) ((member "*" tags) org-tag-line-re) (tags @@ -5575,35 +5597,35 @@ the documentation of `org-diary'." (defvar org-heading-keyword-regexp-format) ; defined in org.el (defvar org-agenda-sorting-strategy-selected nil) -(defun org-agenda-entry-get-agenda-timestamp (pom) +(defun org-agenda-entry-get-agenda-timestamp (epom) "Retrieve timestamp information for sorting agenda views. -Given a point or marker POM, returns a cons cell of the timestamp -and the timestamp type relevant for the sorting strategy in +Given an element, point, or marker EPOM, returns a cons cell of the +timestamp and the timestamp type relevant for the sorting strategy in `org-agenda-sorting-strategy-selected'." (let (ts ts-date-type) (save-match-data (cond ((org-em 'scheduled-up 'scheduled-down org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get pom "SCHEDULED") + (setq ts (org-entry-get epom "SCHEDULED") ts-date-type " scheduled")) ((org-em 'deadline-up 'deadline-down org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get pom "DEADLINE") + (setq ts (org-entry-get epom "DEADLINE") ts-date-type " deadline")) ((org-em 'ts-up 'ts-down org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get pom "TIMESTAMP") + (setq ts (org-entry-get epom "TIMESTAMP") ts-date-type " timestamp")) ((org-em 'tsia-up 'tsia-down org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get pom "TIMESTAMP_IA") + (setq ts (org-entry-get epom "TIMESTAMP_IA") ts-date-type " timestamp_ia")) ((org-em 'timestamp-up 'timestamp-down org-agenda-sorting-strategy-selected) - (setq ts (or (org-entry-get pom "SCHEDULED") - (org-entry-get pom "DEADLINE") - (org-entry-get pom "TIMESTAMP") - (org-entry-get pom "TIMESTAMP_IA")) + (setq ts (or (org-entry-get epom "SCHEDULED") + (org-entry-get epom "DEADLINE") + (org-entry-get epom "TIMESTAMP") + (org-entry-get epom "TIMESTAMP_IA")) ts-date-type "")) (t (setq ts-date-type ""))) (cons (when ts (ignore-errors (org-time-string-to-absolute ts))) @@ -5628,14 +5650,14 @@ and the timestamp type relevant for the sorting strategy in org-todo-regexp) (org-select-this-todo-keyword (concat "\\(" - (mapconcat #'identity - (org-split-string - org-select-this-todo-keyword - "|") - "\\|") + (mapconcat #'regexp-quote + (org-split-string + org-select-this-todo-keyword + "|") + "\\|") "\\)")) (t org-not-done-regexp)))) - marker priority category level tags todo-state + marker priority urgency category level tags todo-state ts-date ts-date-type ts-date-pair ee txt beg end inherited-tags todo-state-end-pos effort effort-minutes) @@ -5643,7 +5665,7 @@ and the timestamp type relevant for the sorting strategy in (while (re-search-forward regexp nil t) (catch :skip (save-match-data - (beginning-of-line) + (forward-line 0) (org-agenda-skip) (setq beg (point) end (save-excursion (outline-next-heading) (point))) (unless (and (setq todo-state (org-get-todo-state)) @@ -5656,7 +5678,7 @@ and the timestamp type relevant for the sorting strategy in (throw :skip nil))) (goto-char (match-beginning 2)) (setq marker (org-agenda-new-marker (match-beginning 0)) - category (org-get-category) + category (save-match-data (org-get-category)) effort (save-match-data (or (get-text-property (point) 'effort) (org-entry-get (point) org-effort-property))) effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))) @@ -5673,15 +5695,18 @@ and the timestamp type relevant for the sorting strategy in (memq 'todo org-agenda-use-tag-inheritance)))) tags (org-get-tags nil (not inherited-tags)) level (make-string (org-reduced-level (org-outline-level)) ? ) - txt (org-agenda-format-item "" - (org-add-props txt nil - 'effort effort - 'effort-minutes effort-minutes) - level category tags t) - priority (1+ (org-get-priority txt))) + txt (org-agenda-format-item + "" + (org-add-props txt nil + 'effort effort + 'effort-minutes effort-minutes) + level category tags t) + urgency (1+ (org-get-priority txt)) + priority (org-get-priority txt)) (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'priority priority + 'urgency urgency 'effort effort 'effort-minutes effort-minutes 'level level 'ts-date ts-date @@ -5697,7 +5722,7 @@ and the timestamp type relevant for the sorting strategy in 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." - (let ((days (org-time-stamp-to-now + (let ((days (org-timestamp-to-now time org-agenda-todo-ignore-time-comparison-use-seconds))) (if (>= n 0) (>= days n) @@ -5719,13 +5744,13 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (re-search-forward org-scheduled-time-regexp end t) (cond ((eq org-agenda-todo-ignore-scheduled 'future) - (> (org-time-stamp-to-now + (> (org-timestamp-to-now (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) ((eq org-agenda-todo-ignore-scheduled 'past) - (<= (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) - 0)) + (<= (org-timestamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) ((numberp org-agenda-todo-ignore-scheduled) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-scheduled)) @@ -5737,13 +5762,13 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', ((eq org-agenda-todo-ignore-deadlines 'far) (not (org-deadline-close-p (match-string 1)))) ((eq org-agenda-todo-ignore-deadlines 'future) - (> (org-time-stamp-to-now + (> (org-timestamp-to-now (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) ((eq org-agenda-todo-ignore-deadlines 'past) - (<= (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) - 0)) + (<= (org-timestamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) ((numberp org-agenda-todo-ignore-deadlines) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-deadlines)) @@ -5766,13 +5791,13 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (when (re-search-forward org-ts-regexp nil t) (cond ((eq org-agenda-todo-ignore-timestamp 'future) - (> (org-time-stamp-to-now + (> (org-timestamp-to-now (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) ((eq org-agenda-todo-ignore-timestamp 'past) - (<= (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) - 0)) + (<= (org-timestamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) ((numberp org-agenda-todo-ignore-timestamp) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-timestamp)) @@ -5798,30 +5823,28 @@ displayed in agenda view." (let ((m (get-text-property 0 'org-hd-marker d))) (and m (marker-position m)))) deadlines)) - ;; Match time-stamps set to current date, time-stamps with - ;; a repeater, and S-exp time-stamps. + ;; Match timestamps set to current date, timestamps with + ;; a repeater, and S-exp timestamps. (regexp (concat (if org-agenda-include-inactive-timestamps "[[<]" "<") (regexp-quote - (substring - (format-time-string - (org-time-stamp-format) - (org-encode-time ; DATE bound by calendar - 0 0 0 (nth 1 date) (car date) (nth 2 date))) - 1 11)) + (format-time-string + "%Y-%m-%d" ; We do not use `org-time-stamp-format' to not demand day name in timestamps. + (org-encode-time ; DATE bound by calendar + 0 0 0 (nth 1 date) (car date) (nth 2 date)))) "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" - "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) + "\\|\\(<%%\\(([^>\n]+)\\)\\([^\n>]*\\)>\\)")) timestamp-items) (goto-char (point-min)) (while (re-search-forward regexp nil t) ;; Skip date ranges, scheduled and deadlines, which are handled - ;; specially. Also skip time-stamps before first headline as + ;; specially. Also skip timestamps before first headline as ;; there would be no entry to add to the agenda. Eventually, ;; ignore clock entries. (catch :skip (save-match-data - (when (or (org-at-date-range-p) + (when (or (org-at-date-range-p t) (org-at-planning-p) (org-before-first-heading-p) (and org-agenda-include-inactive-timestamps @@ -5832,13 +5855,13 @@ displayed in agenda view." (let* ((pos (match-beginning 0)) (repeat (match-string 1)) (sexp-entry (match-string 3)) - (time-stamp (if (or repeat sexp-entry) (match-string 0) - (save-excursion - (goto-char pos) - (looking-at org-ts-regexp-both) - (match-string 0)))) + (timestamp (if (or repeat sexp-entry) (match-string 0) + (save-excursion + (goto-char pos) + (looking-at org-ts-regexp-both) + (match-string 0)))) (todo-state (org-get-todo-state)) - (warntime (get-text-property (point) 'org-appt-warntime)) + (warntime (org-entry-get (point) "APPT_WARNTIME" 'selective)) (done? (member todo-state org-done-keywords))) ;; Possibly skip done tasks. (when (and done? org-agenda-skip-timestamp-if-done) @@ -5881,7 +5904,7 @@ displayed in agenda view." (throw :skip nil)))) (save-excursion (re-search-backward org-outline-regexp-bol nil t) - ;; Possibly skip time-stamp when a deadline is set. + ;; Possibly skip timestamp when a deadline is set. (when (and org-agenda-skip-timestamp-if-deadline-is-shown (assq (point) deadline-position-alist)) (throw :skip nil)) @@ -5909,11 +5932,12 @@ displayed in agenda view." (org-add-props head nil 'effort effort 'effort-minutes effort-minutes) - level category tags time-stamp org-ts-regexp habit?))) + level category tags timestamp org-ts-regexp habit?))) (org-add-props item props - 'priority (if habit? - (org-habit-get-priority (org-habit-parse-todo)) - (org-get-priority item)) + 'urgency (if habit? + (org-habit-get-urgency (org-habit-parse-todo)) + (org-get-priority item)) + 'priority (org-get-priority item) 'org-marker (org-agenda-new-marker pos) 'org-hd-marker (org-agenda-new-marker) 'date date @@ -5983,7 +6007,7 @@ displayed in agenda view." (memq 'agenda org-agenda-use-tag-inheritance)))) tags (org-get-tags nil (not inherited-tags)) todo-state (org-get-todo-state) - warntime (get-text-property (point) 'org-appt-warntime) + warntime (org-entry-get (point) "APPT_WARNTIME" 'selective) extra nil) (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) @@ -5998,10 +6022,10 @@ displayed in agenda view." (setq txt r) (setq txt "SEXP entry returned empty string")) (setq txt (org-agenda-format-item extra - (org-add-props txt nil - 'effort effort - 'effort-minutes effort-minutes) - level category tags 'time)) + (org-add-props txt nil + 'effort effort + 'effort-minutes effort-minutes) + level category tags 'time)) (org-add-props txt props 'org-marker marker 'date date 'todo-state todo-state 'effort effort 'effort-minutes effort-minutes @@ -6087,12 +6111,10 @@ then those holidays will be skipped." "\\(" parts-re "\\)" " *\\[" (regexp-quote - (substring - (format-time-string - (org-time-stamp-format) - (org-encode-time ; DATE bound by calendar - 0 0 0 (nth 1 date) (car date) (nth 2 date))) - 1 11)))) + (format-time-string + "%Y-%m-%d" ; We do not use `org-time-stamp-format' to not demand day name in timestamps. + (org-encode-time ; DATE bound by calendar + 0 0 0 (nth 1 date) (car date) (nth 2 date)))))) (org-agenda-search-headline-for-time nil) marker hdmarker priority category level tags closedp type statep clockp state ee txt extra timestr rest clocked inherited-tags @@ -6106,12 +6128,12 @@ then those holidays will be skipped." statep (equal (string-to-char (match-string 1)) ?-) clockp (not (or closedp statep)) state (and statep (match-string 2)) - category (org-get-category (match-beginning 0)) + category (save-match-data (org-get-category (match-beginning 0))) timestr (buffer-substring (match-beginning 0) (line-end-position)) effort (save-match-data (or (get-text-property (point) 'effort) (org-entry-get (point) org-effort-property)))) (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) - (when (string-match "\\]" timestr) + (when (string-match org-ts-regexp-inactive timestr) ;; substring should only run to end of time stamp (setq rest (substring timestr (match-end 0)) timestr (substring timestr 0 (match-end 0))) @@ -6167,7 +6189,7 @@ then those holidays will be skipped." (setq priority 100000) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done - 'priority priority 'level level + 'urgency priority 'priority priority 'level level 'effort effort 'effort-minutes effort-minutes 'type type 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) @@ -6315,320 +6337,180 @@ specification like [h]h:mm." (today (org-today)) (today? (org-agenda-today-p date)) ; DATE bound by calendar. (current (calendar-absolute-from-gregorian date)) - deadline-items) - (goto-char (point-min)) - (if (org-element--cache-active-p) - (org-element-cache-map - (lambda (el) - (when (and (org-element-property :deadline el) - ;; Only consider active timestamp values. - (memq (org-element-property - :type - (org-element-property :deadline el)) - '(diary active active-range)) - (or (not with-hour) - (org-element-property - :hour-start - (org-element-property :deadline el)) - (org-element-property - :hour-end - (org-element-property :deadline el)))) - (goto-char (org-element-property :contents-begin el)) - (catch :skip - (org-agenda-skip el) - (let* ((s (substring (org-element-property - :raw-value - (org-element-property :deadline el)) - 1 -1)) - (pos (save-excursion - (goto-char (org-element-property :contents-begin el)) - ;; We intentionally leave NOERROR - ;; argument in `re-search-forward' nil. If - ;; the search fails here, something went - ;; wrong and we are looking at - ;; non-matching headline. - (re-search-forward regexp (line-end-position)) - (1- (match-beginning 1)))) - (todo-state (org-element-property :todo-keyword el)) - (done? (eq 'done (org-element-property :todo-type el))) - (sexp? (eq 'diary - (org-element-property - :type (org-element-property :deadline el)))) - ;; DEADLINE is the deadline date for the entry. It is - ;; either the base date or the last repeat, according - ;; to `org-agenda-prefer-last-repeat'. - (deadline - (cond - (sexp? (org-agenda--timestamp-to-absolute s current)) - ((or (eq org-agenda-prefer-last-repeat t) - (member todo-state org-agenda-prefer-last-repeat)) - (org-agenda--timestamp-to-absolute - s today 'past (current-buffer) pos)) - (t (org-agenda--timestamp-to-absolute s)))) - ;; REPEAT is the future repeat closest from CURRENT, - ;; according to `org-agenda-show-future-repeats'. If - ;; the latter is nil, or if the time stamp has no - ;; repeat part, default to DEADLINE. - (repeat + deadline-items) + (org-element-cache-map + (lambda (el) + (when (and (org-element-property :deadline el) + ;; Only consider active timestamp values. + (memq (org-element-property + :type + (org-element-property :deadline el)) + '(diary active active-range)) + (or (not with-hour) + (org-element-property + :hour-start + (org-element-property :deadline el)) + (org-element-property + :hour-end + (org-element-property :deadline el)))) + (goto-char (org-element-contents-begin el)) + (catch :skip + (org-agenda-skip el) + (let* ((s (substring (org-element-property + :raw-value + (org-element-property :deadline el)) + 1 -1)) + (pos (save-excursion + (goto-char (org-element-contents-begin el)) + ;; We intentionally leave NOERROR + ;; argument in `re-search-forward' nil. If + ;; the search fails here, something went + ;; wrong and we are looking at + ;; non-matching headline. + (re-search-forward regexp (line-end-position)) + (1- (match-beginning 1)))) + (todo-state (org-element-property :todo-keyword el)) + (done? (eq 'done (org-element-property :todo-type el))) + (sexp? (eq 'diary + (org-element-property + :type (org-element-property :deadline el)))) + ;; DEADLINE is the deadline date for the entry. It is + ;; either the base date or the last repeat, according + ;; to `org-agenda-prefer-last-repeat'. + (deadline + (cond + (sexp? (org-agenda--timestamp-to-absolute s current)) + ((or (eq org-agenda-prefer-last-repeat t) + (member todo-state org-agenda-prefer-last-repeat)) + (org-agenda--timestamp-to-absolute + s today 'past (current-buffer) pos)) + (t (org-agenda--timestamp-to-absolute s)))) + ;; REPEAT is the future repeat closest from CURRENT, + ;; according to `org-agenda-show-future-repeats'. If + ;; the latter is nil, or if the time stamp has no + ;; repeat part, default to DEADLINE. + (repeat + (cond + (sexp? deadline) + ((<= current today) deadline) + ((not org-agenda-show-future-repeats) deadline) + (t + (let ((base (if (eq org-agenda-show-future-repeats 'next) + (1+ today) + current))) + (org-agenda--timestamp-to-absolute + s base 'future (current-buffer) pos))))) + (diff (- deadline current)) + (max-warning-days + (let ((scheduled + (and org-agenda-skip-deadline-prewarning-if-scheduled + (org-element-property + :raw-value + (org-element-property :scheduled el))))) + (cond + ((not scheduled) most-positive-fixnum) + ;; The current item has a scheduled date, so + ;; evaluate its prewarning lead time. + ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) + ;; Use global prewarning-restart lead time. + org-agenda-skip-deadline-prewarning-if-scheduled) + ((eq org-agenda-skip-deadline-prewarning-if-scheduled + 'pre-scheduled) + ;; Set pre-warning to no earlier than SCHEDULED. + (min (- deadline + (org-agenda--timestamp-to-absolute scheduled)) + org-deadline-warning-days)) + ;; Set pre-warning to deadline. + (t 0)))) + (warning-days (min max-warning-days (org-get-wdays s)))) + (cond + ;; Only display deadlines at their base date, at future + ;; repeat occurrences or in today agenda. + ((= current deadline) nil) + ((= current repeat) nil) + ((not today?) (throw :skip nil)) + ;; Upcoming deadline: display within warning period WARNING-DAYS. + ((> deadline current) (when (> diff warning-days) (throw :skip nil))) + ;; Overdue deadline: warn about it for + ;; `org-deadline-past-days' duration. + (t (when (< org-deadline-past-days (- diff)) (throw :skip nil)))) + ;; Possibly skip done tasks. + (when (and done? + (or org-agenda-skip-deadline-if-done + (/= deadline current))) + (throw :skip nil)) + (save-excursion + (goto-char (org-element-begin el)) + (let* ((category (org-get-category)) + (effort (save-match-data (or (get-text-property (point) 'effort) + (org-element-property (intern (concat ":" (upcase org-effort-property))) el)))) + (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) + (level (make-string (org-element-property :level el) + ?\s)) + (head (save-excursion + (goto-char (org-element-begin el)) + (re-search-forward org-outline-regexp-bol) + (buffer-substring-no-properties (point) (line-end-position)))) + (inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda + org-agenda-use-tag-inheritance))))) + (tags (org-get-tags el (not inherited-tags))) + (time (cond - (sexp? deadline) - ((<= current today) deadline) - ((not org-agenda-show-future-repeats) deadline) - (t - (let ((base (if (eq org-agenda-show-future-repeats 'next) - (1+ today) - current))) - (org-agenda--timestamp-to-absolute - s base 'future (current-buffer) pos))))) - (diff (- deadline current)) - (suppress-prewarning - (let ((scheduled - (and org-agenda-skip-deadline-prewarning-if-scheduled - (org-element-property - :raw-value - (org-element-property :scheduled el))))) - (cond - ((not scheduled) nil) - ;; The current item has a scheduled date, so - ;; evaluate its prewarning lead time. - ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) - ;; Use global prewarning-restart lead time. - org-agenda-skip-deadline-prewarning-if-scheduled) - ((eq org-agenda-skip-deadline-prewarning-if-scheduled - 'pre-scheduled) - ;; Set pre-warning to no earlier than SCHEDULED. - (min (- deadline - (org-agenda--timestamp-to-absolute scheduled)) - org-deadline-warning-days)) - ;; Set pre-warning to deadline. - (t 0)))) - (wdays (or suppress-prewarning (org-get-wdays s)))) - (cond - ;; Only display deadlines at their base date, at future - ;; repeat occurrences or in today agenda. - ((= current deadline) nil) - ((= current repeat) nil) - ((not today?) (throw :skip nil)) - ;; Upcoming deadline: display within warning period WDAYS. - ((> deadline current) (when (> diff wdays) (throw :skip nil))) - ;; Overdue deadline: warn about it for - ;; `org-deadline-past-days' duration. - (t (when (< org-deadline-past-days (- diff)) (throw :skip nil)))) - ;; Possibly skip done tasks. - (when (and done? - (or org-agenda-skip-deadline-if-done - (/= deadline current))) - (throw :skip nil)) - (save-excursion - (goto-char (org-element-property :begin el)) - (let* ((category (org-get-category)) - (effort (save-match-data (or (get-text-property (point) 'effort) - (org-element-property (intern (concat ":" (upcase org-effort-property))) el)))) - (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) - (level (make-string (org-element-property :level el) - ?\s)) - (head (save-excursion - (goto-char (org-element-property :begin el)) - (re-search-forward org-outline-regexp-bol) - (buffer-substring-no-properties (point) (line-end-position)))) - (inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda - org-agenda-use-tag-inheritance))))) - (tags (org-get-tags el (not inherited-tags))) - (time - (cond - ;; No time of day designation if it is only - ;; a reminder. - ((and (/= current deadline) (/= current repeat)) nil) - ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (concat (substring s (match-beginning 1)) " ")) - (t 'time))) - (item - (org-agenda-format-item - ;; Insert appropriate suffixes before deadlines. - ;; Those only apply to today agenda. - (pcase-let ((`(,now ,future ,past) - org-agenda-deadline-leaders)) - (cond - ((and today? (< deadline today)) (format past (- diff))) - ((and today? (> deadline today)) (format future diff)) - (t now))) - (org-add-props head nil - 'effort effort - 'effort-minutes effort-minutes) - level category tags time)) - (face (org-agenda-deadline-face - (- 1 (/ (float diff) (max wdays 1))))) - (upcoming? (and today? (> deadline today))) - (warntime (get-text-property (point) 'org-appt-warntime))) - (org-add-props item props - 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) - 'warntime warntime - 'level level - 'effort effort 'effort-minutes effort-minutes - 'ts-date deadline - 'priority - ;; Adjust priority to today reminders about deadlines. - ;; Overdue deadlines get the highest priority - ;; increase, then imminent deadlines and eventually - ;; more distant deadlines. - (let ((adjust (if today? (- diff) 0))) - (+ adjust (org-get-priority item))) - 'todo-state todo-state - 'type (if upcoming? "upcoming-deadline" "deadline") - 'date (if upcoming? date deadline) - 'face (if done? 'org-agenda-done face) - 'undone-face face - 'done-face 'org-agenda-done) - (push item deadline-items))))))) - :next-re regexp - :fail-re regexp - :narrow t) - (while (re-search-forward regexp nil t) - (catch :skip - (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) - (org-agenda-skip) - (let* ((s (match-string 1)) - (pos (1- (match-beginning 1))) - (todo-state (save-match-data (org-get-todo-state))) - (done? (member todo-state org-done-keywords)) - (sexp? (string-prefix-p "%%" s)) - ;; DEADLINE is the deadline date for the entry. It is - ;; either the base date or the last repeat, according - ;; to `org-agenda-prefer-last-repeat'. - (deadline - (cond - (sexp? (org-agenda--timestamp-to-absolute s current)) - ((or (eq org-agenda-prefer-last-repeat t) - (member todo-state org-agenda-prefer-last-repeat)) - (org-agenda--timestamp-to-absolute - s today 'past (current-buffer) pos)) - (t (org-agenda--timestamp-to-absolute s)))) - ;; REPEAT is the future repeat closest from CURRENT, - ;; according to `org-agenda-show-future-repeats'. If - ;; the latter is nil, or if the time stamp has no - ;; repeat part, default to DEADLINE. - (repeat - (cond - (sexp? deadline) - ((<= current today) deadline) - ((not org-agenda-show-future-repeats) deadline) - (t - (let ((base (if (eq org-agenda-show-future-repeats 'next) - (1+ today) - current))) - (org-agenda--timestamp-to-absolute - s base 'future (current-buffer) pos))))) - (diff (- deadline current)) - (suppress-prewarning - (let ((scheduled - (and org-agenda-skip-deadline-prewarning-if-scheduled - (org-entry-get nil "SCHEDULED")))) - (cond - ((not scheduled) nil) - ;; The current item has a scheduled date, so - ;; evaluate its prewarning lead time. - ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) - ;; Use global prewarning-restart lead time. - org-agenda-skip-deadline-prewarning-if-scheduled) - ((eq org-agenda-skip-deadline-prewarning-if-scheduled - 'pre-scheduled) - ;; Set pre-warning to no earlier than SCHEDULED. - (min (- deadline - (org-agenda--timestamp-to-absolute scheduled)) - org-deadline-warning-days)) - ;; Set pre-warning to deadline. - (t 0)))) - (wdays (or suppress-prewarning (org-get-wdays s)))) - (cond - ;; Only display deadlines at their base date, at future - ;; repeat occurrences or in today agenda. - ((= current deadline) nil) - ((= current repeat) nil) - ((not today?) (throw :skip nil)) - ;; Upcoming deadline: display within warning period WDAYS. - ((> deadline current) (when (> diff wdays) (throw :skip nil))) - ;; Overdue deadline: warn about it for - ;; `org-deadline-past-days' duration. - (t (when (< org-deadline-past-days (- diff)) (throw :skip nil)))) - ;; Possibly skip done tasks. - (when (and done? - (or org-agenda-skip-deadline-if-done - (/= deadline current))) - (throw :skip nil)) - (save-excursion - (re-search-backward "^\\*+[ \t]+" nil t) - (goto-char (match-end 0)) - (let* ((category (org-get-category)) - (effort (save-match-data (or (get-text-property (point) 'effort) - (org-entry-get (point) org-effort-property)))) - (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) - (level (make-string (org-reduced-level (org-outline-level)) - ?\s)) - (head (buffer-substring-no-properties - (point) (line-end-position))) - (inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda - org-agenda-use-tag-inheritance))))) - (tags (org-get-tags nil (not inherited-tags))) - (time - (cond - ;; No time of day designation if it is only - ;; a reminder. - ((and (/= current deadline) (/= current repeat)) nil) - ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (concat (substring s (match-beginning 1)) " ")) - (t 'time))) - (item - (org-agenda-format-item - ;; Insert appropriate suffixes before deadlines. - ;; Those only apply to today agenda. - (pcase-let ((`(,now ,future ,past) - org-agenda-deadline-leaders)) - (cond - ((and today? (< deadline today)) (format past (- diff))) - ((and today? (> deadline today)) (format future diff)) - (t now))) - (org-add-props head nil - 'effort effort - 'effort-minutes effort-minutes) - level category tags time)) - (face (org-agenda-deadline-face - (- 1 (/ (float diff) (max wdays 1))))) - (upcoming? (and today? (> deadline today))) - (warntime (get-text-property (point) 'org-appt-warntime))) - (org-add-props item props - 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) - 'warntime warntime - 'level level - 'effort effort 'effort-minutes effort-minutes - 'ts-date deadline - 'priority - ;; Adjust priority to today reminders about deadlines. - ;; Overdue deadlines get the highest priority - ;; increase, then imminent deadlines and eventually - ;; more distant deadlines. - (let ((adjust (if today? (- diff) 0))) - (+ adjust (org-get-priority item))) - 'todo-state todo-state - 'type (if upcoming? "upcoming-deadline" "deadline") - 'date (if upcoming? date deadline) - 'face (if done? 'org-agenda-done face) - 'undone-face face - 'done-face 'org-agenda-done) - (push item deadline-items))))))) + ;; No time of day designation if it is only + ;; a reminder. + ((and (/= current deadline) (/= current repeat)) nil) + ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (concat (substring s (match-beginning 1)) " ")) + (t 'time))) + (item + (org-agenda-format-item + ;; Insert appropriate suffixes before deadlines. + ;; Those only apply to today agenda. + (pcase-let ((`(,now ,future ,past) + org-agenda-deadline-leaders)) + (cond + ((and today? (< deadline today)) (format past (- diff))) + ((and today? (> deadline today)) (format future diff)) + (t now))) + (org-add-props head nil + 'effort effort + 'effort-minutes effort-minutes) + level category tags time)) + (face (org-agenda-deadline-face + (- 1 (/ (float diff) (max warning-days 1))))) + (upcoming? (and today? (> deadline today))) + (warntime (org-entry-get (point) "APPT_WARNTIME" 'selective))) + (org-add-props item props + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) + 'warntime warntime + 'level level + 'effort effort 'effort-minutes effort-minutes + 'ts-date deadline + 'urgency + ;; Adjust urgency to today reminders about deadlines. + ;; Overdue deadlines get the highest urgency + ;; increase, then imminent deadlines and eventually + ;; more distant deadlines. + (let ((adjust (if today? (- diff) 0))) + (+ adjust (org-get-priority item))) + 'priority (org-get-priority item) + 'todo-state todo-state + 'type (if upcoming? "upcoming-deadline" "deadline") + 'date (if upcoming? date deadline) + 'face (if done? 'org-agenda-done face) + 'undone-face face + 'done-face 'org-agenda-done) + (push item deadline-items))))))) + :next-re regexp + :fail-re regexp + :narrow t) (nreverse deadline-items))) (defun org-agenda-deadline-face (fraction) @@ -6661,435 +6543,257 @@ scheduled items with an hour specification like [h]h:mm." (let ((m (get-text-property 0 'org-hd-marker d))) (and m (marker-position m)))) deadlines)) - scheduled-items) - (goto-char (point-min)) - (if (org-element--cache-active-p) - (org-element-cache-map - (lambda (el) - (when (and (org-element-property :scheduled el) - ;; Only consider active timestamp values. - (memq (org-element-property - :type - (org-element-property :scheduled el)) - '(diary active active-range)) - (or (not with-hour) - (org-element-property - :hour-start - (org-element-property :scheduled el)) - (org-element-property - :hour-end - (org-element-property :scheduled el)))) - (goto-char (org-element-property :contents-begin el)) - (catch :skip - (org-agenda-skip el) - (let* ((s (substring (org-element-property - :raw-value - (org-element-property :scheduled el)) - 1 -1)) - (pos (save-excursion - (goto-char (org-element-property :contents-begin el)) - ;; We intentionally leave NOERROR - ;; argument in `re-search-forward' nil. If - ;; the search fails here, something went - ;; wrong and we are looking at - ;; non-matching headline. - (re-search-forward regexp (line-end-position)) - (1- (match-beginning 1)))) - (todo-state (org-element-property :todo-keyword el)) - (donep (eq 'done (org-element-property :todo-type el))) - (sexp? (eq 'diary - (org-element-property - :type (org-element-property :scheduled el)))) - ;; SCHEDULE is the scheduled date for the entry. It is - ;; either the bare date or the last repeat, according - ;; to `org-agenda-prefer-last-repeat'. - (schedule - (cond - (sexp? (org-agenda--timestamp-to-absolute s current)) - ((or (eq org-agenda-prefer-last-repeat t) - (member todo-state org-agenda-prefer-last-repeat)) - (org-agenda--timestamp-to-absolute - s today 'past (current-buffer) pos)) - (t (org-agenda--timestamp-to-absolute s)))) - ;; REPEAT is the future repeat closest from CURRENT, - ;; according to `org-agenda-show-future-repeats'. If - ;; the latter is nil, or if the time stamp has no - ;; repeat part, default to SCHEDULE. - (repeat - (cond - (sexp? schedule) - ((<= current today) schedule) - ((not org-agenda-show-future-repeats) schedule) - (t - (let ((base (if (eq org-agenda-show-future-repeats 'next) - (1+ today) - current))) - (org-agenda--timestamp-to-absolute - s base 'future (current-buffer) pos))))) - (diff (- current schedule)) - (warntime (get-text-property (point) 'org-appt-warntime)) - (pastschedp (< schedule today)) - (futureschedp (> schedule today)) - (habitp (and (fboundp 'org-is-habit-p) - (string= "habit" (org-element-property :STYLE el)))) - (suppress-delay - (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline - (org-element-property - :raw-value - (org-element-property :deadline el))))) - (cond - ((not deadline) nil) - ;; The current item has a deadline date, so - ;; evaluate its delay time. - ((integerp org-agenda-skip-scheduled-delay-if-deadline) - ;; Use global delay time. - (- org-agenda-skip-scheduled-delay-if-deadline)) - ((eq org-agenda-skip-scheduled-delay-if-deadline - 'post-deadline) - ;; Set delay to no later than DEADLINE. - (min (- schedule - (org-agenda--timestamp-to-absolute deadline)) - org-scheduled-delay-days)) - (t 0)))) - (ddays + scheduled-items) + (org-element-cache-map + (lambda (el) + (when (and (org-element-property :scheduled el) + ;; Only consider active timestamp values. + (memq (org-element-property + :type + (org-element-property :scheduled el)) + '(diary active active-range)) + (or (not with-hour) + (org-element-property + :hour-start + (org-element-property :scheduled el)) + (org-element-property + :hour-end + (org-element-property :scheduled el)))) + (goto-char (org-element-contents-begin el)) + (catch :skip + (org-agenda-skip el) + (let* ((s (substring (org-element-property + :raw-value + (org-element-property :scheduled el)) + 1 -1)) + (pos (save-excursion + (goto-char (org-element-contents-begin el)) + ;; We intentionally leave NOERROR + ;; argument in `re-search-forward' nil. If + ;; the search fails here, something went + ;; wrong and we are looking at + ;; non-matching headline. + (re-search-forward regexp (line-end-position)) + (1- (match-beginning 1)))) + (todo-state (org-element-property :todo-keyword el)) + (donep (eq 'done (org-element-property :todo-type el))) + (sexp? (eq 'diary + (org-element-property + :type (org-element-property :scheduled el)))) + ;; SCHEDULE is the scheduled date for the entry. It is + ;; either the bare date or the last repeat, according + ;; to `org-agenda-prefer-last-repeat'. + (schedule + (cond + (sexp? (org-agenda--timestamp-to-absolute s current)) + ((or (eq org-agenda-prefer-last-repeat t) + (member todo-state org-agenda-prefer-last-repeat)) + (org-agenda--timestamp-to-absolute + s today 'past (current-buffer) pos)) + (t (org-agenda--timestamp-to-absolute s)))) + ;; REPEAT is the future repeat closest from CURRENT, + ;; according to `org-agenda-show-future-repeats'. If + ;; the latter is nil, or if the time stamp has no + ;; repeat part, default to SCHEDULE. + (repeat + (cond + (sexp? schedule) + ((<= current today) schedule) + ((not org-agenda-show-future-repeats) schedule) + (t + (let ((base (if (eq org-agenda-show-future-repeats 'next) + (1+ today) + current))) + (org-agenda--timestamp-to-absolute + s base 'future (current-buffer) pos))))) + (diff (- current schedule)) + (warntime (org-entry-get (point) "APPT_WARNTIME" 'selective)) + (pastschedp (< schedule today)) + (futureschedp (> schedule today)) + (habitp (and (fboundp 'org-is-habit-p) + (string= "habit" (org-element-property :STYLE el)))) + (max-delay-days + (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline + (org-element-property + :raw-value + (org-element-property :deadline el))))) + (cond + ((not deadline) most-positive-fixnum) + ;; The current item has a deadline date, so + ;; evaluate its delay time. + ((integerp org-agenda-skip-scheduled-delay-if-deadline) + ;; Use global delay time. + (- org-agenda-skip-scheduled-delay-if-deadline)) + ((eq org-agenda-skip-scheduled-delay-if-deadline + 'post-deadline) + ;; Set delay to no later than DEADLINE. + (min (- schedule + (org-agenda--timestamp-to-absolute deadline)) + org-scheduled-delay-days)) + (t 0)))) + (delay-days + (cond + ;; Nullify delay when a repeater triggered already + ;; and the delay is of the form --Xd. + ((and (string-match-p "--[0-9]+[hdwmy]" s) + (> schedule (org-agenda--timestamp-to-absolute s))) + 0) + (t (min max-delay-days (org-get-wdays s t)))))) + ;; Display scheduled items at base date (SCHEDULE), today if + ;; scheduled before the current date, and at any repeat past + ;; today. However, skip delayed items and items that have + ;; been displayed for more than `org-scheduled-past-days'. + (unless (and todayp + habitp + (bound-and-true-p org-habit-show-all-today)) + (when (or (and (> delay-days 0) (< diff delay-days)) + (> diff (or (and habitp org-habit-scheduled-past-days) + org-scheduled-past-days)) + (> schedule current) + (and (/= current schedule) + (/= current today) + (/= current repeat))) + (throw :skip nil))) + ;; Possibly skip done tasks. + (when (and donep + (or org-agenda-skip-scheduled-if-done + (/= schedule current))) + (throw :skip nil)) + ;; Skip entry if it already appears as a deadline, per + ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This + ;; doesn't apply to habits. + (when (or org-agenda-skip-scheduled-repeats-after-deadline + ;; FIXME: Backwards-compatibility. + (eq org-agenda-skip-scheduled-if-deadline-is-shown + 'repeated-after-deadline)) + (let ((deadline + (time-to-days + (when (org-element-property :deadline el) + (org-time-string-to-time + (org-element-interpret-data + (org-element-property :deadline el))))))) + (when (and (or (<= (org-agenda--timestamp-to-absolute s) deadline) + (not (= schedule current))) + (> current deadline)) + (throw :skip nil)))) + (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown + ((guard + (or (not (memq (line-beginning-position 0) deadline-pos)) + habitp)) + nil) + (`not-today pastschedp) + (`t t) + (_ nil)) + (throw :skip nil)) + ;; Skip habits if `org-habit-show-habits' is nil, or if we + ;; only show them for today. Also skip done habits. + (when (and habitp + (or donep + (not (bound-and-true-p org-habit-show-habits)) + (and (not todayp) + (bound-and-true-p + org-habit-show-habits-only-for-today)))) + (throw :skip nil)) + (save-excursion + (goto-char (org-element-begin el)) + (let* ((category (org-get-category)) + (effort (save-match-data + (or (get-text-property (point) 'effort) + (org-element-property (intern (concat ":" (upcase org-effort-property))) el)))) + (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) + (inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda + org-agenda-use-tag-inheritance))))) + (tags (org-get-tags el (not inherited-tags))) + (level (make-string (org-element-property :level el) + ?\s)) + (head (save-excursion + (goto-char (org-element-begin el)) + (re-search-forward org-outline-regexp-bol) + (buffer-substring (point) (line-end-position)))) + (time (cond - ;; Nullify delay when a repeater triggered already - ;; and the delay is of the form --Xd. - ((and (string-match-p "--[0-9]+[hdwmy]" s) - (> schedule (org-agenda--timestamp-to-absolute s))) - 0) - (suppress-delay - (let ((org-scheduled-delay-days suppress-delay)) - (org-get-wdays s t t))) - (t (org-get-wdays s t))))) - ;; Display scheduled items at base date (SCHEDULE), today if - ;; scheduled before the current date, and at any repeat past - ;; today. However, skip delayed items and items that have - ;; been displayed for more than `org-scheduled-past-days'. - (unless (and todayp - habitp - (bound-and-true-p org-habit-show-all-today)) - (when (or (and (> ddays 0) (< diff ddays)) - (> diff (or (and habitp org-habit-scheduled-past-days) - org-scheduled-past-days)) - (> schedule current) - (and (/= current schedule) - (/= current today) - (/= current repeat))) - (throw :skip nil))) - ;; Possibly skip done tasks. - (when (and donep - (or org-agenda-skip-scheduled-if-done - (/= schedule current))) - (throw :skip nil)) - ;; Skip entry if it already appears as a deadline, per - ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This - ;; doesn't apply to habits. - (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown - ((guard - (or (not (memq (line-beginning-position 0) deadline-pos)) - habitp)) - nil) - (`repeated-after-deadline - (let ((deadline (time-to-days - (when (org-element-property :deadline el) - (org-time-string-to-time - (org-element-interpret-data - (org-element-property :deadline el))))))) - (and (<= schedule deadline) (> current deadline)))) - (`not-today pastschedp) - (`t t) - (_ nil)) - (throw :skip nil)) - ;; Skip habits if `org-habit-show-habits' is nil, or if we - ;; only show them for today. Also skip done habits. - (when (and habitp - (or donep - (not (bound-and-true-p org-habit-show-habits)) - (and (not todayp) - (bound-and-true-p - org-habit-show-habits-only-for-today)))) - (throw :skip nil)) - (save-excursion - (goto-char (org-element-property :begin el)) - (let* ((category (org-get-category)) - (effort (save-match-data - (or (get-text-property (point) 'effort) - (org-element-property (intern (concat ":" (upcase org-effort-property))) el)))) - (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) - (inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda - org-agenda-use-tag-inheritance))))) - (tags (org-get-tags el (not inherited-tags))) - (level (make-string (org-element-property :level el) - ?\s)) - (head (save-excursion - (goto-char (org-element-property :begin el)) - (re-search-forward org-outline-regexp-bol) - (buffer-substring (point) (line-end-position)))) - (time - (cond - ;; No time of day designation if it is only a - ;; reminder, except for habits, which always show - ;; the time of day. Habits are an exception - ;; because if there is a time of day, that is - ;; interpreted to mean they should usually happen - ;; then, even if doing the habit was missed. - ((and - (not habitp) - (/= current schedule) - (/= current repeat)) - nil) - ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (concat (substring s (match-beginning 1)) " ")) - (t 'time))) - (item - (org-agenda-format-item - (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders)) - ;; Show a reminder of a past scheduled today. - (if (and todayp pastschedp) - (format past diff) - first)) - (org-add-props head nil - 'effort effort - 'effort-minutes effort-minutes) - level category tags time nil habitp)) - (face (cond ((and (not habitp) pastschedp) - 'org-scheduled-previously) - ((and habitp futureschedp) - 'org-agenda-done) - (todayp 'org-scheduled-today) - (t 'org-scheduled))) - (habitp (and habitp (org-habit-parse-todo (org-element-property :begin el))))) - (org-add-props item props - 'undone-face face - 'face (if donep 'org-agenda-done face) - 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) - 'type (if pastschedp "past-scheduled" "scheduled") - 'date (if pastschedp schedule date) - 'ts-date schedule - 'warntime warntime - 'level level - 'effort effort 'effort-minutes effort-minutes - 'priority (if habitp (org-habit-get-priority habitp) - (+ 99 diff (org-get-priority item))) - 'org-habit-p habitp - 'todo-state todo-state) - (push item scheduled-items))))))) - :next-re regexp - :fail-re regexp - :narrow t) - (while (re-search-forward regexp nil t) - (catch :skip - (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) - (org-agenda-skip) - (let* ((s (match-string 1)) - (pos (1- (match-beginning 1))) - (todo-state (save-match-data (org-get-todo-state))) - (donep (member todo-state org-done-keywords)) - (sexp? (string-prefix-p "%%" s)) - ;; SCHEDULE is the scheduled date for the entry. It is - ;; either the bare date or the last repeat, according - ;; to `org-agenda-prefer-last-repeat'. - (schedule - (cond - (sexp? (org-agenda--timestamp-to-absolute s current)) - ((or (eq org-agenda-prefer-last-repeat t) - (member todo-state org-agenda-prefer-last-repeat)) - (org-agenda--timestamp-to-absolute - s today 'past (current-buffer) pos)) - (t (org-agenda--timestamp-to-absolute s)))) - ;; REPEAT is the future repeat closest from CURRENT, - ;; according to `org-agenda-show-future-repeats'. If - ;; the latter is nil, or if the time stamp has no - ;; repeat part, default to SCHEDULE. - (repeat - (cond - (sexp? schedule) - ((<= current today) schedule) - ((not org-agenda-show-future-repeats) schedule) - (t - (let ((base (if (eq org-agenda-show-future-repeats 'next) - (1+ today) - current))) - (org-agenda--timestamp-to-absolute - s base 'future (current-buffer) pos))))) - (diff (- current schedule)) - (warntime (get-text-property (point) 'org-appt-warntime)) - (pastschedp (< schedule today)) - (futureschedp (> schedule today)) - (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p))) - (suppress-delay - (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline - (org-entry-get nil "DEADLINE")))) - (cond - ((not deadline) nil) - ;; The current item has a deadline date, so - ;; evaluate its delay time. - ((integerp org-agenda-skip-scheduled-delay-if-deadline) - ;; Use global delay time. - (- org-agenda-skip-scheduled-delay-if-deadline)) - ((eq org-agenda-skip-scheduled-delay-if-deadline - 'post-deadline) - ;; Set delay to no later than DEADLINE. - (min (- schedule - (org-agenda--timestamp-to-absolute deadline)) - org-scheduled-delay-days)) - (t 0)))) - (ddays - (cond - ;; Nullify delay when a repeater triggered already - ;; and the delay is of the form --Xd. - ((and (string-match-p "--[0-9]+[hdwmy]" s) - (> schedule (org-agenda--timestamp-to-absolute s))) - 0) - (suppress-delay - (let ((org-scheduled-delay-days suppress-delay)) - (org-get-wdays s t t))) - (t (org-get-wdays s t))))) - ;; Display scheduled items at base date (SCHEDULE), today if - ;; scheduled before the current date, and at any repeat past - ;; today. However, skip delayed items and items that have - ;; been displayed for more than `org-scheduled-past-days'. - (unless (and todayp - habitp - (bound-and-true-p org-habit-show-all-today)) - (when (or (and (> ddays 0) (< diff ddays)) - (> diff (or (and habitp org-habit-scheduled-past-days) - org-scheduled-past-days)) - (> schedule current) - (and (/= current schedule) - (/= current today) - (/= current repeat))) - (throw :skip nil))) - ;; Possibly skip done tasks. - (when (and donep - (or org-agenda-skip-scheduled-if-done - (/= schedule current))) - (throw :skip nil)) - ;; Skip entry if it already appears as a deadline, per - ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This - ;; doesn't apply to habits. - (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown - ((guard - (or (not (memq (line-beginning-position 0) deadline-pos)) - habitp)) - nil) - (`repeated-after-deadline - (let ((deadline (time-to-days - (org-get-deadline-time (point))))) - (and (<= schedule deadline) (> current deadline)))) - (`not-today pastschedp) - (`t t) - (_ nil)) - (throw :skip nil)) - ;; Skip habits if `org-habit-show-habits' is nil, or if we - ;; only show them for today. Also skip done habits. - (when (and habitp - (or donep - (not (bound-and-true-p org-habit-show-habits)) - (and (not todayp) - (bound-and-true-p - org-habit-show-habits-only-for-today)))) - (throw :skip nil)) - (save-excursion - (re-search-backward "^\\*+[ \t]+" nil t) - (goto-char (match-end 0)) - (let* ((category (org-get-category)) - (effort (save-match-data (or (get-text-property (point) 'effort) - (org-entry-get (point) org-effort-property)))) - (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) - (inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda - org-agenda-use-tag-inheritance))))) - (tags (org-get-tags nil (not inherited-tags))) - (level (make-string (org-reduced-level (org-outline-level)) - ?\s)) - (head (buffer-substring (point) (line-end-position))) - (time - (cond - ;; No time of day designation if it is only a - ;; reminder, except for habits, which always show - ;; the time of day. Habits are an exception - ;; because if there is a time of day, that is - ;; interpreted to mean they should usually happen - ;; then, even if doing the habit was missed. - ((and - (not habitp) - (/= current schedule) - (/= current repeat)) - nil) - ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (concat (substring s (match-beginning 1)) " ")) - (t 'time))) - (item - (org-agenda-format-item - (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders)) - ;; Show a reminder of a past scheduled today. - (if (and todayp pastschedp) - (format past diff) - first)) - (org-add-props head nil - 'effort effort - 'effort-minutes effort-minutes) - level category tags time nil habitp)) - (face (cond ((and (not habitp) pastschedp) - 'org-scheduled-previously) - ((and habitp futureschedp) - 'org-agenda-done) - (todayp 'org-scheduled-today) - (t 'org-scheduled))) - (habitp (and habitp (org-habit-parse-todo)))) - (org-add-props item props - 'undone-face face - 'face (if donep 'org-agenda-done face) - 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) - 'type (if pastschedp "past-scheduled" "scheduled") - 'date (if pastschedp schedule date) - 'ts-date schedule - 'warntime warntime - 'level level - 'effort effort 'effort-minutes effort-minutes - 'priority (if habitp (org-habit-get-priority habitp) + ;; No time of day designation if it is only a + ;; reminder, except for habits, which always show + ;; the time of day. Habits are an exception + ;; because if there is a time of day, that is + ;; interpreted to mean they should usually happen + ;; then, even if doing the habit was missed. + ((and + (not habitp) + (/= current schedule) + (/= current repeat)) + nil) + ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (concat (substring s (match-beginning 1)) " ")) + (t 'time))) + (item + (org-agenda-format-item + (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders)) + ;; Show a reminder of a past scheduled today. + (if (and todayp pastschedp) + (format past diff) + first)) + (org-add-props head nil + 'effort effort + 'effort-minutes effort-minutes) + level category tags time nil habitp)) + (face (cond ((and (not habitp) pastschedp) + 'org-scheduled-previously) + ((and habitp futureschedp) + 'org-agenda-done) + (todayp 'org-scheduled-today) + (t 'org-scheduled))) + (habitp (and habitp (org-habit-parse-todo (org-element-begin el))))) + (org-add-props item props + 'undone-face face + 'face (if donep 'org-agenda-done face) + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) + 'type (if pastschedp "past-scheduled" "scheduled") + 'date (if pastschedp schedule date) + 'ts-date schedule + 'warntime warntime + 'level level + 'effort effort 'effort-minutes effort-minutes + 'urgency (if habitp (org-habit-get-urgency habitp) (+ 99 diff (org-get-priority item))) - 'org-habit-p habitp - 'todo-state todo-state) - (push item scheduled-items))))))) + 'priority (org-get-priority item) + 'org-habit-p habitp + 'todo-state todo-state) + (push item scheduled-items))))))) + :next-re regexp + :fail-re regexp + :narrow t) (nreverse scheduled-items))) (defun org-agenda-get-blocks () "Return the date-range information for agenda display." (with-no-warnings (defvar date)) - (let* ((props (list 'face nil - 'org-not-done-regexp org-not-done-regexp + (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'mouse-face 'highlight 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) - (regexp org-tr-regexp) + (regexp (if org-agenda-include-inactive-timestamps + org-tr-regexp-both org-tr-regexp)) (d0 (calendar-absolute-from-gregorian date)) - marker hdmarker ee txt d1 d2 s1 s2 category - level todo-state tags pos head donep inherited-tags - effort effort-minutes) + face marker hdmarker ee txt d1 d2 s1 s2 category level + todo-state tags pos head donep inherited-tags effort + effort-minutes inactive?) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip (org-agenda-skip) (setq pos (point)) + (setq inactive? (eq ?\[ (char-after (match-beginning 0)))) (let ((start-time (match-string 1)) (end-time (match-string 2))) (setq s1 (match-string 1) @@ -7122,6 +6826,9 @@ scheduled items with an hour specification like [h]h:mm." (setq donep (member todo-state org-done-keywords)) (when (and donep org-agenda-skip-timestamp-if-done) (throw :skip t)) + (setq face (if (= d1 d2) + 'org-agenda-calendar-event + 'org-agenda-calendar-daterange)) (setq marker (org-agenda-new-marker (point)) category (org-get-category)) (setq effort (save-match-data (or (get-text-property (point) 'effort) @@ -7150,34 +6857,32 @@ scheduled items with an hour specification like [h]h:mm." "<" (regexp-quote s2) ".*?>") nil))) (setq txt (org-agenda-format-item - (format - (nth (if (= d1 d2) 0 1) - org-agenda-timerange-leaders) - (1+ (- d0 d1)) (1+ (- d2 d1))) + (concat + (when inactive? org-agenda-inactive-leader) + (format + (nth (if (= d1 d2) 0 1) + org-agenda-timerange-leaders) + (1+ (- d0 d1)) (1+ (- d2 d1)))) (org-add-props head nil 'effort effort 'effort-minutes effort-minutes) level category tags - (save-match-data - (let ((hhmm1 (and (string-match org-ts-regexp1 s1) - (match-string 6 s1))) - (hhmm2 (and (string-match org-ts-regexp1 s2) - (match-string 6 s2)))) - (cond ((string= hhmm1 hhmm2) - (concat "<" start-time ">--<" end-time ">")) - ((and (= d1 d0) (= d2 d0)) - (concat "<" start-time ">--<" end-time ">")) - ((= d1 d0) - (concat "<" start-time ">")) - ((= d2 d0) - (concat "<" end-time ">"))))) + (cond + ((and (= d1 d0) (= d2 d0)) + (concat "<" start-time ">--<" end-time ">")) + ((= d1 d0) + (concat "<" start-time ">")) + ((= d2 d0) + (concat "<" end-time ">"))) remove-re)))) (org-add-props txt props + 'face face 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date 'level level 'effort effort 'effort-minutes effort-minutes 'todo-state todo-state + 'urgency (org-get-priority txt) 'priority (org-get-priority txt)) (push txt ee)))) (goto-char pos))) @@ -7260,6 +6965,7 @@ Any match of REMOVE-RE will be removed from TXT." (file-name-sans-extension (file-name-nondirectory buffer-file-name)) ""))) + (full-category category) (category-icon (org-agenda-get-category-icon category)) (category-icon (if category-icon (propertize " " 'display category-icon) @@ -7272,7 +6978,13 @@ Any match of REMOVE-RE will be removed from TXT." time (ts (when dotime (concat (if (stringp dotime) dotime "") - (and org-agenda-search-headline-for-time txt)))) + (and org-agenda-search-headline-for-time + ;; Do not search inside + ;; timestamps. They are handled + ;; separately. + (replace-regexp-in-string + org-ts-regexp-both "" + txt))))) (time-of-day (and dotime (org-get-time-of-day ts))) stamp plain s0 s1 s2 rtn srp l duration breadcrumbs) @@ -7337,11 +7049,21 @@ Any match of REMOVE-RE will be removed from TXT." ;; Prepare the variables needed in the eval of the compiled format (when org-prefix-has-breadcrumbs - (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker) - (let ((s (org-format-outline-path (org-get-outline-path) - (1- (frame-width)) - nil org-agenda-breadcrumbs-separator))) - (if (equal "" s) "" (concat s org-agenda-breadcrumbs-separator)))))) + (setq breadcrumbs + ;; When called from Org buffer, remain in position. + ;; When called from Agenda buffer, jump to headline position first. + (org-with-point-at (org-get-at-bol 'org-marker) + (let ((s (if (derived-mode-p 'org-mode) + (org-format-outline-path (org-get-outline-path) + (1- (frame-width)) + nil org-agenda-breadcrumbs-separator) + ;; Not in Org buffer. This can happen, + ;; for example, in + ;; `org-agenda-add-time-grid-maybe' where + ;; time grid does not correspond to a + ;; particular heading. + ""))) + (if (equal "" s) "" (concat s org-agenda-breadcrumbs-separator)))))) (setq time (cond (s2 (concat (org-agenda-time-of-day-to-ampm-maybe s1) "-" (org-agenda-time-of-day-to-ampm-maybe s2) @@ -7371,7 +7093,9 @@ Any match of REMOVE-RE will be removed from TXT." ;; And finally add the text properties (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) (org-add-props rtn nil - 'org-category category + ;; CATEGORY might be truncated. Store the full category in + ;; the properties. + 'org-category full-category 'tags tags 'org-priority-highest org-priority-highest 'org-priority-lowest org-priority-lowest @@ -7438,7 +7162,11 @@ TODAYP is t when the current agenda view is on today." (gridtimes (nth 1 org-agenda-time-grid)) (req (car org-agenda-time-grid)) (remove (member 'remove-match req)) - new time) + new time + ;; We abuse `org-agenda-format-item' to format grid lines + ;; here. Prevent it from adding default duration, if any + ;; to the grid lines. + (org-agenda-default-appointment-duration nil)) (when (and (member 'require-timed req) (not have)) ;; don't show empty grid (throw 'exit list)) @@ -7539,7 +7267,7 @@ and stored in the variable `org-prefix-format-compiled'." org-agenda-sorting-strategy (or (cdr (assq key org-agenda-sorting-strategy)) (cdr (assq 'agenda org-agenda-sorting-strategy)) - '(time-up category-keep priority-down))))) + '(time-up category-keep urgency-down))))) (defun org-get-time-of-day (s &optional string) "Check string S for a time of day. @@ -7692,7 +7420,7 @@ The optional argument TYPE tells the agenda type." re) (if (eq x 'line) (save-excursion - (beginning-of-line 1) + (forward-line 0) (setq re (org-get-at-bol 'org-todo-regexp)) (goto-char (or (text-property-any (line-beginning-position) (line-end-position) @@ -7764,8 +7492,8 @@ The optional argument TYPE tells the agenda type." "Compare the string values of categories of strings A and B." (let ((ca (or (get-text-property (1- (length a)) 'org-category a) "")) (cb (or (get-text-property (1- (length b)) 'org-category b) ""))) - (cond ((string-lessp ca cb) -1) - ((string-lessp cb ca) +1)))) + (cond ((org-string< ca cb) -1) + ((org-string< cb ca) +1)))) (defsubst org-cmp-todo-state (a b) "Compare the todo states of strings A and B." @@ -7811,8 +7539,8 @@ The optional argument TYPE tells the agenda type." (cond ((not (or ta tb)) nil) ((not ta) +1) ((not tb) -1) - ((string-lessp ta tb) -1) - ((string-lessp tb ta) +1)))) + ((org-string< ta tb) -1) + ((org-string< tb ta) +1)))) (defsubst org-cmp-tag (a b) "Compare the string values of the first tags of A and B." @@ -7821,8 +7549,8 @@ The optional argument TYPE tells the agenda type." (cond ((not (or ta tb)) nil) ((not ta) +1) ((not tb) -1) - ((string-lessp ta tb) -1) - ((string-lessp tb ta) +1)))) + ((funcall (or org-tags-sort-function #'org-string<) ta tb) -1) + ((funcall (or org-tags-sort-function #'org-string<) tb ta) +1)))) (defsubst org-cmp-time (a b) "Compare the time-of-day values of strings A and B." @@ -7885,6 +7613,9 @@ their type." (priority-up (and (org-em 'priority-up 'priority-down ss) (org-cmp-values a b 'priority))) (priority-down (if priority-up (- priority-up) nil)) + (urgency-up (and (org-em 'urgency-up 'urgency-down ss) + (org-cmp-values a b 'urgency))) + (urgency-down (if urgency-up (- urgency-up) nil)) (effort-up (and (org-em 'effort-up 'effort-down ss) (org-cmp-effort a b))) (effort-down (if effort-up (- effort-up) nil)) @@ -8461,10 +8192,12 @@ which see." (confirm (lambda (x) (stringp x))) (prefix "") (operator "") - table) + table + begin) (when (string-match "^\\(.*\\([-+<>=]\\)\\)\\([^-+<>=]*\\)$" string) (setq prefix (match-string 1 string) operator (match-string 2 string) + begin (match-beginning 3) string (match-string 3 string))) (cond ((member operator '("+" "-" "" nil)) @@ -8481,6 +8214,11 @@ which see." (pcase flag (`t (all-completions string table confirm)) (`lambda (assoc string table)) ;exact match? + (`(boundaries . ,suffix) + (let ((end (if (string-match "[-+<>=]" suffix) + (match-string 0 suffix) + (length suffix)))) + `(boundaries ,(or begin 0) . ,end))) (`nil (pcase (try-completion string table confirm) ((and completion (pred stringp)) @@ -8773,7 +8511,7 @@ grouptags." (txt (or (org-get-at-bol 'txt) ""))) (unless (eval org-agenda-filter-form t) (org-agenda-filter-hide-line type)))) - (beginning-of-line 2))) + (forward-line 1))) (when (get-char-property (point) 'invisible) (ignore-errors (org-agenda-previous-line)))) @@ -8788,7 +8526,7 @@ grouptags." (when (and tophl (funcall (if negative 'identity 'not) (string= hl tophl))) (org-agenda-filter-hide-line 'top-headline))) - (beginning-of-line 2))) + (forward-line 1))) (when (get-char-property (point) 'invisible) (org-agenda-previous-line)) (setq org-agenda-top-headline-filter hl @@ -8858,6 +8596,14 @@ Negative selection means regexp must not match for selection of an entry." (org-agenda-redo)) (message "Display now includes inactive timestamps as well")) ((eq org-agenda-type 'search) + ;; Previous calls to `org-agenda-manipulate-query' could already + ;; add trailing text to the query. Prevent duplicating it. + ;; Trim the trailing spaces and +/. + (setq org-agenda-query-string + (replace-regexp-in-string + (rx (or (1+ " ") (seq (1+ " ") (any "+-") (opt "{}"))) eos) + "" + org-agenda-query-string)) (org-add-to-string 'org-agenda-query-string (if org-agenda-last-search-view-search-was-boolean @@ -8896,31 +8642,31 @@ See also: (list (let ((org-read-date-prefer-future org-agenda-jump-prefer-future)) (org-read-date)))) + (org-agenda-check-type t 'agenda) (let* ((day (time-to-days (org-time-string-to-time date))) - (org-agenda-sticky-orig org-agenda-sticky) - (org-agenda-buffer-tmp-name (buffer-name)) - (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) - (0-arg (or current-prefix-arg (car args))) - (2-arg (nth 2 args)) - (with-hour-p (nth 4 org-agenda-redo-command)) - (newcmd (list 'org-agenda-list 0-arg date - (org-agenda-span-to-ndays - 2-arg (org-time-string-to-absolute date)) - with-hour-p)) - (newargs (cdr newcmd)) - (inhibit-read-only t) - org-agenda-sticky) - (if (not (org-agenda-check-type t 'agenda)) - (error "Not available in non-agenda views") - (add-text-properties (point-min) (point-max) - `(org-redo-cmd ,newcmd org-last-args ,newargs)) - (org-agenda-redo) - (goto-char (point-min)) - (while (not (or (= (or (get-text-property (point) 'day) 0) day) - (save-excursion (move-beginning-of-line 2) (eobp)))) - (move-beginning-of-line 2)) - (setq org-agenda-sticky org-agenda-sticky-orig - org-agenda-this-buffer-is-sticky org-agenda-sticky)))) + (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)) + (with-hour-p (nth 4 org-agenda-redo-command)) + (newcmd (list 'org-agenda-list 0-arg date + (org-agenda-span-to-ndays + 2-arg (org-time-string-to-absolute date)) + with-hour-p)) + (newargs (cdr newcmd)) + (inhibit-read-only t) + org-agenda-sticky) + (add-text-properties (point-min) (point-max) + `(org-redo-cmd ,newcmd org-last-args ,newargs)) + (org-agenda-redo) + (goto-char (point-min)) + (while (not (or (= (or (get-text-property (point) 'day) 0) day) + (save-excursion (move-beginning-of-line 2) (eobp)))) + (move-beginning-of-line 2)) + (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's date in the agenda buffer. @@ -9198,7 +8944,7 @@ so that the date SD will be in that range." "Jump to the next line indicating a date in agenda buffer." (interactive "p") (org-agenda-check-type t 'agenda) - (beginning-of-line 1) + (forward-line 0) ;; This does not work if user makes date format that starts with a blank (when (looking-at-p "^\\S-") (forward-char 1)) (unless (re-search-forward "^\\S-" nil t arg) @@ -9210,7 +8956,7 @@ so that the date SD will be in that range." "Jump to the previous line indicating a date in agenda buffer." (interactive "p") (org-agenda-check-type t 'agenda) - (beginning-of-line 1) + (forward-line 0) (unless (re-search-backward "^\\S-" nil t arg) (error "No previous date before this line in this buffer"))) @@ -9478,7 +9224,8 @@ When called with a prefix argument, include all archive files as well." (when (and (markerp m) (marker-buffer m)) (and org-agenda-follow-mode (if org-agenda-follow-indirect - (org-agenda-tree-to-indirect-buffer nil) + (let ((org-indirect-buffer-display 'other-window)) + (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 org-agenda-show-outline-path)))))) @@ -9499,7 +9246,6 @@ When called with a prefix argument, include all archive files as well." (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker))) - ;; FIXME: use `org-switch-to-buffer-other-window'? (switch-to-buffer-other-window buffer) (widen) (push-mark) @@ -9571,20 +9317,17 @@ Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'." (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)) (org-with-remote-undo buffer - (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 (line-beginning-position) - dend (min (point-max) (1+ (line-end-position))))) - (goto-char dbeg) - (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) + (org-with-point-at marker + (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 (line-beginning-position) + dend (min (point-max) (1+ (line-end-position))))) + (goto-char dbeg) + (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))) (when (or (eq t org-agenda-confirm-kill) (and (numberp org-agenda-confirm-kill) (> n org-agenda-confirm-kill))) @@ -9601,7 +9344,7 @@ Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'." (set-window-configuration win-conf)))) (let ((org-agenda-buffer-name bufname-orig)) (org-remove-subtree-entries-from-agenda buffer dbeg dend)) - (with-current-buffer buffer (delete-region dbeg dend)) + (org-with-point-at marker (delete-region dbeg dend)) (message "Agenda item and source killed"))))) (defvar org-archive-default-command) ; defined in org-archive.el @@ -9664,26 +9407,26 @@ Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'." The subtree is the one in buffer BUF, starting at BEG and ending at END. If this information is not given, the function uses the tree at point." (let ((buf (or buf (current-buffer))) m p) - (save-excursion - (unless (and beg end) - (org-back-to-heading t) - (setq beg (point)) - (org-end-of-subtree t) - (setq end (point))) - (set-buffer (get-buffer org-agenda-buffer-name)) - (save-excursion - (goto-char (point-max)) - (beginning-of-line 1) - (while (not (bobp)) - (when (and (setq m (org-get-at-bol 'org-marker)) - (equal buf (marker-buffer m)) - (setq p (marker-position m)) - (>= p beg) - (< p end)) - (let ((inhibit-read-only t)) - (delete-region (line-beginning-position) - (1+ (line-end-position))))) - (beginning-of-line 0)))))) + (org-with-wide-buffer + (unless (and beg end) + (org-back-to-heading t) + (setq beg (point)) + (org-end-of-subtree t) + (setq end (point))) + (set-buffer (get-buffer org-agenda-buffer-name)) + (save-excursion + (goto-char (point-max)) + (forward-line 0) + (while (not (bobp)) + (when (and (setq m (org-get-at-bol 'org-marker)) + (equal buf (marker-buffer m)) + (setq p (marker-position m)) + (>= p beg) + (< p end)) + (let ((inhibit-read-only t)) + (delete-region (line-beginning-position) + (1+ (line-end-position))))) + (forward-line -1)))))) (defun org-agenda-refile (&optional goto rfloc no-update) "Refile the item at point. @@ -9754,9 +9497,8 @@ It also looks at the text of the entry itself." (when (search-forward l nil lkend) (goto-char (match-beginning 0)) (org-open-at-point))) - ;; This is an internal link, widen the buffer - ;; FIXME: use `org-switch-to-buffer-other-window'? (switch-to-buffer-other-window buffer) + ;; This is an internal link, widen the buffer (widen) (goto-char marker) (when (search-forward l nil lkend) @@ -9765,7 +9507,7 @@ It also looks at the text of the entry itself." lk)) ((or (org-in-regexp (concat "\\(" org-link-bracket-re "\\)")) (save-excursion - (beginning-of-line 1) + (forward-line 0) (looking-at (concat ".*?\\(" org-link-bracket-re "\\)")))) (org-link-open-from-string (match-string 1))) (t (message "No link to open here"))))) @@ -9793,7 +9535,8 @@ displayed Org file fills the frame." (pos (marker-position marker))) (unless buffer (user-error "Trying to switch to non-existent buffer")) (pop-to-buffer-same-window buffer) - (when delete-other-windows (delete-other-windows)) + (when delete-other-windows + (display-buffer (current-buffer) '(org-display-buffer-full-frame))) (widen) (goto-char pos) (when (derived-mode-p 'org-mode) @@ -9952,27 +9695,6 @@ With a `\\[universal-argument]' prefix, make a separate frame for this tree, \ i.e. don't use the dedicated frame." (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 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)) - (setq org-agenda-last-indirect-buffer org-last-indirect-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) (org-agenda-error))) @@ -9981,7 +9703,8 @@ the dedicated frame." (with-current-buffer buffer (save-excursion (goto-char pos) - (org-tree-to-indirect-buffer arg))))) + (org-tree-to-indirect-buffer arg)))) + (setq org-agenda-last-indirect-buffer org-last-indirect-buffer)) (defvar org-last-heading-marker (make-marker) "Marker pointing to the headline that last changed its TODO state @@ -10032,14 +9755,14 @@ the same tree node, and the headline of the tree node in the Org file." (setq newhead (org-get-heading)) (when (and org-agenda-headline-snapshot-before-repeat (not (equal org-agenda-headline-snapshot-before-repeat - newhead)) + newhead)) todayp) (setq newhead org-agenda-headline-snapshot-before-repeat just-one t)) (save-excursion (org-back-to-heading) (move-marker org-last-heading-marker (point)))) - (beginning-of-line 1) + (forward-line 0) (save-window-excursion (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) (when (bound-and-true-p org-clock-out-when-done) @@ -10084,7 +9807,7 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags." effort effort-minutes) ;; pl (save-excursion (goto-char (point-max)) - (beginning-of-line 1) + (forward-line 0) (while (not finish) (setq finish (bobp)) (when (and (setq m (org-get-at-bol 'org-hd-marker)) @@ -10105,15 +9828,15 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags." (with-current-buffer (marker-buffer hdmarker) (org-with-wide-buffer (org-agenda-format-item extra - (org-add-props newhead nil - 'effort effort - 'effort-minutes effort-minutes) - level cat tags dotime)))) + (org-add-props newhead nil + 'effort effort + 'effort-minutes effort-minutes) + level cat tags dotime)))) ;; pl (text-property-any (line-beginning-position) ;; (line-end-position) 'org-heading t) undone-face (org-get-at-bol 'undone-face) done-face (org-get-at-bol 'done-face)) - (beginning-of-line 1) + (forward-line 0) (cond ((equal new "") (delete-region (point) (line-beginning-position 2))) ((looking-at ".*") @@ -10125,7 +9848,7 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags." 'org-marked-entry-overlay) (throw :overlay o)))))) (replace-match new t t) - (beginning-of-line) + (forward-line 0) (when mark (move-overlay mark (point) (+ 2 (point))))) (add-text-properties (line-beginning-position) (line-end-position) props) @@ -10136,12 +9859,12 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags." (if org-last-todo-state-is-todo undone-face done-face)))) (org-agenda-highlight-todo 'line) - (beginning-of-line 1)) + (forward-line 0)) (t (error "Line update did not work"))) (save-restriction (narrow-to-region (line-beginning-position) (line-end-position)) (org-agenda-finalize))) - (beginning-of-line 0))))) + (forward-line -1))))) (defun org-agenda-align-tags (&optional line) "Align all tags in agenda items to `org-agenda-tags-column'. @@ -10245,7 +9968,7 @@ When called programmatically, FORCE-DIRECTION can be `set', `up', (end-of-line 1) (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead hdmarker) - (beginning-of-line 1))))) + (forward-line 0))))) (defun org-agenda-set-property () "Set a property for the current headline." @@ -10309,7 +10032,7 @@ When called programmatically, FORCE-DIRECTION can be `set', `up', (end-of-line 1) (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead hdmarker) - (beginning-of-line 1))))) + (forward-line 0))))) (defun org-agenda-do-date-later (arg) (interactive "P") @@ -10386,15 +10109,15 @@ When called programmatically, FORCE-DIRECTION can be `set', `up', (org-agenda-date-later (- arg) what)) (defun org-agenda-date-later-minutes (arg) - "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." + "Change the time of this item, in units of `org-timestamp-rounding-minutes'." (interactive "p") - (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) + (setq arg (* arg (cadr org-timestamp-rounding-minutes))) (org-agenda-date-later arg 'minute)) (defun org-agenda-date-earlier-minutes (arg) - "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." + "Change the time of this item, in units of `org-timestamp-rounding-minutes'." (interactive "p") - (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) + (setq arg (* arg (cadr org-timestamp-rounding-minutes))) (org-agenda-date-earlier arg 'minute)) (defun org-agenda-date-later-hours (arg) @@ -10420,19 +10143,21 @@ When called programmatically, FORCE-DIRECTION can be `set', `up', (line-end-position) '(display nil)) (org-move-to-column - (- (window-max-chars-per-line) - (length stamp)) + (max + 1 ;; narrow buffer and wide timestamp + (- (window-max-chars-per-line) + (length stamp))) t) (add-text-properties (1- (point)) (line-end-position) (list 'display (org-add-props stamp nil 'face '(secondary-selection default)))) - (beginning-of-line 1)) - (beginning-of-line 0))))) + (forward-line 0)) + (forward-line -1))))) (defun org-agenda-date-prompt (arg) "Change the date of this item. Date is prompted for, with default today. -The prefix ARG is passed to the `org-time-stamp' command and can therefore +The prefix ARG is passed to the `org-timestamp' command and can therefore be used to request time specification in the time stamp." (interactive "P") (org-agenda-check-type t 'agenda) @@ -10448,7 +10173,7 @@ be used to request time specification in the time stamp." (widen) (goto-char pos) (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) - (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) + (org-timestamp arg (equal (char-after (match-beginning 0)) ?\[))) (org-agenda-show-new-time marker org-last-changed-timestamp)) (message "Time stamp changed to %s" org-last-changed-timestamp)))) @@ -10543,7 +10268,8 @@ ARG is passed through to `org-deadline'." (unless (marker-buffer org-clock-marker) (user-error "No running clock")) (org-with-remote-undo (marker-buffer org-clock-marker) - (org-clock-cancel))) + (org-clock-cancel)) + (org-agenda-unmark-clocking-task)) (defun org-agenda-clock-goto () "Jump to the currently clocked in task within the agenda. @@ -10559,13 +10285,13 @@ buffer, display it in another window." ;; If the currently clocked entry is not in the agenda ;; buffer, we visit it in another window: ((bound-and-true-p org-clock-current-task) - (org-switch-to-buffer-other-window (org-clock-goto))) + (switch-to-buffer-other-window (org-clock-goto))) (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) (defun org-agenda-diary-entry-in-org-file () "Make a diary entry in the file `org-agenda-diary-file'." (let (d1 d2 char (text "") dp1 dp2) - (if (equal (buffer-name) "*Calendar*") + (if (equal (buffer-name) calendar-buffer) (setq d1 (calendar-cursor-to-date t) d2 (car calendar-mark-ring)) (setq dp1 (get-text-property (line-beginning-position) 'day)) @@ -10597,7 +10323,7 @@ buffer, display it in another window." (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2) (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) ((equal char ?j) - (org-switch-to-buffer-other-window + (switch-to-buffer-other-window (find-file-noselect org-agenda-diary-file)) (require 'org-datetree) (org-datetree-find-date-create d1) @@ -10635,7 +10361,7 @@ If TEXT is not empty, it will become the headline of the new entry, and the resulting entry will not be shown. When TEXT is empty, switch to `org-agenda-diary-file' and let the user finish the entry there." (let ((cw (current-window-configuration))) - (org-switch-to-buffer-other-window + (switch-to-buffer-other-window (find-file-noselect org-agenda-diary-file)) (widen) (goto-char (point-min)) @@ -10647,7 +10373,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to (progn (outline-next-heading) (insert "* Anniversaries\n\n") - (beginning-of-line -1))))) + (forward-line -2))))) (outline-next-heading) (org-back-over-empty-lines) (backward-char 1) @@ -10676,9 +10402,9 @@ the resulting entry will not be shown. When TEXT is empty, switch to (require 'org-datetree) (org-datetree-find-date-create d1) (org-agenda-insert-diary-make-new-entry text)) - (org-insert-time-stamp (org-time-from-absolute - (calendar-absolute-from-gregorian d1)) - nil nil nil nil time2)) + (org-insert-timestamp (org-time-from-absolute + (calendar-absolute-from-gregorian d1)) + nil nil nil nil time2)) (end-of-line 0)) ((block) ;; Wrap this in (strictly unnecessary) parens because ;; otherwise the indentation gets confused by the @@ -10691,11 +10417,11 @@ the resulting entry will not be shown. When TEXT is empty, switch to (require 'org-datetree) (org-datetree-find-date-create d1) (org-agenda-insert-diary-make-new-entry text)) - (org-insert-time-stamp (org-time-from-absolute - (calendar-absolute-from-gregorian d1))) + (org-insert-timestamp (org-time-from-absolute + (calendar-absolute-from-gregorian d1))) (insert "--") - (org-insert-time-stamp (org-time-from-absolute - (calendar-absolute-from-gregorian d2))) + (org-insert-timestamp (org-time-from-absolute + (calendar-absolute-from-gregorian d2))) (end-of-line 0))) (if (string-match "\\S-" text) (progn @@ -10924,16 +10650,23 @@ When ARG is greater than one mark ARG lines." (push m org-agenda-bulk-marked-entries) (setq ov (make-overlay (line-beginning-position) (+ 2 (line-beginning-position)))) - (org-overlay-display ov (concat org-agenda-bulk-mark-char " ") - (org-get-todo-face "TODO") - 'evaporate) + ;; Display using 'before-string to make the overlay + ;; compatible with column view in agenda that uses an + ;; overlay with higher priority. + (overlay-put ov 'before-string + (propertize org-agenda-bulk-mark-char + 'face (org-get-todo-face "TODO"))) + ;; We cannot completely hide the overlay to make point + ;; adjustment not move point out of overlay (to previous + ;; line) when moving lines with n/p. + (org-overlay-display ov " " nil 'evaporate) (overlay-put ov 'type 'org-marked-entry-overlay)) (end-of-line 1) (or (ignore-errors (goto-char (next-single-property-change (point) 'org-hd-marker))) - (beginning-of-line 2)) + (forward-line 1)) (while (and (get-char-property (point) 'invisible) (not (eobp))) - (beginning-of-line 2))))) + (forward-line 1))))) (message "%d entries marked for bulk action" (length org-agenda-bulk-marked-entries))) @@ -10953,7 +10686,7 @@ When ARG is greater than one mark ARG lines." (setq txt-at-point (get-text-property (match-beginning 0) 'txt))) (if (get-char-property (point) 'invisible) - (beginning-of-line 2) + (forward-line 1) (when (string-match-p regexp txt-at-point) (setq entries-marked (1+ entries-marked)) (call-interactively 'org-agenda-bulk-mark))))) @@ -10974,9 +10707,9 @@ When ARG is greater than one mark ARG lines." (end-of-line 1) (or (ignore-errors (goto-char (next-single-property-change (point) 'txt))) - (beginning-of-line 2)) + (forward-line 1)) (while (and (get-char-property (point) 'invisible) (not (eobp))) - (beginning-of-line 2)) + (forward-line 1)) (message "%d entries left marked for bulk action" (length org-agenda-bulk-marked-entries))) (t (message "No entry to unmark here"))))) @@ -11324,7 +11057,7 @@ tag and (if present) the flagging note." (unless note (user-error "No flagging note")) (org-kill-new note) - (org-switch-to-buffer-other-window "*Flagging Note*") + (switch-to-buffer-other-window "*Flagging Note*") (erase-buffer) (insert note) (goto-char (point-min)) @@ -11431,10 +11164,16 @@ to override `appt-message-warning-time'." (string-match cat-filter cat)) (and (stringp evt-filter) (string-match evt-filter evt))))))) - (wrn (get-text-property 1 'warntime x))) + (wrn (get-text-property 1 'warntime x)) + (todo-regexp (get-text-property 1 'org-todo-regexp x)) + (not-done-regexp (get-text-property 1 'org-not-done-regexp 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 (not (string-match "\\`DONE\\|CANCELLED" evt))) + (when (and ok tod + ;; Exclude done items unconditionally. + (or (not (and todo-regexp (string-match-p todo-regexp evt))) ; no todo keyword + (and not-done-regexp (string-match-p not-done-regexp evt)) ; or not done + )) (setq tod (concat "00" (number-to-string tod))) (setq tod (when (string-match "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index f5c223661c4..53c825ed6f6 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -34,9 +34,9 @@ (require 'org) (require 'cl-lib) -(declare-function org-element-type "org-element" (element)) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-timestamp-to-now "org" (timestamp-string &optional seconds)) ;; From org-element.el (defvar org-element--cache-avoid-synchronous-headline-re-parsing) @@ -154,10 +154,10 @@ archive location, but not yet deleted from the original file.") ;;;###autoload (defun org-add-archive-files (files) - "Splice the archive files into the list of files. + "Splice the archive FILES into the list of files. This implies visiting all these files and finding out what the archive file is." - (org-uniquify + (seq-uniq (apply 'append (mapcar @@ -166,7 +166,9 @@ archive file is." nil (with-current-buffer (org-get-agenda-file-buffer f) (cons f (org-all-archive-files))))) - files)))) + files)) + #'file-equal-p + )) (defun org-all-archive-files () "List of all archive files used in the current buffer." @@ -252,8 +254,7 @@ direct children of this heading." (newfile-p (and (org-string-nw-p afile) (not (file-exists-p afile)))) (buffer (cond ((not (org-string-nw-p afile)) this-buffer) - ((find-buffer-visiting afile)) - ((find-file-noselect afile)) + ((find-file-noselect afile 'nowarn)) (t (error "Cannot access file \"%s\"" afile)))) (org-odd-levels-only (if (local-variable-p 'org-odd-levels-only (current-buffer)) @@ -477,9 +478,9 @@ Archiving time is retained in the ARCHIVE_TIME node property." (goto-char e) (or (bolp) (newline)) (insert leader org-archive-sibling-heading "\n") - (beginning-of-line 0) + (forward-line -1) (org-toggle-tag org-archive-tag 'on)) - (beginning-of-line 1) + (forward-line 0) (if org-archive-reversed-order (outline-next-heading) (org-end-of-subtree t t)) @@ -524,12 +525,12 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." (let (ts) (and (re-search-forward org-ts-regexp end t) (setq ts (match-string 0)) - (< (org-time-stamp-to-now ts) 0) + (< (org-timestamp-to-now ts) 0) (if (not (looking-at - (concat "--\\(" org-ts-regexp "\\)"))) + (concat "--\\(" org-ts-regexp "\\)"))) (concat "old timestamp " ts) (setq ts (concat "old timestamp " ts (match-string 0))) - (and (< (org-time-stamp-to-now (match-string 1)) 0) + (and (< (org-timestamp-to-now (match-string 1)) 0) ts))))) tag)) @@ -590,8 +591,9 @@ don't move trees, but mark them with the ARCHIVE tag." ;;;###autoload (defun org-toggle-archive-tag (&optional find-done) "Toggle the archive tag for the current headline. -With prefix ARG, check all children of current headline and offer tagging -the children that do not contain any open TODO items." +With prefix argument FIND-DONE, check all children of current headline +and offer tagging the children that do not contain any open TODO +items." (interactive "P") (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) @@ -608,7 +610,7 @@ the children that do not contain any open TODO items." (org-back-to-heading t) (setq set (org-toggle-tag org-archive-tag)) (when set (org-fold-subtree t))) - (and set (beginning-of-line 1)) + (and set (forward-line 0)) (message "Subtree %s" (if set "archived" "unarchived")))))) (defun org-archive-set-tag () diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 7130e5629ab..16f6e1e29fd 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -44,8 +44,12 @@ (declare-function dired-dwim-target-directory "dired-aux") (declare-function dired-get-marked-files "dired" (&optional localp arg filter distinguish-one-marked error)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-begin "org-element" (node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-contents-begin "org-element" (node)) +(declare-function org-element-contents-end "org-element" (node)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) @@ -138,13 +142,13 @@ Selective means to respect the inheritance setting in (const :tag "Inherit parent node attachments" t) (const :tag "Respect org-use-property-inheritance" selective))) -(defcustom org-attach-store-link-p nil +(defcustom org-attach-store-link-p 'attached "Non-nil means store a link to a file when attaching it. When t, store the link to original file location. When `file', store link to the attached file location. When `attached', store attach: link to the attached file." :group 'org-attach - :version "24.1" + :package-version '(Org . "9.7") :type '(choice (const :tag "Don't store link" nil) (const :tag "Link to origin location" t) @@ -297,67 +301,71 @@ ask the user instead, else remove without asking." "The dispatcher for attachment commands. Shows a list of commands and prompts for another key to execute a command." (interactive) - (let ((dir (org-attach-dir nil 'no-fs-check)) - c marker) + (let (c marker) (when (eq major-mode 'org-agenda-mode) (setq marker (or (get-text-property (point) 'org-hd-marker) (get-text-property (point) 'org-marker))) (unless marker (error "No item in current line"))) (org-with-point-at marker - (if (and (featurep 'org-inlinetask) - (not (org-inlinetask-in-task-p))) - (org-with-limited-levels - (org-back-to-heading-or-point-min t)) + (let ((dir (org-attach-dir nil 'no-fs-check))) (if (and (featurep 'org-inlinetask) - (org-inlinetask-in-task-p)) - (org-inlinetask-goto-beginning) - (org-back-to-heading-or-point-min t))) - (save-excursion - (save-window-excursion - (unless org-attach-expert - (org-switch-to-buffer-other-window "*Org Attach*") - (erase-buffer) - (setq cursor-type nil - header-line-format "Use C-v, M-v, C-n or C-p to navigate.") - (insert - (concat "Attachment folder:\n" - (or dir - "Can't find an existing attachment-folder") - (unless (and dir (file-directory-p dir)) - "\n(Not yet created)") - "\n\n" - (format "Select an Attachment Command:\n\n%s" - (mapconcat - (lambda (entry) - (pcase entry - (`((,key . ,_) ,_ ,docstring) - (format "%c %s" - key - (replace-regexp-in-string "\n\\([\t ]*\\)" - " " - docstring - nil nil 1))) - (_ - (user-error - "Invalid `org-attach-commands' item: %S" - entry)))) - org-attach-commands - "\n"))))) - (org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) - (let ((msg (format "Select command: [%s]" - (concat (mapcar #'caar org-attach-commands))))) - (message msg) - (while (and (setq c (read-char-exclusive)) - (memq c '(?\C-n ?\C-p ?\C-v ?\M-v))) - (org-scroll c t))) - (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*")))) - (let ((command (cl-some (lambda (entry) - (and (memq c (nth 0 entry)) (nth 1 entry))) - org-attach-commands))) - (if (commandp command) - (command-execute command) - (error "No such attachment command: %c" c)))))) + (not (org-inlinetask-in-task-p))) + (org-with-limited-levels + (org-back-to-heading-or-point-min t)) + (if (and (featurep 'org-inlinetask) + (org-inlinetask-in-task-p)) + (org-inlinetask-goto-beginning) + (org-back-to-heading-or-point-min t))) + (save-excursion + (save-window-excursion + (unless org-attach-expert + (switch-to-buffer-other-window "*Org Attach*") + (erase-buffer) + (setq cursor-type nil + header-line-format "Use C-v, M-v, C-n or C-p to navigate.") + (insert + (concat "Attachment folder:\n" + (or dir + "Can't find an existing attachment-folder") + (unless (and dir (file-directory-p dir)) + "\n(Not yet created)") + "\n\n" + (format "Select an Attachment Command:\n\n%s" + (mapconcat + (lambda (entry) + (pcase entry + (`((,key . ,_) ,_ ,docstring) + (format "%c %s" + key + (replace-regexp-in-string "\n\\([\t ]*\\)" + " " + docstring + nil nil 1))) + (_ + (user-error + "Invalid `org-attach-commands' item: %S" + entry)))) + org-attach-commands + "\n")))) + (goto-char (point-min))) + (org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) + (unwind-protect + (let ((msg (format "Select command: [%s]" + (concat (mapcar #'caar org-attach-commands))))) + (message msg) + (while (and (setq c (read-char-exclusive)) + (memq c '(?\C-n ?\C-p ?\C-v ?\M-v))) + (org-scroll c t))) + (when-let ((window (get-buffer-window "*Org Attach*" t))) + (quit-window 'kill window)) + (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))) + (let ((command (cl-some (lambda (entry) + (and (memq c (nth 0 entry)) (nth 1 entry))) + org-attach-commands))) + (if (commandp command) + (command-execute command) + (error "No such attachment command: %c" c))))))) ;;;###autoload (defun org-attach-dir (&optional create-if-not-exists-p no-fs-check) @@ -432,17 +440,26 @@ ignoring nils. If EXISTING is non-nil, then return the first path found in the filesystem. Otherwise return the first non-nil value." (let ((fun-list org-attach-id-to-path-function-list) (base-dir (expand-file-name org-attach-id-dir)) + (default-base-dir (expand-file-name "data/")) preferred first) (while (and fun-list (not preferred)) (let* ((name (funcall (car fun-list) id)) - (candidate (and name (expand-file-name name base-dir)))) + (candidate (and name (expand-file-name name base-dir))) + ;; Try the default value `org-attach-id-dir' as a fallback. + (candidate2 (and name (not (equal base-dir default-base-dir)) + (expand-file-name name default-base-dir)))) (setq fun-list (cdr fun-list)) (when candidate (if (or (not existing) (file-directory-p candidate)) (setq preferred candidate) (unless first - (setq first candidate)))))) + (setq first candidate))) + (when (and existing + candidate2 + (not (file-directory-p candidate)) + (file-directory-p candidate2)) + (setq preferred candidate2))))) (or preferred first))) (defun org-attach-check-absolute-path (dir) @@ -512,9 +529,13 @@ DIR-property exists (that is different from the unset one)." (defun org-attach-tag (&optional off) "Turn the autotag on or (if OFF is set) off." (when org-attach-auto-tag - (save-excursion - (org-back-to-heading t) - (org-toggle-tag org-attach-auto-tag (if off 'off 'on))))) + ;; FIXME: There is currently no way to set #+FILETAGS + ;; programatically. Do nothing when before first heading + ;; (attaching to file) to avoid blocking error. + (unless (org-before-first-heading-p) + (save-excursion + (org-back-to-heading t) + (org-toggle-tag org-attach-auto-tag (if off 'off 'on)))))) (defun org-attach-untag () "Turn the autotag off." @@ -573,7 +594,7 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from ((eq method 'url) (if (org--should-fetch-remote-resource-p file) (url-copy-file file attach-file) - (error "The remote resource %S is considered unsafe, and will not be downloaded." + (error "The remote resource %S is considered unsafe, and will not be downloaded" file)))) (run-hook-with-args 'org-attach-after-change-hook attach-dir) (org-attach-tag) @@ -736,20 +757,20 @@ It is meant to be added to `org-export-before-parsing-hook'." (save-excursion (while (re-search-forward "attachment:" nil t) (let ((link (org-element-context))) - (when (and (eq 'link (org-element-type link)) + (when (and (org-element-type-p link 'link) (string-equal "attachment" (org-element-property :type link))) - (let* ((description (and (org-element-property :contents-begin link) + (let* ((description (and (org-element-contents-begin link) (buffer-substring-no-properties - (org-element-property :contents-begin link) - (org-element-property :contents-end link)))) + (org-element-contents-begin link) + (org-element-contents-end link)))) (file (org-element-property :path link)) (new-link (org-link-make-string (concat "file:" (org-attach-expand file)) description))) - (goto-char (org-element-property :end link)) + (goto-char (org-element-end link)) (skip-chars-backward " \t") - (delete-region (org-element-property :begin link) (point)) + (delete-region (org-element-begin link) (point)) (insert new-link))))))) (defun org-attach-follow (file arg) diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 1897c096306..6603b5e017a 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -58,11 +58,13 @@ (declare-function org-at-table-p "org-table" (&optional table-type)) (declare-function org-clock-update-mode-line "org-clock" (&optional refresh)) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) -(declare-function org-datetree-find-month-create (d &optional keep-restriction)) +(declare-function org-datetree-find-month-create "org-datetree" (d &optional keep-restriction)) (declare-function org-decrypt-entry "org-crypt" ()) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) -(declare-function org-element-lineage "org-element" (datum &optional types with-self)) -(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-lineage "org-element-ast" (datum &optional types with-self)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-contents-end "org-element" (node)) +(declare-function org-element-post-affiliated "org-element" (node)) (declare-function org-encrypt-entry "org-crypt" ()) (declare-function org-insert-link "ol" (&optional complete-file link-location default-description)) (declare-function org-link-make-string "ol" (link &optional description)) @@ -220,6 +222,9 @@ target Specification of where the captured item should be placed. (clock) File to the entry that is currently being clocked + (here) + The position of point + (function function-finding-location) Most general way: write your own function which both visits the file and moves point to the right location @@ -366,6 +371,10 @@ be replaced with content and expanded: %^{prompt} Prompt the user for a string and replace this sequence with it. A default value and a completion table can be specified like this: %^{prompt|default|completion2|completion3|...}. + %^{prompt}X where X is one of g, G, t, T, u, U, C, or L. + Same as %^X (see above), but also supply custom + prompt/completions. Default value and completions as in + %^{prompt|default|...}X are allowed. %? After completing the template, position cursor here. %\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N is a number, starting from 1. @@ -393,7 +402,7 @@ calendar | %:type %:date When you need to insert a literal percent sign in the template, you can escape ambiguous cases with a backward slash, e.g., \\%i." :group 'org-capture - :package-version '(Org . "9.6") + :package-version '(Org . "9.7") :set (lambda (s v) (set-default-toplevel-value s (org-capture-upgrade-templates v))) :type (let ((file-variants '(choice :tag "Filename " @@ -496,12 +505,6 @@ The capture buffer is current and still narrowed." :version "24.1" :type 'hook) -(defcustom org-capture-bookmark t - "When non-nil, add 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 @@ -579,7 +582,9 @@ this template to be accessible only from `message-mode' buffers, use this: (setq org-capture-templates-contexts - \\='((\"c\" ((in-mode . \"message-mode\"))))) + \\='((\"c\" ((in-mode . \"message-mode\"))) + (\"d\" (my-context-function + (in-mode . \"org-mode\"))))) Here are the available contexts definitions: @@ -889,10 +894,16 @@ captured item after finalizing." (goto-char (+ size pos)) (goto-char (if (< ipt pos) (+ size pos) pos)))))) - ;; Kill the target buffer if that is desired - (when (and base-buffer new-buffer kill-buffer) - (with-current-buffer base-buffer (save-buffer)) - (kill-buffer base-buffer)) + (if (and base-buffer org-note-abort new-buffer) + ;; Unconditionally kill the new buffer when capture is + ;; aborted. + (with-current-buffer base-buffer + (set-buffer-modified-p nil) + (kill-buffer)) + ;; Kill the target buffer if that is desired + (when (and base-buffer new-buffer kill-buffer) + (with-current-buffer base-buffer (save-buffer)) + (kill-buffer base-buffer))) ;; Restore the window configuration before capture (set-window-configuration return-wconf)) @@ -985,14 +996,15 @@ Store them in the capture property list." (let ((target-entry-p t)) (save-excursion (pcase (or target (org-capture-get :target)) - (`here + ((or `here + `(here)) (org-capture-put :exact-position (point) :insert-here t)) (`(file ,path) (set-buffer (org-capture-target-buffer path)) (org-capture-put-target-region-and-position) (widen) (setq target-entry-p nil)) - (`(id ,id) + (`(id ,(and id (or (pred stringp) (pred symbolp)))) (pcase (org-id-find id) (`(,path . ,position) (set-buffer (org-capture-target-buffer path)) @@ -1000,7 +1012,7 @@ Store them in the capture property list." (org-capture-put-target-region-and-position) (goto-char position)) (_ (error "Cannot find target ID \"%s\"" id)))) - (`(file+headline ,path ,headline) + (`(file+headline ,path ,(and headline (pred stringp))) (set-buffer (org-capture-target-buffer path)) ;; Org expects the target file to be in Org mode, otherwise ;; it throws an error. However, the default notes files @@ -1017,12 +1029,12 @@ Store them in the capture property list." (if (re-search-forward (format org-complex-heading-regexp-format (regexp-quote headline)) nil t) - (beginning-of-line) + (forward-line 0) (goto-char (point-max)) (unless (bolp) (insert "\n")) (insert "* " headline "\n") - (beginning-of-line 0))) - (`(file+olp ,path . ,outline-path) + (forward-line -1))) + (`(file+olp ,path . ,(and outline-path (guard outline-path))) (let ((m (org-find-olp (cons (org-capture-expand-file path) outline-path)))) (set-buffer (marker-buffer m)) @@ -1030,7 +1042,7 @@ Store them in the capture property list." (widen) (goto-char m) (set-marker m nil))) - (`(file+regexp ,path ,regexp) + (`(file+regexp ,path ,(and regexp (pred stringp))) (set-buffer (org-capture-target-buffer path)) (org-capture-put-target-region-and-position) (widen) @@ -1098,7 +1110,7 @@ Store them in the capture property list." ;; the following is the keep-restriction argument for ;; org-datetree-find-date-create (when outline-path 'subtree-at-point)))) - (`(file+function ,path ,function) + (`(file+function ,path ,(and function (pred functionp))) (set-buffer (org-capture-target-buffer path)) (org-capture-put-target-region-and-position) (widen) @@ -1106,7 +1118,7 @@ Store them in the capture property list." (org-capture-put :exact-position (point)) (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) - (`(function ,fun) + (`(function ,(and fun (pred functionp))) (funcall fun) (org-capture-put :exact-position (point)) (setq target-entry-p @@ -1162,9 +1174,9 @@ When INHIBIT-WCONF-STORE is non-nil, don't store the window configuration, as it may have been stored before." (unless inhibit-wconf-store (org-capture-put :return-to-wconf (current-window-configuration))) - (delete-other-windows) - (org-switch-to-buffer-other-window - (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) + (pop-to-buffer + (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE") + '(org-display-buffer-split)) (widen) (org-fold-show-all) (goto-char (org-capture-get :pos)) @@ -1262,7 +1274,7 @@ may have been stored before." (catch :found (while (re-search-forward item-regexp end t) (when (setq item (org-element-lineage - (org-element-at-point) '(plain-list) t)) + (org-element-at-point) 'plain-list t)) (goto-char (org-element-property (if prepend? :post-affiliated :contents-end) item)) @@ -1304,7 +1316,7 @@ may have been stored before." (point-marker)))) (when item (let ((i (save-excursion - (goto-char (org-element-property :post-affiliated item)) + (goto-char (org-element-post-affiliated item)) (org-current-text-indentation)))) (save-excursion (goto-char beg) @@ -1367,13 +1379,13 @@ may have been stored before." ;; Narrow to the table, possibly creating one if necessary. (catch :found (while (re-search-forward org-table-dataline-regexp end t) - (pcase (org-element-lineage (org-element-at-point) '(table) t) + (pcase (org-element-lineage (org-element-at-point) 'table t) (`nil nil) ((pred (lambda (e) (eq 'table.el (org-element-property :type e)))) nil) (table - (goto-char (org-element-property :contents-end table)) - (narrow-to-region (org-element-property :post-affiliated table) + (goto-char (org-element-contents-end table)) + (narrow-to-region (org-element-post-affiliated table) (point)) (throw :found t)))) ;; No table found. Create it with an empty header. @@ -1403,7 +1415,7 @@ may have been stored before." (goto-char (point-min)) (cond ((not (re-search-forward org-table-hline-regexp nil t))) - ((re-search-forward org-table-dataline-regexp nil t) (beginning-of-line)) + ((re-search-forward org-table-dataline-regexp nil t) (forward-line 0)) (t (goto-char (org-table-end))))) (t (goto-char (org-table-end)))) @@ -1492,10 +1504,15 @@ Of course, if exact position has been required, just put it there." (point)))))) (with-current-buffer (buffer-base-buffer (current-buffer)) (org-with-point-at pos - (when org-capture-bookmark + ;; FIXME: `org-capture-bookmark' is obsolete. To be removed + ;; in future Org releases. + (when (with-no-warnings org-capture-bookmark) (let ((bookmark (plist-get org-bookmark-names-plist :last-capture))) - (when bookmark (with-demoted-errors "Bookmark set error: %S" - (bookmark-set bookmark))))) + (when bookmark + (condition-case err + (bookmark-set bookmark) + (error + (message "Bookmark set error: %S" err)))))) (move-marker org-capture-last-stored-marker (point)))))) (defun org-capture-narrow (beg end) @@ -1658,12 +1675,12 @@ Expansion occurs in a temporary Org mode buffer." (org-no-properties org-clock-heading) "")) (v-K (if (marker-buffer org-clock-marker) - (org-link-make-string - (format "%s::*%s" - (buffer-file-name (marker-buffer org-clock-marker)) - v-k) - v-k) - "")) + (let ((original-link-plist org-store-link-plist) + (clocked-task-link (org-with-point-at org-clock-marker + (org-store-link nil nil)))) + (setq org-store-link-plist original-link-plist) + clocked-task-link) + "")) (v-f (or (org-capture-get :original-file-nondirectory) "")) (v-F (or (org-capture-get :original-file) "")) (org-capture--clipboards @@ -1680,7 +1697,7 @@ Expansion occurs in a temporary Org mode buffer." (message "no template") (ding) (sit-for 1)) (save-window-excursion - (org-switch-to-buffer-other-window (get-buffer-create "*Capture*")) + (switch-to-buffer-other-window (get-buffer-create "*Capture*")) (erase-buffer) (setq buffer-file-name nil) (setq mark-active nil) @@ -1852,7 +1869,7 @@ Expansion occurs in a temporary Org mode buffer." (let* ((upcase? (equal (upcase key) key)) (org-end-time-was-given nil) (time (org-read-date upcase? t nil prompt))) - (org-insert-time-stamp + (org-insert-timestamp time (or org-time-was-given upcase?) (member key '("u" "U")) nil nil (list org-end-time-was-given)))) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index e79677ad6be..5555bb1bc3d 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -36,9 +36,11 @@ (declare-function calendar-iso-to-absolute "cal-iso" (date)) (declare-function notifications-notify "notifications" (&rest params)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) -(declare-function org-element--cache-active-p "org-element" ()) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-contents-end "org-element" (node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) +(declare-function org-element-type-p "org-element-ast" (node types)) (defvar org-element-use-cache) (declare-function org-inlinetask-at-task-p "org-inlinetask" ()) (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) @@ -51,6 +53,9 @@ (declare-function org-dynamic-block-define "org" (type func)) (declare-function w32-notification-notify "w32fns.c" (&rest params)) (declare-function w32-notification-close "w32fns.c" (&rest params)) +(declare-function dbus-list-activatable-names "dbus" (&optional bus)) +(declare-function dbus-call-method "dbus" (bus service path interface method &rest args)) +(declare-function dbus-get-property "dbus" (bus service path interface property)) (declare-function haiku-notifications-notify "haikuselect.c") (declare-function android-notifications-notify "androidselect.c") @@ -127,7 +132,7 @@ clocking out." "Rounding minutes when clocking in or out. The default value is 0 so that no rounding is done. When set to a non-integer value, use the car of -`org-time-stamp-rounding-minutes', like for setting a time-stamp. +`org-timestamp-rounding-minutes', like for setting a timestamp. E.g. if `org-clock-rounding-minutes' is set to 5, time is 14:47 and you clock in: then the clock starts at 14:45. If you clock @@ -346,14 +351,16 @@ For more information, see `org-clocktable-write-default'." :version "24.1" :type 'function) -;; FIXME: translate es and nl last string "Clock summary at" (defcustom org-clock-clocktable-language-setup - '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at") - ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at") - ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à") - ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at") - ("de" "Datei" "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT" - "Gesamtdauer" "Dateizeit" "Erstellt am")) + '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at") + ("de" "Datei" "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT" "Gesamtdauer" "Dateizeit" "Erstellt am") + ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Duración" "TODO" "Duración total" "Tiempo archivo" "Generado el") + ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à") + ("nl" "Bestand" "N" "Tijdstip" "Rubriek" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Klok overzicht op") + ("nn" "Fil" "N" "Tidspunkt" "Overskrift" "Tid" "ALLE" "Total tid" "Filtid" "Tidsoversyn") + ("pl" "Plik" "P" "Data i godzina" "Nagłówek" "Czas" "WSZYSTKO" "Czas całkowity" "Czas pliku" "Poddumowanie zegara na") + ("pt-BR" "Arquivo" "N" "Data e hora" "Título" "Hora" "TODOS" "Hora total" "Hora do arquivo" "Resumo das horas em") + ("sk" "Súbor" "L" "Časová značka" "Záhlavie" "Čas" "VÅ ETKO" "Celkový čas" "Čas súboru" "Časový súhrn pre")) "Terms used in clocktable, translated to different languages." :group 'org-clocktable :version "24.1" @@ -413,8 +420,8 @@ play with them." :type 'string) (defcustom org-clock-clocked-in-display 'mode-line - "When clocked in for a task, Org can display the current -task and accumulated time in the mode line and/or frame title. + "Where to display clocked in task and accumulated time when clocked in. + Allowed values are: both displays in both mode line and frame title @@ -440,7 +447,9 @@ This uses the same format as `frame-title-format', which see." :group 'org-clock :type 'sexp) -(defcustom org-clock-x11idle-program-name "x11idle" +(defcustom org-clock-x11idle-program-name + (if (executable-find "xprintidle") + "xprintidle" "x11idle") "Name of the program which prints X11 idle time in milliseconds. you can do \"~$ sudo apt-get install xprintidle\" if you are using @@ -449,8 +458,7 @@ a Debian-based distribution. Alternatively, can find x11idle.c in https://orgmode.org/worg/code/scripts/x11idle.c" :group 'org-clock - :version "24.4" - :package-version '(Org . "8.0") + :package-version '(Org . "9.7") :type 'string) (defcustom org-clock-goto-before-context 2 @@ -508,7 +516,11 @@ to add an effort property.") (defvar org-clock-in-hook nil "Hook run when starting the clock.") (defvar org-clock-out-hook nil - "Hook run when stopping the current clock.") + "Hook run when stopping the current clock. +The point is at the current clock line when the hook is executed. + +The hook functions can access `org-clock-out-removed-last-clock' to +check whether the latest CLOCK line has been cleared.") (defvar org-clock-cancel-hook nil "Hook run when canceling the current clock.") @@ -562,6 +574,10 @@ of a different task.") Assume S in the English term to translate. Return S as-is if it cannot be translated." (or (nth (pcase s + ;; "L" stands for "Level" + ;; "ALL" stands for a line summarizing clock data across + ;; all the files, when the clocktable includes multiple + ;; files. ("File" 1) ("L" 2) ("Timestamp" 3) ("Headline" 4) ("Time" 5) ("ALL" 6) ("Total time" 7) ("File time" 8) ("Clock summary at" 9)) (assoc-string language org-clock-clocktable-language-setup t)) @@ -576,6 +592,7 @@ cannot be translated." (org-no-properties (org-get-heading t t t t)))))) (defun org-clock-menu () + "Pop up org-clock menu." (interactive) (popup-menu '("Clock" @@ -585,7 +602,12 @@ cannot be translated." ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]))) (defun org-clock-history-push (&optional pos buffer) - "Push a marker to the clock history." + "Push point marker to the clock history. +When POS is provided, use it as marker point. +When BUFFER and POS are provided, use marker at POS in base buffer of +BUFFER." + ;; When buffer is provided, POS must be provided. + (cl-assert (or (not buffer) pos)) (setq org-clock-history-length (max 1 org-clock-history-length)) (let ((m (move-marker (make-marker) (or pos (point)) (org-base-buffer @@ -605,7 +627,10 @@ cannot be translated." (push m org-clock-history))) (defun org-clock-save-markers-for-cut-and-paste (beg end) - "Save relative positions of markers in region." + "Save relative positions of markers in region BEG..END. +Save `org-clock-marker', `org-clock-hd-marker', +`org-clock-default-task', `org-clock-interrupted-task', and the +markers in `org-clock-history'." (org-check-and-save-marker org-clock-marker beg end) (org-check-and-save-marker org-clock-hd-marker beg end) (org-check-and-save-marker org-clock-default-task beg end) @@ -631,6 +656,7 @@ cannot be translated." (defun org-clock-select-task (&optional prompt) "Select a task that was recently associated with clocking. +PROMPT is the prompt text to be used, as a string. Return marker position of the selected task. Raise an error if there is no recent clock to choose from." (let (och chl sel-list rpl (i 0) s) @@ -641,7 +667,7 @@ there is no recent clock to choose from." (if (zerop chl) (user-error "No recent clock") (save-window-excursion - (org-switch-to-buffer-other-window + (switch-to-buffer-other-window (get-buffer-create "*Clock Task Select*")) (erase-buffer) (when (marker-buffer org-clock-default-task) @@ -671,8 +697,11 @@ there is no recent clock to choose from." ;; `fit-window-to-buffer' (fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl))) (message (or prompt "Select task for clocking:")) - (setq cursor-type nil rpl (read-char-exclusive)) - (kill-buffer) + (unwind-protect (setq cursor-type nil rpl (read-char-exclusive)) + (when-let ((window (get-buffer-window "*Clock Task Select*" t))) + (quit-window 'kill window)) + (when (get-buffer "*Clock Task Select*") + (kill-buffer "*Clock Task Select*"))) (cond ((eq rpl ?q) nil) ((eq rpl ?x) nil) @@ -781,6 +810,7 @@ previous clocking intervals." 60))) (+ currently-clocked-time (or org-clock-total-time 0)))) +;;;###autoload (defun org-clock-modify-effort-estimate (&optional value) "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. @@ -911,7 +941,7 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." (if (executable-find "aplay") (start-process "org-clock-play-notification" nil "aplay" file) - (condition-case nil + (condition-case-unless-debug nil (play-sound-file file) (error (beep t) (beep t)))))))))) @@ -928,9 +958,11 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." (save-excursion (goto-char (point-min)) (while (re-search-forward org-clock-re nil t) - (push (cons (copy-marker (match-end 1) t) - (org-time-string-to-time (match-string 1))) - clocks)))) + (when (save-match-data + (org-element-type-p (org-element-at-point) 'clock)) + (push (cons (copy-marker (match-end 1) t) + (org-time-string-to-time (match-string 1))) + clocks))))) clocks)) (defsubst org-is-active-clock (clock) @@ -944,7 +976,7 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." `(with-current-buffer (marker-buffer (car ,clock)) (org-with-wide-buffer (goto-char (car ,clock)) - (beginning-of-line) + (forward-line 0) ,@forms))) (defmacro org-with-clock (clock &rest forms) @@ -1050,8 +1082,8 @@ CLOCK is a cons cell of the form (MARKER START-TIME)." (catch 'exit (while (re-search-backward drawer-re beg t) (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'drawer) - (when (> (org-element-property :end element) (car clock)) + (when (org-element-type-p element 'drawer) + (when (> (org-element-end element) (car clock)) (org-fold-hide-drawer-toggle 'off nil element)) (throw 'exit nil))))))))))) @@ -1226,6 +1258,27 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling "Return the current X11 idle time in seconds." (/ (string-to-number (shell-command-to-string org-clock-x11idle-program-name)) 1000)) +(defvar org-logind-dbus-session-path + (when (and (boundp 'dbus-runtime-version) + (require 'dbus nil t) + (member "org.freedesktop.login1" (dbus-list-activatable-names))) + (ignore-errors + (dbus-call-method + :system "org.freedesktop.login1" + "/org/freedesktop/login1" + "org.freedesktop.login1.Manager" + "GetSessionByPID" (emacs-pid)))) + "D-Bus session path for the elogind interface.") + +(defun org-logind-user-idle-seconds () + "Return the number of idle seconds for the user according to logind." + (- (float-time) + (/ (dbus-get-property + :system "org.freedesktop.login1" + org-logind-dbus-session-path + "org.freedesktop.login1.Session" "IdleSinceHint") + 1e6))) + (defun org-user-idle-seconds () "Return the number of seconds the user has been idle for. This routine returns a floating point number." @@ -1234,6 +1287,13 @@ This routine returns a floating point number." (org-mac-idle-seconds)) ((and (eq window-system 'x) org-x11idle-exists-p) (org-x11-idle-seconds)) + ((and + org-logind-dbus-session-path + (dbus-get-property + :system "org.freedesktop.login1" + org-logind-dbus-session-path + "org.freedesktop.login1.Session" "IdleHint")) + (org-logind-user-idle-seconds)) (t (org-emacs-idle-seconds)))) @@ -1291,8 +1351,6 @@ time as the start time. See `org-clock-continuously' to make this the default behavior." (interactive "P") (setq org-clock-notification-was-shown nil) - (unless org-element-use-cache - (org-refresh-effort-properties)) (catch 'abort (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) (org-clocking-p))) @@ -1370,8 +1428,8 @@ the default behavior." (when newstate (org-todo newstate)))) ((and org-clock-in-switch-to-state (not (looking-at (concat org-outline-regexp "[ \t]*" - org-clock-in-switch-to-state - "\\>")))) + org-clock-in-switch-to-state + "\\(?:[ \t]\\|$\\)")))) (org-todo org-clock-in-switch-to-state))) (setq org-clock-heading (org-clock--mode-line-heading)) (org-clock-find-position org-clock-in-resume) @@ -1397,12 +1455,15 @@ the default behavior." (sit-for 2) (throw 'abort nil)) (t + ;; Make sure that point moves after clock line upon + ;; inserting it. Then, users can continue typing even if + ;; point was right where the clock is inserted. (insert-before-markers-and-inherit "\n") (backward-char 1) (when (and (save-excursion (end-of-line 0) (org-in-item-p))) - (beginning-of-line 1) + (forward-line 0) (indent-line-to (max 0 (- (current-indentation) 2)))) (insert-and-inherit org-clock-string " ") (setq org-clock-effort (org-entry-get (point) org-effort-property)) @@ -1422,8 +1483,8 @@ the default behavior." leftover) start-time (org-current-time org-clock-rounding-minutes t))) - (setq ts (org-insert-time-stamp org-clock-start-time - 'with-hm 'inactive)) + (setq ts (org-insert-timestamp org-clock-start-time + 'with-hm 'inactive)) (org-indent-line))) (move-marker org-clock-marker (point) (buffer-base-buffer)) (move-marker org-clock-hd-marker @@ -1459,6 +1520,33 @@ the default behavior." (message "Clock starts at %s - %s" ts org--msg-extra) (run-hooks 'org-clock-in-hook)))))) +(defvar org-clock--auto-clockout-timer-obj nil + "Timer object holding the existing clockout timer.") +(defun org-clock--auto-clockout-maybe () + "Clock out the currently clocked in task when idle. +See `org-clock-auto-clockout-timer' to set the idle time span. + +This function is to be called by a timer." + (when (and (numberp org-clock-auto-clockout-timer) + org-clock-current-task) + (let ((user-idle-seconds (org-user-idle-seconds))) + (cond + ;; Already idle. Clock out. + ((>= user-idle-seconds org-clock-auto-clockout-timer) + (setq org-clock--auto-clockout-timer-obj nil) + (org-clock-out)) + ;; Emacs is idle but system is not. Retry assuming that system will remain idle. + ((>= (org-emacs-idle-seconds) org-clock-auto-clockout-timer) + (setq org-clock--auto-clockout-timer-obj + (run-with-timer + (- org-clock-auto-clockout-timer user-idle-seconds) + nil #'org-clock--auto-clockout-maybe))) + ;; Emacs is not idle. Check again next time we are idle. + (t + (setq org-clock--auto-clockout-timer-obj + (run-with-idle-timer + org-clock-auto-clockout-timer nil #'org-clock--auto-clockout-maybe))))))) + (defun org-clock-auto-clockout () "Clock out the currently clocked in task if Emacs is idle. See `org-clock-auto-clockout-timer' to set the idle time span. @@ -1466,9 +1554,11 @@ See `org-clock-auto-clockout-timer' to set the idle time span. This is only effective when `org-clock-auto-clockout-insinuate' is present in the user configuration." (when (and (numberp org-clock-auto-clockout-timer) - org-clock-current-task) - (run-with-idle-timer - org-clock-auto-clockout-timer nil #'org-clock-out))) + org-clock-current-task + (not (timerp org-clock--auto-clockout-timer-obj))) + (setq org-clock--auto-clockout-timer-obj + (run-with-idle-timer + org-clock-auto-clockout-timer nil #'org-clock--auto-clockout-maybe)))) ;;;###autoload (defun org-clock-toggle-auto-clockout () @@ -1576,9 +1666,9 @@ line and position cursor in that line." " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) (while (re-search-forward open-clock-re end t) (let ((element (org-element-at-point))) - (when (and (eq (org-element-type element) 'clock) + (when (and (org-element-type-p element 'clock) (eq (org-element-property :status element) 'running)) - (beginning-of-line) + (forward-line 0) (throw 'exit t)))))) ;; Look for an existing clock drawer. (when drawer @@ -1586,8 +1676,8 @@ line and position cursor in that line." (let ((drawer-re (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$"))) (while (re-search-forward drawer-re end t) (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'drawer) - (let ((cend (org-element-property :contents-end element))) + (when (org-element-type-p element 'drawer) + (let ((cend (org-element-contents-end element))) (if (and (not org-log-states-order-reversed) cend) (goto-char cend) (forward-line)) @@ -1600,7 +1690,7 @@ line and position cursor in that line." (save-excursion (while (re-search-forward clock-re end t) (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'clock) + (when (org-element-type-p element 'clock) (setq positions (cons (line-beginning-position) positions) count (1+ count)))))) (cond @@ -1608,19 +1698,18 @@ line and position cursor in that line." (org-fold-core-ignore-modifications ;; Skip planning line and property drawer, if any. (org-end-of-meta-data) - (unless (bolp) (insert-and-inherit "\n")) + (unless (bolp) (insert-before-markers-and-inherit "\n")) ;; Create a new drawer if necessary. (when (and org-clock-into-drawer (or (not (wholenump org-clock-into-drawer)) (< org-clock-into-drawer 2))) (let ((beg (point))) - (insert-and-inherit ":" drawer ":\n:END:\n") + ;; Make sure that point moves after drawer upon + ;; inserting it. Then, users can continue typing even + ;; if point was right where the clock is inserted. + (insert-before-markers-and-inherit ":" drawer ":\n:END:\n") (org-indent-region beg (point)) - (if (eq org-fold-core-style 'text-properties) - (org-fold-region - (line-end-position -1) (1- (point)) t 'drawer) - (org-fold-region - (line-end-position -1) (1- (point)) t 'outline)) + (org-fold-region (line-end-position -1) (1- (point)) t 'drawer) (forward-line -1))))) ;; When a clock drawer needs to be created because of the ;; number of clock items or simply if it is missing, collect @@ -1645,13 +1734,13 @@ line and position cursor in that line." "\n:END:\n") (let ((end (point-marker))) (goto-char beg) - (save-excursion (insert-and-inherit ":" drawer ":\n")) + (save-excursion (insert-before-markers-and-inherit ":" drawer ":\n")) (org-fold-region (line-end-position) (1- end) t 'outline) (org-indent-region (point) end) (forward-line) (unless org-log-states-order-reversed (goto-char end) - (beginning-of-line -1)) + (forward-line -2)) (set-marker end nil))))) (org-log-states-order-reversed (goto-char (car (last positions)))) (t (goto-char (car positions)))))))) @@ -1664,6 +1753,11 @@ and current `frame-title-format' is equal to `org-clock-frame-title-format'." (equal frame-title-format org-clock-frame-title-format)) (setq frame-title-format org-frame-title-format-backup))) +(defvar org-clock-out-removed-last-clock nil + "When non-nil, the last `org-clock-out' removed the clock line. +This can happen when `org-clock-out-remove-zero-time-clocks' is set to +non-nil and the latest clock took 0 minutes.") + ;;;###autoload (defun org-clock-out (&optional switch-to-state fail-quietly at-time) "Stop the currently running clock. @@ -1694,7 +1788,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (save-restriction (widen) (goto-char org-clock-marker) - (beginning-of-line 1) + (forward-line 0) (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) (equal (match-string 1) org-clock-string)) (setq ts (match-string 2)) @@ -1703,7 +1797,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (delete-region (point) (line-end-position)) (org-fold-core-ignore-modifications (insert-and-inherit "--") - (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) + (setq te (org-insert-timestamp (or at-time now) 'with-hm 'inactive)) (setq s (org-time-convert-to-integer (time-subtract (org-time-string-to-time te) @@ -1742,10 +1836,10 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (when newstate (org-todo newstate)))) ((and org-clock-out-switch-to-state (not (looking-at - (concat - org-outline-regexp "[ \t]*" - org-clock-out-switch-to-state - "\\>")))) + (concat + org-outline-regexp "[ \t]*" + org-clock-out-switch-to-state + "\\(?:[ \t]\\|$\\)")))) (org-todo org-clock-out-switch-to-state)))))) (force-mode-line-update) (message (if remove @@ -1754,6 +1848,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." te (org-duration-from-minutes (+ (* 60 h) m))) (unless (org-clocking-p) (setq org-clock-current-task nil)) + (setq org-clock-out-removed-last-clock remove) (run-hooks 'org-clock-out-hook) ;; Add a note, but only if we didn't remove the clock line. (when (and org-log-note-clock-out (not remove)) @@ -1948,17 +2043,30 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (save-excursion (goto-char (point-max)) (while (re-search-backward re nil t) - (let ((element-type - (org-element-type - (save-match-data - (org-element-at-point))))) + (let* ((element (save-match-data (org-element-at-point))) + (element-type (org-element-type element))) (cond ((and (eq element-type 'clock) (match-end 2)) ;; Two time stamps. - (let* ((ss (match-string 2)) - (se (match-string 3)) - (ts (org-time-string-to-seconds ss)) - (te (org-time-string-to-seconds se)) + (let* ((timestamp (org-element-property :value element)) + (ts (float-time + (org-encode-time + (list 0 + (org-element-property :minute-start timestamp) + (org-element-property :hour-start timestamp) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp) + nil -1 nil)))) + (te (float-time + (org-encode-time + (list 0 + (org-element-property :minute-end timestamp) + (org-element-property :hour-end timestamp) + (org-element-property :day-end timestamp) + (org-element-property :month-end timestamp) + (org-element-property :year-end timestamp) + nil -1 nil)))) (dt (- (if tend (min te tend) te) (if tstart (max ts tstart) ts)))) (when (> dt 0) (cl-incf t1 (floor dt 60))))) @@ -2358,7 +2466,7 @@ have priority." d (+ d shift))) ((or `week `thisweek) (let* ((ws (or wstart 1)) - (diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))))) + (diff (+ (* -7 shift) (mod (+ dow 7 (- ws)) 7)))) (setq m 0 h org-extend-today-until d (- d diff) d1 (+ 7 d)))) ((or `month `thismonth) (setq h org-extend-today-until m 0 d (or mstart 1) @@ -2509,7 +2617,7 @@ the currently selected interval size." (goto-char b) (insert ins) (delete-region (point) (+ (point) (- e b))) - (beginning-of-line 1) + (forward-line 0) (org-update-dblock) t))))) @@ -2811,13 +2919,13 @@ from the dynamic block definition." (if timestamp (concat ts "|") "") ;timestamp, maybe (if tags (concat (mapconcat #'identity tgs ", ") "|") "") ;tags, maybe (if properties ;properties columns, maybe - (concat (mapconcat (lambda (p) (or (cdr (assoc p props)) "")) - properties - "|") - "|") + (concat (mapconcat (lambda (p) (or (cdr (assoc p props)) "")) + properties + "|") + "|") "") (if indent ;indentation - (org-clocktable-indent-string level) + (org-clocktable-indent-string level) "") (format-field headline) ;; Empty fields for higher levels. @@ -2825,7 +2933,7 @@ from the dynamic block definition." (format-field (org-duration-from-minutes time)) (make-string (max 0 (- time-columns level)) ?|) (if (eq formula '%) - (format "%.1f |" (* 100 (/ time (float total-time)))) + (format "%.1f |" (* 100 (/ time (float total-time)))) "") "\n"))))))) (delete-char -1) @@ -2836,7 +2944,7 @@ from the dynamic block definition." (when (and contents (string-match "^\\([ \t]*#\\+tblfm:.*\\)" contents)) (setq recalc t) (insert "\n" (match-string 1 contents)) - (beginning-of-line 0)))) + (forward-line -1)))) ;; Insert specified formula line. ((stringp formula) (insert "\n#+TBLFM: " formula) @@ -3018,8 +3126,9 @@ PROPERTIES: The list properties specified in the `:properties' parameter (let* ((todo (org-get-todo-state)) (tags-list (org-get-tags)) (org-scanner-tags tags-list) - (org-trust-scanner-tags t)) - (funcall matcher todo tags-list nil))))) + (org-trust-scanner-tags t) + (level (org-current-level))) + (funcall matcher todo tags-list level))))) (goto-char (point-min)) (setq st t) (while (or (and (bobp) (prog1 st (setq st nil)) @@ -3079,7 +3188,7 @@ Otherwise, return nil." (let ((origin (point))) ;; `save-excursion' may not work when deleting. (prog1 (save-excursion - (beginning-of-line 1) + (forward-line 0) (skip-chars-forward " \t") (when (looking-at org-clock-string) (let ((re (concat "[ \t]*" org-clock-string diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index ccf1ca731a4..961ae0fbe54 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -37,13 +37,13 @@ (declare-function org-agenda-redo "org-agenda" (&optional all)) (declare-function org-agenda-do-context-action "org-agenda" ()) (declare-function org-clock-sum-today "org-clock" (&optional headline-filter)) -(declare-function org-element-extract-element "org-element" (element)) +(declare-function org-element-extract "org-element-ast" (node)) (declare-function org-element-interpret-data "org-element" (data)) (declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated)) (declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) -(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-property "org-element-ast" (property node)) (declare-function org-element-restriction "org-element" (element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-dynamic-block-define "org" (type func)) (declare-function org-link-display-format "ol" (s)) (declare-function org-link-open-from-string "ol" (s &optional arg)) @@ -59,6 +59,19 @@ ;;; Configuration +(defcustom org-columns-checkbox-allowed-values '("[ ]" "[X]") + "Allowed values for columns with SUMMARY-TYPE that uses checkbox. +The affected summary types are \"X%\", \"X/\", and \"X\" (see info +node `(org)Column attributes')." + :group 'org-properties + :package-version '(Org . "9.6") + :type '(repeat (choice + (const :tag "Unchecked [ ]" "[ ]") + (const :tag "Checked [X]" "[X]") + (const :tag "No checkbox" "") + (const :tag "Intermediate state [-]" "[-]") + (string :tag "Arbitrary string")))) + (defcustom org-columns-modify-value-for-display-function nil "Function that modifies values for display in column view. For example, it can be used to cut out a certain part from a time stamp. @@ -110,6 +123,12 @@ in `org-columns-summary-types-default', which see." (function :tag "Summarize") (function :tag "Collect"))))) +(defcustom org-columns-dblock-formatter #'org-columns-dblock-write-default + "Function to format data in column view dynamic blocks. +For more information, see `org-columns-dblock-write-default'." + :group 'org-properties + :package-version '(Org . "9.7") + :type 'function) ;;; Column View @@ -118,6 +137,9 @@ in `org-columns-summary-types-default', which see." "Holds the list of current column overlays.") (put 'org-columns-overlays 'permanent-local t) +(defvar-local org-columns-global nil + "Local variable, holds non-nil when current columns are global.") + (defvar-local org-columns-current-fmt nil "Local variable, holds the currently active column format.") @@ -180,28 +202,10 @@ See `org-columns-summary-types' for details.") (org-defkey org-columns-map "\M-b" #'backward-char) (org-defkey org-columns-map "a" #'org-columns-edit-allowed) (org-defkey org-columns-map "s" #'org-columns-edit-attributes) -(org-defkey org-columns-map "\M-f" - (lambda () (interactive) (goto-char (1+ (point))))) -(org-defkey org-columns-map [right] - (lambda () (interactive) (goto-char (1+ (point))))) -(org-defkey org-columns-map [down] - (lambda () (interactive) - (let ((col (current-column))) - (beginning-of-line 2) - (while (and (org-invisible-p2) (not (eobp))) - (beginning-of-line 2)) - (move-to-column col) - (if (derived-mode-p 'org-agenda-mode) - (org-agenda-do-context-action))))) -(org-defkey org-columns-map [up] - (lambda () (interactive) - (let ((col (current-column))) - (beginning-of-line 0) - (while (and (org-invisible-p2) (not (bobp))) - (beginning-of-line 0)) - (move-to-column col) - (if (eq major-mode 'org-agenda-mode) - (org-agenda-do-context-action))))) +(org-defkey org-columns-map "\M-f" #'forward-char) +(org-defkey org-columns-map [right] #'forward-char) +(org-defkey org-columns-map [up] #'org-columns-move-up) +(org-defkey org-columns-map [down] #'org-columns-move-down) (org-defkey org-columns-map [(shift right)] #'org-columns-next-allowed-value) (org-defkey org-columns-map "n" #'org-columns-next-allowed-value) (org-defkey org-columns-map [(shift left)] #'org-columns-previous-allowed-value) @@ -210,6 +214,8 @@ See `org-columns-summary-types' for details.") (org-defkey org-columns-map ">" #'org-columns-widen) (org-defkey org-columns-map [(meta right)] #'org-columns-move-right) (org-defkey org-columns-map [(meta left)] #'org-columns-move-left) +(org-defkey org-columns-map [(meta down)] #'org-columns-move-row-down) +(org-defkey org-columns-map [(meta up)] #'org-columns-move-row-up) (org-defkey org-columns-map [(shift meta right)] #'org-columns-new) (org-defkey org-columns-map [(shift meta left)] #'org-columns-delete) (dotimes (i 10) @@ -231,6 +237,8 @@ See `org-columns-summary-types' for details.") "--" ["Move column right" org-columns-move-right t] ["Move column left" org-columns-move-left t] + ["Move row up" org-columns-move-row-up t] + ["Move row down" org-columns-move-row-down t] ["Add column" org-columns-new t] ["Delete column" org-columns-delete t] "--" @@ -376,17 +384,19 @@ ORIGINAL is the real string, i.e., before it is modified by "Store the relative remapping of column header-line. This is needed to later remove this relative remapping.") +(defvar org-columns--read-only-string nil) (defun org-columns--display-here (columns &optional dateline) "Overlay the current line with column display. COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument DATELINE is non-nil when the face used should be `org-agenda-column-dateline'." - (when (and (ignore-errors (require 'face-remap)) - org-columns-header-line-remap) + (when (and (not org-columns-header-line-remap) + (or (fboundp 'face-remap-add-relative) + (ignore-errors (require 'face-remap)))) (setq org-columns-header-line-remap (face-remap-add-relative 'header-line '(:inherit default)))) (save-excursion - (beginning-of-line) + (forward-line 0) (let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)") (org-get-level-face 2))) (ref-face (or level-face @@ -449,18 +459,36 @@ DATELINE is non-nil when the face used should be (line-end-position 0) (line-beginning-position 2) 'read-only - (substitute-command-keys - "Type \\`\\[org-columns-edit-value]' \ -to edit property"))))))) + (or org-columns--read-only-string + (setq org-columns--read-only-string + (substitute-command-keys + "Type \\`\\[org-columns-edit-value]' \ +to edit property"))))))))) + +(defun org-columns--truncate-below-width (string width) + "Return a substring of STRING no wider than WIDTH. +This substring must start at 0, and must be the longest possible +substring whose `string-width' does not exceed WIDTH." + (declare (side-effect-free t)) + (let ((end (min width (length string))) res) + (while (and end (>= end 0)) + (let* ((curr (string-width (substring string 0 end))) + (excess (- curr width))) + (if (> excess 0) + (cl-decf end (max 1 (/ excess 2))) + (setq res (substring string 0 end) end nil)))) + res)) (defun org-columns-add-ellipses (string width) "Truncate STRING with WIDTH characters, with ellipses." (cond - ((<= (length string) width) string) - ((<= width (length org-columns-ellipses)) - (substring org-columns-ellipses 0 width)) - (t (concat (substring string 0 (- width (length org-columns-ellipses))) - org-columns-ellipses)))) + ((<= (string-width string) width) string) + ((<= width (string-width org-columns-ellipses)) + (org-columns--truncate-below-width org-columns-ellipses width)) + (t (concat + (org-columns--truncate-below-width + string (- width (string-width org-columns-ellipses))) + org-columns-ellipses)))) (defvar org-columns-full-header-line-format nil "The full header line format, will be shifted by horizontal scrolling." ) @@ -728,7 +756,7 @@ an integer, select that value." (let ((all (or (org-property-get-allowed-values pom key) (pcase (nth column org-columns-current-fmt-compiled) - (`(,_ ,_ ,_ ,(or "X" "X/" "X%") ,_) '("[ ]" "[X]"))) + (`(,_ ,_ ,_ ,(or "X" "X/" "X%") ,_) org-columns-checkbox-allowed-values)) (org-colview-construct-allowed-dates value)))) (if previous (reverse all) all)))) (when (equal key "ITEM") (error "Cannot edit item headline from here")) @@ -818,7 +846,7 @@ current specifications. This function also sets (let ((case-fold-search t)) (while (re-search-forward "^[ \t]*#\\+COLUMNS: .+$" nil t) (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) + (when (org-element-type-p element 'keyword) (throw :found (org-element-property :value element))))) nil))) org-columns-default-format))) @@ -851,6 +879,7 @@ turn on column view for the whole buffer unconditionally. When COLUMNS-FMT-STRING is non-nil, use it as the column format." (interactive "P") (org-columns-remove-overlays) + (setq-local org-columns-global global) (save-excursion (when global (goto-char (point-min))) (if (markerp org-columns-begin-marker) @@ -873,7 +902,7 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." ;; Collect contents of columns ahead of time so as to ;; compute their maximum width. (org-scan-tags - (lambda () (cons (point) (org-columns--collect-values))) t org--matcher-tags-todo-only))) + (lambda () (cons (point-marker) (org-columns--collect-values))) t org--matcher-tags-todo-only))) (when cache (org-columns--set-widths cache) (org-columns--display-here-title) @@ -971,6 +1000,30 @@ details." (interactive "p") (org-columns-widen (- arg))) +(defun org-columns-move-up () + "In column view, move cursor up one row. +When in agenda column view, also call `org-agenda-do-context-action'." + (interactive) + (let ((col (current-column))) + (forward-line -1) + (while (and (org-invisible-p2) (not (bobp))) + (forward-line -1)) + (move-to-column col) + (if (eq major-mode 'org-agenda-mode) + (org-agenda-do-context-action)))) + +(defun org-columns-move-down () + "In column view, move cursor down one row. +When in agenda column view, also call `org-agenda-do-context-action'." + (interactive) + (let ((col (current-column))) + (forward-line 1) + (while (and (org-invisible-p2) (not (eobp))) + (forward-line 1)) + (move-to-column col) + (if (derived-mode-p 'org-agenda-mode) + (org-agenda-do-context-action)))) + (defun org-columns-move-right () "Swap this column with the one to the right." (interactive) @@ -1005,6 +1058,27 @@ details." (org-columns-move-right) (backward-char 1))) +(defun org-columns--move-row (&optional up) + "Move the current table row down. +With non-nil optional argument UP, move it up." + (let ((inhibit-read-only t) + (col (current-column))) + (if up (org-move-subtree-up) + (org-move-subtree-down)) + (let ((org-columns-inhibit-recalculation t)) + (org-columns-redo) + (move-to-column col)))) + +(defun org-columns-move-row-down () + "Move the current table row down." + (interactive) + (org-columns--move-row)) + +(defun org-columns-move-row-up () + "Move the current table row up." + (interactive) + (org-columns--move-row 'up)) + (defun org-columns-store-format () "Store the text version of the current columns format. The format is stored either in the COLUMNS property of the node @@ -1022,7 +1096,7 @@ the current buffer." (catch :found (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t) (let ((element (save-match-data (org-element-at-point)))) - (when (and (eq (org-element-type element) 'keyword) + (when (and (org-element-type-p element 'keyword) (equal (org-element-property :key element) "COLUMNS")) (replace-match (concat " " fmt) t t nil 1) @@ -1072,7 +1146,7 @@ the current buffer." (if (derived-mode-p 'org-mode) ;; Since we already know the columns format, provide it ;; instead of computing again. - (call-interactively #'org-columns org-columns-current-fmt) + (funcall-interactively #'org-columns org-columns-global org-columns-current-fmt) (org-agenda-redo) (call-interactively #'org-agenda-columns))) (message "Recomputing columns...done"))) @@ -1132,7 +1206,7 @@ This function updates `org-columns-current-fmt-compiled'." (defun org-columns--age-to-minutes (s) "Turn age string S into a number of minutes. -An age is either computed from a given time-stamp, or indicated +An age is either computed from a given timestamp, or indicated as a canonical duration, i.e., using units defined in `org-duration-canonical-units'." (cond @@ -1161,8 +1235,8 @@ Return the result as a duration." SPEC is a column format specification. When optional argument UPDATE is non-nil, summarized values can replace existing ones in properties drawers." - (let* ((lmax (if (bound-and-true-p org-inlinetask-min-level) - org-inlinetask-min-level + (let* ((lmax (if (bound-and-true-p org-inlinetask-max-level) + org-inlinetask-max-level 29)) ;Hard-code deepest level. (lvals (make-vector (1+ lmax) nil)) (level 0) @@ -1198,9 +1272,9 @@ properties drawers." ;; property `org-summaries', in alist whose key is SPEC. (let* ((summary (and summarize - (let ((values (append (and (/= last-level inminlevel) - (aref lvals last-level)) - (aref lvals inminlevel)))) + (let ((values + (cl-loop for l from (1+ level) to lmax + append (aref lvals l)))) (and values (funcall summarize values printf)))))) ;; Leaf values are not summaries: do not mark them. (when summary @@ -1374,9 +1448,13 @@ that will be excluded from the resulting view. FORMAT is a format string for columns, or nil. When LOCAL is non-nil, only capture headings in current subtree. -This function returns a list containing the title row and all -other rows. Each row is a list of fields, as strings, or -`hline'." +This function returns a list containing the title row and all other +rows. Each row is either a list, or the symbol `hline'. The first list +is the heading row as a list of strings with the column titles according +to FORMAT. All subsequent lists each represent a body row as a list +whose first element is an integer indicating the outline level of the +entry, and whose remaining elements are strings with the contents for +the columns according to FORMAT." (org-columns (not local) format) (goto-char org-columns-top-level-marker) (let ((columns (length org-columns-current-fmt-compiled)) @@ -1389,11 +1467,10 @@ other rows. Each row is a list of fields, as strings, or (dotimes (i columns) (let* ((col (+ (line-beginning-position) i)) (p (get-char-property col 'org-columns-key))) - (push (org-quote-vert - (get-char-property col - (if (string= p "ITEM") - 'org-columns-value - 'org-columns-value-modified))) + (push (get-char-property col + (if (string= p "ITEM") + 'org-columns-value + 'org-columns-value-modified)) row))) (unless (or (and skip-empty @@ -1424,8 +1501,10 @@ an inline src-block." (org-element-map data '(footnote-reference inline-babel-call inline-src-block target radio-target statistics-cookie) - #'org-element-extract-element) - (org-no-properties (org-element-interpret-data data)))) + #'org-element-extract) + (org-quote-vert + (org-no-properties + (org-element-interpret-data data))))) ;;;###autoload (defun org-dblock-write:columnview (params) @@ -1477,7 +1556,17 @@ PARAMS is a property list of parameters: `:vlines' When non-nil, make each column a column group to enforce - vertical lines." + vertical lines. + +`:link' + + Link the item headlines in the table to their origins. + +`:formatter' + + A function to format the data and insert it into the + buffer. Overrides the default formatting function set in + `org-columns-dblock-formatter'." (let ((table (let ((id (plist-get params :id)) view-file view-pos) @@ -1495,7 +1584,7 @@ PARAMS is a property list of parameters: (setq view-file filename) (setq view-pos position)) (_ (user-error "Cannot find entry with :ID: %s" id))) - (with-current-buffer (if view-file (get-file-buffer view-file) + (with-current-buffer (if view-file (org-get-agenda-file-buffer view-file) (current-buffer)) (org-with-wide-buffer (when view-pos (goto-char view-pos)) @@ -1504,7 +1593,21 @@ PARAMS is a property list of parameters: (plist-get params :skip-empty-rows) (plist-get params :exclude-tags) (plist-get params :format) - view-pos)))))) + view-pos))))) + (formatter (or (plist-get params :formatter) + org-columns-dblock-formatter + #'org-columns-dblock-write-default))) + (funcall formatter (point) table params))) + +(defun org-columns-dblock-write-default (ipos table params) + "Write out a columnview table at position IPOS in the current buffer. +TABLE is a table with data as produced by `org-columns--capture-view'. +PARAMS is the parameter property list obtained from the dynamic block +definition." + (let ((link (plist-get params :link)) + (width-specs + (mapcar (lambda (spec) (nth 2 spec)) + org-columns-current-fmt-compiled))) (when table ;; Prune level information from the table. Also normalize ;; headings: remove stars, add indentation entities, if @@ -1528,7 +1631,14 @@ PARAMS is a property list of parameters: (and (numberp hlines) (<= level hlines)))) (push 'hline new-table)) (when item-index - (let ((item (org-columns--clean-item (nth item-index (cdr row))))) + (let* ((raw (nth item-index (cdr row))) + (cleaned (org-columns--clean-item raw)) + (item (if (not link) cleaned + (let ((search (org-link-heading-search-string raw))) + (org-link-make-string + (if (not (buffer-file-name)) search + (format "file:%s::%s" (buffer-file-name) search)) + cleaned))))) (setf (nth item-index (cdr row)) (if (and indent (> level 1)) (concat "\\_" (make-string (* 2 (1- level)) ?\s) item) @@ -1540,6 +1650,13 @@ PARAMS is a property list of parameters: (append (mapcar (lambda (x) (if (eq 'hline x) x (cons "" x))) table) (list (cons "/" (make-list size "<>"))))))) + (when (seq-find #'identity width-specs) + ;; There are width specifiers in column format. Pass them + ;; to the resulting table, adding alignment field as the first + ;; row. + (push (mapcar (lambda (width) (when width (format "<%d>" width))) width-specs) table)) + ;; now insert the table into the buffer + (goto-char ipos) (let ((content-lines (org-split-string (plist-get params :content) "\n")) recalc) ;; Insert affiliated keywords before the table. @@ -1561,7 +1678,9 @@ PARAMS is a property list of parameters: (insert "\n" line) (unless recalc (setq recalc t)))))) (when recalc (org-table-recalculate 'all t)) - (org-table-align))))) + (org-table-align) + (when (seq-find #'identity width-specs) + (org-table-shrink)))))) ;;;###autoload (defun org-columns-insert-dblock () diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index e9f68518e6f..d6620f9627f 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -52,9 +52,15 @@ (declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-element-at-point-no-context "org-element" (&optional pom)) (declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-lineage "org-element" (blob &optional types with-self)) -(declare-function org-element-type "org-element" (element)) -(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-lineage "org-element-ast" (blob &optional types with-self)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) +(declare-function org-element-type-p "org-element-ast" (node types)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-begin "org-element" (node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-contents-begin "org-element" (node)) +(declare-function org-element-contents-end "org-element" (node)) +(declare-function org-element-post-affiliated "org-element" (node)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) (declare-function org-get-tags "org" (&optional pos local)) @@ -71,6 +77,7 @@ (declare-function outline-next-heading "outline" ()) (declare-function speedbar-line-directory "speedbar" (&optional depth)) (declare-function table--at-cell-p "table" (position &optional object at-column)) +(declare-function ob-clojure-eval-with-cmd "ob-clojure" (cmd expanded)) (declare-function org-fold-folded-p "org-fold" (&optional pos spec-or-alias)) (declare-function org-fold-hide-sublevels "org-fold" (levels)) (declare-function org-fold-hide-subtree "org-fold" ()) @@ -96,6 +103,25 @@ ;;; Emacs < 29 compatibility +(if (fboundp 'display-buffer-full-frame) + (defalias 'org-display-buffer-full-frame #'display-buffer-full-frame) + (defun org-display-buffer-full-frame (buffer alist) + "Display BUFFER in the current frame, taking the entire frame. +ALIST is an association list of action symbols and values. See +Info node `(elisp) Buffer Display Action Alists' for details of +such alists. + +This is an action function for buffer display, see Info +node `(elisp) Buffer Display Action Functions'. It should be +called only by `display-buffer' or a function directly or +indirectly called by the latter." + (when-let ((window (or (display-buffer-reuse-window buffer alist) + (display-buffer-same-window buffer alist) + (display-buffer-pop-up-window buffer alist) + (display-buffer-use-some-window buffer alist)))) + (delete-other-windows window) + window))) + (defvar org-file-has-changed-p--hash-table (make-hash-table :test #'equal) "Internal variable used by `org-file-has-changed-p'.") @@ -130,9 +156,41 @@ Upper-case and lower-case letters are treated as equal. Unibyte strings are converted to multibyte for comparison." (eq t (compare-strings string1 0 nil string2 0 nil t)))) +(defun org-buffer-text-pixel-width () + "Return pixel width of text in current buffer. +This function uses `buffer-text-pixel-size', when available, and falls +back to `window-text-pixel-size' otherwise." + (if (fboundp 'buffer-text-pixel-size) + (car (buffer-text-pixel-size nil nil t)) + (if (get-buffer-window (current-buffer)) + ;; FIXME: 10000 because `most-positive-fixnum' ain't working + ;; (tests failing) and this call will be removed after we drop + ;; Emacs 28 support anyway. + (car (window-text-pixel-size + nil (point-min) (point-max) 10000)) + (let ((dedicatedp (window-dedicated-p)) + (oldbuffer (window-buffer))) + (unwind-protect + (progn + ;; Do not throw error in dedicated windows. + (set-window-dedicated-p nil nil) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (point-min) (point-max) 10000))) + (set-window-buffer nil oldbuffer) + (set-window-dedicated-p nil dedicatedp)))))) + ;;; Emacs < 28.1 compatibility +(if (= 2 (cdr (subr-arity (symbol-function 'get-buffer-create)))) + ;; Emacs >27. + (defalias 'org-get-buffer-create #'get-buffer-create) + (defun org-get-buffer-create (buffer-or-name &optional _) + "Call `get-buffer-create' with BUFFER-OR-NAME argument. +Ignore optional argument." + (get-buffer-create buffer-or-name))) + (if (fboundp 'file-name-concat) (defalias 'org-file-name-concat #'file-name-concat) (defun org-file-name-concat (directory &rest components) @@ -204,6 +262,25 @@ removed." `(progn ,@body)) (defalias 'org-combine-change-calls 'combine-change-calls)) +;; `flatten-tree' was added in Emacs 27.1. +(if (fboundp 'flatten-tree) + (defalias 'org--flatten-tree #'flatten-tree) + ;; The implementation is taken from Emacs subr.el 8664ba18c7c5. + (defun org--flatten-tree (tree) + "Return a \"flattened\" copy of TREE. + +A `flatten-tree' polyfill for compatibility with Emacs versions +older than 27.1" + (let (elems) + (while (consp tree) + (let ((elem (pop tree))) + (while (consp elem) + (push (cdr elem) tree) + (setq elem (car elem))) + (if elem (push elem elems)))) + (if tree (push tree elems)) + (nreverse elems)))) + (if (version< emacs-version "27.1") (defsubst org-replace-buffer-contents (source &optional _max-secs _max-costs) (replace-buffer-contents source)) @@ -290,6 +367,24 @@ Execute BODY, and unwind connection-local variables." `(with-connection-local-profiles (connection-local-get-profiles nil) ,@body))) +;; assoc-delete-all missing from 26.1 +(if (fboundp 'assoc-delete-all) + (defalias 'org-assoc-delete-all 'assoc-delete-all) + ;; from compat/compat-27.el + (defun org-assoc-delete-all (key alist &optional test) + "Delete all matching key from alist, default test equal" + (unless test (setq test #'equal)) + (while (and (consp (car alist)) + (funcall test (caar alist) key)) + (setq alist (cdr alist))) + (let ((tail alist) tail-cdr) + (while (setq tail-cdr (cdr tail)) + (if (and (consp (car tail-cdr)) + (funcall test (caar tail-cdr) key)) + (setcdr tail (cdr tail-cdr)) + (setq tail tail-cdr)))) + alist)) + ;;; Emacs < 26.1 compatibility @@ -386,6 +481,10 @@ Counting starts at 1." (define-obsolete-function-alias 'org-string-match-p 'string-match-p "9.0") ;;;; Functions and variables from previous releases now obsolete. +(define-obsolete-variable-alias 'org-export-ignored-local-variables + 'org-element-ignored-local-variables "Org 9.7") +(define-obsolete-function-alias 'org-habit-get-priority + 'org-habit-get-urgency "Org 9.7") (define-obsolete-function-alias 'org-timestamp-format 'org-format-timestamp "Org 9.6") (define-obsolete-variable-alias 'org-export-before-processing-hook @@ -411,7 +510,7 @@ Counting starts at 1." 'completing-read "9.0") (define-obsolete-function-alias 'org-iread-file-name 'read-file-name "9.0") (define-obsolete-function-alias 'org-days-to-time - 'org-time-stamp-to-now "8.2") + 'org-timestamp-to-now "8.2") (define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties 'org-agenda-ignore-properties "9.0") (define-obsolete-function-alias 'org-preview-latex-fragment @@ -549,10 +648,51 @@ Counting starts at 1." (define-obsolete-function-alias 'org-file-url-p 'org-url-p "9.6") (define-obsolete-variable-alias 'org-plantuml-executable-args 'org-plantuml-args "Org 9.6") + +(defvar org-cached-props nil) +(defvar org-use-property-inheritance) +(declare-function org-entry-get "org" (epom property &optional inherit literal-nil)) +(declare-function org-entry-properties "org" (&optional epom which)) +(defun org-cached-entry-get (pom property) + (if (or (eq t org-use-property-inheritance) + (and (stringp org-use-property-inheritance) + (let ((case-fold-search t)) + (string-match-p org-use-property-inheritance property))) + (and (listp org-use-property-inheritance) + (member-ignore-case property org-use-property-inheritance))) + ;; Caching is not possible, check it directly. + (org-entry-get pom property 'inherit) + ;; Get all properties, so we can do complicated checks easily. + (cdr (assoc-string property + (or org-cached-props + (setq org-cached-props (org-entry-properties pom))) + t)))) + +(make-obsolete 'org-cached-entry-get + "Performs badly. Instead use `org-entry-get' with the argument INHERIT set to `selective'" + "9.7") + +(defconst org-latex-line-break-safe "\\\\[0pt]" + "Linebreak protecting the following [...]. + +Without \"[0pt]\" it would be interpreted as an optional argument to +the \\\\. + +This constant, for example, makes the below code not err: + +\\begin{tabular}{c|c} + [t] & s\\\\[0pt] + [I] & A\\\\[0pt] + [m] & kg +\\end{tabular}") +(make-obsolete 'org-latex-line-break-safe + "should not be used - it is not safe in all the scenarios." + "9.7") + (defun org-in-fixed-width-region-p () "Non-nil if point in a fixed-width region." (save-match-data - (eq 'fixed-width (org-element-type (org-element-at-point))))) + (org-element-type-p (org-element-at-point) 'fixed-width))) (make-obsolete 'org-in-fixed-width-region-p "use `org-element' library" "9.0") @@ -570,6 +710,26 @@ Counting starts at 1." (make-obsolete 'org-let "to be removed" "9.6") (make-obsolete 'org-let2 "to be removed" "9.6") +(define-obsolete-function-alias 'org--math-always-on + 'org--math-p "9.7") + +(defmacro org-no-popups (&rest body) + "Suppress popup windows and evaluate BODY." + `(let (pop-up-frames pop-up-windows) + ,@body)) +(make-obsolete 'org-no-popups "no longer used" "9.7") + +(defun org-switch-to-buffer-other-window (&rest args) + "Switch to buffer in a second window on the current frame. +In particular, do not allow pop-up frames. +Returns the newly created buffer." + (let (pop-up-frames pop-up-windows) + (apply #'switch-to-buffer-other-window args))) + (make-obsolete 'org-switch-to-buffer-other-window "no longer used" "9.7") + +(make-obsolete 'org-refresh-category-properties "no longer used" "9.7") +(make-obsolete 'org-refresh-effort-properties "no longer used" "9.7") + (defun org-compatible-face (inherits specs) "Make a compatible face specification. If INHERITS is an existing face and if the Emacs version supports @@ -616,7 +776,7 @@ See `org-link-parameters' for documentation on the other parameters." (defun org-table-recognize-table.el () "If there is a table.el table nearby, recognize it and move into it." (when (org-at-table.el-p) - (beginning-of-line) + (forward-line 0) (unless (or (looking-at org-table-dataline-regexp) (not (looking-at org-table1-hline-regexp))) (forward-line) @@ -658,13 +818,23 @@ See `org-link-parameters' for documentation on the other parameters." (org-unbracket-string "<" ">" s)) (make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "9.0") +(defcustom org-capture-bookmark t + "When non-nil, add bookmark pointing at the last stored position when capturing." + :group 'org-capture + :version "24.3" + :type 'boolean) +(make-obsolete-variable + 'org-capture-bookmark + "use `org-bookmark-names-plist' instead." + "9.7") + (defcustom org-publish-sitemap-file-entry-format "%t" "Format string for site-map file entry. You could use brackets to delimit on what part the link will be. %t is the title. %a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." +%d is the date." :group 'org-export-publish :type 'string) (make-obsolete-variable @@ -881,21 +1051,21 @@ When optional argument ELEMENT is a parsed drawer, as returned by When buffer positions BEG and END are provided, hide or show that region as a drawer without further ado." (declare (obsolete "use `org-hide-drawer-toggle' instead." "9.4")) - (if (and beg end) (org-fold-region beg end flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline)) + (if (and beg end) (org-fold-region beg end flag 'drawer) (let ((drawer (or element (and (save-excursion - (beginning-of-line) + (forward-line 0) (looking-at-p "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$")) (org-element-at-point))))) - (when (memq (org-element-type drawer) '(drawer property-drawer)) - (let ((post (org-element-property :post-affiliated drawer))) + (when (org-element-type-p drawer '(drawer property-drawer)) + (let ((post (org-element-post-affiliated drawer))) (org-fold-region (save-excursion (goto-char post) (line-end-position)) - (save-excursion (goto-char (org-element-property :end drawer)) + (save-excursion (goto-char (org-element-end drawer)) (skip-chars-backward " \t\n") (line-end-position)) - flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline)) + flag 'drawer) ;; When the drawer is hidden away, make sure point lies in ;; a visible part of the buffer. (when (invisible-p (max (1- (point)) (point-min))) @@ -919,7 +1089,7 @@ an error. Return a non-nil value when toggling is successful." (goto-char start) (while (and (< (point) end) (re-search-forward "^[ \t]*#\\+begin_?\ -\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" end t)) +\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\(\\(?:.\\|\n\\)+?\\)#\\+end_?\\1[ \t]*$" end t)) (save-excursion (save-match-data (goto-char (match-beginning 0)) @@ -1116,6 +1286,26 @@ context. See the individual commands for more information." (make-obsolete-variable 'org-latex-polyglossia-language-alist "set `org-latex-language-alist' instead." "9.6") +(defconst org-babel-python-mode 'python + "Python mode for use in running python interactively.") + +(make-obsolete-variable + 'org-babel-python-mode + "Only the built-in Python mode is supported in ob-python now." + "9.7") + +(define-obsolete-function-alias 'ob-clojure-eval-with-babashka + #'ob-clojure-eval-with-cmd "9.7") + +(define-obsolete-function-alias 'org-export-get-parent + 'org-element-parent "9.7") +(define-obsolete-function-alias 'org-export-get-parent-element + 'org-element-parent-element "9.7") + +(define-obsolete-function-alias 'org-print-speed-command + 'org--print-speed-command "9.7" + "Internal function. Subject of unannounced changes.") + ;;;; Obsolete link types (eval-after-load 'ol @@ -1366,7 +1556,7 @@ ELEMENT is the element at point." ;; Only in inline footnotes, within the definition. (and (eq (org-element-property :type object) 'inline) (< (save-excursion - (goto-char (org-element-property :begin object)) + (goto-char (org-element-begin object)) (search-forward ":" nil t 2)) (point)))) (otherwise t)))) @@ -1375,7 +1565,7 @@ ELEMENT is the element at point." "Function used for `flyspell-generic-check-word-predicate'." (if (org-at-heading-p) ;; At a headline or an inlinetask, check title only. - (and (save-excursion (beginning-of-line) + (and (save-excursion (forward-line 0) (and (let ((case-fold-search t)) (not (looking-at-p "\\*+ END[ \t]*$"))) (let ((case-fold-search nil)) @@ -1387,19 +1577,19 @@ ELEMENT is the element at point." ;; Ignore checks in code, verbatim and others. (org--flyspell-object-check-p (org-element-at-point-no-context))) (let* ((element (org-element-at-point-no-context)) - (post-affiliated (org-element-property :post-affiliated element))) + (post-affiliated (org-element-post-affiliated element))) (cond ;; Ignore checks in all affiliated keywords but captions. ((< (point) post-affiliated) (and (save-excursion - (beginning-of-line) + (forward-line 0) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:"))) (> (point) (match-end 0)) (org--flyspell-object-check-p element))) ;; Ignore checks in LOGBOOK (or equivalent) drawer. ((let ((log (org-log-into-drawer))) (and log - (let ((drawer (org-element-lineage element '(drawer)))) + (let ((drawer (org-element-lineage element 'drawer))) (and drawer (org-string-equal-ignore-case log (org-element-property :drawer-name drawer)))))) @@ -1413,7 +1603,7 @@ ELEMENT is the element at point." (save-excursion (end-of-line) (skip-chars-forward " \r\t\n") - (< (point) (org-element-property :end element))))) + (< (point) (org-element-end element))))) ;; Arbitrary list of keywords where checks are meaningful. ;; Make sure point is on the value part of the element. (keyword @@ -1425,8 +1615,8 @@ ELEMENT is the element at point." ;; table rows (after affiliated keywords) but some objects ;; must not be affected. ((paragraph table-row verse-block) - (let ((cbeg (org-element-property :contents-begin element)) - (cend (org-element-property :contents-end element))) + (let ((cbeg (org-element-contents-begin element)) + (cend (org-element-contents-end element))) (and cbeg (>= (point) cbeg) (< (point) cend) (org--flyspell-object-check-p element)))))))))) (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) @@ -1561,7 +1751,7 @@ key." "Run `org-back-to-heading' when in org-mode." (if (derived-mode-p 'org-mode) (progn - (beginning-of-line) + (forward-line 0) (or (org-at-heading-p (not invisible-ok)) (let (found) (save-excursion diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index ccf1dc63386..797f8a9912d 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -71,16 +71,18 @@ (defvar epg-context) (declare-function org-back-over-empty-lines "org" ()) +(declare-function org-current-level "org" ()) (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-before-first-heading-p "org" ()) (declare-function org-end-of-meta-data "org" (&optional full)) -(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) +(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading element)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-fold-subtree "org-fold" (flag)) -(declare-function org-make-tags-matcher "org" (match)) +(declare-function org-make-tags-matcher "org" (match &optional only-local-tags)) (declare-function org-previous-visible-heading "org" (arg)) (declare-function org-scan-tags "org" (action matcher todo-only &optional start-level)) (declare-function org-set-property "org" (property value)) +(declare-function org-cycle-set-startup-visibility "org-cycle" ()) (defgroup org-crypt nil "Org Crypt." @@ -113,16 +115,16 @@ This setting can be overridden in the CRYPTKEY property." (defcustom org-crypt-disable-auto-save 'ask "What org-decrypt should do if `auto-save-mode' is enabled. -t : Disable auto-save-mode for the current buffer +t : Disable `auto-save-mode' for the current buffer prior to decrypting an entry. -nil : Leave auto-save-mode enabled. +nil : Leave `auto-save-mode' enabled. This may cause data to be written to disk unencrypted! -`ask' : Ask user whether or not to disable auto-save-mode +`ask' : Ask user whether or not to disable `auto-save-mode' for the current buffer. -`encrypt': Leave auto-save-mode enabled for the current buffer, +`encrypt': Leave `auto-save-mode' enabled for the current buffer, but automatically re-encrypt all decrypted entries *before* auto-saving. NOTE: This only works for entries which have a tag @@ -165,7 +167,7 @@ and END are buffer positions delimiting the encrypted area." (cons start (line-beginning-position 2))))))))) (defun org-crypt-check-auto-save () - "Check whether auto-save-mode is enabled for the current buffer. + "Check whether `auto-save-mode' is enabled for the current buffer. `auto-save-mode' may cause leakage when decrypting entries, so check whether it's enabled, and decide what to do about it. @@ -177,7 +179,7 @@ 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 "org-decrypt: Disabling auto-save-mode for %s" (or (buffer-file-name) (current-buffer))) ;; The argument to auto-save-mode has to be "-1", since @@ -244,12 +246,13 @@ Assume `epg-context' is set." ;; contents in the buffer. (error (insert contents) - (error (error-message-string err))))) + (error "%s" (error-message-string err))))) (when folded-heading (goto-char folded-heading) (org-fold-subtree t)) nil))))) +(defvar org-outline-regexp-bol) ;;;###autoload (defun org-decrypt-entry () "Decrypt the content of the current headline." @@ -265,23 +268,44 @@ Assume `epg-context' is set." (save-excursion (org-previous-visible-heading 1) (point)))) + (level (org-current-level)) (encrypted-text (org-crypt--encrypted-text beg end)) (decrypted-text (decode-coding-string (epg-decrypt-string epg-context encrypted-text) - 'utf-8))) + 'utf-8)) + origin-marker) ;; Delete region starting just before point, because the ;; 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 allows reusing the same encrypted text if the - ;; text does not change, and therefore avoid a re-encryption - ;; process. - (insert "\n" - (propertize decrypted-text - 'org-crypt-checksum (sha1 decrypted-text) - 'org-crypt-key (org-crypt-key-for-heading) - 'org-crypt-text encrypted-text)) + (setq origin-marker (point-marker)) + (if (string-match (org-headline-re level) decrypted-text) + ;; If decrypted text contains other headings with levels + ;; below LEVEL, adjust the subtree. + (let ((start 0) (min-level level)) + (while (string-match (org-headline-re level) decrypted-text start) + (setq min-level (min min-level (1- (length (match-string 0 decrypted-text)))) + start (match-end 0))) + (insert "\n" + (replace-regexp-in-string + org-outline-regexp-bol + (concat (make-string (1+ (- level min-level)) ?*) "\\&") + decrypted-text))) + ;; Store a checksum of the decrypted and the encrypted text + ;; value. This allows reusing the same encrypted text if the + ;; text does not change, and therefore avoid a re-encryption + ;; process. + (insert "\n" + (propertize decrypted-text + 'org-crypt-checksum (sha1 decrypted-text) + 'org-crypt-key (org-crypt-key-for-heading) + 'org-crypt-text encrypted-text))) + ;; Apply initial visibility. + (save-restriction + (narrow-to-region origin-marker (point)) + (set-marker origin-marker nil) + (org-cycle-set-startup-visibility)) + ;; ... but keep the previous folded state. (when folded-heading (goto-char folded-heading) (org-fold-subtree t)) diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 2417353ee5d..98a00d2c3b2 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -28,7 +28,7 @@ ;; ;; Allows Org mode to make use of the Emacs `etags' system. Defines ;; tag destinations in Org files as any text between <>. This allows the tags-generation program `exuberant +;; 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 <> within the same file @@ -57,6 +57,12 @@ ;; (add-hook 'org-mode-hook ;; (lambda () ;; (define-key org-mode-map "\C-co" 'org-ctags-find-tag-interactive))) +;; (with-eval-after-load "org-ctags" +;; (org-ctags-enable)) +;; +;; To activate the library, you need to call `org-ctags-enable' explicitly. +;; It used to be invoked during library loading, but it was against Emacs +;; policy and caused inconvenience of Org users who do not use `org-ctags'. ;; ;; By default, with org-ctags loaded, org will first try and visit the tag ;; with the same name as the link; then, if unsuccessful, ask the user if @@ -66,7 +72,7 @@ ;; search the entire text of the current buffer for 'tag'. ;; ;; This behavior can be modified by changing the value of -;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example I have the following in my +;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example, I have the following in my ;; .emacs, which describes the same behavior as the above paragraph with ;; one difference: ;; @@ -149,20 +155,36 @@ (defvar org-ctags-enabled-p t "Activate ctags support in org mode?") -(defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/" +(defvar org-ctags-tag-regexp "/<<([^<>]+)>>/\\1/d,definition/" "Regexp expression used by ctags external program. The regexp matches tag destinations in Org files. Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/ See the ctags documentation for more information.") (defcustom org-ctags-path-to-ctags - (if (executable-find "ctags-exuberant") - "ctags-exuberant" - ctags-program-name) + (cond ((executable-find "ctags-exuberant") + "ctags-exuberant") + ((boundp 'ctags-program-name) + ctags-program-name) + (t "ctags")) ; Emacs < 30 "Name of the ctags executable file." :version "24.1" :type 'file) +(defconst org-ctags--open-link-functions-list + (list + #'org-ctags-find-tag + #'org-ctags-ask-rebuild-tags-file-then-find-tag + #'org-ctags-rebuild-tags-file-then-find-tag + #'org-ctags-ask-append-topic + #'org-ctags-append-topic + #'org-ctags-ask-visit-buffer-or-file + #'org-ctags-visit-buffer-or-file + #'org-ctags-fail-silently) + "Options for `org-open-link-functions'. +Ensure that the user option and `unload-feature' +use the same set of functions.") + (defcustom org-ctags-open-link-functions '(org-ctags-find-tag org-ctags-ask-rebuild-tags-file-then-find-tag @@ -170,14 +192,7 @@ See the ctags documentation for more information.") "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS by ORG-CTAGS." :version "24.1" :type 'hook - :options '(org-ctags-find-tag - org-ctags-ask-rebuild-tags-file-then-find-tag - org-ctags-rebuild-tags-file-then-find-tag - org-ctags-ask-append-topic - org-ctags-append-topic - org-ctags-ask-visit-buffer-or-file - org-ctags-visit-buffer-or-file - org-ctags-fail-silently)) + :options org-ctags--open-link-functions-list) (defvar org-ctags-tag-list nil @@ -193,21 +208,21 @@ The following patterns are replaced in the string: :type 'string) -(add-hook 'org-mode-hook - (lambda () - (when (and org-ctags-enabled-p - (buffer-file-name)) - ;; Make sure this file's directory is added to default - ;; directories in which to search for tags. - (let ((tags-filename - (expand-file-name - (concat (file-name-directory (buffer-file-name)) - "/TAGS")))) - (when (file-exists-p tags-filename) - (visit-tags-table tags-filename)))))) +(defun org-ctags--visit-tags-table () + "Load tags for current file. +A function for `org-mode-hook." + (when (and org-ctags-enabled-p + (buffer-file-name)) + ;; Make sure this file's directory is added to default + ;; directories in which to search for tags. + (let ((tags-filename + (expand-file-name + (concat (file-name-directory (buffer-file-name)) + "/TAGS")))) + (when (file-exists-p tags-filename) + (visit-tags-table tags-filename))))) -(advice-add 'visit-tags-table :after #'org--ctags-load-tag-list) (defun org--ctags-load-tag-list (&rest _) (when (and org-ctags-enabled-p tags-file-name) (setq-local org-ctags-tag-list @@ -215,12 +230,28 @@ The following patterns are replaced in the string: (defun org-ctags-enable () + (add-hook 'org-mode-hook #'org-ctags--visit-tags-table) + (advice-add 'visit-tags-table :after #'org--ctags-load-tag-list) + (advice-add 'xref-find-definitions :before + #'org--ctags-set-org-mark-before-finding-tag) + (put 'org-mode 'find-tag-default-function 'org-ctags-find-tag-at-point) (setq org-ctags-enabled-p t) (dolist (fn org-ctags-open-link-functions) (add-hook 'org-open-link-functions fn t))) +(defun org-ctags-unload-function () + "Disable `org-ctags' library. +Called by `unload-feature'." + (put 'org-mode 'find-tag-default-function nil) + (advice-remove 'visit-tags-table #'org--ctags-load-tag-list) + (advice-remove 'xref-find-definitions + #'org--ctags-set-org-mark-before-finding-tag) + (dolist (fn org-ctags--open-link-functions-list) + (remove-hook 'org-open-link-functions fn nil))) + + ;;; General utility functions. =============================================== ;; These work outside org-ctags mode. @@ -296,8 +327,6 @@ The new topic will be titled NAME (or TITLE if supplied)." ;;;; Misc interoperability with etags system ================================= -(advice-add 'xref-find-definitions :before - #'org--ctags-set-org-mark-before-finding-tag) (defun org--ctags-set-org-mark-before-finding-tag (&rest _) "Before trying to find a tag, save our current position on org mark ring." (save-excursion @@ -479,18 +508,21 @@ function may take several seconds to finish if the directory or its subdirectories contain large numbers of taggable files." (interactive) (cl-assert (buffer-file-name)) - (let ((dir-name (or directory-name - (file-name-directory (buffer-file-name)))) + (let ((dir-name (shell-quote-argument + (expand-file-name + (if directory-name + (file-name-as-directory directory-name) + (file-name-directory (buffer-file-name)))))) (exitcode nil)) (save-excursion (setq exitcode (shell-command (format (concat "%s --langdef=orgmode --langmap=orgmode:.org " - "--regex-orgmode=\"%s\" -f \"%s\" -e -R \"%s\"") + "--regex-orgmode=%s -f %sTAGS -e -R %s*") org-ctags-path-to-ctags - org-ctags-tag-regexp - (expand-file-name (concat dir-name "/TAGS")) - (expand-file-name (concat dir-name "/*"))))) + (shell-quote-argument org-ctags-tag-regexp) + dir-name + dir-name))) (cond ((eql 0 exitcode) (setq-local org-ctags-tag-list @@ -508,12 +540,11 @@ its subdirectories contain large numbers of taggable files." (defun org-ctags-find-tag-interactive () "Prompt for the name of a tag, with autocompletion, then visit the named tag. -Uses `ido-mode' if available. If the user enters a string that does not match an existing tag, create a new topic." (interactive) - (let* ((tag (ido-completing-read "Topic: " org-ctags-tag-list - nil 'confirm nil 'org-ctags-find-tag-history))) + (let* ((tag (completing-read "Topic: " org-ctags-tag-list + nil 'confirm nil 'org-ctags-find-tag-history))) (when tag (cond ((member tag org-ctags-tag-list) @@ -526,8 +557,6 @@ a new topic." 'org-open-link-functions tag)))))) -(org-ctags-enable) - (provide 'org-ctags) ;;; org-ctags.el ends here diff --git a/lisp/org/org-cycle.el b/lisp/org/org-cycle.el index 53e086552f6..b325b042d83 100644 --- a/lisp/org/org-cycle.el +++ b/lisp/org/org-cycle.el @@ -2,7 +2,7 @@ ;; ;; Copyright (C) 2020-2024 Free Software Foundation, Inc. ;; -;; Maintainer: Ihor Radchenko +;; Maintainer: Ihor Radchenko ;; Keywords: folding, visibility cycling, invisible text ;; URL: https://orgmode.org ;; @@ -35,9 +35,10 @@ (require 'org-macs) (require 'org-fold) -(declare-function org-element-type "org-element" (element)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-lineage "org-element" (datum &optional types with-self)) +(declare-function org-element-type-p "org-element-ast" (node types)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-post-affiliated "org-element" (node)) +(declare-function org-element-lineage "org-element-ast" (datum &optional types with-self)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-display-inline-images "org" (&optional include-linked refresh beg end)) (declare-function org-get-tags "org" (&optional pos local fontify)) @@ -115,6 +116,7 @@ than its value." (const :tag "No limit" nil) (integer :tag "Maximum level"))) +(defvaralias 'org-hide-block-startup 'org-cycle-hide-block-startup) (defcustom org-cycle-hide-block-startup nil "Non-nil means entering Org mode will fold all blocks. This can also be set in on a per-file basis with @@ -125,6 +127,7 @@ This can also be set in on a per-file basis with :group 'org-cycle :type 'boolean) +(defvaralias 'org-hide-drawer-startup 'org-cycle-hide-drawer-startup) (defcustom org-cycle-hide-drawer-startup t "Non-nil means entering Org mode will fold all drawers. This can also be set in on a per-file basis with @@ -200,6 +203,7 @@ Special case: when 0, never leave empty lines in collapsed view." :type 'integer) (put 'org-cycle-separator-lines 'safe-local-variable 'integerp) +(defvaralias 'org-pre-cycle-hook 'org-cycle-pre-hook) (defcustom org-cycle-pre-hook nil "Hook that is run before visibility cycling is happening. The function(s) in this hook must accept a single argument which indicates @@ -240,6 +244,7 @@ normal outline commands like `show-all', but not with the cycling commands." :package-version '(Org . "9.6") :type 'boolean) +(defvaralias 'org-tab-first-hook 'org-cycle-tab-first-hook) (defvar org-cycle-tab-first-hook nil "Hook for functions to attach themselves to TAB. See `org-ctrl-c-ctrl-c-hook' for more information. @@ -335,6 +340,10 @@ same as `S-TAB') also when called without prefix argument." (and org-cycle-level-after-item/entry-creation (or (org-cycle-level) (org-cycle-item-indentation)))) + (when (and org-cycle-max-level + (or (not (integerp org-cycle-max-level)) + (< org-cycle-max-level 1))) + (user-error "`org-cycle-max-level' must be a positive integer")) (let* ((limit-level (or org-cycle-max-level (and (boundp 'org-inlinetask-min-level) @@ -388,8 +397,8 @@ same as `S-TAB') also when called without prefix argument." ((org-fold-hide-drawer-toggle nil t element)) ;; Table: enter it or move to the next field. ((and (org-match-line "[ \t]*[|+]") - (org-element-lineage element '(table) t)) - (if (and (eq 'table (org-element-type element)) + (org-element-lineage element 'table t)) + (if (and (org-element-type-p element 'table) (eq 'table.el (org-element-property :type element))) (message (substitute-command-keys "\\\ Use `\\[org-edit-special]' to edit table.el tables")) @@ -404,8 +413,8 @@ Use `\\[org-edit-special]' to edit table.el tables")) t))) (and item (= (line-beginning-position) - (org-element-property :post-affiliated - item))))) + (org-element-post-affiliated + item))))) (org-match-line org-outline-regexp)) (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) (org-cycle-internal-local)) @@ -421,7 +430,7 @@ Use `\\[org-edit-special]' to edit table.el tables")) (call-interactively (global-key-binding (kbd "TAB")))) ((or (eq org-cycle-emulate-tab t) (and (memq org-cycle-emulate-tab '(white whitestart)) - (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) + (save-excursion (forward-line 0) (looking-at "[ \t]*")) (or (and (eq org-cycle-emulate-tab 'white) (= (match-end 0) (line-end-position))) (and (eq org-cycle-emulate-tab 'whitestart) @@ -480,7 +489,7 @@ Use `\\[org-edit-special]' to edit table.el tables")) (save-excursion (if (org-at-item-p) (progn - (beginning-of-line) + (forward-line 0) (setq struct (org-list-struct)) (setq eoh (line-end-position)) (setq eos (org-list-get-item-end-before-blank (point) struct)) @@ -502,16 +511,16 @@ Use `\\[org-edit-special]' to edit table.el tables")) (save-excursion (org-list-search-forward (org-item-beginning-re) eos t)))))) ;; Determine end invisible part of buffer (EOL) - (beginning-of-line 2) + (forward-line 1) (if (eq org-fold-core-style 'text-properties) (while (and (not (eobp)) ;this is like `next-line' (org-fold-folded-p (1- (point)))) (goto-char (org-fold-next-visibility-change nil nil t)) - (and (eolp) (beginning-of-line 2))) + (and (eolp) (forward-line 1))) (while (and (not (eobp)) ;this is like `next-line' (get-char-property (1- (point)) 'invisible)) (goto-char (next-single-char-property-change (point) 'invisible)) - (and (eolp) (beginning-of-line 2)))) + (and (eolp) (forward-line 1)))) (setq eol (point))) ;; Find out what to do next and set `this-command' (cond @@ -545,7 +554,7 @@ Use `\\[org-edit-special]' to edit table.el tables")) (save-excursion (org-back-to-heading) (while (org-list-search-forward (org-item-beginning-re) eos t) - (beginning-of-line 1) + (forward-line 0) (let* ((struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) (end (org-list-get-bottom-point struct))) @@ -608,7 +617,9 @@ With a numeric prefix, show all headlines up to that level." (defun org-cycle-set-startup-visibility () "Set the visibility required by startup options and properties." (cond - ((eq org-startup-folded t) + ;; `fold' is technically not allowed value, but it is often + ;; intuitively tried by users by analogy with #+STARTUP: fold. + ((memq org-startup-folded '(t fold overview)) (org-cycle-overview)) ((eq org-startup-folded 'content) (org-cycle-content)) @@ -620,8 +631,10 @@ With a numeric prefix, show all headlines up to that level." (org-cycle-content 4)) ((eq org-startup-folded 'show5levels) (org-cycle-content 5)) - ((or (eq org-startup-folded 'showeverything) - (eq org-startup-folded nil)) + ;; `nofold' and `showall' are technically not allowed values, but + ;; they are often intuitively tried by users by analogy with + ;; #+STARTUP: nofold or #STARUP: showall. + ((memq org-startup-folded '(showeverything nil nofold showall)) (org-fold-show-all))) (unless (eq org-startup-folded 'showeverything) (when org-cycle-hide-block-startup (org-fold-hide-block-all)) @@ -634,20 +647,21 @@ With a numeric prefix, show all headlines up to that level." "Switch subtree visibility according to VISIBILITY property." (interactive) (let ((regexp (org-re-property "VISIBILITY"))) - (org-with-point-at 1 + (save-excursion + (goto-char (point-min)) (while (re-search-forward regexp nil t) - (let ((state (match-string 3))) + (let ((state (match-string 3))) (if (not (org-at-property-p)) (outline-next-heading) (save-excursion (org-back-to-heading t) (org-fold-subtree t) (pcase state - ("folded" + ("folded" (org-fold-subtree t)) - ("children" + ("children" (org-fold-show-hidden-entry) (org-fold-show-children)) - ("content" + ("content" ;; Newline before heading will be outside the ;; narrowing. Make sure that it is revealed. (org-fold-heading nil) @@ -655,10 +669,9 @@ With a numeric prefix, show all headlines up to that level." (save-restriction (org-narrow-to-subtree) (org-cycle-content)))) - ((or "all" "showall") + ((or "all" "showall") (org-fold-show-subtree)) - (_ nil))) - (org-end-of-subtree))))))) + (_ nil))))))))) (defun org-cycle-overview () "Switch to overview mode, showing only top-level headlines." @@ -683,7 +696,7 @@ With a numeric prefix, show all headlines up to that level." (defun org-cycle-content (&optional arg) "Show all headlines in the buffer, like a table of contents. -With numerical argument N, show content up to level N." +With numerical argument ARG, show content up to level ARG." (interactive "p") (org-fold-show-all '(headings)) (save-excursion @@ -705,7 +718,9 @@ With numerical argument N, show content up to level N." "Temporarily store scroll position to restore.") (defun org-cycle-optimize-window-after-visibility-change (state) "Adjust the window after a change in outline visibility. -This function is the default value of the hook `org-cycle-hook'." +This function is the default value of the hook `org-cycle-hook'. +STATE is the current outline visibility state. It should be one of +symbols `content', `all', `folded', `children', or `subtree'." (when (get-buffer-window (current-buffer)) (let ((repeat (eq last-command this-command))) (unless repeat @@ -791,7 +806,9 @@ STATE should be one of the symbols listed in the docstring of (defun org-cycle-display-inline-images (state) "Auto display inline images under subtree when cycling. -It works when `org-cycle-inline-images-display' is non-nil." +It works when `org-cycle-inline-images-display' is non-nil. +STATE is the current outline visibility state. It should be one of +symbols `content', `all', `folded', `children', or `subtree'." (when org-cycle-inline-images-display (pcase state ('children diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index 90581f1360c..d0cc1fabbcb 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -99,16 +99,15 @@ If time-period is month, then group entries by month." (month (calendar-extract-month d)) (day (calendar-extract-day d))) (org-datetree--find-create - "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\ -\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)" - year) + "\\([12][0-9]\\{3\\}\\)" + year nil nil nil t) (org-datetree--find-create - "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" - year month) + "%d-\\([01][0-9]\\) \\w+" + year month nil nil t) (when (eq time-grouping 'day) (org-datetree--find-create - "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" - year month day))))) + "%d-%02d-\\([0123][0-9]\\) \\w+" + year month day nil t))))) ;;;###autoload (defun org-datetree-find-iso-week-create (d &optional keep-restriction) @@ -147,33 +146,51 @@ will be built under the headline at point." (week (nth 0 iso-date))) ;; ISO 8601 week format is %G-W%V(-%u) (org-datetree--find-create - "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\ -\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)" - weekyear nil nil - (format-time-string "%G" time)) + "\\([12][0-9]\\{3\\}\\)" + weekyear nil nil (format-time-string "%G" time) t) (org-datetree--find-create - "^\\*+[ \t]+%d-W\\([0-5][0-9]\\)$" - weekyear week nil - (format-time-string "%G-W%V" time)) + "%d-W\\([0-5][0-9]\\)" + weekyear week nil (format-time-string "%G-W%V" time) t) ;; For the actual day we use the regular date instead of ISO week. (org-datetree--find-create - "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" - year month day)))) + "%d-%02d-\\([0123][0-9]\\) \\w+" year month day nil t)))) (defun org-datetree--find-create - (regex-template year &optional month day insert) + (regex-template year &optional month day insert match-title) "Find the datetree matched by REGEX-TEMPLATE for YEAR, MONTH, or DAY. REGEX-TEMPLATE is passed to `format' with YEAR, MONTH, and DAY as -arguments. Match group 1 is compared against the specified date +arguments. + +If MATCH-TITLE is non-nil, REGEX-TEMPLATE is matched against +heading title and the exact regexp matched against heading line is: + + (format org-complex-heading-regexp-format + (format regex-template year month day)) + +If MATCH-TITLE is nil, the regexp matched against heading line is +REGEX-TEMPLATE: + + (format regex-template year month day) + +Match group 1 in REGEX-TEMPLATE is compared against the specified date component. If INSERT is non-nil and there is no match then it is inserted into the buffer." (when (or month day) (org-narrow-to-subtree)) - (let ((re (format regex-template year month day)) + ;; ensure that the first match group in REGEX-TEMPLATE + ;; is the first inside `org-complex-heading-regexp-format' + (when (and match-title + (not (string-match-p "\\\\(\\?1:" regex-template)) + (string-match "\\\\(" regex-template)) + (setq regex-template (replace-match "\\(?1:" nil t regex-template))) + (let ((re (if match-title + (format org-complex-heading-regexp-format + (format regex-template year month day)) + (format regex-template year month day))) match) (goto-char (point-min)) (while (and (setq match (re-search-forward re nil t)) - (goto-char (match-beginning 1)) + (goto-char (match-beginning 1)) (< (string-to-number (match-string 1)) (or day month year)))) (cond ((not match) @@ -181,9 +198,9 @@ inserted into the buffer." (unless (bolp) (insert "\n")) (org-datetree-insert-line year month day insert)) ((= (string-to-number (match-string 1)) (or day month year)) - (beginning-of-line)) + (forward-line 0)) (t - (beginning-of-line) + (forward-line 0) (org-datetree-insert-line year month day insert))))) (defun org-datetree-insert-line (year &optional month day text) @@ -205,11 +222,11 @@ inserted into the buffer." (save-excursion (insert "\n") (org-indent-line) - (org-insert-time-stamp + (org-insert-timestamp (org-encode-time 0 0 0 day month year) nil (eq org-datetree-add-timestamp 'inactive)))) - (beginning-of-line)) + (forward-line 0)) (defun org-datetree-file-entry-under (txt d) "Insert a node TXT into the date tree under date D." diff --git a/lisp/org/org-duration.el b/lisp/org/org-duration.el index 1ab84776117..662a94bd583 100644 --- a/lisp/org/org-duration.el +++ b/lisp/org/org-duration.el @@ -324,109 +324,110 @@ When optional argument CANONICAL is non-nil, ignore `org-duration-units' and use standard time units value. Raise an error if expected format is unknown." - (pcase (or fmt org-duration-format) - (`h:mm - (format "%d:%02d" (/ minutes 60) (mod minutes 60))) - (`h:mm:ss - (let* ((whole-minutes (floor minutes)) - (seconds (mod (* 60 minutes) 60))) - (format "%s:%02d" - (org-duration-from-minutes whole-minutes 'h:mm) - seconds))) - ((pred atom) (error "Invalid duration format specification: %S" fmt)) - ;; Mixed format. Call recursively the function on both parts. - ((and duration-format - (let `(special . ,(and mode (or `h:mm:ss `h:mm))) - (assq 'special duration-format))) - (let* ((truncated-format - ;; Remove "special" mode from duration format in order to - ;; recurse properly. Also remove units smaller or equal - ;; to an hour since H:MM part takes care of it. - (cl-remove-if-not - (lambda (pair) - (pcase pair - (`(,(and unit (pred stringp)) . ,_) - (> (org-duration--modifier unit canonical) 60)) - (_ nil))) - duration-format)) - (min-modifier ;smallest modifier above hour - (and truncated-format - (apply #'min - (mapcar (lambda (p) - (org-duration--modifier (car p) canonical)) - truncated-format))))) - (if (or (null min-modifier) (< minutes min-modifier)) - ;; There is not unit above the hour or the smallest unit - ;; above the hour is too large for the number of minutes we - ;; need to represent. Use H:MM or H:MM:SS syntax. - (org-duration-from-minutes minutes mode canonical) - ;; Represent minutes above hour using provided units and H:MM - ;; or H:MM:SS below. - (let* ((units-part (* min-modifier (/ (floor minutes) min-modifier))) - (minutes-part (- minutes units-part)) - (compact (memq 'compact duration-format))) - (concat - (org-duration-from-minutes units-part truncated-format canonical) - (and (not compact) " ") - (org-duration-from-minutes minutes-part mode)))))) - ;; Units format. - (duration-format - (let* ((fractional - (let ((digits (cdr (assq 'special duration-format)))) - (and digits - (or (wholenump digits) - (error "Unknown formatting directive: %S" digits)) - (format "%%.%df" digits)))) - (selected-units - (sort (cl-remove-if - ;; Ignore special format cells and compact option. - (lambda (pair) - (pcase pair - ((or `compact `(special . ,_)) t) - (_ nil))) - duration-format) - (lambda (a b) - (> (org-duration--modifier (car a) canonical) - (org-duration--modifier (car b) canonical))))) - (separator (if (memq 'compact duration-format) "" " "))) - (cond - ;; Fractional duration: use first unit that is either required - ;; or smaller than MINUTES. - (fractional - (let* ((unit (car - (or (cl-find-if - (lambda (pair) - (pcase pair - (`(,u . ,req?) - (or req? - (<= (org-duration--modifier u canonical) - minutes))))) - selected-units) - ;; Fall back to smallest unit. - (org-last selected-units)))) - (modifier (org-duration--modifier unit canonical))) - (concat (format fractional (/ (float minutes) modifier)) unit))) - ;; Otherwise build duration string according to available - ;; units. - ((org-string-nw-p - (org-trim - (mapconcat - (lambda (units) - (pcase-let* ((`(,unit . ,required?) units) - (modifier (org-duration--modifier unit canonical))) - (cond ((<= modifier minutes) - (let ((value (floor minutes modifier))) - (cl-decf minutes (* value modifier)) - (format "%s%d%s" separator value unit))) - (required? (concat separator "0" unit)) - (t "")))) - selected-units - "")))) - ;; No unit can properly represent MINUTES. Use the smallest - ;; one anyway. - (t - (pcase-let ((`((,unit . ,_)) (last selected-units))) - (concat "0" unit)))))))) + (if (< minutes 0) (concat "-" (org-duration-from-minutes (abs minutes) fmt canonical)) + (pcase (or fmt org-duration-format) + (`h:mm + (format "%d:%02d" (/ minutes 60) (mod minutes 60))) + (`h:mm:ss + (let* ((whole-minutes (floor minutes)) + (seconds (mod (* 60 minutes) 60))) + (format "%s:%02d" + (org-duration-from-minutes whole-minutes 'h:mm) + seconds))) + ((pred atom) (error "Invalid duration format specification: %S" fmt)) + ;; Mixed format. Call recursively the function on both parts. + ((and duration-format + (let `(special . ,(and mode (or `h:mm:ss `h:mm))) + (assq 'special duration-format))) + (let* ((truncated-format + ;; Remove "special" mode from duration format in order to + ;; recurse properly. Also remove units smaller or equal + ;; to an hour since H:MM part takes care of it. + (cl-remove-if-not + (lambda (pair) + (pcase pair + (`(,(and unit (pred stringp)) . ,_) + (> (org-duration--modifier unit canonical) 60)) + (_ nil))) + duration-format)) + (min-modifier ;smallest modifier above hour + (and truncated-format + (apply #'min + (mapcar (lambda (p) + (org-duration--modifier (car p) canonical)) + truncated-format))))) + (if (or (null min-modifier) (< minutes min-modifier)) + ;; There is not unit above the hour or the smallest unit + ;; above the hour is too large for the number of minutes we + ;; need to represent. Use H:MM or H:MM:SS syntax. + (org-duration-from-minutes minutes mode canonical) + ;; Represent minutes above hour using provided units and H:MM + ;; or H:MM:SS below. + (let* ((units-part (* min-modifier (/ (floor minutes) min-modifier))) + (minutes-part (- minutes units-part)) + (compact (memq 'compact duration-format))) + (concat + (org-duration-from-minutes units-part truncated-format canonical) + (and (not compact) " ") + (org-duration-from-minutes minutes-part mode)))))) + ;; Units format. + (duration-format + (let* ((fractional + (let ((digits (cdr (assq 'special duration-format)))) + (and digits + (or (wholenump digits) + (error "Unknown formatting directive: %S" digits)) + (format "%%.%df" digits)))) + (selected-units + (sort (cl-remove-if + ;; Ignore special format cells and compact option. + (lambda (pair) + (pcase pair + ((or `compact `(special . ,_)) t) + (_ nil))) + duration-format) + (lambda (a b) + (> (org-duration--modifier (car a) canonical) + (org-duration--modifier (car b) canonical))))) + (separator (if (memq 'compact duration-format) "" " "))) + (cond + ;; Fractional duration: use first unit that is either required + ;; or smaller than MINUTES. + (fractional + (let* ((unit (car + (or (cl-find-if + (lambda (pair) + (pcase pair + (`(,u . ,req?) + (or req? + (<= (org-duration--modifier u canonical) + minutes))))) + selected-units) + ;; Fall back to smallest unit. + (org-last selected-units)))) + (modifier (org-duration--modifier unit canonical))) + (concat (format fractional (/ (float minutes) modifier)) unit))) + ;; Otherwise build duration string according to available + ;; units. + ((org-string-nw-p + (org-trim + (mapconcat + (lambda (units) + (pcase-let* ((`(,unit . ,required?) units) + (modifier (org-duration--modifier unit canonical))) + (cond ((<= modifier minutes) + (let ((value (floor minutes modifier))) + (cl-decf minutes (* value modifier)) + (format "%s%d%s" separator value unit))) + (required? (concat separator "0" unit)) + (t "")))) + selected-units + "")))) + ;; No unit can properly represent MINUTES. Use the smallest + ;; one anyway. + (t + (pcase-let ((`((,unit . ,_)) (last selected-units))) + (concat "0" unit))))))))) ;;;###autoload (defun org-duration-h:mm-only-p (times) diff --git a/lisp/org/org-element-ast.el b/lisp/org/org-element-ast.el new file mode 100644 index 00000000000..fba6b37e662 --- /dev/null +++ b/lisp/org/org-element-ast.el @@ -0,0 +1,1150 @@ +;;; org-element-ast.el --- Abstract syntax tree for Org -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2024 Free Software Foundation, Inc. + +;; Author: Ihor Radchenko +;; Keywords: data, lisp + +;; 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 . + +;;; Commentary: + +;; This file implements Org abstract syntax tree (AST) data structure. +;; +;; Only the most generic aspects of the syntax tree are considered +;; below. The fine details of Org syntax are implemented elsewhere. +;; +;; Org AST is composed of nested syntax nodes. +;; Within actual Org syntax, the nodes can be either headings, +;; elements, or objects. However, historically, we often call syntax +;; nodes simply "elements", unless the context requires clarification +;; about the node type. In particular, many functions below will have +;; naming pattern `org-element-X', implying `org-element-node-X' -- +;; they will apply to all the node types, not just to elements. +;; +;; 1. Syntax nodes +;; ------------------ +;; Each Org syntax node can be represented as a string or list. +;; +;; The main node representation follows the pattern +;; (TYPE PROPERTIES CONTENTS), where +;; TYPE is a symbol describing the node type. +;; PROPERTIES is the property list attached to it. +;; CONTENTS is a list of child syntax nodes contained within the +;; current node, when applicable. +;; +;;; For example, "*bold text* " node can be represented as +;; +;; (bold (:begin 1 :end 14 :post-blank 2 ...) "bold text") +;; +;; TYPE can be any symbol, including symbol not explicitly defined by +;; Org syntax. If TYPE is not a part of the syntax, the syntax +;; node is called "pseudo element/object", but otherwise considered a +;; valid part of Org syntax tree. Search "Pseudo objects and +;; elements" in lisp/ox-latex.el for an example of using pseudo +;; elements. +;; +;; PROPERTIES is a property list (:property1 value1 :property2 value2 ...) +;; holding properties and value. +;; +;; `:standard-properties', `:parent', `:deferred', and `:secondary' +;; properties are treated specially in the code below. +;; +;; `:standard-properties' holds an array with +;; `org-element--standard-properties' values, in the same order. The +;; values in the array have priority over the same properties +;; specified in the property list. You should not rely on the value +;; of `org-element--standard-properties' in the code. +;; `:standard-properties' may or may not be actually present in +;; PROPERTIES. It is mostly used to speed up property access in +;; performance-critical code, as most of the code requesting property +;; values by constant name is inlined. +;; +;; The previous example can also be presented in more compact form as: +;; +;; (bold (:standard-properties [1 10 ... 2 ...]) "bold text") +;; +;; Using an array allows faster access to frequently used properties. +;; +;; `:parent' holds the containing node, for a child node within the +;; AST. It may or may not be present in PROPERTIES. +;; +;; `:secondary' holds a list of properties that may contain extra AST +;; nodes, in addition to the node contents. +;; +;; `:deferred' property describes how to update not-yet-calculated +;; properties on request. +;; +;; +;; Syntax node can also be represented by a string. Strings always +;; represent syntax node of `plain-text' type with contents being nil +;; and properties represented as string properties at position 0. +;; `:standard-properties' are not considered for `plain-text' nodes as +;; `plain-text' nodes tend to hold much fewer properties. +;; +;; In the above example, `plain-text' node "bold text" is more +;; accurately represented as +;; +;; #("bold text" 0 9 (:parent (bold ...))) +;; +;; with :parent property value pointing back to the containing `bold' +;; node. +;; +;; `anonymous' syntax node is represented as a list with `car' +;; containing another syntax node. Such node has nil type, does not +;; have properties, and its contents is a list of the contained syntax +;; node. `:parent' property of the contained nodes point back to the +;; list itself, except when `anonymous' node holds secondary value +;; (see below), in which case the `:parent' property is set to be the +;; containing node in the AST. +;; +;; Any node representation other then described above is not +;; considered as Org syntax node. +;; +;; 2. Deferred values +;; ------------------ +;; Sometimes, it is computationally expensive or even not possible to +;; calculate property values when creating an AST node. The value +;; calculation can be deferred to the time the value is requested. +;; +;; Property values and contained nodes may have a special value of +;; `org-element-deferred' type. Such values are computed dynamically. +;; Either every time the property value is requested or just the first +;; time. In the latter case, the `org-element-deferred' property +;; value is auto-replaced with the dynamically computed result. +;; +;; Sometimes, even property names (not just property values) cannot, or +;; should not be computed in advance. If a special property +;; `:deferred' has the value of `org-element-deferred-type', it is +;; first resolved for side effects of setting the missing properties. +;; The resolved value is re-assigned to the `:deferred' property. +;; +;; Note that `org-element-copy' unconditionally resolves deferred +;; properties. This is useful to generate pure (in functional sense) +;; AST. +;; +;; The properties listed in `org-element--standard-properties', except +;; `:deferred' and `:parent' are never considered to have deferred value. +;; This constraint makes org-element API significantly faster. +;; +;; 3. Org document representation +;; ------------------------------ +;; Document AST is represented by nested Org syntax nodes. +;; +;; Each node in the AST can hold the contained node in its CONTENTS or +;; as values of properties. +;; +;; For example, (bold (...) "bold text") `bold' node contains +;; `plain-text' node in CONTENTS. +;; +;; The containing node is called "parent node". +;; +;; The contained nodes held inside CONTENTS are called "child nodes". +;; They must have their `:parent' property set to the containing +;; parent node. +;; +;; The contained nodes can also be held as property values. Such +;; nodes are called "secondary nodes". Only certain properties +;; can contribute to AST - the property names listed as the value of +;; special property `:secondary' +;; +;; For example, +;; +;; (headline ((:secondary (:title) +;; :title (#("text" 0 4 (:parent (headline ...))))))) +;; +;; is a parent headline node containing "text" secondary string node +;; inside `:title' property. Note that `:title' is listed in +;; `:secondary' value. +;; +;; The following example illustrates AST structure for an Org document: +;; +;; ---- Org document -------- +;; * Heading with *bold* text +;; Paragraph. +;; ---- end ----------------- +;; +;; (org-data (...) ; `org-data' node. +;; (headline +;; ( +;; ;; `:secondary' property lists property names that contain other +;; ;; syntax tree nodes. +;; +;; :secondary (:title) +;; +;; ;; `:title' property is set to anonymous node containing: +;; ;; `plain-text', `bold', `plain-text'. +;; +;; :title ("Heading with " (bold (:post-blank 1 ...) "bold") "text")) +;; +;; ;; `headline' contents +;; (section (...) +;; (paragraph +;; ;; `:parent' property set to the containing section. +;; (:parent (section ...)) +;; ;; paragraph contents is a `plain-text' node. +;; "Paragraph1.")))) +;; +;; Try calling M-: (org-element-parse-buffer) on the above example Org +;; document to explore a more complete version of Org AST. + +;;; Code: + +(require 'org-macs) +(require 'inline) ; load indentation rules +(require 'subr-x) ;; FIXME: Required for Emacs 27 + +;;;; Syntax node type + +(defun org-element-type (node &optional anonymous) + "Return type of NODE. + +The function returns the type of the node provided. +It can also return the following special value: + `plain-text' for a string + nil in any other case. + +When optional argument ANONYMOUS is non-nil, return symbol `anonymous' +when NODE is an anonymous node." + (declare (pure t)) + (cond + ((stringp node) 'plain-text) + ((null node) nil) + ((not (consp node)) nil) + ((symbolp (car node)) (car node)) + ((and anonymous (car node) (org-element-type (car node) t)) + 'anonymous) + (t nil))) + +(define-inline org-element-type-p (node types) + "Return non-nil when NODE type is one of TYPES. + TYPES can be a type symbol or a list of symbols." + (inline-letevals (node types) + (if (listp (inline-const-val types)) + (inline-quote (memq (org-element-type ,node t) ,types)) + (inline-quote (eq (org-element-type ,node t) ,types))))) + +(defun org-element-secondary-p (node) + "Non-nil when NODE directly belongs to a secondary node. +Return value is the containing property name, as a keyword, or nil." + (declare (pure t)) + (let* ((parent (org-element-property :parent node)) + (properties (org-element-property :secondary parent)) + val) + (catch 'exit + (dolist (p properties) + (setq val (org-element-property-raw p parent)) + (when (or (eq node val) (memq node val)) + (throw 'exit p)))))) + +;;;; Deferred values + +(cl-defstruct (org-element-deferred + (:constructor nil) + (:constructor org-element-deferred-create + ( auto-undefer-p function &rest arg-value + &aux (args arg-value))) + (:constructor org-element-deferred-create-alias + ( keyword &optional auto-undefer-p + &aux + (function #'org-element-property-2) + (args (list keyword)))) + (:constructor org-element-deferred-create-list + ( args &optional auto-undefer-p + &aux + (function #'org-element--deferred-resolve-list))) + (:type vector) :named) + "Dynamically computed value. + +The value can be obtained by calling FUNCTION with containing syntax +node as first argument and ARGS list as remainting arguments. + +If the function throws `:org-element-deferred-retry' signal, assume +that the syntax node has been modified by side effect and retry +retrieving the value that was previously deferred. + +AUTO-UNDEFER slot flags if the property value should be replaced upon +resolution. Some functions may ignore this flag." + function args auto-undefer-p) + +(defsubst org-element--deferred-resolve-once (deferred-value &optional node) + "Resolve DEFERRED-VALUE for NODE. +Throw `:org-element-deferred-retry' if NODE has been modified and we +need to re-read the value again." + (apply (org-element-deferred-function deferred-value) + node + (org-element-deferred-args deferred-value))) + +(defsubst org-element--deferred-resolve (value &optional node force-undefer) + "Resolve VALUE for NODE recursively. +Return a cons cell of the resolved value and the value to store. +When no value should be stored, return `org-element-ast--nil' as cdr. +When FORCE-UNDEFER is non-nil, resolve all the deferred values, ignoring +their `auto-undefer-p' slot. + +Throw `:org-element-deferred-retry' if NODE has been modified and we +need to re-read the value again." + (let ((value-to-store 'org-element-ast--nil) undefer) + (while (org-element-deferred-p value) + (setq undefer (or force-undefer (org-element-deferred-auto-undefer-p value)) + value (org-element--deferred-resolve-once value node)) + (when undefer (setq value-to-store value))) + (cons value value-to-store))) + +(defsubst org-element--deferred-resolve-force (value &optional node) + "Resolve VALUE for NODE recursively, ignoring `auto-undefer-p'. +Return the resolved value. + +Throw `:org-element-deferred-retry' if NODE has been modified and we +need to re-read the value again." + (car (org-element--deferred-resolve value node 'force))) + +(defsubst org-element--deferred-resolve-list (node &rest list) + "Unconditionally resolve all the deferred values in LIST for NODE. +Return a new list with all the values resolved. + +Throw `:org-element-deferred-retry' if NODE has been modified and we +need to re-read the value again." + (mapcar + (lambda (value) + (if (org-element-deferred-p value) + (org-element--deferred-resolve-force value node) + value)) + list)) + +;;;; Object properties + +(eval-and-compile ; make available during inline expansion + + (defconst org-element--standard-properties + '( :begin :post-affiliated :contents-begin :contents-end :end :post-blank + :secondary :mode :granularity + :cached :org-element--cache-sync-key + :robust-begin :robust-end + :true-level + :buffer :deferred + :structure :parent) + "Standard properties stored in every syntax node structure. +These properties are stored in an array pre-allocated every time a new +object is created. Two exceptions are `anonymous' and `plain-text' +node types.") + + (defconst org-element--standard-properties-idxs + (let (plist) + (seq-do-indexed + (lambda (property idx) + (setq plist (plist-put plist property idx))) + org-element--standard-properties) + plist) + "Property list holding standard indexes for `org-element--standard-properties'.") + + (define-inline org-element--property-idx (property) + "Return standard property index or nil." + (declare (pure t)) + (inline-letevals (property) + (plist-get + org-element--standard-properties-idxs + (inline-const-val property))))) + +(define-inline org-element--parray (node) + "Return standard property array for NODE." + (declare (pure t)) + (inline-letevals (node) + (inline-quote + (pcase (org-element-type ,node) + (`nil nil) + ;; Do not use property array for strings - they usually hold + ;; `:parent' property and nothing more. + (`plain-text nil) + (_ + ;; (type (:standard-properties val ...) ...) + (if (eq :standard-properties (car (nth 1 ,node))) + (cadr (nth 1 ,node)) + ;; Non-standard order. Go long way. + (plist-get (nth 1 ,node) :standard-properties))))))) + +(define-inline org-element--plist-property (property node &optional dflt) + "Extract the value for PROPERTY from NODE's property list. +Ignore standard property array." + (declare (pure t)) + (inline-letevals (property node dflt) + (inline-quote + (pcase (org-element-type ,node) + (`nil ,dflt) + (`plain-text + (or (get-text-property 0 ,property ,node) + (when ,dflt + (if + ;; FIXME: Byte-compiler throws false positives in Emacs 27. + (with-no-warnings + (plist-member (text-properties-at 0 ,node) ,property)) + nil ,dflt)))) + (_ + (or (plist-get (nth 1 ,node) ,property) + (when ,dflt + (if + ;; FIXME: Byte-compiler throws false positives in Emacs 27. + (with-no-warnings + (plist-member (nth 1 ,node) ,property)) + nil ,dflt)))))))) + +(define-inline org-element-property-raw (property node &optional dflt) + "Extract the value for PROPERTY of an NODE. +Do not resolve deferred values. +If PROPERTY is not present, return DFLT." + (declare (pure t)) + (inline-letevals (node property) + (let ((idx (org-element--property-idx (inline-const-val property)))) + (inline-quote + (let ((idx (or ,idx (org-element--property-idx ,property)))) + (if-let ((parray (and idx (org-element--parray ,node)))) + (pcase (aref parray idx) + (`org-element-ast--nil ,dflt) + (val val)) + ;; No property array exists. Fall back to `plist-get'. + (org-element--plist-property ,property ,node ,dflt))))))) + +(define-inline org-element--put-parray (node &optional parray) + "Initialize standard property array in NODE. +Return the array or nil when NODE is `plain-text'." + (inline-letevals (node parray) + (inline-quote + (let ((parray ,parray)) + (unless (or parray (memq (org-element-type ,node) '(plain-text nil))) + (setq parray (make-vector ,(length org-element--standard-properties) nil)) + ;; Copy plist standard properties back to parray. + (let ((stdplist org-element--standard-properties-idxs)) + (while stdplist + (aset parray (cadr stdplist) + (org-element--plist-property (car stdplist) ,node)) + (setq stdplist (cddr stdplist)))) + (setcar (cdr ,node) + (nconc (list :standard-properties parray) + (cadr ,node))) + parray))))) + +(define-inline org-element-put-property (node property value) + "In NODE, set PROPERTY to VALUE. +Return modified NODE." + (let ((idx (and (inline-const-p property) + (org-element--property-idx property)))) + (if idx + (inline-letevals (node value) + (inline-quote + (if (org-element-type-p ,node 'plain-text) + ;; Special case: Do not use parray for plain-text. + (org-add-props ,node nil ,property ,value) + (let ((parray + (or (org-element--parray ,node) + (org-element--put-parray ,node)))) + (when parray (aset parray ,idx ,value)) + ,node)))) + (inline-letevals (node property value) + (inline-quote + (let ((idx (org-element--property-idx ,property))) + (if (and idx (not (org-element-type-p ,node 'plain-text))) + (when-let + ((parray + (or (org-element--parray ,node) + (org-element--put-parray ,node)))) + (aset parray idx ,value)) + (pcase (org-element-type ,node) + (`nil nil) + (`plain-text + (org-add-props ,node nil ,property ,value)) + (_ + ;; Note that `plist-put' adds new elements at the end, + ;; thus keeping `:standard-properties' as the first element. + (setcar (cdr ,node) (plist-put (nth 1 ,node) ,property ,value))))) + ,node)))))) + +(define-inline org-element-put-property-2 (property value node) + "Like `org-element-put-property', but NODE is the last argument. +See `org-element-put-property' for the meaning of PROPERTY and VALUE." + (inline-quote (org-element-put-property ,node ,property ,value))) + +(defun org-element--property (property node &optional dflt force-undefer) + "Extract the value from the PROPERTY of a NODE. +Return DFLT when PROPERTY is not present. +When FORCE-UNDEFER is non-nil, unconditionally resolve deferred +properties, replacing their values in NODE." + (let ((value (org-element-property-raw property node 'org-element-ast--nil))) + ;; PROPERTY not present. + (when (and (eq 'org-element-ast--nil value) + (org-element-deferred-p + (org-element-property-raw :deferred node))) + ;; If :deferred has `org-element-deferred' type, resolve it for + ;; side-effects, and re-assign the new value. + (org-element--property :deferred node nil 'force-undefer) + ;; Try to retrieve the value again. + (setq value (org-element-property-raw property node dflt))) + ;; Deferred property. Resolve it recursively. + (when (org-element-deferred-p value) + (let ((retry t) (firstiter t)) + (while retry + (if firstiter (setq firstiter nil) ; avoid extra call to `org-element-property-raw'. + (setq value (org-element-property-raw property node 'org-element-ast--nil))) + (catch :org-element-deferred-retry + (pcase-let + ((`(,resolved . ,value-to-store) + (org-element--deferred-resolve value node force-undefer))) + (setq value resolved) + ;; Store the resolved property value, if needed. + (unless (eq value-to-store 'org-element-ast--nil) + (org-element-put-property node property value-to-store))) + ;; Finished resolving. + (setq retry nil))))) + ;; Return the resolved value. + (if (eq value 'org-element-ast--nil) dflt value))) + +(define-inline org-element-property (property node &optional dflt force-undefer) + "Extract the value from the PROPERTY of a NODE. +Return DFLT when PROPERTY is not present. +When FORCE-UNDEFER is non-nil and the property value is computed +dynamically, unconditionally replace the dynamic deferred value, +modifying NODE by side effect. + +Note: The properties listed in `org-element--standard-properties', +except `:deferred', may not be resolved." + (if (and (inline-const-p property) + (not (memq (inline-const-val property) '(:deferred :parent))) + (org-element--property-idx (inline-const-val property))) + ;; This is an important optimization, making common org-element + ;; API calls much faster. + (inline-quote (org-element-property-raw ,property ,node ,dflt)) + (inline-quote (org-element--property ,property ,node ,dflt ,force-undefer)))) + +(define-inline org-element-property-2 (node property &optional dflt force-undefer) + "Like `org-element-property', but reverse the order of NODE and PROPERTY." + (inline-quote (org-element-property ,property ,node ,dflt ,force-undefer))) + +(defsubst org-element-parent (node) + "Return `:parent' property of NODE." + (org-element-property :parent node)) + +(gv-define-setter org-element-parent (value node) + `(org-element-put-property ,node :parent ,value)) + +(gv-define-setter org-element-property (value property node &optional _) + `(org-element-put-property ,node ,property ,value)) + +(gv-define-setter org-element-property-raw (value property node &optional _) + `(org-element-put-property ,node ,property ,value)) + +(defun org-element--properties-mapc (fun node &optional collect no-standard) + "Apply FUN for each property of NODE. +FUN will be called with three arguments: property name, property +value, and node. If FUN accepts only 2 arguments, it will be called +with two arguments: property name and property value. If FUN accepts +only a single argument, it will be called with a single argument - +property value. + +Do not resolve deferred values, except `:deferred'. +`:standard-properties' internal property will be skipped. + +When NO-STANDARD is non-nil, do no map over +`org-element--standard-properties'. + +When COLLECT is symbol `set', set the property values to the return +values (except the values equal to `org-element-ast--nil') and finally +return nil. When COLLECT is non-nil and not symbol `set', collect the +return values into a list and return it. +Otherwise, return nil." + (let ( acc rtn (fun-arity (cdr (func-arity fun))) + (type (org-element-type node))) + (when type + ;; Compute missing properties. + (org-element-property :deferred node) + ;; Map over parray. + (unless no-standard + (let ((standard-idxs + org-element--standard-properties-idxs) + (parray (org-element--parray node))) + (when parray + (while standard-idxs + (setq + rtn + (pcase fun-arity + (1 (funcall fun (aref parray (cadr standard-idxs)))) + (2 (funcall + fun + (car standard-idxs) + (aref parray (cadr standard-idxs)))) + (_ (funcall + fun + (car standard-idxs) + (aref parray (cadr standard-idxs)) + node)))) + (when collect + (unless (eq rtn (aref parray (cadr standard-idxs))) + (if (and (eq collect 'set) (not (eq rtn 'org-element-ast--nil))) + (setf (aref parray (cadr standard-idxs)) rtn) + (push rtn acc)))) + (setq standard-idxs (cddr standard-idxs)))))) + ;; Map over plist. + (let ((props + (if (eq type 'plain-text) + (text-properties-at 0 node) + (nth 1 node)))) + (while props + (unless (eq :standard-properties (car props)) + (setq rtn + (pcase fun-arity + (1 (funcall fun (cadr props))) + (2 (funcall fun (car props) (cadr props))) + (_ (funcall fun (car props) (cadr props) node)))) + (when collect + (if (and (eq collect 'set) + (not (eq rtn 'org-element-ast--nil))) + (unless (eq rtn (cadr props)) + (if (eq type 'plain-text) + (org-add-props node nil (car props) rtn) + (setf (cadr props) rtn))) + (push rtn acc)))) + (setq props (cddr props))))) + ;; Return. + (when collect (nreverse acc)))) + +(defun org-element--deferred-resolve-force-rec (property val node) + "Resolve deferred PROPERTY VAL in NODE recursively. Force undefer." + (catch :found + (catch :org-element-deferred-retry + (throw :found (org-element--deferred-resolve-force val node))) + ;; Caught `:org-element-deferred-retry'. Go long way. + (org-element-property property node nil t))) + +(defun org-element--deferred-resolve-rec (property val node) + "Resolve deferred PROPERTY VAL in NODE recursively. +Return the value to be stored." + (catch :found + (catch :org-element-deferred-retry + (throw :found (cdr (org-element--deferred-resolve val node)))) + ;; Caught `:org-element-deferred-retry'. Go long way. + (org-element-property property node))) + +(defsubst org-element-properties-resolve (node &optional force-undefer) + "Resolve all the deferred properties in NODE, modifying the NODE. +When FORCE-UNDEFER is non-nil, resolve unconditionally. +Return the modified NODE." + ;; Compute all the available properties. + (org-element-property :deferred node nil force-undefer) + (org-element--properties-mapc + (if force-undefer + #'org-element--deferred-resolve-force-rec + #'org-element--deferred-resolve-rec) + node 'set 'no-standard) + node) + +(defsubst org-element-properties-mapc (fun node &optional undefer) + "Apply FUN for each property of NODE for side effect. +FUN will be called with three arguments: property name, property +value, and node. If FUN accepts only 2 arguments, it will be called +with two arguments: property name and property value. If FUN accepts +only a single argument, it will be called with a single argument - +property value. + +When UNDEFER is non-nil, undefer deferred properties. +When UNDEFER is symbol `force', unconditionally replace the property +values with undeferred values. + +Return nil." + (when undefer + (org-element-properties-resolve node (eq 'force undefer))) + (org-element--properties-mapc fun node)) + +;; There is purposely no function like `org-element-properties' that +;; returns a list of properties. Such function would tempt the users +;; to (1) run it, creating a whole new list; (2) filter over that list +;; - the process requiring a lot of extra consing, adding a load onto +;; Emacs GC, memory used, and slowing things up as creating new lists +;; is not free for CPU. +(defsubst org-element-properties-map (fun node &optional undefer) + "Apply FUN for each property of NODE and return a list of the results. +FUN will be called with three arguments: property name, property +value, and node. If FUN accepts only 2 arguments, it will be called +with two arguments: property name and property value. If FUN accepts +only a single argument, it will be called with a single argument - +property value. + +When UNDEFER is non-nil, undefer deferred properties unconditionally. +When UNDEFER is symbol `force', unconditionally replace the property +values with undeferred values." + (when undefer + (org-element-properties-resolve node (eq 'force undefer))) + (org-element--properties-mapc fun node 'collect)) + +;;;; Node contents. + +(defsubst org-element-contents (node) + "Extract contents from NODE. +Do not resolve deferred values." + (declare (pure t)) + (cond ((not (consp node)) nil) + ((symbolp (car node)) (nthcdr 2 node)) + (t node))) + +(defsubst org-element-set-contents (node &rest contents) + "Set NODE's contents to CONTENTS. +Return modified NODE. +If NODE cannot have contents, return CONTENTS." + (pcase (org-element-type node t) + (`plain-text contents) + ((guard (null node)) contents) + ;; Anonymous node. + (`anonymous + (setcar node (car contents)) + (setcdr node (cdr contents)) + node) + ;; Node with type. + (_ (setf (cddr node) contents) + node))) + +(defalias 'org-element-resolve-deferred #'org-element-properties-resolve) + +;;;; Constructor and copier + +(defun org-element-create (type &optional props &rest children) + "Create a new syntax node of TYPE. +Optional argument PROPS, when non-nil, is a plist defining the +properties of the node. CHILDREN can be elements, objects or +strings. + +When CHILDREN is a single anonymous node, use its contents as children +nodes. This way, + (org-element-create \\='section nil (org-element-contents node)) +will yield expected results with contents of another node adopted into +a newly created one. + +When TYPE is `plain-text', CHILDREN must contain a single node - +string. Alternatively, TYPE can be a string. When TYPE is nil or +`anonymous', PROPS must be nil." + (cl-assert + ;; FIXME: Just use `plistp' from Emacs 29 when available. + (let ((len (proper-list-p props))) + (and len (zerop (% len 2))))) + ;; Assign parray. + (when (and props (not (stringp type)) (not (eq type 'plain-text))) + (let ((node (list 'dummy props))) + (org-element--put-parray node) + (setq props (nth 1 node)) + ;; Remove standard properties from PROPS plist by side effect. + (let ((ptail props)) + (while ptail + (if (not (and (keywordp (car ptail)) + (org-element--property-idx (car ptail)))) + (setq ptail (cddr ptail)) + (if (null (cddr ptail)) ; last property + (setq props (nbutlast props 2) + ptail nil) + (setcar ptail (nth 2 ptail)) + (setcdr ptail (seq-drop ptail 3)))))))) + (pcase type + ((or `nil `anonymous) + (cl-assert (null props)) + (apply #'org-element-adopt nil children)) + (`plain-text + (cl-assert (= (length children) 1)) + (org-add-props (car children) props)) + ((pred stringp) + (if props (org-add-props type props) type)) + (_ + (if (and (= 1 (length children)) + (org-element-type-p (car children) 'anonymous)) + (apply #'org-element-adopt (list type props) (car children)) + (apply #'org-element-adopt (list type props) children))))) + +(defun org-element-copy (datum &optional keep-contents) + "Return a copy of DATUM. +DATUM is an element, object, string or nil. `:parent' property +is cleared and contents are removed in the process. +Secondary objects are also copied and their `:parent' is re-assigned. + +When optional argument KEEP-CONTENTS is non-nil, do not remove the +contents. Instead, copy the children recursively, updating their +`:parent' property. + +As a special case, `anonymous' nodes do not have their contents +removed. The contained children are copied recursively, updating +their `:parent' property to the copied `anonymous' node. + +When DATUM is `plain-text', all the properties are removed." + (pcase (org-element-type datum t) + ((guard (null datum)) nil) + (`plain-text (substring-no-properties datum)) + (`nil (error "Not an Org syntax node: %S" datum)) + (`anonymous + (let* ((node-copy (copy-sequence datum)) + (tail node-copy)) + (while tail + (setcar tail (org-element-copy (car tail) t)) + (org-element-put-property (car tail) :parent node-copy) + (setq tail (cdr tail))) + node-copy)) + (type + (let ((node-copy (append (list type (copy-sequence (cadr datum))) (copy-sequence (cddr datum))))) + ;; Copy `:standard-properties' + (when-let ((parray (org-element-property-raw :standard-properties node-copy))) + (org-element-put-property node-copy :standard-properties (copy-sequence parray))) + ;; Clear `:parent'. + (org-element-put-property node-copy :parent nil) + ;; We cannot simply return the copied property list. When + ;; DATUM is i.e. a headline, it's property list `:title' can + ;; contain parsed objects. The objects will contain + ;; `:parent' property set to the DATUM itself. When copied, + ;; these inner `:parent' property values will contain + ;; incorrect object decoupled from DATUM. Changes to the + ;; DATUM copy will no longer be reflected in the `:parent' + ;; properties. So, we need to reassign inner `:parent' + ;; properties to the DATUM copy explicitly. + (dolist (secondary-prop (org-element-property :secondary node-copy)) + (when-let ((secondary-value (org-element-property secondary-prop node-copy))) + (setq secondary-value (org-element-copy secondary-value t)) + (if (org-element-type secondary-value) + (org-element-put-property secondary-value :parent node-copy) + (dolist (el secondary-value) + (org-element-put-property el :parent node-copy))) + (org-element-put-property node-copy secondary-prop secondary-value))) + (when keep-contents + (let ((contents (org-element-contents node-copy))) + (while contents + (setcar contents (org-element-copy (car contents) t)) + (setq contents (cdr contents))))) + node-copy)))) + +;;;; AST queries + +(defun org-element-ast-map + ( data types fun + &optional + ignore first-match no-recursion + with-properties no-secondary no-undefer) + "Map a function on selected syntax nodes. + +DATA is a syntax tree. TYPES is a symbol or list of symbols of +node types. FUN is the function called on the matching nodes. +It has to accept one argument: the node itself. + +When TYPES is t, call FUN for all the node types. + +FUN can also be a Lisp form. The form will be evaluated as function +with symbol `node' bound to the current node. + +When optional argument IGNORE is non-nil, it should be a list holding +nodes to be skipped. In that case, the listed nodes and their +contents 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 node 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. + +When optional argument WITH-PROPERTIES is non-nil, it should hold a list +of property names. These properties will be treated as additional +secondary properties. + +When optional argument NO-SECONDARY is non-nil, do not recurse into +secondary strings. + +When optional argument NO-UNDEFER is non-nil, do not resolve deferred +values. + +FUN may also throw `:org-element-skip' signal. Then, +`org-element-ast-map' will not recurse into the current node. + +Nil values returned from FUN do not appear in the results." + (declare (indent 2)) + ;; Ensure TYPES and NO-RECURSION are a list, even of one node. + (when types + (let* ((types (pcase types + ((pred listp) types) + (`t t) + (_ (list types)))) + (no-recursion (if (listp no-recursion) no-recursion + (list no-recursion))) + (fun (if (functionp fun) fun `(lambda (node) ,fun))) + --acc) + (letrec ((--walk-tree + (lambda (--data) + ;; Recursively walk DATA. INFO, if non-nil, is a plist + ;; holding contextual information. + (let ((--type (org-element-type --data t)) + recurse) + (cond + ((not --data)) + ((not --type)) + ;; Ignored node in an export context. + ((and ignore (memq --data ignore))) + ;; List of elements or objects. + ((eq --type 'anonymous) + (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). + (setq recurse t) + (when (or (eq types t) (memq --type types)) + (let ((result + (catch :org-element-skip + (setq recurse nil) + (prog1 (funcall fun --data) + (setq recurse t))))) + (cond ((not result)) + (first-match (throw :--map-first-match result)) + (t (push result --acc))))) + ;; Determine if a recursion into --DATA is possible. + (cond + ;; No recursion requested. + ((not recurse)) + ;; --TYPE is explicitly removed from recursion. + ((memq --type no-recursion)) + ;; In any other case, map secondary, affiliated, and contents. + (t + (when with-properties + (dolist (p with-properties) + (funcall + --walk-tree + (if no-undefer + (org-element-property-raw p --data) + (org-element-property p --data))))) + (unless no-secondary + (dolist (p (org-element-property :secondary --data)) + (funcall + --walk-tree + (if no-undefer + (org-element-property-raw p --data) + (org-element-property p --data))))) + (mapc --walk-tree (org-element-contents --data)))))))))) + (catch :--map-first-match + (funcall --walk-tree data) + ;; Return value in a proper order. + (nreverse --acc)))))) + +(defun org-element-lineage (datum &optional types with-self) + "List all ancestors of a given element or object. + +DATUM is an object or element. + +Return ancestors from the closest to the farthest. When optional +argument TYPES is a symbol or a list of symbols, return the first +element or object in the lineage whose type equals or belongs to that +list instead. + +When optional argument WITH-SELF is non-nil, lineage includes +DATUM itself as the first element, and TYPES, if provided, also +apply to it. + +When DATUM is obtained through `org-element-context' or +`org-element-at-point', and org-element-cache is disabled, only +ancestors from its section can be found. There is no such limitation +when DATUM belongs to a full parse tree." + (when (and types (not (listp types))) (setq types (list types))) + (let ((up (if with-self datum (org-element-parent datum))) + ancestors) + (while (and up (not (org-element-type-p up types))) + (unless types (push up ancestors)) + (setq up (org-element-parent up))) + (if types up (nreverse ancestors)))) + +(defun org-element-lineage-map (datum fun &optional types with-self first-match) + "Map FUN across ancestors of DATUM, from closest to furthest. +Return a list of results. Nil values returned from FUN do not appear +in the results. + +DATUM is an object or element. + +FUN is a function accepting a single argument: syntax node. +FUN can also be a Lisp form. The form will be evaluated as function +with symbol `node' bound to the current node. + +When optional argument TYPES is a list of symbols, only map across +nodes with the listed types. + +When optional argument WITH-SELF is non-nil, lineage includes +DATUM itself as the first element, and TYPES, if provided, also +apply to it. + +When optional argument FIRST-MATCH is non-nil, stop at the first +match for which FUN doesn't return nil, and return that value." + (declare (indent 2)) + (setq fun (if (functionp fun) fun `(lambda (node) ,fun))) + (let ((up (if with-self datum (org-element-parent datum))) + acc rtn) + (catch :--first-match + (while up + (when (or (not types) (org-element-type-p up types)) + (setq rtn (funcall fun up)) + (if (and first-match rtn) + (throw :--first-match rtn) + (when rtn (push rtn acc)))) + (setq up (org-element-parent up))) + (nreverse acc)))) + +(defun org-element-property-inherited (property node &optional with-self accumulate literal-nil include-nil) + "Extract non-nil value from the PROPERTY of a NODE and/or its parents. + +PROPERTY is a single property or a list of properties to be considered. + +When WITH-SELF is non-nil, consider PROPERTY in the NODE itself. +Otherwise, only start from the immediate parent. + +When optional argument ACCUMULATE is nil, return the first non-nil value +\(properties when PROPERTY is a list are considered one by one). +When ACCUMULATE is non-nil, extract all the values, starting from the +outermost ancestor and accumulate them into a single list. The values +that are lists are appended. + +When LITERAL-NIL is non-nil, treat property values \"nil\" and nil. + +When INCLUDE-NIL is non-nil, do not skip properties with value nil. The +properties that are missing from the property list will still be +skipped." + (unless (listp property) (setq property (list property))) + (let (acc local val) + (catch :found + (unless with-self (setq node (org-element-parent node))) + (while node + (setq local nil) + (dolist (prop property) + (setq val (org-element-property prop node 'org-element-ast--nil)) + (unless (eq val 'org-element-ast--nil) ; not present + (when literal-nil (setq val (org-not-nil val))) + (when (and (not accumulate) (or val include-nil)) + (throw :found val)) + ;; Append to the end. + (if (and include-nil (not val)) + (setq local (append local '(nil))) + (setq local (append local (if (listp val) val (list val))))))) + ;; Append parent to front. + (setq acc (append local acc)) + (setq node (org-element-parent node))) + acc))) + +;;;; AST modification + +(defalias 'org-element-adopt-elements #'org-element-adopt) +(defun org-element-adopt (parent &rest children) + "Append CHILDREN to the contents of PARENT. + +PARENT is a syntax node. CHILDREN can be elements, objects, or +strings. + +If PARENT is nil, create a new anonymous node containing CHILDREN. + +The function takes care of setting `:parent' property for each child. +Return the modified PARENT." + (declare (indent 1)) + (if (not children) parent + ;; Link every child to PARENT. If PARENT is nil, it is a secondary + ;; string: parent is the list itself. + (dolist (child children) + (when child + (org-element-put-property child :parent (or parent children)))) + ;; Add CHILDREN at the end of PARENT contents. + (when parent + (apply #'org-element-set-contents + parent + (nconc (org-element-contents parent) children))) + ;; Return modified PARENT element. + (or parent children))) + +(defalias 'org-element-extract-element #'org-element-extract) +(defun org-element-extract (node) + "Extract NODE from parse tree. +Remove NODE from the parse tree by side-effect, and return it +with its `:parent' property stripped out." + (let ((parent (org-element-parent node)) + (secondary (org-element-secondary-p node))) + (if secondary + (org-element-put-property + parent secondary + (delq node (org-element-property secondary parent))) + (apply #'org-element-set-contents + parent + (delq node (org-element-contents parent)))) + ;; Return NODE with its :parent removed. + (org-element-put-property node :parent nil))) + +(defun org-element-insert-before (node location) + "Insert NODE before LOCATION in parse tree. +LOCATION is an element, object or string within the parse tree. +Parse tree is modified by side effect." + (let* ((parent (org-element-parent location)) + (property (org-element-secondary-p location)) + (siblings (if property (org-element-property property parent) + (org-element-contents parent))) + ;; Special case: LOCATION is the first element of an + ;; independent secondary string (e.g. :title property). Add + ;; NODE in-place. + (specialp (and (not property) + (eq siblings parent) + (eq (car parent) location)))) + ;; Install NODE at the appropriate LOCATION within SIBLINGS. + (cond (specialp) + ((or (null siblings) (eq (car siblings) location)) + (push node siblings)) + ((null location) (nconc siblings (list node))) + (t + (let ((index (cl-position location siblings))) + (unless index (error "No location found to insert node")) + (push node (cdr (nthcdr (1- index) siblings)))))) + ;; Store SIBLINGS at appropriate place in parse tree. + (cond + (specialp (setcdr parent (copy-sequence parent)) (setcar parent node)) + (property (org-element-put-property parent property siblings)) + (t (apply #'org-element-set-contents parent siblings))) + ;; Set appropriate :parent property. + (org-element-put-property node :parent parent))) + +(defalias 'org-element-set-element #'org-element-set) +(defun org-element-set (old new &optional keep-props) + "Replace element or object OLD with element or object NEW. +When KEEP-PROPS is non-nil, keep OLD values of the listed property +names. + +Return the modified element. + +The function takes care of setting `:parent' property for NEW." + ;; Ensure OLD and NEW have the same parent. + (org-element-put-property new :parent (org-element-property :parent old)) + ;; Handle KEEP-PROPS. + (dolist (p keep-props) + (org-element-put-property new p (org-element-property p old))) + (let ((old-type (org-element-type old)) + (new-type (org-element-type new))) + (if (or (eq old-type 'plain-text) + (eq new-type 'plain-text)) + ;; We cannot replace OLD with NEW since strings are not mutable. + ;; We take the long path. + (progn + (org-element-insert-before new old) + (org-element-extract old) + ;; We will return OLD. + (setq old 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. + (dolist (blob (org-element-contents new)) + (org-element-put-property blob :parent old)) + ;; Both OLD and NEW are lists. + (setcar old (car new)) + (setcdr old (cdr new)))) + old) + +(provide 'org-element-ast) +;;; org-element-ast.el ends here diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index ef96dc024d1..9f8e8df599a 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2012-2024 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou +;; Maintainer: Ihor Radchenko ;; Keywords: outlines, hypermedia, calendar, text ;; This file is part of GNU Emacs. @@ -77,6 +78,7 @@ (declare-function org-at-heading-p "org" (&optional _)) (declare-function org-escape-code-in-string "org-src" (s)) +(declare-function org-src-preserve-indentation-p "org-src" (&optional node)) (declare-function org-macro-escape-arguments "org-macro" (&rest args)) (declare-function org-macro-extract-arguments "org-macro" (s)) (declare-function org-reduced-level "org" (l)) @@ -93,7 +95,6 @@ (defvar org-property-drawer-re) (defvar org-property-format) (defvar org-property-re) -(defvar org-src-preserve-indentation) (defvar org-tags-column) (defvar org-todo-regexp) (defvar org-ts-regexp-both) @@ -125,17 +126,24 @@ Key is located in match group 1.") Style, if any, is located in match group 1.") (defconst org-element-clock-line-re - (rx-to-string - `(seq - line-start (0+ (or ?\t ?\s)) - "CLOCK: " - (regexp ,org-ts-regexp-inactive) - (opt "--" - (regexp ,org-ts-regexp-inactive) - (1+ (or ?\t ?\s)) "=>" (1+ (or ?\t ?\s)) - (1+ digit) ":" digit digit) - (0+ (or ?\t ?\s)) - line-end)) + (let ((duration ; "=> 212:12" + '(seq + (1+ (or ?\t ?\s)) "=>" (1+ (or ?\t ?\s)) + (1+ digit) ":" digit digit))) + (rx-to-string + `(seq + line-start (0+ (or ?\t ?\s)) + "CLOCK:" + (or + (seq + (1+ (or ?\t ?\s)) + (regexp ,org-ts-regexp-inactive) + (opt "--" + (regexp ,org-ts-regexp-inactive) + ,duration)) + ,duration) + (0+ (or ?\t ?\s)) + line-end))) "Regexp matching a clock line.") (defconst org-element-comment-string "COMMENT" @@ -169,6 +177,13 @@ Style, if any, is located in match group 1.") "Regexp matching opening or closing line of a drawer. Drawer's name is located in match group 1.") +(defconst org-element-drawer-re-nogroup + (rx line-start (0+ (any ?\s ?\t)) + ":" (1+ (any ?- ?_ word)) ":" + (0+ (any ?\s ?\t)) line-end) + "Regexp matching opening or closing line of a drawer. +Drawer's name is located in match group 1.") + (defconst org-element-dynamic-block-open-re (rx line-start (0+ (any ?\s ?\t)) "#+BEGIN:" (0+ (any ?\s ?\t)) @@ -180,6 +195,11 @@ Drawer's name is located in match group 1.") Dynamic block's name is located in match group 1. Parameters are in match group 2.") +(defconst org-element-dynamic-block-open-re-nogroup + (rx line-start (0+ (any ?\s ?\t)) + "#+BEGIN:" (0+ (any ?\s ?\t)) word) + "Regexp matching the opening line of a dynamic block.") + (defconst org-element-headline-re (rx line-start (1+ "*") " ") "Regexp matching a headline.") @@ -400,10 +420,14 @@ Don't modify it, set `org-element-affiliated-keywords' instead.") subscript superscript underline verbatim)) (standard-set (remq 'citation-reference (remq 'table-cell org-element-all-objects))) - (standard-set-no-line-break (remq 'line-break standard-set))) + (standard-set-no-line-break (remq 'line-break standard-set)) + (standard-set-for-citations (seq-difference + standard-set-no-line-break + '( citation citation-reference + footnote-reference link)))) `((bold ,@standard-set) (citation citation-reference) - (citation-reference ,@minimal-set) + (citation-reference ,@standard-set-for-citations) (footnote-reference ,@standard-set) (headline ,@standard-set-no-line-break) (inlinetask ,@standard-set-no-line-break) @@ -487,6 +511,208 @@ past the brackets." (goto-char end) (buffer-substring-no-properties (1+ pos) (1- end))))))))) +(defconst org-element--cache-variables + '( org-element--cache org-element--cache-size + org-element--headline-cache org-element--headline-cache-size + org-element--cache-hash-left org-element--cache-hash-right + org-element--cache-sync-requests org-element--cache-sync-timer + org-element--cache-sync-keys-value org-element--cache-change-tic + org-element--cache-last-buffer-size + org-element--cache-diagnostics-ring + org-element--cache-diagnostics-ring-size + org-element--cache-gapless + org-element--cache-change-warning) + "List of variable symbols holding cache state.") + +(defconst org-element-ignored-local-variables + `( org-font-lock-keywords + ,@org-element--cache-variables) + "List of variables not copied through upon Org buffer duplication. +Export process and parsing in `org-element-parse-secondary-string' +takes place on a copy of the original buffer. When this copy is +created, all Org related local variables not in this list are copied +to the new buffer. Variables with an unreadable value are also +ignored.") + +(cl-defun org-element--generate-copy-script (buffer + &key + copy-unreadable + drop-visibility + drop-narrowing + drop-contents + drop-locals) + "Generate a function duplicating BUFFER. + +The copy will preserve local variables, visibility, contents and +narrowing of the original buffer. If a region was active in +BUFFER, contents will be narrowed to that region instead. + +When optional key COPY-UNREADABLE is non-nil, do not ensure that all +the copied local variables will be readable in another Emacs session. + +When optional keys DROP-VISIBILITY, DROP-NARROWING, DROP-CONTENTS, or +DROP-LOCALS are non-nil, do not preserve visibility, narrowing, +contents, or local variables correspondingly. + +The resulting function can be evaluated at a later time, from +another buffer, effectively cloning the original buffer there. + +The function assumes BUFFER's major mode is `org-mode'." + (declare-function org-fold-core--update-buffer-folds "org-fold-core" ()) + (require 'org-fold-core) + (with-current-buffer buffer + (let ((str (unless drop-contents (org-with-wide-buffer (buffer-string)))) + (narrowing + (unless drop-narrowing + (if (org-region-active-p) + (list (region-beginning) (region-end)) + (list (point-min) (point-max))))) + (pos (point)) + (varvals + (unless drop-locals + (let ((varvals nil)) + (dolist (entry (buffer-local-variables (buffer-base-buffer))) + (when (consp entry) + (let ((var (car entry)) + (val (cdr entry))) + (and (not (memq var org-element-ignored-local-variables)) + (or (memq var + '(default-directory + ;; Required to convert file + ;; links in the #+INCLUDEd + ;; files. See + ;; `org-export--prepare-file-contents'. + buffer-file-name + buffer-file-coding-system + ;; Needed to preserve folding state + char-property-alias-alist)) + (string-match-p "^\\(org-\\|orgtbl-\\)" + (symbol-name var))) + ;; Skip unreadable values, as they cannot be + ;; sent to external process. + (or copy-unreadable (not val) + (ignore-errors (read (format "%S" val)))) + (push (cons var val) varvals))))) + varvals))) + (ols + (unless drop-visibility + (let (ov-set) + (dolist (ov (overlays-in (point-min) (point-max))) + (let ((invis-prop (overlay-get ov 'invisible))) + (when invis-prop + (push (list (overlay-start ov) (overlay-end ov) + (overlay-properties ov)) + ov-set)))) + ov-set)))) + (lambda () + (let ((inhibit-modification-hooks t)) + ;; Set major mode. Ignore `org-mode-hook' and other hooks as + ;; they have been run already in BUFFER. + (unless (eq major-mode 'org-mode) + (delay-mode-hooks + (let ((org-inhibit-startup t)) (org-mode)))) + ;; Copy specific buffer local variables. + (pcase-dolist (`(,var . ,val) varvals) + (set (make-local-variable var) val)) + ;; Whole buffer contents when requested. + (when str + (let ((inhibit-read-only t)) + (erase-buffer) (insert str))) + ;; Make org-element-cache not complain about changed buffer + ;; state. + (org-element-cache-reset nil 'no-persistence) + ;; Narrowing. + (when narrowing + (apply #'narrow-to-region narrowing)) + ;; Current position of point. + (goto-char pos) + ;; Overlays with invisible property. + (pcase-dolist (`(,start ,end ,props) ols) + (let ((ov (make-overlay start end))) + (while props + (overlay-put ov (pop props) (pop props))))) + ;; Text property folds. + (unless drop-visibility (org-fold-core--update-buffer-folds)) + ;; Never write the buffer copy to disk, despite + ;; `buffer-file-name' not being nil. + (setq write-contents-functions (list (lambda (&rest _) t)))))))) + +(cl-defun org-element-copy-buffer (&key to-buffer drop-visibility + drop-narrowing drop-contents + drop-locals) + "Return a copy of the current buffer. +The copy preserves Org buffer-local variables, visibility and +narrowing. + +IMPORTANT: The buffer copy may also have variable `buffer-file-name' +copied. + +To prevent Emacs overwriting the original buffer file, +`write-contents-functions' is set to \='(always). Do not alter this +variable and do not do anything that might alter it (like calling a +major mode) to prevent data corruption. Also, do note that Emacs may +jump into the created buffer if the original file buffer is closed and +then re-opened. Making edits in the buffer copy may also trigger +Emacs save dialog. Prefer using `org-element-with-buffer-copy' macro +when possible. + +When optional key TO-BUFFER is non-nil, copy into BUFFER. + +Optional keys DROP-VISIBILITY, DROP-NARROWING, DROP-CONTENTS, and +DROP-LOCALS are passed to `org-element--generate-copy-script'." + (let ((copy-buffer-fun (org-element--generate-copy-script + (current-buffer) + :copy-unreadable 'do-not-check + :drop-visibility drop-visibility + :drop-narrowing drop-narrowing + :drop-contents drop-contents + :drop-locals drop-locals)) + (new-buf (or to-buffer (generate-new-buffer (buffer-name))))) + (with-current-buffer new-buf + (funcall copy-buffer-fun) + (set-buffer-modified-p nil)) + new-buf)) + +(cl-defmacro org-element-with-buffer-copy ( &rest body + &key to-buffer drop-visibility + drop-narrowing drop-contents + drop-locals + &allow-other-keys) + "Apply BODY in a copy of the current buffer. +The copy preserves local variables, visibility and contents of +the original buffer. Point is at the beginning of the buffer +when BODY is applied. + +Optional keys can modify what is being copied and the generated buffer +copy. TO-BUFFER, DROP-VISIBILITY, DROP-NARROWING, DROP-CONTENTS, and +DROP-LOCALS are passed as arguments to `org-element-copy-buffer'." + (declare (debug t)) + ;; Drop keyword arguments from BODY. + (while (keywordp (car body)) (pop body) (pop body)) + (org-with-gensyms (buf-copy) + `(let ((,buf-copy (org-element-copy-buffer + :to-buffer ,to-buffer + :drop-visibility ,drop-visibility + :drop-narrowing ,drop-narrowing + :drop-contents ,drop-contents + :drop-locals ,drop-locals))) + (unwind-protect + (with-current-buffer ,buf-copy + (goto-char (point-min)) + (prog1 + (progn ,@body) + ;; `org-element-copy-buffer' carried the value of + ;; `buffer-file-name' from the original buffer. When not + ;; killed, the new buffer copy may become a target of + ;; `find-file'. Prevent this. + (setq buffer-file-name nil))) + (and (buffer-live-p ,buf-copy) + ;; Kill copy without confirmation. + (progn (with-current-buffer ,buf-copy + (restore-buffer-modified-p nil)) + (unless ,to-buffer + (kill-buffer ,buf-copy)))))))) + ;;; Accessors and Setters ;; @@ -497,38 +723,18 @@ past the brackets." ;; There is `org-element-put-property', `org-element-set-contents'. ;; These low-level functions are useful to build a parse tree. ;; -;; `org-element-adopt-elements', `org-element-set-element', -;; `org-element-extract-element' and `org-element-insert-before' are -;; high-level functions useful to modify a parse tree. +;; `org-element-adopt', `org-element-set', `org-element-extract' and +;; `org-element-insert-before' are high-level functions useful to +;; modify a parse tree. ;; ;; `org-element-secondary-p' is a predicate used to know if a given ;; object belongs to a secondary string. `org-element-class' tells if ;; some parsed data is an element or an object, handling pseudo ;; elements and objects. `org-element-copy' returns an element or -;; object, stripping its parent property in the process. - -(defsubst org-element-type (element) - "Return type of ELEMENT. +;; object, stripping its parent property and resolving deferred values +;; in the process. -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." - (if (stringp element) (get-text-property 0 property element) - (plist-get (nth 1 element) property))) - -(defsubst org-element-contents (element) - "Extract contents from an ELEMENT." - (cond ((not (consp element)) nil) - ((symbolp (car element)) (nthcdr 2 element)) - (t element))) +(require 'org-element-ast) (defsubst org-element-restriction (element) "Return restriction associated to ELEMENT. @@ -537,39 +743,13 @@ 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." - (if (stringp element) (org-add-props element nil property value) - (setcar (cdr element) (plist-put (nth 1 element) property value)) - element)) - -(defsubst org-element-set-contents (element &rest contents) - "Set ELEMENT's contents to CONTENTS. -Return ELEMENT." - (cond ((null element) contents) - ((not (symbolp (car element))) contents) - ((cdr element) (setcdr (cdr element) contents) element) - (t (nconc element contents)))) - -(defun org-element-secondary-p (object) - "Non-nil when OBJECT directly belongs to a secondary string. -Return value is the property name, as a keyword, or nil." - (let* ((parent (org-element-property :parent object)) - (properties (cdr (assq (org-element-type parent) - org-element-secondary-value-alist)))) - (catch 'exit - (dolist (p properties) - (and (memq object (org-element-property p parent)) - (throw 'exit p)))))) - (defsubst org-element-class (datum &optional parent) "Return class for ELEMENT, as a symbol. Class is either `element' or `object'. Optional argument PARENT is the element or object containing DATUM. It defaults to the value of DATUM `:parent' property." - (let ((type (org-element-type datum)) - (parent (or parent (org-element-property :parent datum)))) + (let ((type (org-element-type datum t)) + (parent (or parent (org-element-parent datum)))) (cond ;; Trivial cases. ((memq type org-element-all-objects) 'object) @@ -577,153 +757,98 @@ value of DATUM `:parent' property." ;; Special cases. ((eq type 'org-data) 'element) ((eq type 'plain-text) 'object) - ((not type) 'object) + ((eq type 'anonymous) 'object) + ((not type) nil) ;; Pseudo object or elements. Make a guess about its class. ;; Basically a pseudo object is contained within another object, ;; a secondary string or a container element. ((not parent) 'element) (t - (let ((parent-type (org-element-type parent))) - (cond ((not parent-type) 'object) + (let ((parent-type (org-element-type parent t))) + (cond ((eq 'anonymous parent-type) 'object) ((memq parent-type org-element-object-containers) 'object) ((org-element-secondary-p datum) 'object) (t 'element))))))) -(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." - (declare (indent 1)) - (if (not children) parent - ;; Link every child to PARENT. If PARENT is nil, it is a secondary - ;; string: parent is the list itself. - (dolist (child children) - (when child - (org-element-put-property child :parent (or parent children)))) - ;; Add CHILDREN at the end of PARENT contents. - (when parent - (apply #'org-element-set-contents - parent - (nconc (org-element-contents parent) children))) - ;; Return modified PARENT element. - (or parent children))) - -(defun org-element-extract-element (element) - "Extract ELEMENT from parse tree. -Remove element from the parse tree by side-effect, and return it -with its `:parent' property stripped out." - (let ((parent (org-element-property :parent element)) - (secondary (org-element-secondary-p element))) - (if secondary - (org-element-put-property - parent secondary - (delq element (org-element-property secondary parent))) - (apply #'org-element-set-contents - parent - (delq element (org-element-contents parent)))) - ;; Return ELEMENT with its :parent removed. - (org-element-put-property element :parent nil))) - -(defun org-element-insert-before (element location) - "Insert ELEMENT before LOCATION in parse tree. -LOCATION is an element, object or string within the parse tree. -Parse tree is modified by side effect." - (let* ((parent (org-element-property :parent location)) - (property (org-element-secondary-p location)) - (siblings (if property (org-element-property property parent) - (org-element-contents parent))) - ;; Special case: LOCATION is the first element of an - ;; independent secondary string (e.g. :title property). Add - ;; ELEMENT in-place. - (specialp (and (not property) - (eq siblings parent) - (eq (car parent) location)))) - ;; Install ELEMENT at the appropriate LOCATION within SIBLINGS. - (cond (specialp) - ((or (null siblings) (eq (car siblings) location)) - (push element siblings)) - ((null location) (nconc siblings (list element))) - (t - (let ((index (cl-position location siblings))) - (unless index (error "No location found to insert element")) - (push element (cdr (nthcdr (1- index) siblings)))))) - ;; Store SIBLINGS at appropriate place in parse tree. - (cond - (specialp (setcdr parent (copy-sequence parent)) (setcar parent element)) - (property (org-element-put-property parent property siblings)) - (t (apply #'org-element-set-contents parent siblings))) - ;; Set appropriate :parent property. - (org-element-put-property element :parent parent))) +(defsubst org-element-parent-element (object) + "Return first element containing OBJECT or nil. +OBJECT is the object to consider." + (org-element-lineage object org-element-all-elements)) + +(defsubst org-element-begin (node) + "Get `:begin' property of NODE." + (org-element-property :begin node)) + +(gv-define-setter org-element-begin (value node) + `(org-element-put-property ,node :begin ,value)) + +(defsubst org-element-end (node) + "Get `:end' property of NODE." + (org-element-property :end node)) + +(gv-define-setter org-element-end (value node) + `(org-element-put-property ,node :end ,value)) + +(defsubst org-element-contents-begin (node) + "Get `:contents-begin' property of NODE." + (org-element-property :contents-begin node)) + +(gv-define-setter org-element-contents-begin (value node) + `(org-element-put-property ,node :contents-begin ,value)) + +(defsubst org-element-contents-end (node) + "Get `:contents-end' property of NODE." + (org-element-property :contents-end node)) + +(gv-define-setter org-element-contents-end (value node) + `(org-element-put-property ,node :contents-end ,value)) + +(defsubst org-element-post-affiliated (node) + "Get `:post-affiliated' property of NODE." + (org-element-property :post-affiliated node)) + +(gv-define-setter org-element-post-affiliated (value node) + `(org-element-put-property ,node :post-affiliated ,value)) + +(defsubst org-element-post-blank (node) + "Get `:post-blank' property of NODE." + (org-element-property :post-blank node)) + +(gv-define-setter org-element-post-blank (value node) + `(org-element-put-property ,node :post-blank ,value)) (defconst org-element--cache-element-properties '(:cached - :org-element--cache-sync-key) + :org-element--cache-sync-key + :buffer) "List of element properties used internally by cache.") -(defun 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." - ;; Ensure OLD and NEW have the same parent. - (org-element-put-property new :parent (org-element-property :parent old)) - (dolist (p org-element--cache-element-properties) - (when (org-element-property p old) - (org-element-put-property new p (org-element-property p old)))) - (if (or (memq (org-element-type old) '(plain-text nil)) - (memq (org-element-type new) '(plain-text nil))) - ;; We cannot replace OLD with NEW since one of them is not an - ;; object or element. We take the long path. - (progn (org-element-insert-before new old) - (org-element-extract-element old)) - ;; 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. - (dolist (blob (org-element-contents new)) - (org-element-put-property blob :parent old)) - ;; Transfer contents. - (apply #'org-element-set-contents old (org-element-contents new)) - ;; Overwrite OLD's properties with NEW's. - (setcar (cdr old) (nth 1 new)) - ;; Transfer type. - (setcar old (car new)))) - -(defun org-element-create (type &optional props &rest children) - "Create a new element of type TYPE. -Optional argument PROPS, when non-nil, is a plist defining the -properties of the element. CHILDREN can be elements, objects or -strings." - (apply #'org-element-adopt-elements (list type props) children)) - -(defun org-element-copy (datum) - "Return a copy of DATUM. -DATUM is an element, object, string or nil. `:parent' property -is cleared and contents are removed in the process." - (when datum - (let ((type (org-element-type datum))) - (pcase type - (`org-data (list 'org-data nil)) - (`plain-text (substring-no-properties datum)) - (`nil (copy-sequence datum)) - (_ - (let ((element-copy (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil)))) - ;; We cannot simply return the copies property list. When - ;; DATUM is i.e. a headline, it's property list (`:title' - ;; in case of headline) can contain parsed objects. The - ;; objects will contain `:parent' property set to the DATUM - ;; itself. When copied, these inner `:parent' property - ;; values will contain incorrect object decoupled from - ;; DATUM. Changes to the DATUM copy will not longer be - ;; reflected in the `:parent' properties. So, we need to - ;; reassign inner `:parent' properties to the DATUM copy - ;; explicitly. - (org-element-map element-copy (cons 'plain-text org-element-all-objects) - (lambda (obj) (when (equal datum (org-element-property :parent obj)) - (org-element-put-property obj :parent element-copy)))) - element-copy)))))) - +(defvar org-element--string-cache (make-hash-table :test #'equal) + "Hash table holding tag strings and todo keyword objects. +We use shared string storage to reduce memory footprint of the syntax +tree.") + +(defsubst org-element--get-cached-string (string) + "Return cached object equal to STRING. +Return nil if STRING is nil." + (when string + (or (gethash string org-element--string-cache) + (puthash string string org-element--string-cache)))) + +(defun org-element--substring (element beg-offset end-offset) + "Get substring inside ELEMENT according to BEG-OFFSET and END-OFFSET." + (with-current-buffer (org-element-property :buffer element) + (org-with-wide-buffer + (let ((beg (org-element-begin element))) + (buffer-substring-no-properties + (+ beg beg-offset) (+ beg end-offset)))))) + +(defun org-element--unescape-substring (element beg-offset end-offset) + "Call `org-element--substring' and unescape the result. +See `org-element--substring' for the meaning of ELEMENT, BEG-OFFSET, +and END-OFFSET." + (org-unescape-code-in-string + (org-element--substring element beg-offset end-offset))) ;;; Greater elements @@ -758,7 +883,26 @@ is cleared and contents are removed in the process." ;; greater element requires tweaking `org-element--current-element'. ;; Moreover, the newly defined type must be added to both ;; `org-element-all-elements' and `org-element-greater-elements'. - +;; +;; When adding or modifying the parser, please keep in mind the +;; following rules. They are important to keep parser performance +;; optimal. +;; +;; 1. When you can use `looking-at-p' or `string-match-p' instead of +;; `looking-at' or `string-match' and keep match data unmodified, +;; do it. +;; 2. When regexps can be grouped together, avoiding multiple regexp +;; match calls, they should be grouped. +;; 3. When `save-match-data' can be avoided, avoid it. +;; 4. When simpler regexps can be used for analysis, use the simpler +;; regexps. +;; 5. When regexps can be calculated in advance, not dynamically, they +;; should be calculated in advance. +;; 6 Note that it is not an obligation of a given function to preserve +;; match data - `save-match-data' is costly and must be arranged by +;; the caller if necessary. +;; +;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=63225 ;;;; Center Block @@ -770,9 +914,9 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `center-block' and CDR is a plist -containing `:begin', `:end', `:contents-begin', `:contents-end', -`:post-blank' and `:post-affiliated' keywords. +Return a new syntax node of `center-block' type containing `:begin', +`:end', `:contents-begin', `:contents-end', `:post-blank' and +`:post-affiliated' properties. Assume point is at the beginning of the block." (let ((case-fold-search t)) @@ -794,15 +938,16 @@ Assume point is at the beginning of the block." (end (save-excursion (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'center-block - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))))) + (org-element-create + 'center-block + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) (defun org-element-center-block-interpreter (_ contents) "Interpret a center-block element as Org syntax. @@ -820,9 +965,9 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `drawer' and CDR is a plist containing -`:drawer-name', `:begin', `:end', `:contents-begin', -`:contents-end', `:post-blank' and `:post-affiliated' keywords. +Return a new syntax node of `drawer' type containing `:drawer-name', +`:begin', `:end', `:contents-begin', `:contents-end', `:post-blank' +and `:post-affiliated' properties. Assume point is at beginning of drawer." (let ((case-fold-search t)) @@ -836,7 +981,7 @@ Assume point is at beginning of drawer." (name (progn (looking-at org-element-drawer-re) - (match-string-no-properties 1))) + (org-element--get-cached-string (match-string-no-properties 1)))) (begin (car affiliated)) (post-affiliated (point)) ;; Empty drawers have no contents. @@ -849,16 +994,17 @@ Assume point is at beginning of drawer." (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'drawer - (nconc - (list :begin begin - :end end - :drawer-name name - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))))) + (org-element-create + 'drawer + (nconc + (list :begin begin + :end end + :drawer-name name + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) (defun org-element-drawer-interpreter (drawer contents) "Interpret DRAWER element as Org syntax. @@ -878,10 +1024,9 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `dynamic-block' and CDR is a plist -containing `:block-name', `:begin', `:end', `:contents-begin', -`:contents-end', `:arguments', `:post-blank' and -`:post-affiliated' keywords. +Return a new syntax node of `dynamic-block' type containing +`:block-name', `:begin', `:end', `:contents-begin', `:contents-end', +`:arguments', `:post-blank' and `:post-affiliated' properties. Assume point is at beginning of dynamic block." (let ((case-fold-search t)) @@ -893,7 +1038,7 @@ Assume point is at beginning of dynamic block." (save-excursion (let* ((name (progn (looking-at org-element-dynamic-block-open-re) - (match-string-no-properties 1))) + (org-element--get-cached-string (match-string-no-properties 1)))) (arguments (match-string-no-properties 2)) (begin (car affiliated)) (post-affiliated (point)) @@ -907,17 +1052,18 @@ Assume point is at beginning of dynamic block." (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'dynamic-block - (nconc - (list :begin begin - :end end - :block-name name - :arguments arguments - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (org-element-create + 'dynamic-block + (nconc + (list :begin begin + :end end + :block-name name + :arguments arguments + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-dynamic-block-interpreter (dynamic-block contents) "Interpret DYNAMIC-BLOCK element as Org syntax. @@ -945,15 +1091,15 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `footnote-definition' and CDR is -a plist containing `:label', `:begin' `:end', `:contents-begin', -`:contents-end', `:pre-blank',`:post-blank' and -`:post-affiliated' keywords. +Return a new syntax node of `footnote-definition' type containing +`:label', `:begin' `:end', `:contents-begin', `:contents-end', +`:pre-blank',`:post-blank' and `:post-affiliated' properties. Assume point is at the beginning of the footnote definition." (save-excursion (let* ((label (progn (looking-at org-footnote-definition-re) - (match-string-no-properties 1))) + (org-element--get-cached-string + (match-string-no-properties 1)))) (begin (car affiliated)) (post-affiliated (point)) (end @@ -988,17 +1134,18 @@ Assume point is at the beginning of the footnote definition." (progn (goto-char end) (skip-chars-backward " \r\t\n") (line-beginning-position 2)))) - (list 'footnote-definition - (nconc - (list :label label - :begin begin - :end end - :contents-begin contents-begin - :contents-end (and contents-begin contents-end) - :pre-blank pre-blank - :post-blank (count-lines contents-end end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (org-element-create + 'footnote-definition + (nconc + (list :label label + :begin begin + :end end + :contents-begin contents-begin + :contents-end (and contents-begin contents-end) + :pre-blank pre-blank + :post-blank (count-lines contents-end end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-footnote-definition-interpreter (footnote-definition contents) "Interpret FOOTNOTE-DEFINITION element as Org syntax. @@ -1018,8 +1165,9 @@ CONTENTS is the contents of the footnote-definition." ;;;; Headline -(defun org-element--get-node-properties (&optional at-point-p?) +(defun org-element--get-node-properties (&optional at-point-p? parent) "Return node properties for headline or property drawer at point. +The property values a deferred relative to PARENT element. Upcase property names. It avoids confusion between properties obtained through property drawer and default properties from the parser (e.g. `:end' and :END:). Return value is a plist. @@ -1027,37 +1175,53 @@ parser (e.g. `:end' and :END:). Return value is a plist. When AT-POINT-P? is nil, assume that point as at a headline. Otherwise parse properties for property drawer at point." (save-excursion - (unless at-point-p? - (forward-line) - (when (looking-at-p org-element-planning-line-re) (forward-line))) - (when (looking-at org-property-drawer-re) - (forward-line) - (let ((end (match-end 0)) properties) - (while (< (line-end-position) end) - (looking-at org-property-re) - (let* ((property-name (concat ":" (upcase (match-string 2)))) - (property-name-symbol (intern property-name)) - (property-value (match-string-no-properties 3))) - (cond - ((and (plist-member properties property-name-symbol) - (string-match-p "\\+$" property-name)) - (let ((val (plist-get properties property-name-symbol))) - (if (listp val) - (setq properties - (plist-put properties - property-name-symbol - (append (plist-get properties property-name-symbol) - (list property-value)))) - (plist-put properties property-name-symbol (list val property-value))))) - (t (setq properties (plist-put properties property-name-symbol property-value))))) - (forward-line)) - properties)))) + (let ((begin (or (org-element-begin parent) (point)))) + (unless at-point-p? + (forward-line) + (when (looking-at-p org-element-planning-line-re) (forward-line))) + (when (looking-at org-property-drawer-re) + (forward-line) + (let ((end (match-end 0)) properties) + (while (< (line-end-position) end) + (looking-at org-property-re) + (let* ((property-name (concat ":" (upcase (match-string 2)))) + (property-name-symbol (intern property-name)) + (property-value + (org-element-deferred-create + nil #'org-element--substring + (- (match-beginning 3) begin) + (- (match-end 3) begin)))) + (cond + ((and (plist-member properties property-name-symbol) + (string-match-p "\\+$" property-name)) + (let ((val (plist-get properties property-name-symbol))) + (if (listp val) + (setq properties + (plist-put properties + property-name-symbol + (append (plist-get properties property-name-symbol) + (list property-value)))) + (plist-put properties property-name-symbol (list val property-value))))) + (t (setq properties (plist-put properties property-name-symbol property-value))))) + (forward-line)) + ;; Convert list of deferred properties into a single + ;; deferred property. + (let ((plist properties) val) + (while plist + (setq val (cadr plist)) + (when (and (car-safe val) + (org-element-deferred-p (car val))) + (setcar + (cdr plist) + (org-element-deferred-create-list (cadr plist)))) + (setq plist (cddr plist)))) + properties))))) (defun org-element--get-time-properties () "Return time properties associated to headline at point. Return value is a plist." (save-excursion - (when (progn (forward-line) (looking-at org-element-planning-line-re)) + (when (progn (forward-line) (looking-at-p org-element-planning-line-re)) (let ((end (line-end-position)) plist) (while (re-search-forward org-element-planning-keywords-re end t) @@ -1071,16 +1235,179 @@ Return value is a plist." (t (setq plist (plist-put plist :closed time)))))) plist)))) +(defun org-element--headline-deferred (element) + "Parse and set extra properties for ELEMENT headline in BUFFER." + (with-current-buffer (org-element-property :buffer element) + (org-with-wide-buffer + ;; Update robust boundaries to not + ;; include property drawer and planning. + ;; Changes there can now invalidate the + ;; properties. + (org-element-put-property + element :robust-begin + (let ((contents-begin (org-element-contents-begin element)) + (contents-end (org-element-contents-end element))) + (when contents-begin + (progn (goto-char contents-begin) + (when (looking-at-p org-element-planning-line-re) + (forward-line)) + (when (looking-at org-property-drawer-re) + (goto-char (match-end 0))) + ;; If there is :pre-blank, we + ;; need to be careful about + ;; robust beginning. + (max (if (< (+ 2 contents-begin) contents-end) + (+ 2 contents-begin) + 0) + (point)))))) + (org-element-put-property + element :robust-end + (let ((contents-end (org-element-contents-end element)) + (robust-begin (org-element-property :robust-begin element))) + (when contents-end + (when (> (- contents-end 2) robust-begin) + (- contents-end 2))))) + (unless (org-element-property :robust-end element) + (org-element-put-property element :robust-begin nil)) + (goto-char (org-element-begin element)) + (setcar (cdr element) + (nconc + (nth 1 element) + (org-element--get-time-properties))) + (goto-char (org-element-begin element)) + (setcar (cdr element) + (nconc + (nth 1 element) + (org-element--get-node-properties nil element))))) + ;; Return nil. + nil) + +(defun org-element--headline-raw-value (headline beg-offset end-offset) + "Retrieve :raw-value in HEADLINE according to BEG-OFFSET and END-OFFSET." + (org-trim (org-element--substring headline beg-offset end-offset))) + +(defun org-element--headline-archivedp (headline) + "Return t when HEADLINE is archived and nil otherwise." + (if (member org-element-archive-tag + (org-element-property :tags headline)) + t nil)) + +(defun org-element--headline-footnote-section-p (headline) + "Return t when HEADLINE is a footnote section and nil otherwise." + (and org-footnote-section + (string= org-footnote-section + (org-element-property :raw-value headline)))) + +(defconst org-element--headline-comment-re + (concat org-element-comment-string "\\(?: \\|$\\)") + "Regexp matching comment string in a headline.") + +(defconst org-element--headline-archivedp + (org-element-deferred-create + nil #'org-element--headline-archivedp) + "Constant holding deferred value for headline `:archivedp' property.") + +(defconst org-element--headline-footnote-section-p + (org-element-deferred-create + nil #'org-element--headline-footnote-section-p) + "Constant holding deferred value for headline `:footnote-section-p' property.") + +(defconst org-element--headline-raw-value + (org-element-deferred-create-alias :raw-value) + "Constant holding deferred value for headline `:raw-value' property.") + +(defun org-element--headline-parse-title (headline raw-secondary-p) + "Resolve title properties of HEADLINE for side effect. +When RAW-SECONDARY-P is non-nil, headline's title will not be +parsed as a secondary string, but as a plain string instead. + +Throw `:org-element-deferred-retry' signal at the end." + (with-current-buffer (org-element-property :buffer headline) + (org-with-point-at (org-element-begin headline) + (let* ((begin (point)) + (true-level (prog1 (skip-chars-forward "*") + (skip-chars-forward " \t"))) + (level (org-reduced-level true-level)) + (todo (and org-todo-regexp + (let (case-fold-search) (looking-at (concat org-todo-regexp "\\(?: \\|$\\)"))) + (progn (goto-char (match-end 0)) + (skip-chars-forward " \t") + (org-element--get-cached-string (match-string-no-properties 1))))) + (todo-type + (and todo (if (member todo org-done-keywords) 'done 'todo))) + (priority (and (looking-at "\\[#.\\][ \t]*") + (progn (goto-char (match-end 0)) + (aref (match-string 0) 2)))) + (commentedp + (and (let ((case-fold-search nil)) + (looking-at org-element--headline-comment-re)) + (prog1 t + (goto-char (match-end 0)) + (skip-chars-forward " \t")))) + (title-start (point)) + (tags (when (re-search-forward + "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" + (line-end-position) + 'move) + (goto-char (match-beginning 0)) + (mapcar #'org-element--get-cached-string + (org-split-string (match-string-no-properties 1) ":")))) + (title-end (point)) + (raw-value + (org-element-deferred-create + nil #'org-element--headline-raw-value + (- title-start begin) (- title-end begin)))) + (org-element-put-property headline :raw-value raw-value) + (org-element-put-property headline :level level) + (org-element-put-property headline :priority priority) + (org-element-put-property headline :tags tags) + (org-element-put-property headline :todo-keyword todo) + (org-element-put-property headline :todo-type todo-type) + (org-element-put-property + headline :footnote-section-p org-element--headline-footnote-section-p) + (org-element-put-property headline :archivedp org-element--headline-archivedp) + (org-element-put-property headline :commentedp commentedp) + (org-element-put-property + headline :title + (if raw-secondary-p + org-element--headline-raw-value + (org-element--parse-objects + (progn (goto-char title-start) + (skip-chars-forward " \t") + (point)) + (progn (goto-char title-end) + (skip-chars-backward " \t") + (point)) + nil + (org-element-restriction + (org-element-type headline)) + headline)))))) + (throw :org-element-deferred-retry nil)) + +(defconst org-element--headline-parse-title-raw + (org-element-deferred-create + nil #'org-element--headline-parse-title t) + "Constant holding deferred value for raw headline `:title' property.") + +(defconst org-element--headline-parse-title-parse + (org-element-deferred-create + nil #'org-element--headline-parse-title nil) + "Constant holding deferred value for parsed headline `:title' property.") + +(defconst org-element--headline-deferred + (org-element-deferred-create + t #'org-element--headline-deferred) + "Constant holding deferred value for headline `:deferred' property.") + (defun org-element-headline-parser (&optional _ raw-secondary-p) "Parse a headline. -Return a list whose CAR is `headline' and CDR is a plist -containing `:raw-value', `:title', `:begin', `:end', -`:pre-blank', `:contents-begin' and `:contents-end', `:level', -`:priority', `:tags', `:todo-keyword', `:todo-type', `:scheduled', -`:deadline', `:closed', `:archivedp', `:commentedp' -`:footnote-section-p', `:post-blank' and `:post-affiliated' -keywords. +Return a new syntax node of `headline' type containing `:raw-value', +`:title', `:begin', `:end', `:pre-blank', `:contents-begin' and +`:contents-end', `:level', `:priority', `:tags', `:todo-keyword', +`:todo-type', `:scheduled', `:deadline', `:closed', `:archivedp', +`:commentedp' `:footnote-section-p', `:post-blank' and +`:post-affiliated' properties. The plist also contains any property set in the property drawer, with its name in upper cases and colons added at the @@ -1091,117 +1418,65 @@ parsed as a secondary string, but as a plain string instead. Assume point is at beginning of the headline." (save-excursion - (let* ((begin (point)) - (true-level (prog1 (skip-chars-forward "*") - (skip-chars-forward " \t"))) - (level (org-reduced-level true-level)) - (todo (and org-todo-regexp - (let (case-fold-search) (looking-at (concat org-todo-regexp " "))) - (progn (goto-char (match-end 0)) - (skip-chars-forward " \t") - (match-string 1)))) - (todo-type - (and todo (if (member todo org-done-keywords) 'done 'todo))) - (priority (and (looking-at "\\[#.\\][ \t]*") - (progn (goto-char (match-end 0)) - (aref (match-string 0) 2)))) - (commentedp - (and (let ((case-fold-search nil)) - (looking-at org-element-comment-string)) - (goto-char (match-end 0)) - (when (looking-at-p "\\(?:[ \t]\\|$\\)") - (point)))) - (title-start (prog1 (point) - (unless (or todo priority commentedp) - ;; Headline like "* :tag:" - (skip-chars-backward " \t")))) - (tags (when (re-search-forward - "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" - (line-end-position) - 'move) - (goto-char (match-beginning 0)) - (org-split-string (match-string 1) ":"))) - (title-end (point)) - (raw-value (org-trim - (buffer-substring-no-properties title-start title-end))) - (archivedp (member org-element-archive-tag tags)) - (footnote-section-p (and org-footnote-section - (string= org-footnote-section raw-value))) - (standard-props (org-element--get-node-properties)) - (time-props (org-element--get-time-properties)) - (end + (let* ((deferred-title-prop + (if raw-secondary-p + org-element--headline-parse-title-raw + org-element--headline-parse-title-parse)) + (begin (point)) + (true-level (skip-chars-forward "*")) + (end (save-excursion - (let ((re (rx-to-string - `(seq line-start (** 1 ,true-level "*") " ")))) - (if (re-search-forward re nil t) - (line-beginning-position) - (point-max))))) + (if (re-search-forward (org-headline-re true-level) nil t) + (line-beginning-position) + (point-max)))) (contents-begin (save-excursion (forward-line) (skip-chars-forward " \r\t\n" end) (and (/= (point) end) (line-beginning-position)))) - (contents-end (and contents-begin - (progn (goto-char end) - (skip-chars-backward " \r\t\n") - (line-beginning-position 2)))) - (robust-begin (and contents-begin - (progn (goto-char contents-begin) - (when (looking-at-p org-element-planning-line-re) - (forward-line)) - (when (looking-at org-property-drawer-re) - (goto-char (match-end 0))) - ;; If there is :pre-blank, we - ;; need to be careful about - ;; robust beginning. - (max (if (< (+ 2 contents-begin) contents-end) - (+ 2 contents-begin) - 0) - (point))))) - (robust-end (and robust-begin - (when (> (- contents-end 2) robust-begin) - (- contents-end 2))))) - (unless robust-end (setq robust-begin nil)) - (let ((headline - (list 'headline - (nconc - (list :raw-value raw-value - :begin begin - :end end - :pre-blank - (if (not contents-begin) 0 - (1- (count-lines begin contents-begin))) - :contents-begin contents-begin - :contents-end contents-end - :robust-begin robust-begin - :robust-end robust-end - :level level - :priority priority - :tags tags - :todo-keyword todo - :todo-type todo-type - :post-blank - (if contents-end - (count-lines contents-end end) - (1- (count-lines begin end))) - :footnote-section-p footnote-section-p - :archivedp archivedp - :commentedp commentedp - :post-affiliated begin) - time-props - standard-props)))) - (org-element-put-property - headline :title - (if raw-secondary-p raw-value - (org-element--parse-objects - (progn (goto-char title-start) - (skip-chars-forward " \t") - (point)) - (progn (goto-char title-end) - (skip-chars-backward " \t") - (point)) - nil - (org-element-restriction 'headline) - headline))))))) + (contents-end (and contents-begin end)) + (robust-begin + ;; If there is :pre-blank, we + ;; need to be careful about + ;; robust beginning. + (when contents-begin + (when (< (+ 2 contents-begin) contents-end) + (+ 2 contents-begin)))) + (robust-end (and robust-begin end))) + (org-element-create + 'headline + (list + :begin begin + :end end + :pre-blank + (if (not contents-begin) 0 + (1- (count-lines begin contents-begin))) + :contents-begin contents-begin + :contents-end contents-end + :robust-begin robust-begin + :robust-end robust-end + :true-level true-level + :buffer (current-buffer) + :raw-value deferred-title-prop + :title deferred-title-prop + :level deferred-title-prop + :priority deferred-title-prop + :tags deferred-title-prop + :todo-keyword deferred-title-prop + :todo-type deferred-title-prop + :post-blank + (if contents-end + ;; Trailing blank lines in org-data, headlines, and + ;; sections belong to the containing elements. + 0 + (1- (count-lines begin end))) + :footnote-section-p deferred-title-prop + :archivedp deferred-title-prop + :commentedp deferred-title-prop + :post-affiliated begin + :secondary (alist-get + 'headline + org-element-secondary-value-alist) + :deferred org-element--headline-deferred))))) (defun org-element-headline-interpreter (headline contents) "Interpret HEADLINE element as Org syntax. @@ -1248,82 +1523,104 @@ CONTENTS is the contents of the element." ;;;; org-data -(defun org-element--get-global-node-properties () - "Return node properties associated with the whole Org buffer. +(defun org-element--get-category () + "Return category in current buffer." + (let ((default-category + (cond ((null org-category) + (when (org-with-base-buffer nil + buffer-file-name) + (file-name-sans-extension + (file-name-nondirectory + (org-with-base-buffer nil + buffer-file-name))))) + ((symbolp org-category) (symbol-name org-category)) + (t org-category))) + category) + ;; Search for #+CATEGORY keywords. + (org-with-point-at (point-max) + (while (and (not category) + (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)) + (let ((element (org-element-at-point-no-context))) + (when (org-element-type-p element 'keyword) + (setq category (org-element-property :value element)))))) + ;; Return. + (or category default-category))) + +(defun org-element--get-global-node-properties (data) + "Set node properties associated with the whole Org buffer. Upcase property names. It avoids confusion between properties obtained through property drawer and default properties from the -parser (e.g. `:end' and :END:). Return value is a plist." - (org-with-wide-buffer - (goto-char (point-min)) - (while (and (org-at-comment-p) (bolp)) (forward-line)) - (org-element--get-node-properties t))) - +parser (e.g. `:end' and :END:). + +Alter DATA by side effect." + (with-current-buffer (org-element-property :buffer data) + (org-with-wide-buffer + (goto-char (point-min)) + (org-skip-whitespace) + (forward-line 0) + (while (and (org-at-comment-p) (bolp)) (forward-line)) + (let ((props (org-element--get-node-properties t data)) + (has-category? nil)) + (while props + (org-element-put-property data (car props) (cadr props)) + (when (eq (car props) :CATEGORY) (setq has-category? t)) + (setq props (cddr props))) + ;; CATEGORY not set in top-level property drawer. Go the long way. + (unless has-category? + (org-element-put-property data :CATEGORY (org-element--get-category))))) + ;; Return nil. + nil)) + +(defconst org-element--get-global-node-properties + (org-element-deferred-create + t #'org-element--get-global-node-properties) + "Constant holding `:deferred' property for org-data.") (defvar org-element-org-data-parser--recurse nil) (defun org-element-org-data-parser (&optional _) - "Parse org-data." + "Parse org-data. + +Return a new syntax node of `org-data' type containing `:begin', +`:contents-begin', `:contents-end', `:end', `:post-blank', +`:post-affiliated', and `:path' properties." (org-with-wide-buffer (let* ((begin 1) (contents-begin (progn (goto-char 1) (org-skip-whitespace) - (beginning-of-line) + (forward-line 0) (point))) (end (point-max)) - (pos-before-blank (progn (goto-char (point-max)) - (skip-chars-backward " \r\t\n") - (line-beginning-position 2))) - (robust-end (when (> (- pos-before-blank 2) contents-begin) - (- pos-before-blank 2))) + (contents-end end) + (robust-end contents-end) (robust-begin (when (and robust-end - (< (+ 2 contents-begin) pos-before-blank)) + (< (+ 2 contents-begin) end)) (or (org-with-wide-buffer (goto-char (point-min)) + (org-skip-whitespace) + (forward-line 0) (while (and (org-at-comment-p) (bolp)) (forward-line)) (when (looking-at org-property-drawer-re) (goto-char (match-end 0)) - (skip-chars-backward " \t") (min robust-end (point)))) - (+ 2 contents-begin)))) - (category (cond ((null org-category) - (when (org-with-base-buffer nil - buffer-file-name) - (file-name-sans-extension - (file-name-nondirectory - (org-with-base-buffer nil - buffer-file-name))))) - ((symbolp org-category) (symbol-name org-category)) - (t org-category))) - (category (catch 'buffer-category - (unless org-element-org-data-parser--recurse - (org-with-point-at end - ;; Avoid recursive calls from - ;; `org-element-at-point-no-context'. - (let ((org-element-org-data-parser--recurse t)) - (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t) - (org-element-with-disabled-cache - (let ((element (org-element-at-point-no-context))) - (when (eq (org-element-type element) 'keyword) - (throw 'buffer-category - (org-element-property :value element))))))))) - category)) - (properties (org-element--get-global-node-properties))) - (unless (plist-get properties :CATEGORY) - (setq properties (plist-put properties :CATEGORY category))) - (list 'org-data - (nconc - (list :begin begin - :contents-begin contents-begin - :contents-end pos-before-blank - :end end - :robust-begin robust-begin - :robust-end robust-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated begin - :path (buffer-file-name) - :mode 'org-data) - properties))))) + (+ 2 contents-begin))))) + (org-element-create + 'org-data + (list :begin begin + :contents-begin contents-begin + :contents-end contents-end + :end end + :robust-begin robust-begin + :robust-end robust-end + ;; Trailing blank lines in org-data, headlines, and + ;; sections belong to the containing elements. + :post-blank 0 + :post-affiliated begin + :path (buffer-file-name) + :mode 'org-data + :buffer (current-buffer) + :deferred org-element--get-global-node-properties))))) (defun org-element-org-data-interpreter (_ contents) "Interpret ORG-DATA element as Org syntax. @@ -1335,12 +1632,13 @@ CONTENTS is the contents of the element." (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', `:pre-blank', -`:contents-begin' and `:contents-end', `:level', `:priority', -`:raw-value', `:tags', `:todo-keyword', `:todo-type', -`:scheduled', `:deadline', `:closed', `:post-blank' and -`:post-affiliated' keywords. +Do not search past LIMIT. + +Return a new syntax node of `inlinetask' type containing `:title', +`:begin', `:end', `:pre-blank', `:contents-begin' and `:contents-end', +`:level', `:priority', `:raw-value', `:tags', `:todo-keyword', +`:todo-type', `:scheduled', `:deadline', `:closed', `:post-blank' and +`:post-affiliated' properties. The plist also contains any property set in the property drawer, with its name in upper cases and colons added at the @@ -1352,46 +1650,16 @@ string instead. Assume point is at beginning of the inline task." (save-excursion - (let* ((begin (point)) - (level (prog1 (org-reduced-level (skip-chars-forward "*")) - (skip-chars-forward " \t"))) - (todo (and org-todo-regexp - (let (case-fold-search) (looking-at org-todo-regexp)) - (progn (goto-char (match-end 0)) - (skip-chars-forward " \t") - (match-string 0)))) - (todo-type (and todo - (if (member todo org-done-keywords) 'done 'todo))) - (priority (and (looking-at "\\[#.\\][ \t]*") - (progn (goto-char (match-end 0)) - (aref (match-string 0) 2)))) - (commentedp - (and (let ((case-fold-search nil)) - (looking-at org-element-comment-string)) - (goto-char (match-end 0)) - (when (looking-at-p "\\(?:[ \t]\\|$\\)") - (point)))) - (title-start (prog1 (point) - (unless (or todo priority commentedp) - ;; Headline like "* :tag:" - (skip-chars-backward " \t")))) - (tags (when (re-search-forward - "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" - (line-end-position) - 'move) - (goto-char (match-beginning 0)) - (org-split-string (match-string 1) ":"))) - (title-end (point)) - (raw-value (org-trim - (buffer-substring-no-properties title-start title-end))) - (archivedp (member org-element-archive-tag tags)) + (let* ((deferred-title-prop + (if raw-secondary-p + org-element--headline-parse-title-raw + org-element--headline-parse-title-parse)) + (begin (point)) (task-end (save-excursion - (end-of-line) + (forward-line 1) (and (re-search-forward org-element-headline-re limit t) (looking-at-p "[ \t]*END[ \t]*$") (line-beginning-position)))) - (standard-props (and task-end (org-element--get-node-properties))) - (time-props (and task-end (org-element--get-time-properties))) (contents-begin (and task-end (< (point) task-end) (progn @@ -1402,42 +1670,34 @@ Assume point is at beginning of the inline task." (end (progn (when task-end (goto-char task-end)) (forward-line) (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position)))) - (inlinetask - (list 'inlinetask - (nconc - (list :raw-value raw-value - :begin begin - :end end - :pre-blank - (if (not contents-begin) 0 - (1- (count-lines begin contents-begin))) - :contents-begin contents-begin - :contents-end contents-end - :level level - :priority priority - :tags tags - :todo-keyword todo - :todo-type todo-type - :post-blank (1- (count-lines (or task-end begin) end)) - :post-affiliated begin - :archivedp archivedp - :commentedp commentedp) - time-props - standard-props)))) - (org-element-put-property - inlinetask :title - (if raw-secondary-p raw-value - (org-element--parse-objects - (progn (goto-char title-start) - (skip-chars-forward " \t") - (point)) - (progn (goto-char title-end) - (skip-chars-backward " \t") - (point)) - nil - (org-element-restriction 'inlinetask) - inlinetask)))))) + (if (eobp) (point) (line-beginning-position))))) + (org-element-create + 'inlinetask + (list + :begin begin + :end end + :pre-blank + (if (not contents-begin) 0 + (1- (count-lines begin contents-begin))) + :contents-begin contents-begin + :contents-end contents-end + :buffer (current-buffer) + :raw-value deferred-title-prop + :title deferred-title-prop + :level deferred-title-prop + :priority deferred-title-prop + :tags deferred-title-prop + :todo-keyword deferred-title-prop + :todo-type deferred-title-prop + :archivedp deferred-title-prop + :commentedp deferred-title-prop + :post-blank (1- (count-lines (or task-end begin) end)) + :post-affiliated begin + :secondary (alist-get + 'inlinetask + org-element-secondary-value-alist) + :deferred + (and task-end org-element--headline-deferred)))))) (defun org-element-inlinetask-interpreter (inlinetask contents) "Interpret INLINETASK element as Org syntax. @@ -1479,15 +1739,15 @@ CONTENTS is the contents of inlinetask." ;;;; Item -(defun org-element-item-parser (_ struct &optional raw-secondary-p) - "Parse an item. +(defun org-element-item-parser (limit struct &optional raw-secondary-p) + "Parse an item up to LIMIT. 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', `:pre-blank', -`:post-blank' and `:post-affiliated' keywords. +Return a new syntax node of `item' type containing `:bullet', +`:begin', `:end', `:contents-begin', `:contents-end', `:checkbox', +`:counter', `:tag', `:structure', `:pre-blank', `:post-blank' and +`:post-affiliated' properties. 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 @@ -1495,25 +1755,19 @@ string instead. Assume point is at the beginning of the item." (save-excursion - (beginning-of-line) + (forward-line 0) (looking-at org-list-full-item-re) (let* ((begin (point)) - (bullet (match-string-no-properties 1)) + (bullet (org-element--get-cached-string (match-string-no-properties 1))) + (tag-begin (match-beginning 4)) + (tag-end (match-end 4)) (checkbox (let ((box (match-string 3))) (cond ((equal "[ ]" box) 'off) ((equal "[X]" box) 'on) ((equal "[-]" box) 'trans)))) - (counter (let ((c (match-string 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 (progn (goto-char (nth 6 (assq (point) struct))) - (if (bolp) (point) (line-beginning-position 2)))) + (min limit + (if (bolp) (point) (line-beginning-position 2))))) (pre-blank 0) (contents-begin (progn @@ -1521,7 +1775,7 @@ Assume point is at the beginning of the item." ;; 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))) + (string-match-p "[.)]" bullet)) (match-beginning 4) (match-end 0))) (skip-chars-forward " \r\t\n" end) @@ -1537,26 +1791,38 @@ Assume point is at the beginning of the item." (progn (goto-char end) (skip-chars-backward " \r\t\n") (line-beginning-position 2)))) + (counter (let ((c (match-string 2))) + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string-no-properties 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string-no-properties 0 c)))))) (item - (list 'item - (list :bullet bullet - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :checkbox checkbox - :counter counter - :structure struct - :pre-blank pre-blank - :post-blank (count-lines (or contents-end begin) end) - :post-affiliated begin)))) + (org-element-create + 'item + (list :bullet bullet + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :checkbox checkbox + :counter counter + :structure struct + :pre-blank pre-blank + :post-blank (count-lines (or contents-end begin) end) + :post-affiliated begin + :secondary (alist-get + 'item + org-element-secondary-value-alist))))) (org-element-put-property item :tag (let ((raw (org-list-get-tag begin struct))) (when raw (if raw-secondary-p raw (org-element--parse-objects - (match-beginning 4) (match-end 4) nil + tag-begin tag-end nil (org-element-restriction 'item) item)))))))) @@ -1605,8 +1871,10 @@ CONTENTS is the contents of the element." ;;;; Plain List (defun org-element--list-struct (limit) - ;; Return structure of list at point. Internal function. See - ;; `org-list-struct' for details. +"Return structure of list at point. +Do not parse past LIMIT. + +Internal function. See `org-list-struct' for details." (let ((case-fold-search t) (top-ind limit) (item-re (org-item-re)) @@ -1628,11 +1896,11 @@ CONTENTS is the contents of the element." (dolist (item items) (setcar (nthcdr 6 item) end))) (throw :exit (sort (nconc items struct) #'car-less-than-car))) ;; At list end: end all items. - ((looking-at org-list-end-re) + ((looking-at-p org-list-end-re) (dolist (item items) (setcar (nthcdr 6 item) (point))) (throw :exit (sort (nconc items struct) #'car-less-than-car))) ;; At a new item: end previous sibling. - ((looking-at item-re) + ((looking-at-p item-re) (let ((ind (save-excursion (skip-chars-forward " \t") (org-current-text-column)))) (setq top-ind (min top-ind ind)) @@ -1648,17 +1916,17 @@ CONTENTS is the contents of the element." (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)) + (and + (string-match-p "[-+*]" bullet) + (match-string-no-properties 4)) ;; Ending position, unknown so far. nil))) items)) (forward-line)) ;; Skip empty lines. - ((looking-at "^[ \t]*$") (forward-line)) + ((looking-at-p "^[ \t]*$") (forward-line)) ;; Skip inline tasks and blank lines along the way. - ((and inlinetask-re (looking-at inlinetask-re)) + ((and inlinetask-re (looking-at-p inlinetask-re)) (forward-line) (let ((origin (point))) (when (re-search-forward inlinetask-re limit t) @@ -1684,7 +1952,7 @@ CONTENTS is the contents of the element." (re-search-forward (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1)) limit t))) - ((and (looking-at org-element-drawer-re) + ((and (looking-at-p org-element-drawer-re) (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))) (forward-line)))))))) @@ -1697,10 +1965,9 @@ keyword and CDR is a plist of affiliated keywords along with their value. STRUCTURE 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', `:post-blank' and -`:post-affiliated' keywords. +Return a new syntax node of `plain-list' type containing `:type', +`:begin', `:end', `:contents-begin' and `:contents-end', `:structure', +`:post-blank' and `:post-affiliated' properties. Assume point is at the beginning of the list." (save-excursion @@ -1717,30 +1984,43 @@ Assume point is at the beginning of the list." (= (nth 1 item) ind)) (setq pos (nth 6 item))) pos)) + (contents-end (progn (goto-char contents-end) + (skip-chars-backward " \r\t\n") + (if (bolp) (point) (line-beginning-position 2)))) (end (progn (goto-char contents-end) (skip-chars-forward " \r\t\n" limit) (if (= (point) limit) limit (line-beginning-position))))) ;; 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) - :post-affiliated contents-begin) - (cdr affiliated)))))) + (org-element-create + '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) + :post-affiliated contents-begin) + (cdr affiliated)))))) (defun org-element-plain-list-interpreter (_ 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))) + (org-element-with-buffer-copy + :to-buffer (org-get-buffer-create " *Org parse*" t) + :drop-contents t + :drop-visibility t + :drop-narrowing t + :drop-locals nil + ;; Transferring local variables may put the temporary buffer + ;; into a read-only state. Make sure we can insert CONTENTS. + (let ((inhibit-read-only t)) (erase-buffer) (insert contents)) + (goto-char (point-min)) + (org-list-repair) + ;; Prevent "Buffer *temp* modified; kill anyway?". + (restore-buffer-modified-p nil) + (buffer-string))) ;;;; Property Drawer @@ -1750,9 +2030,9 @@ CONTENTS is the contents of the element." LIMIT bounds the search. -Return a list whose car is `property-drawer' and cdr is a plist -containing `:begin', `:end', `:contents-begin', `:contents-end', -`:post-blank' and `:post-affiliated' keywords. +Return a new syntax node of `property-drawer' type containing +`:begin', `:end', `:contents-begin', `:contents-end', `:post-blank' +and `:post-affiliated' properties. Assume point is at the beginning of the property drawer." (save-excursion @@ -1765,13 +2045,14 @@ Assume point is at the beginning of the property drawer." (before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'property-drawer - (list :begin begin - :end end - :contents-begin (and contents-end contents-begin) - :contents-end contents-end - :post-blank (count-lines before-blank end) - :post-affiliated begin)))))) + (org-element-create + 'property-drawer + (list :begin begin + :end end + :contents-begin (and contents-end contents-begin) + :contents-end contents-end + :post-blank (count-lines before-blank end) + :post-affiliated begin)))))) (defun org-element-property-drawer-interpreter (_ contents) "Interpret property-drawer element as Org syntax. @@ -1789,9 +2070,9 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `quote-block' and CDR is a plist -containing `:begin', `:end', `:contents-begin', `:contents-end', -`:post-blank' and `:post-affiliated' keywords. +Return a new syntax node of `quote-block' type containing `:begin', +`:end', `:contents-begin', `:contents-end', `:post-blank' and +`:post-affiliated' properties. Assume point is at the beginning of the block." (let ((case-fold-search t)) @@ -1813,15 +2094,16 @@ Assume point is at the beginning of the block." (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'quote-block - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (org-element-create + 'quote-block + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-quote-block-interpreter (_ contents) "Interpret quote-block element as Org syntax. @@ -1834,30 +2116,32 @@ CONTENTS is the contents of the element." (defun org-element-section-parser (_) "Parse a section. -Return a list whose CAR is `section' and CDR is a plist -containing `:begin', `:end', `:contents-begin', `contents-end', -`:post-blank' and `:post-affiliated' keywords." +Return a new syntax node of `section' type containing `:begin', +`:end', `:contents-begin', `contents-end', `:post-blank' and +`:post-affiliated' properties." (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") - (line-beginning-position 2))) - (robust-end (when (> (- pos-before-blank 2) begin) - (- pos-before-blank 2))) - (robust-begin (when robust-end begin)) - ) - (list 'section - (list :begin begin - :end end - :contents-begin begin - :contents-end pos-before-blank - :robust-begin robust-begin - :robust-end robust-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated begin))))) + (end + (if (re-search-forward (org-get-limited-outline-regexp t) nil 'move) + (goto-char (match-beginning 0)) + (point))) + (contents-end end) + (robust-end end) + (robust-begin begin)) + (org-element-create + 'section + (list :begin begin + :end end + :contents-begin begin + :contents-end contents-end + :robust-begin robust-begin + :robust-end robust-end + ;; Trailing blank lines in org-data, headlines, and + ;; sections belong to the containing elements. + :post-blank 0 + :post-affiliated begin))))) (defun org-element-section-interpreter (_ contents) "Interpret section element as Org syntax. @@ -1875,20 +2159,20 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `special-block' and CDR is a plist -containing `:type', `:parameters', `:begin', `:end', -`:contents-begin', `:contents-end', `:post-blank' and -`:post-affiliated' keywords. +Return a new syntax node of `special-block' type containing `:type', +`:parameters', `:begin', `:end', `:contents-begin', `:contents-end', +`:post-blank' and `:post-affiliated' properties. Assume point is at the beginning of the block." (let* ((case-fold-search t) (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)[ \t]*\\(.*\\)[ \t]*$") - (match-string-no-properties 1))) + (org-element--get-cached-string + (match-string-no-properties 1)))) (parameters (match-string-no-properties 2))) (if (not (save-excursion - (re-search-forward - (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type)) - limit t))) + (re-search-forward + (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type)) + limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) (let ((block-end-line (match-beginning 0))) @@ -1905,18 +2189,19 @@ Assume point is at the beginning of the block." (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'special-block - (nconc - (list :type type - :parameters (and (org-string-nw-p parameters) - (org-trim parameters)) - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (org-element-create + 'special-block + (nconc + (list :type type + :parameters (and (org-string-nw-p parameters) + (org-trim parameters)) + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-special-block-interpreter (special-block contents) "Interpret SPECIAL-BLOCK element as Org syntax. @@ -1950,10 +2235,9 @@ the buffer position at the beginning of the first affiliated keyword and cdr is a plist of affiliated keywords along with their value. -Return a list whose car is `babel-call' and cdr is a plist -containing `:call', `:inside-header', `:arguments', -`:end-header', `:begin', `:end', `:value', `:post-blank' and -`:post-affiliated' as keywords." +Return a new syntax node of `babel-call' type containing `:call', +`:inside-header', `:arguments', `:end-header', `:begin', `:end', +`:value', `:post-blank' and `:post-affiliated' as properties." (save-excursion (let* ((begin (car affiliated)) (post-affiliated (point)) @@ -1978,18 +2262,19 @@ containing `:call', `:inside-header', `:arguments', (end (progn (forward-line) (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'babel-call - (nconc - (list :call call - :inside-header inside-header - :arguments arguments - :end-header end-header - :begin begin - :end end - :value value - :post-blank (count-lines before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (org-element-create + 'babel-call + (nconc + (list :call call + :inside-header inside-header + :arguments arguments + :end-header end-header + :begin begin + :end end + :value value + :post-blank (count-lines before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-babel-call-interpreter (babel-call _) "Interpret BABEL-CALL element as Org syntax." @@ -2009,16 +2294,15 @@ containing `:call', `:inside-header', `:arguments', LIMIT bounds the search. -Return a list whose CAR is `clock' and CDR is a plist containing -`:status', `:value', `:time', `:begin', `:end', `:post-blank' and -`:post-affiliated' as keywords." +Return a new syntax node of `clock' type containing `:status', +`:value', `:time', `:begin', `:end', `:post-blank' and +`:post-affiliated' as properties." (save-excursion - (let* ((case-fold-search nil) - (begin (point)) - (value (progn (search-forward "CLOCK:" (line-end-position) t) + (let* ((begin (point)) + (value (progn (search-forward "CLOCK:" (line-end-position)) (skip-chars-forward " \t") (org-element-timestamp-parser))) - (duration (and (search-forward " => " (line-end-position) t) + (duration (and (search-forward "=> " (line-end-position) t) (progn (skip-chars-forward " \t") (looking-at "\\(\\S-+\\)[ \t]*$")) (match-string-no-properties 1))) @@ -2026,17 +2310,18 @@ Return a list whose CAR is `clock' and CDR is a plist containing (post-blank (let ((before-blank (progn (forward-line) (point)))) (skip-chars-forward " \r\t\n" limit) (skip-chars-backward " \t") - (unless (bolp) (end-of-line)) + (unless (bolp) (skip-chars-forward " \t")) (count-lines before-blank (point)))) (end (point))) - (list 'clock - (list :status status - :value value - :duration duration - :begin begin - :end end - :post-blank post-blank - :post-affiliated begin))))) + (org-element-create + 'clock + (list :status status + :value value + :duration duration + :begin begin + :end end + :post-blank post-blank + :post-affiliated begin))))) (defun org-element-clock-interpreter (clock _) "Interpret CLOCK element as Org syntax." @@ -2058,21 +2343,20 @@ Return a list whose CAR is `clock' and CDR is a plist containing LIMIT bounds the search. -Return a list whose CAR is `comment' and CDR is a plist -containing `:begin', `:end', `:value', `:post-blank', -`:post-affiliated' keywords. +Return a new syntax node of `comment' type containing `:begin', +`:end', `:value', `:post-blank', `:post-affiliated' properties. Assume point is at comment beginning." (save-excursion (let* ((begin (point)) - (value (prog2 (looking-at "[ \t]*# ?") + (value (prog2 (looking-at org-comment-regexp) (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]*#\\( \\|$\\)")) + (while (and (< (point) limit) (looking-at org-comment-regexp)) ;; Accumulate lines without leading hash and first ;; whitespace. (setq value @@ -2085,12 +2369,13 @@ Assume point is at comment beginning." (end (progn (goto-char com-end) (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'comment - (list :begin begin - :end end - :value value - :post-blank (count-lines com-end end) - :post-affiliated begin))))) + (org-element-create + 'comment + (list :begin begin + :end end + :value value + :post-blank (count-lines com-end end) + :post-affiliated begin))))) (defun org-element-comment-interpreter (comment _) "Interpret COMMENT element as Org syntax. @@ -2108,9 +2393,8 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `comment-block' and CDR is a plist -containing `:begin', `:end', `:value', `:post-blank' and -`:post-affiliated' keywords. +Return a new syntax node of `comment-block' type containing `:begin', +`:end', `:value', `:post-blank' and `:post-affiliated' properties. Assume point is at comment block beginning." (let ((case-fold-search t)) @@ -2128,16 +2412,20 @@ Assume point is at comment block beginning." (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position)))) - (value (buffer-substring-no-properties - contents-begin contents-end))) - (list 'comment-block - (nconc - (list :begin begin - :end end - :value value - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (value + (org-element-deferred-create + nil #'org-element--substring + (- contents-begin begin) + (- contents-end begin)))) + (org-element-create + 'comment-block + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-comment-block-interpreter (comment-block _) "Interpret COMMENT-BLOCK element as Org syntax." @@ -2157,9 +2445,8 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `diary-sexp' and CDR is a plist -containing `:begin', `:end', `:value', `:post-blank' and -`:post-affiliated' keywords." +Return a new syntax node of `diary-sexp' type containing `:begin', +`:end', `:value', `:post-blank' and `:post-affiliated' properties." (save-excursion (let ((begin (car affiliated)) (post-affiliated (point)) @@ -2168,14 +2455,15 @@ containing `:begin', `:end', `:value', `:post-blank' and (pos-before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'diary-sexp - (nconc - (list :value value - :begin begin - :end end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (org-element-create + 'diary-sexp + (nconc + (list :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-diary-sexp-interpreter (diary-sexp _) "Interpret DIARY-SEXP as Org syntax." @@ -2192,10 +2480,10 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -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', `:switches', -`:value', `:post-blank' and `:post-affiliated' keywords." +Return a new syntax node of `example-block' type containing `:begin', +`:end', `:number-lines', `:preserve-indent', `:retain-labels', +`:use-labels', `:label-fmt', `:switches', `:value', `:post-blank' and +`:post-affiliated' properties." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t))) @@ -2221,49 +2509,52 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', ;; first line. (1- (string-to-number (match-string 2 switches))))))) (preserve-indent - (and switches (string-match "-i\\>" switches))) + (and switches (string-match-p "-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)))) + (not (string-match-p "-r\\>" switches)) + (and number-lines (string-match-p "-k\\>" switches)))) ;; What should code-references use - labels or ;; line-numbers? (use-labels (or (not switches) (and retain-labels - (not (string-match "-k\\>" switches))))) + (not (string-match-p "-k\\>" switches))))) (label-fmt (and switches (string-match "-l +\"\\([^\"\n]+\\)\"" switches) - (match-string 1 switches))) + (match-string-no-properties 1 switches))) ;; Standard block parsing. (begin (car affiliated)) (post-affiliated (point)) (contents-begin (line-beginning-position 2)) - (value (org-unescape-code-in-string - (buffer-substring-no-properties - contents-begin contents-end))) + (value + (org-element-deferred-create + nil #'org-element--unescape-substring + (- contents-begin begin) + (- contents-end begin))) (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (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 - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (org-element-create + '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 + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-example-block-interpreter (example-block _) "Interpret EXAMPLE-BLOCK element as Org syntax." @@ -2271,9 +2562,7 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', (value (let ((val (org-element-property :value example-block))) (cond - ((or org-src-preserve-indentation - (org-element-property :preserve-indent example-block)) - val) + ((org-src-preserve-indentation-p example-block) val) ((= 0 org-edit-src-content-indentation) (org-remove-indentation val)) (t @@ -2296,9 +2585,9 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `export-block' and CDR is a plist -containing `:begin', `:end', `:type', `:value', `:post-blank' and -`:post-affiliated' keywords. +Return a new syntax node of `export-block' type containing `:begin', +`:end', `:type', `:value', `:post-blank' and `:post-affiliated' +properties. Assume point is at export-block beginning." (let* ((case-fold-search t)) @@ -2321,18 +2610,21 @@ Assume point is at export-block beginning." (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position)))) - (value (org-unescape-code-in-string - (buffer-substring-no-properties contents-begin - contents-end)))) - (list 'export-block - (nconc - (list :type (and backend (upcase backend)) - :begin begin - :end end - :value value - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))))) + (value + (org-element-deferred-create + nil #'org-element--unescape-substring + (- contents-begin begin) + (- contents-end begin)))) + (org-element-create + 'export-block + (nconc + (list :type (and backend (upcase backend)) + :begin begin + :end end + :value value + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) (defun org-element-export-block-interpreter (export-block _) "Interpret EXPORT-BLOCK element as Org syntax." @@ -2351,9 +2643,8 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `fixed-width' and CDR is a plist -containing `:begin', `:end', `:value', `:post-blank' and -`:post-affiliated' keywords. +Return a new syntax node of `fixed-width' type containing `:begin', +`:end', `:value', `:post-blank' and `:post-affiliated' properties. Assume point is at the beginning of the fixed-width area." (save-excursion @@ -2362,22 +2653,23 @@ Assume point is at the beginning of the fixed-width area." (end-area (progn (while (and (< (point) limit) - (looking-at "[ \t]*:\\( \\|$\\)")) + (looking-at-p "[ \t]*:\\( \\|$\\)")) (forward-line)) (if (bolp) (line-end-position 0) (point)))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'fixed-width - (nconc - (list :begin begin - :end end - :value (replace-regexp-in-string - "^[ \t]*: ?" "" - (buffer-substring-no-properties post-affiliated - end-area)) - :post-blank (count-lines end-area end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (org-element-create + 'fixed-width + (nconc + (list :begin begin + :end end + :value (replace-regexp-in-string + "^[ \t]*: ?" "" + (buffer-substring-no-properties post-affiliated + end-area)) + :post-blank (count-lines end-area end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-fixed-width-interpreter (fixed-width _) "Interpret FIXED-WIDTH element as Org syntax." @@ -2397,22 +2689,22 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `horizontal-rule' and CDR is a plist -containing `:begin', `:end', `:post-blank' and `:post-affiliated' -keywords." +Return a new syntax node of `horizontal-rule' type containing +`:begin', `:end', `:post-blank' and `:post-affiliated' properties." (save-excursion (let ((begin (car affiliated)) (post-affiliated (point)) (post-hr (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'horizontal-rule - (nconc - (list :begin begin - :end end - :post-blank (count-lines post-hr end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (org-element-create + 'horizontal-rule + (nconc + (list :begin begin + :end end + :post-blank (count-lines post-hr end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-horizontal-rule-interpreter (&rest _) "Interpret HORIZONTAL-RULE element as Org syntax." @@ -2429,9 +2721,9 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is a normalized `keyword' (uppercase) and -CDR is a plist containing `:key', `:value', `:begin', `:end', -`:post-blank' and `:post-affiliated' keywords." +Return a new syntax node of `keyword' type containing `:key', +`:value', `:begin', `:end', `:post-blank' and `:post-affiliated' +properties." (save-excursion ;; An orphaned affiliated keyword is considered as a regular ;; keyword. In this case AFFILIATED is nil, so we take care of @@ -2439,21 +2731,23 @@ CDR is a plist containing `:key', `:value', `:begin', `:end', (let ((begin (or (car affiliated) (point))) (post-affiliated (point)) (key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):") - (upcase (match-string-no-properties 1)))) + (org-element--get-cached-string + (upcase (match-string-no-properties 1))))) (value (org-trim (buffer-substring-no-properties (match-end 0) (line-end-position)))) (pos-before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'keyword - (nconc - (list :key key - :value value - :begin begin - :end end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) + (org-element-create + 'keyword + (nconc + (list :key key + :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-keyword-interpreter (keyword _) "Interpret KEYWORD element as Org syntax." @@ -2471,6 +2765,10 @@ The environment is captured by the first group. See also `org-element--latex-end-environment'.") +(defconst org-element--latex-begin-environment-nogroup + "^[ \t]*\\\\begin{[A-Za-z0-9*]+}" + "Regexp matching the beginning of a LaTeX environment.") + (defconst org-element--latex-end-environment "\\\\end{%s}[ \t]*$" "Format string matching the ending of a LaTeX environment. @@ -2484,9 +2782,9 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `latex-environment' and CDR is a plist -containing `:begin', `:end', `:value', `:post-blank' and -`:post-affiliated' keywords. +Return a new syntax node of `latex-environment' type containing +`:begin', `:end', `:value', `:post-blank' and `:post-affiliated' +properties. Assume point is at the beginning of the latex environment." (save-excursion @@ -2494,23 +2792,28 @@ Assume point is at the beginning of the latex environment." (code-begin (point))) (looking-at org-element--latex-begin-environment) (if (not (re-search-forward (format org-element--latex-end-environment - (regexp-quote (match-string 1))) - limit t)) + (regexp-quote (match-string 1))) + limit t)) ;; Incomplete latex environment: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) (let* ((code-end (progn (forward-line) (point))) (begin (car affiliated)) - (value (buffer-substring-no-properties code-begin code-end)) + (value + (org-element-deferred-create + nil #'org-element--substring + (- code-begin begin) + (- code-end begin))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'latex-environment - (nconc - (list :begin begin - :end end - :value value - :post-blank (count-lines code-end end) - :post-affiliated code-begin) - (cdr affiliated)))))))) + (org-element-create + 'latex-environment + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines code-end end) + :post-affiliated code-begin) + (cdr affiliated)))))))) (defun org-element-latex-environment-interpreter (latex-environment _) "Interpret LATEX-ENVIRONMENT element as Org syntax." @@ -2519,31 +2822,26 @@ Assume point is at the beginning of the latex environment." ;;;; Node Property -(defun org-element-node-property-parser (limit) +(defun org-element-node-property-parser (_) "Parse a node-property at point. -LIMIT bounds the search. - -Return a list whose CAR is `node-property' and CDR is a plist -containing `:key', `:value', `:begin', `:end', `:post-blank' and -`:post-affiliated' keywords." +Return a new syntax node of `node-property' type containing `:key', +`:value', `:begin', `:end', `:post-blank' and `:post-affiliated' +properties." (looking-at org-property-re) - (let ((case-fold-search t) - (begin (point)) - (key (match-string-no-properties 2)) + (let ((begin (point)) + (key (org-element--get-cached-string + (match-string-no-properties 2))) (value (match-string-no-properties 3)) - (end (save-excursion - (end-of-line) - (if (re-search-forward org-property-re limit t) - (line-beginning-position) - limit)))) - (list 'node-property - (list :key key - :value value - :begin begin - :end end - :post-blank 0 - :post-affiliated begin)))) + (end (min (point-max) (1+ (match-end 0))))) + (org-element-create + 'node-property + (list :key key + :value value + :begin begin + :end end + :post-blank 0 + :post-affiliated begin)))) (defun org-element-node-property-interpreter (node-property _) "Interpret NODE-PROPERTY element as Org syntax." @@ -2562,9 +2860,9 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `paragraph' and CDR is a plist -containing `:begin', `:end', `:contents-begin' and -`:contents-end', `:post-blank' and `:post-affiliated' keywords. +Return a new syntax node of `paragraph' type containing `:begin', +`:end', `:contents-begin' and `:contents-end', `:post-blank' and +`:post-affiliated' properties. Assume point is at the beginning of the paragraph." (save-excursion @@ -2581,10 +2879,11 @@ Assume point is at the beginning of the paragraph." (while (not (cond ((not (and (re-search-forward - org-element-paragraph-separate limit 'move) - (progn (beginning-of-line) t)))) - ((looking-at org-element-drawer-re) + org-element-paragraph-separate limit 'move) + (progn (forward-line 0) t)))) + ((looking-at-p org-element-drawer-re) (save-excursion + (forward-line 1) (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") (save-excursion @@ -2611,15 +2910,16 @@ Assume point is at the beginning of the paragraph." (line-beginning-position 2))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'paragraph - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines before-blank end) - :post-affiliated contents-begin) - (cdr affiliated)))))) + (org-element-create + 'paragraph + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines before-blank end) + :post-affiliated contents-begin) + (cdr affiliated)))))) (defun org-element-paragraph-interpreter (_ contents) "Interpret paragraph element as Org syntax. @@ -2634,16 +2934,16 @@ CONTENTS is the contents of the element." LIMIT bounds the search. -Return a list whose CAR is `planning' and CDR is a plist -containing `:closed', `:deadline', `:scheduled', `:begin', -`:end', `:post-blank' and `:post-affiliated' keywords." +Return a new syntax node of `planning' type containing `:closed', +`:deadline', `:scheduled', `:begin', `:end', `:post-blank' and +`:post-affiliated' properties." (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) (skip-chars-backward " \t") - (unless (bolp) (end-of-line)) + (unless (bolp) (skip-chars-forward " \t")) (count-lines before-blank (point)))) (end (point)) closed deadline scheduled) @@ -2656,14 +2956,15 @@ containing `:closed', `:deadline', `:scheduled', `:begin', ((equal keyword org-element-closed-keyword) (setq closed time)) ((equal keyword org-element-deadline-keyword) (setq deadline time)) (t (setq scheduled time))))) - (list 'planning - (list :closed closed - :deadline deadline - :scheduled scheduled - :begin begin - :end end - :post-blank post-blank - :post-affiliated begin))))) + (org-element-create + 'planning + (list :closed closed + :deadline deadline + :scheduled scheduled + :begin begin + :end end + :post-blank post-blank + :post-affiliated begin))))) (defun org-element-planning-interpreter (planning _) "Interpret PLANNING element as Org syntax." @@ -2695,11 +2996,10 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `src-block' and CDR is a plist -containing `:language', `:switches', `:parameters', `:begin', -`:end', `:number-lines', `:retain-labels', `:use-labels', -`:label-fmt', `:preserve-indent', `:value', `:post-blank' and -`:post-affiliated' keywords. +Return a new syntax node of `src-block' type containing `:language', +`:switches', `:parameters', `:begin', `:end', `:number-lines', +`:retain-labels', `:use-labels', `:label-fmt', `:preserve-indent', +`:value', `:post-blank' and `:post-affiliated' properties. Assume point is at the beginning of the block." (let ((case-fold-search t)) @@ -2719,7 +3019,8 @@ Assume point is at the beginning of the block." \\(?: +\\(\\S-+\\)\\)?\ \\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\ \\(.*\\)[ \t]*$") - (match-string-no-properties 1))) + (org-element--get-cached-string + (match-string-no-properties 1)))) ;; Get switches. (switches (match-string-no-properties 2)) ;; Get parameters. @@ -2738,51 +3039,54 @@ Assume point is at the beginning of the block." ;; first line. (1- (string-to-number (match-string 2 switches))))))) (preserve-indent (and switches - (string-match "-i\\>" switches))) + (string-match-p "-i\\>" switches))) (label-fmt (and switches (string-match "-l +\"\\([^\"\n]+\\)\"" switches) - (match-string 1 switches))) + (match-string-no-properties 1 switches))) ;; Should labels be retained in (or stripped from) ;; source blocks? (retain-labels (or (not switches) - (not (string-match "-r\\>" switches)) - (and number-lines (string-match "-k\\>" switches)))) + (not (string-match-p "-r\\>" switches)) + (and number-lines (string-match-p "-k\\>" switches)))) ;; What should code-references use - labels or ;; line-numbers? (use-labels (or (not switches) (and retain-labels - (not (string-match "-k\\>" switches))))) + (not (string-match-p "-k\\>" switches))))) ;; Retrieve code. - (value (org-unescape-code-in-string - (buffer-substring-no-properties - (line-beginning-position 2) contents-end))) + (value + (org-element-deferred-create + nil #'org-element--unescape-substring + (- (line-beginning-position 2) begin) + (- contents-end begin))) (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) (line-beginning-position))))) - (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 - :value value - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (org-element-create + '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 + :value value + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-src-block-interpreter (src-block _) "Interpret SRC-BLOCK element as Org syntax." @@ -2792,9 +3096,7 @@ Assume point is at the beginning of the block." (value (let ((val (org-element-property :value src-block))) (cond - ((or org-src-preserve-indentation - (org-element-property :preserve-indent src-block)) - val) + ((org-src-preserve-indentation-p src-block) val) ((zerop org-edit-src-content-indentation) (org-remove-indentation val)) (t @@ -2819,16 +3121,15 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `table' and CDR is a plist containing -`:begin', `:end', `:tblfm', `:type', `:contents-begin', -`:contents-end', `:value', `:post-blank' and `:post-affiliated' -keywords. +Return a new syntax node of `table' type containing `:begin', `:end', +`:tblfm', `:type', `:contents-begin', `:contents-end', `:value', +`:post-blank' and `:post-affiliated' properties. Assume point is at the beginning of the table." (save-excursion (let* ((case-fold-search t) (table-begin (point)) - (type (if (looking-at "[ \t]*|") 'org 'table.el)) + (type (if (looking-at-p "[ \t]*|") 'org 'table.el)) (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)" (if (eq type 'org) "" "+"))) (begin (car affiliated)) @@ -2844,23 +3145,26 @@ Assume point is at the beginning of the table." (pos-before-blank (point)) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (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) - :post-affiliated table-begin) - (cdr affiliated)))))) + (org-element-create + '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) + (org-element-deferred-create + nil #'org-element--substring + (- table-begin begin) + (- table-end begin))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated table-begin) + (cdr affiliated)))))) (defun org-element-table-interpreter (table contents) "Interpret TABLE element as Org syntax. @@ -2880,11 +3184,11 @@ CONTENTS is a string, if table's type is `org', or nil." (defun org-element-table-row-parser (_) "Parse table row at point. -Return a list whose CAR is `table-row' and CDR is a plist -containing `:begin', `:end', `:contents-begin', `:contents-end', -`:type', `:post-blank' and `:post-affiliated' keywords." +Return a new syntax node of `table-row' type containing `:begin', +`:end', `:contents-begin', `:contents-end', `:type', `:post-blank' and +`:post-affiliated' properties." (save-excursion - (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard)) + (let* ((type (if (looking-at-p "^[ \t]*|-") 'rule 'standard)) (begin (point)) ;; A table rule has no contents. In that case, ensure ;; CONTENTS-BEGIN matches CONTENTS-END. @@ -2895,14 +3199,15 @@ containing `:begin', `:end', `:contents-begin', `:contents-end', (skip-chars-backward " \t") (point)))) (end (line-beginning-position 2))) - (list 'table-row - (list :type type - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank 0 - :post-affiliated begin))))) + (org-element-create + 'table-row + (list :type type + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank 0 + :post-affiliated begin))))) (defun org-element-table-row-interpreter (table-row contents) "Interpret TABLE-ROW element as Org syntax. @@ -2921,9 +3226,9 @@ the buffer position at the beginning of the first affiliated keyword and CDR is a plist of affiliated keywords along with their value. -Return a list whose CAR is `verse-block' and CDR is a plist -containing `:begin', `:end', `:contents-begin', `:contents-end', -`:post-blank' and `:post-affiliated' keywords. +Return a new syntax node of `verse-block' type containing `:begin', +`:end', `:contents-begin', `:contents-end', `:post-blank' and +`:post-affiliated' properties. Assume point is at beginning of the block." (let ((case-fold-search t)) @@ -2941,15 +3246,16 @@ Assume point is at beginning of the block." (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) - (list 'verse-block - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (org-element-create + 'verse-block + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-verse-block-interpreter (_ contents) "Interpret verse-block element as Org syntax. @@ -2991,7 +3297,7 @@ Assume point is at first MARK." `(seq (or line-start (any space ?- ?\( ?' ?\" ?\{)) ,mark (not space))))) - (when (looking-at opening-re) + (when (looking-at-p opening-re) (goto-char (1+ origin)) (let ((closing-re (rx-to-string @@ -3006,26 +3312,28 @@ Assume point is at first MARK." (let* ((post-blank (skip-chars-forward " \t")) (contents-begin (1+ origin)) (contents-end (1- closing))) - (list type - (append - (list :begin origin - :end (point) - :post-blank post-blank) - (if (memq type '(code verbatim)) - (list :value - (and (memq type '(code verbatim)) - (buffer-substring - contents-begin contents-end))) - (list :contents-begin contents-begin - :contents-end contents-end))))))))))))) + (org-element-create + type + (append + (list :begin origin + :end (point) + :post-blank post-blank) + (if (memq type '(code verbatim)) + (list :value + (and (memq type '(code verbatim)) + (org-element-deferred-create + nil #'org-element--substring + (- contents-begin origin) + (- contents-end origin)))) + (list :contents-begin contents-begin + :contents-end contents-end))))))))))))) (defun org-element-bold-parser () "Parse bold object at point, if any. -When at a bold object, return a list whose car is `bold' and cdr -is a plist with `:begin', `:end', `:contents-begin' and -`:contents-end' and `:post-blank' keywords. Otherwise, return -nil. +When at a bold object, return a new syntax node `bold' type containing +`:begin', `:end', `:contents-begin', `:contents-end', and +`:post-blank' properties. Otherwise, return nil. Assume point is at the first star marker." (org-element--parse-generic-emphasis "*" 'bold)) @@ -3041,16 +3349,17 @@ CONTENTS is the contents of the object." (defun org-element-citation-parser () "Parse citation object at point, if any. -When at a citation object, return a list whose car is `citation' -and cdr is a plist with `:style', `:prefix', `:suffix', `:begin', -`:end', `:contents-begin', `:contents-end', and `:post-blank' -keywords. Otherwise, return nil. +When at a citation object, return a new syntax node of `citation' type +containing `:style', `:prefix', `:suffix', `:begin', `:end', +`:contents-begin', `:contents-end', and `:post-blank' properties. +Otherwise, return nil. Assume point is at the beginning of the citation." (when (looking-at org-element-citation-prefix-re) (let* ((begin (point)) (style (and (match-end 1) - (match-string-no-properties 1))) + (org-element--get-cached-string + (match-string-no-properties 1)))) ;; Ignore blanks between cite type and prefix or key. (start (match-end 0)) (closing (with-syntax-table org-element--pair-square-table @@ -3062,13 +3371,17 @@ Assume point is at the beginning of the citation." (let ((first-key-end (match-end 0)) (types (org-element-restriction 'citation-reference)) (cite - (list 'citation - (list :style style - :begin begin - :post-blank (progn - (goto-char closing) - (skip-chars-forward " \t")) - :end (point))))) + (org-element-create + 'citation + (list :style style + :begin begin + :post-blank (progn + (goto-char closing) + (skip-chars-forward " \t")) + :end (point) + :secondary (alist-get + 'citation + org-element-secondary-value-alist))))) ;; `:contents-begin' depends on the presence of ;; a non-empty common prefix. (goto-char first-key-end) @@ -3118,15 +3431,16 @@ CONTENTS is the contents of the object, as a string." (defun org-element-citation-reference-parser () "Parse citation reference object at point, if any. -When at a reference, return a list whose car is -`citation-reference', and cdr is a plist with `:key', -`:prefix', `:suffix', `:begin', `:end', and `:post-blank' keywords. +When at a reference, return a new syntax node of `citation-reference' +type containing `:key', `:prefix', `:suffix', `:begin', `:end', and +`:post-blank' properties. Assume point is at the beginning of the reference." (save-excursion (let ((begin (point))) (when (re-search-forward org-element-citation-key-re nil t) - (let* ((key (match-string-no-properties 1)) + (let* ((key (org-element--get-cached-string + (match-string-no-properties 1))) (key-start (match-beginning 0)) (key-end (match-end 0)) (separator (search-forward ";" nil t)) @@ -3134,11 +3448,15 @@ Assume point is at the beginning of the reference." (suffix-end (if separator (1- end) end)) (types (org-element-restriction 'citation-reference)) (reference - (list 'citation-reference - (list :key key - :begin begin - :end end - :post-blank 0)))) + (org-element-create + 'citation-reference + (list :key key + :begin begin + :end end + :post-blank 0 + :secondary (alist-get + 'citation-reference + org-element-secondary-value-alist))))) (when (< begin key-start) (org-element-put-property reference :prefix @@ -3164,9 +3482,9 @@ Assume point is at the beginning of the reference." (defun org-element-code-parser () "Parse code object at point, if any. -When at a code object, return a list whose car is `code' and cdr -is a plist with `:value', `:begin', `:end' and `:post-blank' -keywords. Otherwise, return nil. +When at a code object, return a new syntax node of `code' type +containing `:value', `:begin', `:end' and `:post-blank' properties. +Otherwise, return nil. Assume point is at the first tilde marker." (org-element--parse-generic-emphasis "~" 'code)) @@ -3181,14 +3499,26 @@ Assume point is at the first tilde marker." (defun org-element-entity-parser () "Parse entity at point, if any. -When at an entity, 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. Otherwise, return nil. +When at an entity, return a new syntax node of `entity' type +containing `:begin', `:end', `:latex', `:latex-math-p', `:html', +`:latin1', `:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as +properties. Otherwise, return nil. Assume point is at the beginning of the entity." (catch 'no-object - (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)") + (when (looking-at + (rx "\\" + (or + ;; Special case: whitespace entities are matched by + ;; name only. + (group-n 1 (seq "_" (1+ " "))) + (seq + (group-n 1 + (or "there4" + (seq "sup" (in "123")) + (seq "frac" (in "13") (in "24")) + (1+ (in "a-zA-Z")))) + (group-n 2 (or eol "{}" (not letter))))))) (save-excursion (let* ((value (or (org-entity-get (match-string 1)) (throw 'no-object nil))) @@ -3198,18 +3528,19 @@ Assume point is at the beginning of the entity." (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))))))) + (org-element-create + '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 _) "Interpret ENTITY object as Org syntax." @@ -3223,32 +3554,37 @@ Assume point is at the beginning of the entity." (defun org-element-export-snippet-parser () "Parse export snippet at point. -When at an export snippet, return a list whose car is -`export-snippet' and cdr a plist with `:begin', `:end', -`:back-end', `:value' and `:post-blank' as keywords. Otherwise, -return nil. +When at an export snippet, return a new syntax node of +`export-snippet' type containing `:begin', `:end', `:back-end', +`:value' and `:post-blank' as properties. Otherwise, return nil. Assume point is at the beginning of the snippet." (save-excursion - (let (contents-end) - (when (and (looking-at "@@\\([-A-Za-z0-9]+\\):") - (setq contents-end - (save-match-data (goto-char (match-end 0)) - (when - (re-search-forward "@@" nil t) - (match-beginning 0))))) - (let* ((begin (match-beginning 0)) - (back-end (match-string-no-properties 1)) - (value (buffer-substring-no-properties - (match-end 0) contents-end)) - (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))))))) + (when (looking-at "@@\\([-A-Za-z0-9]+\\):") + (goto-char (match-end 0)) + (let* ((begin (match-beginning 0)) + (contents-begin (match-end 0)) + (backend (org-element--get-cached-string + (match-string-no-properties 1))) + (contents-end + (when (re-search-forward "@@" nil t) + (match-beginning 0))) + (value + (when contents-end + (org-element-deferred-create + nil #'org-element--substring + (- contents-begin begin) + (- contents-end begin)))) + (post-blank (skip-chars-forward " \t")) + (end (point))) + (when contents-end ; No match when no trailing "@@". + (org-element-create + 'export-snippet + (list :back-end backend + :value value + :begin begin + :end end + :post-blank post-blank))))))) (defun org-element-export-snippet-interpreter (export-snippet _) "Interpret EXPORT-SNIPPET object as Org syntax." @@ -3262,31 +3598,33 @@ Assume point is at the beginning of the snippet." (defun org-element-footnote-reference-parser () "Parse footnote reference at point, if any. -When at a footnote reference, return a list whose car is -`footnote-reference' and cdr a plist with `:label', `:type', -`:begin', `:end', `:contents-begin', `:contents-end' and -`:post-blank' as keywords. Otherwise, return nil." +When at a footnote reference, return a new syntax node of +`footnote-reference' type containing `:label', `:type', `:begin', +`:end', `:contents-begin', `:contents-end' and `:post-blank' as +properties. Otherwise, return nil." (when (looking-at org-footnote-re) (let ((closing (with-syntax-table org-element--pair-square-table (ignore-errors (scan-lists (point) 1 0))))) (when closing (save-excursion (let* ((begin (point)) - (label (match-string-no-properties 1)) + (label (org-element--get-cached-string + (match-string-no-properties 1))) (inner-begin (match-end 0)) (inner-end (1- closing)) (type (if (match-end 2) 'inline 'standard)) (post-blank (progn (goto-char closing) (skip-chars-forward " \t"))) (end (point))) - (list 'footnote-reference - (list :label label - :type type - :begin begin - :end end - :contents-begin (and (eq type 'inline) inner-begin) - :contents-end (and (eq type 'inline) inner-end) - :post-blank post-blank)))))))) + (org-element-create + 'footnote-reference + (list :label label + :type type + :begin begin + :end end + :contents-begin (and (eq type 'inline) inner-begin) + :contents-end (and (eq type 'inline) inner-end) + :post-blank post-blank)))))))) (defun org-element-footnote-reference-interpreter (footnote-reference contents) "Interpret FOOTNOTE-REFERENCE object as Org syntax. @@ -3301,10 +3639,10 @@ CONTENTS is its definition, when inline, or nil." (defun org-element-inline-babel-call-parser () "Parse inline babel call at point, if any. -When at an inline babel call, return a list whose car is -`inline-babel-call' and cdr a plist with `:call', -`:inside-header', `:arguments', `:end-header', `:begin', `:end', -`:value' and `:post-blank' as keywords. Otherwise, return nil. +When at an inline babel call, return a new syntax node of +`inline-babel-call' type containing `:call', `:inside-header', +`:arguments', `:end-header', `:begin', `:end', `:value' and +`:post-blank' as properties. Otherwise, return nil. Assume point is at the beginning of the babel call." (save-excursion @@ -3313,7 +3651,8 @@ Assume point is at the beginning of the babel call." (looking-at "\\. Unlike to @@ -3575,6 +3928,7 @@ Assume point is at the beginning of the link." ((looking-at org-link-angle-re) (setq format 'angle) (setq type (match-string-no-properties 1)) + (setq explicit-type-p t) (setq link-end (match-end 0)) (setq raw-link (buffer-substring-no-properties @@ -3591,10 +3945,10 @@ Assume point is at the beginning of the link." ;; Special "file"-type link processing. Extract opening ;; application and search option, if any. Also normalize URI. (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type) - (setq application (match-string 1 type)) + (setq application (match-string-no-properties 1 type)) (setq type "file") (when (string-match "::\\(.*\\)\\'" path) - (setq search-option (match-string 1 path)) + (setq search-option (match-string-no-properties 1 path)) (setq path (replace-match "" nil nil path))) (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path))) ;; Translate link, if `org-link-translation-function' is set. @@ -3602,19 +3956,22 @@ Assume point is at the beginning of the link." (funcall org-link-translation-function type path)))) (when trans (setq type (car trans)) + (setq explicit-type-p t) (setq path (cdr trans)))) - (list 'link - (list :type type - :path path - :format format - :raw-link (or raw-link path) - :application application - :search-option search-option - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) + (org-element-create + 'link + (list :type (org-element--get-cached-string type) + :type-explicit-p explicit-type-p + :path path + :format format + :raw-link (or raw-link path) + :application application + :search-option search-option + :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. @@ -3648,8 +4005,11 @@ CONTENTS is the contents of the object, or nil." ("custom-id" (concat "#" path)) ("file" (let ((app (org-element-property :application link)) - (opt (org-element-property :search-option link))) - (concat type (and app (concat "+" app)) ":" + (opt (org-element-property :search-option link)) + (type-explicit-p (org-element-property :type-explicit-p link))) + (concat (and type-explicit-p type) + (and type-explicit-p app (concat "+" app)) + (and type-explicit-p ":") path (and opt (concat "::" opt))))) ("fuzzy" path) @@ -3661,15 +4021,16 @@ CONTENTS is the contents of the object, or nil." (defun org-element-macro-parser () "Parse macro at point, if any. -When at a macro, return a list whose car is `macro' and cdr -a plist with `:key', `:args', `:begin', `:end', `:value' and -`:post-blank' as keywords. Otherwise, return nil. +When at a macro, return a new syntax node of `macro' type containing +`:key', `:args', `:begin', `:end', `:value' and `:post-blank' as +properties. Otherwise, return nil. Assume point is at the macro." (save-excursion - (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\([^\000]*?\\))\\)?}}}") + (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\(\\(?:.\\|\n\\)*?\\))\\)?}}}") (let ((begin (point)) - (key (downcase (match-string-no-properties 1))) + (key (org-element--get-cached-string + (downcase (match-string-no-properties 1)))) (value (match-string-no-properties 0)) (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) @@ -3679,13 +4040,14 @@ Assume point is at the macro." (a (org-macro-extract-arguments (replace-regexp-in-string "[ \t\r\n]+" " " (org-trim a))))))) - (list 'macro - (list :key key - :value value - :args args - :begin begin - :end end - :post-blank post-blank)))))) + (org-element-create + 'macro + (list :key key + :value value + :args args + :begin begin + :end end + :post-blank post-blank)))))) (defun org-element-macro-interpreter (macro _) "Interpret MACRO object as Org syntax." @@ -3701,10 +4063,9 @@ Assume point is at the macro." (defun org-element-radio-target-parser () "Parse radio target at point, if any. -When at a radio target, 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. -Otherwise, return nil. +When at a radio target, return a new syntax node of `radio-target' +type containing `:begin', `:end', `:contents-begin', `:contents-end', +`:value' and `:post-blank' as properties. Otherwise, return nil. Assume point is at the radio target." (save-excursion @@ -3716,13 +4077,14 @@ Assume point is at the radio target." (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)))))) + (org-element-create + '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 (_ contents) "Interpret target object as Org syntax. @@ -3735,9 +4097,9 @@ CONTENTS is the contents of the object." (defun org-element-statistics-cookie-parser () "Parse statistics cookie at point, if any. -When at a statistics cookie, return a list whose car is -`statistics-cookie', and cdr a plist with `:begin', `:end', -`:value' and `:post-blank' keywords. Otherwise, return nil. +When at a statistics cookie, return a new syntax node of +`statistics-cookie' type containing `:begin', `:end', `:value' and +`:post-blank' properties. Otherwise, return nil. Assume point is at the beginning of the statistics-cookie." (save-excursion @@ -3748,11 +4110,12 @@ Assume point is at the beginning of the statistics-cookie." (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)))))) + (org-element-create + 'statistics-cookie + (list :begin begin + :end end + :value value + :post-blank post-blank)))))) (defun org-element-statistics-cookie-interpreter (statistics-cookie _) "Interpret STATISTICS-COOKIE object as Org syntax." @@ -3764,10 +4127,10 @@ Assume point is at the beginning of the statistics-cookie." (defun org-element-strike-through-parser () "Parse strike-through object at point, if any. -When at a strike-through object, 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. -Otherwise, return nil. +When at a strike-through object, return a new syntax node of +`strike-through' type containing `:begin', `:end', `:contents-begin' +and `:contents-end' and `:post-blank' properties. Otherwise, return +nil. Assume point is at the first plus sign marker." (org-element--parse-generic-emphasis "+" 'strike-through)) @@ -3783,30 +4146,32 @@ CONTENTS is the contents of the object." (defun org-element-subscript-parser () "Parse subscript at point, if any. -When at a subscript object, 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. Otherwise, return nil. +When at a subscript object, return a new syntax node of `subscript' +type containing `:begin', `:end', `:contents-begin', `:contents-end', +`:use-brackets-p' and `:post-blank' as properties. Otherwise, return +nil. Assume point is at the underscore." (save-excursion - (unless (bolp) (backward-char)) - (when (looking-at org-match-substring-regexp) - (let ((bracketsp (match-beginning 4)) - (begin (match-beginning 2)) - (contents-begin (or (match-beginning 4) - (match-beginning 3))) - (contents-end (or (match-end 4) (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)))))) + (unless (bolp) + (backward-char) + (when (looking-at org-match-substring-regexp) + (let ((bracketsp (if (match-beginning 4) t nil)) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 4) + (match-beginning 3))) + (contents-end (or (match-end 4) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (org-element-create + '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. @@ -3821,16 +4186,16 @@ CONTENTS is the contents of the object." (defun org-element-superscript-parser () "Parse superscript at point, if any. -When at a superscript object, 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. Otherwise, return nil. +When at a superscript object, return a new syntax node of +`superscript' type containing `:begin', `:end', `:contents-begin', +`:contents-end', `:use-brackets-p' and `:post-blank' as properties. +Otherwise, return nil. Assume point is at the caret." (save-excursion (unless (bolp) (backward-char)) (when (looking-at org-match-substring-regexp) - (let ((bracketsp (match-beginning 4)) + (let ((bracketsp (if (match-beginning 4) t nil)) (begin (match-beginning 2)) (contents-begin (or (match-beginning 4) (match-beginning 3))) @@ -3838,13 +4203,14 @@ Assume point is at the caret." (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)))))) + (org-element-create + '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. @@ -3858,20 +4224,21 @@ CONTENTS is the contents of the object." (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." +Return a new syntax node of `table-cell' type containing `:begin', +`:end', `:contents-begin', `:contents-end' and `:post-blank' +properties." (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)))) + (org-element-create + 'table-cell + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank 0)))) (defun org-element-table-cell-interpreter (_ contents) "Interpret table-cell element as Org syntax. @@ -3884,9 +4251,9 @@ CONTENTS is the contents of the cell, or nil." (defun org-element-target-parser () "Parse target at point, if any. -When at a target, return a list whose car is `target' and cdr -a plist with `:begin', `:end', `:value' and `:post-blank' as -keywords. Otherwise, return nil. +When at a target, return a new syntax node of `target' type containing +`:begin', `:end', `:value' and `:post-blank' as properties. +Otherwise, return nil. Assume point is at the target." (save-excursion @@ -3896,11 +4263,12 @@ Assume point is at the target." (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)))))) + (org-element-create + 'target + (list :begin begin + :end end + :value value + :post-blank post-blank)))))) (defun org-element-target-interpreter (target _) "Interpret TARGET object as Org syntax." @@ -3914,20 +4282,26 @@ Assume point is at the target." "\\|" "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" "\\|" - "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") + "\\(?:<%%\\(?:([^>\n]+)\\)\\([^\n>]*\\)>\\)") "Regexp matching any timestamp type object.") +(defconst org-element--timestamp-raw-value-regexp + (concat "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\(" + org-ts-regexp-both + "\\)\\)?") + "Regexp for matching raw value of a timestamp.") + (defun org-element-timestamp-parser () "Parse time stamp at point, if any. -When at a time stamp, return a list whose car is `timestamp', and -cdr a plist with `:type', `:raw-value', `:year-start', +When at a time stamp, return a new syntax node of `timestamp' type +containing `:type', `:range-type', `:raw-value', `:year-start', `:month-start', `:day-start', `:hour-start', `:minute-start', -`:year-end', `:month-end', `:day-end', `:hour-end', -`:minute-end', `:repeater-type', `:repeater-value', -`:repeater-unit', `:warning-type', `:warning-value', -`:warning-unit', `:begin', `:end' and `:post-blank' keywords. -Otherwise, return nil. +`:year-end', `:month-end', `:day-end', `:hour-end', `:minute-end', +`:repeater-type', `:repeater-value', `:repeater-unit', +`:repeater-deadline-value', `:repeater-deadline-unit', `:warning-type', +`:warning-value', `:warning-unit', `:diary-sexp', `:begin', `:end' and +`:post-blank' properties. Otherwise, return nil. Assume point is at the beginning of the timestamp." (when (looking-at-p org-element--timestamp-regexp) @@ -3936,42 +4310,72 @@ Assume point is at the beginning of the timestamp." (activep (eq (char-after) ?<)) (raw-value (progn - (looking-at (concat "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\(" - org-ts-regexp-both - "\\)\\)?")) + (looking-at org-element--timestamp-raw-value-regexp) (match-string-no-properties 0))) - (date-start (match-string-no-properties 1)) - (date-end (match-string 3)) (diaryp (match-beginning 2)) + diary-sexp + (date-start (if diaryp + ;; Only consider part after sexp for + ;; diary timestamps. + (save-match-data + (looking-at org-element--timestamp-regexp) + (setq diary-sexp + (buffer-substring-no-properties + (+ 3 (match-beginning 0)) + (match-beginning 2))) + (match-string 2)) + (match-string-no-properties 1))) + (date-end (match-string-no-properties 3)) (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point)) (time-range - (and (not diaryp) - (string-match - "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" - date-start) - (cons (string-to-number (match-string 2 date-start)) - (string-to-number (match-string 3 date-start))))) + (when (string-match + "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" + date-start) + (cons (string-to-number (match-string 2 date-start)) + (string-to-number (match-string 3 date-start))))) (type (cond (diaryp 'diary) ((and activep (or date-end time-range)) 'active-range) (activep 'active) ((or date-end time-range) 'inactive-range) (t 'inactive))) - (repeater-props - (and (not diaryp) - (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)" - raw-value) - (list - :repeater-type - (let ((type (match-string 1 raw-value))) - (cond ((equal "++" type) 'catch-up) - ((equal ".+" type) 'restart) - (t 'cumulate))) - :repeater-value (string-to-number (match-string 2 raw-value)) - :repeater-unit - (pcase (string-to-char (match-string 3 raw-value)) - (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) + (range-type (cond + (date-end 'daterange) + (time-range 'timerange) + (t nil))) + (repeater-props + (and (not diaryp) + (string-match + (rx + (group-n 1 (or "+" "++" ".+")) + (group-n 2 (+ digit)) + (group-n 3 (any "hdwmy")) + (optional + "/" + (group-n 4 (+ digit)) + (group-n 5 (any "hdwmy")))) + raw-value) + (nconc + (list + :repeater-type + (let ((type (match-string 1 raw-value))) + (cond ((equal "++" type) 'catch-up) + ((equal ".+" type) 'restart) + (t 'cumulate))) + :repeater-value (string-to-number (match-string 2 raw-value)) + :repeater-unit + (pcase (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))) + + (let ((repeater-deadline-value (match-string 4 raw-value)) + (repeater-deadline-unit (match-string 5 raw-value))) + (when (and repeater-deadline-value repeater-deadline-unit) + (list + :repeater-deadline-value (string-to-number repeater-deadline-value) + :repeater-deadline-unit + (pcase (string-to-char repeater-deadline-unit) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))))) (warning-props (and (not diaryp) (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) @@ -3991,7 +4395,7 @@ Assume point is at the beginning of the timestamp." day-start (nth 3 date) hour-start (nth 2 date) minute-start (nth 1 date)))) - ;; Compute date-end. It can be provided directly in time-stamp, + ;; Compute date-end. It can be provided directly in timestamp, ;; or extracted from time range. Otherwise, it defaults to the ;; same values as date-start. (unless diaryp @@ -4001,129 +4405,181 @@ Assume point is at the beginning of the timestamp." day-end (or (nth 3 date) day-start) hour-end (or (nth 2 date) (car time-range) hour-start) minute-end (or (nth 1 date) (cdr time-range) minute-start)))) - (list 'timestamp - (nconc (list :type type - :raw-value raw-value - :year-start year-start - :month-start month-start - :day-start day-start - :hour-start hour-start - :minute-start minute-start - :year-end year-end - :month-end month-end - :day-end day-end - :hour-end hour-end - :minute-end minute-end - :begin begin - :end end - :post-blank post-blank) - repeater-props - warning-props)))))) + ;; Diary timestamp with time. + (when (and diaryp + (string-match "\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)?" date-start)) + (setq hour-start (match-string 1 date-start) + minute-start (match-string 2 date-start) + hour-end (match-string 4 date-start) + minute-end (match-string 5 date-start)) + (when hour-start (setq hour-start (string-to-number hour-start))) + (when minute-start (setq minute-start (string-to-number minute-start))) + (when hour-end (setq hour-end (string-to-number hour-end))) + (when minute-end (setq minute-end (string-to-number minute-end)))) + (org-element-create + 'timestamp + (nconc (list :type type + :range-type range-type + :raw-value raw-value + :year-start year-start + :month-start month-start + :day-start day-start + :hour-start hour-start + :minute-start minute-start + :year-end year-end + :month-end month-end + :day-end day-end + :hour-end hour-end + :minute-end minute-end + :begin begin + :end end + :post-blank post-blank) + (and diary-sexp (list :diary-sexp diary-sexp)) + repeater-props + warning-props)))))) (defun org-element-timestamp-interpreter (timestamp _) "Interpret TIMESTAMP object as Org syntax." - (let* ((repeat-string - (concat - (pcase (org-element-property :repeater-type timestamp) - (`cumulate "+") (`catch-up "++") (`restart ".+")) - (let ((val (org-element-property :repeater-value timestamp))) - (and val (number-to-string val))) - (pcase (org-element-property :repeater-unit timestamp) - (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) - (warning-string - (concat - (pcase (org-element-property :warning-type timestamp) - (`first "--") (`all "-")) - (let ((val (org-element-property :warning-value timestamp))) - (and val (number-to-string val))) - (pcase (org-element-property :warning-unit timestamp) - (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) - (build-ts-string - ;; Build an Org timestamp string from TIME. ACTIVEP is - ;; non-nil when time stamp is active. If WITH-TIME-P is - ;; non-nil, add a time part. HOUR-END and MINUTE-END - ;; specify a time range in the timestamp. REPEAT-STRING is - ;; the repeater string, if any. - (lambda (time activep &optional with-time-p hour-end minute-end) - (let ((ts (format-time-string - (org-time-stamp-format with-time-p) - time))) - (when (and hour-end minute-end) - (string-match "[012]?[0-9]:[0-5][0-9]" ts) - (setq ts - (replace-match - (format "\\&-%02d:%02d" hour-end minute-end) - nil nil ts))) - (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) - (dolist (s (list repeat-string warning-string)) - (when (org-string-nw-p s) - (setq ts (concat (substring ts 0 -1) - " " - s - (substring ts -1))))) - ;; Return value. - ts))) - (type (org-element-property :type timestamp))) - (pcase type - ((or `active `inactive) - (let* ((minute-start (org-element-property :minute-start timestamp)) - (minute-end (org-element-property :minute-end timestamp)) - (hour-start (org-element-property :hour-start timestamp)) - (hour-end (org-element-property :hour-end timestamp)) - (time-range-p (and hour-start hour-end minute-start minute-end - (or (/= hour-start hour-end) - (/= minute-start minute-end))))) - (funcall - build-ts-string - (org-encode-time 0 - (or minute-start 0) - (or hour-start 0) - (org-element-property :day-start timestamp) - (org-element-property :month-start timestamp) - (org-element-property :year-start timestamp)) - (eq type 'active) - (and hour-start minute-start) - (and time-range-p hour-end) - (and time-range-p minute-end)))) - ((or `active-range `inactive-range) - (let ((minute-start (org-element-property :minute-start timestamp)) - (minute-end (org-element-property :minute-end timestamp)) - (hour-start (org-element-property :hour-start timestamp)) - (hour-end (org-element-property :hour-end timestamp))) - (concat - (funcall - build-ts-string (org-encode-time - 0 - (or minute-start 0) - (or hour-start 0) - (org-element-property :day-start timestamp) - (org-element-property :month-start timestamp) - (org-element-property :year-start timestamp)) - (eq type 'active-range) - (and hour-start minute-start)) - "--" - (funcall build-ts-string - (org-encode-time - 0 - (or minute-end 0) - (or hour-end 0) - (org-element-property :day-end timestamp) - (org-element-property :month-end timestamp) - (org-element-property :year-end timestamp)) - (eq type 'active-range) - (and hour-end minute-end))))) - (_ (org-element-property :raw-value timestamp))))) - - + (let((type (org-element-property :type timestamp))) + (let ((day-start (org-element-property :day-start timestamp)) + (month-start (org-element-property :month-start timestamp)) + (year-start (org-element-property :year-start timestamp))) + ;; Return nil when start date is not available. Could also + ;; throw an error, but the current behavior is historical. + (when (or (and day-start month-start year-start) + (eq type 'diary)) + (let* ((repeat-string + (concat + (pcase (org-element-property :repeater-type timestamp) + (`cumulate "+") (`catch-up "++") (`restart ".+")) + (let ((val (org-element-property :repeater-value timestamp))) + (and val (number-to-string val))) + (pcase (org-element-property :repeater-unit timestamp) + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")) + (when-let ((repeater-deadline-value + (org-element-property :repeater-deadline-value timestamp)) + (repeater-deadline-unit + (org-element-property :repeater-deadline-unit timestamp))) + (concat + "/" + (number-to-string repeater-deadline-value) + (pcase repeater-deadline-unit + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))))) + (range-type (org-element-property :range-type timestamp)) + (warning-string + (concat + (pcase (org-element-property :warning-type timestamp) + (`first "--") (`all "-")) + (let ((val (org-element-property :warning-value timestamp))) + (and val (number-to-string val))) + (pcase (org-element-property :warning-unit timestamp) + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) + (hour-start (org-element-property :hour-start timestamp)) + (minute-start (org-element-property :minute-start timestamp)) + (brackets + (if (member + type + '(inactive inactive-range)) + (cons "[" "]") + ;; diary as well + (cons "<" ">"))) + (timestamp-end + (concat + (and (org-string-nw-p repeat-string) (concat " " repeat-string)) + (and (org-string-nw-p warning-string) (concat " " warning-string)) + (cdr brackets)))) + (concat + ;; Opening backet: [ or < + (car brackets) + ;; Starting date/time: YYYY-MM-DD DAY[ HH:MM] + (if (eq type 'diary) + (concat + "%%" + (org-element-property :diary-sexp timestamp) + (when (and minute-start hour-start) + (format " %02d:%02d" hour-start minute-start))) + (format-time-string + ;; `org-time-stamp-formats'. + (org-time-stamp-format + ;; Ignore time unless both HH:MM are available. + ;; Ignore means (car org-timestamp-formats). + (and minute-start hour-start) + 'no-brackets) + (org-encode-time + 0 (or minute-start 0) (or hour-start 0) + day-start month-start year-start))) + ;; Range: -HH:MM or TIMESTAMP-END--[YYYY-MM-DD DAY HH:MM] + (let ((hour-end (org-element-property :hour-end timestamp)) + (minute-end (org-element-property :minute-end timestamp))) + (pcase type + ((or `active `inactive) + ;; `org-element-timestamp-parser' uses this type + ;; when no time/date range is provided. So, + ;; should normally return nil in this clause. + (pcase range-type + (`nil + ;; `org-element-timestamp-parser' assigns end + ;; times for `active'/`inactive' TYPE if start + ;; time is not nil. But manually built + ;; timestamps may not contain end times, so + ;; check for end times anyway. + (when (and hour-start hour-end minute-start minute-end + (or (/= hour-start hour-end) + (/= minute-start minute-end))) + ;; Could also throw an error. Return range + ;; timestamp nevertheless to preserve + ;; historical behavior. + (format "-%02d:%02d" hour-end minute-end))) + ((or `timerange `daterange) + (error "`:range-type' must be `nil' for `active'/`inactive' type")))) + ;; Range must be present. + ((or `active-range `inactive-range + (and `diary (guard (eq 'timerange range-type)))) + (pcase range-type + ;; End time: -HH:MM. + ;; Fall back to start time if end time is not defined (arbitrary historical choice). + ;; Error will be thrown if both end and begin time is not defined. + (`timerange (format "-%02d:%02d" (or hour-end hour-start) (or minute-end minute-start))) + ;; End date: TIMESTAMP-END--[YYYY-MM-DD DAY HH:MM + ((or `daterange + ;; Should never happen in the output of `org-element-timestamp-parser'. + ;; Treat as an equivalent of `daterange' arbitrarily. + `nil) + (concat + ;; repeater + warning + closing > or ] + ;; This info is duplicated in date ranges. + timestamp-end + "--" (car brackets) + (format-time-string + ;; `org-time-stamp-formats'. + (org-time-stamp-format + ;; Ignore time unless both HH:MM are available. + ;; Ignore means (car org-timestamp-formats). + (and minute-end hour-end) + 'no-brackets) + (org-encode-time + ;; Closing HH:MM missing is a valid scenario. + 0 (or minute-end 0) (or hour-end 0) + ;; YEAR/MONTH/DAY-END will always be present + ;; for `daterange' range-type, as parsed by + ;; `org-element-timestamp-parser'. + ;; For manually constructed timestamp + ;; object, arbitrarily fall back to starting + ;; date. + (or (org-element-property :day-end timestamp) day-start) + (or (org-element-property :month-end timestamp) month-start) + (or (org-element-property :year-end timestamp) year-start))))))))) + ;; repeater + warning + closing > or ] + ;; This info is duplicated in date ranges. + timestamp-end)))))) ;;;; Underline (defun org-element-underline-parser () "Parse underline object at point, if any. -When at an underline object, return a list whose car is -`underline' and cdr is a plist with `:begin', `:end', -`:contents-begin' and `:contents-end' and `:post-blank' keywords. -Otherwise, return nil. +When at an underline object, return a new syntax node of `underline' +type containing `:begin', `:end', `:contents-begin' and +`:contents-end' and `:post-blank' properties. Otherwise, return nil. Assume point is at the first underscore marker." (org-element--parse-generic-emphasis "_" 'underline)) @@ -4139,9 +4595,9 @@ CONTENTS is the contents of the object." (defun org-element-verbatim-parser () "Parse verbatim object at point, if any. -When at a verbatim object, return a list whose car is `verbatim' -and cdr is a plist with `:value', `:begin', `:end' and -`:post-blank' keywords. Otherwise, return nil. +When at a verbatim object, return a new syntax node of `verbatim' type +containing `:value', `:begin', `:end' and `:post-blank' properties. +Otherwise, return nil. Assume point is at the first equal sign marker." (org-element--parse-generic-emphasis "=" 'verbatim)) @@ -4158,8 +4614,28 @@ Assume point is at the first equal sign marker." ;; It returns the Lisp representation of the element starting at ;; point. +(defconst org-element--current-element-re + (rx-to-string + `(or + (group-n 1 (regexp ,org-element--latex-begin-environment-nogroup)) + (group-n 2 (regexp ,org-element-drawer-re-nogroup)) + (group-n 3 (regexp "[ \t]*:\\( \\|$\\)")) + (group-n 7 (regexp ,org-element-dynamic-block-open-re-nogroup)) + (seq (group-n 4 (regexp "[ \t]*#\\+")) + (or + (seq "BEGIN_" (group-n 5 (1+ (not space)))) + (group-n 6 "CALL:") + (group-n 8 (1+ (not space)) ":"))) + (group-n 9 (regexp ,org-footnote-definition-re)) + (group-n 10 (regexp "[ \t]*-----+[ \t]*$")) + (group-n 11 "%%("))) + "Bulk regexp matching multiple elements in a single regexp. +This is a bit more efficient compared to invoking regexp search +multiple times.") + +(defvar org-inlinetask-min-level); Declared in org-inlinetask.el (defvar org-element--cache-sync-requests); Declared later -(defun org-element--current-element (limit &optional granularity mode structure add-to-cache) +(defsubst org-element--current-element (limit &optional granularity mode structure) "Parse the element starting at point. Return value is a list like (TYPE PROPS) where TYPE is the type @@ -4184,200 +4660,180 @@ Optional argument MODE, when non-nil, can be either If STRUCTURE isn't provided but MODE is set to `item', it will be computed. -Optional argument ADD-TO-CACHE, when non-nil, and when cache is active, -will also add current element to cache if it is not yet there. Use -this argument with care, as validity of the element in parse tree is -not checked. - This function assumes point is always at the beginning of the element it has to parse." - (let* ((element (and (not (buffer-narrowed-p)) - (org-element--cache-active-p) - (not org-element--cache-sync-requests) - (org-element--cache-find (point) t))) - (element (progn (while (and element - (not (and (eq (point) (org-element-property :begin element)) - (eq mode (org-element-property :mode element))))) - (setq element (org-element-property :parent element))) - element)) - (old-element element) - (element (when - (pcase (org-element-property :granularity element) - (`nil t) - (`object t) - (`element (not (memq granularity '(nil object)))) - (`greater-element (not (memq granularity '(nil object element)))) - (`headline (eq granularity 'headline))) - element))) - (if element - element - (save-excursion - (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)))) - result) - (setq - result - (cond - ;; Item. - ((eq mode 'item) - (org-element-item-parser limit structure raw-secondary-p)) - ;; Table Row. - ((eq mode 'table-row) (org-element-table-row-parser limit)) - ;; Node Property. - ((eq mode 'node-property) (org-element-node-property-parser limit)) - ;; Headline. - ((org-with-limited-levels (looking-at-p org-outline-regexp-bol)) - (org-element-headline-parser limit raw-secondary-p)) - ;; Sections (must be checked after headline). - ((eq mode 'section) (org-element-section-parser limit)) - ((eq mode 'first-section) - (org-element-section-parser - (or (save-excursion (org-with-limited-levels (outline-next-heading))) - limit))) - ;; Comments. - ((looking-at "^[ \t]*#\\(?: \\|$\\)") - (org-element-comment-parser limit)) - ;; Planning. - ((and (eq mode 'planning) - (eq ?* (char-after (line-beginning-position 0))) - (looking-at org-element-planning-line-re)) - (org-element-planning-parser limit)) - ;; Property drawer. - ((and (pcase mode - (`planning (eq ?* (char-after (line-beginning-position 0)))) - ((or `property-drawer `top-comment) - (save-excursion - (beginning-of-line 0) - (not (looking-at "[[:blank:]]*$")))) - (_ nil)) - (looking-at org-property-drawer-re)) - (org-element-property-drawer-parser 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 (list (point)))) - ;; Clock. - ((looking-at org-element-clock-line-re) - (org-element-clock-parser limit)) - ;; Inlinetask. - ((looking-at "^\\*+ ") - (org-element-inlinetask-parser limit raw-secondary-p)) - ;; From there, elements can have affiliated keywords. - (t (let ((affiliated (org-element--collect-affiliated-keywords - limit (memq granularity '(nil object))))) - (cond - ;; Jumping over affiliated keywords put point off-limits. - ;; Parse them as regular keywords. - ((and (cdr affiliated) (>= (point) limit)) - (goto-char (car affiliated)) - (org-element-keyword-parser limit nil)) - ;; LaTeX Environment. - ((looking-at org-element--latex-begin-environment) - (org-element-latex-environment-parser limit affiliated)) - ;; Drawer. - ((looking-at org-element-drawer-re) - (org-element-drawer-parser limit affiliated)) - ;; Fixed Width - ((looking-at "[ \t]*:\\( \\|$\\)") - (org-element-fixed-width-parser limit affiliated)) - ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and - ;; Keywords. - ((looking-at "[ \t]*#\\+") - (goto-char (match-end 0)) - (cond - ((looking-at "BEGIN_\\(\\S-+\\)") - (beginning-of-line) - (funcall (pcase (upcase (match-string 1)) - ("CENTER" #'org-element-center-block-parser) - ("COMMENT" #'org-element-comment-block-parser) - ("EXAMPLE" #'org-element-example-block-parser) - ("EXPORT" #'org-element-export-block-parser) - ("QUOTE" #'org-element-quote-block-parser) - ("SRC" #'org-element-src-block-parser) - ("VERSE" #'org-element-verse-block-parser) - (_ #'org-element-special-block-parser)) - limit - affiliated)) - ((looking-at "CALL:") - (beginning-of-line) - (org-element-babel-call-parser limit affiliated)) - ((save-excursion - (beginning-of-line) - (looking-at org-element-dynamic-block-open-re)) - (beginning-of-line) - (org-element-dynamic-block-parser limit affiliated)) - ((looking-at "\\S-+:") - (beginning-of-line) - (org-element-keyword-parser limit affiliated)) - (t - (beginning-of-line) - (org-element-paragraph-parser limit affiliated)))) - ;; Footnote Definition. - ((looking-at org-footnote-definition-re) - (org-element-footnote-definition-parser limit affiliated)) - ;; Horizontal Rule. - ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") - (org-element-horizontal-rule-parser limit affiliated)) - ;; Diary Sexp. - ((looking-at "%%(") - (org-element-diary-sexp-parser limit affiliated)) - ;; Table. - ((or (looking-at "[ \t]*|") - ;; There is no strict definition of a table.el - ;; table. Try to prevent false positive while being - ;; quick. - (let ((rule-regexp - (rx (zero-or-more (any " \t")) - "+" - (one-or-more (one-or-more "-") "+") - (zero-or-more (any " \t")) - eol)) - (non-table.el-line - (rx bol - (zero-or-more (any " \t")) - (or eol (not (any "+| \t"))))) - (next (line-beginning-position 2))) - ;; Start with a full rule. - (and - (looking-at rule-regexp) - (< next limit) ;no room for a table.el table - (save-excursion - (end-of-line) - (cond - ;; Must end with a full rule. - ((not (re-search-forward non-table.el-line limit 'move)) - (if (bolp) (forward-line -1) (beginning-of-line)) - (looking-at rule-regexp)) - ;; Ignore pseudo-tables with a single - ;; rule. - ((= next (line-beginning-position)) - nil) - ;; Must end with a full rule. - (t - (forward-line -1) - (looking-at rule-regexp))))))) - (org-element-table-parser limit affiliated)) - ;; List. - ((looking-at (org-item-re)) - (org-element-plain-list-parser - limit affiliated - (or structure (org-element--list-struct limit)))) - ;; Default element: Paragraph. - (t (org-element-paragraph-parser limit affiliated))))))) - (when result - (org-element-put-property result :mode mode) - (org-element-put-property result :granularity granularity)) - (when (and (not (buffer-narrowed-p)) - (org-element--cache-active-p) - (not org-element--cache-sync-requests) - add-to-cache) - (if (not old-element) - (setq result (org-element--cache-put result)) - (org-element-set-element old-element result) - (setq result old-element))) - result))))) + (save-excursion + (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)))) + result at-task?) + (setq + result + ;; Regexp matches below should avoid modifying match data, + ;; if possible. Doing it unnecessarily degrades regexp + ;; matching performance an order of magnitude, which + ;; becomes important when parsing large buffers with huge + ;; amount of elements to be parsed. + ;; + ;; In general, the checks below should be as efficient as + ;; possible, especially early in the `cond' form. (The + ;; early checks will contribute to al subsequent parsers as + ;; well). + (cond + ;; Item. + ((eq mode 'item) (org-element-item-parser limit structure raw-secondary-p)) + ;; Table Row. + ((eq mode 'table-row) (org-element-table-row-parser limit)) + ;; Node Property. + ((eq mode 'node-property) (org-element-node-property-parser limit)) + ;; Headline. + ((and (looking-at-p "^\\*+ ") + (setq at-task? t) + (or (not (featurep 'org-inlinetask)) + (save-excursion + (< (skip-chars-forward "*") + (if org-odd-levels-only + (1- (* org-inlinetask-min-level 2)) + org-inlinetask-min-level))))) + (org-element-headline-parser limit raw-secondary-p)) + ;; Sections (must be checked after headline). + ((memq mode '(section first-section)) (org-element-section-parser nil)) + ;; Comments. + ((looking-at-p org-comment-regexp) (org-element-comment-parser limit)) + ;; Planning. + ((and (eq mode 'planning) + (eq ?* (char-after (line-beginning-position 0))) + (looking-at-p org-element-planning-line-re)) + (org-element-planning-parser limit)) + ;; Property drawer. + ((and (pcase mode + (`planning (eq ?* (char-after (line-beginning-position 0)))) + ((or `property-drawer `top-comment) + ;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=63225#80 + (save-excursion + (forward-line -1) ; faster than beginning-of-line + (skip-chars-forward "[:blank:]") ; faster than looking-at-p + (or (not (eolp)) ; very cheap + ;; Document-wide property drawer may be preceded by blank lines. + (progn (skip-chars-backward " \t\n\r") (bobp))))) + (_ nil)) + (looking-at-p org-property-drawer-re)) + (org-element-property-drawer-parser 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 (list (point)))) + ;; Clock. + ((looking-at-p org-element-clock-line-re) (org-element-clock-parser limit)) + ;; Inlinetask. + (at-task? (org-element-inlinetask-parser limit raw-secondary-p)) + ;; From there, elements can have affiliated keywords. + ;; Note an edge case with a keyword followed by element that + ;; cannot have affiliated keywords attached (the above). + ;; `org-element--collect-affiliated-keywords' must have a + ;; special check to fall back to parsing proper keyword. + (t (let ((affiliated (org-element--collect-affiliated-keywords + limit (memq granularity '(nil object))))) + (cond + ;; Jumping over affiliated keywords put point off-limits. + ;; Parse them as regular keywords. + ((and (cdr affiliated) (>= (point) limit)) + (goto-char (car affiliated)) + (org-element-keyword-parser limit nil)) + ;; Do a single regexp match do reduce overheads for + ;; multiple regexp search invocations. + ((looking-at org-element--current-element-re) + (cond + ;; LaTeX Environment. + ((match-beginning 1) + (org-element-latex-environment-parser limit affiliated)) + ;; Drawer. + ((match-beginning 2) + (org-element-drawer-parser limit affiliated)) + ;; Fixed Width + ((match-beginning 3) + (org-element-fixed-width-parser limit affiliated)) + ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and + ;; Keywords. + ((match-beginning 5) + (funcall (pcase (upcase (match-string 5)) + ("CENTER" #'org-element-center-block-parser) + ("COMMENT" #'org-element-comment-block-parser) + ("EXAMPLE" #'org-element-example-block-parser) + ("EXPORT" #'org-element-export-block-parser) + ("QUOTE" #'org-element-quote-block-parser) + ("SRC" #'org-element-src-block-parser) + ("VERSE" #'org-element-verse-block-parser) + (_ #'org-element-special-block-parser)) + limit + affiliated)) + ((match-beginning 6) + (org-element-babel-call-parser limit affiliated)) + ((match-beginning 7) + (forward-line 0) + (org-element-dynamic-block-parser limit affiliated)) + ((match-beginning 8) + (org-element-keyword-parser limit affiliated)) + ((match-beginning 4) ;; #+, not matching a specific element. + (org-element-paragraph-parser limit affiliated)) + ;; Footnote Definition. + ((match-beginning 9) + (org-element-footnote-definition-parser limit affiliated)) + ;; Horizontal Rule. + ((match-beginning 10) + (org-element-horizontal-rule-parser limit affiliated)) + ;; Diary Sexp. + ((match-beginning 11) + (org-element-diary-sexp-parser limit affiliated)))) + ;; Table. + ((or (looking-at-p "[ \t]*|") + ;; There is no strict definition of a table.el + ;; table. Try to prevent false positive while being + ;; quick. + (let ((rule-regexp + (rx (zero-or-more (any " \t")) + "+" + (one-or-more (one-or-more "-") "+") + (zero-or-more (any " \t")) + eol)) + (non-table.el-line + (rx bol + (zero-or-more (any " \t")) + (or eol (not (any "+| \t"))))) + (next (line-beginning-position 2))) + ;; Start with a full rule. + (and + (looking-at-p rule-regexp) + (< next limit) ;no room for a table.el table + (save-excursion + (end-of-line) + (cond + ;; Must end with a full rule. + ((not (re-search-forward non-table.el-line limit 'move)) + (if (bolp) (forward-line -1) (forward-line 0)) + (looking-at-p rule-regexp)) + ;; Ignore pseudo-tables with a single + ;; rule. + ((= next (line-beginning-position)) + nil) + ;; Must end with a full rule. + (t + (forward-line -1) + (looking-at-p rule-regexp))))))) + (org-element-table-parser limit affiliated)) + ;; List. + ((looking-at-p (org-item-re)) + (org-element-plain-list-parser + limit affiliated + (or structure (org-element--list-struct limit)))) + ;; Default element: Paragraph. + (t (org-element-paragraph-parser limit affiliated))))))) + (when result + (org-element-put-property result :buffer (current-buffer)) + (org-element-put-property result :mode mode) + (org-element-put-property result :granularity granularity)) + result))) ;; Most elements can have affiliated keywords. When looking for an @@ -4416,16 +4872,13 @@ When PARSE is non-nil, values from keywords belonging to ;; value parsed. (parsed? (member kwd org-element-parsed-keywords)) ;; Find main value for any keyword. - (value - (let ((beg (match-end 0)) - (end (save-excursion - (end-of-line) - (skip-chars-backward " \t") - (point)))) - (if parsed? - (save-match-data - (org-element--parse-objects beg end nil restrict)) - (org-trim (buffer-substring-no-properties beg end))))) + (value-begin (match-end 0)) + (value-end + (save-excursion + (end-of-line) + (skip-chars-backward " \t") + (point))) + value ;; If KWD is a dual keyword, find its secondary value. ;; Maybe parse it. (dual? (member kwd org-element-dual-keywords)) @@ -4434,26 +4887,38 @@ When PARSE is non-nil, values from keywords belonging to (let ((sec (match-string-no-properties 2))) (cond ((and sec parsed?) - (save-match-data - (org-element--parse-objects - (match-beginning 2) (match-end 2) nil restrict))) + (org-element--parse-objects + (match-beginning 2) (match-end 2) nil restrict)) (sec sec))))) ;; Attribute a property name to KWD. (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) + (setq value + (if parsed? + (org-element--parse-objects + value-begin value-end nil restrict) + (org-trim (buffer-substring-no-properties + value-begin value-end)))) ;; Now set final shape for VALUE. (when dual? (setq value (and (or value dual-value) (cons value dual-value)))) (when (or (member kwd org-element-multiple-keywords) ;; Attributes can always appear on multiple lines. - (string-match "^ATTR_" kwd)) - (setq value (cons value (plist-get output kwd-sym)))) + (string-match-p "^ATTR_" kwd)) + (setq value (nconc (plist-get output kwd-sym) (list value)))) ;; Eventually store the new value in OUTPUT. (setq output (plist-put output kwd-sym value)) ;; Move to next keyword. (forward-line))) ;; If affiliated keywords are orphaned: move back to first one. ;; They will be parsed as a paragraph. - (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil)) + (when (or (looking-at-p "[ \t]*$") + ;; Affiliated keywords are not allowed before comments. + (looking-at-p org-comment-regexp) + ;; Clock lines are also not allowed. + (looking-at-p org-clock-line-re) + ;; Inlinetasks not allowed. + (looking-at-p "^\\*+ ")) + (goto-char origin) (setq output nil)) ;; Return value. (cons origin output)))) @@ -4472,7 +4937,7 @@ When PARSE is non-nil, values from keywords belonging to ;; resulting values. In an export situation, it also skips unneeded ;; parts of the parse tree. -(defun org-element-parse-buffer (&optional granularity visible-only) +(defun org-element-parse-buffer (&optional granularity visible-only keep-deferred) "Recursively parse the buffer and return structure. If narrowing is in effect, only parse the visible part of the buffer. @@ -4490,6 +4955,8 @@ recursion. It can be set to the following symbols: When VISIBLE-ONLY is non-nil, don't parse contents of hidden elements. +When KEEP-DEFERRED is non-nil, do not resolve deferred properties. + An element or object is represented as a list with the pattern (TYPE PROPERTIES CONTENTS), where : @@ -4498,7 +4965,7 @@ pattern (TYPE PROPERTIES CONTENTS), where : exhaustive list of such symbols. One can retrieve it with `org-element-type' function. - PROPERTIES is the list of attributes attached to the element or + PROPERTIES is the list of properties attached to the element or object, as a plist. Although most of them are specific to the element or object type, all types share `:begin', `:end', `:post-blank' and `:parent' properties, which respectively @@ -4521,11 +4988,18 @@ This function assumes that current major mode is `org-mode'." (let ((org-data (org-element-org-data-parser)) (gc-cons-threshold #x40000000)) (org-skip-whitespace) - (org-element--parse-elements - (line-beginning-position) (point-max) - ;; Start in `first-section' mode so text before the first - ;; headline belongs to a section. - 'first-section nil granularity visible-only org-data)))) + (setq org-data + (org-element--parse-elements + (line-beginning-position) (point-max) + ;; Start in `first-section' mode so text before the first + ;; headline belongs to a section. + 'first-section nil granularity visible-only org-data)) + (unless keep-deferred + (org-element-map ; undefer + org-data t + (lambda (el) (org-element-properties-resolve el t)) + nil nil nil t)) + org-data))) (defun org-element-parse-secondary-string (string restriction &optional parent) "Recursively parse objects in STRING and return structure. @@ -4541,24 +5015,31 @@ If STRING is the empty string or nil, return nil." (cond ((not string) nil) ((equal string "") nil) - (t (let ((local-variables (buffer-local-variables))) - (with-temp-buffer - (dolist (v local-variables) - (ignore-errors - (if (symbolp v) (makunbound v) - ;; Don't set file name to avoid mishandling hooks (bug#44524) - (unless (memq (car v) '(buffer-file-name buffer-file-truename)) - (set (make-local-variable (car v)) (cdr v)))))) - ;; Transferring local variables may put the temporary buffer - ;; into a read-only state. Make sure we can insert STRING. - (let ((inhibit-read-only t)) (insert string)) - ;; Prevent "Buffer *temp* modified; kill anyway?". - (restore-buffer-modified-p nil) - (org-element--parse-objects - (point-min) (point-max) nil restriction parent)))))) + (t (let (rtn) + (org-element-with-buffer-copy + :to-buffer (org-get-buffer-create " *Org parse*" t) + :drop-contents t + :drop-visibility t + :drop-narrowing t + :drop-locals nil + ;; Transferring local variables may put the temporary buffer + ;; into a read-only state. Make sure we can insert STRING. + (let ((inhibit-read-only t)) (erase-buffer) (insert string)) + ;; Prevent "Buffer *temp* modified; kill anyway?". + (restore-buffer-modified-p nil) + (setq rtn + (org-element--parse-objects + (point-min) (point-max) nil restriction parent)) + ;; Resolve deferred. + (org-element-map rtn t + (lambda (el) (org-element-properties-resolve el t))) + rtn))))) (defun org-element-map - (data types fun &optional info first-match no-recursion with-affiliated) + ( data types fun + &optional + info first-match no-recursion + with-affiliated no-undefer) "Map a function on selected elements or objects. DATA is a parse tree (for example, returned by @@ -4569,9 +5050,15 @@ elements or object types (see `org-element-all-elements' and function called on the matching element or object. It has to accept one argument: the element or object itself. +When TYPES is t, call FUN for all the elements and objects. + +FUN can also be a Lisp form. The form will be evaluated as function +with symbol `node' bound to the current node. + 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. +holding export options. In that case, elements of the parse tree +\\(compared with `eq') not exportable according to `:ignore-list' +property in 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. @@ -4585,8 +5072,18 @@ When optional argument WITH-AFFILIATED is non-nil, FUN will also apply to matching objects within parsed affiliated keywords (see `org-element-parsed-keywords'). +When optional argument NO-UNDEFER is non-nil, do not resolve deferred +values. + +FUN may throw `:org-element-skip' signal. Then, `org-element-map' +will not recurse into the current element. + Nil values returned from FUN do not appear in the results. +When buffer parse tree is used, elements and objects are generally +traversed in the same order they appear in text with a single +exception of dual keywords where secondary value is traversed after +the mail value. Examples: --------- @@ -4605,7 +5102,7 @@ of 1 and a \"phone\" tag, and will return its beginning position: (lambda (hl) (and (= (org-element-property :level hl) 1) (member \"phone\" (org-element-property :tags hl)) - (org-element-property :begin hl))) + (org-element-begin hl))) nil t) The next example will return a flat list of all `plain-list' type @@ -4623,99 +5120,35 @@ looking into captions: nil nil nil t)" (declare (indent 2)) ;; Ensure TYPES and NO-RECURSION are a list, even of one element. - (let* ((types (if (listp types) types (list types))) - (no-recursion (if (listp no-recursion) no-recursion - (list no-recursion))) - ;; Recursion depth is determined by --CATEGORY. - (--category - (catch :--found - (let ((category 'greater-elements) - (all-objects (cons 'plain-text org-element-all-objects))) - (dolist (type types category) - (cond ((memq type all-objects) - ;; 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)))))))) - (--ignore-list (plist-get info :ignore-list)) - --acc) - (letrec ((--walk-tree - (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 --ignore-list))) - ;; List of elements or objects. - ((not --type) (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 inside. - (when (and (eq --category 'objects) (not (stringp --data))) - (dolist (p (cdr (assq --type - org-element-secondary-value-alist))) - (funcall --walk-tree (org-element-property p --data)))) - ;; If --DATA has any parsed affiliated keywords and - ;; WITH-AFFILIATED is non-nil, look for objects in - ;; them. - (when (and with-affiliated - (eq --category 'objects) - (eq (org-element-class --data) 'element)) - (dolist (kwd-pair org-element--parsed-properties-alist) - (let ((kwd (car kwd-pair)) - (value (org-element-property (cdr kwd-pair) --data))) - ;; Pay attention to the type of parsed - ;; keyword. In particular, preserve order for - ;; multiple keywords. - (cond - ((not value)) - ((member kwd org-element-dual-keywords) - (if (member kwd org-element-multiple-keywords) - (dolist (line (reverse value)) - (funcall --walk-tree (cdr line)) - (funcall --walk-tree (car line))) - (funcall --walk-tree (cdr value)) - (funcall --walk-tree (car value)))) - ((member kwd org-element-multiple-keywords) - (mapc --walk-tree (reverse value))) - (t (funcall --walk-tree value)))))) - ;; 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) - (eq (org-element-class --data) 'object))) - ;; 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))))) + (when (and types data) + (let* ((ignore-list (plist-get info :ignore-list)) + (objects? + (or (eq types t) + (cl-intersection + (cons 'plain-text org-element-all-objects) + (if (listp types) types (list types))))) + (no-recursion + (append + (if (listp no-recursion) no-recursion + (list no-recursion)) + (unless objects? + org-element-all-objects) + (unless objects? + ;; Do not recurse into elements that can only contain + ;; objects. + (cl-set-difference + org-element-all-elements + org-element-greater-elements))))) + (org-element-ast-map + data types fun + ignore-list first-match + no-recursion + ;; Affiliated keywords may only contain objects. + (when (and with-affiliated objects?) + (mapcar #'cdr org-element--parsed-properties-alist)) + ;; Secondary strings may only contain objects. + (not objects?) + no-undefer)))) ;; The following functions are internal parts of the parser. ;; @@ -4789,23 +5222,10 @@ Elements are accumulated into ACC." (when (and (eolp) (not (eobp))) (forward-char))) ;; Find current element's type and parse it accordingly to ;; its category. - (let* ((element (org-element-copy - ;; `org-element--current-element' may return cached - ;; elements. Below code reassigns - ;; `:parent' property of the element and - ;; may interfere with cache - ;; synchronization if parent element is not - ;; yet in cache. Moreover, the returned - ;; structure may be altered by caller code - ;; arbitrarily. Hence, we return a copy of - ;; the potentially cached element to make - ;; potential modifications safe for element - ;; cache. - (org-element--current-element - end granularity mode structure))) + (let* ((element (org-element--current-element end granularity mode structure)) (type (org-element-type element)) - (cbeg (org-element-property :contents-begin element))) - (goto-char (org-element-property :end element)) + (cbeg (org-element-contents-begin element))) + (goto-char (org-element-end element)) ;; Fill ELEMENT contents by side-effect. (cond ;; If element has no contents, don't modify it. @@ -4820,7 +5240,7 @@ Elements are accumulated into ACC." (eq type 'section)) (eq type 'headline))) (org-element--parse-elements - cbeg (org-element-property :contents-end element) + cbeg (org-element-contents-end element) ;; Possibly switch to a special mode. (org-element--next-mode mode type t) (and (memq type '(item plain-list)) @@ -4830,7 +5250,7 @@ Elements are accumulated into ACC." ;; GRANULARITY allows it. ((memq granularity '(object nil)) (org-element--parse-objects - cbeg (org-element-property :contents-end element) element + cbeg (org-element-contents-end element) element (org-element-restriction type)))) (push (org-element-put-property element :parent acc) elements) ;; Update mode. @@ -4844,117 +5264,127 @@ Elements are accumulated into ACC." RESTRICTION is a list of object types, as symbols, that should be looked after. This function assumes that the buffer is narrowed to an appropriate container (e.g., a paragraph)." - (cond - ((memq 'table-cell restriction) (org-element-table-cell-parser)) - ((memq 'citation-reference restriction) - (org-element-citation-reference-parser)) - (t - (let* ((start (point)) - (limit - ;; Object regexp sometimes needs to have a peek at - ;; a character ahead. Therefore, when there is a hard - ;; limit, make it one more than the true beginning of the - ;; radio target. - (save-excursion - (cond ((not org-target-link-regexp) nil) - ((not (memq 'link restriction)) nil) - ((progn - (unless (bolp) (forward-char -1)) - (not (re-search-forward org-target-link-regexp nil t))) - nil) - ;; Since we moved backward, we do not want to - ;; match again an hypothetical 1-character long - ;; radio link before us. Realizing that this can - ;; only happen if such a radio link starts at - ;; beginning of line, we prevent this here. - ((and (= start (1+ (line-beginning-position))) - (= start (match-end 1))) - (and (re-search-forward org-target-link-regexp nil t) - (1+ (match-beginning 1)))) - (t (1+ (match-beginning 1)))))) - found) - (save-excursion - (while (and (not found) - (re-search-forward org-element--object-regexp limit 'move)) - (goto-char (match-beginning 0)) - (let ((result (match-string 0))) - (setq found - (cond - ((string-prefix-p "call_" result t) - (and (memq 'inline-babel-call restriction) - (org-element-inline-babel-call-parser))) - ((string-prefix-p "src_" result t) - (and (memq 'inline-src-block restriction) - (org-element-inline-src-block-parser))) - (t - (pcase (char-after) - (?^ (and (memq 'superscript restriction) - (org-element-superscript-parser))) - (?_ (or (and (memq 'subscript restriction) - (org-element-subscript-parser)) - (and (memq 'underline restriction) - (org-element-underline-parser)))) - (?* (and (memq 'bold restriction) - (org-element-bold-parser))) - (?/ (and (memq 'italic restriction) - (org-element-italic-parser))) - (?~ (and (memq 'code restriction) - (org-element-code-parser))) - (?= (and (memq 'verbatim restriction) - (org-element-verbatim-parser))) - (?+ (and (memq 'strike-through restriction) - (org-element-strike-through-parser))) - (?@ (and (memq 'export-snippet restriction) - (org-element-export-snippet-parser))) - (?{ (and (memq 'macro restriction) - (org-element-macro-parser))) - (?$ (and (memq 'latex-fragment restriction) - (org-element-latex-fragment-parser))) - (?< - (if (eq (aref result 1) ?<) - (or (and (memq 'radio-target restriction) - (org-element-radio-target-parser)) - (and (memq 'target restriction) - (org-element-target-parser))) - (or (and (memq 'timestamp restriction) - (org-element-timestamp-parser)) - (and (memq 'link restriction) - (org-element-link-parser))))) - (?\\ - (if (eq (aref result 1) ?\\) - (and (memq 'line-break restriction) - (org-element-line-break-parser)) - (or (and (memq 'entity restriction) - (org-element-entity-parser)) - (and (memq 'latex-fragment restriction) - (org-element-latex-fragment-parser))))) - (?\[ - (pcase (aref result 1) - ((and ?\[ - (guard (memq 'link restriction))) - (org-element-link-parser)) - ((and ?f - (guard (memq 'footnote-reference restriction))) - (org-element-footnote-reference-parser)) - ((and ?c - (guard (memq 'citation restriction))) - (org-element-citation-parser)) - ((and (or ?% ?/) - (guard (memq 'statistics-cookie restriction))) - (org-element-statistics-cookie-parser)) - (_ - (or (and (memq 'timestamp restriction) - (org-element-timestamp-parser)) - (and (memq 'statistics-cookie restriction) - (org-element-statistics-cookie-parser)))))) - ;; This is probably a plain link. - (_ (and (memq 'link restriction) - (org-element-link-parser))))))) - (or (eobp) (forward-char)))) - (cond (found) - (limit (forward-char -1) - (org-element-link-parser)) ;radio link - (t nil))))))) + (let (result) + (setq + result + (cond + ((memq 'table-cell restriction) (org-element-table-cell-parser)) + ((memq 'citation-reference restriction) + (org-element-citation-reference-parser)) + (t + (let* ((start (point)) + (limit + ;; Object regexp sometimes needs to have a peek at + ;; a character ahead. Therefore, when there is a hard + ;; limit, make it one more than the true beginning of the + ;; radio target. + (save-excursion + (cond ((not org-target-link-regexp) nil) + ((not (memq 'link restriction)) nil) + ((progn + (unless (bolp) (forward-char -1)) + (not + (if org-target-link-regexps + (org--re-list-search-forward org-target-link-regexps nil t) + (re-search-forward org-target-link-regexp nil t)))) + nil) + ;; Since we moved backward, we do not want to + ;; match again an hypothetical 1-character long + ;; radio link before us. Realizing that this can + ;; only happen if such a radio link starts at + ;; beginning of line, we prevent this here. + ((and (= start (1+ (line-beginning-position))) + (= start (match-end 1))) + (and + (if org-target-link-regexps + (org--re-list-search-forward org-target-link-regexps nil t) + (re-search-forward org-target-link-regexp nil t)) + (1+ (match-beginning 1)))) + (t (1+ (match-beginning 1)))))) + found) + (save-excursion + (while (and (not found) + (re-search-forward org-element--object-regexp limit 'move)) + (goto-char (match-beginning 0)) + (let ((result (match-string 0))) + (setq found + (cond + ((string-prefix-p "call_" result t) + (and (memq 'inline-babel-call restriction) + (org-element-inline-babel-call-parser))) + ((string-prefix-p "src_" result t) + (and (memq 'inline-src-block restriction) + (org-element-inline-src-block-parser))) + (t + (pcase (char-after) + (?^ (and (memq 'superscript restriction) + (org-element-superscript-parser))) + (?_ (or (and (memq 'underline restriction) + (org-element-underline-parser)) + (and (memq 'subscript restriction) + (org-element-subscript-parser)))) + (?* (and (memq 'bold restriction) + (org-element-bold-parser))) + (?/ (and (memq 'italic restriction) + (org-element-italic-parser))) + (?~ (and (memq 'code restriction) + (org-element-code-parser))) + (?= (and (memq 'verbatim restriction) + (org-element-verbatim-parser))) + (?+ (and (memq 'strike-through restriction) + (org-element-strike-through-parser))) + (?@ (and (memq 'export-snippet restriction) + (org-element-export-snippet-parser))) + (?{ (and (memq 'macro restriction) + (org-element-macro-parser))) + (?$ (and (memq 'latex-fragment restriction) + (org-element-latex-fragment-parser))) + (?< + (if (eq (aref result 1) ?<) + (or (and (memq 'radio-target restriction) + (org-element-radio-target-parser)) + (and (memq 'target restriction) + (org-element-target-parser))) + (or (and (memq 'timestamp restriction) + (org-element-timestamp-parser)) + (and (memq 'link restriction) + (org-element-link-parser))))) + (?\\ + (if (eq (aref result 1) ?\\) + (and (memq 'line-break restriction) + (org-element-line-break-parser)) + (or (and (memq 'entity restriction) + (org-element-entity-parser)) + (and (memq 'latex-fragment restriction) + (org-element-latex-fragment-parser))))) + (?\[ + (pcase (aref result 1) + ((and ?\[ + (guard (memq 'link restriction))) + (org-element-link-parser)) + ((and ?f + (guard (memq 'footnote-reference restriction))) + (org-element-footnote-reference-parser)) + ((and ?c + (guard (memq 'citation restriction))) + (org-element-citation-parser)) + ((and (or ?% ?/) + (guard (memq 'statistics-cookie restriction))) + (org-element-statistics-cookie-parser)) + (_ + (or (and (memq 'timestamp restriction) + (org-element-timestamp-parser)) + (and (memq 'statistics-cookie restriction) + (org-element-statistics-cookie-parser)))))) + ;; This is probably a plain link. + (_ (and (memq 'link restriction) + (org-element-link-parser))))))) + (or (eobp) (forward-char)))) + (cond (found) + (limit (forward-char -1) + (org-element-link-parser)) ;radio link + (t nil))))))) + (org-element-put-property result :buffer (current-buffer)))) (defun org-element--parse-objects (beg end acc restriction &optional parent) "Parse objects between BEG and END and return recursive structure. @@ -4975,20 +5405,20 @@ the list of objects itself." (while (and (not (eobp)) (setq next-object (org-element--object-lex restriction))) ;; Text before any object. - (let ((obj-beg (org-element-property :begin next-object))) + (let ((obj-beg (org-element-begin next-object))) (unless (= (point) obj-beg) (let ((text (buffer-substring-no-properties (point) obj-beg))) (push (if acc (org-element-put-property text :parent acc) text) contents)))) ;; Object... - (let ((obj-end (org-element-property :end next-object)) - (cont-beg (org-element-property :contents-begin next-object))) + (let ((obj-end (org-element-end next-object)) + (cont-beg (org-element-contents-begin next-object))) (when acc (org-element-put-property next-object :parent acc)) (push (if cont-beg ;; Fill contents of NEXT-OBJECT if possible. (org-element--parse-objects cont-beg - (org-element-property :contents-end next-object) + (org-element-contents-end next-object) next-object (org-element-restriction next-object)) next-object) @@ -5037,7 +5467,7 @@ to interpret. Return Org syntax as a string." (results (cond ;; Secondary string. - ((not type) + ((eq type 'anonymous) (mapconcat (lambda (obj) (funcall fun obj parent)) data "")) @@ -5072,16 +5502,16 @@ to interpret. Return Org syntax as a string." ;; an item or a footnote-definition, ;; ignore first line's indentation. (and (eq type 'paragraph) - (memq (org-element-type parent) - '(footnote-definition item)) + (org-element-type-p + parent '(footnote-definition item)) (eq data (car (org-element-contents parent))) (eq (org-element-property :pre-blank parent) 0))))) "")))))) - (if (memq type '(org-data nil)) results + (if (memq type '(org-data anonymous)) results ;; Build white spaces. If no `:post-blank' property ;; is specified, assume its value is 0. - (let ((blank (or (org-element-property :post-blank data) 0))) + (let ((blank (or (org-element-post-blank data) 0))) (if (eq (org-element-class data parent) 'object) (concat results (make-string blank ?\s)) (concat (org-element--interpret-affiliated-keywords data) @@ -5112,22 +5542,25 @@ If there is no affiliated keyword, return the empty string." (when value (if (or (member keyword org-element-multiple-keywords) ;; All attribute keywords can have multiple lines. - (string-match "^ATTR_" keyword)) + (string-match-p "^ATTR_" keyword)) (mapconcat (lambda (line) (funcall keyword-to-org keyword line)) - (reverse value) - "") + 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. - (cl-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) + (let (acc) + (org-element-properties-mapc + (lambda (prop _ __) + (let ((keyword (upcase (substring (symbol-name prop) 1)))) + (when (or (string-match-p "^ATTR_" keyword) + (and + (member keyword org-element-affiliated-keywords) + (not (assoc keyword + org-element-keyword-translation-alist)))) + (push prop acc)))) + element t) + (nreverse acc)) ""))) ;; Because interpretation of the parse tree must return the same @@ -5209,9 +5642,9 @@ indentation removed from its contents." (put-text-property (match-beginning 1) (match-end 1) 'org-ind i datum) (setq min-ind (min i min-ind)))))))) - ((eq (org-element-type datum) 'line-break) + ((org-element-type-p datum 'line-break) (setq first-flag t)) - ((memq (org-element-type datum) org-element-recursive-objects) + ((org-element-type-p datum org-element-recursive-objects) (setq min-ind (funcall find-min-ind datum first-flag min-ind))))))) (min-ind @@ -5225,8 +5658,9 @@ indentation removed from its contents." (lambda (datum) ;; Return DATUM with all its strings indentation ;; shortened from MIN-IND white spaces. - (setcdr - (cdr datum) + (apply + #'org-element-set-contents + datum (mapcar (lambda (object) (cond @@ -5243,8 +5677,7 @@ indentation removed from its contents." (point))) (when (integerp i) (indent-to (- i min-ind)))))) (buffer-string))) - ((memq (org-element-type object) - org-element-recursive-objects) + ((org-element-type-p object org-element-recursive-objects) (funcall build object)) (t object))) (org-element-contents datum))) @@ -5316,6 +5749,11 @@ indentation removed from its contents." (defvar org-element-cache-persistent t "Non-nil when cache should persist between Emacs sessions.") +(defconst org-element-cache-version "2.3" + "Version number for Org AST structure. +Used to avoid loading obsolete AST representation when using +`org-element-cache-persistent'.") + (defvar org-element-cache-sync-idle-time 0.6 "Length, in seconds, of idle time before syncing cache.") @@ -5338,6 +5776,13 @@ of `org-element--cache-self-verify-frequency'. When set to symbol `backtrace', record and display backtrace log if any inconsistency is detected.") +(defvar org-element--cache-self-verify-before-persisting nil + "Perform consistency checks for the cache before writing to disk. + +When non-nil, signal an error an show backtrace if cache contains +incorrect elements. `org-element--cache-self-verify' must be set to +symbol `backtrace' to have non-empty backtrace displayed.") + (defvar org-element--cache-self-verify-frequency 0.03 "Frequency of cache element verification. @@ -5357,8 +5802,8 @@ to be correct. Setting this to a value less than 0.0001 is useless.") "Detail level of the diagnostics.") (defvar-local org-element--cache-diagnostics-ring nil - "Ring containing last `org-element--cache-diagnostics-ring-size' -cache process log entries.") + "Ring containing cache process log entries. +The ring size is `org-element--cache-diagnostics-ring-size'.") (defvar org-element--cache-diagnostics-ring-size 5000 "Size of `org-element--cache-diagnostics-ring'.") @@ -5397,14 +5842,6 @@ When non-nil, it should be a vector representing POS arguments of `org-element--cache-find' called with non-nil, non-`both' SIDE argument. Also, see `org-element--cache-hash-size'.") -(defvar org-element--cache-hash-statistics '(0 . 0) - "Cons cell storing how Org makes use of `org-element--cache-find' caching. -The car is the number of successful uses and cdr is the total calls to -`org-element--cache-find'.") -(defvar org-element--cache-hash-nocache 0 - "Number of calls to `org-element--cache-has' with `both' SIDE argument. -These calls are not cached by hash. See `org-element--cache-hash-size'.") - (defvar-local org-element--cache-size 0 "Size of the `org-element--cache'. @@ -5518,7 +5955,8 @@ better to remove the commands advised in such a way from this list.") (prin1-to-string ,element))) (defmacro org-element--cache-log-message (format-string &rest args) - "Add a new log message for org-element-cache." + "Add a new log message for org-element-cache. +FORMAT-STRING and ARGS are the same arguments as in `foramt'." `(when (or org-element--cache-diagnostics (eq org-element--cache-self-verify 'backtrace)) (let* ((format-string (concat (format "org-element-cache diagnostics(%s): " @@ -5526,14 +5964,15 @@ better to remove the commands advised in such a way from this list.") ,format-string)) (format-string (funcall #'format format-string ,@args))) (if org-element--cache-diagnostics - (display-warning 'org-element-cache format-string) + (display-warning '(org-element org-element-cache) format-string) (unless org-element--cache-diagnostics-ring (setq org-element--cache-diagnostics-ring (make-ring org-element--cache-diagnostics-ring-size))) (ring-insert org-element--cache-diagnostics-ring format-string))))) (defmacro org-element--cache-warn (format-string &rest args) - "Raise warning for org-element-cache." + "Raise warning for org-element-cache. +FORMAT-STRING and ARGS are the same arguments as in `format'." `(let* ((format-string (funcall #'format ,format-string ,@args)) (format-string (if (or (not org-element--cache-diagnostics-ring) @@ -5550,7 +5989,8 @@ better to remove the commands advised in such a way from this list.") (setq org-element--cache-diagnostics-ring nil))))) (if (and (boundp 'org-batch-test) org-batch-test) (error "%s" (concat "org-element--cache: " format-string)) - (display-warning 'org-element-cache + (push (concat "org-element--cache: " format-string) org--warnings) + (display-warning '(org-element org-element-cache) (concat "org-element--cache: " format-string))))) (defsubst org-element--cache-key (element) @@ -5573,23 +6013,24 @@ cache during the synchronization get a new key generated with Such keys are stored inside the element property `:org-element--cache-sync-key'. The property is a cons containing current `org-element--cache-sync-keys-value' and the element key." - (or (when (eq org-element--cache-sync-keys-value (car (org-element-property :org-element--cache-sync-key element))) - (cdr (org-element-property :org-element--cache-sync-key element))) - (let* ((begin (org-element-property :begin element)) + (or (when-let ((key-cons (org-element-property :org-element--cache-sync-key element))) + (when (eq org-element--cache-sync-keys-value (car key-cons)) + (cdr key-cons))) + (let* ((begin (org-element-begin element)) + (type (org-element-type element)) ;; Increase beginning position of items (respectively ;; table rows) by one, so the first item can get ;; a different key from its parent list (respectively ;; table). - (key (if (memq (org-element-type element) '(item table-row)) - (1+ begin) - ;; Decrease beginning position of sections by one, - ;; so that the first element of the section get - ;; different key from the parent section. - (if (eq (org-element-type element) 'section) - (1- begin) - (if (eq (org-element-type element) 'org-data) - (- begin 2) - begin))))) + (key + (cond + ((memq type '(item table-row)) (1+ begin)) + ;; Decrease beginning position of sections by one, + ;; so that the first element of the section get + ;; different key from the parent section. + ((eq type 'section) (1- begin)) + ((eq type 'org-data) (- begin 2)) + (t begin)))) (when org-element--cache-sync-requests (org-element-put-property element @@ -5690,7 +6131,7 @@ position." ;; than B (A is longer). Therefore, return nil. (and (null a) b))))) -(defun org-element--cache-compare (a b) +(defsubst org-element--cache-compare (a b) "Non-nil when element A is located before element B." (org-element--cache-key-less-p (org-element--cache-key a) (org-element--cache-key b))) @@ -5706,16 +6147,18 @@ This function assumes `org-element--headline-cache' is a valid AVL tree." ;;;; Tools -;; FIXME: Ideally, this should be inlined to avoid overheads, but -;; inlined functions should be declared before the code that uses them -;; and some code above does use `org-element--cache-active-p'. Moving this -;; declaration on top would require restructuring the whole cache -;; section. +;; FIXME: `org-fold-core-cycle-over-indirect-buffers' should better be +;; taken out of org-fold-core to track indirect buffers in general. (defun org-element--cache-active-p (&optional called-from-cache-change-func-p) - "Non-nil when cache is active in current buffer." + "Non-nil when cache is active in current buffer. +When CALLED-FROM-CACHE-CHANGE-FUNC-P is non-nil, do not assert cache +consistency with buffer modifications." (org-with-base-buffer nil (and org-element-use-cache - org-element--cache + (or org-element--cache + (when (derived-mode-p 'org-mode) + (org-element-cache-reset) + t)) (or called-from-cache-change-func-p (eq org-element--cache-change-tic (buffer-chars-modified-tick)) (and @@ -5738,25 +6181,6 @@ This function assumes `org-element--headline-cache' is a valid AVL tree." (throw :inhibited nil))) t)))))) -;; FIXME: Remove after we establish that hashing is effective. -(defun org-element-cache-hash-show-statistics () - "Display efficiency of O(1) query cache for `org-element--cache-find'. - -This extra caching is based on the following paper: -Pugh [Information Processing Letters] (1990) Slow optimally balanced - search strategies vs. cached fast uniformly balanced search - strategies. http://dx.doi.org/10.1016/0020-0190(90)90130-P - -Also, see `org-element--cache-size'." - (interactive) - (message "%.2f%% of cache searches hashed, %.2f%% non-hashable." - (* 100 - (/ (float (car org-element--cache-hash-statistics)) - (cdr org-element--cache-hash-statistics))) - (* 100 - (/ (float org-element--cache-hash-nocache) - (cdr org-element--cache-hash-statistics))))) - (defun org-element--cache-find (pos &optional side) "Find element in cache starting at POS or before. @@ -5784,26 +6208,28 @@ the cache." lower upper) ;; `org-element--cache-key-less-p' does not accept markers. (when (markerp pos) (setq pos (marker-position pos))) - (cl-incf (cdr org-element--cache-hash-statistics)) - (when (eq side 'both) (cl-incf org-element--cache-hash-nocache)) (if (and hashed (not (eq side 'both)) + ;; Ensure that HASHED is not within synchronized part + ;; of the cache. + (org-element-property :cached hashed) (or (not limit) ;; Limit can be a list key. (org-element--cache-key-less-p (org-element--cache-key hashed) limit)) - (= pos (org-element-property :begin hashed)) + ;; It is only safe to assume that element at POS is + ;; exact. Extra elements starting before/after could + ;; have been added to cache and HASHED may no longer be + ;; valid. + (= pos (org-element-begin hashed)) ;; We cannot rely on element :begin for elements with ;; children starting at the same pos. - (not (memq (org-element-type hashed) - '(section org-data table))) - (org-element-property :cached hashed)) - (progn - (cl-incf (car org-element--cache-hash-statistics)) - hashed) + (not (org-element-type-p hashed '(section org-data table)))) + hashed + ;; No appriate HASHED. Search the cache. (while node (let* ((element (avl-tree--node-data node)) - (begin (org-element-property :begin element))) + (begin (org-element-begin element))) (cond ((and limit (not (org-element--cache-key-less-p @@ -5815,7 +6241,7 @@ the cache." ((or (< begin pos) ;; If the element is section or org-data, we also need ;; to check the following element. - (memq (org-element-type element) '(section org-data))) + (org-element-type-p element '(section org-data))) (setq lower element node (avl-tree--node-right node))) ;; We found an element in cache starting at POS. If `side' @@ -5830,10 +6256,11 @@ the cache." ((eq side 'both) (setq lower element) (setq node (avl-tree--node-right node))) - ((and (memq (org-element-type element) '(item table-row)) - (let ((parent (org-element-property :parent element))) - (and (= (org-element-property :begin element) - (org-element-property :contents-begin parent)) + ((and (org-element-type-p element '(item table-row)) + ;; Cached elements cannot have deferred `:parent'. + (let ((parent (org-element-property-raw :parent element))) + (and (= (org-element-begin element) + (org-element-contents-begin parent)) (setq node nil lower parent upper parent))))) @@ -5841,14 +6268,12 @@ the cache." (setq node nil lower element upper element))))) - (if (not side) - (aset org-element--cache-hash-left hash-pos lower) - (unless (eq side 'both) - (aset org-element--cache-hash-right hash-pos lower))) (pcase side (`both (cons lower upper)) - (`nil lower) - (_ upper)))))) + (`nil + (aset org-element--cache-hash-left hash-pos lower)) + (_ + (aset org-element--cache-hash-right hash-pos upper))))))) (defun org-element--cache-put (element) "Store ELEMENT in current buffer's cache, if allowed." @@ -5859,7 +6284,7 @@ the cache." ;; the new element so `avl-tree-enter' can insert it at the ;; right spot in the cache. (let* ((keys (org-element--cache-find - (org-element-property :begin element) 'both)) + (org-element-begin element) 'both)) (new-key (org-element--cache-generate-key (and (car keys) (org-element--cache-key (car keys))) (cond ((cdr keys) (org-element--cache-key (cdr keys))) @@ -5875,7 +6300,7 @@ the cache." (org-element-property :org-element--cache-sync-key element) (org-element--format-element element))) (org-element-put-property element :cached t) - (when (memq (org-element-type element) '(headline inlinetask)) + (when (org-element-type-p element '(headline inlinetask)) (cl-incf org-element--headline-cache-size) (avl-tree-enter org-element--headline-cache element)) (cl-incf org-element--cache-size) @@ -5888,10 +6313,12 @@ Assume ELEMENT belongs to cache and that a cache is active." (org-element-put-property element :cached nil) (cl-decf org-element--cache-size) ;; Invalidate contents of parent. - (when (and (org-element-property :parent element) - (org-element-contents (org-element-property :parent element))) - (org-element-set-contents (org-element-property :parent element) nil)) - (when (memq (org-element-type element) '(headline inlinetask)) + (when (org-element-contents + ;; Cached elements cannot have deferred `:parent'. + (org-element-property-raw :parent element)) + (org-element-set-contents + (org-element-property-raw :parent element) nil)) + (when (org-element-type-p element '(headline inlinetask)) (cl-decf org-element--headline-cache-size) (avl-tree-delete org-element--headline-cache element)) (org-element--cache-log-message @@ -5903,7 +6330,7 @@ Assume ELEMENT belongs to cache and that a cache is active." If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)." (org-element-type element) (current-buffer) - (org-element-property :begin element) + (org-element-begin element) (org-element-property :org-element--cache-sync-key element)) (org-element-cache-reset) (throw 'org-element--cache-quit nil)) @@ -5916,7 +6343,7 @@ If this warning appears regularly, please report the warning text to Org mode ma If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)." (org-element-type element) (current-buffer) - (org-element-property :begin element) + (org-element-begin element) (org-element-property :org-element--cache-sync-key element)) (org-element-cache-reset) (throw 'org-element--cache-quit nil))))) @@ -5952,21 +6379,42 @@ optional argument PROPS is a list of keywords, only shift properties provided in that list. Properties are modified by side-effect." - (let ((properties (nth 1 element))) - ;; Shift `:structure' property for the first plain list only: it - ;; is the only one that really matters and it prevents from - ;; shifting it more than once. - (when (and (or (not props) (memq :structure props)) - (eq (org-element-type element) 'plain-list) - (not (eq (org-element-type (plist-get properties :parent)) 'item))) - (dolist (item (plist-get properties :structure)) - (cl-incf (car item) offset) - (cl-incf (nth 6 item) offset))) - (dolist (key '( :begin :contents-begin :contents-end :end - :post-affiliated :robust-begin :robust-end)) - (let ((value (and (or (not props) (memq key props)) - (plist-get properties key)))) - (and value (plist-put properties key (+ offset value))))))) + ;; Shift `:structure' property for the first plain list only: it + ;; is the only one that really matters and it prevents from + ;; shifting it more than once. + (when (and (not (zerop offset)) + (or (not props) (memq :structure props)) + (org-element-type-p element 'plain-list) + (not (org-element-type-p + ;; Cached elements cannot have deferred `:parent'. + (org-element-property-raw :parent element) + 'item))) + (let ((structure (org-element-property :structure element))) + (dolist (item structure) + (cl-incf (car item) offset) + (cl-incf (nth 6 item) offset)))) + ;; Clear :fragile cache when contents is changed. + (when props (org-element-put-property element :fragile-cache nil)) + ;; Do not use loop for inline expansion to work during compile time. + (unless (zerop offset) + (when (or (not props) (memq :begin props)) + (cl-incf (org-element-begin element) offset)) + (when (or (not props) (memq :end props)) + (cl-incf (org-element-end element) offset)) + (when (or (not props) (memq :post-affiliated props)) + (cl-incf (org-element-post-affiliated element) offset)) + (when (and (or (not props) (memq :contents-begin props)) + (org-element-contents-begin element)) + (cl-incf (org-element-contents-begin element) offset)) + (when (and (or (not props) (memq :contents-end props)) + (org-element-contents-end element)) + (cl-incf (org-element-contents-end element) offset)) + (when (and (or (not props) (memq :robust-begin props)) + (org-element-property :robust-begin element)) + (cl-incf (org-element-property :robust-begin element) offset)) + (when (and (or (not props) (memq :robust-end props)) + (org-element-property :robust-end element)) + (cl-incf (org-element-property :robust-end element) offset)))) (defvar org-element--cache-interrupt-C-g t "When non-nil, allow the user to abort `org-element--cache-sync'. @@ -5985,7 +6433,7 @@ It is a symbol among nil, t, or a number representing smallest level of modified headline. The level considers headline levels both before and after the modification.") -(defun org-element--cache-sync (buffer &optional threshold future-change offset) +(defun org-element--cache-sync (buffer &optional threshold future-change offset force) "Synchronize cache with recent modification in BUFFER. When optional argument THRESHOLD is non-nil, do the @@ -5998,13 +6446,18 @@ FUTURE-CHANGE, when non-nil, is a buffer position where changes not registered yet in the cache are going to happen. OFFSET is the change offset. It is used in `org-element--cache-submit-request', where cache is partially updated before current modification are -actually submitted." +actually submitted. + +FORCE, when non-nil will force the synchronization even when +`org-element--cache-active-p' returns nil." (when (buffer-live-p buffer) (org-with-base-buffer buffer ;; Do not sync when, for example, in the middle of ;; `combine-change-calls'. See the commentary inside - ;; `org-element--cache-active-p'. - (when (and org-element--cache-sync-requests (org-element--cache-active-p)) + ;; `org-element--cache-active-p'. Such situation may occur when + ;; sync timer triggers in the middle of `combine-change-calls'. + (when (and org-element--cache-sync-requests + (or force (org-element--cache-active-p))) ;; Check if the buffer have been changed outside visibility of ;; `org-element--cache-before-change' and `org-element--cache-after-change'. (if (/= org-element--cache-last-buffer-size (buffer-size)) @@ -6066,7 +6519,11 @@ The buffer is: %s\n Current command: %S\n Backtrace:\n%S" ;; Otherwise, reset keys. (if org-element--cache-sync-requests (org-element--cache-set-timer buffer) - (setq org-element--cache-change-warning nil) + ;; NOTE: We cannot reset + ;; `org-element--cache-change-warning' here as it might + ;; still be needed when synchronization is called by + ;; `org-element--cache-submit-request' before + ;; `org-element--cache-for-removal'. (setq org-element--cache-sync-keys-value (1+ org-element--cache-sync-keys-value))))))))) (defun org-element--cache-process-request @@ -6136,22 +6593,22 @@ completing the request." (if data ;; We found first element in cache starting at or ;; after REQUEST-KEY. - (let ((pos (org-element-property :begin data))) + (let ((pos (org-element-begin data))) ;; FIXME: Maybe simply (< pos end)? (if (<= pos end) (progn (org-element--cache-log-message "removing %S::%S" - (org-element-property :org-element--cache-sync-key data) - (org-element--format-element data)) + (org-element-property :org-element--cache-sync-key data) + (org-element--format-element data)) (cl-incf deletion-count) (org-element--cache-remove data) (when (and (> (log org-element--cache-size 2) 10) (> deletion-count (/ org-element--cache-size (log org-element--cache-size 2)))) (org-element--cache-log-message "Removed %S>N/LogN(=%S/%S) elements. Resetting cache to prevent performance degradation" - deletion-count - org-element--cache-size - (log org-element--cache-size 2)) + deletion-count + org-element--cache-size + (log org-element--cache-size 2)) (org-element-cache-reset) (throw 'org-element--cache-quit t))) ;; Done deleting everything starting before END. @@ -6215,8 +6672,8 @@ completing the request." ;; requests. (let ((next-request (nth 1 org-element--cache-sync-requests))) (org-element--cache-log-message "Phase 1: Unorderered requests. Merging: %S\n%S\n" - (let ((print-length 10) (print-level 3)) (prin1-to-string request)) - (let ((print-length 10) (print-level 3)) (prin1-to-string next-request))) + (let ((print-length 10) (print-level 3)) (prin1-to-string request)) + (let ((print-length 10) (print-level 3)) (prin1-to-string next-request))) (setf (org-element--request-key next-request) key) (setf (org-element--request-beg next-request) (org-element--request-beg request)) (setf (org-element--request-phase next-request) 1) @@ -6264,9 +6721,9 @@ completing the request." (let ((up parent)) (while (and up (or (not cached-before) - (> (org-element-property :begin up) - (org-element-property :begin cached-before)))) - (when (> (org-element-property :end up) future-change) + (> (org-element-begin up) + (org-element-begin cached-before)))) + (when (> (org-element-end up) future-change) ;; Offset future cache request. (org-element--cache-shift-positions up (- offset) @@ -6274,7 +6731,8 @@ completing the request." (org-element-property :robust-end up)) '(:contents-end :end :robust-end) '(:contents-end :end)))) - (setq up (org-element-property :parent up))))) + ;; Cached elements cannot have deferred `:parent'. + (setq up (org-element-property-raw :parent up))))) (org-element--cache-log-message "New parent at %S: %S::%S" limit @@ -6325,10 +6783,10 @@ completing the request." (org-element--cache-log-message "Reached next request.") (let ((next-request (nth 1 org-element--cache-sync-requests))) (unless (and (org-element-property :cached (org-element--request-parent next-request)) - (org-element-property :begin (org-element--request-parent next-request)) + (org-element-begin (org-element--request-parent next-request)) parent - (> (org-element-property :begin (org-element--request-parent next-request)) - (org-element-property :begin parent))) + (> (org-element-begin (org-element--request-parent next-request)) + (org-element-begin parent))) (setf (org-element--request-parent next-request) parent))) (throw 'org-element--cache-quit t)) ;; Handle interruption request. Update current request. @@ -6338,19 +6796,19 @@ completing the request." (setf (org-element--request-parent request) parent) (throw 'org-element--cache-interrupt nil)) ;; Shift element. - (unless (zerop offset) - (when (>= org-element--cache-diagnostics-level 3) - (org-element--cache-log-message "Shifting positions (𝝙%S) in %S::%S" - offset - (org-element-property :org-element--cache-sync-key data) - (org-element--format-element data))) - (org-element--cache-shift-positions data offset)) - (let ((begin (org-element-property :begin data))) + (when (>= org-element--cache-diagnostics-level 3) + (org-element--cache-log-message "Shifting positions (𝝙%S) in %S::%S" + offset + (org-element-property :org-element--cache-sync-key data) + (org-element--format-element data))) + (org-element--cache-shift-positions data offset) + (let ((begin (org-element-begin data))) ;; Update PARENT and re-parent DATA, only when ;; necessary. Propagate new structures for lists. - (while (and parent - (<= (org-element-property :end parent) begin)) - (setq parent (org-element-property :parent parent))) + (while (and parent (<= (org-element-end parent) begin)) + (setq parent + ;; Cached elements cannot have deferred `:parent'. + (org-element-property-raw :parent parent))) (cond ((and (not parent) (zerop offset)) (throw 'org-element--cache-quit nil)) ;; Consider scenario when DATA lays within ;; sensitive lines of PARENT that was found @@ -6367,17 +6825,17 @@ completing the request." ;; However, the paragraph element stored in ;; cache must be deleted instead. ((and parent - (or (not (memq (org-element-type parent) org-element-greater-elements)) - (and (org-element-property :contents-begin parent) - (< (org-element-property :begin data) (org-element-property :contents-begin parent))) - (and (org-element-property :contents-end parent) - (>= (org-element-property :begin data) (org-element-property :contents-end parent))) - (> (org-element-property :end data) (org-element-property :end parent)) - (and (org-element-property :contents-end data) - (> (org-element-property :contents-end data) (org-element-property :contents-end parent))))) + (or (not (org-element-type-p parent org-element-greater-elements)) + (and (org-element-contents-begin parent) + (< (org-element-begin data) (org-element-contents-begin parent))) + (and (org-element-contents-end parent) + (>= (org-element-begin data) (org-element-contents-end parent))) + (> (org-element-end data) (org-element-end parent)) + (and (org-element-contents-end data) + (> (org-element-contents-end data) (org-element-contents-end parent))))) (org-element--cache-log-message "org-element-cache: Removing obsolete element with key %S::%S" - (org-element-property :org-element--cache-sync-key data) - (org-element--format-element data)) + (org-element-property :org-element--cache-sync-key data) + (org-element--format-element data)) (org-element--cache-remove data) ;; We altered the tree structure. The tree ;; traversal needs to be restarted. @@ -6395,10 +6853,11 @@ completing the request." continue-flag t)) ((and parent (not (eq parent data)) - (let ((p (org-element-property :parent data))) + ;; Cached elements cannot have deferred `:parent'. + (let ((p (org-element-property-raw :parent data))) (or (not p) - (< (org-element-property :begin p) - (org-element-property :begin parent)) + (< (org-element-begin p) + (org-element-begin parent)) (unless (eq p parent) (not (org-element-property :cached p)) ;; (not (avl-tree-member-p org-element--cache p)) @@ -6406,10 +6865,11 @@ completing the request." (org-element--cache-log-message "Updating parent in %S\n Old parent: %S\n New parent: %S" (org-element--format-element data) - (org-element--format-element (org-element-property :parent data)) + (org-element--format-element + (org-element-property-raw :parent data)) (org-element--format-element parent)) - (when (and (eq 'org-data (org-element-type parent)) - (not (eq 'headline (org-element-type data)))) + (when (and (org-element-type-p parent 'org-data) + (not (org-element-type-p data 'headline))) ;; FIXME: This check is here to see whether ;; such error happens within ;; `org-element--cache-process-request' or somewhere @@ -6428,8 +6888,8 @@ If this warning appears regularly, please report the warning text to Org mode ma ;; interruption. (when (and threshold (> begin threshold)) (org-element--cache-log-message "Reached threshold %S: %S" - threshold - (org-element--format-element data)) + threshold + (org-element--format-element data)) (setq exit-flag t)))) (if continue-flag (setq continue-flag nil) @@ -6443,18 +6903,26 @@ If this warning appears regularly, please report the warning text to Org mode ma org-element--cache-size (let ((print-level 2)) (prin1-to-string org-element--cache-sync-requests))))) -(defsubst org-element--open-end-p (element) - "Check if ELEMENT in current buffer contains extra blank lines after -it and does not have closing term. - -Examples of such elements are: section, headline, org-data, -and footnote-definition." - (and (org-element-property :contents-end element) - (= (org-element-property :contents-end element) - (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\n\t") - (line-beginning-position 2))))) +(defun org-element--headline-parent-deferred (headline) + "Parse parent for HEADLINE." + (with-current-buffer (org-element-property :buffer headline) + (org-with-point-at (org-element-begin headline) + (if (or (bobp) (= 1 (org-element-property :true-level headline))) + ;; Top-level heading. Parent is `org-data'. + (org-element-org-data-parser) + (re-search-backward + (org-headline-re + (1- (org-element-property :true-level headline))) + nil 'move) + (let ((parent (org-element-at-point))) + (if (org-element-type-p parent 'headline) parent + ;; Before first headline. Assign `org-data'. + (org-element-lineage parent 'org-data t))))))) + +(defconst org-element--headline-parent-deferred + (org-element-deferred-create + t #'org-element--headline-parent-deferred) + "Constant holding deferred value for headline `:parent' property.") (defun org-element--parse-to (pos &optional syncp time-limit) "Parse elements in current section, down to POS. @@ -6470,214 +6938,194 @@ when the parsing should stop. The function throws `org-element--cache-interrupt' if the process stopped before finding the expected result." (catch 'exit - (save-match-data - (org-with-base-buffer nil - (org-with-wide-buffer - (goto-char pos) - (save-excursion - (end-of-line) - (skip-chars-backward " \r\t\n") - ;; Within blank lines at the beginning of buffer, return nil. - (when (bobp) (throw 'exit nil))) - (let* ((cached (and (org-element--cache-active-p) - (org-element--cache-find pos nil))) - (mode (org-element-property :mode cached)) - element next) - (cond - ;; Nothing in cache before point: start parsing from first - ;; element in buffer down to POS or from the beginning of the - ;; file. - ((and (not cached) (org-element--cache-active-p)) + (org-with-base-buffer nil + (org-with-wide-buffer + (goto-char pos) + (save-excursion + (forward-line 1) + (skip-chars-backward " \r\t\n") + ;; Within blank lines at the beginning of buffer, return nil. + (when (bobp) (throw 'exit nil))) + (let* ((cached (and (org-element--cache-active-p) + (org-element--cache-find pos nil))) + (mode (org-element-property :mode cached)) + element next) + (cond + ;; Nothing in cache before point: start parsing from first + ;; element in buffer down to POS or from the beginning of the + ;; file. + ((and (not cached) (org-element--cache-active-p)) + (setq element (org-element-org-data-parser)) + (unless (org-element-begin element) + (org-element--cache-warn "Error parsing org-data. Got %S\nPlease report to Org mode mailing list (M-x org-submit-bug-report)." element)) + (org-element--cache-log-message + "Nothing in cache. Adding org-data: %S" + (org-element--format-element element)) + (org-element--cache-put element) + (goto-char (org-element-contents-begin element)) + (setq mode 'org-data)) + ;; Nothing in cache before point because cache is not active. + ;; Parse from previous heading to avoid re-parsing the whole + ;; buffer above. Arrange `:parent' to be calculated on demand. + ((not cached) + (forward-line 1) ; ensure the end of current heading. + (if (re-search-backward + (org-get-limited-outline-regexp t) + nil 'move) + (progn + (setq element (org-element-headline-parser nil 'fast)) + (org-element-put-property + element :parent + org-element--headline-parent-deferred) + (setq mode 'planning) + (forward-line)) (setq element (org-element-org-data-parser)) - (unless (org-element-property :begin element) - (org-element--cache-warn "Error parsing org-data. Got %S\nPlease report to Org mode mailing list (M-x org-submit-bug-report)." element)) - (org-element--cache-log-message - "Nothing in cache. Adding org-data: %S" - (org-element--format-element element)) - (org-element--cache-put element) - (goto-char (org-element-property :contents-begin element)) (setq mode 'org-data)) - ;; Nothing in cache before point because cache is not active. - ;; Parse from previous heading to avoid re-parsing the whole - ;; buffer above. This comes at the cost of not calculating - ;; `:parent' property for headings. - ((not cached) - (if (org-with-limited-levels (outline-previous-heading)) - (progn - (setq element (org-element-headline-parser nil 'fast)) - (setq mode 'planning) - (forward-line)) - (setq element (org-element-org-data-parser)) - (setq mode 'org-data)) - (org-skip-whitespace) - (beginning-of-line)) - ;; Check if CACHED or any of its ancestors contain point. - ;; - ;; If there is such an element, we inspect it in order to know - ;; if we return it or if we need to parse its contents. - ;; Otherwise, we just start parsing from location, which is - ;; right after the top-most element containing CACHED but - ;; still before POS. - ;; - ;; As a special case, if POS is at the end of the buffer, we - ;; want to return the innermost element ending there. - ;; - ;; Also, if we find an ancestor and discover that we need to - ;; parse its contents, make sure we don't start from - ;; `:contents-begin', as we would otherwise go past CACHED - ;; again. Instead, in that situation, we will resume parsing - ;; from NEXT, which is located after CACHED or its higher - ;; ancestor not containing point. - (t - (let ((up cached) - (pos (if (= (point-max) pos) (1- pos) pos))) - (while (and up (<= (org-element-property :end up) pos)) - (goto-char (org-element-property :end up)) - (setq element up - mode (org-element--next-mode (org-element-property :mode element) (org-element-type element) nil) - up (org-element-property :parent up) - next (point))) - (when up (setq element up))))) - ;; Parse successively each element until we reach POS. - (let ((end (or (org-element-property :end element) (point-max))) - (parent (org-element-property :parent element))) - (while t - (when (org-element--cache-interrupt-p time-limit) - (throw 'org-element--cache-interrupt nil)) - (when (and inhibit-quit org-element--cache-interrupt-C-g quit-flag) - (when quit-flag - (cl-incf org-element--cache-interrupt-C-g-count) - (setq quit-flag nil)) - (when (>= org-element--cache-interrupt-C-g-count - org-element--cache-interrupt-C-g-max-count) - (setq quit-flag t) - (setq org-element--cache-interrupt-C-g-count 0) - (org-element-cache-reset) - (error "org-element: Parsing aborted by user. Cache has been cleared. -If you observe Emacs hangs frequently, please report this to Org mode mailing list (M-x org-submit-bug-report).")) - (message (substitute-command-keys - "`org-element--parse-to': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.") - (- org-element--cache-interrupt-C-g-max-count - org-element--cache-interrupt-C-g-count))) - (unless element - ;; Do not try to parse within blank at EOB. - (unless (save-excursion - (org-skip-whitespace) - (eobp)) - (org-element-with-disabled-cache - (setq element (org-element--current-element - end 'element mode - (org-element-property :structure parent))))) - ;; Make sure that we return referenced element in cache - ;; that can be altered directly. - (if element - (progn - (org-element-put-property element :granularity 'element) - (setq element (or (org-element--cache-put element) element))) - ;; Nothing to parse (i.e. empty file). - (throw 'exit parent)) - (unless (or (not (org-element--cache-active-p)) parent) - (org-element--cache-warn - "Got empty parent while parsing. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n Backtrace:\n%S" - (when (and (fboundp 'backtrace-get-frames) - (fboundp 'backtrace-to-string)) - (backtrace-to-string (backtrace-get-frames 'backtrace)) - (org-element-cache-reset) - (error "org-element--cache: Emergency exit")))) - (org-element-put-property element :parent parent)) - (let ((elem-end (org-element-property :end element)) - (type (org-element-type element))) - (cond - ;; Skip any element ending before point. Also skip - ;; element ending at point (unless it is also the end of - ;; buffer) since we're sure that another element begins - ;; after it. - ((and (<= elem-end pos) (/= (point-max) elem-end)) - ;; Avoid parsing headline siblings above. - (goto-char elem-end) - (when (eq type 'headline) - (save-match-data - (unless (when (and (/= 1 (org-element-property :level element)) - (re-search-forward - (rx-to-string - `(and bol (repeat 1 ,(1- (let ((level (org-element-property :level element))) - (if org-odd-levels-only (1- (* level 2)) level))) - "*") - " ")) - pos t)) - (beginning-of-line) - t) - ;; There are headings with lower level than - ;; ELEMENT between ELEM-END and POS. Siblings - ;; may exist though. Parse starting from the - ;; last sibling or from ELEM-END if there are - ;; no other siblings. - (goto-char pos) - (unless - (re-search-backward - (rx-to-string - `(and bol (repeat ,(let ((level (org-element-property :level element))) - (if org-odd-levels-only (1- (* level 2)) level)) - "*") - " ")) - elem-end t) - ;; Roll-back to normal parsing. - (goto-char elem-end))))) - (setq mode (org-element--next-mode mode type nil))) - ;; A non-greater element contains point: return it. - ((not (memq type org-element-greater-elements)) - (throw 'exit (if syncp parent element))) - ;; Otherwise, we have to decide if ELEMENT really - ;; contains POS. In that case we start parsing from - ;; contents' beginning. - ;; - ;; If POS is at contents' beginning but it is also at - ;; the beginning of the first item in a list or a table. - ;; In that case, we need to create an anchor for that - ;; list or table, so return it. - ;; - ;; Also, if POS is at the end of the buffer, no element - ;; can start after it, but more than one may end there. - ;; Arbitrarily, we choose to return the innermost of - ;; such elements. - ((let ((cbeg (org-element-property :contents-begin element)) - (cend (org-element-property :contents-end element))) - (when (and cbeg cend - (or (< cbeg pos) - (and (= cbeg pos) - (not (memq type '(plain-list table))))) - (or (> cend pos) - ;; When we are at cend or within blank - ;; lines after, it is a special case: - ;; 1. At the end of buffer we return - ;; the innermost element. - ;; 2. At cend of element with return - ;; that element. - ;; 3. At the end of element, we would - ;; return in the earlier cond form. - ;; 4. Within blank lines after cend, - ;; when element does not have a - ;; closing keyword, we return that - ;; outermost element, unless the - ;; outermost element is a non-empty - ;; headline. In the latter case, we - ;; return the outermost element inside - ;; the headline section. - (and (org-element--open-end-p element) - (or (= (org-element-property :end element) (point-max)) - (and (>= pos (org-element-property :contents-end element)) - (memq (org-element-type element) '(org-data section headline))))))) - (goto-char (or next cbeg)) - (setq mode (if next mode (org-element--next-mode mode type t)) - next nil - parent element - end (if (org-element--open-end-p element) - (org-element-property :end element) - (org-element-property :contents-end element)))))) - ;; Otherwise, return ELEMENT as it is the smallest - ;; element containing POS. - (t (throw 'exit (if syncp parent element))))) - (setq element nil))))))))) + (org-skip-whitespace) + (forward-line 0)) + ;; Check if CACHED or any of its ancestors contain point. + ;; + ;; If there is such an element, we inspect it in order to know + ;; if we return it or if we need to parse its contents. + ;; Otherwise, we just start parsing from location, which is + ;; right after the top-most element containing CACHED but + ;; still before POS. + ;; + ;; As a special case, if POS is at the end of the buffer, we + ;; want to return the innermost element ending there. + ;; + ;; Also, if we find an ancestor and discover that we need to + ;; parse its contents, make sure we don't start from + ;; `:contents-begin', as we would otherwise go past CACHED + ;; again. Instead, in that situation, we will resume parsing + ;; from NEXT, which is located after CACHED or its higher + ;; ancestor not containing point. + (t + (let ((up cached) + (pos (if (= (point-max) pos) (1- pos) pos))) + (while (and up (<= (org-element-end up) pos)) + (setq next (org-element-end up) + element up + mode (org-element--next-mode (org-element-property :mode element) (org-element-type element) nil) + ;; Cached elements cannot have deferred `:parent'. + up (org-element-property-raw :parent up))) + (when next (goto-char next)) + (when up (setq element up))))) + ;; Parse successively each element until we reach POS. + (let ((end (or (org-element-end element) (point-max))) + (parent (org-element-property-raw :parent element))) + (while t + (when (org-element--cache-interrupt-p time-limit) + (throw 'org-element--cache-interrupt nil)) + (when (and inhibit-quit org-element--cache-interrupt-C-g quit-flag) + (when quit-flag + (cl-incf org-element--cache-interrupt-C-g-count) + (setq quit-flag nil)) + (when (>= org-element--cache-interrupt-C-g-count + org-element--cache-interrupt-C-g-max-count) + (setq quit-flag t) + (setq org-element--cache-interrupt-C-g-count 0) + (org-element-cache-reset) + (error "org-element: Parsing aborted by user. Cache has been cleared. +If you observe Emacs hangs frequently, please report this to Org mode mailing list (M-x org-submit-bug-report)")) + (message (substitute-command-keys + "`org-element--parse-to': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.") + (- org-element--cache-interrupt-C-g-max-count + org-element--cache-interrupt-C-g-count))) + (unless element + ;; Do not try to parse within blank at EOB. + (unless (save-excursion + (org-skip-whitespace) + (eobp)) + (setq element (org-element--current-element + end 'element mode + (org-element-property :structure parent)))) + ;; Make sure that we return referenced element in cache + ;; that can be altered directly. + (if element + (setq element (or (org-element--cache-put element) element)) + ;; Nothing to parse (i.e. empty file). + (throw 'exit parent)) + (unless (or parent (not (org-element--cache-active-p))) + (org-element--cache-warn + "Got empty parent while parsing. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n Backtrace:\n%S" + (when (and (fboundp 'backtrace-get-frames) + (fboundp 'backtrace-to-string)) + (backtrace-to-string (backtrace-get-frames 'backtrace)) + (org-element-cache-reset) + (error "org-element--cache: Emergency exit")))) + (org-element-put-property element :parent parent)) + (let ((elem-end (org-element-end element)) + (type (org-element-type element))) + (cond + ;; Skip any element ending before point. Also skip + ;; element ending at point (unless it is also the end of + ;; buffer) since we're sure that another element begins + ;; after it. + ((and (<= elem-end pos) (/= (point-max) elem-end)) + ;; Avoid parsing headline siblings above. + (goto-char elem-end) + (when (eq type 'headline) + (unless (when (and (/= 1 (org-element-property :true-level element)) + (re-search-forward + (org-headline-re (1- (org-element-property :true-level element))) + pos t)) + (forward-line 0) + t) + ;; There are headings with lower level than + ;; ELEMENT between ELEM-END and POS. Siblings + ;; may exist though. Parse starting from the + ;; last sibling or from ELEM-END if there are + ;; no other siblings. + (goto-char pos) + (unless + (re-search-backward + (org-headline-re (org-element-property :true-level element)) + elem-end t) + ;; Roll-back to normal parsing. + (goto-char elem-end)))) + (setq mode (org-element--next-mode mode type nil))) + ;; A non-greater element contains point: return it. + ((not (memq type org-element-greater-elements)) + (throw 'exit (if syncp parent element))) + ;; Otherwise, we have to decide if ELEMENT really + ;; contains POS. In that case we start parsing from + ;; contents' beginning. + ;; + ;; If POS is at contents' beginning but it is also at + ;; the beginning of the first item in a list or a table. + ;; In that case, we need to create an anchor for that + ;; list or table, so return it. + ;; + ;; Also, if POS is at the end of the buffer, no element + ;; can start after it, but more than one may end there. + ;; Arbitrarily, we choose to return the innermost of + ;; such elements. + ((let ((cbeg (org-element-contents-begin element)) + (cend (org-element-contents-end element))) + (when (and cbeg cend + (or (< cbeg pos) + (and (= cbeg pos) + (not (memq type '(plain-list table))))) + (or (> cend pos) + ;; When we are at cend or within blank + ;; lines after, it is a special case: + ;; 1. At the end of buffer we return + ;; the innermost element. + (= pos cend (point-max)) + ;; 2. At cend of element with return + ;; that element (thus, no need to + ;; parse inside). + nil)) + (goto-char (or next cbeg)) + (setq mode (if next mode (org-element--next-mode mode type t)) + next nil + parent element + end (org-element-contents-end element))))) + ;; Otherwise, return ELEMENT as it is the smallest + ;; element containing POS. + (t (throw 'exit (if syncp parent element))))) + (setq element nil)))))))) ;;;; Staging Buffer Changes @@ -6726,12 +7174,13 @@ The function returns the new value of `org-element--cache-change-warning'." (let ((org-element--cache-change-warning-before org-element--cache-change-warning) (org-element--cache-change-warning-after)) (setq org-element--cache-change-warning-after + ;; We must preserve match data when called as `before-change-functions'. (save-match-data (let ((case-fold-search t)) (when (re-search-forward org-element--cache-sensitive-re bottom t) (goto-char beg) - (beginning-of-line) + (forward-line 0) (let (min-level) (cl-loop while (re-search-forward (rx-to-string @@ -6743,7 +7192,7 @@ The function returns the new value of `org-element--cache-change-warning'." do (setq min-level (1- (length (match-string 0)))) until (= min-level 1)) (goto-char beg) - (beginning-of-line) + (forward-line 0) (or (and min-level (org-reduced-level min-level)) (when (looking-at-p "^[ \t]*#\\+CATEGORY:") 'org-data) @@ -6767,14 +7216,14 @@ The function returns the new value of `org-element--cache-change-warning'." (defun org-element--cache-after-change (beg end pre) "Update buffer modifications for current buffer. -BEG and END are the beginning and end of the range of changed +BEG, END, and PRE are the beginning and end of the range of changed text, and the length in bytes of the pre-change text replaced by that range. See `after-change-functions' for more information." (org-with-base-buffer nil (when (org-element--cache-active-p t) (when (not (eq org-element--cache-change-tic (buffer-chars-modified-tick))) (org-element--cache-log-message "After change") - (setq org-element--cache-change-warning (org-element--cache-before-change beg end)) + (org-element--cache-before-change beg end) ;; If beg is right after spaces in front of an element, we ;; risk affecting previous element, so move beg to bol, making ;; sure that we capture preceding element. @@ -6784,6 +7233,7 @@ that range. See `after-change-functions' for more information." (line-beginning-position))) ;; Store synchronization request. (let ((offset (- end beg pre))) + ;; We must preserve match data when called as `after-change-functions'. (save-match-data (org-element--cache-submit-request beg (- end offset) offset))) ;; Activate a timer to process the request during idle time. @@ -6792,6 +7242,16 @@ that range. See `after-change-functions' for more information." (defun org-element--cache-setup-change-functions () "Setup `before-change-functions' and `after-change-functions'." (when (and (derived-mode-p 'org-mode) org-element-use-cache) + ;; Clear copied local cache to avoid extra memory usage. + ;; We only use cache stored in the base buffer. + (when (buffer-base-buffer) + (setq-local org-element--cache nil) + (setq-local org-element--headline-cache nil)) + ;; Register current buffer in `org-fold-core--indirect-buffers' to + ;; be used within `org-fold-core-cycle-over-indirect-buffers'. + ;; FIXME: We should eventually factor out indirect buffer tracking + ;; from org-fold-core. + (org-fold-core-decouple-indirect-buffer-folds) (add-hook 'before-change-functions #'org-element--cache-before-change nil t) ;; Run `org-element--cache-after-change' early to handle cases @@ -6811,7 +7271,7 @@ when buffer modifications are mixed with cache requests. However, large automated edits inserting/deleting many headlines are somewhat slower by default (as in `org-archive-subtree'). Let-binding this variable to non-nil will reduce cache latency after every singular edit -(`after-change-functions') at the cost of slower cache queries.") +\(`after-change-functions') at the cost of slower cache queries.") (defun org-element--cache-for-removal (beg end offset) "Return first element to remove from cache. @@ -6835,12 +7295,12 @@ known element in cache (it may start after END)." (if (not before) after ;; If BEFORE is a keyword, it may need to be removed to become ;; an affiliated keyword. - (when (eq 'keyword (org-element-type before)) + (when (org-element-type-p before 'keyword) (let ((prev before)) - (while (eq 'keyword (org-element-type prev)) + (while (org-element-type-p prev 'keyword) (setq before prev - beg (org-element-property :begin prev)) - (setq prev (org-element--cache-find (1- (org-element-property :begin before))))))) + beg (org-element-begin prev)) + (setq prev (org-element--cache-find (1- (org-element-begin before))))))) (let ((up before) (robust-flag t)) (while up @@ -6853,8 +7313,8 @@ known element in cache (it may start after END)." ;; Sensitive change. This is ;; unconditionally non-robust change. (not org-element--cache-change-warning) - (let ((cbeg (org-element-property :contents-begin up)) - (cend (org-element-property :contents-end up))) + (let ((cbeg (org-element-contents-begin up)) + (cend (org-element-contents-end up))) (and cbeg (<= cbeg beg) (or (> cend end) @@ -6884,9 +7344,9 @@ known element in cache (it may start after END)." (or (not (numberp org-element--cache-change-warning)) (> org-element--cache-change-warning (org-element-property :level up))) - (org-with-point-at (org-element-property :contents-begin up) + (org-with-point-at (org-element-contents-begin up) (unless - (save-match-data + (progn (when (looking-at-p org-element-planning-line-re) (forward-line)) (when (looking-at org-property-drawer-re) @@ -6903,9 +7363,8 @@ known element in cache (it may start after END)." ;; Should not see property ;; drawer within changed ;; region. - (save-match-data - (or (not (looking-at org-property-drawer-re)) - (> beg (match-end 0))))))) + (or (not (looking-at org-property-drawer-re)) + (> beg (match-end 0)))))) (_ 'robust))))) ;; UP is a robust greater element containing changes. ;; We only need to extend its ending boundaries. @@ -6917,7 +7376,8 @@ known element in cache (it may start after END)." '(:contents-end :end :robust-end) '(:contents-end :end))) (org-element--cache-log-message - "Shifting end positions of robust parent: %S" + "Shifting end positions of robust parent (warning %S): %S" + org-element--cache-change-warning (org-element--format-element up))) (unless (or ;; UP is non-robust. Yet, if UP is headline, flagging @@ -6927,31 +7387,31 @@ known element in cache (it may start after END)." ;; starting from old :begin position, we do not care that ;; its boundaries could have extended to shrunk - we ;; will re-parent and shift them anyway. - (and (eq 'headline (org-element-type up)) + (and (org-element-type-p up 'headline) (not org-element--cache-avoid-synchronous-headline-re-parsing) ;; The change is not inside headline. Not ;; updating here. - (not (<= beg (org-element-property :begin up))) - (not (> end (org-element-property :end up))) - (let ((current (org-with-point-at (org-element-property :begin up) + (not (<= beg (org-element-begin up))) + (not (> end (org-element-end up))) + (let ((current (org-with-point-at (org-element-begin up) (org-element-with-disabled-cache (and (looking-at-p org-element-headline-re) (org-element-headline-parser nil 'fast)))))) - (when (eq 'headline (org-element-type current)) + (when (org-element-type-p current 'headline) (org-element--cache-log-message - "Found non-robust headline that can be updated individually: %S" + "Found non-robust headline that can be updated individually (warning %S): %S" + org-element--cache-change-warning (org-element--format-element current)) - (org-element-set-element up current) - (org-element-put-property up :granularity 'element) + (org-element-set up current org-element--cache-element-properties) t))) ;; If UP is org-data, the situation is similar to ;; headline case. We just need to re-parse the ;; org-data itself, unless the change is made ;; within blank lines at BOB (that could ;; potentially alter first-section). - (when (and (eq 'org-data (org-element-type up)) - (>= beg (org-element-property :contents-begin up))) - (org-element-set-element up (org-with-point-at 1 (org-element-org-data-parser))) + (when (and (org-element-type-p up 'org-data) + (>= beg (org-element-contents-begin up))) + (org-element-set up (org-with-point-at 1 (org-element-org-data-parser)) org-element--cache-element-properties) (org-element--cache-log-message "Found non-robust change invalidating org-data. Re-parsing: %S" (org-element--format-element up)) @@ -6961,12 +7421,12 @@ known element in cache (it may start after END)." (org-element--format-element up)) (setq before up) (when robust-flag (setq robust-flag nil)))) - (unless (or (org-element-property :parent up) - (eq 'org-data (org-element-type up))) + (unless (or (org-element-property-raw :parent up) + (org-element-type-p up 'org-data)) (org-element--cache-warn "Got element without parent. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" up) (org-element-cache-reset) (error "org-element--cache: Emergency exit")) - (setq up (org-element-property :parent up))) + (setq up (org-element-property-raw :parent up))) ;; We're at top level element containing ELEMENT: if it's ;; altered by buffer modifications, it is first element in ;; cache to be removed. Otherwise, that first element is the @@ -6974,7 +7434,7 @@ known element in cache (it may start after END)." ;; ;; As a special case, do not remove BEFORE if it is a robust ;; container for current changes. - (if (or (< (org-element-property :end before) beg) robust-flag) after + (if (or (< (org-element-end before) beg) robust-flag) after before))))) (defun org-element--cache-submit-request (beg end offset) @@ -7032,12 +7492,13 @@ change, as an integer." (setf (org-element--request-key next) (org-element--cache-key first)) (setf (org-element--request-beg next) - (org-element-property :begin first)) + (org-element-begin first)) (setf (org-element--request-end next) - (max (org-element-property :end first) + (max (org-element-end first) (org-element--request-end next))) (setf (org-element--request-parent next) - (org-element-property :parent first)))) + ;; Cached elements cannot have deferred `:parent'. + (org-element-property-raw :parent first)))) ;; The current and NEXT modifications are intersecting ;; with current modification starting before NEXT and NEXT ;; ending after current. We need to update the common @@ -7055,11 +7516,13 @@ change, as an integer." "Current request intersects with next. Updating. New parent: %S" (org-element--format-element first)) (setf (org-element--request-key next) (org-element--cache-key first)) - (setf (org-element--request-beg next) (org-element-property :begin first)) + (setf (org-element--request-beg next) (org-element-begin first)) (setf (org-element--request-end next) - (max (org-element-property :end first) + (max (org-element-end first) (org-element--request-end next))) - (setf (org-element--request-parent next) (org-element-property :parent first)))))) + (setf (org-element--request-parent next) + ;; Cached elements cannot have deferred `:parent'. + (org-element-property-raw :parent first)))))) ;; Ensure cache is correct up to END. Also make sure that NEXT, ;; if any, is no longer a 0-phase request, thus ensuring that ;; phases are properly ordered. We need to provide OFFSET as @@ -7067,10 +7530,10 @@ change, as an integer." ;; yet to the otherwise correct part of the cache (i.e, before ;; the first request). (org-element--cache-log-message "Adding new phase 0 request") - (when next (org-element--cache-sync (current-buffer) end beg offset)) + (when next (org-element--cache-sync (current-buffer) end beg offset 'force)) (let ((first (org-element--cache-for-removal beg end offset))) (if first - (push (let ((first-beg (org-element-property :begin first)) + (push (let ((first-beg (org-element-begin first)) (key (org-element--cache-key first))) (cond ;; When changes happen before the first known @@ -7086,10 +7549,11 @@ change, as an integer." ;; The current modification is completely inside ;; FIRST. Clear and update cached elements in ;; region containing FIRST. - ((let ((first-end (org-element-property :end first))) + ((let ((first-end (org-element-end first))) (when (> first-end end) (org-element--cache-log-message "Extending to non-robust element %S" (org-element--format-element first)) - (vector key first-beg first-end offset (org-element-property :parent first) 0)))) + (vector key first-beg first-end offset + (org-element-property-raw :parent first) 0)))) (t ;; Now, FIRST is the first element after BEG or ;; non-robust element containing BEG. However, @@ -7100,16 +7564,17 @@ change, as an integer." ;; parent of FIRST and everything inside ;; BEG..END. (let* ((element (org-element--cache-find end)) - (element-end (org-element-property :end element)) + (element-end (org-element-end element)) (up element)) (while (and (not (eq up first)) - (setq up (org-element-property :parent up)) - (>= (org-element-property :begin up) first-beg)) + ;; Cached elements cannot have deferred `:parent'. + (setq up (org-element-property-raw :parent up)) + (>= (org-element-begin up) first-beg)) ;; Note that UP might have been already ;; shifted if it is a robust element. After ;; deletion, it can put it's end before yet ;; unprocessed ELEMENT. - (setq element-end (max (org-element-property :end up) element-end) + (setq element-end (max (org-element-end up) element-end) element up)) ;; Extend region to remove elements between ;; beginning of first and the end of outermost @@ -7152,17 +7617,19 @@ Return non-nil when verification failed." ;; Verify correct parent for the element. (unless (or (not org-element--cache-self-verify) (org-element-property :parent element) - (eq 'org-data (org-element-type element))) + (org-element-type-p element 'org-data)) (org-element--cache-warn "Got element without parent (cache active?: %S). Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" (org-element--cache-active-p) element) (org-element-cache-reset)) (when (and org-element--cache-self-verify (org-element--cache-active-p) - (eq 'headline (org-element-type element)) + (org-element-type-p element 'headline) ;; Avoid too much slowdown (< (random 1000) (* 1000 org-element--cache-self-verify-frequency))) - (org-with-point-at (org-element-property :begin element) + (org-with-point-at (org-element-begin element) (org-element-with-disabled-cache (org-up-heading-or-point-min)) - (unless (or (= (point) (org-element-property :begin (org-element-property :parent element))) + (unless (or (= (point) + (org-element-begin + (org-element-property :parent element))) (eq (point) (point-min))) (org-element--cache-warn "Cached element has wrong parent in %s. Resetting. @@ -7171,26 +7638,29 @@ The element is: %S\n The parent is: %S\n The real parent is: %S" (buffer-name (current-buffer)) (org-element--format-element element) (org-element--format-element (org-element-property :parent element)) - (org-element--format-element (org-element--current-element (org-element-property :end (org-element-property :parent element))))) + (org-element--format-element + (org-element--current-element + (org-element-end (org-element-property :parent element))))) (org-element-cache-reset)) - (org-element--cache-verify-element (org-element-property :parent element)))) + (org-element--cache-verify-element + (org-element-property :parent element)))) ;; Verify the element itself. (when (and org-element--cache-self-verify (org-element--cache-active-p) element - (not (memq (org-element-type element) '(section org-data))) + (not (org-element-type-p element '(section org-data))) ;; Avoid too much slowdown (< (random 1000) (* 1000 org-element--cache-self-verify-frequency))) - (let ((real-element (let (org-element-use-cache) + (let ((real-element (org-element-with-disabled-cache (org-element--parse-to - (if (memq (org-element-type element) '(table-row item)) - (1+ (org-element-property :begin element)) - (org-element-property :begin element)))))) + (if (org-element-type-p element '(table-row item)) + (1+ (org-element-begin element)) + (org-element-begin element)))))) (unless (and (eq (org-element-type real-element) (org-element-type element)) - (eq (org-element-property :begin real-element) (org-element-property :begin element)) - (eq (org-element-property :end real-element) (org-element-property :end element)) - (eq (org-element-property :contents-begin real-element) (org-element-property :contents-begin element)) - (eq (org-element-property :contents-end real-element) (org-element-property :contents-end element)) + (eq (org-element-begin real-element) (org-element-begin element)) + (eq (org-element-end real-element) (org-element-end element)) + (eq (org-element-contents-begin real-element) (org-element-contents-begin element)) + (eq (org-element-contents-end real-element) (org-element-contents-end element)) (or (not (org-element-property :ID real-element)) (string= (org-element-property :ID real-element) (org-element-property :ID element)))) (org-element--cache-warn "(%S) Cached element is incorrect in %s. (Cache tic up to date: %S) Resetting. @@ -7203,15 +7673,20 @@ The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%S\n%S" "no" "yes") (org-element--format-element element) (org-element--format-element real-element) - (org-element--cache-find (1- (org-element-property :begin real-element))) - (car (org-element--cache-find (org-element-property :begin real-element) 'both)) - (cdr (org-element--cache-find (org-element-property :begin real-element) 'both))) + (org-element--format-element (org-element--cache-find (1- (org-element-begin real-element)))) + (org-element--format-element (car (org-element--cache-find (org-element-begin real-element) 'both))) + (org-element--format-element (cdr (org-element--cache-find (org-element-begin real-element) 'both)))) (org-element-cache-reset)))))) ;;; Cache persistence (defun org-element--cache-persist-before-write (container &optional associated) - "Sync cache before saving." + "Sync element cache for CONTAINER and ASSOCIATED item before saving. +This function is intended to be used in `org-persist-before-write-hook'. + +Prevent writing to disk cache when cache is disabled in the CONTAINER +buffer. Otherwise, cleanup cache sync keys, unreadable :buffer +properties, and verify cache consistency." (when (equal container '(elisp org-element--cache)) (if (and org-element-use-cache (plist-get associated :file) @@ -7223,39 +7698,78 @@ The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%S\n%S" (org-with-wide-buffer (org-element--cache-sync (current-buffer) (point-max)) ;; Cleanup cache request keys to avoid collisions during next - ;; Emacs session. + ;; Emacs session. Cleanup known non-printable objects. (avl-tree-mapc (lambda (el) - (org-element-put-property el :org-element--cache-sync-key nil)) + (org-element-put-property el :org-element--cache-sync-key nil) + (org-element-map el t + (lambda (el2) + (unless (org-element-type-p el2 'plain-text) + (org-element-put-property el2 :buffer nil))) + nil nil nil 'with-affiliated 'no-undefer) + (let ((org-element--cache-self-verify-frequency 1.0)) + (when (and org-element--cache-self-verify-before-persisting + (org-element--cache-verify-element el)) + (error "Cache verification failed: aborting")))) org-element--cache) nil) 'forbid)) 'forbid))) (defun org-element--cache-persist-before-read (container &optional associated) - "Avoid reading cache before Org mode is loaded." + "Avoid reading cache for CONTAINER and ASSOCIATED before Org mode is loaded. +This function is intended to be used in `org-persist-before-read-hook'. + +Also, prevent reading cache when the buffer CONTAINER hash is not +consistent with the cache." (when (equal container '(elisp org-element--cache)) + (org-element--cache-log-message "Loading persistent cache for %s" (plist-get associated :file)) (if (not (and (plist-get associated :file) (get-file-buffer (plist-get associated :file)))) - 'forbid + (progn + (org-element--cache-log-message "%s does not have a buffer: not loading cache" (plist-get associated :file)) + 'forbid) (with-current-buffer (get-file-buffer (plist-get associated :file)) (unless (and org-element-use-cache org-element-cache-persistent (derived-mode-p 'org-mode) (equal (secure-hash 'md5 (current-buffer)) (plist-get associated :hash))) + (org-element--cache-log-message "Cache is not current (or persistence is disabled) in %s" (plist-get associated :file)) 'forbid))))) (defun org-element--cache-persist-after-read (container &optional associated) - "Setup restored cache." + "Setup restored cache for CONTAINER and ASSOCIATED. +Re-fill :buffer properties for cache elements (buffer objects cannot +be written onto disk). Also, perform some consistency checks to +prevent loading corrupted cache." (when (and (plist-get associated :file) (get-file-buffer (plist-get associated :file))) (with-current-buffer (get-file-buffer (plist-get associated :file)) (when (and org-element-use-cache org-element-cache-persistent) - (when (and (equal container '(elisp org-element--cache)) org-element--cache) - (setq-local org-element--cache-size (avl-tree-size org-element--cache))) - (when (and (equal container '(elisp org-element--headline-cache)) org-element--headline-cache) - (setq-local org-element--headline-cache-size (avl-tree-size org-element--headline-cache))))))) + (catch 'abort + (when (and (equal container '(elisp org-element--cache)) org-element--cache) + ;; Restore `:buffer' property. + (avl-tree-mapc + (lambda (el) + (org-element-map el t + (lambda (el2) + (unless (org-element-type-p el2 'plain-text) + (org-element-put-property el2 :buffer (current-buffer)))) + nil nil nil 'with-affiliated 'no-undefer) + (org-element--cache-log-message + "Recovering persistent cached element: %S" + (org-element--format-element el)) + (when (and (not (org-element-parent el)) (not (org-element-type-p el 'org-data))) + (org-element--cache-warn + "Got element without parent when loading cache from disk. Not using this persistent cache. +Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" el) + (org-element-cache-reset) + (throw 'abort t))) + org-element--cache) + (setq-local org-element--cache-size (avl-tree-size org-element--cache))) + (when (and (equal container '(elisp org-element--headline-cache)) org-element--headline-cache) + (setq-local org-element--headline-cache-size (avl-tree-size org-element--headline-cache)))))))) (add-hook 'org-persist-before-write-hook #'org-element--cache-persist-before-write) (add-hook 'org-persist-before-read-hook #'org-element--cache-persist-before-read) @@ -7282,14 +7796,23 @@ the cache persistence in the buffer." ;; Only persist cache in file buffers. (when (and (buffer-file-name) (not no-persistence)) (when (not org-element-cache-persistent) - (org-persist-unregister 'org-element--headline-cache (current-buffer)) - (org-persist-unregister 'org-element--cache (current-buffer))) + (org-persist-unregister + 'org-element--headline-cache + (current-buffer) + :remove-related t) + (org-persist-unregister + 'org-element--cache + (current-buffer) + :remove-related t)) (when (and org-element-cache-persistent (buffer-file-name (current-buffer))) - (org-persist-register 'org-element--cache (current-buffer)) - (org-persist-register 'org-element--headline-cache - (current-buffer) - :inherit 'org-element--cache))) + (org-persist-register + `((elisp org-element--cache) (version ,org-element-cache-version)) + (current-buffer)) + (org-persist-register + 'org-element--headline-cache + (current-buffer) + :inherit `((elisp org-element--cache) (version ,org-element-cache-version))))) (setq-local org-element--cache-change-tic (buffer-chars-modified-tick)) (setq-local org-element--cache-last-buffer-size (buffer-size)) (setq-local org-element--cache-gapless nil) @@ -7306,6 +7829,14 @@ the cache persistence in the buffer." (setq-local org-element--cache-sync-requests nil) (setq-local org-element--cache-sync-timer nil) (org-element--cache-setup-change-functions) + ;; Install in the existing indirect buffers. + (dolist (buf (seq-filter + (lambda (buf) + (eq (current-buffer) + (buffer-base-buffer buf))) + (buffer-list))) + (with-current-buffer buf + (org-element--cache-setup-change-functions))) ;; Make sure that `org-element--cache-after-change' and ;; `org-element--cache-before-change' are working inside properly created ;; indirect buffers. Note that `clone-indirect-buffer-hook' @@ -7316,6 +7847,45 @@ the cache persistence in the buffer." (add-hook 'clone-indirect-buffer-hook #'org-element--cache-setup-change-functions))))) +;;;###autoload +(defun org-element-cache-store-key (epom key value &optional robust) + "Store KEY with VALUE associated with EPOM - point, marker, or element. +The key can be retrieved as long as the element (provided or at point) +contents is not modified. +If optional argument ROBUST is non-nil, the key will be retained even +when the contents (children) of current element are modified. Only +non-robust element modifications (affecting the element properties +other then begin/end boundaries) will invalidate the key then." + (let ((element (org-element-at-point epom)) + (property (if robust :robust-cache :fragile-cache))) + (let ((key-store (org-element-property property element))) + (unless (hash-table-p key-store) + (setq key-store (make-hash-table :test #'equal)) + (org-element-put-property element property key-store)) + (puthash key value key-store)))) + +;;;###autoload +(defun org-element-cache-get-key (epom key &optional default) + "Get KEY associated with EPOM - point, marker, or element. +Return DEFAULT when KEY is not associated with EPOM. +The key can be retrieved as long as the element (provided or at point) +contents is not modified." + (let ((element (org-element-at-point epom))) + (let ((key-store1 (org-element-property :fragile-cache element)) + (key-store2 (org-element-property :robust-cache element))) + (let ((val1 (if (hash-table-p key-store1) + (gethash key key-store1 'not-found) + 'not-found)) + (val2 (if (hash-table-p key-store2) + (gethash key key-store2 'not-found) + 'not-found))) + (cond + ((and (eq 'not-found val1) + (eq 'not-found val2)) + default) + ((eq 'not-found val1) val2) + ((eq 'not-found val2) val1)))))) + ;;;###autoload (defun org-element-cache-refresh (pos) "Refresh cache at position POS." @@ -7324,8 +7894,35 @@ the cache persistence in the buffer." (org-element--cache-submit-request pos pos 0) (org-element--cache-set-timer (current-buffer)))) -(defvar warning-minimum-log-level) ; Defined in warning.el +(defmacro org-element-with-enabled-cache (&rest body) + "Run BODY with org-element cache enabled (maybe temporarily). +When cache is enabled, just run body. +When cache is disabled, initialize a new cache, run BODY, and cleanup +at the end." + (declare (debug (form body)) (indent 0)) + (org-with-gensyms (old-state buffer) + `(if (org-element--cache-active-p) + ;; Cache is active, just run BODY. + (progn ,@body) + ;; Cache is disabled. + ;; Save existing cache. + (let ((,buffer (current-buffer)) + (,old-state + (org-with-base-buffer nil + (mapcar #'symbol-value org-element--cache-variables))) + (org-element-use-cache t)) + (unwind-protect + (progn + (org-element-cache-reset) + ,@body) + (cl-mapc + (lambda (var values) + (org-with-base-buffer ,buffer + (set var values))) + org-element--cache-variables + ,old-state)))))) +(defvar warning-minimum-log-level) ; Defined in warning.el (defvar org-element-cache-map-continue-from nil "Position from where mapping should continue. This variable can be set by called function, especially when the @@ -7334,8 +7931,8 @@ function modified the buffer.") (cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) restrict-elements next-re fail-re from-pos (to-pos (point-max-marker)) after-element limit-count narrow) - "Map all elements in current buffer with FUNC according to -GRANULARITY. Collect non-nil return values into result list. + "Map all elements in current buffer with FUNC according to GRANULARITY. +Collect non-nil return values into result list. FUNC should accept a single argument - the element. @@ -7379,346 +7976,356 @@ This function does a subset of what `org-element-map' does, but with much better performance. Cached elements are supplied as the single argument of FUNC. Changes to elements made in FUNC will also alter the cache." - (unless (org-element--cache-active-p) - (error "Cache must be active.")) - (unless (memq granularity '( headline headline+inlinetask - greater-element element)) - (error "Unsupported granularity: %S" granularity)) - ;; Make TO-POS marker. Otherwise, buffer edits may garble the the - ;; process. - (unless (markerp to-pos) - (let ((mk (make-marker))) - (set-marker mk to-pos) - (setq to-pos mk))) - (let (;; Bind variables used inside loop to avoid memory - ;; re-allocation on every iteration. - ;; See https://emacsconf.org/2021/talks/faster/ - tmpnext-start tmpparent tmpelement) - (save-excursion - (save-restriction - (unless narrow (widen)) - ;; Synchronize cache up to the end of mapped region. - (org-element-at-point to-pos) - (cl-macrolet ((cache-root - ;; Use the most optimal version of cache available. - () `(org-with-base-buffer nil - (if (memq granularity '(headline headline+inlinetask)) - (org-element--headline-cache-root) - (org-element--cache-root)))) - (cache-size - ;; Use the most optimal version of cache available. - () `(org-with-base-buffer nil - (if (memq granularity '(headline headline+inlinetask)) - org-element--headline-cache-size - org-element--cache-size))) - (cache-walk-restart - ;; Restart tree traversal after AVL tree re-balance. - () `(when node - (org-element-at-point (point-max)) - (setq node (cache-root) - stack (list nil) - leftp t - continue-flag t))) - (cache-walk-abort - ;; Abort tree traversal. - () `(setq continue-flag t - node nil)) - (element-match-at-point - ;; Returning the first element to match around point. - ;; For example, if point is inside headline and - ;; granularity is restricted to headlines only, skip - ;; over all the child elements inside the headline - ;; and return the first parent headline. - ;; When we are inside a cache gap, calling - ;; `org-element-at-point' also fills the cache gap down to - ;; point. - () `(progn - ;; Parsing is one of the performance - ;; bottlenecks. Make sure to optimize it as - ;; much as possible. - ;; - ;; Avoid extra staff like timer cancels et al - ;; and only call `org-element--cache-sync-requests' when - ;; there are pending requests. - (org-with-base-buffer nil - (when org-element--cache-sync-requests - (org-element--cache-sync (current-buffer)))) - ;; Call `org-element--parse-to' directly avoiding any - ;; kind of `org-element-at-point' overheads. - (if restrict-elements - ;; Search directly instead of calling - ;; `org-element-lineage' to avoid funcall overheads - ;; and making sure that we do not go all - ;; the way to `org-data' as `org-element-lineage' - ;; does. - (progn - (setq tmpelement (org-element--parse-to (point))) - (while (and tmpelement (not (memq (org-element-type tmpelement) restrict-elements))) - (setq tmpelement (org-element-property :parent tmpelement))) - tmpelement) - (org-element--parse-to (point))))) - ;; Starting from (point), search RE and move START to - ;; the next valid element to be matched according to - ;; restriction. Abort cache walk if no next element - ;; can be found. When RE is nil, just find element at - ;; point. - (move-start-to-next-match - (re) `(save-match-data - (if (or (not ,re) - (if org-element--cache-map-statistics - (progn - (setq before-time (float-time)) - (re-search-forward (or (car-safe ,re) ,re) nil 'move) - (cl-incf re-search-time - (- (float-time) - before-time))) - (re-search-forward (or (car-safe ,re) ,re) nil 'move))) - (unless (or (< (point) (or start -1)) - (and data - (< (point) (org-element-property :begin data)))) - (if (cdr-safe ,re) - ;; Avoid parsing when we are 100% - ;; sure that regexp is good enough - ;; to find new START. - (setq start (match-beginning 0)) - (setq start (max (or start -1) - (or (org-element-property :begin data) -1) - (or (org-element-property :begin (element-match-at-point)) -1)))) - (when (>= start to-pos) (cache-walk-abort)) - (when (eq start -1) (setq start nil))) - (cache-walk-abort)))) - ;; Find expected begin position of an element after - ;; DATA. - (next-element-start - () `(progn - (setq tmpnext-start nil) - (if (memq granularity '(headline headline+inlinetask)) - (setq tmpnext-start (or (when (memq (org-element-type data) '(headline org-data)) - (org-element-property :contents-begin data)) - (org-element-property :end data))) - (setq tmpnext-start (or (when (memq (org-element-type data) org-element-greater-elements) - (org-element-property :contents-begin data)) - (org-element-property :end data)))) - ;; DATA end may be the last element inside - ;; i.e. source block. Skip up to the end - ;; of parent in such case. - (setq tmpparent data) - (catch :exit - (when (eq tmpnext-start (org-element-property :contents-end tmpparent)) - (setq tmpnext-start (org-element-property :end tmpparent))) - (while (setq tmpparent (org-element-property :parent tmpparent)) - (if (eq tmpnext-start (org-element-property :contents-end tmpparent)) - (setq tmpnext-start (org-element-property :end tmpparent)) - (throw :exit t)))) - tmpnext-start)) - ;; Check if cache does not have gaps. - (cache-gapless-p - () `(org-with-base-buffer nil - (eq org-element--cache-change-tic - (alist-get granularity org-element--cache-gapless))))) - ;; The core algorithm is simple walk along binary tree. However, - ;; instead of checking all the tree elements from first to last - ;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping - ;; the elements before FROM-POS efficiently: O(logN) instead of - ;; O(Nbefore). - ;; - ;; Later, we may also not check every single element in the - ;; binary tree after FROM-POS. Instead, we can find position of - ;; next candidate elements by means of regexp search and skip the - ;; binary tree branches that are before the next candidate: - ;; again, O(logN) instead of O(Nbetween). - ;; - ;; Some elements might not yet be in the tree. So, we also parse - ;; the empty gaps in cache as needed making sure that we do not - ;; miss anything. - (let* (;; START is always beginning of an element. When there is - ;; no element in cache at START, we are inside cache gap - ;; and need to fill it. - (start (and from-pos - (progn - (goto-char from-pos) - (org-element-property :begin (element-match-at-point))))) - ;; Some elements may start at the same position, so we - ;; also keep track of the last processed element and make - ;; sure that we do not try to search it again. - (prev after-element) - (node (cache-root)) - data - (stack (list nil)) - (leftp t) - result - ;; Whether previous element matched FUNC (FUNC - ;; returned non-nil). - (last-match t) - continue-flag - ;; Generic regexp to search next potential match. If it - ;; is a cons of (regexp . 'match-beg), we are 100% sure - ;; that the match beginning is the existing element - ;; beginning. - (next-element-re (pcase granularity - ((or `headline - (guard (equal '(headline) - restrict-elements))) - (cons - (org-with-limited-levels - org-element-headline-re) - 'match-beg)) - (`headline+inlinetask - (cons - (if (equal '(inlinetask) restrict-elements) - (org-inlinetask-outline-regexp) - org-element-headline-re) - 'match-beg)) - ;; TODO: May add other commonly - ;; searched elements as needed. - (_))) - ;; Make sure that we are not checking the same regexp twice. - (next-re (unless (and next-re - (string= next-re - (or (car-safe next-element-re) - next-element-re))) - next-re)) - (fail-re (unless (and fail-re - (string= fail-re - (or (car-safe next-element-re) - next-element-re))) - fail-re)) - (restrict-elements (or restrict-elements - (pcase granularity - (`headline - '(headline)) - (`headline+inlinetask - '(headline inlinetask)) - (`greater-element - org-element-greater-elements) - (_ nil)))) - ;; Statistics - (time (float-time)) - (predicate-time 0) - (pre-process-time 0) - (re-search-time 0) - (count-predicate-calls-match 0) - (count-predicate-calls-fail 0) - ;; Bind variables used inside loop to avoid memory - ;; re-allocation on every iteration. - ;; See https://emacsconf.org/2021/talks/faster/ - cache-size before-time modified-tic) - ;; Skip to first element within region. - (goto-char (or start (point-min))) - (move-start-to-next-match next-element-re) - (unless (and start (>= start to-pos)) - (while node - (setq data (avl-tree--node-data node)) - (if (and leftp (avl-tree--node-left node) ; Left branch. - ;; Do not move to left branch when we are before - ;; PREV. - (or (not prev) - (not (org-element--cache-key-less-p - (org-element--cache-key data) - (org-element--cache-key prev)))) - ;; ... or when we are before START. - (or (not start) - (not (> start (org-element-property :begin data))))) - (progn (push node stack) - (setq node (avl-tree--node-left node))) - ;; The whole tree left to DATA is before START and - ;; PREV. DATA may still be before START (i.e. when - ;; DATA is the root or when START moved), at START, or - ;; after START. - ;; - ;; If DATA is before start, skip it over and move to - ;; subsequent elements. - ;; If DATA is at start, run FUNC if necessary and - ;; update START according and NEXT-RE, FAIL-RE, - ;; NEXT-ELEMENT-RE. - ;; If DATA is after start, we have found a cache gap - ;; and need to fill it. - (unless (or (and start (< (org-element-property :begin data) start)) - (and prev (not (org-element--cache-key-less-p - (org-element--cache-key prev) - (org-element--cache-key data))))) - ;; DATA is at of after START and PREV. - (if (or (not start) (= (org-element-property :begin data) start)) - ;; DATA is at START. Match it. - ;; In the process, we may alter the buffer, - ;; so also keep track of the cache state. - (progn - (setq modified-tic + (org-element-with-enabled-cache + (unless (org-element--cache-active-p) + (error "Cache must be active")) + (unless (memq granularity '( headline headline+inlinetask + greater-element element)) + (error "Unsupported granularity: %S" granularity)) + ;; Make TO-POS marker. Otherwise, buffer edits may garble the the + ;; process. + (unless (markerp to-pos) + (let ((mk (make-marker))) + (set-marker mk to-pos) + (setq to-pos mk))) + (let ((gc-cons-threshold #x40000000) + ;; Bind variables used inside loop to avoid memory + ;; re-allocation on every iteration. + ;; See https://emacsconf.org/2021/talks/faster/ + tmpnext-start tmpparent tmpelement) + (save-excursion + (save-restriction + (unless narrow (widen)) + ;; Synchronize cache up to the end of mapped region. + (org-element-at-point to-pos) + (cl-macrolet ((cache-root + ;; Use the most optimal version of cache available. + () `(org-with-base-buffer nil + (if (memq granularity '(headline headline+inlinetask)) + (org-element--headline-cache-root) + (org-element--cache-root)))) + (cache-size + ;; Use the most optimal version of cache available. + () `(org-with-base-buffer nil + (if (memq granularity '(headline headline+inlinetask)) + org-element--headline-cache-size + org-element--cache-size))) + (cache-walk-restart + ;; Restart tree traversal after AVL tree re-balance. + () `(when node + (org-element-at-point (point-max)) + (setq node (cache-root) + stack (list nil) + leftp t + continue-flag t))) + (cache-walk-abort + ;; Abort tree traversal. + () `(setq continue-flag t + node nil)) + (element-match-at-point + ;; Returning the first element to match around point. + ;; For example, if point is inside headline and + ;; granularity is restricted to headlines only, skip + ;; over all the child elements inside the headline + ;; and return the first parent headline. + ;; When we are inside a cache gap, calling + ;; `org-element-at-point' also fills the cache gap down to + ;; point. + () `(progn + ;; Parsing is one of the performance + ;; bottlenecks. Make sure to optimize it as + ;; much as possible. + ;; + ;; Avoid extra staff like timer cancels et al + ;; and only call `org-element--cache-sync-requests' when + ;; there are pending requests. (org-with-base-buffer nil - org-element--cache-change-tic)) - (setq cache-size (cache-size)) - ;; When NEXT-RE/FAIL-RE is provided, skip to - ;; next regexp match after :begin of the current - ;; element. - (when (if last-match next-re fail-re) - (goto-char (org-element-property :begin data)) - (move-start-to-next-match - (if last-match next-re fail-re))) - (when (and (or (not start) (eq (org-element-property :begin data) start)) - (< (org-element-property :begin data) to-pos)) - ;; Calculate where next possible element - ;; starts and update START if needed. - (setq start (next-element-start)) - (goto-char start) - ;; Move START further if possible. - (when (and next-element-re - ;; Do not move if we know for - ;; sure that cache does not - ;; contain gaps. Regexp - ;; searches are not cheap. - (not (cache-gapless-p))) - (move-start-to-next-match next-element-re) - ;; Make sure that point is at START - ;; before running FUNC. - (goto-char start)) - ;; Try FUNC if DATA matches all the - ;; restrictions. Calculate new START. - (when (or (not restrict-elements) - (memq (org-element-type data) restrict-elements)) - ;; DATA matches restriction. FUNC may - ;; - ;; Call FUNC. FUNC may move point. - (setq org-element-cache-map-continue-from nil) - (if (org-with-base-buffer nil org-element--cache-map-statistics) - (progn - (setq before-time (float-time)) - (push (funcall func data) result) - (cl-incf predicate-time - (- (float-time) - before-time)) - (if (car result) - (cl-incf count-predicate-calls-match) - (cl-incf count-predicate-calls-fail))) - (push (funcall func data) result) - (when (car result) (cl-incf count-predicate-calls-match))) - ;; Set `last-match'. - (setq last-match (car result)) - ;; If FUNC moved point forward, update - ;; START. - (when org-element-cache-map-continue-from - (goto-char org-element-cache-map-continue-from)) - (when (> (point) start) - (move-start-to-next-match nil) - ;; (point) inside matching element. - ;; Go further. - (when (> (point) start) - (setq data (element-match-at-point)) - (if (not data) - (cache-walk-abort) - (goto-char (next-element-start)) - (move-start-to-next-match next-element-re)))) - ;; Drop nil. - (unless (car result) (pop result))) - ;; If FUNC did not move the point and we - ;; know for sure that cache does not contain - ;; gaps, do not try to calculate START in - ;; advance but simply loop to the next cache + (when org-element--cache-sync-requests + (org-element--cache-sync (current-buffer)))) + ;; Call `org-element--parse-to' directly avoiding any + ;; kind of `org-element-at-point' overheads. + (if restrict-elements + ;; Search directly instead of calling + ;; `org-element-lineage' to avoid funcall overheads + ;; and making sure that we do not go all + ;; the way to `org-data' as `org-element-lineage' + ;; does. + (progn + (setq tmpelement (org-element--parse-to (point))) + (while (and tmpelement (not (org-element-type-p tmpelement restrict-elements))) + (setq tmpelement (org-element-parent tmpelement))) + tmpelement) + (org-element--parse-to (point))))) + ;; Starting from (point), search RE and move START to + ;; the next valid element to be matched according to + ;; restriction. Abort cache walk if no next element + ;; can be found. When RE is nil, just find element at + ;; point. + (move-start-to-next-match + ;; Preserve match data that might be set by FUNC. + (re) `(save-match-data + (if (or (not ,re) + (if org-element--cache-map-statistics + (progn + (setq before-time (float-time)) + (prog1 (re-search-forward (or (car-safe ,re) ,re) nil 'move) + (cl-incf re-search-time + (- (float-time) + before-time)))) + (re-search-forward (or (car-safe ,re) ,re) nil 'move))) + (unless (or (< (point) (or start -1)) + (and data + (< (point) (org-element-begin data)))) + (if (cdr-safe ,re) + ;; Avoid parsing when we are 100% + ;; sure that regexp is good enough + ;; to find new START. + (setq start (match-beginning 0)) + (setq start (max (or start -1) + (or (org-element-begin data) -1) + (or (org-element-begin (element-match-at-point)) -1)))) + (when (>= start to-pos) (cache-walk-abort)) + (when (eq start -1) (setq start nil))) + (cache-walk-abort)))) + ;; Find expected begin position of an element after + ;; DATA. + (next-element-start + () `(progn + (setq tmpnext-start nil) + (if (memq granularity '(headline headline+inlinetask)) + (setq tmpnext-start (or (when (org-element-type-p data '(headline org-data)) + (org-element-contents-begin data)) + (org-element-end data))) + (setq tmpnext-start (or (when (org-element-type-p data org-element-greater-elements) + (org-element-contents-begin data)) + (org-element-end data)))) + ;; DATA end may be the last element inside + ;; i.e. source block. Skip up to the end + ;; of parent in such case. + (setq tmpparent data) + (catch :exit + (when (eq tmpnext-start (org-element-contents-end tmpparent)) + (setq tmpnext-start (org-element-end tmpparent))) + (while (setq tmpparent (org-element-parent tmpparent)) + (if (eq tmpnext-start (org-element-contents-end tmpparent)) + (setq tmpnext-start (org-element-end tmpparent)) + (throw :exit t)))) + tmpnext-start)) + ;; Check if cache does not have gaps. + (cache-gapless-p + () `(org-with-base-buffer nil + (eq org-element--cache-change-tic + (alist-get granularity org-element--cache-gapless))))) + ;; The core algorithm is simple walk along binary tree. However, + ;; instead of checking all the tree elements from first to last + ;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping + ;; the elements before FROM-POS efficiently: O(logN) instead of + ;; O(Nbefore). + ;; + ;; Later, we may also not check every single element in the + ;; binary tree after FROM-POS. Instead, we can find position of + ;; next candidate elements by means of regexp search and skip the + ;; binary tree branches that are before the next candidate: + ;; again, O(logN) instead of O(Nbetween). + ;; + ;; Some elements might not yet be in the tree. So, we also parse + ;; the empty gaps in cache as needed making sure that we do not + ;; miss anything. + (let* (;; START is always beginning of an element. When there is + ;; no element in cache at START, we are inside cache gap + ;; and need to fill it. + (start (and from-pos + (progn + (goto-char from-pos) + (org-element-begin (element-match-at-point))))) + ;; Some elements may start at the same position, so we + ;; also keep track of the last processed element and make + ;; sure that we do not try to search it again. + (prev after-element) + (node (cache-root)) + data + (stack (list nil)) + (leftp t) + result + ;; Whether previous element matched FUNC (FUNC + ;; returned non-nil). + (last-match t) + continue-flag + ;; Generic regexp to search next potential match. If it + ;; is a cons of (regexp . 'match-beg), we are 100% sure + ;; that the match beginning is the existing element + ;; beginning. + (next-element-re (pcase granularity + ((or `headline + (guard (equal '(headline) + restrict-elements))) + (cons + (org-with-limited-levels + org-element-headline-re) + 'match-beg)) + (`headline+inlinetask + (cons + (if (equal '(inlinetask) restrict-elements) + (org-inlinetask-outline-regexp) + org-element-headline-re) + 'match-beg)) + ;; TODO: May add other commonly + ;; searched elements as needed. + (_))) + ;; Make sure that we are not checking the same regexp twice. + (next-re (unless (and next-re + (string= next-re + (or (car-safe next-element-re) + next-element-re))) + next-re)) + (fail-re (unless (and fail-re + (string= fail-re + (or (car-safe next-element-re) + next-element-re))) + fail-re)) + (restrict-elements (or restrict-elements + (pcase granularity + (`headline + '(headline)) + (`headline+inlinetask + '(headline inlinetask)) + (`greater-element + org-element-greater-elements) + (_ nil)))) + ;; Statistics + (time (float-time)) + (predicate-time 0) + (pre-process-time 0) + (re-search-time 0) + (count-predicate-calls-match 0) + (count-predicate-calls-fail 0) + ;; Bind variables used inside loop to avoid memory + ;; re-allocation on every iteration. + ;; See https://emacsconf.org/2021/talks/faster/ + cache-size before-time modified-tic) + ;; Skip to first element within region. + (goto-char (or start (point-min))) + (move-start-to-next-match next-element-re) + (unless (and start (>= start to-pos)) + (while node + (setq data (avl-tree--node-data node)) + (if (and leftp (avl-tree--node-left node) ; Left branch. + ;; Do not move to left branch when we are before + ;; PREV. + (or (not prev) + (not (org-element--cache-key-less-p + (org-element--cache-key data) + (org-element--cache-key prev)))) + ;; ... or when we are before START. + (or (not start) + (not (> start (org-element-begin data))))) + (progn (push node stack) + (setq node (avl-tree--node-left node))) + ;; The whole tree left to DATA is before START and + ;; PREV. DATA may still be before START (i.e. when + ;; DATA is the root or when START moved), at START, or + ;; after START. + ;; + ;; If DATA is before start, skip it over and move to + ;; subsequent elements. + ;; If DATA is at start, run FUNC if necessary and + ;; update START according and NEXT-RE, FAIL-RE, + ;; NEXT-ELEMENT-RE. + ;; If DATA is after start, we have found a cache gap + ;; and need to fill it. + (unless (or (and start (< (org-element-begin data) start)) + (and prev (not (org-element--cache-key-less-p + (org-element--cache-key prev) + (org-element--cache-key data))))) + ;; DATA is at of after START and PREV. + (if (or (not start) (= (org-element-begin data) start)) + ;; DATA is at START. Match it. + ;; In the process, we may alter the buffer, + ;; so also keep track of the cache state. + (progn + (setq modified-tic + (org-with-base-buffer nil + org-element--cache-change-tic)) + (setq cache-size (cache-size)) + ;; When NEXT-RE/FAIL-RE is provided, skip to + ;; next regexp match after :begin of the current ;; element. - (when (and (cache-gapless-p) - (eq (next-element-start) - start)) - (setq start nil)) - ;; Check if the buffer has been modified. + (when (if last-match next-re fail-re) + (goto-char (org-element-begin data)) + (move-start-to-next-match + (if last-match next-re fail-re))) + (when (and (or (not start) (eq (org-element-begin data) start)) + (< (org-element-begin data) to-pos) + (not continue-flag)) + ;; Calculate where next possible element + ;; starts and update START if needed. + (setq start (next-element-start)) + (goto-char start) + ;; Move START further if possible. + (save-excursion + (when (and next-element-re + ;; Do not move if we know for + ;; sure that cache does not + ;; contain gaps. Regexp + ;; searches are not cheap. + (not (cache-gapless-p))) + (move-start-to-next-match next-element-re))) + ;; Try FUNC if DATA matches all the + ;; restrictions. Calculate new START. + (when (or (not restrict-elements) + (org-element-type-p data restrict-elements)) + ;; DATA matches restriction. FUNC may + ;; + ;; Call FUNC. FUNC may move point. + (setq org-element-cache-map-continue-from nil) + (if (org-with-base-buffer nil org-element--cache-map-statistics) + (progn + (setq before-time (float-time)) + (push (funcall func data) result) + (cl-incf predicate-time + (- (float-time) + before-time)) + (if (car result) + (cl-incf count-predicate-calls-match) + (cl-incf count-predicate-calls-fail))) + (push (funcall func data) result) + (when (car result) (cl-incf count-predicate-calls-match))) + ;; Set `last-match'. + (setq last-match (car result)) + ;; If FUNC moved point forward, update + ;; START. + (when org-element-cache-map-continue-from + (goto-char org-element-cache-map-continue-from)) + (when (> (point) start) + (move-start-to-next-match nil) + ;; (point) inside matching element. + ;; Go further. + (when (> (point) start) + (setq data (element-match-at-point)) + (if (not data) + (cache-walk-abort) + (goto-char (next-element-start)) + (move-start-to-next-match next-element-re)))) + ;; Drop nil. + (unless (car result) (pop result))) + ;; If FUNC did not move the point and we + ;; know for sure that cache does not contain + ;; gaps, do not try to calculate START in + ;; advance but simply loop to the next cache + ;; element. + (when (and (cache-gapless-p) + (eq (next-element-start) + start)) + (setq start nil)) + ;; Reached LIMIT-COUNT. Abort. + (when (and limit-count + (>= count-predicate-calls-match + limit-count)) + (cache-walk-abort)) + ;; Make sure that we have a cached + ;; element at the new STAR. + (when start (element-match-at-point))) + ;; Check if the buffer or cache has been modified. (unless (org-with-base-buffer nil (and (eq modified-tic org-element--cache-change-tic) (eq cache-size (cache-size)))) @@ -7737,7 +8344,7 @@ the cache." ;; element past already processed ;; place. (when (and start - (<= start (org-element-property :begin data)) + (<= start (org-element-begin data)) (not org-element-cache-map-continue-from)) (goto-char start) (setq data (element-match-at-point)) @@ -7748,58 +8355,55 @@ the cache." (move-start-to-next-match next-element-re))) (org-element-at-point to-pos) (cache-walk-restart)) - ;; Reached LIMIT-COUNT. Abort. - (when (and limit-count - (>= count-predicate-calls-match - limit-count)) - (cache-walk-abort)) (if (org-element-property :cached data) (setq prev data) - (setq prev nil)))) - ;; DATA is after START. Fill the gap. - (if (memq (org-element-type (org-element--parse-to start)) '(plain-list table)) - ;; Tables and lists are special, we need a - ;; trickery to make items/rows be populated - ;; into cache. - (org-element--parse-to (1+ start))) - ;; Restart tree traversal as AVL tree is - ;; re-balanced upon adding elements. We can no - ;; longer trust STACK. - (cache-walk-restart))) - ;; Second, move to the right branch of the tree or skip - ;; it altogether. - (if continue-flag - (setq continue-flag nil) - (setq node (if (and (car stack) - ;; If START advanced beyond stack parent, skip the right branch. - (or (and start (< (org-element-property :begin (avl-tree--node-data (car stack))) start)) - (and prev (org-element--cache-key-less-p - (org-element--cache-key (avl-tree--node-data (car stack))) - (org-element--cache-key prev))))) - (progn - (setq leftp nil) - (pop stack)) - ;; Otherwise, move ahead into the right - ;; branch when it exists. - (if (setq leftp (avl-tree--node-right node)) - (avl-tree--node-right node) - (pop stack)))))))) - (when (and org-element--cache-map-statistics - (or (not org-element--cache-map-statistics-threshold) - (> (- (float-time) time) org-element--cache-map-statistics-threshold))) - (message "Mapped over elements in %S. %d/%d predicate matches. Total time: %f sec. Pre-process time: %f sec. Predicate time: %f sec. Re-search time: %f sec. + (setq prev nil))) + ;; DATA is after START. Fill the gap. + (if (org-element-type-p + (org-element--parse-to start) + '(plain-list table)) + ;; Tables and lists are special, we need a + ;; trickery to make items/rows be populated + ;; into cache. + (org-element--parse-to (1+ start))) + ;; Restart tree traversal as AVL tree is + ;; re-balanced upon adding elements. We can no + ;; longer trust STACK. + (cache-walk-restart))) + ;; Second, move to the right branch of the tree or skip + ;; it altogether. + (if continue-flag + (setq continue-flag nil) + (setq node (if (and (car stack) + ;; If START advanced beyond stack parent, skip the right branch. + (or (and start (< (org-element-begin (avl-tree--node-data (car stack))) start)) + (and prev (org-element--cache-key-less-p + (org-element--cache-key (avl-tree--node-data (car stack))) + (org-element--cache-key prev))))) + (progn + (setq leftp nil) + (pop stack)) + ;; Otherwise, move ahead into the right + ;; branch when it exists. + (if (setq leftp (avl-tree--node-right node)) + (avl-tree--node-right node) + (pop stack)))))))) + (when (and org-element--cache-map-statistics + (or (not org-element--cache-map-statistics-threshold) + (> (- (float-time) time) org-element--cache-map-statistics-threshold))) + (message "Mapped over elements in %S. %d/%d predicate matches. Total time: %f sec. Pre-process time: %f sec. Predicate time: %f sec. Re-search time: %f sec. Calling parameters: :granularity %S :restrict-elements %S :next-re %S :fail-re %S :from-pos %S :to-pos %S :limit-count %S :after-element %S" - (current-buffer) - count-predicate-calls-match - (+ count-predicate-calls-match - count-predicate-calls-fail) - (- (float-time) time) - pre-process-time - predicate-time - re-search-time - granularity restrict-elements next-re fail-re from-pos to-pos limit-count after-element)) - ;; Return result. - (nreverse result))))))) + (current-buffer) + count-predicate-calls-match + (+ count-predicate-calls-match + count-predicate-calls-fail) + (- (float-time) time) + pre-process-time + predicate-time + re-search-time + granularity restrict-elements next-re fail-re from-pos to-pos limit-count after-element)) + ;; Return result. + (nreverse result)))))))) @@ -7822,11 +8426,14 @@ the cache." ;;;###autoload -(defun org-element-at-point (&optional pom cached-only) - "Determine closest element around point or POM. +(defun org-element-at-point (&optional epom cached-only) + "Determine closest element around point or EPOM. + +When EPOM is an element, return it immediately. +Otherwise, determine element at EPOM marker or position. Only check cached element when CACHED-ONLY is non-nil and return nil -unconditionally when element at POM is not in cache. +unconditionally when element at EPOM is not in cache. 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 @@ -7843,66 +8450,76 @@ the first row of a table, returned element will be the table instead of the first row. When point is at the end of the buffer, return the innermost -element ending there." - (setq pom (or pom (point))) - ;; Allow re-parsing when the command can benefit from it. - (when (and cached-only - (memq this-command org-element--cache-non-modifying-commands)) - (setq cached-only nil)) - (let (element) - (when (org-element--cache-active-p) - (if (not (org-with-base-buffer nil org-element--cache)) (org-element-cache-reset) - (unless cached-only (org-element--cache-sync (current-buffer) pom)))) - (setq element (if cached-only - (when (and (org-element--cache-active-p) - (or (not org-element--cache-sync-requests) - (< pom - (org-element--request-beg - (car org-element--cache-sync-requests))))) - (org-element--cache-find pom)) - (condition-case err - (org-element--parse-to pom) - (error - (org-element--cache-warn - "Org parser error in %s::%S. Resetting.\n The error was: %S\n Backtrace:\n%S\n Please report this to Org mode mailing list (M-x org-submit-bug-report)." - (buffer-name (current-buffer)) - pom - err - (when (and (fboundp 'backtrace-get-frames) - (fboundp 'backtrace-to-string)) - (backtrace-to-string (backtrace-get-frames 'backtrace)))) - (org-element-cache-reset) - (org-element--parse-to pom))))) - (when (and (org-element--cache-active-p) - element - (org-element--cache-verify-element element)) - (setq element (org-element--parse-to pom))) - (unless (eq 'org-data (org-element-type element)) - (unless (and cached-only - (not (and element - (or (= pom (org-element-property :begin element)) - (and (not (memq (org-element-type element) org-element-greater-elements)) - (>= pom (org-element-property :begin element)) - (< pom (org-element-property :end element))) - (and (org-element-property :contents-begin element) - (>= pom (org-element-property :begin element)) - (< pom (org-element-property :contents-begin element))) - (and (not (org-element-property :contents-end element)) - (>= pom (org-element-property :begin element)) - (< pom (org-element-property :end element))))))) - (if (not (eq (org-element-type element) 'section)) - element - (org-element-at-point (1+ pom) cached-only)))))) +element ending there. + +This function may modify the match data." + (if (org-element-type epom t) epom + (setq epom (or epom (point))) + (org-with-point-at epom + (unless (derived-mode-p 'org-mode) + (display-warning + '(org-element org-element-parser) + (format-message + "`org-element-at-point' cannot be used in non-Org buffer %S (%s)" + (current-buffer) major-mode))) + ;; Allow re-parsing when the command can benefit from it. + (when (and cached-only + (memq this-command org-element--cache-non-modifying-commands)) + (setq cached-only nil)) + (let (element) + (when (org-element--cache-active-p) + (if (not (org-with-base-buffer nil org-element--cache)) (org-element-cache-reset) + (unless cached-only (org-element--cache-sync (current-buffer) epom)))) + (setq element (if cached-only + (when (and (org-element--cache-active-p) + (or (not org-element--cache-sync-requests) + (< epom + (org-element--request-beg + (car org-element--cache-sync-requests))))) + (org-element--cache-find epom)) + (condition-case-unless-debug err + (org-element--parse-to epom) + (error + (org-element--cache-warn + "Org parser error in %s::%S. Resetting.\n The error was: %S\n Backtrace:\n%S\n Please report this to Org mode mailing list (M-x org-submit-bug-report)." + (buffer-name (current-buffer)) + epom + err + (when (and (fboundp 'backtrace-get-frames) + (fboundp 'backtrace-to-string)) + (backtrace-to-string (backtrace-get-frames 'backtrace)))) + (org-element-cache-reset) + (org-element--parse-to epom))))) + (when (and (org-element--cache-active-p) + element + (org-element--cache-verify-element element)) + (setq element (org-element--parse-to epom))) + (unless (org-element-type-p element 'org-data) + (unless (and cached-only + (not (and element + (or (= epom (org-element-begin element)) + (and (not (org-element-type-p element org-element-greater-elements)) + (>= epom (org-element-begin element)) + (< epom (org-element-end element))) + (and (org-element-contents-begin element) + (>= epom (org-element-begin element)) + (< epom (org-element-contents-begin element))) + (and (not (org-element-contents-end element)) + (>= epom (org-element-begin element)) + (< epom (org-element-end element))))))) + (if (not (org-element-type-p element 'section)) + element + (org-element-at-point (1+ epom) cached-only)))))))) ;;;###autoload (defsubst org-element-at-point-no-context (&optional pom) "Quickly find element at point or POM. It is a faster version of `org-element-at-point' that is not -guaranteed to return correct `:parent' properties even when cache is -enabled." +guaranteed to return cached element. `:parent' element may be +deferred and slow to retrieve." (or (org-element-at-point pom 'cached-only) - (let (org-element-use-cache) (org-element-at-point pom)))) + (org-element-with-disabled-cache (org-element-at-point pom)))) ;;;###autoload (defun org-element-context (&optional element) @@ -7922,148 +8539,125 @@ the beginning of any other object, return that object. Optional argument ELEMENT, when non-nil, is the closest element containing point, as returned by `org-element-at-point'. -Providing it allows for quicker computation." - (save-match-data - (catch 'objects-forbidden - (org-with-wide-buffer - (let* ((pos (point)) - (element (or element (org-element-at-point))) - (type (org-element-type element)) - (post (org-element-property :post-affiliated element))) - ;; If point is inside an element containing objects or - ;; a secondary string, narrow buffer to the container and - ;; proceed with parsing. Otherwise, return ELEMENT. - (cond - ;; At a parsed affiliated keyword, check if we're inside main - ;; or dual value. - ((and post (< pos post)) - (beginning-of-line) - (let ((case-fold-search t)) (looking-at org-element--affiliated-re)) - (cond - ((not (member-ignore-case (match-string 1) - org-element-parsed-keywords)) - (throw 'objects-forbidden element)) - ((< (match-end 0) pos) - (narrow-to-region (match-end 0) (line-end-position))) - ((and (match-beginning 2) - (>= pos (match-beginning 2)) - (< pos (match-end 2))) - (narrow-to-region (match-beginning 2) (match-end 2))) - (t (throw 'objects-forbidden element))) - ;; Also change type to retrieve correct restrictions. - (setq type 'keyword)) - ;; At an item, objects can only be located within tag, if any. - ((eq type 'item) - (let ((tag (org-element-property :tag element))) - (if (or (not tag) (/= (line-beginning-position) post)) - (throw 'objects-forbidden element) - (beginning-of-line) - (search-forward tag (line-end-position)) - (goto-char (match-beginning 0)) - (if (and (>= pos (point)) (< pos (match-end 0))) - (narrow-to-region (point) (match-end 0)) - (throw 'objects-forbidden element))))) - ;; At an headline or inlinetask, objects are in title. - ((memq type '(headline inlinetask)) - (let ((case-fold-search nil)) - (goto-char (org-element-property :begin element)) - (looking-at org-complex-heading-regexp) - (let ((end (match-end 4))) - (if (not end) (throw 'objects-forbidden element) - (goto-char (match-beginning 4)) - (when (looking-at org-element-comment-string) - (goto-char (match-end 0))) - (if (>= (point) end) (throw 'objects-forbidden element) - (narrow-to-region (point) end)))))) - ;; At a paragraph, a table-row or a verse block, objects are - ;; located within their contents. - ((memq type '(paragraph table-row verse-block)) - (let ((cbeg (org-element-property :contents-begin element)) - (cend (org-element-property :contents-end element))) - ;; CBEG is nil for table rules. - (if (and cbeg cend (>= pos cbeg) - (or (< pos cend) (and (= pos cend) (eobp)))) - (narrow-to-region cbeg cend) - (throw 'objects-forbidden element)))) +Providing it allows for quicker computation. + +This function may modify match data." + (catch 'objects-forbidden + (org-with-wide-buffer + (let* ((pos (point)) + (element (or element (org-element-at-point))) + (type (org-element-type element)) + (post (org-element-post-affiliated element))) + ;; If point is inside an element containing objects or + ;; a secondary string, narrow buffer to the container and + ;; proceed with parsing. Otherwise, return ELEMENT. + (cond + ;; At a parsed affiliated keyword, check if we're inside main + ;; or dual value. + ((and post (< pos post)) + (forward-line 0) + (let ((case-fold-search t)) (looking-at org-element--affiliated-re)) + (cond + ((not (member-ignore-case (match-string 1) + org-element-parsed-keywords)) + (throw 'objects-forbidden element)) + ((<= (match-end 0) pos) + (narrow-to-region (match-end 0) (line-end-position))) + ((and (match-beginning 2) + (>= pos (match-beginning 2)) + (< pos (match-end 2))) + (narrow-to-region (match-beginning 2) (match-end 2))) (t (throw 'objects-forbidden element))) - (goto-char (point-min)) - (let ((restriction (org-element-restriction type)) - (parent element) - last) - (catch 'exit - (while t - (let ((next (org-element--object-lex restriction))) - (when next (org-element-put-property next :parent parent)) - ;; Process NEXT, if any, in order to know if we need to - ;; skip it, return it or move into it. - (if (or (not next) (> (org-element-property :begin next) pos)) - (throw 'exit (or last parent)) - (let ((end (org-element-property :end next)) - (cbeg (org-element-property :contents-begin next)) - (cend (org-element-property :contents-end next))) - (cond - ;; Skip objects ending before point. Also skip - ;; objects ending at point unless it is also the - ;; end of buffer, since we want to return the - ;; innermost object. - ((and (<= end pos) (/= (point-max) end)) - (goto-char end) - ;; For convenience, when object ends at POS, - ;; without any space, store it in LAST, as we - ;; will return it if no object starts here. - (when (and (= end pos) - (not (memq (char-before) '(?\s ?\t)))) - (setq last next))) - ;; If POS is within a container object, move into - ;; that object. - ((and cbeg cend - (>= pos cbeg) - (or (< pos cend) - ;; At contents' end, if there is no - ;; space before point, also move into - ;; object, for consistency with - ;; convenience feature above. - (and (= pos cend) - (or (= (point-max) pos) - (not (memq (char-before pos) - '(?\s ?\t))))))) - (goto-char cbeg) - (narrow-to-region (point) cend) - (setq parent next) - (setq restriction (org-element-restriction next))) - ;; Otherwise, return NEXT. - (t (throw 'exit next)))))))))))))) - -(defun org-element-lineage (datum &optional types with-self) - "List all ancestors of a given element or object. - -DATUM is an object or element. - -Return ancestors from the closest to the farthest. When optional -argument TYPES is a list of symbols, return the first element or -object in the lineage whose type belongs to that list instead. - -When optional argument WITH-SELF is non-nil, lineage includes -DATUM itself as the first element, and TYPES, if provided, also -apply to it. - -When DATUM is obtained through `org-element-context' or -`org-element-at-point', only ancestors from its section can be -found. There is no such limitation when DATUM belongs to a full -parse tree." - (let ((up (if with-self datum (org-element-property :parent datum))) - ancestors) - (while (and up (not (memq (org-element-type up) types))) - (unless types (push up ancestors)) - (setq up (org-element-property :parent up))) - (if types up (nreverse ancestors)))) + ;; Also change type to retrieve correct restrictions. + (setq type 'keyword)) + ;; At an item, objects can only be located within tag, if any. + ((eq type 'item) + (let ((tag (org-element-property :tag element))) + (if (or (not tag) (/= (line-beginning-position) post)) + (throw 'objects-forbidden element) + (forward-line 0) + (search-forward tag (line-end-position)) + (goto-char (match-beginning 0)) + (if (and (>= pos (point)) (< pos (match-end 0))) + (narrow-to-region (point) (match-end 0)) + (throw 'objects-forbidden element))))) + ;; At an headline or inlinetask, objects are in title. + ((memq type '(headline inlinetask)) + (let ((case-fold-search nil)) + (goto-char (org-element-begin element)) + (looking-at org-complex-heading-regexp) + (let ((end (match-end 4))) + (if (not end) (throw 'objects-forbidden element) + (goto-char (match-beginning 4)) + (when (looking-at org-element-comment-string) + (goto-char (match-end 0))) + (if (>= (point) end) (throw 'objects-forbidden element) + (narrow-to-region (point) end)))))) + ;; At a paragraph, a table-row or a verse block, objects are + ;; located within their contents. + ((memq type '(paragraph table-row verse-block)) + (let ((cbeg (org-element-contents-begin element)) + (cend (org-element-contents-end element))) + ;; CBEG is nil for table rules. + (if (and cbeg cend (>= pos cbeg) + (or (< pos cend) (and (= pos cend) (eobp)))) + (narrow-to-region cbeg cend) + (throw 'objects-forbidden element)))) + (t (throw 'objects-forbidden element))) + (goto-char (point-min)) + (let ((restriction (org-element-restriction type)) + (parent element) + last) + (catch 'exit + (while t + (let ((next (org-element--object-lex restriction))) + (when next (org-element-put-property next :parent parent)) + ;; Process NEXT, if any, in order to know if we need to + ;; skip it, return it or move into it. + (if (or (not next) (> (org-element-begin next) pos)) + (throw 'exit (or last parent)) + (let ((end (org-element-end next)) + (cbeg (org-element-contents-begin next)) + (cend (org-element-contents-end next))) + (cond + ;; Skip objects ending before point. Also skip + ;; objects ending at point unless it is also the + ;; end of buffer, since we want to return the + ;; innermost object. + ((and (<= end pos) (/= (point-max) end)) + (goto-char end) + ;; For convenience, when object ends at POS, + ;; without any space, store it in LAST, as we + ;; will return it if no object starts here. + (when (and (= end pos) + (not (memq (char-before) '(?\s ?\t)))) + (setq last next))) + ;; If POS is within a container object, move into + ;; that object. + ((and cbeg cend + (>= pos cbeg) + (or (< pos cend) + ;; At contents' end, if there is no + ;; space before point, also move into + ;; object, for consistency with + ;; convenience feature above. + (and (= pos cend) + (or (= (point-max) pos) + (not (memq (char-before pos) + '(?\s ?\t))))))) + (goto-char cbeg) + (narrow-to-region (point) cend) + (setq parent next) + (setq restriction (org-element-restriction next))) + ;; Otherwise, return NEXT. + (t (throw 'exit next))))))))))))) (defun org-element-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))) + (let ((beg-A (org-element-begin elem-A)) + (beg-B (org-element-begin elem-B)) + (end-A (org-element-end elem-A)) + (end-B (org-element-end elem-B))) (or (and (>= beg-A beg-B) (<= end-A end-B)) (and (>= beg-B beg-A) (<= end-B end-A))))) @@ -8071,7 +8665,7 @@ parse tree." "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)) + (goto-char (org-element-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)))) @@ -8080,9 +8674,9 @@ end of ELEM-A." ;; a footnote definition is impossible: it cannot contain two ;; paragraphs in a row because it cannot contain a blank line. (when (and specialp - (or (not (eq (org-element-type elem-B) 'paragraph)) - (/= (org-element-property :begin elem-B) - (org-element-property :contents-begin elem-B)))) + (or (not (org-element-type-p elem-B 'paragraph)) + (/= (org-element-begin elem-B) + (org-element-contents-begin elem-B)))) (error "Cannot swap elements")) ;; Preserve folding state when `org-fold-core-style' is set to ;; `text-properties'. @@ -8090,16 +8684,16 @@ end of ELEM-A." ;; 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)) + (goto-char (org-element-begin elem-B)) (current-indentation))) - (beg-A (org-element-property :begin elem-A)) + (beg-A (org-element-begin elem-A)) (end-A (save-excursion - (goto-char (org-element-property :end elem-A)) + (goto-char (org-element-end elem-A)) (skip-chars-backward " \r\t\n") (line-end-position))) - (beg-B (org-element-property :begin elem-B)) + (beg-B (org-element-begin elem-B)) (end-B (save-excursion - (goto-char (org-element-property :end elem-B)) + (goto-char (org-element-end elem-B)) (skip-chars-backward " \r\t\n") (line-end-position))) ;; Store inner folds responsible for visibility status. @@ -8126,7 +8720,7 @@ end of ELEM-A." (insert body-B) ;; Restore ex ELEM-A folds. (org-fold-core-regions (cdr folds) :relative beg-A) - (goto-char (org-element-property :end elem-B)))))) + (goto-char (org-element-end elem-B)))))) (provide 'org-element) diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 5820c7428cd..c38c0fcb224 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -29,6 +29,7 @@ (require 'org-macs) (org-assert-version) +(require 'seq) ; Emacs 27 does not preload seq.el; for `seq-every-p'. (declare-function org-mode "org" ()) (declare-function org-toggle-pretty-entities "org" ()) @@ -277,8 +278,10 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("vert" "\\vert{}" t "|" "|" "|" "|") ("vbar" "|" nil "|" "|" "|" "|") ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") - ("S" "\\S" nil "§" "paragraph" "§" "§") - ("sect" "\\S" nil "§" "paragraph" "§" "§") + ("S" "\\S" nil "§" "section" "§" "§") + ("sect" "\\S" nil "§" "section" "§" "§") + ("P" "\\P{}" nil "¶" "paragraph" "¶" "¶") + ("para" "\\P{}" nil "¶" "paragraph" "¶" "¶") ("amp" "\\&" nil "&" "&" "&" "&") ("lt" "\\textless{}" nil "<" "<" "<" "<") ("gt" "\\textgreater{}" nil ">" ">" ">" ">") @@ -494,7 +497,6 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") "** Miscellaneous (seldom used)" - ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") ("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ª" "ª") ("ordm" "\\textordmasculine{}" nil "º" "_o_" "º" "º") ("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸") diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index cb5c423ad0f..af7269bd15a 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -389,6 +389,10 @@ changes." "Face used for tables." :group 'org-faces) +(defface org-table-row '((t :inherit org-table)) + "Face used to fontify whole table rows (including newlines and indentation)." + :group 'org-faces) + (defface org-table-header '((t :inherit org-table :background "LightGray" :foreground "Black")) @@ -660,6 +664,10 @@ month and 365.24 days for a year)." "Face used for agenda entries that come from the Emacs diary." :group 'org-faces) +(defface org-agenda-calendar-daterange '((t :inherit default)) + "Face used to show entries with a date range in the agenda." + :group 'org-faces) + (defface org-agenda-calendar-event '((t :inherit default)) "Face used to show events and appointments in the agenda." :group 'org-faces) diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index e4035dd4e96..4077afa0d3c 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -475,7 +475,7 @@ This will find DRAWER and extract the alist." (goto-char pos) (let ((end (save-excursion (org-end-of-subtree t t)))) (if (re-search-forward - (concat "^[ \t]*:" drawer ":[ \t]*\n\\([^\000]*?\\)\n[ \t]*:END:") + (concat "^[ \t]*:" drawer ":[ \t]*\n\\(\\(?:.\\|\n\\)*?\\)\n[ \t]*:END:") end t) (read (match-string 1)) nil)))) @@ -495,7 +495,7 @@ This will find DRAWER and extract the alist." (match-beginning 0))))) (outline-next-heading) (insert " :" drawer ":\n :END:\n") - (beginning-of-line 0)) + (forward-line -1)) (insert (pp-to-string status))))) (defun org-feed-add-items (pos entries) @@ -508,7 +508,7 @@ This will find DRAWER and extract the alist." (setq level (org-get-valid-level (length (match-string 1)) 1)) (org-end-of-subtree t t) (skip-chars-backward " \t\n") - (beginning-of-line 2) + (forward-line 1) (setq pos (point)) (while (setq entry (pop entries)) (org-paste-subtree level entry 'yank)) @@ -565,7 +565,7 @@ If that property is already present, nothing changes." (let ((v (plist-get entry (intern (concat ":" name))))) (save-excursion (save-match-data - (beginning-of-line) + (forward-line 0) (if (looking-at (concat "^\\([ \t]*\\)%" name "[ \t]*$")) (org-feed-make-indented-block @@ -633,7 +633,7 @@ containing the properties `:guid' and `:item-full-text'." end (and (re-search-forward "" nil t) (match-beginning 0))) (setq item (buffer-substring beg end) - guid (if (string-match ".*?>\\([^\000]*?\\)" item) + guid (if (string-match ".*?>\\(\\(?:.\\|\n\\)*?\\)" item) (xml-substitute-special (match-string-no-properties 1 item)))) (setq entry (list :guid guid :item-full-text item)) (push entry entries) @@ -647,7 +647,7 @@ containing the properties `:guid' and `:item-full-text'." (with-temp-buffer (insert (plist-get entry :item-full-text)) (goto-char (point-min)) - (while (re-search-forward "<\\([a-zA-Z]+\\>\\).*?>\\([^\000]*?\\)" + (while (re-search-forward "<\\([a-zA-Z]+\\>\\).*?>\\(\\(?:.\\|\n\\)*?\\)" nil t) (setq entry (plist-put entry (intern (concat ":" (match-string 1))) diff --git a/lisp/org/org-fold-core.el b/lisp/org/org-fold-core.el index be90ca398a1..664846a619c 100644 --- a/lisp/org/org-fold-core.el +++ b/lisp/org/org-fold-core.el @@ -2,7 +2,7 @@ ;; ;; Copyright (C) 2020-2024 Free Software Foundation, Inc. ;; -;; Author: Ihor Radchenko +;; Author: Ihor Radchenko ;; Keywords: folding, invisible text ;; URL: https://orgmode.org ;; @@ -280,16 +280,17 @@ ;;; Customization -(defcustom org-fold-core-style 'text-properties +(defcustom org-fold-core-style (if (version< emacs-version "29") + 'text-properties + 'overlays) "Internal implementation detail used to hide folded text. Can be either `text-properties' or `overlays'. -The former is faster on large files, while the latter is generally -less error-prone with regard to third-party packages that haven't yet -adapted to the new folding implementation. +The former is faster on large files in Emacs <29, while the latter is +generally less error-prone with regard to third-party packages. Important: This variable must be set before loading Org." :group 'org - :package-version '(Org . "9.6") + :package-version '(Org . "9.7") :type '(choice (const :tag "Overlays" overlays) (const :tag "Text properties" text-properties))) @@ -380,6 +381,9 @@ The following properties are known: `buffer-invisibility-spec' will be used as is. Note that changing this property from nil to t may clear the setting in `buffer-invisibility-spec'. +- :font-lock :: non-nil means that newlines after the fold should + be re-fontified upon folding/unfolding. See + `org-activate-folds'. - :alias :: a list of aliases for the SPEC-SYMBOL. - :fragile :: Must be a function accepting two arguments. Non-nil means that changes in region may cause @@ -424,7 +428,7 @@ Return nil when there is no matching folding spec." (unless org-fold-core--spec-symbols (dolist (spec (org-fold-core-folding-spec-list)) (push (cons spec spec) org-fold-core--spec-symbols) - (dolist (alias (assq :alias (assq spec org-fold-core--specs))) + (dolist (alias (cdr (assq :alias (assq spec org-fold-core--specs)))) (push (cons alias spec) org-fold-core--spec-symbols)))) (alist-get spec-or-alias org-fold-core--spec-symbols))) @@ -553,7 +557,10 @@ and the setup appears to be created for different buffer, copy the old invisibility state into new buffer-local text properties, unless RETURN-ONLY is non-nil." (if (eq org-fold-core-style 'overlays) - (org-fold-core-get-folding-property-symbol spec nil 'global) + (or (gethash (cons 'global spec) org-fold-core--property-symbol-cache) + (puthash (cons 'global spec) + (org-fold-core-get-folding-property-symbol spec nil 'global) + org-fold-core--property-symbol-cache)) (let* ((buf (or buffer (current-buffer)))) ;; Create unique property symbol for SPEC in BUFFER (let ((local-prop (or (gethash (cons buf spec) org-fold-core--property-symbol-cache) @@ -574,15 +581,6 @@ unless RETURN-ONLY is non-nil." ;; would contain folding properties, which are not ;; matching the generated `local-prop'. (unless (member local-prop (cdr (assq 'invisible char-property-alias-alist))) - ;; Add current buffer to the list of indirect buffers in the base buffer. - (when (buffer-base-buffer) - (with-current-buffer (buffer-base-buffer) - (setq-local org-fold-core--indirect-buffers - (let (bufs) - (org-fold-core-cycle-over-indirect-buffers - (push (current-buffer) bufs)) - (push buf bufs) - (delete-dups bufs))))) ;; Copy all the old folding properties to preserve the folding state (with-silent-modifications (dolist (old-prop (cdr (assq 'invisible char-property-alias-alist))) @@ -633,14 +631,27 @@ unless RETURN-ONLY is non-nil." text-property-default-nonsticky full-prop-list)))))))))))))) +(defun org-fold-core--update-buffer-folds () + "Copy folding state in a new buffer with text copied from old buffer." + (org-fold-core--property-symbol-get-create (car (org-fold-core-folding-spec-list)))) + (defun org-fold-core-decouple-indirect-buffer-folds () "Copy and decouple folding state in a newly created indirect buffer. This function is mostly intended to be used in `clone-indirect-buffer-hook'." + ;; Add current buffer to the list of indirect buffers in the base buffer. + (when (buffer-base-buffer) + (with-current-buffer (buffer-base-buffer) + (setq-local org-fold-core--indirect-buffers + (let (bufs) + (org-fold-core-cycle-over-indirect-buffers + (push (current-buffer) bufs)) + (push (current-buffer) bufs) + (delete-dups bufs))))) (when (and (buffer-base-buffer) (eq org-fold-core-style 'text-properties) (not (memql 'ignore-indirect org-fold-core--optimise-for-huge-buffers))) - (org-fold-core--property-symbol-get-create (car (org-fold-core-folding-spec-list))))) + (org-fold-core--update-buffer-folds))) ;;; API @@ -694,7 +705,7 @@ The folding spec properties will be set to PROPERTIES (see (let* ((full-properties (mapcar (lambda (prop) (cons prop (cdr (assq prop properties)))) '( :visible :ellipsis :isearch-ignore :global :isearch-open :front-sticky - :rear-sticky :fragile :alias))) + :rear-sticky :fragile :alias :font-lock))) (full-spec (cons spec full-properties))) (add-to-list 'org-fold-core--specs full-spec append) (mapc (lambda (prop-cons) (org-fold-core-set-folding-spec-property spec (car prop-cons) (cdr prop-cons) 'force)) full-properties) @@ -783,16 +794,19 @@ corresponding folding spec (if the text is folded using that spec)." (when (and spec (not (eq spec 'all))) (org-fold-core--check-spec spec)) (org-with-point-at pom (cond - ((eq spec 'all) - (let ((result)) - (dolist (spec (org-fold-core-folding-spec-list)) - (let ((val (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t)))) - (when val (push val result)))) - (reverse result))) - ((null spec) - (let ((result (get-char-property (point) 'invisible))) - (when (org-fold-core-folding-spec-p result) result))) - (t (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t))))))) + ((or (null spec) (eq spec 'all)) + (catch :single-spec + (let ((result)) + (dolist (lspec (org-fold-core-folding-spec-list)) + (let ((val (if (eq org-fold-core-style 'text-properties) + (get-text-property (point) (org-fold-core--property-symbol-get-create lspec nil t)) + (get-char-property (point) (org-fold-core--property-symbol-get-create lspec nil t))))) + (when (and val (null spec)) (throw :single-spec val)) + (when val (push val result)))) + (reverse result)))) + (t (if (eq org-fold-core-style 'text-properties) + (get-text-property (point) (org-fold-core--property-symbol-get-create spec nil t)) + (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t)))))))) (defun org-fold-core-get-folding-specs-in-region (beg end) "Get all folding specs in region from BEG to END." @@ -843,13 +857,20 @@ If PREVIOUS-P is non-nil, search backwards." (next-change (if previous-p (if ignore-hidden-p (lambda (p) (org-fold-core-previous-folding-state-change (org-fold-core-get-folding-spec nil p) p limit)) - (lambda (p) (max limit (1- (previous-single-char-property-change p 'invisible nil limit))))) + (lambda (p) (max limit (previous-single-char-property-change p 'invisible nil limit)))) (if ignore-hidden-p (lambda (p) (org-fold-core-next-folding-state-change (org-fold-core-get-folding-spec nil p) p limit)) (lambda (p) (next-single-char-property-change p 'invisible nil limit))))) (next pos)) (while (and (funcall cmp next limit) - (not (org-xor invisible-initially? (funcall invisible-p next)))) + (not (org-xor + invisible-initially? + (funcall invisible-p + (if previous-p + ;; NEXT-1 -> NEXT is the change. + (max limit (1- next)) + ;; NEXT -> NEXT+1 is the change. + next))))) (setq next (funcall next-change next))) next)) @@ -897,14 +918,19 @@ Search backwards when PREVIOUS-P is non-nil." (unless spec-or-alias (setq spec-or-alias (org-fold-core-folding-spec-list))) (setq pos (or pos (point))) - (apply (if previous-p - #'max - #'min) - (mapcar (if previous-p - (lambda (prop) (max (or limit (point-min)) (previous-single-char-property-change pos prop nil (or limit (point-min))))) - (lambda (prop) (next-single-char-property-change pos prop nil (or limit (point-max))))) - (mapcar (lambda (el) (org-fold-core--property-symbol-get-create el nil t)) - spec-or-alias)))) + (let ((limit (or limit (if previous-p (point-min) (point-max))))) + (catch :limit + (dolist (prop (mapcar + (lambda (el) + (org-fold-core--property-symbol-get-create el nil t)) + spec-or-alias)) + (when (= limit pos) (throw :limit limit)) + (setq + limit + (if previous-p + (previous-single-char-property-change pos prop nil limit) + (next-single-char-property-change pos prop nil limit)))) + limit))) (defun org-fold-core-previous-folding-state-change (&optional spec-or-alias pos limit) "Call `org-fold-core-next-folding-state-change' searching backwards." @@ -985,6 +1011,24 @@ WITH-MARKERS must be nil when RELATIVE is non-nil." ;;;;; Region visibility +(defvar org-fold-core--keep-overlays nil + "When non-nil, `org-fold-core-region' will not remove existing overlays.") +(defvar org-fold-core--isearch-overlays) ; defined below +(defmacro org-fold-core--keep-overlays (&rest body) + "Run BODY with `org-fold-core--keep-overlays' set to t." + (declare (debug (body))) + `(let ((org-fold-core--keep-overlays t)) + ,@body)) + +(defvar org-fold-core--isearch-active nil + "When non-nil, `org-fold-core-region' records created overlays. +New overlays will be added to `org-fold-core--isearch-overlays'.") +(defmacro org-fold-core--with-isearch-active (&rest body) + "Run BODY with `org-fold-core--isearch-active' set to t." + (declare (debug (body))) + `(let ((org-fold-core--isearch-active t)) + ,@body)) + ;; This is the core function performing actual folding/unfolding. The ;; folding state is stored in text property (folding property) ;; returned by `org-fold-core--property-symbol-get-create'. The value of the @@ -997,7 +1041,43 @@ If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region." (when spec (org-fold-core--check-spec spec)) (with-silent-modifications (org-with-wide-buffer - (when (eq org-fold-core-style 'overlays) (remove-overlays from to 'invisible spec)) + ;; Arrange fontifying newlines after all the folds between FROM + ;; and TO to match the first character before the fold; not the + ;; last as per Emacs defaults. This makes :extend faces span + ;; past the ellipsis. See bug#65896. The face properties are + ;; assigned via `org-activate-folds'. + (when (or (not spec) (org-fold-core-get-folding-spec-property spec :font-lock)) + (when (equal ?\n (char-after from)) + (font-lock-flush from (1+ from))) + (when (equal ?\n (char-after to)) + (font-lock-flush to (1+ to))) + (dolist (region (org-fold-core-get-regions :from from :to to :specs spec)) + (when (equal ?\n (char-after (cadr region))) + (font-lock-flush (cadr region) (1+ (cadr region)))) + ;; Re-fontify beginning of the fold - we may + ;; unfold inside an existing fold, with FROM begin a newline + ;; after spliced fold. + (when (equal ?\n (char-after (car region))) + (font-lock-flush (car region) (1+ (car region)))))) + (when (eq org-fold-core-style 'overlays) + (if org-fold-core--keep-overlays + (mapc + (lambda (ov) + (when (or (not spec) + (eq spec (overlay-get ov 'invisible))) + (when (and org-fold-core--isearch-active + (overlay-get ov 'invisible) + (org-fold-core-get-folding-spec-property + (overlay-get ov 'invisible) :isearch-open)) + (when (overlay-get ov 'invisible) + (overlay-put ov 'org-invisible (overlay-get ov 'invisible))) + (overlay-put ov 'invisible nil) + (when org-fold-core--isearch-active + (cl-pushnew ov org-fold-core--isearch-overlays))))) + (overlays-in from to)) + (when spec + (remove-overlays from to 'org-invisible spec) + (remove-overlays from to 'invisible spec)))) (if flag (if (not spec) (error "Calling `org-fold-core-region' with missing SPEC") @@ -1007,17 +1087,14 @@ If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region." (let ((o (make-overlay from to nil (org-fold-core-get-folding-spec-property spec :front-sticky) (org-fold-core-get-folding-spec-property spec :rear-sticky)))) + (when org-fold-core--isearch-active + (push o org-fold-core--isearch-overlays)) (overlay-put o 'evaporate t) (overlay-put o (org-fold-core--property-symbol-get-create spec) spec) (overlay-put o 'invisible spec) - (overlay-put o 'isearch-open-invisible #'org-fold-core--isearch-show) - ;; FIXME: Disabling to work around Emacs bug#60399 - ;; and https://orgmode.org/list/87zgb6tk6h.fsf@localhost. - ;; The proper fix will require making sure that - ;; `org-fold-core-isearch-open-function' does not - ;; delete the overlays used by isearch. - ;; (overlay-put o 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary) - ) + ;; Preserve priority. + (overlay-put o 'priority (length (member spec (org-fold-core-folding-spec-list)))) + (overlay-put o 'isearch-open-invisible #'org-fold-core--isearch-show)) (put-text-property from to (org-fold-core--property-symbol-get-create spec) spec) (put-text-property from to 'isearch-open-invisible #'org-fold-core--isearch-show) (put-text-property from to 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary) @@ -1041,7 +1118,13 @@ If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region." (setq pos next)) (setq pos (next-single-char-property-change pos 'invisible nil to))))))) (when (eq org-fold-core-style 'text-properties) - (remove-text-properties from to (list (org-fold-core--property-symbol-get-create spec) nil))))))))) + (remove-text-properties from to (list (org-fold-core--property-symbol-get-create spec) nil))))) + ;; Re-calculate trailing faces for all the folds revealed + ;; by unfolding or created by folding. + (when (or (not spec) (org-fold-core-get-folding-spec-property spec :font-lock)) + (dolist (region (org-fold-core-get-regions :from from :to to :specs spec)) + (when (equal ?\n (char-after (cadr region))) + (font-lock-flush (cadr region) (1+ (cadr region)))))))))) (cl-defmacro org-fold-core-regions (regions &key override clean-markers relative) "Fold every region in REGIONS list in current buffer. @@ -1104,13 +1187,19 @@ TYPE can be either `text-properties' or `overlays'." (setq-local isearch-filter-predicate #'org-fold-core--isearch-filter-predicate-text-properties)) (`overlays (when (eq org-fold-core-style 'text-properties) - (setq-local isearch-filter-predicate #'org-fold-core--isearch-filter-predicate-overlays) - (add-hook 'isearch-mode-end-hook #'org-fold-core--clear-isearch-overlays nil 'local))) + (add-function :before (local 'isearch-filter-predicate) #'org-fold-core--create-isearch-overlays) + ;; When `isearch-filter-predicate' is called outside isearch, + ;; it is common that `isearch-mode-end-hook' does not get + ;; executed, but `isearch-clean-overlays' usually does. + (advice-add + 'isearch-clean-overlays :after + #'org-fold-core--clear-isearch-overlays + '((name . isearch-clean-overlays@org-fold-core))))) (_ (error "%s: Unknown type of setup for `org-fold-core--isearch-setup'" type)))) (defun org-fold-core--isearch-reveal (pos) "Default function used to reveal hidden text at POS for isearch." - (let ((region (org-fold-core-get-region-at-point pos))) + (let ((region (org-fold-core-get-region-at-point nil pos))) (org-fold-core-region (car region) (cdr region) nil))) (defun org-fold-core--isearch-filter-predicate-text-properties (beg end) @@ -1145,34 +1234,37 @@ This function is intended to be used as `isearch-filter-predicate'." "Clear `org-fold-core--isearch-local-regions'." (clrhash org-fold-core--isearch-local-regions)) -(defun org-fold-core--isearch-show (_) - "Reveal text at point found by isearch." - (funcall org-fold-core-isearch-open-function (point))) +(defun org-fold-core--isearch-show (overlay-or-region) + "Reveal text at OVERLAY-OR-REGION found by isearch." + (let (beg end) + (if (overlayp overlay-or-region) + (setq beg (overlay-start overlay-or-region) + end (overlay-end overlay-or-region)) + (setq beg (car overlay-or-region) + end (cdr overlay-or-region))) + ;; FIXME: Reveal the match (usually point, but may sometimes go beyond the region). + (when (< beg (point) end) + (funcall org-fold-core-isearch-open-function (point))) + (if (overlayp overlay-or-region) + (delete-overlay overlay-or-region) + (org-fold-core-region beg end nil)))) (defun org-fold-core--isearch-show-temporary (region hide-p) "Temporarily reveal text in REGION. Hide text instead if HIDE-P is non-nil. REGION can also be an overlay in current buffer." - (when (overlayp region) - (setq region (cons (overlay-start region) - (overlay-end region)))) - (if (not hide-p) - (let ((pos (car region))) - (while (< pos (cdr region)) - (let ((spec-no-open - (catch :found - (dolist (spec (org-fold-core-get-folding-spec 'all pos)) - (unless (org-fold-core-get-folding-spec-property spec :isearch-open) - (throw :found spec)))))) - (if spec-no-open - ;; Skip regions folded with folding specs that cannot be opened. - (setq pos (org-fold-core-next-folding-state-change spec-no-open pos (cdr region))) - (dolist (spec (org-fold-core-get-folding-spec 'all pos)) - (push (cons spec (org-fold-core-get-region-at-point spec pos)) (gethash region org-fold-core--isearch-local-regions))) - (org-fold-core--isearch-show region) - (setq pos (org-fold-core-next-folding-state-change nil pos (cdr region))))))) - (mapc (lambda (val) (org-fold-core-region (cadr val) (cddr val) t (car val))) (gethash region org-fold-core--isearch-local-regions)) - (remhash region org-fold-core--isearch-local-regions))) + (save-match-data ; match data must not be modified. + (let ((org-fold-core-style (if (overlayp region) 'overlays 'text-properties))) + (if hide-p + (if (not (overlayp region)) + nil ;; FIXME: after isearch supports text properties. + (when (overlay-get region 'org-invisible) + (overlay-put region 'invisible (overlay-get region 'org-invisible)))) + ;; isearch expects all the temporarily opened overlays to exist. + ;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=60399 + (org-fold-core--keep-overlays + (org-fold-core--with-isearch-active + (org-fold-core--isearch-show region))))))) (defvar-local org-fold-core--isearch-special-specs nil "List of specs that can break visibility state when converted to overlays. @@ -1187,49 +1279,28 @@ instead of text properties. The created overlays will be stored in (while (< pos end) ;; We need loop below to make sure that we clean all invisible ;; properties, which may be nested. - (dolist (spec (org-fold-core-get-folding-spec 'all pos)) - (unless (org-fold-core-get-folding-spec-property spec :isearch-ignore) - (let* ((region (org-fold-core-get-region-at-point spec pos))) - (when (memq spec org-fold-core--isearch-special-specs) - (setq pos (min pos (car region))) - (setq end (max end (cdr region)))) - ;; Changing text properties is considered buffer modification. - ;; We do not want it here. - (with-silent-modifications - (org-fold-core-region (car region) (cdr region) nil spec) - ;; The overlay is modeled after `outline-flag-region' - ;; [2020-05-09 Sat] overlay for 'outline blocks. - (let ((o (make-overlay (car region) (cdr region) nil 'front-advance))) - (overlay-put o 'evaporate t) - (overlay-put o 'invisible spec) - (overlay-put o 'org-invisible spec) - ;; Make sure that overlays are applied in the same order - ;; with the folding specs. - ;; Note: `memq` returns cdr with car equal to the first - ;; found matching element. - (overlay-put o 'priority (length (memq spec (org-fold-core-folding-spec-list)))) - ;; `delete-overlay' here means that spec information will be lost - ;; for the region. The region will remain visible. - (if (org-fold-core-get-folding-spec-property spec :isearch-open) - (overlay-put o 'isearch-open-invisible #'delete-overlay) - (overlay-put o 'isearch-open-invisible #'ignore) - (overlay-put o 'isearch-open-invisible-temporary #'ignore)) - (push o org-fold-core--isearch-overlays)))))) - (setq pos (org-fold-core-next-folding-state-change nil pos end))))) - -(defun org-fold-core--isearch-filter-predicate-overlays (beg end) - "Return non-nil if text between BEG and END is deemed visible by isearch. -This function is intended to be used as `isearch-filter-predicate'." - (org-fold-core--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text - (isearch-filter-visible beg end)) + (catch :repeat + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (unless (org-fold-core-get-folding-spec-property spec :isearch-ignore) + (let* ((region (org-fold-core-get-region-at-point spec pos))) + (when (memq spec org-fold-core--isearch-special-specs) + (setq end (max end (cdr region))) + (when (< (car region) beg) + (setq beg (car region)) + (setq pos beg) + (throw :repeat t))) + ;; Changing text properties is considered buffer modification. + ;; We do not want it here. + (with-silent-modifications + (org-fold-core-region (car region) (cdr region) nil spec) + (let ((org-fold-core-style 'overlays)) + (org-fold-core--with-isearch-active + (org-fold-core-region (car region) (cdr region) t spec))))))) + (setq pos (org-fold-core-next-folding-state-change nil pos end)))))) (defun org-fold-core--clear-isearch-overlay (ov) "Convert OV region back into using text properties." - (let ((spec (if isearch-mode-end-hook-quit - ;; Restore all folds. - (overlay-get ov 'org-invisible) - ;; Leave opened folds open. - (overlay-get ov 'invisible)))) + (let ((spec (overlay-get ov 'invisible))) ;; Ignore deleted overlays. (when (and spec (overlay-buffer ov)) @@ -1238,8 +1309,6 @@ This function is intended to be used as `isearch-filter-predicate'." (with-silent-modifications (when (<= (overlay-end ov) (point-max)) (org-fold-core-region (overlay-start ov) (overlay-end ov) t spec))))) - (when (member ov isearch-opened-overlays) - (setq isearch-opened-overlays (delete ov isearch-opened-overlays))) (delete-overlay ov)) (defun org-fold-core--clear-isearch-overlays () @@ -1254,6 +1323,8 @@ This function is intended to be used as `isearch-filter-predicate'." "Non-nil: skip processing modifications in `org-fold-core--fix-folded-region'.") (defvar org-fold-core--ignore-fragility-checks nil "Non-nil: skip fragility checks in `org-fold-core--fix-folded-region'.") +(defvar org-fold-core--suppress-folding-fix nil + "Non-nil: skip folding fix in `org-fold-core--fix-folded-region'.") (defmacro org-fold-core-ignore-modifications (&rest body) "Run BODY ignoring buffer modifications in `org-fold-core--fix-folded-region'." @@ -1262,12 +1333,47 @@ This function is intended to be used as `isearch-filter-predicate'." (unwind-protect (progn ,@body) (setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick))))) +(defmacro org-fold-core-suppress-folding-fix (&rest body) + "Run BODY skipping re-folding checks in `org-fold-core--fix-folded-region'." + (declare (debug (form body)) (indent 0)) + `(let ((org-fold-core--suppress-folding-fix t)) + (progn ,@body))) + (defmacro org-fold-core-ignore-fragility-checks (&rest body) "Run BODY skipping :fragility checks in `org-fold-core--fix-folded-region'." (declare (debug (form body)) (indent 0)) `(let ((org-fold-core--ignore-fragility-checks t)) (progn ,@body))) +(defvar org-fold-core--region-delayed-list nil + "List holding (MKFROM MKTO FLAG SPEC-OR-ALIAS) arguments to process. +The list is used by `org-fold-core--region-delayed'.") +(defun org-fold-core--region-delayed (from to flag &optional spec-or-alias) + "Call `org-fold-core-region' after current command. +Pass the same FROM, TO, FLAG, and SPEC-OR-ALIAS." + ;; Setup delayed folding. + (add-hook 'post-command-hook #'org-fold-core--process-delayed) + (let ((frommk (make-marker)) + (tomk (make-marker))) + (set-marker frommk from (current-buffer)) + (set-marker tomk to (current-buffer)) + (push (list frommk tomk flag spec-or-alias) org-fold-core--region-delayed-list))) + +(defun org-fold-core--process-delayed () + "Perform folding for `org-fold-core--region-delayed-list'." + (when org-fold-core--region-delayed-list + (mapc (lambda (args) + (when (and (buffer-live-p (marker-buffer (nth 0 args))) + (buffer-live-p (marker-buffer (nth 1 args))) + (< (nth 0 args) (nth 1 args))) + (org-with-point-at (car args) + (apply #'org-fold-core-region args)))) + ;; Restore the initial folding order. + (nreverse org-fold-core--region-delayed-list)) + ;; Cleanup `post-command-hook'. + (remove-hook 'post-command-hook #'org-fold-core--process-delayed) + (setq org-fold-core--region-delayed-list nil))) + (defvar-local org-fold-core--last-buffer-chars-modified-tick nil "Variable storing the last return value of `buffer-chars-modified-tick'.") @@ -1295,7 +1401,7 @@ property, unfold the region if the :fragile function returns non-nil." ;; buffer. Work around Emacs bug#46982. ;; Re-hide text inserted in the middle/front/back of a folded ;; region. - (unless (equal from to) ; Ignore deletions. + (unless (or org-fold-core--suppress-folding-fix (equal from to)) ; Ignore deletions. (when (eq org-fold-core-style 'text-properties) (org-fold-core-cycle-over-indirect-buffers (dolist (spec (org-fold-core-folding-spec-list)) @@ -1385,7 +1491,10 @@ property, unfold the region if the :fragile function returns non-nil." (cons fold-begin fold-end) spec)) ;; Reveal completely, not just from the SPEC. - (org-fold-core-region fold-begin fold-end nil))))) + ;; Do it only after command is finished - + ;; some Emacs commands assume that + ;; visibility is not altered by `after-change-functions'. + (org-fold-core--region-delayed fold-begin fold-end nil))))) ;; Move to next fold. (setq pos (org-fold-core-next-folding-state-change spec pos local-to))))))))))))) diff --git a/lisp/org/org-fold.el b/lisp/org/org-fold.el index 241324624c9..1b62168c483 100644 --- a/lisp/org/org-fold.el +++ b/lisp/org/org-fold.el @@ -2,7 +2,7 @@ ;; ;; Copyright (C) 2020-2024 Free Software Foundation, Inc. ;; -;; Author: Ihor Radchenko +;; Author: Ihor Radchenko ;; Keywords: folding, invisible text ;; URL: https://orgmode.org ;; @@ -49,8 +49,6 @@ (require 'org-fold-core) (defvar org-inlinetask-min-level) -(defvar org-link--link-folding-spec) -(defvar org-link--description-folding-spec) (defvar org-odd-levels-only) (defvar org-drawer-regexp) (defvar org-property-end-re) @@ -61,11 +59,12 @@ (defvar org-element-headline-re) (declare-function isearch-filter-visible "isearch" (beg end)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) -(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-post-affiliated "org-element" (node)) (declare-function org-element--current-element "org-element" (limit &optional granularity mode structure)) -(declare-function org-element--cache-active-p "org-element" ()) (declare-function org-toggle-custom-properties-visibility "org" ()) (declare-function org-item-re "org-list" ()) (declare-function org-up-heading-safe "org" ()) @@ -189,7 +188,10 @@ smart Make point visible, and do insertion/deletion if it is Never delete a previously invisible character or add in the middle or right after an invisible region. Basically, this allows insertion and backward-delete right before ellipses. - FIXME: maybe in this case we should not even show?" + FIXME: maybe in this case we should not even show? + +This variable only affects commands listed in +`org-fold-catch-invisible-edits-commands'." :group 'org-edit-structure :version "24.1" :type '(choice @@ -199,6 +201,33 @@ smart Make point visible, and do insertion/deletion if it is (const :tag "Show invisible part and do the edit" show) (const :tag "Be smart and do the right thing" smart))) +(defcustom org-fold-catch-invisible-edits-commands + ;; We do not add non-Org commands here by default to avoid advising + ;; globally. See `org-fold--advice-edit-commands'. + '((org-self-insert-command . insert) + (org-delete-backward-char . delete-backward) + (org-delete-char . delete) + (org-meta-return . insert) + (org-return . insert)) + "Alist of commands where Org checks for invisible edits. +Each element is (COMMAND . KIND), where COMMAND is symbol representing +command as stored in `this-command' and KIND is symbol `insert', +symbol `delete', or symbol `delete-backward'. + +The checks are performed around `point'. + +This variable must be set before loading Org in order to take effect. + +Also, see `org-fold-catch-invisible-edits'." + :group 'org-edit-structure + :package-version '("Org" . "9.7") + :type '(alist + :key-type symbol + :value-type (choice + (const insert) + (const delete) + (const delete-backward)))) + ;;; Core functionality ;;; API @@ -224,6 +253,7 @@ smart Make point visible, and do insertion/deletion if it is (:ellipsis . ,ellipsis) (:fragile . ,#'org-fold--reveal-outline-maybe) (:isearch-open . t) + (:font-lock . t) ;; This is needed to make sure that inserting a ;; new planning line in folded heading is not ;; revealed. Also, the below combination of :front-sticky and @@ -236,6 +266,7 @@ smart Make point visible, and do insertion/deletion if it is (:ellipsis . ,ellipsis) (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe) (:isearch-open . t) + (:font-lock . t) (:front-sticky . t) (:alias . ( block center-block comment-block dynamic-block example-block export-block @@ -245,10 +276,9 @@ smart Make point visible, and do insertion/deletion if it is (:ellipsis . ,ellipsis) (:fragile . ,#'org-fold--reveal-drawer-or-block-maybe) (:isearch-open . t) + (:font-lock . t) (:front-sticky . t) - (:alias . (drawer property-drawer))) - ,org-link--description-folding-spec - ,org-link--link-folding-spec))) + (:alias . (drawer property-drawer)))))) ;;;; Searching and examining folded text @@ -358,7 +388,7 @@ of the current heading, or to 1 if the current line is not a heading." (interactive (list (cond (current-prefix-arg (prefix-numeric-value current-prefix-arg)) - ((save-excursion (beginning-of-line) + ((save-excursion (forward-line 0) (looking-at outline-regexp)) (funcall outline-level)) (t 1)))) @@ -419,20 +449,21 @@ Show the heading too, if it is currently invisible." (defun org-fold-show-children (&optional level) "Show all direct subheadings of this heading. -Prefix arg LEVEL is how many levels below the current level -should be shown. Default is enough to cause the following -heading to appear." +Prefix arg LEVEL is how many levels below the current level should be +shown. If direct subheadings are deeper than LEVEL, they are still +displayed." (interactive "p") (unless (org-before-first-heading-p) (save-excursion (org-with-limited-levels (org-back-to-heading t)) (let* ((current-level (funcall outline-level)) + (parent-level current-level) (max-level (org-get-valid-level - current-level + parent-level (if level (prefix-numeric-value level) 1))) + (min-level-direct-child most-positive-fixnum) (end (save-excursion (org-end-of-subtree t t))) (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)") - (past-first-child nil) ;; Make sure to skip inlinetasks. (re (format regexp-fmt current-level @@ -448,11 +479,12 @@ heading to appear." ;; MAX-LEVEL. Since we want to display it anyway, adjust ;; MAX-LEVEL accordingly. (while (re-search-forward re end t) - (unless past-first-child - (setq re (format regexp-fmt - current-level - (max (funcall outline-level) max-level))) - (setq past-first-child t)) + (setq current-level (funcall outline-level)) + (when (< current-level min-level-direct-child) + (setq min-level-direct-child current-level + re (format regexp-fmt + parent-level + (max min-level-direct-child max-level)))) (org-fold-heading nil)))))) (defun org-fold-show-subtree () @@ -496,12 +528,12 @@ Return a non-nil value when toggling is successful." comment-block dynamic-block example-block export-block quote-block special-block src-block verse-block)) (_ (error "Unknown category: %S" category)))) - (let* ((post (org-element-property :post-affiliated element)) + (let* ((post (org-element-post-affiliated element)) (start (save-excursion (goto-char post) (line-end-position))) (end (save-excursion - (goto-char (org-element-property :end element)) + (goto-char (org-element-end element)) (skip-chars-backward " \t\n") (line-end-position)))) ;; Do nothing when not before or at the block opening line or @@ -560,10 +592,12 @@ Return a non-nil value when toggling is successful." (interactive) (org-block-map (apply-partially #'org-fold-hide-block-toggle 'hide))) -(defun org-fold-hide-drawer-all () - "Fold all drawers in the current buffer." - (let ((begin (point-min)) - (end (point-max))) +(defun org-fold-hide-drawer-all (&optional begin end) + "Fold all drawers in the current buffer or active region BEGIN..END." + (interactive (list (and (use-region-p) (region-beginning)) + (and (use-region-p) (region-end)))) + (let ((begin (or begin (point-min))) + (end (or end (point-max)))) (org-fold--hide-drawers begin end))) (defun org-fold--hide-drawers (begin end) @@ -582,7 +616,7 @@ Return a non-nil value when toggling is successful." ;; Make sure to skip drawer entirely or we might flag it ;; another time when matching its ending line with ;; `org-drawer-regexp'. - (goto-char (org-element-property :end drawer)))))))) + (goto-char (org-element-end drawer)))))))) (defun org-fold-hide-archived-subtrees (beg end) "Re-hide all archived subtrees after a visibility state change." @@ -591,7 +625,7 @@ Return a non-nil value when toggling is successful." (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":"))) (goto-char beg) ;; Include headline point is currently on. - (beginning-of-line) + (forward-line 0) (while (and (< (point) end) (re-search-forward re end t)) (when (member org-archive-tag (org-get-tags nil t)) (org-fold-subtree t) @@ -626,33 +660,27 @@ DETAIL is either nil, `minimal', `local', `ancestors', (when (org-invisible-p) ;; FIXME: No clue why, but otherwise the following might not work. (redisplay) - (let ((region (org-fold-get-region-at-point))) - ;; Reveal emphasis markers. - (when (eq detail 'local) - (let (org-hide-emphasis-markers - org-link-descriptive - org-pretty-entities - (org-hide-macro-markers nil) - (region (or (org-find-text-property-region (point) 'org-emphasis) - (org-find-text-property-region (point) 'org-macro) - (org-find-text-property-region (point) 'invisible) - region))) - ;; Silence byte-compiler. - (ignore org-hide-macro-markers) - (when region - (org-with-point-at (car region) - (beginning-of-line) - (let (font-lock-extend-region-functions) - (font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region)))))) - ;; Unfold links. + ;; Reveal emphasis markers. + (when (eq detail 'local) + (let (org-hide-emphasis-markers + org-link-descriptive + org-pretty-entities + (org-hide-macro-markers nil) + (region (or (org-find-text-property-region (point) 'org-emphasis) + (org-find-text-property-region (point) 'org-macro) + (org-find-text-property-region (point) 'invisible)))) + ;; Silence byte-compiler. + (ignore org-hide-macro-markers) (when region - (dolist (spec '(org-link org-link-description)) - (org-fold-region (car region) (cdr region) nil spec)))) - (when region - (dolist (spec (org-fold-core-folding-spec-list)) - ;; Links are taken care by above. - (unless (memq spec '(org-link org-link-description)) - (org-fold-region (car region) (cdr region) nil spec)))))) + (org-with-point-at (car region) + (forward-line 0) + (let (font-lock-extend-region-functions) + (font-lock-fontify-region (max (point-min) (1- (car region))) (cdr region))))))) + (let (region) + (dolist (spec (org-fold-core-folding-spec-list)) + (setq region (org-fold-get-region-at-point spec)) + (when region + (org-fold-region (car region) (cdr region) nil spec))))) (unless (org-before-first-heading-p) (org-with-limited-levels (cl-case detail @@ -697,9 +725,10 @@ go to the parent and show the entire tree." ;;; Make isearch search in some text hidden via text properties. -(defun org-fold--isearch-reveal (&rest _) +(defun org-fold--isearch-reveal (pos) "Reveal text at POS found by isearch." - (org-fold-show-context 'isearch)) + (org-with-point-at pos + (org-fold-show-context 'isearch))) ;;; Handling changes in folded elements @@ -724,7 +753,7 @@ the contents consists of blank lines. Assume that point is located at the header line." (org-with-wide-buffer - (beginning-of-line) + (forward-line 0) (org-fold-region (max (point-min) (1- (point))) (let ((endl (line-end-position))) @@ -735,7 +764,7 @@ Assume that point is located at the header line." (if (equal (point) (save-excursion (goto-char endl) - (org-end-of-subtree) + (org-end-of-subtree t) (skip-chars-forward "\n\t\r "))) (point) endl))) @@ -752,7 +781,7 @@ This function is intended to be used as :fragile property of ;; The line before beginning of the fold should be either a ;; headline or a list item. (backward-char) - (beginning-of-line) + (forward-line 0) ;; Make sure that headline is not partially hidden. (unless (org-fold-folded-p nil 'headline) (org-fold--reveal-headline-at-point)) @@ -764,14 +793,14 @@ This function is intended to be used as :fragile property of (org-fold--reveal-headline-at-point)))) ;; Make sure that headline after is not partially hidden. (goto-char (cdr region)) - (beginning-of-line) + (forward-line 0) (unless (org-fold-folded-p nil 'headline) (when (looking-at-p org-element-headline-re) (org-fold--reveal-headline-at-point))) ;; Check the validity of headline (goto-char (car region)) (backward-char) - (beginning-of-line) + (forward-line 0) (unless (let ((case-fold-search t)) (looking-at (rx-to-string `(or (regex ,(org-item-re)) @@ -807,7 +836,7 @@ This function is intended to be used as :fragile property of ;; The line before beginning of the fold should be the ;; first line of the drawer/block. (backward-char) - (beginning-of-line) + (forward-line 0) (unless (let ((case-fold-search t)) (looking-at begin-re)) ; the match-data will be used later (throw :exit (setq unfold? t)))) @@ -827,7 +856,7 @@ This function is intended to be used as :fragile property of ;; The last line of the folded text should match `end-re'. (save-excursion (goto-char fold-end) - (beginning-of-line) + (forward-line 0) (unless (let ((case-fold-search t)) (looking-at end-re)) (throw :exit (setq unfold? t)))) @@ -901,6 +930,19 @@ The detailed reaction depends on the user option ;; Don't do the edit, make the user repeat it in full visibility (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) +(defun org-fold-check-before-invisible-edit-maybe (&rest _) + "Check before invisible command by `this-command'." + (when (derived-mode-p 'org-mode) + (pcase (alist-get this-command org-fold-catch-invisible-edits-commands) + ((pred null) nil) + (kind (org-fold-check-before-invisible-edit kind))))) + +(defun org-fold--advice-edit-commands () + "Advice editing commands according to `org-fold-catch-invisible-edits-commands'. +The advices are installed in current buffer." + (dolist (command (mapcar #'car org-fold-catch-invisible-edits-commands)) + (advice-add command :before #'org-fold-check-before-invisible-edit-maybe))) + (provide 'org-fold) ;;; org-fold.el ends here diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index 608d694294c..24cb8bf1899 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -45,9 +45,10 @@ (declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-element-class "org-element" (datum &optional parent)) (declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-lineage "org-element" (blob &optional types with-self)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-lineage "org-element-ast" (blob &optional types with-self)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-fill-paragraph "org" (&optional justify region)) (declare-function org-in-block-p "org" (names)) @@ -136,15 +137,18 @@ Possible values are: nil Prompt the user for each label. t Create unique labels of the form [fn:1], [fn:2], etc. +anonymous Create anonymous footnotes confirm Like t, but let the user edit the created value. The label can be removed from the minibuffer to create an anonymous footnote. random Automatically generate a unique, random label." :group 'org-footnote + :package-version '(Org . "9.7") :type '(choice (const :tag "Prompt for label" nil) (const :tag "Create automatic [fn:N]" t) (const :tag "Offer automatic [fn:N] for editing" confirm) + (const :tag "Create anoymous [fn::]" anonymous) (const :tag "Create a random label" random)) :safe #'symbolp) @@ -183,21 +187,21 @@ extracted will be filled again." "Is point in a context where footnotes are allowed?" (save-match-data (not (or (org-at-comment-p) - (org-inside-LaTeX-fragment-p) - ;; Avoid literal example. - (org-in-verbatim-emphasis) - (save-excursion - (beginning-of-line) - (looking-at "[ \t]*:[ \t]+")) - ;; Avoid forbidden blocks. - (org-in-block-p org-footnote-forbidden-blocks))))) + (org-inside-LaTeX-fragment-p) + ;; Avoid literal example. + (org-in-verbatim-emphasis) + (save-excursion + (forward-line 0) + (looking-at "[ \t]*:[ \t]+")) + ;; Avoid forbidden blocks. + (org-in-block-p org-footnote-forbidden-blocks))))) (defun org-footnote-at-reference-p () "Non-nil if point is at a footnote reference. If so, return a list containing its label, beginning and ending positions, and the definition, when inline." (let ((reference (org-element-context))) - (when (eq 'footnote-reference (org-element-type reference)) + (when (org-element-type-p reference 'footnote-reference) (let ((end (save-excursion (goto-char (org-element-property :end reference)) (skip-chars-backward " \t") @@ -223,7 +227,7 @@ defined locally. The return value is nil if not at a footnote definition, and a list with label, start, end and definition of the footnote otherwise." - (pcase (org-element-lineage (org-element-at-point) '(footnote-definition) t) + (pcase (org-element-lineage (org-element-at-point) 'footnote-definition t) (`nil nil) (definition (let* ((label (org-element-property :label definition)) @@ -269,7 +273,7 @@ otherwise." ((memq type '(headline inlinetask)) (or (not (org-at-heading-p)) (and (save-excursion - (beginning-of-line) + (forward-line 0) (and (let ((case-fold-search t)) (not (looking-at-p "\\*+ END[ \t]*$"))) (let ((case-fold-search nil)) @@ -281,10 +285,10 @@ otherwise." ;; White spaces after an object or blank lines after an element ;; are OK. ((>= (point) - (save-excursion (goto-char (org-element-property :end context)) - (skip-chars-backward " \r\t\n") - (if (eq (org-element-class context) 'object) (point) - (line-beginning-position 2))))) + (save-excursion (goto-char (org-element-property :end context)) + (skip-chars-backward " \r\t\n") + (if (eq (org-element-class context) 'object) (point) + (line-beginning-position 2))))) ;; At the beginning of a footnote definition, right after the ;; label, is OK. ((eq type 'footnote-definition) (looking-at (rx space))) @@ -298,7 +302,7 @@ otherwise." ;; :contents-begin is not reliable on empty cells, so special ;; case it. (<= (save-excursion (skip-chars-backward " \t") (point)) - (org-element-property :contents-end context))) + (org-element-property :contents-end context))) ((let ((cbeg (org-element-property :contents-begin context)) (cend (org-element-property :contents-end context))) (and cbeg (>= (point) cbeg) (<= (point) cend)))))))) @@ -368,14 +372,14 @@ References are sorted according to a deep-reading order." ;; Ensure point is within the reference before parsing it. (backward-char) (let ((object (org-element-context))) - (when (eq (org-element-type object) 'footnote-reference) + (when (org-element-type-p object 'footnote-reference) (let* ((label (org-element-property :label object)) (begin (org-element-property :begin object)) (size (and (eq (org-element-property :type object) 'inline) (- (org-element-property :contents-end object) (org-element-property :contents-begin object))))) - (let ((d (org-element-lineage object '(footnote-definition)))) + (let ((d (org-element-lineage object 'footnote-definition))) (push (list label (copy-marker begin) (not d) size) references) (when d @@ -420,7 +424,7 @@ while collecting them." (backward-char) (let ((element (org-element-at-point))) (let ((label (org-element-property :label element))) - (when (and (eq (org-element-type element) 'footnote-definition) + (when (and (org-element-type-p element 'footnote-definition) (not (member label seen))) (push label seen) (let* ((beg (progn @@ -516,7 +520,7 @@ This function is meant to be used for fontification only." ;; Definition: also grab the last square bracket, matched in ;; `org-footnote-re' for non-inline footnotes. ((and (save-excursion - (beginning-of-line) + (forward-line 0) (save-match-data (org-footnote-in-valid-context-p))) (save-excursion (end-of-line) @@ -633,8 +637,8 @@ This function ignores narrowing, if any." (while (re-search-forward org-footnote-re nil t) (backward-char) (let ((context (org-element-context))) - (when (memq (org-element-type context) - '(footnote-definition footnote-reference)) + (when (org-element-type-p + context '(footnote-definition footnote-reference)) (let ((label (org-element-property :label context))) (when label (cl-pushnew label all :test #'equal)))))) all))) @@ -665,15 +669,16 @@ or new, let the user edit the definition of the footnote." (user-error "Cannot insert a footnote here")) (let* ((all (org-footnote-all-labels)) (label - (if (eq org-footnote-auto-label 'random) - (format "%x" (abs (random))) - (org-footnote-normalize-label - (let ((propose (org-footnote-unique-label all))) - (if (eq org-footnote-auto-label t) propose - (completing-read - "Label (leave empty for anonymous): " - (mapcar #'list all) nil nil - (and (eq org-footnote-auto-label 'confirm) propose)))))))) + (unless (eq org-footnote-auto-label 'anonymous) + (if (eq org-footnote-auto-label 'random) + (format "%x" (abs (random))) + (org-footnote-normalize-label + (let ((propose (org-footnote-unique-label all))) + (if (eq org-footnote-auto-label t) propose + (completing-read + "Label (leave empty for anonymous): " + (mapcar #'list all) nil nil + (and (eq org-footnote-auto-label 'confirm) propose))))))))) (cond ((not label) (insert "[fn::]") (backward-char 1)) diff --git a/lisp/org/org-goto.el b/lisp/org/org-goto.el index e9df4057e4b..5e4c05a7683 100644 --- a/lisp/org/org-goto.el +++ b/lisp/org/org-goto.el @@ -102,7 +102,11 @@ When nil, you can use these keybindings to navigate the buffer: mouse-drag-region universal-argument org-occur))) (dolist (cmd cmds) (substitute-key-definition cmd cmd map global-map))) - (suppress-keymap map) + (if org-goto-auto-isearch + ;; Suppress 0-9 interpreted as digital arguments. + ;; Make them initiate isearch instead. + (suppress-keymap map t) + (suppress-keymap map)) (org-defkey map "\C-m" 'org-goto-ret) (org-defkey map [(return)] 'org-goto-ret) (org-defkey map [(left)] 'org-goto-left) @@ -145,7 +149,7 @@ When nil, you can use these keybindings to navigate the buffer: (search-backward string bound noerror)) (when (save-match-data (and (save-excursion - (beginning-of-line) + (forward-line 0) (looking-at org-complex-heading-regexp)) (or (not (match-beginning 5)) (< (point) (match-beginning 5))))) @@ -172,7 +176,7 @@ When nil, you can use these keybindings to navigate the buffer: (interactive) (if (org-at-heading-p) (progn - (beginning-of-line 1) + (forward-line 0) (setq org-goto-selected-point (point) org-goto-exit-command 'left) (throw 'exit nil)) @@ -211,12 +215,12 @@ position or nil." (help (or help org-goto-help))) (save-excursion (save-window-excursion - (delete-other-windows) (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (pop-to-buffer-same-window - (condition-case nil + (pop-to-buffer + (condition-case nil (make-indirect-buffer (current-buffer) "*org-goto*" t) - (error (make-indirect-buffer (current-buffer) "*org-goto*" t)))) + (error (make-indirect-buffer (current-buffer) "*org-goto*" t))) + '(org-display-buffer-full-frame)) (let (temp-buffer-show-function temp-buffer-show-hook) (with-output-to-temp-buffer "*Org Help*" (princ (format help (if org-goto-auto-isearch @@ -234,8 +238,10 @@ position or nil." (let (org-special-ctrl-a/e) (org-beginning-of-line)) (message "Select location and press RET") (use-local-map org-goto-map) - (recursive-edit))) - (kill-buffer "*org-goto*") + (unwind-protect (recursive-edit) + (when-let ((window (get-buffer-window "*Org Help*" t))) + (quit-window 'kill window))))) + (when (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) (cons org-goto-selected-point org-goto-exit-command))) ;;;###autoload diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index ca2910e1538..e17ee27fc6f 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -168,9 +168,10 @@ means of creating calendar-based reminders." ("m" . 30.4) ("y" . 365.25)))))) (error "Invalid duration string: %s" ts))) -(defun org-is-habit-p (&optional pom) - "Is the task at POM or point a habit?" - (string= "habit" (org-entry-get (or pom (point)) "STYLE"))) +(defun org-is-habit-p (&optional epom) + "Is the task at EPOM or point a habit? +EPOM is an element, marker, or buffer position." + (string= "habit" (org-entry-get epom "STYLE" 'selective))) (defun org-habit-parse-todo (&optional pom) "Parse the TODO surrounding point for its habit-related data. @@ -263,8 +264,8 @@ This list represents a \"habit\" for the rest of this module." (defsubst org-habit-repeat-type (habit) (nth 5 habit)) -(defsubst org-habit-get-priority (habit &optional moment) - "Determine the relative priority of a habit. +(defsubst org-habit-get-urgency (habit &optional moment) + "Determine the relative urgency of a habit. This must take into account not just urgency, but consistency as well." (let ((pri 1000) (now (if moment (time-to-days moment) (org-today))) diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 9586b728e70..e247fab1d8e 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -29,13 +29,13 @@ ;; are provided that create and retrieve such identifiers, and that find ;; entries based on the identifier. -;; Identifiers consist of a prefix (default "Org" given by the variable +;; Identifiers consist of a prefix (given by the variable ;; `org-id-prefix') and a unique part that can be created by a number -;; of different methods, see the variable `org-id-method'. -;; Org has a builtin method that uses a compact encoding of the creation -;; time of the ID, with microsecond accuracy. This virtually -;; guarantees globally unique identifiers, even if several people are -;; creating IDs at the same time in files that will eventually be used +;; of different methods, see the variable `org-id-method'. Org has a +;; builtin method that uses a compact encoding of the creation time of +;; the ID, with microsecond accuracy. This virtually guarantees +;; globally unique identifiers, even if several people are creating +;; IDs at the same time in files that will eventually be used ;; together. ;; ;; By default Org uses UUIDs as global unique identifiers. @@ -74,6 +74,7 @@ (org-assert-version) (require 'org) +(require 'org-element-ast) (require 'org-refile) (require 'ol) @@ -128,6 +129,46 @@ nil Never use an ID to make a link, instead link using a text search for (const :tag "Only use existing" use-existing) (const :tag "Do not use ID to create link" nil))) +(defcustom org-id-link-consider-parent-id nil + "Non-nil means storing a link to an Org entry considers inherited IDs. + +When this option is non-nil and `org-id-link-use-context' is +enabled, ID properties inherited from parent entries will be +considered when storing an ID link. If no ID is found in this +way, a new one may be created as normal (see +`org-id-link-to-org-use-id'). + +For example, given this org file: + +* Parent +:PROPERTIES: +:ID: abc +:END: +** Child 1 +** Child 2 + +With `org-id-link-consider-parent-id' and +`org-id-link-use-context' both enabled, storing a link with point +at \"Child 1\" will produce a link \"\". This +allows linking to uniquely-named sub-entries within a parent +entry with an ID, without requiring every sub-entry to have its +own ID." + :group 'org-link-store + :group 'org-id + :package-version '(Org . "9.7") + :type 'boolean) + +(defcustom org-id-link-use-context t + "Non-nil means enables search string context in org-id links. + +Search strings are added by `org-id-store-link' when both the +general option `org-link-context-for-files' and the org-id option +`org-id-link-use-context' are non-nil." + :group 'org-link-store + :group 'org-id + :package-version '(Org . "9.7") + :type 'boolean) + (defcustom org-id-uuid-program "uuidgen" "The uuidgen program." :group 'org-id @@ -225,6 +266,8 @@ systems." (defvar org-id-locations nil "List of files with IDs in those files.") +(defvar org-id--locations-checksum nil + "Last checksum corresponding to ID files and their modifications.") (defvar org-id-files nil "List of files that contain IDs.") @@ -277,25 +320,32 @@ This is useful when working with contents in a temporary buffer that will be copied back to the original.") ;;;###autoload -(defun org-id-get (&optional pom create prefix) - "Get the ID property of the entry at point-or-marker POM. -If POM is nil, refer to the entry at point. -If the entry does not have an ID, the function returns nil. -However, when CREATE is non-nil, create an ID if none is present already. -PREFIX will be passed through to `org-id-new'. -In any case, the ID of the entry is returned." - (org-with-point-at pom - (let ((id (org-entry-get nil "ID"))) - (cond - ((and id (stringp id) (string-match "\\S-" id)) - id) - (create - (setq id (org-id-new prefix)) - (org-entry-put pom "ID" id) - (org-id-add-location id +(defun org-id-get (&optional epom create prefix inherit) + "Get the ID of the entry at EPOM. + +EPOM is an element, marker, or buffer position. If EPOM is nil, +refer to the entry at point. + +If INHERIT is non-nil, ID properties inherited from parent +entries are considered. Otherwise, only ID properties on the +entry itself are considered. + +When CREATE is nil, return the ID of the entry if found, +otherwise nil. When CREATE is non-nil, create an ID if none has +been found, and return the new ID. PREFIX will be passed through +to `org-id-new'." + (let ((id (org-entry-get epom "ID" (and inherit t)))) + (cond + ((and id (stringp id) (string-match "\\S-" id)) + id) + (create + (setq id (org-id-new prefix)) + (org-entry-put epom "ID" id) + (org-with-point-at epom + (org-id-add-location id (or org-id-overriding-file-name - (buffer-file-name (buffer-base-buffer)))) - id))))) + (buffer-file-name (buffer-base-buffer))))) + id)))) ;;;###autoload (defun org-id-get-with-outline-path-completion (&optional targets) @@ -399,30 +449,6 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (t (error "Invalid `org-id-method'"))) (concat prefix unique))) -(defun org-id-uuid () - "Return string with random (version 4) UUID." - (let ((rnd (md5 (format "%s%s%s%s%s%s%s" - (random) - (org-time-convert-to-list nil) - (user-uid) - (emacs-pid) - (user-full-name) - user-mail-address - (recent-keys))))) - (format "%s-%s-4%s-%s%s-%s" - (substring rnd 0 8) - (substring rnd 8 12) - (substring rnd 13 16) - (format "%x" - (logior - #b10000000 - (logand - #b10111111 - (string-to-number - (substring rnd 16 18) 16)))) - (substring rnd 18 20) - (substring rnd 20 32)))) - (defun org-id-int-to-b36-one-digit (integer) "Convert INTEGER between 0 and 61 into a single character 0..9, A..Z, a..z." (cond @@ -500,7 +526,6 @@ If SILENT is non-nil, messages are suppressed." (interactive) (unless org-id-track-globally (error "Please turn on `org-id-track-globally' if you want to track IDs")) - (setq org-id-locations nil) (let* ((files (delete-dups (mapcar #'file-truename @@ -524,11 +549,18 @@ If SILENT is non-nil, messages are suppressed." (nfiles (length files)) (id-regexp (rx (seq bol (0+ (any "\t ")) ":ID:" (1+ " ") (not (any " "))))) - (seen-ids nil) + (seen-ids (make-hash-table :test #'equal)) (ndup 0) - (i 0)) - (with-temp-buffer - (org-element-with-disabled-cache + (i 0) + (checksum + (mapcar + (lambda (f) + (when (file-exists-p f) + (list f (file-attribute-modification-time (file-attributes f))))) + (sort (copy-sequence files) #'string<)))) + (unless (equal checksum org-id--locations-checksum) ; Files have changed since the last update. + (setq org-id-locations nil) + (with-temp-buffer (delay-mode-hooks (org-mode) (dolist (file files) @@ -538,29 +570,32 @@ If SILENT is non-nil, messages are suppressed." (message "Finding ID locations (%d/%d files): %s" i nfiles file)) (insert-file-contents file nil nil nil 'replace) (let ((ids nil) + node (case-fold-search t)) (org-with-point-at 1 (while (re-search-forward id-regexp nil t) - (when (org-at-property-p) - (push (org-entry-get (point) "ID") ids))) + (setq node (org-element-at-point)) + (when (org-element-type-p node 'node-property) + (push (org-element-property :value node) ids))) (when ids (push (cons (abbreviate-file-name file) ids) org-id-locations) (dolist (id ids) (cond - ((not (member id seen-ids)) (push id seen-ids)) + ((not (gethash id seen-ids)) (puthash id t seen-ids)) (silent nil) (t (message "Duplicate ID %S" id) - (cl-incf ndup)))))))))))) - (setq org-id-files (mapcar #'car org-id-locations)) - (org-id-locations-save) - ;; Now convert to a hash table. - (setq org-id-locations (org-id-alist-to-hash org-id-locations)) - (when (and (not silent) (> ndup 0)) - (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)) - (message "%d files scanned, %d files contains IDs, and %d IDs found." - nfiles (length org-id-files) (hash-table-count org-id-locations)) + (cl-incf ndup))))))))))) + (setq org-id-files (mapcar #'car org-id-locations)) + (org-id-locations-save) + ;; Now convert to a hash table. + (setq org-id-locations (org-id-alist-to-hash org-id-locations)) + (setq org-id--locations-checksum checksum) + (when (and (not silent) (> ndup 0)) + (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)) + (message "%d files scanned, %d files contains IDs, and %d IDs found." + nfiles (length org-id-files) (hash-table-count org-id-locations))) org-id-locations)) (defun org-id-locations-save () @@ -686,34 +721,81 @@ optional argument MARKERP, return the position as a new marker." ((not (file-exists-p file)) nil) (t (let* ((visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file)))) + (buffer (or visiting + (if markerp (find-file-noselect file) + (org-get-buffer-create " *Org ID temp*" t))))) (unwind-protect (with-current-buffer buffer + (unless (derived-mode-p 'org-mode) (org-mode)) + (unless (or visiting markerp) + (buffer-disable-undo) + ;; FIXME: In Emacs 27, `insert-file-contents' seemingly + ;; does not trigger modification hooks in some + ;; scenarios. This is manifested in test failures due + ;; to element cache losing track of the modifications. + (org-element-cache-reset) + (insert-file-contents file nil nil nil 'replace)) (let ((pos (org-find-entry-with-id id))) (cond ((null pos) nil) (markerp (move-marker (make-marker) pos buffer)) (t (cons file pos))))) - ;; Remove opened buffer in the process. - (unless (or visiting markerp) (kill-buffer buffer))))))) + ;; Clean temporarily buffer if we don't need to keep it. + (unless (or visiting markerp) + (with-current-buffer buffer (erase-buffer)))))))) ;; id link type -;; Calling the following function is hard-coded into `org-store-link', -;; so we do have to add it to `org-store-link-functions'. +(defun org-id--get-id-to-store-link (&optional create) + "Get or create the relevant ID for storing a link. + +Optional argument CREATE is passed to `org-id-get'. + +Inherited IDs are only considered when +`org-id-link-consider-parent-id', `org-id-link-use-context' and +`org-link-context-for-files' are all enabled, since inherited IDs +are confusing without the additional search string context. + +Note that this function resets the +`org-entry-property-inherited-from' marker: it will either point +to nil (if the id was not inherited) or to the point it was +inherited from." + (let* ((inherit-id (and org-id-link-consider-parent-id + org-id-link-use-context + org-link-context-for-files))) + (move-marker org-entry-property-inherited-from nil) + (org-id-get nil create nil inherit-id))) ;;;###autoload (defun org-id-store-link () "Store a link to the current entry, using its ID. -If before first heading store first title-keyword as description -or filename if no title." +The link description is based on the heading, or if before the +first heading, the title keyword if available, or else the +filename. + +When `org-link-context-for-files' and `org-id-link-use-context' +are non-nil, add a search string to the link. The link +description is then based on the search string target. + +When in addition `org-id-link-consider-parent-id' is non-nil, the +ID can be inherited from a parent entry, with the search string +used to still link to the current location." (interactive) - (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) - (let* ((link (concat "id:" (org-id-get-create))) + (when (and (buffer-file-name (buffer-base-buffer)) + (derived-mode-p 'org-mode)) + ;; Get the precise target first, in case looking for an id causes + ;; a properties drawer to be added at the current location. + (let* ((precise-target (and org-link-context-for-files + org-id-link-use-context + (org-link-precise-link-target))) + (link (concat "id:" (org-id--get-id-to-store-link 'create))) + (id-location (or (and org-entry-property-inherited-from + (marker-position org-entry-property-inherited-from)) + (save-excursion (org-back-to-heading-or-point-min t) (point)))) (case-fold-search nil) (desc (save-excursion - (org-back-to-heading-or-point-min t) + (goto-char id-location) (cond ((org-before-first-heading-p) (let ((keywords (org-collect-keywords '("TITLE")))) (if keywords @@ -725,14 +807,59 @@ or filename if no title." (match-string 4) (match-string 0))) (t link))))) + ;; Precise targets should be after id-location to avoid + ;; duplicating the current headline as a search string + (when (and precise-target + (> (nth 2 precise-target) id-location)) + (setq link (concat link "::" (nth 0 precise-target))) + (setq desc (nth 1 precise-target))) (org-link-store-props :link link :description desc :type "id") link))) -(defun org-id-open (id _) - "Go to the entry with id ID." - (org-mark-ring-push) - (let ((m (org-id-find id 'marker)) - cmd) +;;;###autoload +(defun org-id-store-link-maybe (&optional interactive?) + "Store a link to the current entry using its ID if enabled. + +The value of `org-id-link-to-org-use-id' determines whether an ID +link should be stored, using `org-id-store-link'. + +Assume the function is called interactively if INTERACTIVE? is +non-nil." + (when (and (buffer-file-name (buffer-base-buffer)) + (derived-mode-p 'org-mode) + (or (eq org-id-link-to-org-use-id t) + (and interactive? + (or (eq org-id-link-to-org-use-id 'create-if-interactive) + (and (eq org-id-link-to-org-use-id + 'create-if-interactive-and-no-custom-id) + (not (org-entry-get nil "CUSTOM_ID"))))) + ;; 'use-existing + (and org-id-link-to-org-use-id + (org-id--get-id-to-store-link)))) + (org-id-store-link))) + +(defun org-id-open (link _) + "Go to the entry indicated by id link LINK. + +The link can include a search string after \"::\", which is +passed to `org-link-search'. + +For backwards compatibility with IDs that contain \"::\", if no +match is found for the ID, the full link string including \"::\" +will be tried as an ID." + (let* ((option (and (string-match "::\\(.*\\)\\'" link) + (match-string 1 link))) + (id (if (not option) link + (substring link 0 (match-beginning 0)))) + m cmd) + (org-mark-ring-push) + (setq m (org-id-find id 'marker)) + (when (and (not m) option) + ;; Backwards compatibility: if id is not found, try treating + ;; whole link as an id. + (setq m (org-id-find link 'marker)) + (when m + (setq option nil))) (unless m (error "Cannot find entry with ID \"%s\"" id)) ;; Use a buffer-switching command in analogy to finding files @@ -749,9 +876,17 @@ or filename if no title." (funcall cmd (marker-buffer m))) (goto-char m) (move-marker m nil) + (when option + (save-restriction + (unless (org-before-first-heading-p) + (org-narrow-to-subtree)) + (org-link-search option nil nil + (org-element-lineage (org-element-at-point) 'headline t)))) (org-fold-show-context))) -(org-link-set-parameters "id" :follow #'org-id-open) +(org-link-set-parameters "id" + :follow #'org-id-open + :store #'org-id-store-link-maybe) (provide 'org-id) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index a612e1c9dc9..39dda4332aa 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -103,6 +103,14 @@ For details see the variable `org-adapt-indentation'." :group 'org-indent :type 'integer) +(defcustom org-indent-post-buffer-init-functions nil + "Hook run after org-indent finishes initializing a buffer. +The function(s) in in this hook must accept a single argument representing +the initialized buffer." + :group 'org-indent + :package-version '(Org . "9.7") + :type 'hook) + (defface org-indent '((t (:inherit org-hide))) "Face for outline indentation. The default is to make it look like whitespace. But you may find it @@ -290,7 +298,8 @@ a time value." ;; Job is complete: un-agentize buffer. (unless interruptp (setq org-indent-agentized-buffers - (delq buffer org-indent-agentized-buffers)))))))) + (delq buffer org-indent-agentized-buffers)) + (run-hook-with-args 'org-indent-post-buffer-init-functions buffer))))))) (defun org-indent-set-line-properties (level indentation &optional heading) "Set prefix properties on current line an move to next one. @@ -328,7 +337,7 @@ stopped." (save-match-data (org-with-wide-buffer (goto-char beg) - (beginning-of-line) + (forward-line 0) ;; Initialize prefix at BEG, according to current entry's level. (let* ((case-fold-search t) (limited-re (org-get-limited-outline-regexp)) @@ -410,7 +419,7 @@ This function is meant to be called by `after-change-functions'." (if (or org-indent-modified-headline-flag (save-excursion (goto-char beg) - (beginning-of-line) + (forward-line 0) (re-search-forward (org-with-limited-levels org-outline-regexp-bol) (save-excursion diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 7cbdaae4e8e..a4136a13d2c 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -94,9 +94,8 @@ 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 -the value of this variable." +or to a number smaller than this one. See `org-cycle-max-level' +docstring for more details." :group 'org-inlinetask :type '(choice (const :tag "Off" nil) @@ -175,7 +174,7 @@ The number of levels is controlled by `org-inlinetask-min-level'." (defun org-inlinetask-in-task-p () "Return true if point is inside an inline task." (save-excursion - (beginning-of-line) + (forward-line 0) (let ((case-fold-search t)) (or (looking-at-p (concat (org-inlinetask-outline-regexp) "\\(?:.*\\)")) (and (re-search-forward "^\\*+[ \t]+" nil t) @@ -194,7 +193,7 @@ The number of levels is controlled by `org-inlinetask-min-level'." "Go to the end of the inline task at point. Return point." (save-match-data - (beginning-of-line) + (forward-line 0) (let ((case-fold-search t) (inlinetask-re (org-inlinetask-outline-regexp))) (cond @@ -242,7 +241,7 @@ going below `org-inlinetask-min-level'." (replace-match down-task nil t nil 1) (org-inlinetask-goto-end) (if (and (eobp) (looking-back "END\\s-*" (line-beginning-position))) - (beginning-of-line) + (forward-line 0) (forward-line -1)) (unless (= (point) beg) (looking-at (org-inlinetask-outline-regexp)) @@ -268,7 +267,7 @@ If the task has an end part, also demote it." (replace-match down-task nil t nil 1) (org-inlinetask-goto-end) (if (and (eobp) (looking-back "END\\s-*" (line-beginning-position))) - (beginning-of-line) + (forward-line 0) (forward-line -1)) (unless (= (point) beg) (looking-at (org-inlinetask-outline-regexp)) diff --git a/lisp/org/org-keys.el b/lisp/org/org-keys.el index a0dbb289dba..5e9e666ace8 100644 --- a/lisp/org/org-keys.el +++ b/lisp/org/org-keys.el @@ -85,11 +85,26 @@ (declare-function org-down-element "org" ()) (declare-function org-edit-special "org" (&optional arg)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-emphasize "org" (&optional char)) (declare-function org-end-of-line "org" (&optional n)) (declare-function org-entry-put "org" (pom property value)) (declare-function org-eval-in-calendar "org" (form &optional keepdate)) +(declare-function org-calendar-goto-today-or-insert-dot "org" ()) +(declare-function org-calendar-goto-today "org" ()) +(declare-function org-calendar-backward-month "org" ()) +(declare-function org-calendar-forward-month "org" ()) +(declare-function org-calendar-backward-year "org" ()) +(declare-function org-calendar-forward-year "org" ()) +(declare-function org-calendar-backward-week "org" ()) +(declare-function org-calendar-forward-week "org" ()) +(declare-function org-calendar-backward-day "org" ()) +(declare-function org-calendar-forward-day "org" ()) +(declare-function org-calendar-view-entries "org" ()) +(declare-function org-calendar-scroll-month-left "org" ()) +(declare-function org-calendar-scroll-month-right "org" ()) +(declare-function org-calendar-scroll-three-months-left "org" ()) +(declare-function org-calendar-scroll-three-months-right "org" ()) (declare-function org-evaluate-time-range "org" (&optional to-buffer)) (declare-function org-export-dispatch "org" (&optional arg)) (declare-function org-feed-goto-inbox "org" (feed)) @@ -190,8 +205,8 @@ (declare-function org-table-sum "org" (&optional beg end nlast)) (declare-function org-table-toggle-coordinate-overlays "org" ()) (declare-function org-table-toggle-formula-debugger "org" ()) -(declare-function org-time-stamp "org" (arg &optional inactive)) -(declare-function org-time-stamp-inactive "org" (&optional arg)) +(declare-function org-timestamp "org" (arg &optional inactive)) +(declare-function org-timestamp-inactive "org" (&optional arg)) (declare-function org-timer "org" (&optional restart no-insert)) (declare-function org-timer-item "org" (&optional arg)) (declare-function org-timer-pause-or-continue "org" (&optional stop)) @@ -210,7 +225,7 @@ (declare-function org-toggle-ordered-property "org" ()) (declare-function org-toggle-pretty-entities "org" ()) (declare-function org-toggle-tags-groups "org" ()) -(declare-function org-toggle-time-stamp-overlays "org" ()) +(declare-function org-toggle-timestamp-overlays "org" ()) (declare-function org-transpose-element "org" ()) (declare-function org-transpose-words "org" ()) (declare-function org-tree-to-indirect-buffer "org" (&optional arg)) @@ -273,7 +288,7 @@ therefore you'll have to restart Emacs to apply it after changing." (defcustom org-mouse-1-follows-link (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) - "Non-nil means mouse-1 on a link will follow the link. + "Non-nil means Mouse-1 on a link will follow the link. A longer mouse click will still set point. Needs to be set before org.el is loaded." :group 'org-link-follow @@ -298,7 +313,7 @@ implementation is bad." :type 'hook) (defcustom org-return-follows-link nil - "Non-nil means on links RET will follow the link. + "Non-nil means on links RET will open links, timestamps, and citations. In tables, the special behavior of RET has precedence." :group 'org-link-follow :type 'boolean @@ -309,7 +324,7 @@ In tables, the special behavior of RET has precedence." ;;;; Base functions (defun org-key (key) - "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. + "Select KEY according to `org-replace-disputed-keys' and `org-disputed-keys'. Or return the original if not disputed." (when org-replace-disputed-keys (let* ((nkey (key-description key)) @@ -319,7 +334,7 @@ Or return the original if not disputed." key) (defun org-defkey (keymap key def) - "Define a key, possibly translated, as returned by `org-key'." + "Define KEY, possibly translated, as returned by `org-key' in KEYMAP to DEF." (define-key keymap (org-key key) def)) (defun org-remap (map &rest commands) @@ -349,71 +364,25 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (defvar org-read-date-minibuffer-local-map (let* ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) - (org-defkey map (kbd ".") - (lambda () (interactive) - ;; Are we at the beginning of the prompt? - (if (looking-back "^[^:]+: " - (let ((inhibit-field-text-motion t)) - (line-beginning-position))) - (org-eval-in-calendar '(calendar-goto-today)) - (insert ".")))) - (org-defkey map (kbd "C-.") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-goto-today)))) - (org-defkey map (kbd "M-S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey map (kbd "ESC S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey map (kbd "M-S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey map (kbd "ESC S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey map (kbd "M-S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey map (kbd "ESC S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey map (kbd "M-S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey map (kbd "ESC S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey map (kbd "S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-week 1)))) - (org-defkey map (kbd "S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-week 1)))) - (org-defkey map (kbd "S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-day 1)))) - (org-defkey map (kbd "S-") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-day 1)))) - (org-defkey map (kbd "!") - (lambda () (interactive) - (org-eval-in-calendar '(diary-view-entries)) - (message ""))) - (org-defkey map (kbd ">") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-scroll-left 1)))) - (org-defkey map (kbd "<") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-scroll-right 1)))) - (org-defkey map (kbd "C-v") - (lambda () (interactive) - (org-eval-in-calendar - '(calendar-scroll-left-three-months 1)))) - (org-defkey map (kbd "M-v") - (lambda () (interactive) - (org-eval-in-calendar - '(calendar-scroll-right-three-months 1)))) + (org-defkey map (kbd ".") #'org-calendar-goto-today-or-insert-dot) + (org-defkey map (kbd "C-.") #'org-calendar-goto-today) + (org-defkey map (kbd "M-S-") #'org-calendar-backward-month) + (org-defkey map (kbd "ESC S-") #'org-calendar-backward-month) + (org-defkey map (kbd "M-S-") #'org-calendar-forward-month) + (org-defkey map (kbd "ESC S-") #'org-calendar-forward-month) + (org-defkey map (kbd "M-S-") #'org-calendar-backward-year) + (org-defkey map (kbd "ESC S-") #'org-calendar-backward-year) + (org-defkey map (kbd "M-S-") #'org-calendar-forward-year) + (org-defkey map (kbd "ESC S-") #'org-calendar-forward-year) + (org-defkey map (kbd "S-") #'org-calendar-backward-week) + (org-defkey map (kbd "S-") #'org-calendar-forward-week) + (org-defkey map (kbd "S-") #'org-calendar-backward-day) + (org-defkey map (kbd "S-") #'org-calendar-forward-day) + (org-defkey map (kbd "!") #'org-calendar-view-entries) + (org-defkey map (kbd ">") #'org-calendar-scroll-month-left) + (org-defkey map (kbd "<") #'org-calendar-scroll-month-right) + (org-defkey map (kbd "C-v") #'org-calendar-scroll-three-months-left) + (org-defkey map (kbd "M-v") #'org-calendar-scroll-three-months-right) map) "Keymap for minibuffer commands when using `org-read-date'.") @@ -503,6 +472,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (org-defkey org-mode-map (kbd "C-c C-x c") #'org-table-copy-down) (org-defkey org-mode-map (kbd "C-c C-x m") #'org-meta-return) (org-defkey org-mode-map (kbd "C-c C-x M") #'org-insert-todo-heading) + (org-defkey org-mode-map (kbd "C-c C-x s") #'org-insert-structure-template) (org-defkey org-mode-map (kbd "C-c C-x RET") #'org-meta-return) (org-defkey org-mode-map (kbd "ESC RET") #'org-meta-return) (org-defkey org-mode-map (kbd "ESC ") #'org-metaleft) @@ -593,8 +563,8 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (org-defkey org-mode-map (kbd "C-c %") #'org-mark-ring-push) (org-defkey org-mode-map (kbd "C-c &") #'org-mark-ring-goto) (org-defkey org-mode-map (kbd "C-c C-z") #'org-add-note) ;alternative binding -(org-defkey org-mode-map (kbd "C-c .") #'org-time-stamp) ;minor-mode reserved -(org-defkey org-mode-map (kbd "C-c !") #'org-time-stamp-inactive) ;minor-mode r. +(org-defkey org-mode-map (kbd "C-c .") #'org-timestamp) ;minor-mode reserved +(org-defkey org-mode-map (kbd "C-c !") #'org-timestamp-inactive) ;minor-mode r. (org-defkey org-mode-map (kbd "C-c ,") #'org-priority) ;minor-mode reserved (org-defkey org-mode-map (kbd "C-c C-y") #'org-evaluate-time-range) (org-defkey org-mode-map (kbd "C-c >") #'org-goto-calendar) @@ -638,7 +608,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (org-defkey org-mode-map (kbd "C-c C-x C-w") #'org-cut-special) (org-defkey org-mode-map (kbd "C-c C-x M-w") #'org-copy-special) (org-defkey org-mode-map (kbd "C-c C-x C-y") #'org-paste-special) -(org-defkey org-mode-map (kbd "C-c C-x C-t") #'org-toggle-time-stamp-overlays) +(org-defkey org-mode-map (kbd "C-c C-x C-t") #'org-toggle-timestamp-overlays) (org-defkey org-mode-map (kbd "C-c C-x C-i") #'org-clock-in) (org-defkey org-mode-map (kbd "C-c C-x C-x") #'org-clock-in-last) (org-defkey org-mode-map (kbd "C-c C-x C-z") #'org-resolve-clocks) @@ -788,19 +758,21 @@ command." (function) (sexp)))))) -(defun org-print-speed-command (e) - (if (> (length (car e)) 1) +(defun org--print-speed-command (speed-command) + "Print information about SPEED-COMMAND in help buffer. +SPEED-COMMAND is an element of `org-speed-commands'." + (if (> (length (car speed-command)) 1) (progn (princ "\n") - (princ (car e)) + (princ (car speed-command)) (princ "\n") - (princ (make-string (length (car e)) ?-)) + (princ (make-string (length (car speed-command)) ?-)) (princ "\n")) - (princ (car e)) + (princ (car speed-command)) (princ " ") - (if (symbolp (cdr e)) - (princ (symbol-name (cdr e))) - (prin1 (cdr e))) + (if (symbolp (cdr speed-command)) + (princ (symbol-name (cdr speed-command))) + (prin1 (cdr speed-command))) (princ "\n"))) (defun org-speed-command-help () @@ -810,12 +782,7 @@ command." (user-error "Speed commands are not activated, customize `org-use-speed-commands'")) (with-output-to-temp-buffer "*Help*" (princ "Speed commands\n==============\n") - (mapc #'org-print-speed-command - ;; FIXME: don't check `org-speed-commands-user' past 9.6 - (if (boundp 'org-speed-commands-user) - (append org-speed-commands - org-speed-commands-user) - org-speed-commands))) + (mapc #'org--print-speed-command org-speed-commands)) (with-current-buffer "*Help*" (setq truncate-lines t))) @@ -831,16 +798,12 @@ If not, return to the original position and throw an error." (defun org-speed-command-activate (keys) "Hook for activating single-letter speed commands. +KEYS is the keys vector as returned by `this-command-keys-vector'. See `org-speed-commands' for configuring them." (when (or (and (bolp) (looking-at org-outline-regexp)) (and (functionp org-use-speed-commands) (funcall org-use-speed-commands))) - (cdr (assoc keys - ;; FIXME: don't check `org-speed-commands-user' past 9.6 - (if (boundp 'org-speed-commands-user) - (append org-speed-commands - org-speed-commands-user) - org-speed-commands))))) + (cdr (assoc keys org-speed-commands)))) ;;; Babel speed keys @@ -910,10 +873,11 @@ a-list placed behind the generic `org-babel-key-prefix'.") (define-key org-babel-map key def)) (defun org-babel-speed-command-activate (keys) - "Hook for activating single-letter code block commands." + "Hook for activating single-letter code block commands. +KEYS is the keys vector as returned by `this-command-keys-vector'." (when (and (bolp) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+begin_src")) - (eq 'src-block (org-element-type (org-element-at-point)))) + (org-element-type-p (org-element-at-point) 'src-block)) (cdr (assoc keys org-babel-key-bindings)))) ;;;###autoload diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index 5a202808e76..aed774ee2de 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -46,7 +46,7 @@ ;; - deprecated export block syntax, ;; - deprecated Babel header syntax, ;; - missing language in source blocks, -;; - missing back-end in export blocks, +;; - missing backend in export blocks, ;; - invalid Babel call blocks, ;; - NAME values with a colon, ;; - wrong babel headers, @@ -65,11 +65,13 @@ ;; - special properties in properties drawers, ;; - obsolete syntax for properties drawers, ;; - invalid duration in EFFORT property, +;; - invalid ID property with a double colon, ;; - missing definition for footnote references, ;; - missing reference for footnote definitions, ;; - non-footnote definitions in footnote section, ;; - probable invalid keywords, ;; - invalid blocks, +;; - mismatched repeaters in planning info line, ;; - misplaced planning info line, ;; - probable incomplete drawers, ;; - probable indented diary-sexps, @@ -194,7 +196,7 @@ for `tabulated-list-printer'." (with-current-buffer buffer (save-excursion (goto-char (point-min)) - (let ((ast (org-element-parse-buffer)) + (let ((ast (org-element-parse-buffer nil nil 'defer)) (id 0) (last-line 1) (last-pos 1)) @@ -208,10 +210,12 @@ for `tabulated-list-printer'." (cons (progn (goto-char (car report)) - (beginning-of-line) - (prog1 (number-to-string - (cl-incf last-line - (count-lines last-pos (point)))) + (forward-line 0) + (prog1 (propertize + (number-to-string + (cl-incf last-line + (count-lines last-pos (point)))) + 'org-lint-marker (car report)) (setf last-pos (point)))) (cdr report))))) ;; Insert trust level in generated reports. Also sort them @@ -221,7 +225,7 @@ for `tabulated-list-printer'." (let ((trust (symbol-name (org-lint-checker-trust c)))) (mapcar (lambda (report) - (list (car report) trust (nth 1 report) c)) + (list (copy-marker (car report)) trust (nth 1 report) c)) (save-excursion (funcall (org-lint-checker-function c) ast))))) @@ -244,6 +248,10 @@ for `tabulated-list-printer'." "Return current report line, as a number." (string-to-number (aref (tabulated-list-get-entry) 0))) +(defun org-lint--current-marker () + "Return current report marker." + (get-text-property 0 'org-lint-marker (aref (tabulated-list-get-entry) 0))) + (defun org-lint--current-checker (&optional entry) "Return current report checker. When optional argument ENTRY is non-nil, use this entry instead @@ -265,9 +273,10 @@ CHECKERS is the list of checkers used." (defun org-lint--jump-to-source () "Move to source line that generated the report at point." (interactive) - (let ((l (org-lint--current-line))) + (let ((mk (org-lint--current-marker))) (switch-to-buffer-other-window org-lint--source-buffer) - (org-goto-line l) + (unless (<= (point-min) mk (point-max)) (widen)) + (goto-char mk) (org-fold-show-set-visibility 'local) (recenter))) @@ -378,6 +387,18 @@ called with one argument, the key used for comparison." (t (push (cons key (funcall extract-position datum key)) keys)))))) (dolist (e originals reports) (funcall make-report (cdr e) (car e))))) +(defun org-lint-misplaced-heading (ast) + "Check for accidentally misplaced heading lines." + (org-with-point-at ast + (goto-char (point-min)) + (let (result) + ;; Heuristics for 2+ level heading not at bol. + (while (re-search-forward (rx (not (any "*\n\r ,")) ;; Not a bol; not escaped ,** heading; not " *** words" + "*" (1+ "*") " ") nil t) + (unless (org-at-block-p) ; Inside a block, where the chances to have heading a slim. + (push (list (match-beginning 0) "Possibly misplaced heading line") result))) + result))) + (defun org-lint-duplicate-custom-id (ast) (org-lint--collect-duplicates ast @@ -386,7 +407,7 @@ called with one argument, the key used for comparison." (and (org-string-equal-ignore-case "CUSTOM_ID" (org-element-property :key property)) (org-element-property :value property))) - (lambda (property _) (org-element-property :begin property)) + (lambda (property _) (org-element-begin property)) (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key)))) (defun org-lint-duplicate-name (ast) @@ -395,7 +416,7 @@ called with one argument, the key used for comparison." org-element-all-elements (lambda (datum) (org-element-property :name datum)) (lambda (datum name) - (goto-char (org-element-property :begin datum)) + (goto-char (org-element-begin datum)) (re-search-forward (format "^[ \t]*#\\+[A-Za-z]+:[ \t]*%s[ \t]*$" (regexp-quote name))) (match-beginning 0)) @@ -406,7 +427,7 @@ called with one argument, the key used for comparison." ast 'target (lambda (target) (split-string (org-element-property :value target))) - (lambda (target _) (org-element-property :begin target)) + (lambda (target _) (org-element-begin target)) (lambda (key) (format "Duplicate target <<%s>>" (mapconcat #'identity key " "))))) @@ -415,7 +436,7 @@ called with one argument, the key used for comparison." ast 'footnote-definition (lambda (definition) (org-element-property :label definition)) - (lambda (definition _) (org-element-property :post-affiliated definition)) + (lambda (definition _) (org-element-post-affiliated definition)) (lambda (key) (format "Duplicate footnote definition \"%s\"" key)))) (defun org-lint-orphaned-affiliated-keywords (ast) @@ -430,9 +451,22 @@ called with one argument, the key used for comparison." (and (or (let ((case-fold-search t)) (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key)) (member key keywords)) - (list (org-element-property :post-affiliated k) + (list (org-element-post-affiliated k) (format "Orphaned affiliated keyword: \"%s\"" key)))))))) +(defun org-lint-regular-keyword-before-affiliated (ast) + (org-element-map ast 'keyword + (lambda (keyword) + (when (= (org-element-post-blank keyword) 0) + (let ((next-element (org-with-point-at (org-element-end keyword) + (org-element-at-point)))) + (when (< (org-element-begin next-element) (org-element-post-affiliated next-element)) + ;; A keyword followed without blank lines by an element with affiliated keywords. + ;; The keyword may be confused with affiliated keywords. + (list (org-element-begin keyword) + (format "Independent keyword %s may be confused with affiliated keywords below" + (org-element-property :key keyword))))))))) + (defun org-lint-obsolete-affiliated-keywords (_) (let ((regexp (format "^[ \t]*#\\+%s:" (regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE" @@ -442,7 +476,7 @@ called with one argument, the key used for comparison." (while (re-search-forward regexp nil t) (let ((key (upcase (match-string-no-properties 1)))) (when (< (point) - (org-element-property :post-affiliated (org-element-at-point))) + (org-element-post-affiliated (org-element-at-point))) (push (list (line-beginning-position) (format @@ -463,7 +497,7 @@ called with one argument, the key used for comparison." (let ((type (org-element-property :type b))) (when (member-ignore-case type deprecated) (list - (org-element-property :post-affiliated b) + (org-element-post-affiliated b) (format "Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \ instead" @@ -485,14 +519,14 @@ instead" (let ((value (org-element-property :value datum))) (and (string= key "PROPERTY") (string-match deprecated-re value) - (list (org-element-property :begin datum) + (list (org-element-begin datum) (format "Deprecated syntax for \"%s\". \ Use header-args instead" (match-string-no-properties 1 value)))))) (`node-property (and (member-ignore-case key deprecated-babel-properties) (list - (org-element-property :begin datum) + (org-element-begin datum) (format "Deprecated syntax for \"%s\". \ Use :header-args: instead" key)))))))))) @@ -501,27 +535,38 @@ Use :header-args: instead" (org-element-map ast 'src-block (lambda (b) (unless (org-element-property :language b) - (list (org-element-property :post-affiliated b) + (list (org-element-post-affiliated b) "Missing language in source block"))))) +(defun org-lint-suspicious-language-in-src-block (ast) + (org-element-map ast 'src-block + (lambda (b) + (when-let ((lang (org-element-property :language b))) + (unless (or (functionp (intern (format "org-babel-execute:%s" lang))) + ;; No babel backend, but there is corresponding + ;; major mode. + (fboundp (org-src-get-lang-mode lang))) + (list (org-element-property :post-affiliated b) + (format "Unknown source block language: '%s'" lang))))))) + (defun org-lint-missing-backend-in-export-block (ast) (org-element-map ast 'export-block (lambda (b) (unless (org-element-property :type b) - (list (org-element-property :post-affiliated b) - "Missing back-end in export block"))))) + (list (org-element-post-affiliated b) + "Missing backend in export block"))))) (defun org-lint-invalid-babel-call-block (ast) (org-element-map ast 'babel-call (lambda (b) (cond ((not (org-element-property :call b)) - (list (org-element-property :post-affiliated b) + (list (org-element-post-affiliated b) "Invalid syntax in babel call block")) ((let ((h (org-element-property :end-header b))) (and h (string-match-p "\\`\\[.*\\]\\'" h))) (list - (org-element-property :post-affiliated b) + (org-element-post-affiliated b) "Babel call's end header must not be wrapped within brackets")))))) (defun org-lint-deprecated-category-setup (ast) @@ -531,7 +576,7 @@ Use :header-args: instead" (cond ((not (string= (org-element-property :key k) "CATEGORY")) nil) (category-flag - (list (org-element-property :post-affiliated k) + (list (org-element-post-affiliated k) "Spurious CATEGORY keyword. Set :CATEGORY: property instead")) (t (setf category-flag t) nil)))))) @@ -542,7 +587,7 @@ Use :header-args: instead" (let ((ref (org-element-property :path link))) (and (equal (org-element-property :type link) "coderef") (not (ignore-errors (org-export-resolve-coderef ref info))) - (list (org-element-property :begin link) + (list (org-element-begin link) (format "Unknown coderef \"%s\"" ref)))))))) (defun org-lint-invalid-custom-id-link (ast) @@ -551,7 +596,7 @@ Use :header-args: instead" (lambda (link) (and (equal (org-element-property :type link) "custom-id") (not (ignore-errors (org-export-resolve-id-link link info))) - (list (org-element-property :begin link) + (list (org-element-begin link) (format "Unknown custom ID \"%s\"" (org-element-property :path link)))))))) @@ -561,7 +606,7 @@ Use :header-args: instead" (lambda (link) (and (equal (org-element-property :type link) "fuzzy") (not (ignore-errors (org-export-resolve-fuzzy-link link info))) - (list (org-element-property :begin link) + (list (org-element-begin link) (format "Unknown fuzzy location \"%s\"" (let ((path (org-element-property :path link))) (if (string-prefix-p "*" path) @@ -569,20 +614,54 @@ Use :header-args: instead" path))))))))) (defun org-lint-invalid-id-link (ast) + (let ((id-locations-updated nil)) + (org-element-map ast 'link + (lambda (link) + (let ((id (org-element-property :path link))) + (and (equal (org-element-property :type link) "id") + (progn + (unless id-locations-updated + (org-id-update-id-locations nil t) + (setq id-locations-updated t)) + t) + ;; The locations are up-to-date with file changes after + ;; the call to `org-id-update-id-locations'. We do not + ;; need to double-check if recorded ID is still present + ;; in the file. + (not (org-id-find-id-file id)) + (list (org-element-begin link) + (format "Unknown ID \"%s\"" id)))))))) + +(defun org-lint-confusing-brackets (ast) + (org-element-map ast 'link + (lambda (link) + (org-with-wide-buffer + (when (eq (char-after (org-element-end link)) ?\]) + (list (org-element-begin link) + (format "Trailing ']' after link end"))))))) + +(defun org-lint-brackets-inside-description (ast) (org-element-map ast 'link (lambda (link) - (let ((id (org-element-property :path link))) - (and (equal (org-element-property :type link) "id") - (not (org-id-find id)) - (list (org-element-property :begin link) - (format "Unknown ID \"%s\"" id))))))) + (when (org-element-contents-begin link) + (org-with-point-at link + (goto-char (org-element-contents-begin link)) + (let ((count 0)) + (while (re-search-forward (rx (or ?\] ?\[)) (org-element-contents-end link) t) + (if (equal (match-string 0) "[") (cl-incf count) (cl-decf count))) + (when (> count 0) + (list (org-element-begin link) + (format "No closing ']' matches '[' in link description: %s" + (buffer-substring-no-properties + (org-element-contents-begin link) + (org-element-contents-end link))))))))))) (defun org-lint-special-property-in-properties-drawer (ast) (org-element-map ast 'node-property (lambda (p) (let ((key (org-element-property :key p))) (and (member-ignore-case key org-special-properties) - (list (org-element-property :begin p) + (list (org-element-begin p) (format "Special property \"%s\" found in a properties drawer" key))))))) @@ -591,12 +670,12 @@ Use :header-args: instead" (org-element-map ast 'drawer (lambda (d) (when (equal (org-element-property :drawer-name d) "PROPERTIES") - (let ((headline? (org-element-lineage d '(headline))) + (let ((headline? (org-element-lineage d 'headline)) (before (mapcar #'org-element-type (assq d (reverse (org-element-contents - (org-element-property :parent d))))))) - (list (org-element-property :post-affiliated d) + (org-element-parent d))))))) + (list (org-element-post-affiliated d) (if (or (and headline? (member before '(nil (planning)))) (and (null headline?) (member before '(nil (comment))))) "Incorrect contents for PROPERTIES drawer" @@ -609,9 +688,19 @@ Use :header-args: instead" (let ((value (org-element-property :value p))) (and (org-string-nw-p value) (not (org-duration-p value)) - (list (org-element-property :begin p) + (list (org-element-begin p) (format "Invalid effort duration format: %S" value)))))))) +(defun org-lint-invalid-id-property (ast) + (org-element-map ast 'node-property + (lambda (p) + (when (equal "ID" (org-element-property :key p)) + (let ((value (org-element-property :value p))) + (and (org-string-nw-p value) + (string-match-p "::" value) + (list (org-element-begin p) + (format "IDs should not include \"::\": %S" value)))))))) + (defun org-lint-link-to-local-file (ast) (org-element-map ast 'link (lambda (l) @@ -621,12 +710,13 @@ Use :header-args: instead" (let* ((path (org-element-property :path l)) (file (if (string= type "file") path - (org-with-point-at (org-element-property :begin l) + (org-with-point-at (org-element-begin l) (org-attach-expand path))))) + (setq file (substitute-env-in-file-name file)) (and (not (file-remote-p file)) (not (file-exists-p file)) - (list (org-element-property :begin l) - (format (if (org-element-lineage l '(link)) + (list (org-element-begin l) + (format (if (org-element-lineage l 'link) "Link to non-existent image file %S \ in description" "Link to non-existent local file %S") @@ -643,7 +733,7 @@ in description" (and (not (org-url-p file)) (not (file-remote-p file)) (not (file-exists-p file)) - (list (org-element-property :begin k) + (list (org-element-begin k) (format "Non-existent setup file %S" file)))))))) (defun org-lint-wrong-include-link-parameter (ast) @@ -656,7 +746,7 @@ in description" (save-match-data (org-strip-quotes (match-string 1 value)))))) (if (not path) - (list (org-element-property :post-affiliated k) + (list (org-element-post-affiliated k) "Missing location argument in INCLUDE keyword") (let* ((file (org-string-nw-p (if (string-match "::\\(.*\\)\\'" path) @@ -668,7 +758,7 @@ in description" (if (and file (not (file-remote-p file)) (not (file-exists-p file))) - (list (org-element-property :post-affiliated k) + (list (org-element-post-affiliated k) "Non-existent file argument in INCLUDE keyword") (let* ((visiting (if file (find-buffer-visiting file) (current-buffer))) @@ -676,13 +766,14 @@ in description" (org-link-search-must-match-exact-headline t)) (unwind-protect (with-current-buffer buffer - (when (and search - (not (ignore-errors - (org-link-search search nil t)))) - (list (org-element-property :post-affiliated k) - (format - "Invalid search part \"%s\" in INCLUDE keyword" - search)))) + (org-with-wide-buffer + (when (and search + (not (ignore-errors + (org-link-search search nil t)))) + (list (org-element-post-affiliated k) + (format + "Invalid search part \"%s\" in INCLUDE keyword" + search))))) (unless visiting (kill-buffer buffer))))))))))))) (defun org-lint-obsolete-include-markup (ast) @@ -698,7 +789,7 @@ in description" (value (org-element-property :value k))) (when (string-match regexp value) (let ((markup (match-string-no-properties 1 value))) - (list (org-element-property :post-affiliated k) + (list (org-element-post-affiliated k) (format "Obsolete markup \"%s\" in INCLUDE keyword. \ Use \"export %s\" instead" markup @@ -725,15 +816,51 @@ Use \"export %s\" instead" (setf start (match-end 0)) (let ((item (match-string 1 value))) (unless (member item allowed) - (push (list (org-element-property :post-affiliated k) + (push (list (org-element-post-affiliated k) (format "Unknown OPTIONS item \"%s\"" item)) reports)) (unless (match-string 2 value) - (push (list (org-element-property :post-affiliated k) + (push (list (org-element-post-affiliated k) (format "Missing value for option item %S" item)) reports)))))))) reports)) +(defun org-lint-export-option-keywords (ast) + "Check for options keyword properties without EXPORT in AST." + (require 'ox) + (let (options reports common-options options-alist) + (dolist (opt org-export-options-alist) + (when (stringp (nth 1 opt)) + (cl-pushnew (nth 1 opt) common-options :test #'equal))) + (dolist (backend org-export-registered-backends) + (dolist (opt (org-export-backend-options backend)) + (when (stringp (nth 1 opt)) + (cl-pushnew (or (org-export-backend-name backend) 'anonymous) + (alist-get (nth 1 opt) options-alist nil nil #'equal)) + (cl-pushnew (nth 1 opt) options :test #'equal)))) + (setq options-alist (nreverse options-alist)) + (org-element-map ast 'node-property + (lambda (node) + (let ((prop (org-element-property :key node))) + (when (and (or (member prop options) (member prop common-options)) + (not (member prop org-default-properties))) + (push (list (org-element-post-affiliated node) + (format "Potentially misspelled %sexport option \"%s\"%s. Consider \"EXPORT_%s\"." + (when (member prop common-options) + "global ") + prop + (if-let ((backends + (and (not (member prop common-options)) + (cdr (assoc-string prop options-alist))))) + (format + " in %S export %s" + (if (= 1 (length backends)) (car backends) backends) + (if (> (length backends) 1) "backends" "backend")) + "") + prop)) + reports))))) + reports)) + (defun org-lint-invalid-macro-argument-and-template (ast) (let* ((reports nil) (extract-placeholders @@ -747,7 +874,7 @@ Use \"export %s\" instead" (check-arity (lambda (arity macro) (let* ((name (org-element-property :key macro)) - (pos (org-element-property :begin macro)) + (pos (org-element-begin macro)) (args (org-element-property :args macro)) (l (length args))) (cond @@ -782,17 +909,17 @@ Use \"export %s\" instead" (org-trim (substring value (match-end 0)))))) (cond ((not name) - (push (list (org-element-property :post-affiliated k) + (push (list (org-element-post-affiliated k) "Missing name in MACRO keyword") reports)) ((not (org-string-nw-p template)) - (push (list (org-element-property :post-affiliated k) + (push (list (org-element-post-affiliated k) "Missing template in macro \"%s\"" name) reports)) (t (unless (let ((args (funcall extract-placeholders template))) (equal (number-sequence 1 (or (org-last args) 0)) args)) - (push (list (org-element-property :post-affiliated k) + (push (list (org-element-post-affiliated k) (format "Unused placeholders in macro \"%s\"" name)) reports)))))))) @@ -808,7 +935,7 @@ Use \"export %s\" instead" (template (cdr (assoc-string name templates t)))) (pcase template (`nil - (push (list (org-element-property :begin macro) + (push (list (org-element-begin macro) (format "Undefined macro %S" name)) reports)) ((guard (string= name "keyword")) @@ -833,17 +960,17 @@ Use \"export %s\" instead" (defun org-lint-undefined-footnote-reference (ast) (let ((definitions - (org-element-map ast '(footnote-definition footnote-reference) - (lambda (f) - (and (or (eq 'footnote-definition (org-element-type f)) - (eq 'inline (org-element-property :type f))) - (org-element-property :label f)))))) + (org-element-map ast '(footnote-definition footnote-reference) + (lambda (f) + (and (or (org-element-type-p f 'footnote-definition) + (eq 'inline (org-element-property :type f))) + (org-element-property :label f)))))) (org-element-map ast 'footnote-reference (lambda (f) (let ((label (org-element-property :label f))) (and (eq 'standard (org-element-property :type f)) (not (member label definitions)) - (list (org-element-property :begin f) + (list (org-element-begin f) (format "Missing definition for footnote [%s]" label)))))))) @@ -855,32 +982,46 @@ Use \"export %s\" instead" (let ((label (org-element-property :label f))) (and label (not (member label references)) - (list (org-element-property :post-affiliated f) + (list (org-element-post-affiliated f) (format "No reference for footnote definition [%s]" label)))))))) -(defun org-lint-colon-in-name (ast) - (org-element-map ast org-element-all-elements +(defun org-lint-mismatched-planning-repeaters (ast) + (org-element-map ast 'planning (lambda (e) - (let ((name (org-element-property :name e))) - (and name - (string-match-p ":" name) - (list (progn - (goto-char (org-element-property :begin e)) - (re-search-forward - (format "^[ \t]*#\\+\\w+: +%s *$" (regexp-quote name))) - (match-beginning 0)) - (format - "Name \"%s\" contains a colon; Babel cannot use it as input" - name))))))) + (let* ((scheduled (org-element-property :scheduled e)) + (deadline (org-element-property :deadline e)) + (scheduled-repeater-type (org-element-property + :repeater-type scheduled)) + (deadline-repeater-type (org-element-property + :repeater-type deadline)) + (scheduled-repeater-value (org-element-property + :repeater-value scheduled)) + (deadline-repeater-value (org-element-property + :repeater-value deadline))) + (when (and scheduled deadline + (memq scheduled-repeater-type '(cumulate catch-up)) + (memq deadline-repeater-type '(cumulate catch-up)) + (> scheduled-repeater-value 0) + (> deadline-repeater-value 0) + (not + (and + (eq scheduled-repeater-type deadline-repeater-type) + (eq (org-element-property :repeater-unit scheduled) + (org-element-property :repeater-unit deadline)) + (eql scheduled-repeater-value deadline-repeater-value)))) + (list + (org-element-property :begin e) + "Different repeaters in SCHEDULED and DEADLINE timestamps.")))))) (defun org-lint-misplaced-planning-info (_) (let ((case-fold-search t) reports) (while (re-search-forward org-planning-line-re nil t) - (unless (memq (org-element-type (org-element-at-point)) - '(comment-block example-block export-block planning - src-block verse-block)) + (unless (org-element-type-p + (org-element-at-point) + '(comment-block example-block export-block planning + src-block verse-block)) (push (list (line-beginning-position) "Misplaced planning info line") reports))) reports)) @@ -893,16 +1034,16 @@ Use \"export %s\" instead" (pcase (org-element-type element) (`drawer ;; Find drawer opening lines within non-empty drawers. - (let ((end (org-element-property :contents-end element))) + (let ((end (org-element-contents-end element))) (when end (while (re-search-forward org-drawer-regexp end t) (let ((n (org-trim (match-string-no-properties 0)))) (push (list (line-beginning-position) (format "Possible misleading drawer entry %S" n)) reports)))) - (goto-char (org-element-property :end element)))) + (goto-char (org-element-end element)))) (`property-drawer - (goto-char (org-element-property :end element))) + (goto-char (org-element-end element))) ((or `comment-block `example-block `export-block `src-block `verse-block) nil) @@ -916,9 +1057,10 @@ Use \"export %s\" instead" (defun org-lint-indented-diary-sexp (_) (let (reports) (while (re-search-forward "^[ \t]+%%(" nil t) - (unless (memq (org-element-type (org-element-at-point)) - '(comment-block diary-sexp example-block export-block - src-block verse-block)) + (unless (org-element-type-p + (org-element-at-point) + '(comment-block diary-sexp example-block export-block + src-block verse-block)) (push (list (line-beginning-position) "Possible indented diary-sexp") reports))) reports)) @@ -936,10 +1078,11 @@ Use \"export %s\" instead" (push (list (line-beginning-position) (format "Invalid block closing line \"%s\"" name)) reports)) - ((not (memq (org-element-type (org-element-at-point)) - '(center-block comment-block dynamic-block example-block - export-block quote-block special-block - src-block verse-block))) + ((not (org-element-type-p + (org-element-at-point) + '(center-block comment-block dynamic-block example-block + export-block quote-block special-block + src-block verse-block))) (push (list (line-beginning-position) (format "Possible incomplete block \"%s\"" name)) @@ -957,13 +1100,43 @@ Use \"export %s\" instead" (unless (or (string-prefix-p "BEGIN" name t) (string-prefix-p "END" name t) (save-excursion - (beginning-of-line) + (forward-line 0) (let ((case-fold-search t)) (looking-at exception-re)))) (push (list (match-beginning 0) (format "Possible missing colon in keyword \"%s\"" name)) reports)))) reports)) +(defun org-lint-invalid-image-alignment (ast) + (apply + #'nconc + (org-element-map ast 'paragraph + (lambda (p) + (let ((center-re ":center[[:space:]]+\\(\\S-+\\)") + (align-re ":align[[:space:]]+\\(\\S-+\\)") + (keyword-string + (car-safe (org-element-property :attr_org p))) + reports) + (when keyword-string + (when (and (string-match align-re keyword-string) + (not (member (match-string 1 keyword-string) + '("left" "center" "right")))) + (push + (list (org-element-begin p) + (format + "\"%s\" not a supported value for #+ATTR_ORG keyword attribute \":align\"." + (match-string 1 keyword-string))) + reports)) + (when (and (string-match center-re keyword-string) + (not (equal (match-string 1 keyword-string) "t"))) + (push + (list (org-element-begin p) + (format + "\"%s\" not a supported value for #+ATTR_ORG keyword attribute \":center\"." + (match-string 1 keyword-string))) + reports))) + reports))))) + (defun org-lint-extraneous-element-in-footnote-section (ast) (org-element-map ast 'headline (lambda (h) @@ -975,10 +1148,10 @@ Use \"export %s\" instead" property-drawer section))) org-element-all-elements) (lambda (e) - (not (and (eq (org-element-type e) 'headline) - (org-element-property :commentedp e)))) + (not (and (org-element-type-p e 'headline) + (org-element-property :commentedp e)))) nil t '(footnote-definition property-drawer)) - (list (org-element-property :begin h) + (list (org-element-begin h) "Extraneous elements in footnote section are not exported"))))) (defun org-lint-quote-section (ast) @@ -987,7 +1160,7 @@ Use \"export %s\" instead" (let ((title (org-element-property :raw-value h))) (and (or (string-prefix-p "QUOTE " title) (string-prefix-p (concat org-comment-string " QUOTE ") title)) - (list (org-element-property :begin h) + (list (org-element-begin h) "Deprecated QUOTE section")))))) (defun org-lint-file-application (ast) @@ -995,7 +1168,7 @@ Use \"export %s\" instead" (lambda (l) (let ((app (org-element-property :application l))) (and app - (list (org-element-property :begin l) + (list (org-element-begin l) (format "Deprecated \"file+%s\" link type" app))))))) (defun org-lint-percent-encoding-link-escape (ast) @@ -1012,7 +1185,7 @@ Use \"export %s\" instead" (throw :obsolete nil))) (string-match-p "%" uri)))) (when obsolete-flag - (list (org-element-property :begin l) + (list (org-element-begin l) "Link escaped with obsolete percent-encoding syntax"))))))) (defun org-lint-wrong-header-argument (ast) @@ -1034,8 +1207,8 @@ Use \"export %s\" instead" (mapcar #'car org-babel-load-languages)))))) (dolist (header headers) (let ((h (symbol-name (car header))) - (p (or (org-element-property :post-affiliated datum) - (org-element-property :begin datum)))) + (p (or (org-element-post-affiliated datum) + (org-element-begin datum)))) (cond ((not (string-prefix-p ":" h)) (push @@ -1096,6 +1269,37 @@ Use \"export %s\" instead" (org-element-property :header datum)))))))) reports)) +(defun org-lint-empty-header-argument (ast) + (let* (reports) + (org-element-map ast '(babel-call inline-babel-call inline-src-block src-block) + (lambda (datum) + (let ((headers + (pcase (org-element-type datum) + ((or `babel-call `inline-babel-call) + (cl-mapcan + (lambda (header) (org-babel-parse-header-arguments header 'no-eval)) + (list + (org-element-property :inside-header datum) + (org-element-property :end-header datum)))) + (`inline-src-block + (org-babel-parse-header-arguments + (org-element-property :parameters datum) + 'no-eval)) + (`src-block + (cl-mapcan + (lambda (header) (org-babel-parse-header-arguments header 'no-eval)) + (cons (org-element-property :parameters datum) + (org-element-property :header datum))))))) + (dolist (header headers) + (when (not (cdr header)) + (push + (list + (or (org-element-post-affiliated datum) + (org-element-begin datum)) + (format "Empty value in header argument \"%s\"" (symbol-name (car header)))) + reports)))))) + reports)) + (defun org-lint-wrong-header-value (ast) (let (reports) (org-element-map ast @@ -1148,8 +1352,8 @@ Use \"export %s\" instead" ((assq group groups-alist) (push (list - (or (org-element-property :post-affiliated datum) - (org-element-property :begin datum)) + (or (org-element-post-affiliated datum) + (org-element-begin datum)) (format "Forbidden combination in header \"%s\": %s, %s" (car header) @@ -1162,19 +1366,34 @@ Use \"export %s\" instead" (unless valid-value (push (list - (or (org-element-property :post-affiliated datum) - (org-element-property :begin datum)) + (or (org-element-post-affiliated datum) + (org-element-begin datum)) (format "Unknown value \"%s\" for header \"%s\"" v (car header))) reports)))))))))))) reports)) +(defun org-lint-named-result (ast) + (org-element-map ast org-element-all-elements + (lambda (el) + (when-let* ((result (org-element-property :results el)) + (result-name (org-element-property :name el)) + (origin-block + (if (org-string-nw-p (car result)) + (condition-case _ + (org-export-resolve-link (car result) `(:parse-tree ,ast)) + (org-link-broken nil)) + (org-export-get-previous-element el nil)))) + (when (org-element-type-p origin-block 'src-block) + (list (org-element-begin el) + (format "Links to \"%s\" will not be valid during export unless the parent source block has :exports results or both" result-name))))))) + (defun org-lint-spurious-colons (ast) (org-element-map ast '(headline inlinetask) (lambda (h) (when (member "" (org-element-property :tags h)) - (list (org-element-property :begin h) + (list (org-element-begin h) "Tags contain a spurious colon"))))) (defun org-lint-non-existent-bibliography (ast) @@ -1184,7 +1403,7 @@ Use \"export %s\" instead" (let ((file (org-strip-quotes (org-element-property :value k)))) (and (not (file-remote-p file)) (not (file-exists-p file)) - (list (org-element-property :begin k) + (list (org-element-begin k) (format "Non-existent bibliography %S" file)))))))) (defun org-lint-missing-print-bibliography (ast) @@ -1201,7 +1420,7 @@ Use \"export %s\" instead" (lambda (k) (when (equal "CITE_EXPORT" (org-element-property :key k)) (let ((value (org-element-property :value k)) - (source (org-element-property :begin k))) + (source (org-element-begin k))) (if (equal value "") (list source "Missing export processor name") (condition-case _ @@ -1209,8 +1428,11 @@ Use \"export %s\" instead" (`(,(and (pred symbolp) name) ,(pred string-or-null-p) ,(pred string-or-null-p)) - (unless (org-cite-get-processor name) - (list source "Unknown cite export processor %S" name))) + (unless (or (org-cite-get-processor name) + (progn + (org-cite-try-load-processor name) + (org-cite-get-processor name))) + (list source (format "Unknown cite export processor %S" name)))) (_ (list source "Invalid cite export processor declaration"))) (error @@ -1223,13 +1445,103 @@ Use \"export %s\" instead" ;; XXX: The code below signals the error at the beginning ;; of the paragraph containing the faulty object. It is ;; not very accurate but may be enough for now. - (list (org-element-property :contents-begin - (org-element-property :parent text)) + (list (org-element-contents-begin + (org-element-parent text)) "Possibly incomplete citation markup"))))) +(defun org-lint-item-number (ast) + (org-element-map ast 'item + (lambda (item) + (unless (org-element-property :counter item) + (when-let* ((bullet (org-element-property :bullet item)) + (bullet-number + (cond + ((string-match "[A-Za-z]" bullet) + (- (string-to-char (upcase (match-string 0 bullet))) + 64)) + ((string-match "[0-9]+" bullet) + (string-to-number (match-string 0 bullet))))) + (true-number + (org-list-get-item-number + (org-element-begin item) + (org-element-property :structure item) + (org-list-prevs-alist (org-element-property :structure item)) + (org-list-parents-alist (org-element-property :structure item))))) + (unless (equal bullet-number (car (last true-number))) + (list + (org-element-begin item) + (format "Bullet counter \"%s\" is not the same with item position %d. Consider adding manual [@%d] counter." + bullet (car (last true-number)) bullet-number)))))))) + +(defun org-lint-LaTeX-$ (ast) + "Report semi-obsolete $...$ LaTeX fragments. +AST is the buffer parse tree." + (org-element-map ast 'latex-fragment + (lambda (fragment) + (and (string-match-p "^[$][^$]" (org-element-property :value fragment)) + (list (org-element-begin fragment) + "Potentially confusing LaTeX fragment format. Prefer using more reliable \\(...\\)"))))) +(defun org-lint-LaTeX-$-ambiguous (_) + "Report LaTeX fragment-like text. +AST is the buffer parse tree." + (org-with-wide-buffer + (let ((ambiguous-latex-re (rx "$." digit)) + report context) + (while (re-search-forward ambiguous-latex-re nil t) + (setq context (org-element-context)) + (when (or (eq 'latex-fragment (org-element-type context)) + (memq 'latex-fragment (org-element-restriction context))) + (push + (list + (point) + "$ symbol potentially matching LaTeX fragment boundary. Consider using \\dollar entity.") + report))) + report))) +(defun org-lint-timestamp-syntax (ast) + "Report malformed timestamps. +AST is the buffer parse tree." + (org-element-map ast 'timestamp + (lambda (timestamp) + (let ((expected (org-element-interpret-data timestamp)) + (actual (buffer-substring-no-properties + (org-element-property :begin timestamp) + (org-element-property :end timestamp)))) + (unless (equal expected actual) + (list (org-element-property :begin timestamp) + (format "Potentially malformed timestamp %s. Parsed as: %s" actual expected))))))) +(defun org-lint-inactive-planning (ast) + "Report inactive timestamp in SCHEDULED/DEADLINE. +AST is the buffer parse tree." + (org-element-map ast 'planning + (lambda (planning) + (let ((scheduled (org-element-property :scheduled planning)) + (deadline (org-element-property :deadline planning))) + (cond + ((memq (org-element-property :type scheduled) '(inactive inactive-range)) + (list (org-element-begin planning) "Inactive timestamp in SCHEDULED will not appear in agenda.")) + ((memq (org-element-property :type deadline) '(inactive inactive-range)) + (list (org-element-begin planning) "Inactive timestamp in DEADLINE will not appear in agenda.")) + (t nil)))))) + +(defvar org-beamer-frame-environment) ; defined in ox-beamer.el +(defun org-lint-beamer-frame (ast) + "Check for occurrences of begin or end frame." + (require 'ox-beamer) + (org-with-point-at ast + (goto-char (point-min)) + (let (result) + (while (re-search-forward + (concat "\\\\\\(begin\\|end\\){" org-beamer-frame-environment "}") nil t) + (push (list (match-beginning 0) "Beamer frame name may cause error when exporting. Consider customizing `org-beamer-frame-environment'.") result)) + result))) + ;;; Checkers declaration +(org-lint-add-checker 'misplaced-heading + "Report accidentally misplaced heading lines." + #'org-lint-misplaced-heading :trust 'low) + (org-lint-add-checker 'duplicate-custom-id "Report duplicates CUSTOM_ID properties" #'org-lint-duplicate-custom-id @@ -1255,6 +1567,11 @@ Use \"export %s\" instead" #'org-lint-orphaned-affiliated-keywords :trust 'low) +(org-lint-add-checker 'combining-keywords-with-affiliated + "Report independent keywords preceding affiliated keywords." + #'org-lint-regular-keyword-before-affiliated + :trust 'low) + (org-lint-add-checker 'obsolete-affiliated-keywords "Report obsolete affiliated keywords" #'org-lint-obsolete-affiliated-keywords @@ -1275,8 +1592,13 @@ Use \"export %s\" instead" #'org-lint-missing-language-in-src-block :categories '(babel)) +(org-lint-add-checker 'suspicious-language-in-src-block + "Report suspicious language in source blocks" + #'org-lint-suspicious-language-in-src-block + :trust 'low :categories '(babel)) + (org-lint-add-checker 'missing-backend-in-export-block - "Report missing back-end in export blocks" + "Report missing backend in export blocks" #'org-lint-missing-backend-in-export-block :categories '(export)) @@ -1285,11 +1607,6 @@ Use \"export %s\" instead" #'org-lint-invalid-babel-call-block :categories '(babel)) -(org-lint-add-checker 'colon-in-name - "Report NAME values with a colon" - #'org-lint-colon-in-name - :categories '(babel)) - (org-lint-add-checker 'wrong-header-argument "Report wrong babel headers" #'org-lint-wrong-header-argument @@ -1300,6 +1617,16 @@ Use \"export %s\" instead" #'org-lint-wrong-header-value :categories '(babel) :trust 'low) +(org-lint-add-checker 'named-result + "Report results evaluation with #+name keyword." + #'org-lint-named-result + :categories '(babel) :trust 'high) + +(org-lint-add-checker 'empty-header-argument + "Report empty values in babel headers" + #'org-lint-empty-header-argument + :categories '(babel) :trust 'low) + (org-lint-add-checker 'deprecated-category-setup "Report misuse of CATEGORY keyword" #'org-lint-deprecated-category-setup @@ -1325,6 +1652,16 @@ Use \"export %s\" instead" #'org-lint-invalid-id-link :categories '(link)) +(org-lint-add-checker 'trailing-bracket-after-link + "Report potentially confused trailing ']' after link." + #'org-lint-confusing-brackets + :categories '(link) :trust 'low) + +(org-lint-add-checker 'unclosed-brackets-in-link-description + "Report potentially confused trailing ']' after link." + #'org-lint-brackets-inside-description + :categories '(link) :trust 'low) + (org-lint-add-checker 'link-to-local-file "Report links to non-existent local files" #'org-lint-link-to-local-file @@ -1350,6 +1687,11 @@ Use \"export %s\" instead" #'org-lint-unknown-options-item :categories '(export) :trust 'low) +(org-lint-add-checker 'misspelled-export-option + "Report potentially misspelled export options in properties." + #'org-lint-export-option-keywords + :categories '(export) :trust 'low) + (org-lint-add-checker 'invalid-macro-argument-and-template "Report spurious macro arguments or invalid macro templates" #'org-lint-invalid-macro-argument-and-template @@ -1370,6 +1712,11 @@ Use \"export %s\" instead" #'org-lint-invalid-effort-property :categories '(properties)) +(org-lint-add-checker 'invalid-id-property + "Report search string delimiter \"::\" in ID property" + #'org-lint-invalid-id-property + :categories '(properties)) + (org-lint-add-checker 'undefined-footnote-reference "Report missing definition for footnote references" #'org-lint-undefined-footnote-reference @@ -1390,11 +1737,21 @@ Use \"export %s\" instead" #'org-lint-invalid-keyword-syntax :trust 'low) +(org-lint-add-checker 'invalid-image-alignment + "Report unsupported align attribute for keyword" + #'org-lint-invalid-image-alignment + :trust 'high) + (org-lint-add-checker 'invalid-block "Report invalid blocks" #'org-lint-invalid-block :trust 'low) +(org-lint-add-checker 'mismatched-planning-repeaters + "Report mismatched repeaters in planning info line" + #'org-lint-mismatched-planning-repeaters + :trust 'low) + (org-lint-add-checker 'misplaced-planning-info "Report misplaced planning info line" #'org-lint-misplaced-planning-info @@ -1450,6 +1807,32 @@ Use \"export %s\" instead" #'org-lint-incomplete-citation :categories '(cite) :trust 'low) +(org-lint-add-checker 'item-number + "Report inconsistent item numbers in lists" + #'org-lint-item-number + :categories '(plain-list)) + +(org-lint-add-checker 'LaTeX-$ + "Report potentially confusing $...$ LaTeX markup." + #'org-lint-LaTeX-$ + :categories '(markup)) +(org-lint-add-checker 'LaTeX-$ + "Report $ that might be treated as LaTeX fragment boundary." + #'org-lint-LaTeX-$-ambiguous + :categories '(markup) :trust 'low) +(org-lint-add-checker 'beamer-frame + "Report that frame text contains beamer frame environment." + #'org-lint-beamer-frame + :categories '(export) :trust 'low) +(org-lint-add-checker 'timestamp-syntax + "Report malformed timestamps." + #'org-lint-timestamp-syntax + :categories '(timestamp) :trust 'low) +(org-lint-add-checker 'planning-inactive + "Report inactive timestamps in SCHEDULED/DEADLINE." + #'org-lint-inactive-planning + :categories '(timestamp) :trust 'high) + (provide 'org-lint) ;; Local variables: diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index dbef7a82b1f..45a07a71546 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -111,15 +111,22 @@ (declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-interpret-data "org-element" (data)) -(declare-function org-element-lineage "org-element" (blob &optional types with-self)) +(declare-function org-element-lineage "org-element-ast" (blob &optional types with-self)) (declare-function org-element-macro-interpreter "org-element" (macro ##)) (declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated)) (declare-function org-element-normalize-string "org-element" (s)) -(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-put-property "org-element" (element property value)) -(declare-function org-element-set-element "org-element" (old new)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only keep-deferred)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-begin "org-element" (node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-contents-begin "org-element" (node)) +(declare-function org-element-contents-end "org-element" (node)) +(declare-function org-element-post-affiliated "org-element" (node)) +(declare-function org-element-post-blank "org-element" (node)) +(declare-function org-element-parent "org-element-ast" (node)) +(declare-function org-element-put-property "org-element-ast" (node property value)) +(declare-function org-element-set "org-element-ast" (old new)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-element-update-syntax "org-element" ()) (declare-function org-end-of-meta-data "org" (&optional full)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) @@ -364,16 +371,32 @@ group 2: counter group 3: checkbox group 4: description tag") -(defun org-item-re () +(defvar org--item-re-cache nil + "Results cache for `org-item-re'.") +(defsubst org-item-re () "Return the correct regular expression for plain lists." - (let ((term (cond - ((eq org-plain-list-ordered-item-terminator t) "[.)]") - ((= org-plain-list-ordered-item-terminator ?\)) ")") - ((= org-plain-list-ordered-item-terminator ?.) "\\.") - (t "[.)]"))) - (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" ""))) - (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term - "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)"))) + (or (plist-get + (plist-get org--item-re-cache + org-list-allow-alphabetical) + org-plain-list-ordered-item-terminator) + (let* ((term (cond + ((eq org-plain-list-ordered-item-terminator t) "[.)]") + ((= org-plain-list-ordered-item-terminator ?\)) ")") + ((= org-plain-list-ordered-item-terminator ?.) "\\.") + (t "[.)]"))) + (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" "")) + (re (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term + "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)"))) + (setq org--item-re-cache + (plist-put + org--item-re-cache + org-list-allow-alphabetical + (plist-put + (plist-get org--item-re-cache + org-list-allow-alphabetical) + org-plain-list-ordered-item-terminator + re))) + re))) (defsubst org-item-beginning-re () "Regexp matching the beginning of a plain list item." @@ -400,7 +423,7 @@ group 4: description tag") (defun org-in-item-p () "Return item beginning position when in a plain list, nil otherwise." (save-excursion - (beginning-of-line) + (forward-line 0) (let* ((case-fold-search t) (context (org-list-context)) (lim-up (car context)) @@ -448,7 +471,7 @@ group 4: description tag") (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) ((and (looking-at "^[ \t]*:END:") (re-search-backward org-drawer-regexp lim-up t)) - (beginning-of-line)) + (forward-line 0)) ((and inlinetask-re (looking-at inlinetask-re)) (org-inlinetask-goto-beginning) (forward-line -1)) @@ -462,11 +485,18 @@ group 4: description tag") (forward-line -1)) (t (forward-line -1))))))))))) +;; FIXME: We should make use of org-element API in more places here. (defun org-at-item-p () - "Is point in a line starting a hand-formatted item?" + "Is point in a line starting a hand-formatted item? +Modify match data, matching against `org-item-re'." (save-excursion - (beginning-of-line) - (and (looking-at (org-item-re)) (org-list-in-valid-context-p)))) + (forward-line 0) + (and + (org-element-type-p + (org-element-at-point) + '(plain-list item)) + ;; Set match data. + (looking-at (org-item-re))))) (defun org-at-item-bullet-p () "Is point at the bullet of a plain list item?" @@ -508,7 +538,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (save-match-data (save-excursion (org-with-limited-levels - (beginning-of-line) + (forward-line 0) (let ((case-fold-search t) (pos (point)) beg end context-type ;; Get positions of surrounding headings. This is the ;; default context. @@ -595,7 +625,7 @@ will get the following structure: Assume point is at an item." (save-excursion - (beginning-of-line) + (forward-line 0) (let* ((case-fold-search t) (context (org-list-context)) (lim-up (car context)) @@ -663,7 +693,7 @@ Assume point is at an item." (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) ((and (looking-at "^[ \t]*:END:") (re-search-backward org-drawer-regexp lim-up t)) - (beginning-of-line)) + (forward-line 0)) ((and inlinetask-re (looking-at inlinetask-re)) (org-inlinetask-goto-beginning) (forward-line -1)) @@ -1122,7 +1152,7 @@ This function modifies STRUCT." (org-fold-core-regions (cdr folds) :relative beg-A) (org-fold-core-regions (car folds) - :relative (+ beg-B (- size-B size-A (length between-A-no-blank-and-B)))) + :relative (+ beg-A size-B (length between-A-no-blank-and-B))) ;; 2. Now modify struct. No need to re-read the list, the ;; transformation is just a shift of positions. Some special ;; attention is required for items ending at END-A and END-B @@ -1831,7 +1861,7 @@ Initial position of cursor is restored after the changes." (lambda (end beg delta) (goto-char end) (skip-chars-backward " \r\t\n") - (beginning-of-line) + (forward-line 0) (while (or (> (point) beg) (and (= (point) beg) (not (looking-at item-re)))) @@ -2218,7 +2248,7 @@ item is invisible." (setq struct (org-list-insert-item pos struct prevs checkbox desc)) (org-list-write-struct struct (org-list-parents-alist struct)) (when checkbox (org-update-checkbox-count-maybe)) - (beginning-of-line) + (forward-line 0) (looking-at org-list-full-item-re) (goto-char (if (and (match-beginning 4) (save-match-data @@ -2248,7 +2278,7 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (interactive "P") (unless (org-at-item-p) (error "Not at an item")) (let ((origin (point-marker))) - (beginning-of-line) + (forward-line 0) (let* ((struct (org-list-struct)) (parents (org-list-parents-alist struct)) (prevs (org-list-prevs-alist struct)) @@ -2310,14 +2340,14 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (setq struct (org-list-struct)) (cond ((>= origin-offset2 0) - (beginning-of-line) + (forward-line 0) (move-marker origin (+ (point) (org-list-get-ind (point) struct) (length (org-list-get-bullet (point) struct)) origin-offset2)) (goto-char origin)) ((>= origin-offset 0) - (beginning-of-line) + (forward-line 0) (move-marker origin (+ (point) (org-list-get-ind (point) struct) origin-offset)) @@ -2362,15 +2392,15 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (defun org-at-radio-list-p () "Is point at a list item with radio buttons?" (when (org-match-line (org-item-re)) ;short-circuit - (let* ((e (save-excursion (beginning-of-line) (org-element-at-point)))) + (let* ((e (save-excursion (forward-line 0) (org-element-at-point)))) ;; Check we're really on a line with a bullet. - (when (memq (org-element-type e) '(item plain-list)) + (when (org-element-type-p e '(item plain-list)) ;; Look for ATTR_ORG attribute in the current plain list. - (let ((plain-list (org-element-lineage e '(plain-list) t))) - (org-with-point-at (org-element-property :post-affiliated plain-list) + (let ((plain-list (org-element-lineage e 'plain-list t))) + (org-with-point-at (org-element-post-affiliated plain-list) (let ((case-fold-search t) (regexp "^[ \t]*#\\+attr_org:.* :radio \\(\\S-+\\)") - (begin (org-element-property :begin plain-list))) + (begin (org-element-begin plain-list))) (and (re-search-backward regexp begin t) (not (string-equal "nil" (match-string 1))))))))))) @@ -2408,7 +2438,7 @@ subtree, ignoring planning line and any drawer following it." (setq lim-down (copy-marker limit)))) ((org-at-heading-p) ;; On a heading, start at first item after drawers and - ;; time-stamps (scheduled, etc.). + ;; timestamps (scheduled, etc.). (let ((limit (save-excursion (outline-next-heading) (point)))) (org-end-of-meta-data t) (if (org-list-search-forward (org-item-beginning-re) limit t) @@ -2492,8 +2522,8 @@ subtree, ignoring planning line and any drawer following it." (while (< (point) end) (when (org-at-item-checkbox-p) (replace-match "[ ]" t t nil 1)) - (beginning-of-line 2))) - (org-update-checkbox-count-maybe 'all))))) + (forward-line 1))) + (org-update-checkbox-count-maybe 'narrow))))) (defun org-update-checkbox-count (&optional all) "Update the checkbox statistics in the current section. @@ -2501,126 +2531,131 @@ subtree, ignoring planning line and any drawer following it." This will find all statistic cookies like [57%] and [6/12] and update them with the current numbers. -With optional prefix argument ALL, do this for the whole buffer." +With optional prefix argument ALL, do this for the whole buffer. +When ALL is symbol `narrow', update statistics only in the accessible +portion of the buffer." (interactive "P") - (org-with-wide-buffer - (let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\ + (save-excursion + (save-restriction + (unless (eq all 'narrow) (widen)) + (let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\ \\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") - (cookie-data (or (org-entry-get nil "COOKIE_DATA") "")) - (recursivep - (or (not org-checkbox-hierarchical-statistics) - (string-match-p "\\" cookie-data))) - (within-inlinetask (and (not all) - (featurep 'org-inlinetask) - (org-inlinetask-in-task-p))) - (end (cond (all (point-max)) - (within-inlinetask - (save-excursion (outline-next-heading) (point))) - (t (save-excursion - (org-with-limited-levels (outline-next-heading)) - (point))))) - (count-boxes - (lambda (item structs recursivep) - ;; Return number of checked boxes and boxes of all types - ;; in all structures in STRUCTS. If RECURSIVEP is - ;; non-nil, also count boxes in sub-lists. If ITEM is - ;; nil, count across the whole structure, else count only - ;; across subtree whose ancestor is ITEM. - (let ((c-on 0) (c-all 0)) - (dolist (s structs (list c-on c-all)) - (let* ((pre (org-list-prevs-alist s)) - (par (org-list-parents-alist s)) - (items - (cond - ((and recursivep item) (org-list-get-subtree item s)) - (recursivep (mapcar #'car s)) - (item (org-list-get-children item s par)) - (t (org-list-get-all-items - (org-list-get-top-point s) s pre)))) - (cookies (delq nil (mapcar - (lambda (e) - (org-list-get-checkbox e s)) - items)))) - (cl-incf c-all (length cookies)) - (cl-incf c-on (cl-count "[X]" cookies :test #'equal))))))) - cookies-list cache) - ;; Move to start. - (cond (all (goto-char (point-min))) - (within-inlinetask (org-back-to-heading t)) - (t (org-with-limited-levels (outline-previous-heading)))) - ;; Build an alist for each cookie found. The key is the position - ;; at beginning of cookie and values ending position, format of - ;; cookie, number of checked boxes to report and total number of - ;; boxes. - (while (re-search-forward cookie-re end t) - (let ((context (save-excursion (backward-char) - (save-match-data (org-element-context))))) - (when (and (eq (org-element-type context) 'statistics-cookie) - (not (string-match-p "\\" cookie-data))) - (push - (append - (list (match-beginning 1) (match-end 1) (match-end 2)) - (let* ((container - (org-element-lineage - context - '(drawer center-block dynamic-block inlinetask item - quote-block special-block verse-block))) - (beg (if container - (org-element-property :contents-begin container) - (save-excursion - (org-with-limited-levels - (outline-previous-heading)) + (cookie-data (or (org-entry-get nil "COOKIE_DATA") "")) + (recursivep + (or (not org-checkbox-hierarchical-statistics) + (string-match-p "\\" cookie-data))) + (within-inlinetask (and (not all) + (featurep 'org-inlinetask) + (org-inlinetask-in-task-p))) + (end (cond (all (point-max)) + (within-inlinetask + (save-excursion (outline-next-heading) (point))) + (t (save-excursion + (org-with-limited-levels (outline-next-heading)) (point))))) - (or (cdr (assq beg cache)) - (save-excursion - (goto-char beg) - (let ((end - (if container - (org-element-property :contents-end container) + (count-boxes + (lambda (item structs recursivep) + ;; Return number of checked boxes and boxes of all types + ;; in all structures in STRUCTS. If RECURSIVEP is + ;; non-nil, also count boxes in sub-lists. If ITEM is + ;; nil, count across the whole structure, else count only + ;; across subtree whose ancestor is ITEM. + (let ((c-on 0) (c-all 0)) + (dolist (s structs (list c-on c-all)) + (let* ((pre (org-list-prevs-alist s)) + (par (org-list-parents-alist s)) + (items + (cond + ((and recursivep item) (org-list-get-subtree item s)) + (recursivep (mapcar #'car s)) + (item (org-list-get-children item s par)) + (t (org-list-get-all-items + (org-list-get-top-point s) s pre)))) + (cookies (delq nil (mapcar + (lambda (e) + (org-list-get-checkbox e s)) + items)))) + (cl-incf c-all (length cookies)) + (cl-incf c-on (cl-count "[X]" cookies :test #'equal))))))) + cookies-list cache) + ;; Move to start. + (cond (all (goto-char (point-min))) + (within-inlinetask (org-back-to-heading t)) + (t (org-with-limited-levels (outline-previous-heading)))) + ;; Build an alist for each cookie found. The key is the position + ;; at beginning of cookie and values ending position, format of + ;; cookie, number of checked boxes to report and total number of + ;; boxes. + (while (re-search-forward cookie-re end t) + (let ((context (save-excursion (backward-char) + (save-match-data (org-element-context))))) + (when (and (org-element-type-p context 'statistics-cookie) + (not (string-match-p "\\" cookie-data))) + (push + (append + (list (match-beginning 1) (match-end 1) (match-end 2)) + (let* ((container + (org-element-lineage + context + '(drawer center-block dynamic-block inlinetask item + quote-block special-block verse-block))) + (beg (if container + (org-element-contents-begin container) (save-excursion - (org-with-limited-levels (outline-next-heading)) - (point)))) - structs) - (while (re-search-forward box-re end t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'item) - (push (org-element-property :structure element) - structs) - ;; Skip whole list since we have its - ;; structure anyway. - (while (setq element (org-element-lineage - element '(plain-list))) - (goto-char - (min (org-element-property :end element) - end)))))) - ;; Cache count for cookies applying to the same - ;; area. Then return it. - (let ((count - (funcall count-boxes - (and (eq (org-element-type container) - 'item) - (org-element-property - :begin container)) - structs - recursivep))) - (push (cons beg count) cache) - count)))))) - cookies-list)))) - ;; Apply alist to buffer. - (dolist (cookie cookies-list) - (let* ((beg (car cookie)) - (end (nth 1 cookie)) - (percent (nth 2 cookie)) - (checked (nth 3 cookie)) - (total (nth 4 cookie))) - (goto-char beg) - (insert - (if percent (format "[%d%%]" (floor (* 100.0 checked) - (max 1 total))) - (format "[%d/%d]" checked total))) - (delete-region (point) (+ (point) (- end beg))) - (when org-auto-align-tags (org-fix-tags-on-the-fly))))))) + (org-with-limited-levels + (outline-previous-heading)) + (point))))) + (or (cdr (assq beg cache)) + (save-excursion + (goto-char beg) + (let ((end + (if container + (org-element-contents-end container) + (save-excursion + (org-with-limited-levels (outline-next-heading)) + (point)))) + structs) + (while (re-search-forward box-re end t) + (let ((element (org-element-at-point))) + (when (org-element-type-p element 'item) + (push (org-element-property :structure element) + structs) + ;; Skip whole list since we have its + ;; structure anyway. + (while (setq element (org-element-lineage + element 'plain-list)) + (goto-char + (min (org-element-end element) + end)))))) + ;; Cache count for cookies applying to the same + ;; area. Then return it. + (let ((count + (funcall count-boxes + (and (org-element-type-p + container 'item) + (org-element-property + :begin container)) + structs + recursivep))) + (push (cons beg count) cache) + count)))))) + cookies-list)))) + ;; Apply alist to buffer. + (dolist (cookie cookies-list) + (let* ((beg (car cookie)) + (end (nth 1 cookie)) + (percent (nth 2 cookie)) + (checked (nth 3 cookie)) + (total (nth 4 cookie))) + (goto-char beg) + (org-fold-core-ignore-modifications + (insert-and-inherit + (if percent (format "[%d%%]" (floor (* 100.0 checked) + (max 1 total))) + (format "[%d/%d]" checked total))) + (delete-region (point) (+ (point) (- end beg)))) + (when org-auto-align-tags (org-fix-tags-on-the-fly)))))))) (defun org-get-checkbox-statistics-face () "Select the face for checkbox statistics. @@ -2637,7 +2672,9 @@ Otherwise it will be `org-todo'." (defun org-update-checkbox-count-maybe (&optional all) "Update checkbox statistics unless turned off by user. -With an optional argument ALL, update them in the whole buffer." +With an optional argument ALL, update them in the whole buffer. +When ALL is symbol `narrow', update statistics only in the accessible +portion of the buffer." (when (cdr (assq 'checkbox org-list-automatic-rules)) (org-update-checkbox-count all)) (run-hooks 'org-checkbox-statistics-hook)) @@ -2688,7 +2725,8 @@ Return t if successful." (no-subtree (1+ (line-beginning-position))) (t (org-list-get-item-end (line-beginning-position) struct)))))) (let* ((beg (marker-position org-last-indent-begin-marker)) - (end (marker-position org-last-indent-end-marker))) + (end (marker-position org-last-indent-end-marker)) + (deactivate-mark nil)) (cond ;; Special case: moving top-item with indent rule. (specialp @@ -2941,7 +2979,7 @@ function is being called interactively." (error "Missing key extractor")))) (sort-func (cond - ((= dcst ?a) #'string-collate-lessp) + ((= dcst ?a) #'org-string<) ((= dcst ?f) (or compare-func (and interactive? @@ -2959,7 +2997,7 @@ function is being called interactively." (now (current-time)) (next-record (lambda () (skip-chars-forward " \r\t\n") - (or (eobp) (beginning-of-line)))) + (or (eobp) (forward-line 0)))) (end-record (lambda () (goto-char (org-list-get-item-end-before-blank (point) struct)))) @@ -3030,28 +3068,25 @@ With a prefix argument ARG, change the region in a single item." (save-excursion (while (re-search-forward org-footnote-definition-re end t) (setq element (org-element-at-point)) - (when (eq 'footnote-definition - (org-element-type element)) + (when (org-element-type-p element 'footnote-definition) (push (buffer-substring-no-properties - (org-element-property :begin element) - (org-element-property :end element)) + (org-element-begin element) + (org-element-end element)) definitions) ;; Ensure at least 2 blank lines after the last ;; footnote definition, thus not slurping the ;; following element. - (unless (<= 2 (org-element-property - :post-blank - (org-element-at-point))) + (unless (<= 2 (org-element-post-blank + (org-element-at-point))) (setf (car definitions) (concat (car definitions) (make-string - (- 2 (org-element-property - :post-blank + (- 2 (org-element-post-blank (org-element-at-point))) ?\n)))) (delete-region - (org-element-property :begin element) - (org-element-property :end element)))) + (org-element-begin element) + (org-element-end element)))) definitions)))) (shift-text (lambda (ind end) @@ -3158,8 +3193,8 @@ With a prefix argument ARG, change the region in a single item." "[X]" "[ ]")) (org-list-write-struct struct - (org-list-parents-alist struct) - old))) + (org-list-parents-alist struct) + old))) ;; Ensure all text down to END (or SECTION-END) belongs ;; to the newly created item. (let ((section-end (save-excursion @@ -3171,7 +3206,7 @@ With a prefix argument ARG, change the region in a single item." (when footnote-definitions (goto-char end) ;; Insert footnote definitions after the list. - (unless (bolp) (beginning-of-line 2)) + (unless (bolp) (forward-line 1)) ;; At (point-max). (unless (bolp) (insert "\n")) (dolist (def footnote-definitions) @@ -3198,13 +3233,12 @@ With a prefix argument ARG, change the region in a single item." (when footnote-definitions ;; If the new list is followed by same-level items, ;; move past them as well. - (goto-char (org-element-property - :end + (goto-char (org-element-end (org-element-lineage (org-element-at-point (1- end)) - '(plain-list) t))) + 'plain-list t))) ;; Insert footnote definitions after the list. - (unless (bolp) (beginning-of-line 2)) + (unless (bolp) (forward-line 1)) ;; At (point-max). (unless (bolp) (insert "\n")) (dolist (def footnote-definitions) @@ -3333,7 +3367,7 @@ Valid parameters are: :backend, :raw - Export back-end used as a basis to transcode elements of the + Export backend used as a basis to transcode elements of the list, when no specific parameter applies to it. It is also used to translate its contents. You can prevent this by setting :raw property to a non-nil value. @@ -3421,7 +3455,7 @@ Valid parameters are: (if (consp e) (funcall insert-list e) (insert e) (insert "\n"))) - (beginning-of-line) + (forward-line 0) (save-excursion (let ((ind (if (eq type 'ordered) 3 2))) (while (> (point) start) @@ -3441,7 +3475,7 @@ Valid parameters are: (when (and backend (plist-get params :raw)) (org-element-map data org-element-all-objects (lambda (object) - (org-element-set-element + (org-element-set object (org-element-interpret-data object))))) ;; We use a low-level mechanism to export DATA so as to skip all ;; usual pre-processing and post-processing, i.e., hooks, filters, @@ -3454,7 +3488,7 @@ Valid parameters are: (defun org-list--depth (element) "Return the level of ELEMENT within current plain list. ELEMENT is either an item or a plain list." - (cl-count-if (lambda (ancestor) (eq (org-element-type ancestor) 'plain-list)) + (cl-count-if (lambda (ancestor) (org-element-type-p ancestor 'plain-list)) (org-element-lineage element nil t))) (defun org-list--trailing-newlines (string) @@ -3531,7 +3565,7 @@ PARAMS is a plist used to tweak the behavior of the transcoder." (ddend (plist-get params :ddend))) (lambda (item contents info) (let* ((type - (org-element-property :type (org-element-property :parent item))) + (org-element-property :type (org-element-parent item))) (tag (org-element-property :tag item)) (depth (org-list--depth item)) (separator (and (org-export-get-next-element item info) diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index fe3bbc658ff..d213435304c 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -57,14 +57,17 @@ (declare-function org-collect-keywords "org" (keywords &optional unique directory)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-copy "org-element" (datum)) +(declare-function org-element-copy "org-element-ast" (datum)) (declare-function org-element-macro-parser "org-element" ()) (declare-function org-element-keyword-parser "org-element" (limit affiliated)) -(declare-function org-element-put-property "org-element" (element property value)) +(declare-function org-element-put-property "org-element-ast" (node property value)) (declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) -(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-begin "org-element" (node)) +(declare-function org-element-end "org-element" (node)) (declare-function org-element-restriction "org-element" (element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-file-contents "org" (file &optional noerror nocache)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance element)) @@ -261,7 +264,7 @@ a definition in TEMPLATES." (org-element-put-property macro :parent nil) (let* ((key (org-element-property :key macro)) (value (org-macro-expand macro templates)) - (begin (org-element-property :begin macro)) + (begin (org-element-begin macro)) (signature (list begin macro (org-element-property :args macro)))) @@ -275,7 +278,7 @@ a definition in TEMPLATES." (delete-region begin ;; Preserve white spaces after the macro. - (progn (goto-char (org-element-property :end macro)) + (progn (goto-char (org-element-end macro)) (skip-chars-backward " \t") (point))) ;; Leave point before replacement in case of @@ -337,14 +340,14 @@ Return a list of arguments, as strings. This is the opposite of "Find PROPERTY's value at LOCATION. PROPERTY is a string. LOCATION is a search string, as expected by `org-link-search', or the empty string." - (save-excursion - (when (org-string-nw-p location) - (condition-case _ - (let ((org-link-search-must-match-exact-headline t)) - (org-link-search location nil t)) - (error - (error "Macro property failed: cannot find location %s" location)))) - (org-entry-get nil property 'selective))) + (org-with-wide-buffer + (when (org-string-nw-p location) + (condition-case _ + (let ((org-link-search-must-match-exact-headline t)) + (org-link-search location nil t)) + (error + (error "Macro property failed: cannot find location %s" location)))) + (org-entry-get nil property 'selective))) (defun org-macro--find-keyword-value (name &optional collect) "Find value for keyword NAME in current buffer. @@ -359,7 +362,7 @@ in the buffer." (catch :exit (while (re-search-forward regexp nil t) (let ((element (org-with-point-at (match-beginning 0) (org-element-keyword-parser (line-end-position) (list (match-beginning 0)))))) - (when (eq 'keyword (org-element-type element)) + (when (org-element-type-p element 'keyword) (let ((value (org-element-property :value element))) (if (not collect) (throw :exit value) (setq result (concat result " " value))))))) @@ -373,10 +376,13 @@ Return value as a string." value (org-element-restriction 'keyword)))) (if (and (consp date) (not (cdr date)) - (eq 'timestamp (org-element-type (car date)))) + (org-element-type-p (car date) 'timestamp)) (format "(eval (if (org-string-nw-p $1) %s %S))" (format "(org-format-timestamp '%S $1)" - (org-element-copy (car date))) + (org-element-put-property + (org-element-copy (car date)) + ;; Remove non-printable. + :buffer nil)) value) value))) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index aafbdf0e0aa..555ff44a330 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -113,16 +113,24 @@ Version mismatch is commonly encountered in the following situations: (declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p)) (declare-function org-fold-core-with-forced-fontification "org-fold" (&rest body)) (declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p)) -(declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case)) -(declare-function org-time-convert-to-integer "org-compat" (time)) +(declare-function org-time-convert-to-list "org-compat" (time)) +(declare-function org-buffer-text-pixel-width "org-compat" ()) (defvar org-ts-regexp0) (defvar ffap-url-regexp) -(defvar org-fold-core-style) ;;; Macros +(defmacro org-require-package (symbol &optional name noerror) + "Try to load library SYMBOL and display error otherwise. +With optional parameter NAME, use NAME as package name instead of +SYMBOL. Show warning instead of error when NOERROR is non-nil." + `(unless (require ,symbol nil t) + (,(if noerror 'warn 'user-error) + "`%s' failed to load required package \"%s\"" + this-command ,(or name symbol)))) + (defmacro org-with-gensyms (symbols &rest body) (declare (debug (sexp body)) (indent 1)) `(let ,(mapcar (lambda (s) @@ -151,19 +159,29 @@ If BUFFER is nil, use base buffer for `current-buffer'." (or ,buffer (current-buffer))) ,@body)) -(defmacro org-with-point-at (pom &rest body) - "Move to buffer and point of point-or-marker POM for the duration of BODY." +(defmacro org-with-point-at (epom &rest body) + "Move to buffer and point of EPOM for the duration of BODY. +EPOM is an element, point, or marker." (declare (debug (form body)) (indent 1)) - (org-with-gensyms (mpom) - `(let ((,mpom ,pom)) + (require 'org-element-ast) + (org-with-gensyms (mepom) + `(let ((,mepom ,epom)) (save-excursion - (when (markerp ,mpom) (set-buffer (marker-buffer ,mpom))) + (cond + ((markerp ,mepom) + (set-buffer (marker-buffer ,mepom))) + ((numberp ,mepom)) + (t + (when (org-element-property :buffer ,mepom) + (set-buffer (org-element-property :buffer ,mepom))) + (setq ,mepom (org-element-property :begin ,mepom)))) (org-with-wide-buffer - (goto-char (or ,mpom (point))) + (goto-char (or ,mepom (point))) ,@body))))) (defmacro org-with-remote-undo (buffer &rest body) - "Execute BODY while recording undo information in two buffers." + "Execute BODY while recording undo information in current buffer and BUFFER. +This function is only useful when called from Agenda buffer." (declare (debug (form body)) (indent 1)) (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2) `(let ((,cline (org-current-line)) @@ -195,7 +213,7 @@ If BUFFER is nil, use base buffer for `current-buffer'." (defalias 'org-save-outline-visibility #'org-fold-save-outline-visibility) (defmacro org-with-wide-buffer (&rest body) - "Execute body while temporarily widening the buffer." + "Execute BODY while temporarily widening the buffer." (declare (debug (body))) `(save-excursion (save-restriction @@ -213,7 +231,7 @@ If BUFFER is nil, use base buffer for `current-buffer'." (let* ((org-called-with-limited-levels t) (org-outline-regexp (org-get-limited-outline-regexp)) (outline-regexp org-outline-regexp) - (org-outline-regexp-bol (concat "^" org-outline-regexp))) + (org-outline-regexp-bol (org-get-limited-outline-regexp t))) ,@body))) (defmacro org-eval-in-environment (environment form) @@ -249,11 +267,7 @@ If BUFFER is nil, use base buffer for `current-buffer'." (unless modified (restore-buffer-modified-p nil)))))))) -(defmacro org-no-popups (&rest body) - "Suppress popup windows and evaluate BODY." - `(let (pop-up-frames pop-up-windows) - ,@body)) - +;;;###autoload (defmacro org-element-with-disabled-cache (&rest body) "Run BODY without active org-element-cache." (declare (debug (form body)) (indent 0)) @@ -270,17 +284,36 @@ If BUFFER is nil, use base buffer for `current-buffer'." buffer))) (defun org-find-base-buffer-visiting (file) - "Like `find-buffer-visiting' but always return the base buffer and -not an indirect buffer." + "Like `find-buffer-visiting' but always return the base buffer. +FILE is the file name passed to `find-buffer-visiting'." (let ((buf (or (get-file-buffer file) (find-buffer-visiting file)))) (org-base-buffer buf))) -(defun org-switch-to-buffer-other-window (&rest args) - "Switch to buffer in a second window on the current frame. -In particular, do not allow pop-up frames. -Returns the newly created buffer." - (org-no-popups (apply #'switch-to-buffer-other-window args))) +(defvar-local org-file-buffer-created nil + "Non-nil when current buffer is created from `org-with-file-buffer'. +The value is FILE argument passed to `org-with-file-buffer'.") +(defmacro org-with-file-buffer (file &rest body) + "Evaluate BODY with current buffer visiting FILE. +When no live buffer is visiting FILE, create one and kill after +evaluating BODY. +During evaluation, when the buffer was created, `org-file-buffer-created' +variable is set to FILE." + (declare (debug (form body)) (indent 1)) + (org-with-gensyms (mark-function filename buffer) + `(let ((,mark-function (lambda () (setq-local org-file-buffer-created ,file))) + (,filename ,file) + ,buffer) + (add-hook 'find-file-hook ,mark-function) + (unwind-protect + (progn + (setq ,buffer (find-file-noselect ,filename t)) + (with-current-buffer ,buffer + (prog1 (progn ,@body) + (with-current-buffer ,buffer + (when (equal ,filename org-file-buffer-created) + (kill-buffer)))))) + (remove-hook 'find-file-hook ,mark-function))))) (defun org-fit-window-to-buffer (&optional window max-height min-height shrink-only) @@ -358,72 +391,6 @@ in target-prerequisite files relation." (let ((mtime (file-attribute-modification-time (file-attributes file)))) (and mtime (or (not time) (time-less-p time mtime))))) -(defun org-compile-file (source process ext &optional err-msg log-buf spec) - "Compile a SOURCE file using PROCESS. - -PROCESS is either a function or a list of shell commands, as -strings. EXT is a file extension, without the leading dot, as -a string. It is used to check if the process actually succeeded. - -PROCESS must create a file with the same base name and directory -as SOURCE, but ending with EXT. The function then returns its -filename. Otherwise, it raises an error. The error message can -then be refined by providing string ERR-MSG, which is appended to -the standard message. - -If PROCESS is a function, it is called with a single argument: -the SOURCE file. - -If it is a list of commands, each of them is called using -`shell-command'. By default, in each command, %b, %f, %F, %o and -%O are replaced with, respectively, SOURCE base name, name, full -name, directory and absolute output file name. It is possible, -however, to use more place-holders by specifying them in optional -argument SPEC, as an alist following the pattern - - (CHARACTER . REPLACEMENT-STRING). - -When PROCESS is a list of commands, optional argument LOG-BUF can -be set to a buffer or a buffer name. `shell-command' then uses -it for output." - (let* ((base-name (file-name-base source)) - (full-name (file-truename source)) - (relative-name (file-relative-name source)) - (out-dir (if (file-name-directory source) - ;; Expand "~". Shell expansion will be disabled - ;; in the shell command call. - (file-name-directory full-name) - "./")) - (output (expand-file-name (concat base-name "." ext) out-dir)) - (time (file-attribute-modification-time (file-attributes output))) - (err-msg (if (stringp err-msg) (concat ". " err-msg) ""))) - (save-window-excursion - (pcase process - ((pred functionp) (funcall process (shell-quote-argument relative-name))) - ((pred consp) - (let ((log-buf (and log-buf (get-buffer-create log-buf))) - (spec (append spec - `((?b . ,(shell-quote-argument base-name)) - (?f . ,(shell-quote-argument relative-name)) - (?F . ,(shell-quote-argument full-name)) - (?o . ,(shell-quote-argument out-dir)) - (?O . ,(shell-quote-argument output)))))) - ;; Combine output of all commands in PROCESS. - (with-current-buffer log-buf - (let (buffer-read-only) - (erase-buffer))) - (let ((shell-command-dont-erase-buffer t)) - (dolist (command process) - (shell-command (format-spec command spec) log-buf))) - (when log-buf (with-current-buffer log-buf (compilation-mode))))) - (_ (error "No valid command to process %S%s" source err-msg)))) - ;; Check for process failure. Output file is expected to be - ;; located in the same directory as SOURCE. - (unless (org-file-newer-than-p output time) - (error (format "File %S wasn't produced%s" output err-msg))) - output)) - - ;;; Indentation @@ -434,6 +401,8 @@ it for output." (defun org-do-remove-indentation (&optional n skip-fl) "Remove the maximum common indentation from the buffer. +Do not consider invisible text when calculating indentation. + When optional argument N is a positive integer, remove exactly that much characters from indentation, if possible. When optional argument SKIP-FL is non-nil, skip the first @@ -454,10 +423,14 @@ line. Return nil if it fails." ;; Remove exactly N indentation, but give up if not possible. (when skip-fl (forward-line)) (while (not (eobp)) - (let ((ind (progn (skip-chars-forward " \t") (current-column)))) - (cond ((eolp) (delete-region (line-beginning-position) (point))) - ((< ind n) (throw :exit nil)) - (t (indent-line-to (- ind n)))) + (let* ((buffer-invisibility-spec nil) ; do not treat invisible text specially + (ind (progn (skip-chars-forward " \t") (current-column)))) + (cond ((< ind n) + (if (eolp) (delete-region (line-beginning-position) (point)) + (throw :exit nil))) + (t (delete-region (line-beginning-position) + (progn (move-to-column n t) + (point))))) (forward-line))) ;; Signal success. t)))) @@ -476,7 +449,7 @@ error when the user input is empty." (allow-empty? nil) (t (user-error "Empty input is not valid"))))) -(declare-function org-time-stamp-inactive "org" (&optional arg)) +(declare-function org-timestamp-inactive "org" (&optional arg)) (defun org-completing-read (&rest args) "Completing-read with SPACE being a normal character." @@ -486,7 +459,7 @@ error when the user input is empty." (define-key minibuffer-local-completion-map " " #'self-insert-command) (define-key minibuffer-local-completion-map "?" #'self-insert-command) (define-key minibuffer-local-completion-map (kbd "C-c !") - #'org-time-stamp-inactive) + #'org-timestamp-inactive) (apply #'completing-read args))) (defun org--mks-read-key (allowed-keys prompt navigation-keys) @@ -535,7 +508,7 @@ alist with (\"key\" \"description\") entries. When one of these is selected, only the bare key is returned." (save-window-excursion (let ((inhibit-quit t) - (buffer (org-switch-to-buffer-other-window "*Org Select*")) + (buffer (switch-to-buffer-other-window "*Org Select*")) (prompt (or prompt "Select: ")) case-fold-search current) @@ -599,7 +572,10 @@ is selected, only the bare key is returned." ;; selection prefix. ((assoc current specials) (throw 'exit current)) (t (error "No entry available"))))))) - (when buffer (kill-buffer buffer)))))) + (when buffer + (when-let ((window (get-buffer-window buffer t))) + (quit-window 'kill window)) + (kill-buffer buffer)))))) ;;; List manipulation @@ -781,46 +757,100 @@ get an unnecessary O(N²) space complexity, so you're usually better off using (defun org-eval (form) "Eval FORM and return result." - (condition-case error + (condition-case-unless-debug error (eval form t) (error (format "%%![Error: %s]" error)))) +(defvar org--headline-re-cache-no-bol nil + "Plist holding association between headline level regexp.") +(defvar org--headline-re-cache-bol nil + "Plist holding association between headline level regexp.") +(defsubst org-headline-re (true-level &optional no-bol) + "Generate headline regexp for TRUE-LEVEL. +When NO-BOL is non-nil, regexp will not demand the regexp to start at +beginning of line." + (or (plist-get + (if no-bol + org--headline-re-cache-no-bol + org--headline-re-cache-bol) + true-level) + (let ((re (rx-to-string + (if no-bol + `(seq (** 1 ,true-level "*") " ") + `(seq line-start (** 1 ,true-level "*") " "))))) + (if no-bol + (setq org--headline-re-cache-no-bol + (plist-put + org--headline-re-cache-no-bol + true-level re)) + (setq org--headline-re-cache-bol + (plist-put + org--headline-re-cache-bol + true-level re))) + re))) + (defvar org-outline-regexp) ; defined in org.el +(defvar org-outline-regexp-bol) ; defined in org.el (defvar org-odd-levels-only) ; defined in org.el (defvar org-inlinetask-min-level) ; defined in org-inlinetask.el -(defun org-get-limited-outline-regexp () +(defun org-get-limited-outline-regexp (&optional with-bol) "Return outline-regexp with limited number of levels. -The number of levels is controlled by `org-inlinetask-min-level'." +The number of levels is controlled by `org-inlinetask-min-level'. +Match at beginning of line when WITH-BOL is non-nil." (cond ((not (derived-mode-p 'org-mode)) - outline-regexp) + (if (string-prefix-p "^" outline-regexp) + (if with-bol outline-regexp (substring outline-regexp 1)) + (if with-bol (concat "^" outline-regexp) outline-regexp))) ((not (featurep 'org-inlinetask)) - org-outline-regexp) + (if with-bol org-outline-regexp-bol org-outline-regexp)) (t (let* ((limit-level (1- org-inlinetask-min-level)) (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) - (format "\\*\\{1,%d\\} " nstars))))) + (org-headline-re nstars (not with-bol)))))) (defun org--line-empty-p (n) - "Is the Nth next line empty? -Counts the current line as N = 1 and the previous line as N = 0; -see `beginning-of-line'." + "Is the Nth next line empty?" (and (not (bobp)) (save-excursion - (beginning-of-line n) - (looking-at-p "[ \t]*$")))) + (forward-line n) + (skip-chars-forward "[ \t]") + (eolp)))) (defun org-previous-line-empty-p () "Is the previous line a blank line? When NEXT is non-nil, check the next line instead." - (org--line-empty-p 0)) + (org--line-empty-p -1)) (defun org-next-line-empty-p () "Is the previous line a blank line? When NEXT is non-nil, check the next line instead." - (org--line-empty-p 2)) - + (org--line-empty-p 1)) + +(defun org-id-uuid () + "Return string with random (version 4) UUID." + (let ((rnd (md5 (format "%s%s%s%s%s%s%s" + (random) + (org-time-convert-to-list nil) + (user-uid) + (emacs-pid) + (user-full-name) + user-mail-address + (recent-keys))))) + (format "%s-%s-4%s-%s%s-%s" + (substring rnd 0 8) + (substring rnd 8 12) + (substring rnd 13 16) + (format "%x" + (logior + #b10000000 + (logand + #b10111111 + (string-to-number + (substring rnd 16 18) 16)))) + (substring rnd 18 20) + (substring rnd 20 32)))) ;;; Motion @@ -887,14 +917,14 @@ Return nil when PROP is not set at POS." (<= (match-beginning n) pos) (>= (match-end n) pos))) -(defun org-skip-whitespace () +(defsubst org-skip-whitespace () "Skip over space, tabs and newline characters." (skip-chars-forward " \t\n\r")) (defun org-match-line (regexp) "Match REGEXP at the beginning of the current line." (save-excursion - (beginning-of-line) + (forward-line 0) (looking-at regexp))) (defun org-match-any-p (re list) @@ -916,7 +946,7 @@ match." (let ((pos (point)) (eol (line-end-position (if nlines (1+ nlines) 1)))) (save-excursion - (beginning-of-line (- 1 (or nlines 0))) + (forward-line (- (or nlines 0))) (while (and (re-search-forward regexp eol t) (<= (match-beginning 0) pos)) (let ((end (match-end 0))) @@ -940,23 +970,79 @@ return nil." (require 'ffap) (and ffap-url-regexp (string-match-p ffap-url-regexp s))) - -;;; String manipulation +(defconst org-uuid-regexp + "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" + "Regular expression matching a universal unique identifier (UUID).") -(defun org-string< (a b) - (string-collate-lessp a b)) +(defun org-uuidgen-p (s) + "Is S an ID created by UUIDGEN?" + (string-match org-uuid-regexp (downcase s))) -(defun org-string<= (a b) - (or (string= a b) (string-collate-lessp a b))) -(defun org-string>= (a b) - (not (string-collate-lessp a b))) + +;;; String manipulation -(defun org-string> (a b) +(defcustom org-sort-function #'string-collate-lessp + "Function used to compare strings when sorting. +This function affects how Org mode sorts headlines, agenda items, +table lines, etc. + +The function must accept either 2 or 4 arguments: strings to compare +and, optionally, LOCALE and IGNORE-CASE - locale name and flag to make +comparison case-insensitive. + +The default value uses sorting rules according to OS language. Users +who want to make sorting language-independent, may customize the value +to `org-sort-function-fallback'. + +Note that some string sorting rules are known to be not accurate on +MacOS. See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=59275. +MacOS users may customize the value to +`org-sort-function-fallback'." + :group 'org + :package-version '(Org . "9.7") + :type '(choice + (const :tag "According to OS language" string-collate-lessp) + (const :tag "Using string comparison" org-sort-function-fallback) + (function :tag "Custom function"))) + +(defun org-sort-function-fallback (a b &optional _ ignore-case) + "Return non-nil when downcased string A < string B. +Use `compare-strings' for comparison. Honor IGNORE-CASE." + (let ((ans (compare-strings a nil nil b nil nil ignore-case))) + (cond + ((and (numberp ans) (< ans 0)) t) + (t nil)))) + +(defun org-string< (a b &optional locale ignore-case) + "Return non-nil when string A < string B. +LOCALE is the locale name. IGNORE-CASE, when non-nil, makes comparison +ignore case." + (if (= 4 (cdr (func-arity org-sort-function))) + (funcall org-sort-function a b locale ignore-case) + (funcall org-sort-function a b))) + +(defun org-string<= (a b &optional locale ignore-case) + "Return non-nil when string A <= string B. +LOCALE is the locale name. IGNORE-CASE, when non-nil, makes comparison +ignore case." + (or (string= a b) (org-string< a b locale ignore-case))) + +(defun org-string>= (a b &optional locale ignore-case) + "Return non-nil when string A >= string B. +LOCALE is the locale name. IGNORE-CASE, when non-nil, makes comparison +ignore case." + (not (org-string< a b locale ignore-case))) + +(defun org-string> (a b &optional locale ignore-case) + "Return non-nil when string A > string B. +LOCALE is the locale name. IGNORE-CASE, when non-nil, makes comparison +ignore case." (and (not (string= a b)) - (not (string-collate-lessp a b)))) + (not (org-string< a b locale ignore-case)))) (defun org-string<> (a b) + "Return non-nil when string A and string B are not equal." (not (string= a b))) (defsubst org-trim (s &optional keep-lead) @@ -1065,9 +1151,11 @@ Results may be off sometimes if it cannot handle a given `display' value." (org--string-from-props string 'display 0 (length string))) -(defun org-string-width (string &optional pixels) +(defun org-string-width (string &optional pixels default-face) "Return width of STRING when displayed in the current buffer. -Return width in pixels when PIXELS is non-nil." +Return width in pixels when PIXELS is non-nil. +When PIXELS is nil, DEFAULT-FACE is the face used to calculate relative +STRING width. When REFERENCE-FACE is nil, `default' face is used." (if (and (version< emacs-version "28") (not pixels)) ;; FIXME: Fallback to old limited version, because ;; `window-pixel-width' is buggy in older Emacs. @@ -1082,7 +1170,7 @@ Return width in pixels when PIXELS is non-nil." ;; is critical to get right string width from pixel width (not needed ;; when PIXELS are requested though). (unless pixels - (remove-text-properties 0 (length string) '(face t) string)) + (put-text-property 0 (length string) 'face (or default-face 'default) string)) (let (;; We need to remove the folds to make sure that folded table ;; alignment is not messed up. (current-invisibility-spec @@ -1102,8 +1190,10 @@ Return width in pixels when PIXELS is non-nil." (push el result))) result))) (current-char-property-alias-alist char-property-alias-alist)) - (with-temp-buffer + (with-current-buffer (get-buffer-create " *Org string width*") (setq-local display-line-numbers nil) + (setq-local line-prefix nil) + (setq-local wrap-prefix nil) (setq-local buffer-invisibility-spec (if (listp current-invisibility-spec) (mapcar (lambda (el) @@ -1121,52 +1211,26 @@ Return width in pixels when PIXELS is non-nil." (with-silent-modifications (erase-buffer) (insert string) - (setq pixel-width - (if (get-buffer-window (current-buffer)) - (car (window-text-pixel-size - ;; FIXME: 10000 because - ;; `most-positive-fixnum' ain't working - ;; (tests failing) and this call will be - ;; removed after we drop Emacs 28 support - ;; anyway. - nil (line-beginning-position) (point-max) 10000)) - (let ((dedicatedp (window-dedicated-p)) - (oldbuffer (window-buffer))) - (unwind-protect - (progn - ;; Do not throw error in dedicated windows. - (set-window-dedicated-p nil nil) - (set-window-buffer nil (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max) 10000))) - (set-window-buffer nil oldbuffer) - (set-window-dedicated-p nil dedicatedp))))) + (setq pixel-width (org-buffer-text-pixel-width)) (unless pixels (erase-buffer) - (insert "a") - (setq symbol-width - (if (get-buffer-window (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max) 10000)) - (let ((dedicatedp (window-dedicated-p)) - (oldbuffer (window-buffer))) - (unwind-protect - (progn - ;; Do not throw error in dedicated windows. - (set-window-dedicated-p nil nil) - (set-window-buffer nil (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max) 10000))) - (set-window-buffer nil oldbuffer) - (set-window-dedicated-p nil dedicatedp))))))) + (insert (propertize "a" 'face (or default-face 'default))) + (setq symbol-width (org-buffer-text-pixel-width)))) (if pixels pixel-width - (/ pixel-width symbol-width))))))) + (ceiling pixel-width symbol-width))))))) (defmacro org-current-text-column () - "Like `current-column' but ignore display properties." - `(string-width (buffer-substring-no-properties - (line-beginning-position) (point)))) + "Like `current-column' but ignore display properties. +Throw an error when `tab-width' is not 8. + +This function forces `tab-width' value because it is used as a part of +the parser, to ensure parser consistency when calculating list +indentation." + `(progn + (unless (= 8 tab-width) (error "Tab width in Org files must be 8, not %d. Please adjust your `tab-width' settings for Org mode." tab-width)) + (string-width (buffer-substring-no-properties + (line-beginning-position) (point))))) (defun org-not-nil (v) "If V not nil, and also not the string \"nil\", then return V. @@ -1227,6 +1291,10 @@ Assumes that s is a single line, starting in column 0." t t s))) s) +(defun org-remove-blank-lines (s) + "Remove blank lines in S." + (replace-regexp-in-string (rx "\n" (1+ (0+ space) "\n")) "\n" s)) + (defun org-wrap (string &optional width lines) "Wrap string to either a number of lines, or a width in characters. If WIDTH is non-nil, the string is wrapped to that width, however many lines @@ -1553,6 +1621,9 @@ Return 0. if S is not recognized as a valid value." ((string-match org-ts-regexp0 s) (org-2ft s)) (t 0.))))) + +;;; Misc + (defun org-scroll (key &optional additional-keys) "Receive KEY and scroll the current window accordingly. When ADDITIONAL-KEYS is not nil, also include SPC and DEL in the @@ -1589,6 +1660,158 @@ Credit: https://stackoverflow.com/questions/11871245/knuth-multiplicative-hash#4 (cl-assert (and (<= 0 base 32))) (ash (* number 2654435769) (- base 32))) +(defvar org-sxhash-hashes (make-hash-table :weakness 'key :test 'equal)) +(defvar org-sxhash-objects (make-hash-table :weakness 'value)) +(defun org-sxhash-safe (obj &optional counter) + "Like `sxhash' for OBJ, but collision-free for in-memory objects. +When COUNTER is non-nil, return safe hash for (COUNTER . OBJ)." + ;; Note: third-party code may modify OBJ by side effect. + ;; Should not affect anything as long as `org-sxhash-safe' + ;; is used to calculate hash. + (or (and (not counter) (gethash obj org-sxhash-hashes)) + (let* ((hash (sxhash (if counter (cons counter obj) obj))) + (obj-old (gethash hash org-sxhash-objects))) + (if obj-old ; collision + (org-sxhash-safe obj (if counter (1+ counter) 1)) + ;; No collision. Remember and return normal hash. + (puthash hash obj org-sxhash-objects) + (puthash obj hash org-sxhash-hashes))))) + +(defun org-compile-file (source process ext &optional err-msg log-buf spec) + "Compile a SOURCE file using PROCESS. + +See `org-compile-file-commands' for information on PROCESS, EXT, and SPEC. +If PROCESS fails, an error will be raised. The error message can +then be refined by providing string ERR-MSG, which is appended to +the standard message. + +PROCESS must create a file with the same base name and directory +as SOURCE, but ending with EXT. The function then returns its +filename. Otherwise, it raises an error. + +When PROCESS is a list of commands, optional argument LOG-BUF can +be set to a buffer or a buffer name. `shell-command' then uses +it for output." + (let* ((commands (org-compile-file-commands source process ext spec err-msg)) + (output (concat (file-name-sans-extension source) "." ext)) + ;; Resolve symlinks in default-directory to correctly handle + ;; absolute source paths or relative paths with .. + (relname (if (file-name-absolute-p source) + (let ((pwd (file-truename default-directory))) + (file-relative-name source pwd)) + source)) + (log-buf (and log-buf (get-buffer-create log-buf))) + (time (file-attribute-modification-time (file-attributes output)))) + (save-window-excursion + (dolist (command commands) + (cond + ((functionp command) + (funcall command (shell-quote-argument relname))) + ((stringp command) + (let ((shell-command-dont-erase-buffer t)) + (shell-command command log-buf)))))) + ;; Check for process failure. Output file is expected to be + ;; located in the same directory as SOURCE. + (unless (org-file-newer-than-p output time) + (ignore (defvar org-batch-test)) + ;; Display logs when running tests. + (when (bound-and-true-p org-batch-test) + (message "org-compile-file log ::\n-----\n%s\n-----\n" + (with-current-buffer log-buf (buffer-string)))) + (error + (format + "File %S wasn't produced%s" + output + (if (org-string-nw-p err-msg) + (concat " " (org-trim err-msg)) + err-msg)))) + output)) + +(defun org-compile-file-commands (source process ext &optional spec err-msg) + "Return list of commands used to compile SOURCE file. + +The commands are formed from PROCESS, which is either a function or +a list of shell commands, as strings. EXT is a file extension, without +the leading dot, as a string. After PROCESS has been executed, +a file with the same basename and directory as SOURCE but with the +file extension EXT is expected to be produced. +Failure to produce this file will be interpreted as PROCESS failing. + +If PROCESS is a function, it is called with a single argument: +the SOURCE file. + +If PROCESS is a list of commands, each of them is called using +`shell-command'. By default, in each command, %b, %f, %F, %o and +%O are replaced with, respectively, SOURCE base name, relative +file name, absolute file name, relative directory and absolute +output file name. It is possible, however, to use more +place-holders by specifying them in optional argument SPEC, as an +alist following the pattern + + (CHARACTER . REPLACEMENT-STRING). + +Throw an error if PROCESS does not satisfy the described patterns. +The error string will be appended with ERR-MSG, when it is a string." + (let* ((basename (file-name-base source)) + ;; Resolve symlinks in default-directory to correctly handle + ;; absolute source paths or relative paths with .. + (pwd (file-truename default-directory)) + (absname (expand-file-name source pwd)) + (relname (if (file-name-absolute-p source) + (file-relative-name source pwd) + source)) + (relpath (or (file-name-directory relname) "./")) + (output (concat (file-name-sans-extension absname) "." ext)) + (err-msg (if (stringp err-msg) (concat ". " err-msg) ""))) + (pcase process + ((pred functionp) (list process)) + ((pred consp) + (let ((spec (append spec + `((?b . ,(shell-quote-argument basename)) + (?f . ,(shell-quote-argument relname)) + (?F . ,(shell-quote-argument absname)) + (?o . ,(shell-quote-argument relpath)) + (?O . ,(shell-quote-argument output)))))) + (mapcar (lambda (command) (format-spec command spec)) process))) + (_ (error "No valid command to process %S%s" source err-msg))))) + +(defun org-display-buffer-split (buffer alist) + "Display BUFFER in the current frame split in two parts. +The frame will display two buffers - current buffer and BUFFER. +ALIST is an association list of action symbols and values. See +Info node `(elisp) Buffer Display Action Alists' for details of +such alists. + +Use `display-buffer-in-direction' internally. + +This is an action function for buffer display, see Info +node `(elisp) Buffer Display Action Functions'. It should be +called only by `display-buffer' or a function directly or +indirectly called by the latter." + (let ((window-configuration (current-window-configuration))) + (ignore-errors (delete-other-windows)) + (or (display-buffer-in-direction buffer alist) + (display-buffer-pop-up-window buffer alist) + (prog1 nil + (set-window-configuration window-configuration))))) + +(defun org-display-buffer-in-window (buffer alist) + "Display BUFFER in specific window. +The window is defined according to the `window' slot in the ALIST. +Then `same-frame' slot in the ALIST is set, only display buffer when +window is present in the current frame. + +This is an action function for buffer display, see Info +node `(elisp) Buffer Display Action Functions'. It should be +called only by `display-buffer' or a function directly or +indirectly called by the latter." + (let ((window (alist-get 'window alist))) + (when (and window + (window-live-p window) + (or (not (alist-get 'same-frame alist)) + (eq (window-frame) (window-frame window)))) + (window--display-buffer buffer window 'reuse alist)))) + (provide 'org-macs) ;; Local variables: diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index c34011fc3dc..82f97fd3635 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -470,7 +470,7 @@ agenda view showing the flagged items." (insert "#+TAGS: " (mapconcat 'identity tags " ") "\n") (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n") (when (file-exists-p (expand-file-name - org-mobile-directory "agendas.org")) + "agendas.org" org-mobile-directory)) (insert "* [[file:agendas.org][Agenda Views]]\n")) (pcase-dolist (`(,_ . ,link-name) files-alist) (insert (format "* [[file:%s][%s]]\n" link-name link-name))) @@ -627,11 +627,11 @@ The table of checksums is written to the file mobile-checksums." (setq short (get-text-property (point) 'short-heading)) (when (and short (looking-at ".+")) (replace-match short nil t) - (beginning-of-line 1)) + (forward-line 0)) (when app (end-of-line 1) (insert app) - (beginning-of-line 1)) + (forward-line 0)) (insert "* ")) ((get-text-property (point) 'org-agenda-date-header) (setq in-date t) @@ -649,7 +649,7 @@ The table of checksums is written to the file mobile-checksums." (line-end-position)))) (delete-region (line-beginning-position) (line-end-position)) (insert line "" prefix "") - (beginning-of-line 1)) + (forward-line 0)) (and (looking-at "[ \t]+") (replace-match ""))) (insert (if in-date "*** " "** ")) (end-of-line 1) @@ -666,7 +666,7 @@ The table of checksums is written to the file mobile-checksums." (org-mobile-get-outline-path-link m)))) (insert " :PROPERTIES:\n :ORIGINAL_ID: " id "\n :END:\n"))))) - (beginning-of-line 2)) + (forward-line 1)) (push (cons "agendas.org" (md5 (buffer-string))) org-mobile-checksum-files)) (message "Agenda written to Org file %s" file))) @@ -1057,7 +1057,7 @@ be returned that indicates what went wrong." (goto-char (match-beginning 4)) (insert new) (delete-region (point) (+ (point) (length current))) - (org-align-tags)) + (when org-auto-align-tags (org-align-tags))) (t (error "Heading changed in the mobile device and on the computer"))))))) @@ -1071,7 +1071,7 @@ be returned that indicates what went wrong." (end-of-line 1) (org-insert-heading-respect-content t) (org-demote)) - (beginning-of-line) + (forward-line 0) (insert "* ")) (insert new)) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 35d1b6f1ce1..6bc7f788fb9 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -185,8 +185,8 @@ Changing this variable requires a restart of Emacs to get activated." (const :tag "Activate checkboxes" activate-checkboxes))) (defun org-mouse-re-search-line (regexp) - "Search the current line for a given regular expression." - (beginning-of-line) + "Search the current line for a given regular expression REGEXP." + (forward-line 0) (re-search-forward regexp (line-end-position) t)) (defun org-mouse-end-headline () @@ -242,13 +242,13 @@ return `:middle'." (defun org-mouse-empty-line () "Return non-nil if the line contains only white space." - (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))) + (save-excursion (forward-line 0) (looking-at "[ \t]*$"))) (defun org-mouse-next-heading () "Go to the next heading. If there is none, ensure that the point is at the beginning of an empty line." (unless (outline-next-heading) - (beginning-of-line) + (forward-line 0) (unless (org-mouse-empty-line) (end-of-line) (newline)))) @@ -261,7 +261,7 @@ insert the new heading before the current line. Otherwise, insert it after the current heading." (interactive) (cl-case (org-mouse-line-position) - (:beginning (beginning-of-line) + (:beginning (forward-line 0) (org-insert-heading)) (t (org-mouse-next-heading) (org-insert-heading)))) @@ -271,7 +271,7 @@ after the current heading." For the acceptable UNITS, see `org-timestamp-change'." (interactive) - (org-time-stamp nil) + (org-timestamp nil) (when shift (org-timestamp-change shift units))) (defun org-mouse-keyword-menu (keywords function &optional selected itemformat) @@ -426,13 +426,14 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (append (let ((tags (org-get-tags nil t))) (org-mouse-keyword-menu - (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp) + (sort (mapcar #'car (org-get-buffer-tags)) + (or org-tags-sort-function #'org-string<)) (lambda (tag) (org-mouse-set-tags (sort (if (member tag tags) (delete tag tags) (cons tag tags)) - #'string-lessp))) + (or org-tags-sort-function #'org-string<)))) (lambda (tag) (member tag tags)) )) '("--" @@ -473,7 +474,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (sort (if (member ',name ',options) (delete ',name ',options) (cons ',name ',options)) - 'string-lessp) + #'org-string<) " ") nil nil nil 1) (when (functionp ',function) (funcall ',function))) @@ -502,7 +503,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ["Check TODOs" org-show-todo-tree t] ("Check Tags" ,@(org-mouse-keyword-menu - (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp) + (sort (mapcar #'car (org-get-buffer-tags)) + (or org-tags-sort-function #'org-string<)) (lambda (tag) (org-tags-sparse-tree nil tag))) "--" ["Custom Tag ..." org-tags-sparse-tree t]) @@ -512,7 +514,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ["Display TODO List" org-todo-list t] ("Display Tags" ,@(org-mouse-keyword-menu - (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp) + (sort (mapcar #'car (org-get-buffer-tags)) + (or org-tags-sort-function #'org-string<)) (lambda (tag) (org-tags-view nil tag))) "--" ["Custom Tag ..." org-tags-view t]) @@ -566,7 +569,7 @@ This means, between the beginning of line and the point." (defun org-mouse-insert-item (text) (cl-case (org-mouse-line-position) (:beginning ; insert before - (beginning-of-line) + (forward-line 0) (looking-at "[ \t]*") (open-line 1) (indent-to-column (- (match-end 0) (match-beginning 0))) @@ -582,7 +585,7 @@ This means, between the beginning of line and the point." (unless (looking-back org-mouse-punctuation (line-beginning-position)) (insert (concat org-mouse-punctuation " "))))) (insert text) - (beginning-of-line)) + (forward-line 0)) (advice-add 'dnd-insert-text :around #'org--mouse-dnd-insert-text) (defun org--mouse-dnd-insert-text (orig-fun window action text &rest args) @@ -632,7 +635,7 @@ This means, between the beginning of line and the point." (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 "[ \t]*#\\+STARTUP: \\(.*\\)")) + ((save-excursion (forward-line 0) (looking-at "[ \t]*#\\+STARTUP: \\(.*\\)")) (popup-menu `(nil ,@(org-mouse-list-options-menu (mapcar #'car org-startup-options) @@ -713,7 +716,7 @@ This means, between the beginning of line and the point." (popup-menu '(nil ["Show Day" org-open-at-point t] - ["Change Timestamp" org-time-stamp t] + ["Change Timestamp" org-timestamp t] ["Delete Timestamp" (org-mouse-delete-timestamp) t] ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)] "--" @@ -823,8 +826,8 @@ This means, between the beginning of line and the point." :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] + (progn (org-mouse-end-headline) (insert " ") (org-timestamp nil)) t] + ; ["Timestamp (inactive)" org-timestamp-inactive t] "--" ["Archive Subtree" org-archive-subtree] ["Cut Subtree" org-cut-special] @@ -980,7 +983,7 @@ This means, between the beginning of line and the point." (org-back-to-heading) (let ((minlevel 1000) (replace-text (concat (make-string (org-current-level) ?*) "* "))) - (beginning-of-line 2) + (forward-line 1) (save-excursion (while (not (or (eobp) (looking-at org-outline-regexp))) (when (looking-at org-mouse-plain-list-regexp) @@ -1028,7 +1031,7 @@ This means, between the beginning of line and the point." (unless (eq (marker-position marker) (marker-position endmarker)) (setq newhead (org-get-heading)))) - (beginning-of-line 1) + (forward-line 1) (save-excursion (org-agenda-change-all-lines newhead hdmarker 'fixface)))) t)))) diff --git a/lisp/org/org-num.el b/lisp/org/org-num.el index 00a25b11e53..aebfef05079 100644 --- a/lisp/org/org-num.el +++ b/lisp/org/org-num.el @@ -83,6 +83,7 @@ ;;; Customization +;;;###autoload (defcustom org-num-face nil "Face to use for numbering. When nil, use the same face as the headline. This value is @@ -104,6 +105,7 @@ Any `face' text property on the returned string overrides :package-version '(Org . "9.3") :type 'function) +;;;###autoload (defcustom org-num-max-level nil "Level below which headlines are not numbered. When set to nil, all headlines are numbered." @@ -113,6 +115,7 @@ When set to nil, all headlines are numbered." (integer :tag "Stop numbering at level")) :safe (lambda (val) (or (null val) (wholenump val)))) +;;;###autoload (defcustom org-num-skip-commented nil "Non-nil means commented sub-trees are not numbered." :group 'org-appearance @@ -120,6 +123,7 @@ When set to nil, all headlines are numbered." :type 'boolean :safe #'booleanp) +;;;###autoload (defcustom org-num-skip-footnotes nil "Non-nil means footnotes sections are not numbered." :group 'org-appearance @@ -127,6 +131,7 @@ When set to nil, all headlines are numbered." :type 'boolean :safe #'booleanp) +;;;###autoload (defcustom org-num-skip-tags nil "List of tags preventing the numbering of sub-trees. @@ -141,6 +146,7 @@ control tag inheritance." :type '(repeat (string :tag "Tag")) :safe (lambda (val) (and (listp val) (cl-every #'stringp val)))) +;;;###autoload (defcustom org-num-skip-unnumbered nil "Non-nil means numbering obeys to UNNUMBERED property." :group 'org-appearance @@ -214,7 +220,7 @@ Assume point is at a headline." (let ((after-edit-functions (list (lambda (o &rest _) (org-num--invalidate-overlay o)))) (o (save-excursion - (beginning-of-line) + (forward-line 0) (skip-chars-forward "*") (make-overlay (line-beginning-position) (1+ (point)))))) (overlay-put o 'org-num t) @@ -267,7 +273,7 @@ otherwise." tags) t) (and org-num-skip-unnumbered - (org-entry-get (point) "UNNUMBERED") + (org-entry-get (point) "UNNUMBERED" 'selective) t)))) (defun org-num--current-numbering (level skip) diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index c793563570b..0d311f9598f 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -22,6 +22,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . +;;; Commentary: + +;; This library implementes completion support in Org mode buffers. + ;;; Code: ;;;; Require other packages @@ -39,8 +43,9 @@ (declare-function org-before-first-heading-p "org" ()) (declare-function org-buffer-property-keys "org" (&optional specials defaults columns)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) -(declare-function org-element-property "org-element" property element) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-property "org-element-ast" (property node &optional dflt force-undefer)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-end-of-meta-data "org" (&optional full)) (declare-function org-entry-properties "org" (&optional pom which)) (declare-function org-export-backend-options "ox" (cl-x) t) @@ -171,21 +176,29 @@ When completing for #+STARTUP, for example, this function returns (defun org-parse-arguments () "Parse whitespace separated arguments in the current region." - (let ((begin (line-beginning-position)) - (end (line-end-position)) - begins args) - (save-restriction - (narrow-to-region begin end) + (if (equal (cons "searchhead" nil) (org-thing-at-point)) + ;; [[* foo bar link::search option. + ;; Arguments are not simply space-separated. (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n[") - (setq begins (cons (point) begins)) - (skip-chars-forward "^ \t\n[") - (setq args (cons (buffer-substring-no-properties - (car begins) (point)) - args))) - (cons (reverse args) (reverse begins)))))) + (let ((origin (point))) + (skip-chars-backward "^*" (line-beginning-position)) + (cons (list (buffer-substring-no-properties (point) origin)) + (list (point))))) + (let ((begin (line-beginning-position)) + (end (line-end-position)) + begins args) + (save-restriction + (narrow-to-region begin end) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n[") + (setq begins (cons (point) begins)) + (skip-chars-forward "^ \t\n[") + (setq args (cons (buffer-substring-no-properties + (car begins) (point)) + args))) + (cons (reverse args) (reverse begins))))))) (defun org-pcomplete-initial () "Call the right completion function for first argument completions." @@ -306,7 +319,7 @@ When completing for #+STARTUP, for example, this function returns "creator:" "date:" "d:" "email:" "*:" "e:" "::" "f:" "inline:" "tex:" "p:" "pri:" "':" "-:" "stat:" "^:" "toc:" "|:" "tags:" "tasks:" "<:" "todo:") - ;; OPTION items from registered back-ends. + ;; OPTION items from registered backends. (let (items) (dolist (backend (bound-and-true-p org-export-registered-backends)) @@ -361,14 +374,7 @@ This needs more work, to handle headings with lots of spaces in them." ;; Remove the leading asterisk from ;; `org-link-heading-search-string' result. (push (substring (org-link-heading-search-string) 1) tbl)) - (pcomplete-uniquify-list tbl))) - ;; When completing a bracketed link, i.e., "[[*", argument - ;; starts at the star, so remove this character. - ;; Also, if the completion is done inside [[*head]], - ;; drop the closing parentheses. - (replace-regexp-in-string - "\\]+$" "" - (substring pcomplete-stub 1))))) + (pcomplete-uniquify-list tbl)))))) (defun pcomplete/org-mode/tag () "Complete a tag name. Omit tags already set." @@ -397,10 +403,9 @@ This needs more work, to handle headings with lots of spaces in them." (goto-char (point-min)) (while (re-search-forward org-drawer-regexp nil t) (let ((drawer (org-element-at-point))) - (when (memq (org-element-type drawer) - '(drawer property-drawer)) + (when (org-element-type-p drawer '(drawer property-drawer)) (push (org-element-property :drawer-name drawer) names) - (goto-char (org-element-property :end drawer)))))) + (goto-char (org-element-end drawer)))))) (pcomplete-uniquify-list names)))) (substring pcomplete-stub 1))) ;remove initial colon diff --git a/lisp/org/org-persist.el b/lisp/org/org-persist.el index 9acf35bd488..9f2fd3424c7 100644 --- a/lisp/org/org-persist.el +++ b/lisp/org/org-persist.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. -;; Author: Ihor Radchenko +;; Author: Ihor Radchenko ;; Keywords: cache, storage ;; This file is part of GNU Emacs. @@ -27,24 +27,44 @@ ;; implementation is not meant to be used to store important data - ;; all the caches should be safe to remove at any time. ;; +;; Entry points are `org-persist-register', `org-persist-write', +;; `org-persist-read', and `org-persist-load'. +;; +;; `org-persist-register' will mark the data to be stored. By +;; default, the data is written on disk before exiting Emacs session. +;; Optionally, the data can be written immediately. +;; +;; `org-persist-write' will immediately write the data onto disk. +;; +;; `org-persist-read' will read the data and return its value or list +;; of values for each requested container. +;; +;; `org-persist-load' will read the data with side effects. For +;; example, loading `elisp' container will assign the values to +;; variables. +;; ;; Example usage: ;; ;; 1. Temporarily cache Elisp symbol value to disk. Remove upon ;; closing Emacs: ;; (org-persist-write 'variable-symbol) ;; (org-persist-read 'variable-symbol) ;; read the data later +;; ;; 2. Temporarily cache a remote URL file to disk. Remove upon ;; closing Emacs: ;; (org-persist-write 'url "https://static.fsf.org/common/img/logo-new.png") ;; (org-persist-read 'url "https://static.fsf.org/common/img/logo-new.png") ;; `org-persist-read' will return the cached file location or nil if cached file ;; has been removed. +;; ;; 3. Temporarily cache a file, including TRAMP path to disk: ;; (org-persist-write 'file "/path/to/file") +;; ;; 4. Cache file or URL while some other file exists. ;; (org-persist-register '(url "https://static.fsf.org/common/img/logo-new.png") '(:file "/path to the other file") :expiry 'never :write-immediately t) ;; or, if the other file is current buffer file ;; (org-persist-register '(url "https://static.fsf.org/common/img/logo-new.png") (current-buffer) :expiry 'never :write-immediately t) +;; ;; 5. Cache value of a Elisp variable to disk. The value will be ;; saved and restored automatically (except buffer-local ;; variables). @@ -55,14 +75,29 @@ ;; ;; Save buffer-local variable (buffer-local will not be ;; ;; autoloaded!) ;; (org-persist-register 'org-element--cache (current-buffer)) -;; ;; Save buffer-local variable preserving circular links: +;; ;; Save several buffer-local variables preserving circular links +;; ;; between: ;; (org-persist-register 'org-element--headline-cache (current-buffer) ;; :inherit 'org-element--cache) +;; ;; 6. Load variable by side effects assigning variable symbol: ;; (org-persist-load 'variable-symbol (current-buffer)) +;; ;; 7. Version variable value: ;; (org-persist-register '((elisp variable-symbol) (version "2.0"))) -;; 8. Cancel variable persistence: +;; +;; 8. Define a named container group: +;; +;; (let ((info1 "test") +;; (info2 "test 2")) +;; (org-persist-register +;; `("Named data" (elisp info1 local) (elisp info2 local)) +;; nil :write-immediately t)) +;; (org-persist-read +;; "Named data" +;; nil nil nil :read-related t) ; => ("Named data" "test" "test2") +;; +;; 9. Cancel variable persistence: ;; (org-persist-unregister 'variable-symbol 'all) ; in all buffers ;; (org-persist-unregister 'variable-symbol) ;; global variable ;; (org-persist-unregister 'variable-symbol (current-buffer)) ;; buffer-local @@ -76,13 +111,14 @@ ;; data-cells and we want to preserve their circular structure. ;; ;; Each data collection can be associated with a local or remote file, -;; its inode number, or contents hash. The persistent data collection +;; its inode number, contents hash. The persistent data collection ;; can later be accessed using either file buffer, file, inode, or ;; contents hash. ;; ;; The data collections can be versioned and removed upon expiry. ;; -;; In the code below I will use the following naming conventions: +;; In the code below, I will use the following naming conventions: +;; ;; 1. Container :: a type of data to be stored ;; Containers can store elisp variables, files, and version ;; numbers. Each container can be customized with container @@ -90,19 +126,72 @@ ;; variable symbol. (elisp variable) is a container storing ;; Lisp variable value. Similarly, (version "2.0") container ;; will store version number. +;; +;; Container can also refer to a group of containers: +;; +;; ;; Three containers stored together. +;; '((elisp variable) (file "/path") (version "x.x")) +;; +;; Providing a single container from the list to `org-persist-read' +;; is sufficient to retrieve all the containers (with appropriate +;; optional parameter). +;; +;; Example: +;; +;; (org-persist-register '((version "My data") (file "/path/to/file")) '(:key "key") :write-immediately t) +;; (org-persist-read '(version "My data") '(:key "key") :read-related t) ;; => '("My data" "/path/to/file/copy") +;; +;; Individual containers can also take a short form (not a list): +;; +;; '("String" file '(quoted elisp "value") :keyword) +;; is the same with +;; '((elisp-data "String") (file nil) +;; (elisp-data '(quoted elisp "value")) (elisp-data :keyword)) +;; +;; Note that '(file "String" (elisp value)) would be interpreted as +;; `file' container with "String" path and extra options. See +;; `org-persist--normalize-container'. +;; ;; 2. Associated :: an object the container is associated with. The ;; object can be a buffer, file, inode number, file contents hash, ;; a generic key, or multiple of them. Associated can also be nil. -;; 3. Data collection :: a list of containers linked to an associated -;; object/objects. Each data collection can also have auxiliary -;; records. Their only purpose is readability of the collection -;; index. +;; +;; Example: +;; +;; '(:file "/path/to/file" :inode number :hash buffer-hash :key arbitrary-key) +;; +;; When several objects are associated with a single container, it +;; is not necessary to provide them all to access the container. +;; Just using a single :file/:inode/:hash/:key is sufficient. This +;; way, one can retrieve cached data even when the file has moved - +;; by contents hash. +;; +;; 3. Data collection :: a list of containers, the associated +;; object/objects, expiry, access time, and information about where +;; the cache is stored. Each data collection can also have +;; auxiliary records. Their only purpose is readability of the +;; collection index. +;; +;; Example: +;; +;; (:container +;; ((index "2.7")) +;; :persist-file "ba/cef3b7-e31c-4791-813e-8bd0bf6c5f9c" +;; :associated nil :expiry never +;; :last-access 1672207741.6422956 :last-access-hr "2022-12-28T09:09:01+0300") +;; ;; 4. Index file :: a file listing all the stored data collections. +;; ;; 5. Persist file :: a file holding data values or references to ;; actual data values for a single data collection. This file ;; contains an alist associating each data container in data ;; collection with its value or a reference to the actual value. ;; +;; Example (persist file storing two elisp container values): +;; +;; (((elisp org-element--headline-cache) . #s(avl-tree- ...)) +;; ((elisp org-element--cache) . #s(avl-tree- ...))) +;; ;; All the persistent data is stored in `org-persist-directory'. The data ;; collections are listed in `org-persist-index-file' and the actual data is ;; stored in UID-style subfolders. @@ -111,6 +200,7 @@ ;; ;; Each collection is represented as a plist containing the following ;; properties: +;; ;; - `:container' : list of data containers to be stored in single ;; file; ;; - `:persist-file': data file name; @@ -120,15 +210,30 @@ ;; - all other keywords are ignored ;; ;; The available types of data containers are: -;; 1. (file variable-symbol) or just variable-symbol :: Storing -;; elisp variable data. +;; 1. (elisp variable-symbol scope) or just variable-symbol :: Storing +;; elisp variable data. SCOPE can be +;; +;; - `nil' :: Use buffer-local value in associated :file or global +;; value if no :file is associated. +;; - string :: Use buffer-local value in buffer named STRING or +;; with STRING `buffer-file-name'. +;; - `local' :: Use symbol value in current scope. +;; Note: If `local' scope is used without writing the +;; value immediately, the actual stored value is +;; undefined. +;; ;; 2. (file) :: Store a copy of the associated file preserving the ;; extension. + ;; (file "/path/to/a/file") :: Store a copy of the file in path. +;; ;; 3. (version "version number") :: Version the data collection. ;; If the stored collection has different version than "version ;; number", disregard it. -;; 4. (url) :: Store a downloaded copy of URL object. +;; +;; 4. (url) :: Store a downloaded copy of URL object given by +;; associated :file. +;; (url "path") :: Use "path" instead of associated :file. ;; ;; The data collections can expire, in which case they will be removed ;; from the persistent storage at the end of Emacs session. The @@ -145,7 +250,8 @@ ;; expiry is controlled by `org-persist-remote-files' instead. ;; ;; Data loading/writing can be more accurately controlled using -;; `org-persist-before-write-hook', `org-persist-before-read-hook', and `org-persist-after-read-hook'. +;; `org-persist-before-write-hook', `org-persist-before-read-hook', +;; and `org-persist-after-read-hook'. ;;; Code: @@ -163,7 +269,7 @@ ;; Silence byte-compiler (used in `org-persist--write-elisp-file'). (defvar pp-use-max-width) -(defconst org-persist--storage-version "3.1" +(defconst org-persist--storage-version "3.2" "Persistent storage layout version.") (defgroup org-persist nil @@ -171,18 +277,19 @@ :tag "Org persist" :group 'org) -(defcustom org-persist-directory (expand-file-name - (org-file-name-concat - (let ((cache-dir (when (fboundp 'xdg-cache-home) - (xdg-cache-home)))) - (if (or (seq-empty-p cache-dir) - (not (file-exists-p cache-dir)) - (file-exists-p (org-file-name-concat - user-emacs-directory - "org-persist"))) +(defcustom org-persist-directory + (expand-file-name + (org-file-name-concat + (let ((cache-dir (when (fboundp 'xdg-cache-home) + (xdg-cache-home)))) + (if (or (seq-empty-p cache-dir) + (not (file-exists-p cache-dir)) + (file-exists-p (org-file-name-concat user-emacs-directory - cache-dir)) - "org-persist/")) + "org-persist"))) + user-emacs-directory + cache-dir)) + "org-persist/")) "Directory where the data is stored." :group 'org-persist :package-version '(Org . "9.6") @@ -221,9 +328,24 @@ function will be called with a single argument - collection." (number :tag "Keep N days") (function :tag "Function"))) -(defconst org-persist-index-file "index" +(defconst org-persist-index-file "index.eld" "File name used to store the data index.") +(defconst org-persist-gc-lock-file "gc-lock.eld" + "File used to store information about active Emacs sessions. +The file contains an alist of (`before-init-time' . LAST-ACTIVE-TIME). +`before-init-time' uniquely identifies Emacs process and +LAST-ACTIVE-TIME is written every `org-persist-gc-lock-interval' +seconds. When LAST-ACTIVE-TIME is more than +`org-persist-gc-lock-expiry' seconds ago, that Emacs session is +considered not active.") + +(defvar org-persist-gc-lock-interval (* 60 60) ; 1 hour + "Interval in seconds for refreshing `org-persist-gc-lock-file'.") + +(defvar org-persist-gc-lock-expiry (* 60 60 24) ; 1 day + "Interval in seconds for expiring a record in `org-persist-gc-lock-file'.") + (defvar org-persist--disable-when-emacs-Q t "Disable persistence when Emacs is called with -Q command line arg. When non-nil, this sets `org-persist-directory' to temporary directory. @@ -262,13 +384,16 @@ properties: (defvar org-persist--index-hash nil "Hash table storing `org-persist--index'. Used for quick access. -They keys are conses of (container . associated).") +The keys are conses of (container . associated).") -(defvar org-persist--report-time 0.5 +(defvar org-persist--index-age nil + "The modification time of the index file, when it was loaded.") + +(defvar org-persist--report-time nil "Whether to report read/write time. When the value is a number, it is a threshold number of seconds. If -the read/write time of a single variable exceeds the threshold, a +the read/write time of a single persist file exceeds the threshold, a message is displayed. When the value is a non-nil non-number, always display the message. @@ -290,41 +415,57 @@ FORMAT and ARGS are passed to `message'." (defun org-persist--read-elisp-file (&optional buffer-or-file) "Read elisp data from BUFFER-OR-FILE or current buffer." - (unless buffer-or-file (setq buffer-or-file (current-buffer))) - (with-temp-buffer - (if (bufferp buffer-or-file) - (set-buffer buffer-or-file) - (insert-file-contents buffer-or-file)) - (condition-case err - (let ((coding-system-for-read 'utf-8) - (read-circle t) - (start-time (float-time))) - ;; FIXME: Reading sometimes fails to read circular objects. - ;; I suspect that it happens when we have object reference - ;; #N# read before object definition #N=. If it is really - ;; so, it should be Emacs bug - either in `read' or in - ;; `prin1'. Meanwhile, just fail silently when `read' - ;; fails to parse the saved cache object. - (prog1 - (read (current-buffer)) - (org-persist--display-time - (- (float-time) start-time) - "Reading from %S" buffer-or-file))) - ;; Recover gracefully if index file is corrupted. - (error - ;; Remove problematic file. - (unless (bufferp buffer-or-file) (delete-file buffer-or-file)) - ;; Do not report the known error to user. - (if (string-match-p "Invalid read syntax" (error-message-string err)) - (message "Emacs reader failed to read data in %S. The error was: %S" - buffer-or-file (error-message-string err)) - (warn "Emacs reader failed to read data in %S. The error was: %S" - buffer-or-file (error-message-string err))) - nil)))) + (let (;; UTF-8 is explicitly used in `org-persist--write-elisp-file'. + (coding-system-for-read 'utf-8) + (buffer-or-file (or buffer-or-file (current-buffer)))) + (with-temp-buffer + (if (bufferp buffer-or-file) + (set-buffer buffer-or-file) + (insert-file-contents buffer-or-file)) + (condition-case err + (let ((read-circle t) + (start-time (float-time))) + ;; FIXME: Reading sometimes fails to read circular objects. + ;; I suspect that it happens when we have object reference + ;; #N# read before object definition #N=. If it is really + ;; so, it should be Emacs bug - either in `read' or in + ;; `prin1'. Meanwhile, just fail silently when `read' + ;; fails to parse the saved cache object. + (prog1 + (read (current-buffer)) + (org-persist--display-time + (- (float-time) start-time) + "Reading from %S" buffer-or-file))) + ;; Recover gracefully if index file is corrupted. + (error + ;; Remove problematic file. + (unless (bufferp buffer-or-file) (delete-file buffer-or-file)) + ;; Do not report the known error to user. + (if (string-match-p "Invalid read syntax" (error-message-string err)) + (message "Emacs reader failed to read data in %S. The error was: %S" + buffer-or-file (error-message-string err)) + (warn "Emacs reader failed to read data in %S. The error was: %S" + buffer-or-file (error-message-string err))) + nil))))) (defun org-persist--write-elisp-file (file data &optional no-circular pp) "Write elisp DATA to FILE." - (let ((print-circle (not no-circular)) + ;; Fsync slightly reduces the chance of an incomplete filesystem + ;; write, however on modern hardware its effectiveness is + ;; questionable and it is insufficient to garantee complete writes. + ;; Coupled with the significant performance hit if writing many + ;; small files, it simply does not make sense to use fsync here, + ;; particularly as cache corruption is only a minor inconvenience. + ;; With all this in mind, we ensure `write-region-inhibit-fsync' is + ;; set. + ;; + ;; To read more about this, see the comments in Emacs' fileio.c, in + ;; particular the large comment block in init_fileio. + (let ((write-region-inhibit-fsync t) + ;; We set UTF-8 here and in `org-persist--read-elisp-file' + ;; to avoid the overhead from `find-auto-coding'. + (coding-system-for-write 'utf-8) + (print-circle (not no-circular)) print-level print-length print-quoted @@ -335,11 +476,17 @@ FORMAT and ARGS are passed to `message'." (start-time (float-time))) (unless (file-exists-p (file-name-directory file)) (make-directory (file-name-directory file) t)) - (with-temp-file file - (if pp - (let ((pp-use-max-width nil)) ; Emacs bug#58687 - (pp data (current-buffer))) - (prin1 data (current-buffer)))) + ;; Force writing even when the file happens to be opened by + ;; another Emacs process. + (cl-letf (((symbol-function #'ask-user-about-lock) + ;; FIXME: Emacs 27 does not yet have `always'. + (lambda (&rest _) t))) + (with-temp-file file + (insert ";; -*- mode: lisp-data; -*-\n") + (if pp + (let ((pp-use-max-width nil)) ; Emacs bug#58687 + (pp data (current-buffer))) + (prin1 data (current-buffer))))) (org-persist--display-time (- (float-time) start-time) "Writing to %S" file))) @@ -426,7 +573,9 @@ Return PLIST." (org-persist-collection-let collection (dolist (cont (cons container container)) (unless (listp (car container)) - (org-persist-gc:generic cont collection)) + (org-persist-gc:generic cont collection) + (dolist (afile (org-persist-associated-files:generic cont collection)) + (delete-file afile))) (remhash (cons cont associated) org-persist--index-hash) (when path (remhash (cons cont (list :file path)) org-persist--index-hash)) (when inode (remhash (cons cont (list :inode inode)) org-persist--index-hash)) @@ -458,18 +607,22 @@ MISC, if non-nil will be appended to the collection. It must be a plist." ;;;; Reading container data. -(defun org-persist--normalize-container (container) - "Normalize CONTAINER representation into (type . settings)." - (if (and (listp container) (listp (car container))) - (mapcar #'org-persist--normalize-container container) - (pcase container - ((or `elisp `version `file `index `url) - (list container nil)) - ((pred symbolp) - (list `elisp container)) - (`(,(or `elisp `version `file `index `url) . ,_) - container) - (_ (error "org-persist: Unknown container type: %S" container))))) +(defun org-persist--normalize-container (container &optional inner) + "Normalize CONTAINER representation into (type . settings). + +When INNER is non-nil, do not try to match as list of containers." + (pcase container + ((or `elisp `elisp-data `version `file `index `url) + `(,container nil)) + ((or (pred keywordp) (pred stringp) `(quote . ,_)) + `(elisp-data ,container)) + ((pred symbolp) + `(elisp ,container)) + (`(,(or `elisp `elisp-data `version `file `index `url) . ,_) + container) + ((and (pred listp) (guard (not inner))) + (mapcar (lambda (c) (org-persist--normalize-container c 'inner)) container)) + (_ (error "org-persist: Unknown container type: %S" container)))) (defvar org-persist--associated-buffer-cache (make-hash-table :weakness 'key) "Buffer hash cache.") @@ -543,10 +696,12 @@ COLLECTION is the plist holding data collection." "Read elisp container and return LISP-VALUE." lisp-value) -(defun org-persist-read:version (container _ __) - "Read version CONTAINER." +(defun org-persist-read:elisp-data (container _ __) + "Read elisp-data CONTAINER." (cadr container)) +(defalias 'org-persist-read:version #'org-persist-read:elisp-data) + (defun org-persist-read:file (_ path __) "Read file container from PATH." (when (and path (file-exists-p (org-file-name-concat org-persist-directory path))) @@ -598,14 +753,17 @@ COLLECTION is the plist holding data collection." (set lisp-symbol lisp-value)) (set lisp-symbol lisp-value)))) +(defalias 'org-persist-load:elisp-data #'org-persist-read:elisp-data) (defalias 'org-persist-load:version #'org-persist-read:version) (defalias 'org-persist-load:file #'org-persist-read:file) (defun org-persist-load:index (container index-file _) "Load `org-persist--index' from INDEX-FILE according to CONTAINER." (unless org-persist--index - (setq org-persist--index (org-persist-read:index container index-file nil)) - (setq org-persist--index-hash nil) + (setq org-persist--index (org-persist-read:index container index-file nil) + org-persist--index-hash nil + org-persist--index-age (file-attribute-modification-time + (file-attributes index-file))) (if org-persist--index (mapc (lambda (collection) (org-persist--add-to-index collection 'hash)) org-persist--index) (setq org-persist--index nil) @@ -618,7 +776,7 @@ COLLECTION is the plist holding data collection." (plist-put (org-persist--get-collection container) :expiry 'never)))) (defun org-persist--load-index () - "Load `org-persist--index." + "Load `org-persist--index'." (org-persist-load:index `(index ,org-persist--storage-version) (org-file-name-concat org-persist-directory org-persist-index-file) @@ -630,8 +788,9 @@ COLLECTION is the plist holding data collection." "Write CONTAINER in COLLECTION." `(let* ((c (org-persist--normalize-container ,container)) (write-func-symbol (intern (format "org-persist-write:%s" (car c))))) - (setf ,collection (plist-put ,collection :last-access (float-time))) - (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time)))) + (unless (plist-get ,collection :last-access) + (setf ,collection (plist-put ,collection :last-access (float-time))) + (setf ,collection (plist-put ,collection :last-access-hr (format-time-string "%FT%T%z" (float-time))))) (unless (fboundp write-func-symbol) (error "org-persist: Write function %s not defined" write-func-symbol)) @@ -639,17 +798,31 @@ COLLECTION is the plist holding data collection." (defun org-persist-write:elisp (container collection) "Write elisp CONTAINER according to COLLECTION." - (if (and (plist-get (plist-get collection :associated) :file) - (get-file-buffer (plist-get (plist-get collection :associated) :file))) - (let ((buf (get-file-buffer (plist-get (plist-get collection :associated) :file)))) - ;; FIXME: There is `buffer-local-boundp' introduced in Emacs 28. - ;; Not using it yet to keep backward compatibility. - (condition-case nil - (buffer-local-value (cadr container) buf) - (void-variable nil))) - (when (boundp (cadr container)) - (symbol-value (cadr container))))) - + (let ((scope (nth 2 container))) + (pcase scope + ((pred stringp) + (when-let ((buf (or (get-buffer scope) + (get-file-buffer scope)))) + ;; FIXME: There is `buffer-local-boundp' introduced in Emacs 28. + ;; Not using it yet to keep backward compatibility. + (condition-case nil + (buffer-local-value (cadr container) buf) + (void-variable nil)))) + (`local + (when (boundp (cadr container)) + (symbol-value (cadr container)))) + (`nil + (if-let ((buf (and (plist-get (plist-get collection :associated) :file) + (get-file-buffer (plist-get (plist-get collection :associated) :file))))) + ;; FIXME: There is `buffer-local-boundp' introduced in Emacs 28. + ;; Not using it yet to keep backward compatibility. + (condition-case nil + (buffer-local-value (cadr container) buf) + (void-variable nil)) + (when (boundp (cadr container)) + (symbol-value (cadr container)))))))) + +(defalias 'org-persist-write:elisp-data #'ignore) (defalias 'org-persist-write:version #'ignore) (defun org-persist-write:file (c collection) @@ -685,38 +858,81 @@ COLLECTION is the plist holding data collection." (make-directory (file-name-directory file-copy) t)) (if (org--should-fetch-remote-resource-p path) (url-copy-file path file-copy 'overwrite) - (error "The remote resource %S is considered unsafe, and will not be downloaded." + (error "The remote resource %S is considered unsafe, and will not be downloaded" path))) (format "%s-%s.%s" persist-file (md5 path) ext))))) +(defun org-persist--check-write-access (path) + "Check write access to all missing directories in PATH. +Show message and return nil if there is no write access. +Otherwise, return t." + (let* ((dir (directory-file-name (file-name-as-directory path))) + (prev dir)) + (while (and (not (file-exists-p dir)) + (setq prev dir) + (not (equal dir (setq dir (directory-file-name + (file-name-directory dir))))))) + (if (file-writable-p prev) t ; return t + (message "org-persist: Missing write access rights to: %S" prev) + ;; return nil + nil))) + (defun org-persist-write:index (container _) "Write index CONTAINER." (org-persist--get-collection container) (unless (file-exists-p org-persist-directory) - (make-directory org-persist-directory)) - (unless (file-exists-p org-persist-directory) - (warn "Failed to create org-persist storage in %s." - org-persist-directory) - (let ((dir (directory-file-name - (file-name-as-directory org-persist-directory)))) - (while (and (not (file-exists-p dir)) - (not (equal dir (setq dir (directory-file-name - (file-name-directory dir))))))) - (unless (file-writable-p dir) - (message "Missing write access rights to org-persist-directory: %S" - org-persist-directory)))) + (condition-case nil + (make-directory org-persist-directory 'parent) + (t + (warn "Failed to create org-persist storage in %s." + org-persist-directory) + (org-persist--check-write-access org-persist-directory)))) (when (file-exists-p org-persist-directory) - (org-persist--write-elisp-file - (org-file-name-concat org-persist-directory org-persist-index-file) - org-persist--index - t t) - (org-file-name-concat org-persist-directory org-persist-index-file))) + (let ((index-file + (org-file-name-concat org-persist-directory org-persist-index-file))) + (org-persist--merge-index-with-disk) + (org-persist--write-elisp-file index-file org-persist--index t t) + (setq org-persist--index-age + (file-attribute-modification-time (file-attributes index-file))) + index-file))) (defun org-persist--save-index () - "Save `org-persist--index." + "Save `org-persist--index'." (org-persist-write:index `(index ,org-persist--storage-version) nil)) +(defun org-persist--merge-index-with-disk () + "Merge `org-persist--index' with the current index file on disk." + (let* ((index-file + (org-file-name-concat org-persist-directory org-persist-index-file)) + (disk-index + (and (file-exists-p index-file) + (org-file-newer-than-p index-file org-persist--index-age) + (org-persist-read:index `(index ,org-persist--storage-version) index-file nil))) + (combined-index + (org-persist--merge-index org-persist--index disk-index))) + (when disk-index + (setq org-persist--index combined-index + org-persist--index-age + (file-attribute-modification-time (file-attributes index-file)))))) + +(defun org-persist--merge-index (base other) + "Attempt to merge new index items in OTHER into BASE. +Items with different details are considered too difficult, and skipped." + (if other + (let ((new (cl-set-difference other base :test #'equal)) + (base-files (mapcar (lambda (s) (plist-get s :persist-file)) base)) + (combined (reverse base))) + (dolist (item (nreverse new)) + (unless (or (memq 'index (mapcar #'car (plist-get item :container))) + (not (file-exists-p + (org-file-name-concat org-persist-directory + (plist-get item :persist-file)))) + (member (plist-get item :persist-file) base-files)) + (push item combined))) + (nreverse combined)) + base)) + ;;;; Public API (cl-defun org-persist-register (container &optional associated &rest misc @@ -760,20 +976,22 @@ with `org-persist-write'." (add-hook 'kill-buffer-hook #'org-persist-write-all-buffer nil 'local))) (when write-immediately (org-persist-write container associated))) -(defun org-persist-unregister (container &optional associated) +(cl-defun org-persist-unregister (container &optional associated &key remove-related) "Unregister CONTAINER in ASSOCIATED to be persistent. -When ASSOCIATED is `all', unregister CONTAINER everywhere." +When ASSOCIATED is `all', unregister CONTAINER everywhere. +When REMOVE-RELATED is non-nil, remove all the containers stored with +the CONTAINER as well." (unless org-persist--index (org-persist--load-index)) (setq container (org-persist--normalize-container container)) (if (eq associated 'all) (mapc (lambda (collection) (when (member container (plist-get collection :container)) - (org-persist-unregister container (plist-get collection :associated)))) + (org-persist-unregister container (plist-get collection :associated) :remove-related remove-related))) org-persist--index) (setq associated (org-persist--normalize-associated associated)) (let ((collection (org-persist--find-index `(:container ,container :associated ,associated)))) (when collection - (if (= (length (plist-get collection :container)) 1) + (if (or remove-related (= (length (plist-get collection :container)) 1)) (org-persist--remove-from-index collection) (plist-put collection :container (remove container (plist-get collection :container))) @@ -783,14 +1001,27 @@ When ASSOCIATED is `all', unregister CONTAINER everywhere." "Hash table storing as-written data objects. This data is used to avoid reading the data multiple times.") -(defun org-persist-read (container &optional associated hash-must-match load?) +(cl-defun org-persist-read (container &optional associated hash-must-match load &key read-related) "Restore CONTAINER data for ASSOCIATED. When HASH-MUST-MATCH is non-nil, do not restore data if hash for ASSOCIATED file or buffer does not match. + ASSOCIATED can be a plist, a buffer, or a string. A buffer is treated as (:buffer ASSOCIATED). A string is treated as (:file ASSOCIATED). -When LOAD? is non-nil, load the data instead of reading." + +When LOAD is non-nil, load the data instead of reading. + +When READ-RELATED is non-nil, return the data stored alongside with +CONTAINER as well. For example: + + (let ((info \"test\")) + (org-persist-register + \\=`(\"My data\" (elisp-data ,info)) + nil :write-immediately t)) + (org-persist-read \"My data\") ; => \"My data\" + (org-persist-read \"My data\" nil nil nil + :read-related t) ; => (\"My data\" \"test\")" (unless org-persist--index (org-persist--load-index)) (setq associated (org-persist--normalize-associated associated)) (setq container (org-persist--normalize-container container)) @@ -802,33 +1033,41 @@ When LOAD? is non-nil, load the data instead of reading." (plist-get collection :persist-file)))) (data nil)) (when (and collection - (file-exists-p persist-file) (or (not (plist-get collection :expiry)) ; current session (not (org-persist--gc-expired-p (plist-get collection :expiry) collection))) (or (not hash-must-match) (and (plist-get associated :hash) (equal (plist-get associated :hash) - (plist-get (plist-get collection :associated) :hash))))) + (plist-get (plist-get collection :associated) :hash)))) + (or (file-exists-p persist-file) + ;; Attempt to write data if it is not yet written. + (progn + (org-persist-write container associated 'no-read) + (file-exists-p persist-file)))) (unless (seq-find (lambda (v) (run-hook-with-args-until-success 'org-persist-before-read-hook v associated)) (plist-get collection :container)) (setq data (or (gethash persist-file org-persist--write-cache) (org-persist--read-elisp-file persist-file))) (when data - (cl-loop for container in (plist-get collection :container) + (cl-loop for c in (plist-get collection :container) with result = nil do - (if load? - (push (org-persist-load:generic container (alist-get container data nil nil #'equal) collection) result) - (push (org-persist-read:generic container (alist-get container data nil nil #'equal) collection) result)) - (run-hook-with-args 'org-persist-after-read-hook container associated) - finally return (if (= 1 (length result)) (car result) result))))))) - -(defun org-persist-load (container &optional associated hash-must-match) + (when (or read-related + (equal c container) + (member c container)) + (if load + (push (org-persist-load:generic c (alist-get c data nil nil #'equal) collection) result) + (push (org-persist-read:generic c (alist-get c data nil nil #'equal) collection) result))) + (run-hook-with-args 'org-persist-after-read-hook c associated) + finally return (if (= 1 (length result)) (car result) (nreverse result)))))))) + +(cl-defun org-persist-load (container &optional associated hash-must-match &key read-related) "Load CONTAINER data for ASSOCIATED. -The arguments have the same meaning as in `org-persist-read'." - (org-persist-read container associated hash-must-match t)) +The arguments CONTAINER, ASSOCIATED, HASH-MUST-MATCH, and READ-RELATED +have the same meaning as in `org-persist-read'." + (org-persist-read container associated hash-must-match t :read-related read-related)) (defun org-persist-load-all (&optional associated) "Restore all the persistent data associated with ASSOCIATED." @@ -934,32 +1173,84 @@ Do nothing in an indirect buffer." (defalias 'org-persist-gc:elisp #'ignore) (defalias 'org-persist-gc:index #'ignore) +(defalias 'org-persist-gc:elisp-data #'ignore) +(defalias 'org-persist-gc:version #'ignore) +(defalias 'org-persist-gc:file #'ignore) +(defalias 'org-persist-gc:url #'ignore) + +(defun org-persist--gc-persist-file (persist-file) + "Garbage collect PERSIST-FILE." + (when (file-exists-p persist-file) + (delete-file persist-file) + (when (org-directory-empty-p (file-name-directory persist-file)) + (delete-directory (file-name-directory persist-file))))) + +(defmacro org-persist-associated-files:generic (container collection) + "List associated files in `org-persist-directory' of CONTAINER in COLLECTION." + `(let* ((c (org-persist--normalize-container ,container)) + (assocf-func-symbol (intern (format "org-persist-associated-files:%s" (car c))))) + (if (fboundp assocf-func-symbol) + (funcall assocf-func-symbol c ,collection) + (error "org-persist: Read function %s not defined" + assocf-func-symbol)))) + +(defalias 'org-persist-associated-files:elisp #'ignore) +(defalias 'org-persist-associated-files:index #'ignore) +(defalias 'org-persist-associated-files:elisp-data #'ignore) +(defalias 'org-persist-associated-files:version #'ignore) -(defun org-persist-gc:file (container collection) - "Garbage collect file CONTAINER in COLLECTION." +(defun org-persist-associated-files:file (container collection) + "List file CONTAINER associated files of COLLECTION in `org-persist-directory'." (let ((file (org-persist-read container (plist-get collection :associated)))) - (when (file-exists-p file) - (delete-file file)))) + (when (and file (file-exists-p file)) + (list file)))) -(defun org-persist-gc:url (container collection) - "Garbage collect url CONTAINER in COLLECTION." +(defun org-persist-associated-files:url (container collection) + "List url CONTAINER associated files of COLLECTION in `org-persist-directory'." (let ((file (org-persist-read container (plist-get collection :associated)))) (when (file-exists-p file) - (delete-file file)))) - -(defmacro org-persist--gc-persist-file (persist-file) - "Garbage collect PERSIST-FILE." - `(when (file-exists-p ,persist-file) - (delete-file ,persist-file) - (when (org-directory-empty-p (file-name-directory ,persist-file)) - (delete-directory (file-name-directory ,persist-file))))) + (list file)))) + +(defun org-persist--refresh-gc-lock () + "Refresh session timestamp in `org-persist-gc-lock-file'. +Remove expired sessions timestamps." + (let* ((file (org-file-name-concat org-persist-directory org-persist-gc-lock-file)) + (alist (when (file-exists-p file) (org-persist--read-elisp-file file))) + new-alist) + (setf (alist-get before-init-time alist nil nil #'equal) + (current-time)) + (dolist (record alist) + (when (< (- (float-time (cdr record)) (float-time (current-time))) + org-persist-gc-lock-expiry) + (push record new-alist))) + (org-persist--write-elisp-file file new-alist))) + +(defun org-persist--gc-orphan-p () + "Return non-nil, when orphan files should be garbage-collected. +Remove current sessions from `org-persist-gc-lock-file'." + (let* ((file (org-file-name-concat org-persist-directory org-persist-gc-lock-file)) + (alist (when (file-exists-p file) (org-persist--read-elisp-file file)))) + (setq alist (org-assoc-delete-all before-init-time alist)) + (org-persist--write-elisp-file file alist) + ;; Only GC orphan files when there are no active sessions. + (not alist))) (defun org-persist-gc () - "Remove expired or unregistered containers. + "Remove expired or unregistered containers and orphaned files. Also, remove containers associated with non-existing files." - (let (new-index (remote-files-num 0)) + (if org-persist--index + (org-persist--merge-index-with-disk) + (org-persist--load-index)) + (let (new-index + (remote-files-num 0) + (orphan-files + (when (org-persist--gc-orphan-p) ; also removes current session from lock file. + (delete (org-file-name-concat org-persist-directory org-persist-index-file) + (when (file-exists-p org-persist-directory) + (directory-files-recursively org-persist-directory ".+")))))) (dolist (collection org-persist--index) (let* ((file (plist-get (plist-get collection :associated) :file)) + (web-file (and file (string-match-p "\\`https?://" file))) (file-remote (when file (file-remote-p file))) (persist-file (when (plist-get collection :persist-file) (org-file-name-concat @@ -968,7 +1259,8 @@ Also, remove containers associated with non-existing files." (expired? (org-persist--gc-expired-p (plist-get collection :expiry) collection))) (when persist-file - (when file + (setq orphan-files (delete persist-file orphan-files)) + (when (and file (not web-file)) (when file-remote (cl-incf remote-files-num)) (unless (if (not file-remote) (file-exists-p file) @@ -977,12 +1269,18 @@ Also, remove containers associated with non-existing files." ('check-existence (file-exists-p file)) ((pred numberp) - (<= org-persist-remote-files remote-files-num)) + (< org-persist-remote-files remote-files-num)) (_ nil))) (setq expired? t))) (if expired? (org-persist--gc-persist-file persist-file) - (push collection new-index))))) + (push collection new-index) + (dolist (container (plist-get collection :container)) + (dolist (associated-file + (org-persist-associated-files:generic + container collection)) + (setq orphan-files (delete associated-file orphan-files)))))))) + (mapc #'org-persist--gc-persist-file orphan-files) (setq org-persist--index (nreverse new-index)))) (defun org-persist-clear-storage-maybe () @@ -1010,22 +1308,27 @@ such scenario." (make-temp-file "org-persist-" 'dir))) ;; Automatically write the data, but only when we have write access. -(let ((dir (directory-file-name - (file-name-as-directory org-persist-directory)))) - (while (and (not (file-exists-p dir)) - (not (equal dir (setq dir (directory-file-name - (file-name-directory dir))))))) - (if (not (file-writable-p dir)) - (message "Missing write access rights to org-persist-directory: %S" - org-persist-directory) - (add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last. - (add-hook 'kill-emacs-hook #'org-persist-write-all) - ;; `org-persist-gc' should run before `org-persist-write-all'. - ;; So we are adding the hook after `org-persist-write-all'. - (add-hook 'kill-emacs-hook #'org-persist-gc))) +(when (org-persist--check-write-access org-persist-directory) + (add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last. + (add-hook 'kill-emacs-hook #'org-persist-write-all) + ;; `org-persist-gc' should run before `org-persist-write-all'. + ;; So we are adding the hook after `org-persist-write-all'. + (add-hook 'kill-emacs-hook #'org-persist-gc)) (add-hook 'after-init-hook #'org-persist-load-all) +(defvar org-persist--refresh-gc-lock-timer nil + "Timer used to refresh session timestamp in `org-persist-gc-lock-file'.") + +(unless (and org-persist--disable-when-emacs-Q + ;; FIXME: This is relying on undocumented fact that + ;; Emacs sets `user-init-file' to nil when loaded with + ;; "-Q" argument. + (not user-init-file)) + (unless org-persist--refresh-gc-lock-timer + (setq org-persist--refresh-gc-lock-timer + (run-at-time nil org-persist-gc-lock-interval #'org-persist--refresh-gc-lock)))) + (provide 'org-persist) ;;; org-persist.el ends here diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 3fea8b5b8b4..283d99380da 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -641,9 +641,13 @@ manner suitable for prepending to a user-specified script." If not given options will be taken from the +PLOT line directly before or after the table." (interactive) - (require 'gnuplot) + (org-require-package 'gnuplot) (save-window-excursion - (delete-other-windows) + ;; `gnuplot-send-buffer-to-gnuplot' will display *gnuplot* buffer + ;; if `gnuplot-display-process' is non-nil. Make it visible while + ;; gnuplot is processing the data, preferably as a split, and + ;; restore old window configuration after gnuplot finishes. + (ignore-errors (delete-other-windows)) (when (get-buffer "*gnuplot*") ; reset *gnuplot* if it already running (with-current-buffer "*gnuplot*" (goto-char (point-max)))) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 6b6664fc375..80caf6017a1 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -329,7 +329,7 @@ results of that splitting are returned as a list." Greedy handlers might receive a list like this from emacsclient: \((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) where \"/dir/\" is the absolute path to emacsclient's working directory. This -function transforms it into a flat list using `org-protocol-flatten' and +function transforms it into a flat list using `flatten-tree' and transforms the elements of that list as follows: If STRIP-PATH is non-nil, remove the \"/dir/\" prefix from all members of @@ -344,9 +344,9 @@ 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. emacsclient's 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)))) + (let* ((l (org--flatten-tree (if org-protocol-reverse-list-of-files + param-list + (reverse param-list)))) (trigger (car l)) (len 0) dir @@ -369,21 +369,15 @@ returned list." ret) l))) -;; `flatten-tree' was added in Emacs 27.1. -(defalias 'org-protocol-flatten - (if (fboundp 'flatten-tree) 'flatten-tree - (lambda (list) - "Transform LIST into a flat list. +(define-obsolete-function-alias 'org-protocol-flatten + (if (fboundp 'flatten-tree) 'flatten-tree 'org--flatten-tree) + "9.7" + "Transform LIST into a flat list. Greedy handlers might receive a list like this from emacsclient: \((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) where \"/dir/\" is the absolute path to emacsclients working directory. -This function transforms it into a flat list." - (if list - (if (consp list) - (append (org-protocol-flatten (car list)) - (org-protocol-flatten (cdr list))) - (list list)))))) +This function transforms it into a flat list.") (defun org-protocol-parse-parameters (info &optional new-style default-order) "Return a property list of parameters from INFO. @@ -689,7 +683,8 @@ to deal with new-style links.") (advice-add 'server-visit-files :around #'org--protocol-detect-protocol-server) (defun org--protocol-detect-protocol-server (orig-fun files client &rest args) - "Advice server-visit-flist to call `org-protocol-check-filename-for-protocol'." + "Advice `server-visit-files' to call `org-protocol-check-filename-for-protocol'. +This function is indented to be used as :around advice for `server-visit-files'." (let ((flist (if org-protocol-reverse-list-of-files (reverse files) files))) diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el index 4f204c739fa..20b5fbd02c0 100644 --- a/lisp/org/org-refile.el +++ b/lisp/org/org-refile.el @@ -221,7 +221,8 @@ converted to a headline before refiling." ["Refile and copy Subtree" org-refile-copy (org-in-subtree-not-table-p)])) (defun org-refile-marker (pos) - "Get a new refile marker, but only if caching is in use." + "Return a new refile marker at POS, but only if caching is in use. +When `org-refile-use-cache' is nil, just return POS." (if (not org-refile-use-cache) pos (let ((m (make-marker))) @@ -273,8 +274,10 @@ converted to a headline before refiling." (entries (or org-refile-targets '((nil . (:level . 1))))) targets tgs files desc descre) (message "Getting targets...") + (cl-assert (listp entries) t "`org-refile-targets' must be a list of targets") (with-current-buffer (or default-buffer (current-buffer)) (dolist (entry entries) + (cl-assert (consp entry) t "Refile target must be a cons cell (FILES . SPECIFICATION)") (setq files (car entry) desc (cdr entry)) (cond ((null files) (setq files (list (current-buffer)))) @@ -285,28 +288,37 @@ converted to a headline before refiling." ((and (symbolp files) (boundp files)) (setq files (symbol-value files)))) (when (stringp files) (setq files (list files))) - (cond - ((eq (car desc) :tag) - (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) - ((eq (car desc) :todo) - (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) - ((eq (car desc) :regexp) - (setq descre (cdr desc))) - ((eq (car desc) :level) - (setq descre (concat "^\\*\\{" (number-to-string - (if org-odd-levels-only - (1- (* 2 (cdr desc))) - (cdr desc))) - "\\}[ \t]"))) - ((eq (car desc) :maxlevel) - (setq descre (concat "^\\*\\{1," (number-to-string + ;; Allow commonly used (FILE :maxlevel N) and similar values. + (when (and (listp (cdr desc)) (null (cddr desc))) + (setq desc (cons (car desc) (cadr desc)))) + (condition-case err + (cond + ((eq (car desc) :tag) + (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) + ((eq (car desc) :todo) + (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) + ((eq (car desc) :regexp) + (setq descre (cdr desc))) + ((eq (car desc) :level) + (setq descre (concat "^\\*\\{" (number-to-string (if org-odd-levels-only - (1- (* 2 (cdr desc))) + (1- (* 2 (cdr desc))) (cdr desc))) - "\\}[ \t]"))) - (t (error "Bad refiling target description %s" desc))) + "\\}[ \t]"))) + ((eq (car desc) :maxlevel) + (setq descre (concat "^\\*\\{1," (number-to-string + (if org-odd-levels-only + (1- (* 2 (cdr desc))) + (cdr desc))) + "\\}[ \t]"))) + (t (error "Bad refiling target description %s" desc))) + (error + (error "Error parsing refiling target description: %s" + (error-message-string err)))) (dolist (f files) (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)) + (unless (derived-mode-p 'org-mode) + (error "Major mode in refile target buffer \"%s\" must be `org-mode'" f)) (or (setq tgs (org-refile-cache-get (buffer-file-name) descre)) (progn @@ -330,7 +342,7 @@ converted to a headline before refiling." (goto-char (point-min)) (setq org-outline-path-cache nil) (while (re-search-forward descre nil t) - (beginning-of-line) + (forward-line 0) (let ((case-fold-search nil)) (looking-at org-complex-heading-regexp)) (let ((begin (point)) @@ -365,7 +377,7 @@ converted to a headline before refiling." (buffer-base-buffer)))) (_ nil)) (mapcar (lambda (s) (replace-regexp-in-string - "/" "\\/" s nil t)) + "/" "\\/" s nil t)) (org-get-outline-path t t))) "/")))) (push (list target f re (org-refile-marker (point))) @@ -474,7 +486,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (setq last-command nil) (when regionp (goto-char region-start) - (beginning-of-line) + (forward-line 0) (setq region-start (point)) (unless (or (org-kill-is-subtree-p (buffer-substring region-start region-end)) @@ -523,12 +535,13 @@ prefix argument (`C-u C-u C-u C-c C-w')." (if regionp (and (>= pos region-start) (<= pos region-end)) - (and (>= pos (point)) + (and (>= pos (save-excursion + (org-back-to-heading t) + (point))) (< pos (save-excursion (org-end-of-subtree t t)))))) (error "Cannot refile to position inside the tree or region")) - (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) + (setq nbuf (find-file-noselect file 'nowarn)) (if (and arg (not (equal arg 3))) (progn (pop-to-buffer-same-window nbuf) @@ -541,58 +554,70 @@ prefix argument (`C-u C-u C-u C-c C-w')." (org-kill-new (buffer-substring region-start region-end)) (org-save-markers-in-region region-start region-end)) (org-copy-subtree 1 nil t)) - (with-current-buffer (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) - (setq reversed (org-notes-order-reversed-p)) - (org-with-wide-buffer - (if pos - (progn - (goto-char pos) - (setq level (org-get-valid-level (funcall outline-level) 1)) - (goto-char - (if reversed - (or (outline-next-heading) (point-max)) - (or (save-excursion (org-get-next-sibling)) - (org-end-of-subtree t t) - (point-max))))) - (setq level 1) - (if (not reversed) - (goto-char (point-max)) - (goto-char (point-min)) - (or (outline-next-heading) (goto-char (point-max))))) - (unless (bolp) (newline)) - (org-paste-subtree level nil nil t) - ;; Record information, according to `org-log-refile'. - ;; Do not prompt for a note when refiling multiple - ;; headlines, however. Simply add a time stamp. - (cond - ((not org-log-refile)) - (regionp - (org-map-region - (lambda () (org-add-log-setup 'refile nil nil 'time)) - (point) - (+ (point) (- region-end region-start)))) - (t - (org-add-log-setup 'refile nil nil org-log-refile))) - (and org-auto-align-tags - (let ((org-loop-over-headlines-in-active-region nil)) - (org-align-tags))) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-refile))) - (when bookmark-name - (with-demoted-errors "Bookmark set error: %S" - (bookmark-set bookmark-name)))) - ;; If we are refiling for capture, make sure that the - ;; last-capture pointers point here - (when (bound-and-true-p org-capture-is-refiling) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-capture-marker))) + (let ((origin (point-marker))) + ;; Handle special case when we refile to exactly same + ;; location with tree promotion/demotion. Point marker + ;; saved by `org-width-wide-buffer' (`save-excursion') + ;; will then remain before the inserted subtree in + ;; unexpected location. + (set-marker-insertion-type origin t) + (with-current-buffer (setq nbuf (find-file-noselect file 'nowarn)) + (setq reversed (org-notes-order-reversed-p)) + (org-with-wide-buffer + (if pos + (progn + (goto-char pos) + (setq level (org-get-valid-level (funcall outline-level) 1)) + (goto-char + (if reversed + (or (outline-next-heading) (point-max)) + (or (save-excursion (org-get-next-sibling)) + (org-end-of-subtree t t) + (point-max))))) + (setq level 1) + (if (not reversed) + (goto-char (point-max)) + (goto-char (point-min)) + (or (outline-next-heading) (goto-char (point-max))))) + (unless (bolp) (newline)) + (org-paste-subtree level nil nil t) + ;; Record information, according to `org-log-refile'. + ;; Do not prompt for a note when refiling multiple + ;; headlines, however. Simply add a time stamp. + (cond + ((not org-log-refile)) + (regionp + (org-map-region + (lambda () (org-add-log-setup 'refile nil nil 'time)) + (point) + (+ (point) (- region-end region-start)))) + (t + (org-add-log-setup 'refile nil nil org-log-refile))) + (and org-auto-align-tags + (let ((org-loop-over-headlines-in-active-region nil)) + (org-align-tags))) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-refile))) (when bookmark-name - (with-demoted-errors "Bookmark set error: %S" - (bookmark-set bookmark-name)))) - (move-marker org-capture-last-stored-marker (point))) - (deactivate-mark) - (run-hooks 'org-after-refile-insert-hook))) + (condition-case err + (bookmark-set bookmark-name) + (error + (message (format "Bookmark set error: %S" err)))))) + ;; If we are refiling for capture, make sure that the + ;; last-capture pointers point here + (when (bound-and-true-p org-capture-is-refiling) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-capture-marker))) + (when bookmark-name + (condition-case err + (bookmark-set bookmark-name) + (error + (message (format "Bookmark set error: %S" err)))))) + (move-marker org-capture-last-stored-marker (point))) + (deactivate-mark) + (run-hooks 'org-after-refile-insert-hook))) + ;; Go back to ORIGIN. + (goto-char origin)) (unless org-refile-keep (if regionp (delete-region (point) (+ (point) (- region-end region-start))) @@ -700,12 +725,11 @@ this function appends the default value from (when (org-string-nw-p re) (setq buffer (if (markerp pos) (marker-buffer pos) - (or (find-buffer-visiting file) - (find-file-noselect file)))) + (find-file-noselect file 'nowarn))) (with-current-buffer buffer (org-with-wide-buffer (goto-char pos) - (beginning-of-line 1) + (forward-line 0) (unless (looking-at-p re) (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling")))))))) @@ -716,8 +740,7 @@ this function appends the default value from (let ((file (nth 1 parent-target)) (pos (nth 3 parent-target)) level) - (with-current-buffer (or (find-buffer-visiting file) - (find-file-noselect file)) + (with-current-buffer (find-file-noselect file 'nowarn) (org-with-wide-buffer (if pos (goto-char pos) @@ -730,7 +753,7 @@ this function appends the default value from (insert "\n" (make-string (if pos (org-get-valid-level level 1) 1) ?*) " " child "\n") - (beginning-of-line 0) + (forward-line -1) (list (concat (car parent-target) "/" child) file "" (point)))))) (defun org-olpath-completing-read (prompt collection &rest args) @@ -752,6 +775,14 @@ this function appends the default value from (concat string (substring r 0 (match-end 0)) f) x))) (all-completions string thetable predicate)))) + ((eq (car-safe flag) 'boundaries) + ;; See `completion-file-name-table'. + (let ((start (or (and (string-match "/" string) + (match-beginning 0)) + (length string))) + (end (and (string-match "/" (cdr flag)) + (match-beginning 0)))) + `(boundaries ,start . ,end))) ;; Exact match? ((eq flag 'lambda) (assoc string thetable)))) args))) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 8cc11965812..d152fbfe8b1 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -39,6 +39,7 @@ (require 'org-macs) (require 'org-compat) (require 'org-keys) +(require 'sh-script) (declare-function org--get-expected-indentation "org" (element contentsp)) (declare-function org-mode "org" ()) @@ -47,11 +48,19 @@ (declare-function org-element-at-point "org-element" (&optional pom cached-only)) (declare-function org-element-class "org-element" (datum &optional parent)) (declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-lineage "org-element" +(declare-function org-element-lineage "org-element-ast" (blob &optional types with-self)) (declare-function org-element--parse-paired-brackets "org-element" (char)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-begin "org-element" (node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-contents-begin "org-element" (node)) +(declare-function org-element-contents-end "org-element" (node)) +(declare-function org-element-post-affiliated "org-element" (node)) +(declare-function org-element-post-blank "org-element" (node)) +(declare-function org-element-parent "org-element-ast" (node)) +(declare-function org-element-type "org-element-ast" (node &optional anonymous)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-footnote-goto-definition "org-footnote" (label &optional location)) @@ -110,15 +119,16 @@ These are the regions where each line starts with a colon." (defcustom org-src-preserve-indentation nil "If non-nil preserve leading whitespace characters on export. -\\ -If non-nil leading whitespace characters in source code blocks -are preserved on export, and when switching between the org -buffer and the language mode edit buffer. - -When this variable is nil, after editing with `\\[org-edit-src-code]', -the minimum (across-lines) number of leading whitespace characters -are removed from all lines, and the code block is uniformly indented -according to the value of `org-edit-src-content-indentation'." + +If non-nil leading whitespace characters in source code blocks are +preserved on export, or adjusted while indenting or when switching +between the org buffer and the language mode edit buffer. + +When this variable is nil, while indenting with `\\[org-indent-block]' +or after editing with `\\[org-edit-src-code]', the minimum (across-lines) +number of leading whitespace characters are removed from all lines, +and the code block is uniformly indented according to the value of +`org-edit-src-content-indentation'." :group 'org-edit-structure :type 'boolean) @@ -194,11 +204,17 @@ You may want to use this hook for example to turn off `outline-minor-mode' or similar things which you want to have when editing a source code file, but which mess up the display of a snippet in Org exported files.") +(defun org-src--get-known-shells () + "List all the shells in `sh-ancestor-alist' for `org-src-lang-modes'. +The shells are associated with `sh-mode'." + (mapcar + (lambda (shell) (cons (symbol-name shell) 'sh)) + (delete-dups (org--flatten-tree sh-ancestor-alist)))) + (defcustom org-src-lang-modes - '(("C" . c) + `(("C" . c) ("C++" . c++) ("asymptote" . asy) - ("bash" . sh) ("beamer" . latex) ("calc" . fundamental) ("cpp" . c++) @@ -208,9 +224,10 @@ but which mess up the display of a snippet in Org exported files.") ("elisp" . emacs-lisp) ("ocaml" . tuareg) ("screen" . shell-script) - ("shell" . sh) ("sqlite" . sql) - ("toml" . conf-toml)) + ("toml" . conf-toml) + ("shell" . sh) + ,@(org-src--get-known-shells)) "Alist mapping languages to their major mode. The key is the language name. The value is the mode name, as @@ -221,7 +238,7 @@ not the case, this variable provides a way to simplify things on the user side. For example, there is no `ocaml-mode' in Emacs, but the mode to use is `tuareg-mode'." :group 'org-edit-structure - :package-version '(Org . "9.6") + :package-version '(Org . "9.7") :type '(repeat (cons (string "Language name") @@ -233,7 +250,8 @@ Each element is a cell of the format (\"language\" FACE) -Where FACE is either a defined face or an anonymous face. +Where FACE is either a defined face or an anonymous face. Empty +language string refers to source blocks without specified language. For instance, the following would color the background of emacs-lisp source blocks and python source blocks in purple and @@ -247,7 +265,6 @@ green, respectability. (choice (face :tag "Face") (sexp :tag "Anonymous face")))) - :version "26.1" :package-version '(Org . "9.0")) (defcustom org-src-tab-acts-natively t @@ -310,9 +327,6 @@ is 0.") "File name associated to Org source buffer, or nil.") (put 'org-src-source-file-name 'permanent-local t) -(defvar-local org-src--preserve-blank-line nil) -(put 'org-src--preserve-blank-line 'permanent-local t) - (defun org-src--construct-edit-buffer-name (org-buffer-name lang) "Construct the buffer name for a source editing buffer. Format is \"*Org Src ORG-BUFFER-NAME[ LANG ]*\"." @@ -369,36 +383,36 @@ where BEG and END are buffer positions and CONTENTS is a string." (cond ((eq type 'footnote-definition) (let* ((beg (progn - (goto-char (org-element-property :post-affiliated datum)) + (goto-char (org-element-post-affiliated datum)) (search-forward "]"))) - (end (or (org-element-property :contents-end datum) beg))) + (end (or (org-element-contents-end datum) beg))) (list beg end (buffer-substring-no-properties beg end)))) ((eq type 'inline-src-block) - (let ((beg (progn (goto-char (org-element-property :begin datum)) + (let ((beg (progn (goto-char (org-element-begin datum)) (search-forward "{" (line-end-position) t))) - (end (progn (goto-char (org-element-property :end datum)) + (end (progn (goto-char (org-element-end datum)) (search-backward "}" (line-beginning-position) t)))) (list beg end (buffer-substring-no-properties beg end)))) ((eq type 'latex-fragment) - (let ((beg (org-element-property :begin datum)) - (end (org-with-point-at (org-element-property :end datum) + (let ((beg (org-element-begin datum)) + (end (org-with-point-at (org-element-end datum) (skip-chars-backward " \t") (point)))) (list beg end (buffer-substring-no-properties beg end)))) - ((org-element-property :contents-begin datum) - (let ((beg (org-element-property :contents-begin datum)) - (end (org-element-property :contents-end datum))) + ((org-element-contents-begin datum) + (let ((beg (org-element-contents-begin datum)) + (end (org-element-contents-end datum))) (list beg end (buffer-substring-no-properties beg end)))) ((memq type '(example-block export-block src-block comment-block)) - (list (progn (goto-char (org-element-property :post-affiliated datum)) + (list (progn (goto-char (org-element-post-affiliated datum)) (line-beginning-position 2)) - (progn (goto-char (org-element-property :end datum)) + (progn (goto-char (org-element-end datum)) (skip-chars-backward " \r\t\n") (line-beginning-position 1)) (org-element-property :value datum))) ((memq type '(fixed-width latex-environment table)) - (let ((beg (org-element-property :post-affiliated datum)) - (end (progn (goto-char (org-element-property :end datum)) + (let ((beg (org-element-post-affiliated datum)) + (end (progn (goto-char (org-element-end datum)) (skip-chars-backward " \r\t\n") (line-beginning-position 2)))) (list beg @@ -439,58 +453,89 @@ END." "Non-nil when point is on DATUM. DATUM is an element or an object. Consider blank lines or white spaces after it as being outside." - (and (>= (point) (org-element-property :begin datum)) + (and (>= (point) (org-element-begin datum)) (<= (point) - (org-with-wide-buffer - (goto-char (org-element-property :end datum)) - (skip-chars-backward " \r\t\n") - (if (eq (org-element-class datum) 'element) - (line-end-position) - (point)))))) - -(defun org-src--contents-for-write-back (write-back-buf) - "Populate WRITE-BACK-BUF with contents in the appropriate format. -Assume point is in the corresponding edit buffer." - (let ((indentation-offset - (if org-src--preserve-indentation 0 - (+ (or org-src--block-indentation 0) - (if (memq org-src--source-type '(example-block src-block)) - org-src--content-indentation - 0)))) - (use-tabs? (and (> org-src--tab-width 0) t)) - (preserve-fl (eq org-src--source-type 'latex-fragment)) - (source-tab-width org-src--tab-width) - (contents (org-with-wide-buffer - (let ((eol (line-end-position))) - (list (buffer-substring (point-min) eol) - (buffer-substring eol (point-max)))))) - (write-back org-src--allow-write-back) - (preserve-blank-line org-src--preserve-blank-line) - marker) + (org-with-wide-buffer + (goto-char (org-element-end datum)) + (skip-chars-backward " \r\t\n") + (if (eq (org-element-class datum) 'element) + (line-end-position) + (point)))))) + +(defun org-src-preserve-indentation-p (&optional node) + "Non-nil when indentation should be preserved within NODE. +When NODE is not passed, assume element at point." + (let ((node (or node (org-element-at-point)))) + (and (org-element-type-p node '(example-block src-block)) + (or (org-element-property :preserve-indent node) + org-src-preserve-indentation)))) + +(defun org-src--contents-for-write-back-1 + ( write-back-buf contents + &optional indentation-offset preserve-fl source-tab-width write-back) + "Populate WRITE-BACK-BUF with CONTENTS in the appropriate format. + +INDENTATION-OFFSET, when non-nil is additional indentation to be applied +to all the lines. PRESERVE-FL means that first line should not be +indented (useful for inline blocks contents that belong to paragraph). +The original indentation, if any, is not altered. + +TAB-WIDTH is `tab-width' to be used when indenting. The value of 0 +means that tabs should not be used. + +WRITE-BACK, when non-nil, is a function to be called with point at +WRITE-BACK-BUF after inserting the original contents, but before +applying extra indentation." + (let ((use-tabs? (and (> source-tab-width 0) t)) + indent-str) (with-current-buffer write-back-buf - ;; Reproduce indentation parameters from source buffer. - (setq indent-tabs-mode use-tabs?) - (when (> source-tab-width 0) (setq tab-width source-tab-width)) ;; Apply WRITE-BACK function on edit buffer contents. - (insert (org-no-properties (car contents))) - (setq marker (point-marker)) - (insert (org-no-properties (car (cdr contents)))) + (insert (org-no-properties contents)) (goto-char (point-min)) (when (functionp write-back) (save-excursion (funcall write-back))) ;; Add INDENTATION-OFFSET to every line in buffer, ;; unless indentation is meant to be preserved. - (when (> indentation-offset 0) - (when preserve-fl (forward-line)) + (when (and indentation-offset (> indentation-offset 0)) + ;; The exact sequence of tabs and spaces used to indent + ;; up to `indentation-offset' in the Org buffer. + (setq indent-str + (with-temp-buffer + ;; Reproduce indentation parameters. + (setq indent-tabs-mode use-tabs?) + (when (> source-tab-width 0) + (setq tab-width source-tab-width)) + (indent-to indentation-offset) + (buffer-string))) + ;; LaTeX-fragments are inline. Do not add indentation to their + ;; first line. + (when preserve-fl (forward-line)) (while (not (eobp)) - (skip-chars-forward " \t") - (when (or (not (eolp)) ; not a blank line - (and (eq (point) (marker-position marker)) ; current line - preserve-blank-line)) - (let ((i (current-column))) - (delete-region (line-beginning-position) (point)) - (indent-to (+ i indentation-offset)))) - (forward-line))) - (set-marker marker nil)))) + ;; Keep empty src lines empty, even when src block is + ;; indented on Org side. + ;; See https://list.orgmode.org/725763.1632663635@apollo2.minshall.org/T/ + (when (not (eolp)) ; not an empty line + (insert indent-str)) + (forward-line)))))) + +(defun org-src--contents-for-write-back (write-back-buf) + "Populate WRITE-BACK-BUF with contents in the appropriate format. +Assume point is in the corresponding edit buffer." + (org-src--contents-for-write-back-1 + write-back-buf + ;; CONTENTS + (org-with-wide-buffer (buffer-string)) + ;; INDENTATION + (if org-src--preserve-indentation 0 + (+ (or org-src--block-indentation 0) + (if (memq org-src--source-type '(example-block src-block)) + org-src--content-indentation + 0))) + ;; PRESERVE-FL + (eq org-src--source-type 'latex-fragment) + ;; TAB-WIDTH + org-src--tab-width + ;; WRITE-BACK + org-src--allow-write-back)) (defun org-src--edit-element (datum name &optional initialize write-back contents remote) @@ -532,24 +577,16 @@ Leave point in edit buffer." (source-file-name (buffer-file-name (buffer-base-buffer))) (source-tab-width (if indent-tabs-mode tab-width 0)) (type (org-element-type datum)) - (block-ind (org-with-point-at (org-element-property :begin datum) + (block-ind (org-with-point-at (org-element-begin datum) (cond ((save-excursion (skip-chars-backward " \t") (bolp)) (org-current-text-indentation)) - ((org-element-property :parent datum) + ((org-element-parent datum) (org--get-expected-indentation - (org-element-property :parent datum) nil)) + (org-element-parent datum) nil)) (t (org-current-text-indentation))))) (content-ind org-edit-src-content-indentation) - (blank-line (save-excursion (beginning-of-line) - (looking-at-p "^[[:space:]]*$"))) - (empty-line (and blank-line (looking-at-p "^$"))) - (preserve-blank-line (or (and blank-line (not empty-line)) - (and empty-line (= (+ block-ind content-ind) 0)))) - (preserve-ind - (and (memq type '(example-block src-block)) - (or (org-element-property :preserve-indent datum) - org-src-preserve-indentation))) + (preserve-ind (org-src-preserve-indentation-p datum)) ;; Store relative positions of mark (if any) and point ;; within the edited area. (point-coordinates (and (not remote) @@ -576,7 +613,7 @@ Leave point in edit buffer." ;; Initialize buffer. (when (functionp initialize) (let ((org-inhibit-startup t)) - (condition-case e + (condition-case-unless-debug e (funcall initialize) (error (message "Initialization fails with: %S" (error-message-string e)))))) @@ -595,7 +632,6 @@ Leave point in edit buffer." (setq org-src--overlay overlay) (setq org-src--allow-write-back write-back) (setq org-src-source-file-name source-file-name) - (setq org-src--preserve-blank-line preserve-blank-line) ;; Start minor mode. (org-src-mode) ;; Clear undo information so we cannot undo back to the @@ -629,7 +665,7 @@ Leave point in edit buffer." "Fontify code block between START and END using LANG's syntax. This function is called by Emacs' automatic fontification, as long as `org-src-fontify-natively' is non-nil." - (let ((modified (buffer-modified-p))) + (let ((modified (buffer-modified-p)) native-tab-width) (remove-text-properties start end '(face nil)) (let ((lang-mode (org-src-get-lang-mode lang))) (when (fboundp lang-mode) @@ -643,8 +679,11 @@ as `org-src-fontify-natively' is non-nil." ;; Add string and a final space to ensure property change. (insert string " ")) (unless (eq major-mode lang-mode) (funcall lang-mode)) + (setq native-tab-width tab-width) (font-lock-ensure) - (let ((pos (point-min)) next) + (let ((pos (point-min)) next + ;; Difference between positions here and in org-buffer. + (offset (- start (point-min)))) (while (setq next (next-property-change pos)) ;; Handle additional properties from font-lock, so as to ;; preserve, e.g., composition. @@ -658,9 +697,7 @@ as `org-src-fontify-natively' is non-nil." (when new-prop (if (not (eq prop 'invisible)) (put-text-property - (+ start (- pos (point-min))) - (+ start (- next (point-min))) - prop new-prop + (+ offset pos) (+ offset next) prop new-prop org-buffer) ;; Special case. `invisible' text property may ;; clash with Org folding. Do not assign @@ -692,8 +729,7 @@ as `org-src-fontify-natively' is non-nil." (when invisibility-spec (add-to-invisibility-spec invisibility-spec)) (put-text-property - (+ start (- pos (point-min))) - (+ start (- next (point-min))) + (+ offset pos) (+ offset next) 'org-src-invisible new-prop org-buffer))))))) (setq pos next))) @@ -703,8 +739,21 @@ as `org-src-fontify-natively' is non-nil." (when (or (facep src-face) (listp src-face)) (font-lock-append-text-property start end 'face src-face)) (font-lock-append-text-property start end 'face 'org-block)) - ;; Clear abbreviated link folding. - (org-fold-region start end nil 'org-link) + ;; Display native tab indentation characters as spaces + (save-excursion + (goto-char start) + (let ((indent-offset + (if (org-src-preserve-indentation-p) 0 + (+ (progn (backward-char) + (org-current-text-indentation)) + org-edit-src-content-indentation)))) + (while (re-search-forward "^[ ]*\t" end t) + (let* ((b (and (eq indent-offset (move-to-column indent-offset)) + (point))) + (e (progn (skip-chars-forward "\t") (point))) + (s (and b (make-string (* (- e b) native-tab-width) ? )))) + (when (and b (< b e)) (add-text-properties b e `(display ,s))) + (forward-char))))) (add-text-properties start end '(font-lock-fontified t fontified t font-lock-multiline t)) @@ -712,7 +761,7 @@ as `org-src-fontify-natively' is non-nil." (defun org-fontify-inline-src-blocks (limit) "Try to apply `org-fontify-inline-src-blocks-1'." - (condition-case nil + (condition-case-unless-debug nil (org-fontify-inline-src-blocks-1 limit) (error (message "Org mode fontification error in %S at %d" (current-buffer) @@ -727,12 +776,9 @@ as `org-src-fontify-natively' is non-nil." (lang-beg (match-beginning 1)) (lang-end (match-end 1)) pt) - (font-lock-append-text-property - lang-beg lang-end 'face 'org-meta-line) - (font-lock-append-text-property - beg lang-beg 'face 'shadow) - (font-lock-append-text-property - beg lang-end 'face 'org-inline-src-block) + (add-face-text-property beg lang-end 'org-inline-src-block) + (add-face-text-property beg lang-beg 'shadow) + (add-face-text-property lang-beg lang-end 'org-meta-line) (setq pt (goto-char lang-end)) ;; `org-element--parse-paired-brackets' doesn't take a limit, so to ;; prevent it searching the entire rest of the buffer we temporarily @@ -744,13 +790,11 @@ as `org-src-fontify-natively' is non-nil." (point))) (point-max)))) (when (ignore-errors (org-element--parse-paired-brackets ?\[)) - (font-lock-append-text-property - pt (point) 'face 'org-inline-src-block) + (add-face-text-property pt (point) 'org-inline-src-block) (setq pt (point))) (when (ignore-errors (org-element--parse-paired-brackets ?\{)) (remove-text-properties pt (point) '(face nil)) - (font-lock-append-text-property - pt (1+ pt) 'face '(org-inline-src-block shadow)) + (add-face-text-property pt (1+ pt) '(org-inline-src-block shadow)) (unless (= (1+ pt) (1- (point))) (if org-src-fontify-natively (org-src-font-lock-fontify-block @@ -758,8 +802,7 @@ as `org-src-fontify-natively' is non-nil." (1+ pt) (1- (point))) (font-lock-append-text-property (1+ pt) (1- (point)) 'face 'org-inline-src-block))) - (font-lock-append-text-property - (1- (point)) (point) 'face '(org-inline-src-block shadow)) + (add-face-text-property (1- (point)) (point) '(org-inline-src-block shadow)) (setq pt (point))))) t))) @@ -877,7 +920,6 @@ INFO should be a list similar in format to the return value of (interactive) (let ((session (cdr (assq :session (nth 2 info))))) (and session (not (string= session "none")) - (org-babel-comint-buffer-livep session) (let ((f (intern (format "org-babel-%s-associate-session" (nth 0 info))))) (and (fboundp f) (funcall f session)))))) @@ -964,7 +1006,7 @@ Raise an error when current buffer is not a source editing buffer." (`current-window (pop-to-buffer-same-window buffer)) (`other-window (let ((cur-win (selected-window))) - (org-switch-to-buffer-other-window buffer) + (switch-to-buffer-other-window buffer) (when (eq context 'exit) (quit-restore-window cur-win)))) (`split-window-below (if (eq context 'exit) @@ -987,9 +1029,10 @@ Raise an error when current buffer is not a source editing buffer." (pop-to-buffer-same-window buffer)) (_ (switch-to-buffer-other-frame buffer)))) (`reorganize-frame - (when (eq context 'edit) (delete-other-windows)) - (org-switch-to-buffer-other-window buffer) - (when (eq context 'exit) (delete-other-windows))) + (pcase context + (`edit (pop-to-buffer buffer '(org-display-buffer-split))) + (`exit (pop-to-buffer buffer '(org-display-buffer-full-frame))) + (_ (switch-to-buffer-other-window buffer)))) (`switch-invisibly (set-buffer buffer)) (_ (message "Invalid value %s for `org-src-window-setup'" @@ -1034,7 +1077,7 @@ A coderef format regexp can only match at the end of a line." (interactive) (let* ((context (org-element-context)) (label (org-element-property :label context))) - (unless (and (eq (org-element-type context) 'footnote-reference) + (unless (and (org-element-type-p context 'footnote-reference) (org-src--on-datum-p context)) (user-error "Not on a footnote reference")) (unless label (user-error "Cannot edit remotely anonymous footnotes")) @@ -1042,16 +1085,16 @@ A coderef format regexp can only match at the end of a line." (org-footnote-goto-definition label) (backward-char) (org-element-context))) - (inline? (eq 'footnote-reference (org-element-type definition))) + (inline? (org-element-type-p definition 'footnote-reference)) (contents (org-with-wide-buffer (buffer-substring-no-properties - (or (org-element-property :post-affiliated definition) - (org-element-property :begin definition)) + (or (org-element-post-affiliated definition) + (org-element-begin definition)) (cond - (inline? (1+ (org-element-property :contents-end definition))) - ((org-element-property :contents-end definition)) - (t (goto-char (org-element-property :post-affiliated definition)) + (inline? (1+ (org-element-contents-end definition))) + ((org-element-contents-end definition)) + (t (goto-char (org-element-post-affiliated definition)) (line-end-position))))))) (add-text-properties 0 @@ -1082,7 +1125,7 @@ A coderef format regexp can only match at the end of a line." ;; If footnote reference belongs to a table, make sure to ;; remove any newline characters in order to preserve ;; table's structure. - (when (org-element-lineage definition '(table-cell)) + (when (org-element-lineage definition 'table-cell) (while (search-forward "\n" nil t) (replace-match " "))))) contents 'remote)) @@ -1101,7 +1144,7 @@ the area in the Org mode buffer. Throw an error when not at such a table." (interactive) (let ((element (org-element-at-point))) - (unless (and (eq (org-element-type element) 'table) + (unless (and (org-element-type-p element 'table) (eq (org-element-property :type element) 'table.el) (org-src--on-datum-p element)) (user-error "Not in a table.el table")) @@ -1117,14 +1160,14 @@ Throw an error when not at such a table." "Edit LaTeX fragment at point." (interactive) (let ((context (org-element-context))) - (unless (and (eq 'latex-fragment (org-element-type context)) + (unless (and (org-element-type-p context 'latex-fragment) (org-src--on-datum-p context)) (user-error "Not on a LaTeX fragment")) (let* ((contents (buffer-substring-no-properties - (org-element-property :begin context) - (- (org-element-property :end context) - (org-element-property :post-blank context)))) + (org-element-begin context) + (- (org-element-end context) + (org-element-post-blank context)))) (delim-length (if (string-match "\\`\\$[^$]" contents) 1 2))) ;; Make the LaTeX deliminators read-only. (add-text-properties 0 delim-length @@ -1148,7 +1191,7 @@ Throw an error when not at such a table." ;; If within a table a newline would disrupt the structure, ;; so remove newlines. (goto-char (point-min)) - (when (org-element-lineage context '(table-cell)) + (when (org-element-lineage context 'table-cell) (while (search-forward "\n" nil t) (replace-match " ")))) contents)) t)) @@ -1165,7 +1208,7 @@ will then replace the LaTeX environment in the Org mode buffer." (interactive) (let ((element (org-element-at-point))) - (unless (and (eq (org-element-type element) 'latex-environment) + (unless (and (org-element-type-p element 'latex-environment) (org-src--on-datum-p element)) (user-error "Not in a LaTeX environment")) (org-src--edit-element @@ -1189,7 +1232,7 @@ the area in the Org mode buffer. Throw an error when not at an export block." (interactive) (let ((element (org-element-at-point))) - (unless (and (eq (org-element-type element) 'export-block) + (unless (and (org-element-type-p element 'export-block) (org-src--on-datum-p element)) (user-error "Not in an export block")) (let* ((type (downcase (or (org-element-property :type element) @@ -1217,7 +1260,7 @@ then replace the area in the Org mode buffer. Throw an error when not at a comment block." (interactive) (let ((element (org-element-at-point))) - (unless (and (eq (org-element-type element) 'comment-block) + (unless (and (org-element-type-p element 'comment-block) (org-src--on-datum-p element)) (user-error "Not in a comment block")) (org-src--edit-element @@ -1262,16 +1305,18 @@ name of the sub-editing buffer." element (or edit-buffer-name (org-src--construct-edit-buffer-name (buffer-name) lang)) - lang-f + (lambda () + (when lang-f (funcall lang-f)) + (setq-local org-coderef-label-format + (or (org-element-property :label-fmt element) + org-coderef-label-format)) + (when (eq type 'src-block) + (setq org-src--babel-info babel-info))) (and (null code) (lambda () (org-escape-code-in-region (point-min) (point-max)))) (and code (org-unescape-code-in-string code))) ;; Finalize buffer. - (setq-local org-coderef-label-format - (or (org-element-property :label-fmt element) - org-coderef-label-format)) (when (eq type 'src-block) - (setq org-src--babel-info babel-info) (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) (when (fboundp edit-prep-func) (funcall edit-prep-func babel-info)))) @@ -1281,7 +1326,7 @@ name of the sub-editing buffer." "Edit inline source code at point." (interactive) (let ((context (org-element-context))) - (unless (and (eq (org-element-type context) 'inline-src-block) + (unless (and (org-element-type-p context 'inline-src-block) (org-src--on-datum-p context)) (user-error "Not on inline source code")) (let* ((lang (org-element-property :language context)) @@ -1326,7 +1371,7 @@ will then replace the area in the Org mode buffer." (interactive) (let ((element (org-element-at-point))) - (unless (and (eq (org-element-type element) 'fixed-width) + (unless (and (org-element-type-p element 'fixed-width) (org-src--on-datum-p element)) (user-error "Not in a fixed-width area")) (org-src--edit-element @@ -1411,8 +1456,8 @@ EVENT is passed to `mouse-set-point'." (org-with-wide-buffer (when (and write-back (not (equal (buffer-substring beg end) - (with-current-buffer write-back-buf - (buffer-string))))) + (with-current-buffer write-back-buf + (buffer-string))))) (undo-boundary) (goto-char beg) (let ((expecting-bol (bolp))) @@ -1433,11 +1478,7 @@ EVENT is passed to `mouse-set-point'." (goto-char beg) (cond ;; Block is hidden; move at start of block. - ((if (eq org-fold-core-style 'text-properties) - (org-fold-folded-p nil 'block) - (cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) - (overlays-at (point)))) - (beginning-of-line 0)) + ((org-fold-folded-p nil 'block) (forward-line -1)) (write-back (org-src--goto-coordinates coordinates beg end)))) ;; Clean up left-over markers and restore window configuration. (set-marker beg nil) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index bf0f503da2e..37ce91570d2 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -52,14 +52,16 @@ (declare-function org-duration-p "org-duration" (duration &optional canonical)) (declare-function org-duration-to-minutes "org-duration" (duration &optional canonical)) (declare-function org-element-at-point "org-element" (&optional pom cached-only)) -(declare-function org-element-contents "org-element" (element)) -(declare-function org-element-extract-element "org-element" (element)) +(declare-function org-element-contents "org-element-ast" (node)) +(declare-function org-element-extract "org-element-ast" (node)) (declare-function org-element-interpret-data "org-element" (data)) -(declare-function org-element-lineage "org-element" (blob &optional types with-self)) +(declare-function org-element-lineage "org-element-ast" (blob &optional types with-self)) (declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated)) -(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) +(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only keep-deferred)) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-element-post-affiliated "org-element" (node)) +(declare-function org-element-type-p "org-element-ast" (node types)) (declare-function org-element-cache-reset "org-element" (&optional all no-persistence)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-export-create-backend "ox" (&rest rest) t) @@ -465,16 +467,17 @@ prevents it from hanging Emacs." This may be useful when columns have been shrunk." (save-excursion (when pos (goto-char pos)) - (goto-char (line-beginning-position)) - (let ((end (line-end-position)) str) - (goto-char (1- pos)) - (while (progn (forward-char 1) (< (point) end)) - (let ((ov (car (overlays-at (point))))) - (if (not ov) - (push (char-to-string (char-after)) str) - (push (overlay-get ov 'display) str) - (goto-char (1- (overlay-end ov)))))) - (format "|%s" (mapconcat #'identity (reverse str) ""))))) + (let* ((beg (line-beginning-position)) + (end (line-end-position)) + (str (buffer-substring beg end))) + ;; FIXME: This does not handle intersecting overlays. + (dolist (ov (overlays-in beg end)) + (when (overlay-get ov 'display) + (put-text-property + (- (overlay-start ov) beg) (- (overlay-end ov) beg) + 'display (overlay-get ov 'display) + str))) + str))) (defvar-local org-table-header-overlay nil) (put 'org-table-header-overlay 'permanent-local t) @@ -485,19 +488,29 @@ This may be useful when columns have been shrunk." (progn (when (overlayp org-table-header-overlay) (delete-overlay org-table-header-overlay)) + ;; We might be called after scrolling but before display is + ;; updated. Make sure that any queued redisplay is executed + ;; before we look into `window-start'. + (redisplay) (let* ((ws (window-start)) (beg (save-excursion + ;; Check table at window start, not at point. + ;; Point might be after the table, or at + ;; another table located below the one visible + ;; on top. + (goto-char ws) (goto-char (org-table-begin)) (while (or (org-at-table-hline-p) (looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>")) (move-beginning-of-line 2)) - (line-beginning-position))) - (end (save-excursion (goto-char beg) (line-end-position)))) + (line-beginning-position)))) (if (pos-visible-in-window-p beg) (when (overlayp org-table-header-overlay) (delete-overlay org-table-header-overlay)) (setq org-table-header-overlay - (make-overlay ws (+ ws (- end beg)))) + (make-overlay + (save-excursion (goto-char ws) (line-beginning-position)) + (save-excursion (goto-char ws) (line-end-position)))) (org-overlay-display org-table-header-overlay (org-table-row-get-visible-string beg) @@ -753,16 +766,16 @@ Field is restored even in case of abnormal exit." "Non-nil when point (or POS) is in #+TBLFM line." (save-excursion (goto-char (or pos (point))) - (beginning-of-line) + (forward-line 0) (and (let ((case-fold-search t)) (looking-at org-TBLFM-regexp)) - (eq (org-element-type (org-element-at-point)) 'table)))) + (org-element-type-p (org-element-at-point) 'table)))) (defun org-at-table-p (&optional table-type) "Non-nil if the cursor is inside an Org table. If TABLE-TYPE is non-nil, also check for table.el-type tables." (and (org-match-line (if table-type "[ \t]*[|+]" "[ \t]*|")) (or (not (derived-mode-p 'org-mode)) - (let ((e (org-element-lineage (org-element-at-point) '(table) t))) + (let ((e (org-element-lineage (org-element-at-point) 'table t))) (and e (or table-type (eq 'org (org-element-property :type e)))))))) @@ -770,7 +783,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." "Non-nil when point is at a table.el table." (and (org-match-line "[ \t]*[|+]") (let ((element (org-element-at-point))) - (and (eq (org-element-type element) 'table) + (and (org-element-type-p element 'table) (eq (org-element-property :type element) 'table.el))))) (defun org-at-table-hline-p () @@ -844,7 +857,7 @@ SIZE is a string Columns x Rows like for example \"3x2\"." "\n"))) (if (string-match "^[ \t]*$" (buffer-substring-no-properties (line-beginning-position) (point))) - (beginning-of-line 1) + (forward-line 0) (newline)) ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) (dotimes (_ rows) (insert line)) @@ -879,7 +892,10 @@ nil When nil, the command tries to be smart and figure out the separator in the following way: - when each line contains a TAB, assume TAB-separated material - when each line contains a comma, assume CSV material - - else, assume one or more SPACE characters as separator." + - else, assume one or more SPACE characters as separator. +`babel-auto' + Use the same rules as nil, but do not try any separator when + the region contains a single line and has no commas or tabs." (interactive "r\nP") (let* ((beg (min beg0 end0)) (end (max beg0 end0)) @@ -890,18 +906,21 @@ nil When nil, the command tries to be smart and figure out the (when (equal separator '(64)) (setq separator (read-regexp "Regexp for field separator"))) (goto-char beg) - (beginning-of-line 1) + (forward-line 0) (setq beg (point-marker)) (goto-char end) (if (bolp) (backward-char 1) (end-of-line 1)) (setq end (point-marker)) ;; Get the right field separator - (unless separator + (when (or (not separator) (eq separator 'babel-auto)) (goto-char beg) (setq separator (cond - ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) - ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) + ((not (save-excursion (re-search-forward "^[^\n\t]+$" end t))) '(16)) + ((not (save-excursion (re-search-forward "^[^\n,]+$" end t))) '(4)) + ((and (eq separator 'babel-auto) + (= 1 (count-lines beg end))) + (rx unmatchable)) (t 1)))) (goto-char beg) (if (equal separator '(4)) @@ -909,13 +928,13 @@ nil When nil, the command tries to be smart and figure out the ;; parse the csv stuff (cond ((looking-at "^") (insert "| ")) - ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) + ((looking-at "[ \t]*$") (replace-match " |") (forward-line 1)) ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") (replace-match "\\1") (if (looking-at "\"") (insert "\""))) ((looking-at "[^,\n]+") (goto-char (match-end 0))) ((looking-at "[ \t]*,") (replace-match " | ")) - (t (beginning-of-line 2)))) + (t (forward-line 1)))) (setq re (cond ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") ((equal separator '(16)) "^\\|\t") @@ -992,9 +1011,9 @@ applies a recipe that works for simple tables." ;; insert a hline before first (goto-char beg) (org-table-insert-hline 'above) - (beginning-of-line -1) + (forward-line -2) ;; insert a hline after each line - (while (progn (beginning-of-line 3) (< (point) end)) + (while (progn (forward-line 2) (< (point) end)) (org-table-insert-hline)) (goto-char beg) (setq end (move-marker end (org-table-end))) @@ -1016,7 +1035,7 @@ With a non-nil optional argument TABLE-TYPE, return the beginning of a table.el-type table. This function assumes point is on a table." (cond (table-type - (org-element-property :post-affiliated (org-element-at-point))) + (org-element-post-affiliated (org-element-at-point))) ((save-excursion (and (re-search-backward org-table-border-regexp nil t) (line-beginning-position 2)))) @@ -1030,7 +1049,7 @@ a table.el-type table. This function assumes point is on a table." (save-excursion (cond (table-type - (goto-char (org-element-property :end (org-element-at-point))) + (goto-char (org-element-end (org-element-at-point))) (skip-chars-backward " \t\n") (line-beginning-position 2)) ((re-search-forward org-table-border-regexp nil t) @@ -1068,7 +1087,7 @@ Before doing so, re-align the table if necessary." (goto-char (match-beginning 1))) (if (looking-at "-") (progn - (beginning-of-line 0) + (forward-line -1) (org-table-insert-row 'below)) (if (looking-at " ") (forward-char 1)))) (error @@ -1134,7 +1153,8 @@ With numeric argument N, move N-1 fields forward first." ;;;###autoload (defun org-table-next-row () "Go to the next row (same column) in the current table. -Before doing so, re-align the table if necessary." +When next row is an hline or outside the table, create a new empty +row. Before doing so, re-align the table if necessary." (interactive) (org-table-maybe-eval-formula) (org-table-maybe-recalculate-line) @@ -1142,11 +1162,11 @@ Before doing so, re-align the table if necessary." org-table-may-need-update) (org-table-align)) (let ((col (org-table-current-column))) - (beginning-of-line 2) + (forward-line 1) (unless (bolp) (insert "\n")) ;missing newline at eob (when (or (not (org-at-table-p)) (org-at-table-hline-p)) - (beginning-of-line 0) + (forward-line -1) (org-table-insert-row 'below)) (org-table-goto-column col) (skip-chars-backward "^|\n\r") @@ -1189,7 +1209,7 @@ When ALIGN is set, also realign the table." (interactive) (save-excursion (let ((pos (point))) - (beginning-of-line) + (forward-line 0) (if (not (search-forward "|" pos t)) 0 (let ((column 1) (separator (if (org-at-table-hline-p) "[+|]" "|"))) @@ -1230,7 +1250,7 @@ Return t when the line exists, nil if it does not exist." (if (looking-at "|[^|\n]+") (let* ((pos (match-beginning 0)) (match (match-string 0)) - (len (save-match-data (org-string-width match)))) + (len (save-match-data (org-string-width match nil 'org-table)))) (replace-match (concat "|" (make-string (1- len) ?\ ))) (goto-char (+ 2 pos)) (substring match 1))))) @@ -1341,7 +1361,7 @@ of the field. If there are less than N fields, just go to after the last delimiter. However, when FORCE is non-nil, create new columns if necessary." (interactive "p") - (beginning-of-line 1) + (forward-line 0) (when (> n 0) (while (and (> (setq n (1- n)) -1) (or (search-forward "|" (line-end-position) t) @@ -1620,15 +1640,15 @@ Swap with anything in target cell." (interactive "P") (let* ((col (current-column)) (pos (point)) - (hline1p (save-excursion (beginning-of-line 1) + (hline1p (save-excursion (forward-line 0) (looking-at org-table-hline-regexp))) (dline1 (org-table-current-dline)) (dline2 (+ dline1 (if up -1 1))) - (tonew (if up 0 2)) + (tonew (if up -1 1)) hline2p) (when (and up (= (point-min) (line-beginning-position))) (user-error "Cannot move row further")) - (beginning-of-line tonew) + (forward-line tonew) (when (or (and (not up) (eobp)) (not (org-at-table-p))) (goto-char pos) (user-error "Cannot move row further")) @@ -1637,16 +1657,16 @@ Swap with anything in target cell." (goto-char pos) (let ((row (delete-and-extract-region (line-beginning-position) (line-beginning-position 2)))) - (beginning-of-line tonew) + (forward-line tonew) (unless (bolp) (insert "\n")) ;at eob without a newline (insert row) (unless (bolp) (insert "\n")) ;missing final newline in ROW - (beginning-of-line 0) + (forward-line -1) (org-move-to-column col) (unless (or hline1p hline2p (not (or (not org-table-fix-formulas-confirm) - (funcall org-table-fix-formulas-confirm - "Fix formulas? ")))) + (funcall org-table-fix-formulas-confirm + "Fix formulas? ")))) (org-table-fix-formulas "@" (list (cons (number-to-string dline1) (number-to-string dline2)) @@ -1667,12 +1687,12 @@ With prefix ARG, insert below the current line." ;; Fix the first field if necessary (when (string-match "^[ \t]*| *[#*$] *|" line) (setq new (replace-match (match-string 0 line) t t new))) - (beginning-of-line (if arg 2 1)) + (forward-line (if arg 1 0)) ;; Buffer may not end of a newline character, so ensure - ;; (beginning-of-line 2) moves point to a new line. + ;; (forward-line 1) moves point to a new line. (unless (bolp) (insert "\n")) (let (org-table-may-need-update) (insert-before-markers new "\n")) - (beginning-of-line 0) + (forward-line -1) (re-search-forward "| ?" (line-end-position) t) (when (or org-table-may-need-update org-table-overlay-coordinates) (org-table-align)) @@ -1698,9 +1718,9 @@ With prefix ABOVE, insert above the current line." (concat "+" (make-string (- (match-end 1) (match-beginning 1)) ?-) "|") t t line))) (and (string-match "\\+" line) (setq line (replace-match "|" t t line))) - (beginning-of-line (if above 1 2)) + (forward-line (if above 0 1)) (insert line "\n") - (beginning-of-line (if above 1 -1)) + (forward-line (if above 0 -2)) (org-move-to-column col) (when org-table-overlay-coordinates (org-table-align))))) @@ -1729,7 +1749,7 @@ In particular, this does handle wide and invisible characters." (concat "|" (make-string (save-match-data - (org-string-width (match-string 1 s))) + (org-string-width (match-string 1 s) nil 'org-table)) ?\ ) "|") t t s))) @@ -1746,7 +1766,7 @@ In particular, this does handle wide and invisible characters." (org-table-with-shrunk-columns (kill-region (line-beginning-position) (min (1+ (line-end-position)) (point-max))) - (if (not (org-at-table-p)) (beginning-of-line 0)) + (if (not (org-at-table-p)) (forward-line -1)) (org-move-to-column col) (when (and dline (or (not org-table-fix-formulas-confirm) @@ -1892,7 +1912,7 @@ However, when N is 0, do not increment the field at all." (save-excursion ;; Get reference field. (if initial-field (setq field initial-field) - (beginning-of-line) + (forward-line 0) (setq field (catch :exit (while (re-search-backward org-table-dataline-regexp beg t) @@ -1900,7 +1920,7 @@ However, when N is 0, do not increment the field at all." (cond ((and (> n 1) f) (cl-decf n)) (f (throw :exit (org-trim f))) (t nil)) - (beginning-of-line))) + (forward-line 0))) (user-error "No non-empty field found")))) ;; Check if increment is appropriate, and how it should be done. (when (and org-table-copy-increment (/= n 0)) @@ -1922,8 +1942,8 @@ However, when N is 0, do not increment the field at all." (let ((org-table-may-need-update nil)) (org-table-next-row)) (org-table-blank-field)) ;; Insert the new field. NEW-FIELD may be nil if - ;; `org-table-increment' is nil, or N = 0. In that case, copy - ;; FIELD. + ;; `org-table-copy-increment' is nil, or N = 0. In that case, + ;; copy FIELD. (insert (or next-field field)) (org-table-maybe-recalculate-line) (org-table-align))) @@ -2049,7 +2069,7 @@ toggle `org-table-follow-field-mode'." (cw (current-window-configuration)) p) (goto-char pos) - (org-switch-to-buffer-other-window "*Org Table Edit Field*") + (switch-to-buffer-other-window "*Org Table Edit Field*") (when (and (local-variable-p 'org-field-marker) (markerp org-field-marker)) (move-marker org-field-marker nil)) @@ -2185,7 +2205,7 @@ If optional argument LOCATION is a buffer position, insert it at LOCATION instead." (save-excursion (if location - (progn (goto-char location) (beginning-of-line)) + (progn (goto-char location) (forward-line 0)) (goto-char (org-table-end))) (let ((case-fold-search t)) (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+TBLFM:\\)\\(.*\n?\\)") @@ -2235,7 +2255,7 @@ on the first line after the table. However, if optional argument LOCATION is a buffer position, consider the formulas there." (save-excursion (if location - (progn (goto-char location) (beginning-of-line)) + (progn (goto-char location) (forward-line 0)) (goto-char (org-table-end))) (let ((case-fold-search t)) (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") @@ -2355,7 +2375,7 @@ of the new mark." newchar)) (when l1 (goto-char l1)) (save-excursion - (beginning-of-line) + (forward-line 0) (unless (looking-at org-table-dataline-regexp) (user-error "Not at a table data line"))) (when no-special-column @@ -2364,7 +2384,7 @@ of the new mark." (let ((previous-line-end (line-end-position)) (newchar (save-excursion - (beginning-of-line) + (forward-line 0) (cond ((not (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")) "#") (newchar) (t (cadr (member (match-string 1) @@ -2396,8 +2416,8 @@ of the new mark." (interactive) (and org-table-allow-automatic-line-recalculation (not (and (memq last-command org-recalc-commands) - (eq org-last-recalc-line (line-beginning-position)))) - (save-excursion (beginning-of-line 1) + (eq org-last-recalc-line (line-beginning-position)))) + (save-excursion (forward-line 0) (looking-at org-table-auto-recalculate-regexp)) (org-table-recalculate) t)) @@ -2628,10 +2648,10 @@ location of point." duration-output-format) ev)) - ;; Use <...> time-stamps so that Calc can handle them. + ;; Use <...> timestamps so that Calc can handle them. (setq form (replace-regexp-in-string org-ts-regexp-inactive "<\\1>" form)) - ;; Internationalize local time-stamps by setting locale to + ;; Internationalize local timestamps by setting locale to ;; "C". (setq form (replace-regexp-in-string @@ -2648,11 +2668,16 @@ location of point." form (calc-eval (cons form calc-modes) (when (and (not keep-empty) numbers) 'num))) - ev (if duration (org-table-time-seconds-to-string - (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) - (string-to-number (org-table-time-string-to-seconds ev)) - (string-to-number ev)) - duration-output-format) + ev (if (and duration + ;; When the result is an empty string, + ;; keep it empty. + ;; See https://list.orgmode.org/orgmode/CAF_DUeEFpNU5UXjE80yB1MB9xj5oVLqG=XadnkqCdzWtakWdPg@mail.gmail.com/ + (not (string-empty-p ev))) + (org-table-time-seconds-to-string + (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 @@ -2862,10 +2887,15 @@ list, `literal' is for the format specifier L." (if lispp (if (eq lispp 'literal) elements - (if (and (equal elements "") (not keep-empty)) - "" - (prin1-to-string - (if numbers (string-to-number elements) elements)))) + ;; Ignore KEEP-EMPTY here. + ;; When ELEMENTS="" and NUMBERS=t, (string-to-number "") + ;; returns 0 - consistent with (0) for Calc branch. + ;; When ELEMENTS="" and NUMBERS=nil, `prin1-to-string' will + ;; return "\"\"" - historical behavior that also does not + ;; leave missing arguments in formulas like (string< $1 $2) + ;; when $2 cell is empty. + (prin1-to-string + (if numbers (string-to-number elements) elements))) (if (string-match "\\S-" elements) (progn (when numbers (setq elements (number-to-string @@ -3151,7 +3181,7 @@ with the prefix ARG." (insert formula "\n") (let ((e (point-marker))) ;; Recalculate the table. - (beginning-of-line 0) ; move to the inserted line + (forward-line -1) ; move to the inserted line (skip-chars-backward " \r\n\t") (unwind-protect (org-call-with-arg #'org-table-recalculate (or arg t)) @@ -3355,7 +3385,10 @@ Parameters get priority." (titles '((column . "# Column Formulas\n") (field . "# Field and Range Formulas\n") (named . "# Named Field Formulas\n")))) - (org-switch-to-buffer-other-window "*Edit Formulas*") + (let ((pop-up-frames nil)) + ;; We explicitly prohibit creating edit buffer in a new frame + ;; - such configuration is not supported. + (switch-to-buffer-other-window "*Edit Formulas*")) (erase-buffer) ;; Keep global-font-lock-mode from turning on font-lock-mode (let ((font-lock-global-modes '(not fundamental-mode))) @@ -3676,7 +3709,9 @@ With prefix ARG, apply the new formulas to the table." (org-table-store-formulas eql) (set-marker pos nil) (set-marker source nil) - (kill-buffer "*Edit Formulas*") + (when-let ((window (get-buffer-window "*Edit Formulas*" t))) + (quit-window 'kill window)) + (when (get-buffer "*Edit Formulas*") (kill-buffer "*Edit Formulas*")) (if arg (org-table-recalculate 'all) (message "New formulas installed - press C-u C-c C-c to apply.")))) @@ -3696,7 +3731,7 @@ With prefix ARG, apply the new formulas to the table." "Pretty-print and re-indent Lisp expressions in the Formula Editor." (interactive) (let ((pos (point)) beg end ind) - (beginning-of-line 1) + (forward-line 0) (cond ((looking-at "[ \t]") (goto-char pos) @@ -3722,7 +3757,7 @@ With prefix ARG, apply the new formulas to the table." (untabify (point-min) (point-max)) (goto-char (1+ (point-min))) (while (re-search-forward "^." nil t) - (beginning-of-line 1) + (forward-line 0) (insert ind)) (goto-char (point-max)) (org-delete-backward-char 1))) @@ -3903,7 +3938,7 @@ When non-nil, return the overlay narrowing the field." ;; However, fixing it requires checking every row, which may be ;; slow on large tables. Moreover, the hindrance of this ;; pathological case is very limited. - (beginning-of-line) + (forward-line 0) (search-forward "|") (let ((separator (if (org-at-table-hline-p) "+" "|")) (column 1) @@ -3989,7 +4024,7 @@ already hidden." start end (make-string (1+ width) ?-) ""))) ((equal contents "") ;no contents to hide (list - (let ((w (org-string-width (buffer-substring start end))) + (let ((w (org-string-width (buffer-substring start end) nil 'org-table)) ;; We really want WIDTH + 2 whitespace, to include blanks ;; around fields. (full (+ 2 width))) @@ -4008,7 +4043,8 @@ already hidden." (let* ((lead (org-with-point-at start (skip-chars-forward " "))) (trail (org-with-point-at end (abs (skip-chars-backward " ")))) (contents-width (org-string-width - (buffer-substring (+ start lead) (- end trail))))) + (buffer-substring (+ start lead) (- end trail)) + nil 'org-table))) (cond ;; Contents are too large to fit in WIDTH character. Limit, if ;; possible, blanks at the beginning of the field to a single @@ -4033,7 +4069,7 @@ already hidden." (let ((mean (+ (ash lower -1) (ash upper -1) (logand lower upper 1)))) - (pcase (org-string-width (buffer-substring begin mean)) + (pcase (org-string-width (buffer-substring begin mean) nil 'org-table) ((pred (= width)) (throw :exit mean)) ((pred (< width)) (setq upper mean)) (_ (setq lower mean))))) @@ -4084,8 +4120,8 @@ already hidden." "Read column selection select as a list of numbers. SELECT is a string containing column ranges, separated by white -space characters, see `org-table-hide-column' for details. MAX -is the maximum column number. +space characters, see `org-table-toggle-column-width' for details. +MAX is the maximum column number. Return value is a sorted list of numbers. Ignore any number outside of the [1;MAX] range." @@ -4261,13 +4297,13 @@ beginning and end position of the current table." "Apply function F to the start of all tables in the buffer." (org-with-point-at 1 (while (re-search-forward org-table-line-regexp nil t) - (let ((table (org-element-lineage (org-element-at-point) '(table) t))) + (let ((table (org-element-lineage (org-element-at-point) 'table t))) (when table (unless quietly (message "Mapping tables: %d%%" (floor (* 100.0 (point)) (buffer-size)))) - (goto-char (org-element-property :post-affiliated table)) - (let ((end (copy-marker (org-element-property :end table)))) + (goto-char (org-element-post-affiliated table)) + (let ((end (copy-marker (org-element-end table)))) (unwind-protect (progn (funcall f) (goto-char end)) (set-marker end nil))))))) @@ -4334,14 +4370,8 @@ extension of the given file name, and finally on the variable (table (org-table-to-lisp))) (unless (fboundp transform) (user-error "No such transformation function %s" transform)) - (let (buf) - (with-current-buffer (find-file-noselect file) - (setq buf (current-buffer)) - (erase-buffer) - (fundamental-mode) - (insert (funcall transform table params) "\n") - (save-buffer)) - (kill-buffer buf)) + (with-temp-file file + (insert (funcall transform table params) "\n")) (message "Export done.")) (user-error "TABLE_EXPORT_FORMAT invalid"))))) @@ -4350,7 +4380,7 @@ extension of the given file name, and finally on the variable "Format FIELD according to column WIDTH and alignment ALIGN. FIELD is a string. WIDTH is a number. ALIGN is either \"c\", \"l\" or\"r\"." - (let* ((spaces (- width (org-string-width field))) + (let* ((spaces (- width (org-string-width field nil 'org-table))) (prefix (pcase align ("l" "") ("r" (make-string spaces ?\s)) @@ -4399,7 +4429,7 @@ FIELD is a string. WIDTH is a number. ALIGN is either \"c\", (non-empty 0)) (dolist (row rows) (let ((cell (or (nth i row) ""))) - (setq max-width (max max-width (org-string-width cell))) + (setq max-width (max max-width (org-string-width cell nil 'org-table))) (cond (fixed-align? nil) ((equal cell "") nil) ((string-match "\\`<\\([lrc]\\)[0-9]*>\\'" cell) @@ -4466,46 +4496,48 @@ Optional argument NEW may specify text to replace the current field content." (cond ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway ((org-at-table-hline-p)) - ((and (not new) - (or (not (eq (marker-buffer org-table-aligned-begin-marker) - (current-buffer))) - (< (point) org-table-aligned-begin-marker) - (>= (point) org-table-aligned-end-marker))) - ;; This is not the same table, force a full re-align. - (setq org-table-may-need-update t)) (t - ;; Realign the current field, based on previous full realign. - (let ((pos (point)) - (col (org-table-current-column))) - (when (> col 0) - (skip-chars-backward "^|") - (if (not (looking-at " *\\(?:\\([^|\n]*?\\) *\\(|\\)\\|\\([^|\n]+?\\) *\\($\\)\\)")) - (setq org-table-may-need-update t) - (let* ((align (nth (1- col) org-table-last-alignment)) - (width (nth (1- col) org-table-last-column-widths)) - (cell (match-string 0)) - (field (match-string 1)) - (properly-closed? (/= (match-beginning 2) (match-end 2))) - (new-cell - (save-match-data - (cond (org-table-may-need-update - (format " %s |" (or new field))) - ((not properly-closed?) - (setq org-table-may-need-update t) - (format " %s |" (or new field))) - ((not new) - (concat (org-table--align-field field width align) - "|")) - ((and width (<= (org-string-width new) width)) - (concat (org-table--align-field new width align) - "|")) - (t - (setq org-table-may-need-update t) - (format " %s |" new)))))) - (unless (equal new-cell cell) - (let (org-table-may-need-update) - (replace-match new-cell t t))) - (goto-char pos)))))))) + (when (or (not (eq (marker-buffer org-table-aligned-begin-marker) + (current-buffer))) + (< (point) org-table-aligned-begin-marker) + (>= (point) org-table-aligned-end-marker)) + ;; This is not the same table, force a full re-align. + (setq org-table-may-need-update t + org-table-last-alignment nil + org-table-last-column-widths nil)) + (when new + ;; Realign the current field, based on previous full realign. + (let ((pos (point)) + (col (org-table-current-column))) + (when (> col 0) + (skip-chars-backward "^|") + (if (not (looking-at " *\\(?:\\([^|\n]*?\\) *\\(|\\)\\|\\([^|\n]+?\\) *\\($\\)\\)")) + (setq org-table-may-need-update t) + (let* ((align (nth (1- col) org-table-last-alignment)) + (width (nth (1- col) org-table-last-column-widths)) + (cell (match-string 0)) + (field (match-string 1)) + (properly-closed? (/= (match-beginning 2) (match-end 2))) + (new-cell + (save-match-data + (cond (org-table-may-need-update + (format " %s |" (or new field))) + ((not properly-closed?) + (setq org-table-may-need-update t) + (format " %s |" (or new field))) + ((not new) + (concat (org-table--align-field field width align) + "|")) + ((and width (<= (org-string-width new nil 'org-table) width)) + (concat (org-table--align-field new width align) + "|")) + (t + (setq org-table-may-need-update t) + (format " %s |" new)))))) + (unless (equal new-cell cell) + (let (org-table-may-need-update) + (replace-match new-cell t t))) + (goto-char pos))))))))) ;;;###autoload (defun org-table-sort-lines @@ -4605,8 +4637,8 @@ function is being called interactively." (predicate (cl-case sorting-type ((?n ?N ?t ?T) #'<) - ((?a ?A) (if with-case #'string-collate-lessp - (lambda (s1 s2) (string-collate-lessp s1 s2 nil t)))) + ((?a ?A) (if with-case #'org-string< + (lambda (s1 s2) (org-string< s1 s2 nil t)))) ((?f ?F) (or compare-func (and interactive? @@ -4979,7 +5011,7 @@ When LOCAL is non-nil, show references for the table at point." (save-excursion (end-of-line) (re-search-backward "^\\S-" nil t) - (beginning-of-line) + (forward-line 0) (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\ \\([0-9]+\\|&\\)\\) *=") (setq dest @@ -4990,8 +5022,8 @@ When LOCAL is non-nil, show references for the table at point." (if (and (markerp pos) (marker-buffer pos)) (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))))) + (switch-to-buffer-other-window (get-buffer-window + (marker-buffer pos))))) (goto-char pos) (org-table--force-dataline) (let ((table-start @@ -5193,7 +5225,7 @@ When LOCAL is non-nil, show references for the table at point." ;; accident in Org mode. (message "Orgtbl mode is not useful in Org mode, command ignored")) (orgtbl-mode - (and (orgtbl-setup) (defun orgtbl-setup () nil)) ;; FIXME: Yuck!?! + (orgtbl-setup) ;; Make sure we are first in minor-mode-map-alist (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) ;; FIXME: maybe it should use emulation-mode-map-alists? @@ -5248,92 +5280,91 @@ to execute outside of tables." (interactive) (user-error "This key has no function outside tables")) +;; Fill in orgtbl keymap. +(let ((nfunc 0) + (bindings + '(([(meta shift left)] org-table-delete-column) + ([(meta left)] org-table-move-column-left) + ([(meta right)] org-table-move-column-right) + ([(meta shift right)] org-table-insert-column) + ([(meta shift up)] org-table-kill-row) + ([(meta shift down)] org-table-insert-row) + ([(meta up)] org-table-move-row-up) + ([(meta down)] org-table-move-row-down) + ("\C-c\C-w" org-table-cut-region) + ("\C-c\M-w" org-table-copy-region) + ("\C-c\C-y" org-table-paste-rectangle) + ("\C-c\C-w" org-table-wrap-region) + ("\C-c-" org-table-insert-hline) + ("\C-c}" org-table-toggle-coordinate-overlays) + ("\C-c{" org-table-toggle-formula-debugger) + ("\C-m" org-table-next-row) + ([(shift return)] org-table-copy-down) + ("\C-c?" org-table-field-info) + ("\C-c " org-table-blank-field) + ("\C-c+" org-table-sum) + ("\C-c=" org-table-eval-formula) + ("\C-c'" org-table-edit-formulas) + ("\C-c`" org-table-edit-field) + ("\C-c*" org-table-recalculate) + ("\C-c^" org-table-sort-lines) + ("\M-a" org-table-beginning-of-field) + ("\M-e" org-table-end-of-field) + ([(control ?#)] org-table-rotate-recalc-marks))) + elt key fun cmd) + (while (setq elt (pop bindings)) + (setq nfunc (1+ nfunc)) + (setq key (org-key (car elt)) + fun (nth 1 elt) + cmd (orgtbl-make-binding fun nfunc key)) + (org-defkey orgtbl-mode-map key cmd)) + + ;; Special treatment needed for TAB, RET and DEL + (org-defkey orgtbl-mode-map [(return)] + (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)])) + (org-defkey orgtbl-mode-map [(tab)] + (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)])) + (org-defkey orgtbl-mode-map [(shift tab)] + (orgtbl-make-binding 'org-table-previous-field 104 + [(shift tab)] [(tab)] "\C-i")) + (org-defkey orgtbl-mode-map [backspace] + (orgtbl-make-binding 'org-delete-backward-char 109 + [backspace] (kbd "DEL"))) + + (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")) + + (org-defkey orgtbl-mode-map [backtab] + (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)])) + (org-defkey orgtbl-mode-map [(meta return)] + (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)) + (defun orgtbl-setup () "Setup orgtbl keymaps." - (let ((nfunc 0) - (bindings - '(([(meta shift left)] org-table-delete-column) - ([(meta left)] org-table-move-column-left) - ([(meta right)] org-table-move-column-right) - ([(meta shift right)] org-table-insert-column) - ([(meta shift up)] org-table-kill-row) - ([(meta shift down)] org-table-insert-row) - ([(meta up)] org-table-move-row-up) - ([(meta down)] org-table-move-row-down) - ("\C-c\C-w" org-table-cut-region) - ("\C-c\M-w" org-table-copy-region) - ("\C-c\C-y" org-table-paste-rectangle) - ("\C-c\C-w" org-table-wrap-region) - ("\C-c-" org-table-insert-hline) - ("\C-c}" org-table-toggle-coordinate-overlays) - ("\C-c{" org-table-toggle-formula-debugger) - ("\C-m" org-table-next-row) - ([(shift return)] org-table-copy-down) - ("\C-c?" org-table-field-info) - ("\C-c " org-table-blank-field) - ("\C-c+" org-table-sum) - ("\C-c=" org-table-eval-formula) - ("\C-c'" org-table-edit-formulas) - ("\C-c`" org-table-edit-field) - ("\C-c*" org-table-recalculate) - ("\C-c^" org-table-sort-lines) - ("\M-a" org-table-beginning-of-field) - ("\M-e" org-table-end-of-field) - ([(control ?#)] org-table-rotate-recalc-marks))) - elt key fun cmd) - (while (setq elt (pop bindings)) - (setq nfunc (1+ nfunc)) - (setq key (org-key (car elt)) - fun (nth 1 elt) - cmd (orgtbl-make-binding fun nfunc key)) - (org-defkey orgtbl-mode-map key cmd)) - - ;; Special treatment needed for TAB, RET and DEL - (org-defkey orgtbl-mode-map [(return)] - (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)])) - (org-defkey orgtbl-mode-map [(tab)] - (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)])) - (org-defkey orgtbl-mode-map [(shift tab)] - (orgtbl-make-binding 'org-table-previous-field 104 - [(shift tab)] [(tab)] "\C-i")) - (org-defkey orgtbl-mode-map [backspace] - (orgtbl-make-binding 'org-delete-backward-char 109 - [backspace] (kbd "DEL"))) - - (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")) - - (org-defkey orgtbl-mode-map [backtab] - (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)])) - (org-defkey orgtbl-mode-map [(meta return)] - (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) - - (when orgtbl-optimized - ;; If the user wants maximum table support, we need to hijack - ;; some standard editing functions - (org-remap orgtbl-mode-map - 'self-insert-command 'orgtbl-self-insert-command - 'delete-char 'org-delete-char - 'delete-forward-char 'org-delete-char - 'delete-backward-char 'org-delete-backward-char) - (org-defkey orgtbl-mode-map "|" 'org-force-self-insert)) - t)) + ;; If the user wants maximum table support, we need to hijack + ;; some standard editing functions + (org-remap orgtbl-mode-map + 'self-insert-command (and orgtbl-optimized 'orgtbl-self-insert-command) + 'delete-char (and orgtbl-optimized 'org-delete-char) + 'delete-forward-char (and orgtbl-optimized 'org-delete-char) + 'delete-backward-char (and orgtbl-optimized 'org-delete-backward-char)) + (org-defkey orgtbl-mode-map "|" (and orgtbl-optimized 'org-force-self-insert))) (defun orgtbl-ctrl-c-ctrl-c (arg) "If the cursor is inside a table, realign the table. @@ -5342,7 +5373,7 @@ With prefix arg, also recompute table." (interactive "P") (let ((case-fold-search t) (pos (point)) action) (save-excursion - (beginning-of-line 1) + (forward-line 0) (setq action (cond ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) ((looking-at "[ \t]*|") pos) @@ -5359,7 +5390,7 @@ With prefix arg, also recompute table." (run-hooks 'orgtbl-after-send-table-hook))) ((eq action 'recalc) (save-excursion - (beginning-of-line 1) + (forward-line 0) (skip-chars-backward " \r\n\t") (if (org-at-table-p) (org-call-with-arg 'org-table-recalculate t)))) @@ -5445,7 +5476,7 @@ a radio table." (save-excursion (goto-char (org-table-begin)) (let (rtn) - (beginning-of-line 0) + (forward-line -1) (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") (let ((name (org-no-properties (match-string 1))) (transform (intern (match-string 2))) @@ -5453,7 +5484,7 @@ a radio table." (read (concat "(" (match-string 3) ")"))))) (push (list :name name :transform transform :params params) rtn) - (beginning-of-line 0))) + (forward-line -1))) rtn))) (defun orgtbl-send-replace-tbl (name text) @@ -5469,7 +5500,7 @@ a radio table." (let ((beg (line-beginning-position 2))) (unless (re-search-forward end-re nil t) (user-error "Cannot find end of receiver location at %d" beg)) - (beginning-of-line) + (forward-line 0) (delete-region beg (point)) (insert text "\n"))) (unless location-flag @@ -5484,25 +5515,38 @@ for a horizontal separator line, or a list of field values as strings. The table is taken from the parameter TXT, or from the buffer at point." (if txt (with-temp-buffer + (buffer-disable-undo) (insert txt) (goto-char (point-min)) (org-table-to-lisp)) (save-excursion (goto-char (org-table-begin)) - (let ((table nil)) - (while (re-search-forward "\\=[ \t]*|" nil t) - (let ((row nil)) - (if (looking-at "-") - (push 'hline table) - (while (not (progn (skip-chars-forward " \t") (eolp))) - (push (buffer-substring - (point) - (progn (re-search-forward "[ \t]*\\(|\\|$\\)") - (match-beginning 0))) - row)) - (push (nreverse row) table))) + (let (table) + (while (progn (skip-chars-forward " \t") + (eq (following-char) ?|)) + (forward-char) + (push + (if (eq (following-char) ?-) + 'hline + (let (row) + (while (progn + (skip-chars-forward " \t") + (not (eolp))) + (let ((q (point))) + (skip-chars-forward "^|\n") + (goto-char + (prog1 + (let ((p (point))) + (unless (eolp) (setq p (1+ p))) + p) + (skip-chars-backward " \t" q) + ;; Preserve text properties. They are used when + ;; calculating cell width. + (push (buffer-substring q (point)) row))))) + (nreverse row))) + table) (forward-line)) - (nreverse table))))) + (nreverse table))))) (defun org-table-collapse-header (table &optional separator max-header-lines) "Collapse the lines before `hline' into a single header. @@ -5574,22 +5618,22 @@ First element has index 0, or I0 if given." (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) + (commented (save-excursion (forward-line 0) (cond ((looking-at re1) t) ((looking-at re2) nil) (t (user-error "Not at an org table"))))) (re (if commented re1 re2)) beg end) (save-excursion - (beginning-of-line 1) + (forward-line 0) (while (and (not (eq (point) (point-min))) (looking-at re)) - (beginning-of-line 0)) - (unless (eq (point) (point-min)) (beginning-of-line 2)) + (forward-line -1)) + (unless (eq (point) (point-min)) (forward-line 1)) (setq beg (point)) (while (and (not (eq (point) (point-max))) (looking-at re)) - (beginning-of-line 2)) + (forward-line 1)) (setq end (point))) (comment-region beg end (if commented '(4) nil)))) @@ -5623,7 +5667,7 @@ Valid parameters are: :backend, :raw - Export back-end used as a basis to transcode elements of the + Export backend used as a basis to transcode elements of the table, when no specific parameter applies to it. It is also used to translate cells contents. You can prevent this by setting :raw property to a non-nil value. @@ -5715,7 +5759,7 @@ This may be either a string or a function of two arguments: (require 'ox) (let* ((backend (plist-get params :backend)) (custom-backend - ;; Build a custom back-end according to PARAMS. Before + ;; Build a custom backend according to PARAMS. Before ;; defining a translator, check if there is anything to do. ;; When there isn't, let BACKEND handle the element. (org-export-create-backend @@ -5725,7 +5769,7 @@ This may be either a string or a function of two arguments: (table-row . ,(org-table--to-generic-row params)) (table-cell . ,(org-table--to-generic-cell params)) ;; Macros are not going to be expanded. However, no - ;; regular back-end has a transcoder for them. We + ;; regular backend has a transcoder for them. We ;; provide one so they are not ignored, but displayed ;; as-is instead. (macro . (lambda (m c i) (org-element-macro-interpreter m nil)))))) @@ -5743,7 +5787,7 @@ This may be either a string or a function of two arguments: (princ "| ") (dolist (c e) (princ c) (princ " |")) (princ "\n"))))) (org-element-cache-reset) - ;; Add back-end specific filters, but not user-defined ones. In + ;; Add backend specific filters, but not user-defined ones. In ;; particular, make sure to call parse-tree filters on the ;; table. (setq info @@ -5769,7 +5813,7 @@ This may be either a string or a function of two arguments: (org-element-map data 'table-row (lambda (row) (if (>= n skip) t - (org-element-extract-element row) + (org-element-extract row) (cl-incf n) nil)) nil t)))) @@ -5786,7 +5830,7 @@ This may be either a string or a function of two arguments: (dolist (cell (nthcdr (if specialp 1 0) (org-element-contents row))) (when (memq c skipcols) - (org-element-extract-element cell)) + (org-element-extract cell)) (cl-incf c)))))))))) ;; Since we are going to export using a low-level mechanism, ;; ignore special column and special rows manually. @@ -5794,7 +5838,7 @@ This may be either a string or a function of two arguments: ignore) (org-element-map data (if special? '(table-cell table-row) 'table-row) (lambda (datum) - (when (if (eq (org-element-type datum) 'table-row) + (when (if (org-element-type-p datum 'table-row) (org-export-table-row-is-special-p datum nil) (org-export-first-sibling-p datum nil)) (push datum ignore)))) @@ -5802,7 +5846,7 @@ This may be either a string or a function of two arguments: ;; We use a low-level mechanism to export DATA so as to skip all ;; usual pre-processing and post-processing, i.e., hooks, Babel ;; code evaluation, include keywords and macro expansion. Only - ;; back-end specific filters are retained. + ;; backend specific filters are retained. (let ((output (org-export-data-with-backend data custom-backend info))) ;; Remove final newline. (if (org-string-nw-p output) (substring-no-properties output 0 -1) "")))) @@ -5962,7 +6006,7 @@ information." (let ((headerp ,(and (or hfmt hsep) '(org-export-table-row-in-header-p - (org-export-get-parent-element cell) info))) + (org-element-parent-element cell) info))) (column ;; Call costly `org-export-table-cell-address' only if ;; absolutely necessary, i.e., if one diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el index 638f0ea3f4a..c811f61c4cb 100644 --- a/lisp/org/org-tempo.el +++ b/lisp/org/org-tempo.el @@ -24,7 +24,7 @@ ;;; Commentary: ;; ;; Org Tempo reimplements completions of structure template before -;; point like `org-try-structure-completion' in Org v9.1 and earlier. +;; point in Org v9.1 and earlier. ;; For example, strings like "