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

Update to Org 9.6-3-ga4d38e

Browse source
This commit is contained in:
Kyle Meyer 2022-11-29 23:05:53 -05:00
parent edd64e64a3
commit 0625651e8a
132 changed files with 20012 additions and 8692 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
doc/misc/org-setup.org
View file

@ -49,5 +49,5 @@
# The "kbd" macro turns KBD into @kbd{KBD}. Additionally, it
# encloses case-sensitive special keys (SPC, RET...) within @key{...}.
#+macro: kbd (eval (let ((case-fold-search nil) (regexp (regexp-opt '("SPC" "RET" "LFD" "TAB" "BS" "ESC" "DELETE" "SHIFT" "Ctrl" "Meta" "Alt" "Cmd" "Super" "UP" "LEFT" "RIGHT" "DOWN") 'words))) (format "@@texinfo:@kbd{@@%s@@texinfo:}@@" (replace-regexp-in-string regexp "@@texinfo:@key{@@\\&@@texinfo:}@@" $1 t))))
#+macro: kbd (eval (org-texinfo-kbd-macro $1))

2261
doc/misc/org.org
View file

File diff suppressed because it is too large Load diff

743
etc/ORG-NEWS
View file

@ -11,6 +11,742 @@ See the end of the file for license conditions.
Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
* Version 9.6
** Important announcements and breaking changes
*** =python-mode.el (MELPA)= support in =ob-python.el= is deprecated
We no longer aim to support third-party =python-mode.el= implementation of Python REPL.
Only the built-in =python.el= will be supported from now on.
We still keep the old, partially broken, code in =ob-python.el= for
the time being. It will be removed in the next release.
See https://orgmode.org/list/87r0yk7bx8.fsf@localhost for more details.
*** Element cache is enabled by default and work for headings
The old element cache code has been refactored. Emacs does not hang
anymore when the cache is enabled.
When cache is enabled, ~org-element-at-point~ for headings is
guaranteed to return valid =:parent= property. The highest-level
headings contain new =org-data= element as their parent.
The new =org-data= element provides properties from top-level property
drawer, buffer-global category, and =:path= property containing file
path for file Org buffers.
The new cache still need to be tested extensively. Please, report any
warning coming from element cache. If you see warnings regularly, it
would be helpful to set ~org-element--cache-self-verify~ to
='backtrace= and provide the backtrace to Org mailing list.
*** Element cache persists across Emacs sessions
The cache state is saved between Emacs sessions. Enabled by default.
The cache persistence can be controlled via
~org-element-cache-persistent~.
*** Users experiencing performance issues can use new folding backend
The old folding backend used in Org is poorly scalable when the file
size increases beyond few Mbs. The symptoms usually include slow
cursor motion, especially in long-running Emacs sessions.
A new optimised folding backend is now available, and enabled by
default. To disable it, put the following to the Emacs config *before*
loading Org:
#+begin_src emacs-lisp
(setq org-fold-core-style 'overlays)
#+end_src
Even more performance optimisation can be enabled by customising
=org-fold-core--optimise-for-huge-buffers=. However, this option may
be dangerous. Please, read the variable docstring carefully to
understand the possible consequences.
When =org-fold-core-style= is set to =text-properties=, several new
features will become available and several notable changes will happen
to the Org behaviour. The new features and changes are listed below.
**** Hidden parts of the links can now be searched and revealed during isearch
In the past, hidden parts of the links could not be searched using
isearch (=C-s=). Now, they are searchable by default. The hidden
match is also revealed temporarily during isearch.
To restore the old behaviour add the following core to your Emacs
config:
#+begin_src emacs-lisp
(defun org-hidden-link-ignore-isearch ()
"Do not match hidden parts of links during isearch."
(org-fold-core-set-folding-spec-property 'org-link :isearch-open nil)
(org-fold-core-set-folding-spec-property 'org-link :isearch-ignore t))
(add-hook 'org-mode-hook #'org-hidden-link-ignore-isearch)
#+end_src
See docstring of =org-fold-core--specs= to see more details about
=:isearch-open= and =:isearch-ignore= properties.
**** =org-catch-invisible-edits= now works for hidden parts of the links and for emphasis markers
In the past, user could edit invisible parts of the links and emphasis markers. Now, the editing is respecting the value of =org-catch-invisible-edits=.
Note that hidden parts of sub-/super-scripts are still not handled.
**** Breaking structure of folded elements automatically reveals the folded text
In the past, the user could be left with unfoldable text after breaking the org structure.
For example, if
#+begin_src org
:DRAWER:
like this
:END:
#+end_src
is folded and then edited into
#+begin_src org
DRAWER:
like this
:END:
#+end_src
The hidden text would not be revealed.
Now, breaking structure of drawers, blocks, and headings automatically
reveals the folded text.
**** Folding state of the drawers is now preserved when cycling headline visibility
In the past drawers were folded every time a headline is unfolded.
Now, it is not the case anymore. The drawer folding state is
preserved. The initial folding state of all the drawers in buffer is
set according to the startup visibility settings.
To restore the old behaviour, add the following code to Emacs config:
#+begin_src emacs-lisp
(add-hook 'org-cycle-hook #'org-cycle-hide-drawers)
#+end_src
Note that old behaviour may cause performance issues when cycling
headline visibility in large buffers.
**** =outline-*= functions may no longer work correctly in Org mode
The new folding backend breaks some of the =outline-*= functions that
rely on the details of visibility state implementation in
=outline.el=. The old Org folding backend was compatible with the
=outline.el= folding, but it is not the case anymore with the new
backend. From now on, using =outline-*= functions is strongly
discouraged when working with Org files.
*** HTML export uses MathJax 3+ instead of MathJax 2
Org now uses MathJax 3 by default instead of MathJax 2. During HTML
exports, Org automatically converts all legacy MathJax 2 options to
the corresponding MathJax 3+ options, except for the ~path~ option in
which now /must/ point to a file containing MathJax version 3 or
later. The new Org does /not/ work with the legacy MathJax 2.
Further, if you need to use a non-default ~font~ or ~linebreaks~ (now
~overflow~), then the ~path~ must point to MathJax 4 or later.
See the updated ~org-html-mathjax-options~ for more details.
MathJax 3, a ground-up rewrite of MathJax 2 came out in 2019. The new
version brings modularity, better and faster rendering, improved LaTeX
support, and more.
For more information about new features, see:
https://docs.mathjax.org/en/latest/upgrading/whats-new-3.0.html
https://docs.mathjax.org/en/latest/upgrading/whats-new-3.1.html
https://docs.mathjax.org/en/latest/upgrading/whats-new-3.2.html
MathJax 3 comes with useful extensions. For instance, you can typeset
calculus with the ~physics~ extension or chemistry with the ~mhchem~
extension, like in LaTeX.
Note that the Org manual does not discuss loading of MathJax
extensions via ~+HTML_MATHJAX~ anymore. It has never worked anyway.
To actually load extensions, consult the official documentation:
https://docs.mathjax.org/en/latest/input/tex/extensions.html
Lastly, MathJax 3 changed the default JavaScript content delivery
network (CDN) provider from CloudFlare to jsDelivr. You can find the
new terms of service, including the privacy policy, at
https://www.jsdelivr.com/terms.
*** List references in source block variable assignments are now proper lists
List representation of named lists is now converted to a simple list
as promised by the manual section [[info:org#Environment of a Code Block][org#Environment of a Code Block]].
Previously, it was converted to a list of lists.
Before:
#+begin_src org
,#+NAME: example-list
- simple
- not
- nested
- list
,#+BEGIN_SRC emacs-lisp :var x=example-list :results value
(format "%S" x)
,#+END_SRC
,#+RESULTS:
: (("simple" (unordered ("not") ("nested"))) ("list"))
#+end_src
After:
#+begin_src org
,#+BEGIN_SRC emacs-lisp :var x=example-list :results value
(format "%S" x)
,#+END_SRC
,#+RESULTS:
: ("simple" "list")
#+end_src
** New features
*** Clock table can now produce quarterly reports
=:step= clock table parameter can now be set to =quarter=.
*** Publishing now supports links to encrypted Org files
Links to other published Org files are automatically converted to the
corresponding html links. Now, this feature is also available when
links point to encrypted Org files, like
=[[file:foo.org.gpg::Heading]]=.
*** Interactive commands now support escaping text inside comment blocks
~org-edit-special~ and ~org-insert-structure-template~ now handle
comment blocks.
See [[*New command ~org-edit-comment-block~ to edit comment block at
point]].
*** New customization option =org-property-separators=
A new alist variable to control how properties are combined.
If a property is specified multiple times with a =+=, like
#+begin_src org
:PROPERTIES:
:EXPORT_FILE_NAME: some/path
:EXPORT_FILE_NAME+: to/file
:END:
#+end_src
the old behavior was to always combine them with a single space
(=some/path to/file=). For the new variable, the car of each item in
the alist should be either a list of property names or a regular
expression, while the cdr should be the separator to use when
combining that property.
The default value for the separator is a single space, if none of the
provided items in the alist match a given property.
For example, in order to combine =EXPORT_FILE_NAME= properties with a
forward slash =/=, one can use
#+begin_src emacs-lisp
(setq org-property-separators '((("EXPORT_FILE_NAME") . "/")))
#+end_src
The example above would then produce the property value
=some/path/to/file=.
*** New library =org-persist.el= implements variable persistence across Emacs sessions
The library stores variable data in ~org-persist-directory~ (set to XDG
cache dir by default).
The entry points are ~org-persist-register~, ~org-persist-unregister~,
~org-persist-read~, and ~org-persist-read-all~. Storing circular
structures is supported. Storing references between different
variables is also supported (see =:inherit= key in
~org-persist-register~).
The library permits storing buffer-local variables. Such variables
are linked to the buffer text, file =inode=, and file path.
*** New =:options= attribute when exporting tables to LaTeX
The =:options= attribute allows adding an optional argument with a
list of various table options (between brackets in LaTeX export),
since certain tabular environments, such as longtblr of the
tabularray LaTeX package, provides this structure.
*** New =:compact= attribute when exporting lists to Texinfo
The =:compact= attribute allows exporting multiple description list
items to one =@item= command and one or more =@itemx= commands. This
feature can also be enabled for all description lists in a file using
the =compact-itemx= export option, or globally using the
~org-texinfo-compact-itemx~ variable.
*** New shorthands recognized when exporting to Texinfo
Items in a description list that begin with =Function:=, =Variable:=
or certain related prefixes are converted using Texinfo definition
commands.
*** New =:noweb-prefix= babel header argument
=:noweb-prefix= can be set to =no= to prevent the prefix characters
from being repeated when expanding a multiline noweb reference.
*** New =:noweb= babel header argument value =strip-tangle=
=:noweb= can be set to =strip-tangle= to strip the noweb syntax references
before tangling.
*** New LaTeX source block backend using =engraved-faces-latex=
When ~org-latex-src-block-backend~ is set to ~engraved~,
=engrave-faces-latex= from [[http://elpa.gnu.org/packages/engrave-faces.html][engrave-faces]] is used to transcode source
blocks to LaTeX. This requires the =fvextra=, =float=, and (by
default, but not necessarily) =tcolorbox= LaTeX packages be
installed. It uses Emacs' font-lock information, and so tends to
produce results superior to Minted or Listings.
*** Support for =#+include=-ing URLs
=#+include: FILE= will now accept URLs as the file.
*** Structure templates now respect case used in ~org-structure-template-alist~
The block type in ~org-structure-template-alist~ is not case-sensitive.
When the block type starts from the upper case, structure template
will now insert =#+BEGIN_TYPE=. Previously, lower-case =#+begin_type= was inserted unconditionally.
*** New ox-latex tabbing support for tables.
Latex tables can now be exported to the latex tabbing environment
tabbing environment]].
This is done by adding =#+ATTR_LATEX: :mode tabbing= at the top
of the table.
The default column width is set to 1/n times the latex textwidth,
where n is the number of columns.
This behaviour can be changed by supplying a =:align= parameter.
The tabbing environment can be useful when generating simple tables which
can be span multiple pages and when table cells are allowed to overflow.
*** Support for =nocite= citations and sub-bibliographies in the "csl" export processor
The "csl" citation export processor now supports =nocite= style
citations that add items to the printed bibliography without visible
references in the text. Using the key =*= in a nocite citation, for
instance,
#+begin_src org
[cite/n:@*]
#+end_src
includes all available items in the printed bibliography.
The "csl" export processor now also supports sub-bibliographies that
show only a subset of the references based on some criterion. For
example,
#+begin_src org
#+print_bibliography: :type book :keyword ai
#+end_src
prints a sub-bibliography containing the book entries with =ai= among
their keywords.
*** New =:filetitle= option for clock table
The =:filetitle= option for clock tables can be set to ~t~ to show org
file title (set by =#+title:=) in the File column instead of the
file name. For example:
#+begin_src org
,#+BEGIN: clocktable :scope agenda :maxlevel 2 :block thisweek :filetitle t
#+end_src
If a file does not have a title, the table will show the file name
instead.
*** New =org-md-toplevel-hlevel= variable for Markdown export
The =org-md-toplevel-hlevel= customization variable sets the heading
level used for top level headings, much like how
=org-html-toplevel-hlevel= sets the heading level used for top level
headings in HTML export.
*** Babel: new syntax to pass the contents of a src block as argument
Use the header argument =:var x=code-block[]= or
: #+CALL: fn(x=code-block[])
to pass the contents of a named code block as a string argument.
*** New property =ORG-IMAGE-ACTUAL-WIDTH= for overriding global ~org-image-actual-width~
The new property =ORG-IMAGE-ACTUAL-WIDTH= can override the global
variable ~org-image-actual-width~ value for inline images display width.
*** Outline cycling can now include inline image visibility
New ~org-cycle-hook~ function ~org-cycle-display-inline-images~ for
auto-displaying inline images in the visible parts of the subtree.
This behavior is controlled by new custom option
~org-cycle-inline-images-display~.
*** New ~org-babel-tangle-finished-hook~ hook run at the very end of ~org-babel-tangle~
This provides a proper counterpart to ~org-babel-pre-tangle-hook~, as
~org-babel-post-tangle-hook~ is run
per-tangle-destination. ~org-babel-tangle-finished-hook~ is just run
once after the post tangle hooks.
*** New =:backend= header argument for clojure code blocks
The =:backend= header argument on clojure code blocks can override the
value of ~org-babel-clojure-backend~. For example:
#+begin_src clojure :backend babashka
(range 2)
#+end_src
*** New =:results discard= header argument
Unlike =:results none=, the return value of code blocks called with
=:results discard= header argument is always ~nil~. Org does not
attempt to analyze the results and simply returns nil. This can be
useful when the code block is used for side effects only but generates
large outputs that may be slow to analyze for Org.
*** Add Capture template hook properties
Capture templates can now attach template specific hooks via the
following properties: ~:hook~, ~:prepare-finalize~,
~:before-finalize~, ~:after-finalize~. These nullary functions run
prior to their global counterparts for the selected template.
** New options
*** 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
instead of the file name in refile targets. If the document do not have
a title, the filename will be used, similar to ~'file~ option.
*** A new option for custom setting ~org-agenda-show-outline-path~ to show document title
Setting ~org-agenda-show-outline-path~ to ~'title~ will show title
instead of the file name at the beginning of the outline. The title of
the document can be set by special keyword =#+title:=.
*** New custom settings =org-icalendar-scheduled-summary-prefix= and =org-icalendar-deadline-summary-prefix=
These settings allow users to define prefixes for exported summary
lines in ICS exports. The customization can be used to disable
the prefixes completely or make them a little bit more verbose
(e.g. "Deadline: " instead of the default "DL: ").
The same settings can also be applied via corresponding exporter
options:
=:icalendar-scheduled-summary-prefix=,
=:icalendar-deadline-summary-prefix=
*** A new custom setting =org-hide-drawer-startup= to control initial folding state of drawers
Previously, all the drawers were always folded when opening an Org
file. This only had an effect on the drawers outside folded
headlines. The drawers inside folded headlines were re-folded because
=org-cycle-hide-drawers= was present inside =org-cycle-hook=.
With the new folding backend, running =org-cycle-hide-drawers= is no
longer needed if all the drawers are truly folded on startup: [[*Folding
state of the drawers is now preserved when cycling headline
visibility]]. However, this has an unwanted effect when a user does
not want the drawers to be folded (see [[https://orgmode.org/list/m2r14f407q.fsf@ntnu.no][this bug report]]).
The new custom setting gives more control over initial folding state
of the drawers. When set to =nil= (default is =t=), the drawers are
not folded on startup.
The folding state can also be controlled on per-file basis using
=STARTUP= keyword:
: #+startup: hidedrawers
: #+startup: nohidedrawers
*** New custom setting ~org-icalendar-force-alarm~
The new setting, when set to non-nil, makes Org create alarm at the
event time when the alarm time is set to 0. The default value is
nil -- do not create alarms at the event time.
*** New special value ~'attach~ for src block =:dir= option
Passing the symbol ~attach~ or string ="'attach"= (with quotes) to the =:dir=
option of a src block is now equivalent to =:dir (org-attach-dir) :mkdir yes=
and any file results with a path descended from the attachment directory will
use =attachment:= style links instead of the standard =file:= link type.
** New functions and changes in function arguments
*** New function ~org-get-title~ to get =#+TITLE:= property from buffers
A function to collect the document title from the org-mode buffer.
*** ~org-fold-show-entry~ does not fold drawers by default anymore
~org-fold-show-entry~ now accepts an optional argument HIDE-DRAWERS.
When the argument is non-nil, the function folds all the drawers
inside entry. This was the default previously.
Now, ~org-fold-show-entry~ does not fold drawers by default.
*** New command ~org-edit-comment-block~ to edit comment block at point
As the contents of comments blocks is not parsed as Org markup, the
headlines and keywords inside should be escaped, similar to src
blocks, example blocks, and export blocks. This in inconvenient to do
manually and ~org-edit-special~ is usually advised to edit text in
such kind of blocks.
Now, comment block editing is also supported via this new function.
*** New function ~org-element-cache-map~ for quick mapping across Org elements
When element cache is enabled, the new function provides the best
possible performance to map across large Org buffers.
It is recommended to provide =:next-re= and =:fail-re= parameters for
best speed.
Diagnostic information about execution speed can be provided according
to ~org-element--cache-map-statistics~ and
~org-element--cache-map-statistics-threshold~.
~org-scan-tags~ and tag views in agenda utilise the new function.
*** New function ~org-element-at-point-no-context~
This function is like ~org-element-at-point~, but it does not try to
update the cache and does not guarantee correct =:parent= properties
for =headline= elements.
This function is faster than ~org-element-at-point~ when used together
with frequent buffer edits.
*** Various Org API functions now use cache and accept Org elements as optional arguments
~org-in-archived-heading-p~, ~org-in-commented-heading-p~,
~org-up-heading-safe~, ~org-end-of-subtree~, ~org-goto-first-child~,
~org-back-to-heading~, ~org-entry-get-with-inheritance~, and
~org-narrow-to-subtree~ all accept Org element as an extra optional
argument.
~org-get-tags~ now accepts Org element or buffer position as first
argument.
*** New function ~org-texinfo-kbd-macro~
This function is intended for us in the definition of a ~kbd~ macro in
files that are exported to Texinfo.
*** =org-at-heading-p= now recognises optional argument. Its meaning is inverted.
=org-at-heading-p= now returns t by default on headings inside folds.
Passing optional argument will produce the old behaviour.
*** =org-babel-execute:plantuml= can output ASCII graphs in the buffer
Previously, executing PlantUML src blocks always exported to a file. Now, if
:results is set to a value which does not include "file", no file will be
exported and an ASCII graph will be inserted below the src block.
** Removed or renamed functions and variables
*** =org-plantump-executable-args= is renamed and applies to jar as well
The new variable name is =org-plantuml-args=. It now applies to both
jar PlantUML file and executable.
*** Default values and interpretations of ~org-time-stamp-formats~ and ~org-time-stamp-custom-formats~ are changed
Leading =<= and trailing =>= in the default values of
~org-time-stamp-formats~ and ~org-time-stamp-custom-formats~ are
stripped.
The Org functions that are using these variables also ignore leading
and trailing brackets (=<...>= and =[...]=, if present).
This change makes the Org code more consistent and also makes the
docstring for ~org-time-stamp-custom-formats~ accurate.
No changes on the user side are needed if
~org-time-stamp-custom-formats~ was customized.
*** ~org-timestamp-format~ is renamed to ~org-format-timestamp~
The old function name is similar to other ~org-time-stamp-format~
function. The new name emphasizes that ~org-format-timestamp~ works
on =timestamp= objects.
*** Updated argument list in ~org-time-stamp-format~
New =custom= argument in ~org-time-stamp-format~ makes the function
use ~org-time-stamp-custom-formats~ instead of
~org-time-stamp-formats~ to determine the format.
Optional argument =long= is renamed to =with-time=, emphasizing that it refers to time stamp format with time specification.
Optional argument =inactive= can now have a value =no-brackets= to
return format string with brackets stripped.
** Miscellaneous
*** SQL Babel ~:dbconnection~ parameter can be mixed with other SQL Babel parameters
Before you could either specify SQL parameters like ~:dbhost~,
~:dbuser~, ~:database~, etc or a ~:dbconnection~ parameter which looks
up all other parameters from the ~sql-connection-alist~ variable. Now
it's possible to specify a ~:dbconnection~ and additionally other
parameters that will add or overwrite the parameters coming from
~sql-connection-alist~.
E.g. if you have a connection in your ~sql-connection-alist~ to a
server that has many databases, you don't need an entry for every
database but instead can just specify ~:database~ next to your
~:dbconnection~ parameter.
*** Post-processing code blocks can return an empty list
When the result of a regular code block is nil, then that was already
treated as an empty list. Now that is also the case for code blocks
that post-process the result of another block.
*** Styles are customizable in ~biblatex~ citation processor
It is now possible to add new styles or modify old ones in ~biblatex~
citation processor. See ~org-cite-biblatex-styles~ for more
information.
*** Citation processors can declare styles dynamically
When a citation processor is registered, it is now possible to set
~:cite-styles~ key to a function, which will be called whenever the
list of styles is required.
*** Org also searches for CSL style files in default directory
When CSL style file name is relative, Org first looks into
default-directory before trying ~org-cite-csl-styles-dir~.
*** Users can add checkers to the linting process
The function ~org-lint-add-checker~ allows one to add personal checks
when calling ~org-lint~. See its docstring for more information.
*** New =transparent-image-converter= property for =dvipng=
The =dvipng= option in ~org-preview-latex-process-alist~ has a new
property =transparent-image-converter= which is used instead of
=image-converter= when producing transparent images.
*** =:tangle-mode= now accepts more permissions formats
Previously =:tangle-mode (identity #o755)= was the only reasonable way
to set the file mode. ~org-babel-interpret-file-mode~ has been
introduced which will accept three new formats:
+ Short octals, e.g. =:tangle-mode o755=
+ ls-style, e.g. =:tangle-mode rwxrw-rw-=
+ chmod-style, e.g. =:tangle-mode u+x=
Chmod-style permissions are based on the new variable
~org-babel-tangle-default-file-mode~.
*** A new custom setting =org-agenda-clock-report-header= to add a header to org agenda clock report
*** ~org-latex-listings~ has been replaced with ~org-latex-src-block-backend~
~org-latex-listings~ has been renamed to better reflect the current
purpose of the variable. The replacement variable
~org-latex-src-block-backend~ acts in exactly the same way, however it
accepts =listings= and =verbatim= in place of =t= and =nil= (which
still work, but are no longer listed as valid options).
*** ~org-link-parameters~ has a new ~:insert-description~ parameter
The value of ~:insert-description~ is used as the initial input when
prompting for a link description. It can be a string (used as-is) or
a function (called with the same arguments as
~org-make-link-description-function~ to return a string to use).
An example of a such function for =info:= links is
~org-info-description-as-command~. To access a manual section outside
of Org, description may be pasted to shell prompt or evaluated withing
Emacs using =M-:= (wrapped into parenthesis). For example,
description of the =info:org#Tags= link is =info "(org) Tags"=. To
restore earlier behavior add to your Emacs init file the following:
#+begin_src elisp :results silent :eval never-export
(with-eval-after-load 'ol-info
(org-link-set-parameters "info" :insert-description nil))
#+end_src
*** New list of languages for LaTeX export: ~org-latex-language-alist~
~org-latex-language-alist~ unifies into a single list the old language
lists for the =babel= and =polyglossia= LaTeX packages:
~org-latex-babel-language-alist~ and
~org-latex-polyglossia-language-alist~, respectively, which are
declared obsolete.
This new list captures the current state of art regarding language
support in LaTeX. The new =babel= syntax for loading languages via
=ini= files and the new command =\babelprovide= (see:
https://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf)
are also supported.
*** Texinfo exports include LaTeX
With the new customization option ~org-texinfo-with-latex~ set to (its
default value) ~'detect~, if the system runs Texinfo 6.8 (3 July 2021)
or newer, Org will export all LaTeX fragments and environments using
Texinfo ~@math~ and ~@displaymath~ commands respectively.
*** More flexible ~org-attach-id-to-path-function-list~
List entries may return nil if they are unable to handle the passed
ID. So, responsibility is passed to the next item in the list.
Default entries ~org-attach-id-uuid-folder-format~ and
~org-attach-id-ts-folder-format~ now return nil for too short IDs.
Earlier an obscure error has been thrown.
After the change, error text suggests adjusting
~org-attach-id-to-path-function-list~ value. The
~org-attach-dir-from-id~ function is adapted to ignore nil values and
to take first non-nil value instead of the value returned by first
~org-attach-id-to-path-function-list~ item.
New policy allows mixing different ID styles while keeping subfolder
layout suited best for each one. For example, one can use the
following snippet to allow multiple different ID formats in Org files.
#+begin_src emacs-lisp
(setq org-attach-id-to-path-function-list
'(;; When ID looks like an UUIDs or Org internal ID, use
;; `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)))
;; When ID looks like a timestap-based ID. Group by year-month
;; folders.
(lambda (id)
(and (string-match-p "[0-9]\\{8\\}T[0-9]\\{6\\}\.[0-9]\\{6\\}" id)
(org-attach-id-ts-folder-format id)))
;; Any other ID goes into "important" folder.
(lambda (id) (format "important/%s/%s" (substring id 0 1) id))
;; Fallback to detect existing attachments for old defaults.
;; All the above functions, even when return non-nil, would
;; point to non-existing folders.
org-attach-id-uuid-folder-format
org-attach-id-ts-folder-format))
#+end_src
* Version 9.5
** Important announcements and breaking changes
@ -1466,6 +2202,7 @@ the headline to use for making the table of contents.
,* Another section
,#+TOC: headlines 1 :target "#TargetSection"
#+end_example
** New functions
*** ~org-dynamic-block-insert-dblock~
@ -1756,6 +2493,7 @@ CIDER version which has not =sesman= integrated, only has
(dissoc Clojure 'JVM)
(conj clojurists "stardiviner")
#+end_src
*** Add ~:results link~ support for Babel
With this output format, create a link to the file specified in
@ -1774,14 +2512,17 @@ wget -c "https://ben.akrin.com/crackzor/crackzor_1.0.c.gz"
#+begin_src js :session "*Javascript REPL*"
console.log("stardiviner")
#+end_src
*** Add ~:session~ support of ob-js for Indium
#+begin_src js :session "*JS REPL*"
console.log("stardiviner")
#+end_src
*** Add ~:session~ support of ob-js for skewer-mode
#+begin_src js :session "*skewer-repl*"
console.log("stardiviner")
#+end_src
*** Add support for links to LaTeX equations in HTML export
Use MathJax links when enabled (by ~org-html-with-latex~), otherwise
add a label to the rendered equation.
@ -1868,6 +2609,7 @@ you should expect to see something like:
#+BEGIN_EXAMPLE
,#+STARTUP: shrink
#+END_EXAMPLE
*** Allow to filter by tags/property when capturing colview
You can now use =:match= to filter entries using a todo/tags/properties
@ -2250,6 +2992,7 @@ To use =vertica= in an sql =SRC_BLK= set the =:engine= like this:
SELECT * FROM nodes;
,#+END_SRC
#+END_EXAMPLE
**** C++: New header ~:namespaces~
The new ~:namespaces~ export option can be used to specify namespaces

2
etc/org/README
View file

@ -21,7 +21,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Author: Jambunathan K <kjambunathan at gmail dot com>
Keywords: outlines, hypermedia, calendar, wp
Homepage: https://orgmode.org
URL: https://orgmode.org
Commentary:

2
etc/refcards/orgcard.tex
View file

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

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

@ -4,9 +4,9 @@
;; Author: Eric Schulte
;; Thierry Banel
;; Maintainer: Thierry Banel
;; Maintainer: Thierry Banel <tbanelwebmin@free.fr>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -33,6 +33,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cc-mode)
(require 'ob)
(require 'org-macs)
@ -182,7 +185,7 @@ or `org-babel-execute:C++' or `org-babel-execute:D'."
(setq results (org-remove-indentation results))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results t)
results
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))

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

@ -4,9 +4,9 @@
;; Author: Eric Schulte
;; Dan Davison
;; Maintainer: Jeremie Juste
;; Maintainer: Jeremie Juste <jeremiejuste@gmail.com>
;; Keywords: literate programming, reproducible research, R, statistics
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -29,6 +29,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'ob)
@ -40,13 +43,6 @@
(declare-function ess-wait-for-process "ext:ess-inf"
(&optional proc sec-prompt wait force-redisplay))
;; FIXME: Temporary declaration to silence the byte-compiler
(defvar user-inject-src-param)
(defvar ess-eval-visibly-tmp)
(defvar ess-eval-visibly)
(defvar ess-inject-source)
(defvar user-inject-src-param)
(defconst org-babel-header-args:R
'((width . :any)
(height . :any)
@ -385,7 +381,7 @@ Has four %s escapes to be filled in:
(if session
(if async
(ob-session-async-org-babel-R-evaluate-session
session body result-type result-params column-names-p row-names-p)
session body result-type column-names-p row-names-p)
(org-babel-R-evaluate-session
session body result-type result-params column-names-p row-names-p))
(org-babel-R-evaluate-external-process
@ -486,7 +482,7 @@ Insert hline if column names in output have been requested."
(defconst ob-session-async-R-indicator "'ob_comint_async_R_%s_%s'")
(defun ob-session-async-org-babel-R-evaluate-session
(session body result-type _ column-names-p row-names-p)
(session body result-type column-names-p row-names-p)
"Asynchronously evaluate BODY in SESSION.
Returns a placeholder string for insertion, to later be replaced
by `org-babel-comint-async-filter'."
@ -525,7 +521,8 @@ by `org-babel-comint-async-filter'."
(output
(let ((uuid (md5 (number-to-string (random 100000000))))
(ess-local-process-name
(process-name (get-buffer-process session))))
(process-name (get-buffer-process session)))
(ess-eval-visibly-p nil))
(with-temp-buffer
(insert (format ob-session-async-R-indicator
"start" uuid))
@ -534,13 +531,7 @@ by `org-babel-comint-async-filter'."
(insert "\n")
(insert (format ob-session-async-R-indicator
"end" uuid))
(setq ess-eval-visibly-tmp ess-eval-visibly)
(setq user-inject-src-param ess-inject-source)
(setq ess-eval-visibly nil)
(setq ess-inject-source 'function-and-buffer)
(ess-eval-buffer nil))
(setq ess-eval-visibly ess-eval-visibly-tmp)
(setq ess-inject-source user-inject-src-param)
(ess-eval-buffer nil ))
uuid))))
(defun ob-session-async-R-value-callback (params tmp-file)

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Maintainer: Tyler Smith <tyler@plantarum.ca>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -32,6 +32,10 @@
;; which will be passed to the awk process through STDIN
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-compat)
@ -51,7 +55,7 @@
(defun org-babel-execute:awk (body params)
"Execute a block of Awk code with org-babel.
This function is called by `org-babel-execute-src-block'."
(message "executing Awk source code block")
(message "Executing Awk source code block")
(let* ((result-params (cdr (assq :result-params params)))
(cmd-line (cdr (assq :cmd-line params)))
(in-file (cdr (assq :in-file params)))

6
lisp/org/ob-calc.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Maintainer: Tom Gillespie <tgbugs@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -27,6 +27,10 @@
;; Org-Babel support for evaluating calc code
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)
(require 'calc)

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

@ -3,10 +3,10 @@
;; Copyright (C) 2009-2022 Free Software Foundation, Inc.
;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
;; Maintainer: Bastien Guerry <bzg@gnu.org>
;; Maintainer: Daniel Kraus <daniel@kraus.my>
;;
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -25,23 +25,30 @@
;;; Commentary:
;; Support for evaluating clojure code
;; Support for evaluating Clojure code
;; Requirements:
;; - clojure (at least 1.2.0)
;; - Clojure (at least 1.2.0)
;; - clojure-mode
;; - inf-clojure, cider or SLIME
;; - inf-clojure, Cider, SLIME, babashka or nbb
;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode
;; For cider, see https://github.com/clojure-emacs/cider
;; For inf-clojure, see https://github.com/clojure-emacs/cider
;; 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 SLIME, the best way to install these components is by following
;; For SLIME, the best way to install its components is by following
;; the directions as set out by Phil Hagelberg (Technomancy) on the
;; web page: https://technomancy.us/126
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(declare-function cider-current-connection "ext:cider-client" (&optional type))
@ -62,17 +69,29 @@
(add-to-list 'org-babel-tangle-lang-exts '("clojurescript" . "cljs"))
(defvar org-babel-default-header-args:clojure '())
(defvar org-babel-header-args:clojure '((ns . :any) (package . :any)))
(defvar org-babel-header-args:clojure
'((ns . :any)
(package . :any)
(backend . ((inf-clojure cider slime babashka nbb)))))
(defvar org-babel-default-header-args:clojurescript '())
(defvar org-babel-header-args:clojurescript '((package . :any)))
(defcustom org-babel-clojure-backend nil
(defcustom org-babel-clojure-backend (cond
((executable-find "bb") 'babashka)
((executable-find "nbb") 'nbb)
((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")
:type '(choice
(const :tag "inf-clojure" inf-clojure)
(const :tag "cider" cider)
(const :tag "slime" slime)
(const :tag "babashka" babashka)
(const :tag "nbb" nbb)
(const :tag "Not configured yet" nil)))
(defcustom org-babel-clojure-default-ns "user"
@ -80,9 +99,28 @@
:type 'string
:group 'org-babel)
(defcustom ob-clojure-babashka-command (executable-find "bb")
"Path to the babashka executable."
:type 'file
:group 'org-babel
:package-version '(Org . "9.6"))
(defcustom ob-clojure-nbb-command (executable-find "nbb")
"Path to the nbb executable."
:type 'file
:group 'org-babel
:package-version '(Org . "9.6"))
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let* ((vars (org-babel--get-vars params))
(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"))))
(ns (or (cdr (assq :ns params))
(if (eq org-babel-clojure-backend 'cider)
(or cider-buffer-ns
@ -104,7 +142,7 @@
(format "(let [%s]\n%s)"
(mapconcat
(lambda (var)
(format "%S %S" (car var) (cdr var)))
(format "%S '%S" (car var) (cdr var)))
vars
"\n ")
body))))))
@ -210,8 +248,10 @@
"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" "" r))
(replace-regexp-in-string "nil" "" (or r "")))
result0)))))))
(defun ob-clojure-eval-with-slime (expanded params)
@ -225,25 +265,43 @@
,(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")))
(with-temp-file script-file
(insert expanded))
(org-babel-eval
(format "%s %s" bb (org-babel-process-file-name script-file))
"")))
(defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code with Babel."
(unless org-babel-clojure-backend
(user-error "You need to customize org-babel-clojure-backend"))
(let* ((expanded (org-babel-expand-body:clojure body params))
(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 'cider)
(ob-clojure-eval-with-cider expanded params))
((eq org-babel-clojure-backend 'slime)
(ob-clojure-eval-with-slime expanded params))))
(org-babel-result-cond result-params
result
(condition-case nil (org-babel-script-escape result)
(error result)))))
"Execute the BODY block of Clojure code with PARAMS using Babel."
(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))
(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 'babashka)
(ob-clojure-eval-with-babashka ob-clojure-babashka-command expanded))
((eq org-babel-clojure-backend 'nbb)
(ob-clojure-eval-with-babashka ob-clojure-nbb-command expanded))
((eq org-babel-clojure-backend 'cider)
(ob-clojure-eval-with-cider expanded params))
((eq org-babel-clojure-backend 'slime)
(ob-clojure-eval-with-slime expanded params))))
(org-babel-result-cond result-params
result
(condition-case nil (org-babel-script-escape result)
(error result))))))
(defun org-babel-execute:clojurescript (body params)
"Evaluate BODY with PARAMS as ClojureScript code."

33
lisp/org/ob-comint.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -30,6 +30,10 @@
;; org-babel at large.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob-core)
(require 'org-compat)
(require 'comint)
@ -70,11 +74,26 @@ 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)))
(full-body (nth 3 meta))
(org-babel-comint-prompt-separator
"org-babel-comint-prompt-separator"))
`(org-babel-comint-in-buffer ,buffer
(let* ((string-buffer "")
(comint-output-filter-functions
(cons (lambda (text) (setq string-buffer (concat string-buffer text)))
(cons (lambda (text)
(setq string-buffer
(concat
string-buffer
;; Upon concatenation, the prompt may no
;; longer match `comint-prompt-regexp'.
;; In particular, when the regexp has ^
;; and the output does not contain
;; trailing newline. Use more reliable
;; match to split the output later.
(replace-regexp-in-string
comint-prompt-regexp
,org-babel-comint-prompt-separator
text))))
comint-output-filter-functions))
dangling-text)
;; got located, and save dangling text
@ -105,7 +124,9 @@ or user `keyboard-quit' during execution of body."
"\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
string-buffer))
(setq string-buffer (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp)))))
(delete "" (split-string
string-buffer
,org-babel-comint-prompt-separator))))))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
@ -124,9 +145,7 @@ statement (not large blocks of code)."
(while (progn
(goto-char comint-last-input-end)
(not (and (re-search-forward comint-prompt-regexp nil t)
(goto-char (match-beginning 0))
(string= (face-name (face-at-point))
"comint-highlight-prompt"))))
(goto-char (match-beginning 0)))))
(accept-process-output (get-buffer-process buffer)))))
(defun org-babel-comint-eval-invisibly-and-wait-for-file

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

File diff suppressed because it is too large Load diff

6
lisp/org/ob-css.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -27,6 +27,10 @@
;; CSS from Org files.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-default-header-args:css '())

6
lisp/org/ob-ditaa.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -36,6 +36,10 @@
;; 4) there are no variables (at least for now)
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-compat)

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

@ -3,9 +3,9 @@
;; Copyright (C) 2009-2022 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Justin Abrahms
;; Maintainer: Justin Abrahms <justin@abrah.ms>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -39,6 +39,10 @@
;; 4) there are no variables (at least for now)
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-default-header-args:dot

7
lisp/org/ob-emacs-lisp.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -27,6 +27,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob-core)
(declare-function org-babel--get-vars "ob" (params))
@ -55,7 +58,7 @@ by `org-edit-src-code'.")
(format "(let (%s)\n%s\n)"
(mapconcat
(lambda (var)
(format "%S" (print `(,(car var) ',(cdr var)))))
(format "%S" `(,(car var) ',(cdr var))))
vars "\n ")
body))))

6
lisp/org/ob-eshell.el
View file

@ -4,7 +4,7 @@
;; Author: stardiviner <numbchild@gmail.com>
;; Maintainer: stardiviner <numbchild@gmail.com>
;; Homepage: https://github.com/stardiviner/ob-eshell
;; URL: https://github.com/stardiviner/ob-eshell
;; Keywords: literate programming, reproducible research
;; This file is part of GNU Emacs.
@ -27,6 +27,10 @@
;; Org Babel support for evaluating Eshell source code.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'eshell)

56
lisp/org/ob-eval.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -27,7 +27,11 @@
;; shell commands.
;;; Code:
(require 'org-macs)
(org-assert-version)
(eval-when-compile (require 'subr-x)) ; For `string-empty-p', Emacs < 29
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
(declare-function org-babel-temp-file "ob-core" (prefix &optional suffix))
@ -37,36 +41,45 @@
(let ((buf (get-buffer-create org-babel-error-buffer-name)))
(with-current-buffer buf
(goto-char (point-max))
(save-excursion (insert stderr)))
(save-excursion
(unless (bolp) (insert "\n"))
(insert stderr)
(insert (format "[ Babel evaluation exited with code %S ]" exit-code))))
(display-buffer buf))
(message "Babel evaluation exited with code %S" exit-code))
(defun org-babel-eval (command query)
"Run COMMAND on QUERY.
Return standard output produced by COMMAND. If COMMAND exits
with a non-zero code or produces error output, show it with
`org-babel-eval-error-notify'.
Writes QUERY into a temp-buffer that is processed with
`org-babel--shell-command-on-region'. If COMMAND succeeds then return
its results, otherwise display STDERR with
`org-babel-eval-error-notify'."
`org-babel--shell-command-on-region'."
(let ((error-buffer (get-buffer-create " *Org-Babel Error*")) exit-code)
(with-current-buffer error-buffer (erase-buffer))
(with-temp-buffer
(insert query)
(setq exit-code
(org-babel--shell-command-on-region
command error-buffer))
(if (or (not (numberp exit-code)) (> exit-code 0))
(progn
(with-current-buffer error-buffer
(org-babel-eval-error-notify exit-code (buffer-string)))
(save-excursion
(when (get-buffer org-babel-error-buffer-name)
(with-current-buffer org-babel-error-buffer-name
(unless (derived-mode-p 'compilation-mode)
(compilation-mode))
;; Compilation-mode enforces read-only, but Babel expects the buffer modifiable.
(setq buffer-read-only nil))))
nil)
(buffer-string)))))
(org-babel--shell-command-on-region
command error-buffer))
(let ((stderr (with-current-buffer error-buffer (buffer-string))))
(if (or (not (numberp exit-code))
(> exit-code 0)
(not (string-empty-p stderr)))
(progn
(org-babel-eval-error-notify exit-code stderr)
(save-excursion
(when (get-buffer org-babel-error-buffer-name)
(with-current-buffer org-babel-error-buffer-name
(unless (derived-mode-p 'compilation-mode)
(compilation-mode))
;; Compilation-mode enforces read-only, but
;; Babel expects the buffer modifiable.
(setq buffer-read-only nil))))
;; Return output, if any.
(buffer-string))
(buffer-string))))))
(defun org-babel-eval-read-file (file)
"Return the contents of FILE as a string."
@ -146,7 +159,8 @@ This buffer is named by `org-babel-error-buffer-name'."
"Return system `shell-file-name', defaulting to /bin/sh.
Unfortunately, `executable-find' does not support file name
handlers. Therefore, we could use it in the local case only."
;; FIXME: This is generic enough that it should probably be in emacs, not org-mode
;; FIXME: Since Emacs 27, `executable-find' accepts optional second
;; argument supporting remote hosts.
(cond ((and (not (file-remote-p default-directory))
(executable-find shell-file-name))
shell-file-name)

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

@ -5,7 +5,7 @@
;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -23,17 +23,24 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob-core)
(declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
(declare-function org-element-at-point "org-element" ())
(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-escape-code-in-string "org-src" (s))
(declare-function org-export-copy-buffer "ox" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-in-archived-heading-p "org" (&optional no-inheritance))
(declare-function org-export-copy-buffer "ox"
(&optional buffer drop-visibility
drop-narrowing drop-contents
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)
@ -66,7 +73,7 @@ point is at the beginning of the Babel block."
(when source (goto-char source))
,@body))))
(defun org-babel-exp-src-block ()
(defun org-babel-exp-src-block (&optional element)
"Process source block for export.
Depending on the \":export\" header argument, replace the source
code block like this:
@ -81,10 +88,12 @@ results - just like none only the block is run on export ensuring
none ---- do not display either code or results upon export
Optional argument ELEMENT must contain source block element at point.
Assume point is at block opening line."
(interactive)
(save-excursion
(let* ((info (org-babel-get-src-block-info))
(let* ((info (org-babel-get-src-block-info nil element))
(lang (nth 0 info))
(raw-params (nth 2 info))
hash)
@ -137,7 +146,8 @@ this template."
;; 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)))
(org-babel-exp-reference-buffer (org-export-copy-buffer))
element)
(unwind-protect
(save-excursion
;; First attach to every source block their original
@ -157,133 +167,167 @@ this template."
;; Evaluate from top to bottom every Babel block
;; encountered.
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(unless (save-match-data (or (org-in-commented-heading-p)
(org-in-archived-heading-p)))
(let* ((object? (match-end 1))
(element (save-match-data
(if object? (org-element-context)
;; No deep inspection if we're
;; just looking for an element.
(org-element-at-point))))
(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.
(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.
;; 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)
(delete-region begin end)
(insert rep))))
(`src-block
(let ((match-start (copy-marker (match-beginning 0)))
(ind (current-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))))
(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
(goto-char match-start)
(delete-region (point)
(save-excursion
(goto-char end)
(line-end-position)))
(insert replacement)
(if (or org-src-preserve-indentation
(org-element-property
:preserve-indent element))
;; Indent only code block
;; markers.
(save-excursion
(skip-chars-backward " \r\t\n")
(indent-line-to ind)
(goto-char match-start)
(indent-line-to ind))
;; Indent everything.
(indent-rigidly
match-start (point) ind)))))
(set-marker match-start nil))))
(set-marker begin nil)
(set-marker end nil)))))
(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)
(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)))))))
@ -306,7 +350,7 @@ The function respects the value of the :exports header argument."
(org-babel-exp-code info type)))))
(defcustom org-babel-exp-code-template
"#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
"#+begin_src %lang%switches%flags\n%body\n#+end_src"
"Template used to export the body of code blocks.
This template may be customized to include additional information
such as the code block name, or the values of particular header
@ -323,7 +367,8 @@ 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)
:type 'string
:package-version '(Org . "9.6"))
(defcustom org-babel-exp-inline-code-template
"src_%lang[%switches%flags]{%body}"

6
lisp/org/ob-forth.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, forth
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -32,6 +32,10 @@
;; `forth-mode' which is distributed with gforth (in gforth.el).
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)

6
lisp/org/ob-fortran.el
View file

@ -5,7 +5,7 @@
;; Authors: Sergey Litvinov
;; Eric Schulte
;; Keywords: literate programming, reproducible research, fortran
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;;
@ -27,6 +27,10 @@
;; Org-Babel support for evaluating fortran code.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)
(require 'cc-mode)

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

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Maintainer: Ihor Radchenko <yantar92@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -39,6 +39,10 @@
;; - gnuplot-mode :: you can search the web for the latest active one.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)
@ -94,12 +98,15 @@ code."
(let* ((first (car val))
(tablep (or (listp first) (symbolp first))))
(if tablep val (mapcar 'list val)))
(org-babel-temp-file "gnuplot-") params)
;; Make temporary file name stable with respect to data.
;; If we do not do it, :cache argument becomes useless.
(org-babel-temp-stable-file (cons val params) "gnuplot-")
params)
(if (and (stringp val)
(file-remote-p val) ;; check if val is a remote file
(file-exists-p val)) ;; call to file-exists-p is slow, maybe remove it
(let* ((local-name (concat ;; create a unique filename to avoid multiple downloads
org-babel-temporary-directory
(org-babel-temp-directory)
"/gnuplot/"
(file-remote-p val 'host)
(org-babel-local-file-name val))))
@ -135,8 +142,7 @@ code."
(timefmt (cdr (assq :timefmt params)))
(time-ind (or (cdr (assq :timeind params))
(when timefmt 1)))
(directory (and (buffer-file-name)
(file-name-directory (buffer-file-name))))
(directory default-directory)
(add-to-body (lambda (text) (setq body (concat text "\n" body)))))
;; append header argument settings to body
(when missing (funcall add-to-body (format "set datafile missing '%s'" missing)))

12
lisp/org/ob-groovy.el
View file

@ -2,10 +2,10 @@
;; Copyright (C) 2013-2022 Free Software Foundation, Inc.
;; Author: Miro Bezjak
;; Maintainer: Palak Mathur
;; Author: Miro Bezjak <bezjak.miro@gmail.com>
;; Maintainer: Palak Mathur <palakmathur@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -31,6 +31,10 @@
;; https://github.com/russel/Emacs-Groovy-Mode
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
@ -48,7 +52,7 @@ parameters may be used, like groovy -v"
(defun org-babel-execute:groovy (body params)
"Execute a block of Groovy code with org-babel.
This function is called by `org-babel-execute-src-block'."
(message "executing Groovy source code block")
(message "Executing Groovy source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-groovy-initiate-session (nth 0 processed-params)))
(result-params (nth 2 processed-params))

10
lisp/org/ob-haskell.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Maintainer: Lawrence Bottorff <borgauf@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -39,6 +39,10 @@
;; - (optionally) lhs2tex: https://people.cs.uu.nl/andres/lhs2tex/
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)
(require 'comint)
@ -132,7 +136,7 @@ a parameter, such as \"ghc -v\"."
(comint-preoutput-filter-functions
(cons 'ansi-color-filter-apply comint-preoutput-filter-functions))
(raw (org-babel-comint-with-output
(session org-babel-haskell-eoe t full-body)
(session org-babel-haskell-eoe nil full-body)
(insert (org-trim full-body))
(comint-send-input nil t)
(insert org-babel-haskell-eoe)
@ -146,7 +150,7 @@ a parameter, such as \"ghc -v\"."
(`output (mapconcat #'identity (reverse results) "\n"))
(`value (car results)))))
(org-babel-result-cond (cdr (assq :result-params params))
result (org-babel-script-escape result)))
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))

25
lisp/org/ob-java.el
View file

@ -6,7 +6,7 @@
;; Dan Davison
;; Maintainer: Ian Martins <ianxm@jhu.edu>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -28,6 +28,10 @@
;; Org-Babel support for evaluating java source code.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-tangle-lang-exts)
@ -49,7 +53,13 @@ directory, so we keep that as the default behavior.
[1] https://orgmode.org/manual/Results-of-Evaluation.html")
(defconst org-babel-header-args:java '((imports . :any))
(defconst org-babel-header-args:java
'((dir . :any)
(classname . :any)
(imports . :any)
(cmpflag . :any)
(cmdline . :any)
(cmdarg . :any))
"Java-specific header arguments.")
(defcustom org-babel-java-command "java"
@ -184,13 +194,10 @@ replaced in this string.")
(packagename (if (string-match-p "\\." fullclassname)
(file-name-base fullclassname)))
;; the base dir that contains the top level package dir
(basedir (file-name-as-directory (if run-from-temp
(if (file-remote-p default-directory)
(concat
(file-remote-p default-directory)
org-babel-remote-temporary-directory)
org-babel-temporary-directory)
default-directory)))
(basedir (file-name-as-directory
(if run-from-temp
(org-babel-temp-directory)
default-directory)))
;; the dir to write the source file
(packagedir (if (and (not run-from-temp) packagename)
(file-name-as-directory

6
lisp/org/ob-js.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -38,6 +38,10 @@
;; configuration instructions
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(declare-function run-mozilla "ext:moz" (arg))

6
lisp/org/ob-julia.el
View file

@ -4,7 +4,7 @@
;; Authors: G. Jay Kerns
;; Maintainer: Pedro Bruel <pedro.bruel@gmail.com>
;; Keywords: literate programming, reproducible research, scientific computing
;; Homepage: https://github.com/phrb/ob-julia
;; URL: https://github.com/phrb/ob-julia
;; This file is part of GNU Emacs.
@ -31,6 +31,10 @@
;; Julia packages.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'ob)

21
lisp/org/ob-latex.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -30,6 +30,10 @@
;; be created directly form the latex source code.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)
@ -37,6 +41,9 @@
(declare-function org-latex-compile "ox-latex" (texfile &optional snippet))
(declare-function org-latex-guess-inputenc "ox-latex" (header))
(declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra))
(declare-function org-at-heading-p "org" (&optional _))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-next-visible-heading "org" (arg))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex"))
@ -61,7 +68,6 @@
(pdfpng . :any)
(pdfwidth . :any)
(headers . :any)
(packages . :any)
(buffer . ((yes no))))
"LaTeX-specific header arguments.")
@ -104,10 +110,17 @@ exporting the literal LaTeX source."
:type 'function)
(defcustom org-babel-latex-pdf-svg-process
"inkscape --pdf-poppler %f -T -l -o %O"
"inkscape \
--pdf-poppler \
--export-area-drawing \
--export-text-to-path \
--export-plain-svg \
--export-filename=%O \
%f"
"Command to convert a PDF file to an SVG file."
:group 'org-babel
:type 'string)
:type 'string
:package-version '(Org . "9.6"))
(defcustom org-babel-latex-htlatex-packages
'("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}")

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

@ -4,7 +4,7 @@
;; Author: Martyn Jago
;; Keywords: babel language, literate programming
;; Homepage: https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
;; URL: https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
;; This file is part of GNU Emacs.
@ -32,9 +32,13 @@
;; This depends on epstopdf --- See https://www.ctan.org/pkg/epstopdf.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(declare-function org-show-all "org" (&optional types))
(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)
@ -108,7 +112,7 @@ you can leave the string empty on this case."
:package-version '(Org . "8.2.7")
:set
(lambda (symbol value)
(set symbol value)
(set-default-toplevel-value symbol value)
(setq
org-babel-lilypond-ly-command (nth 0 value)
org-babel-lilypond-pdf-command (nth 1 value)
@ -280,7 +284,7 @@ LINE is the erroneous line."
(setq case-fold-search nil)
(if (search-forward line nil t)
(progn
(org-show-all)
(org-fold-show-all)
(set-mark (point))
(goto-char (- (point) (length line))))
(goto-char temp))))

6
lisp/org/ob-lisp.el
View file

@ -6,7 +6,7 @@
;; Eric Schulte
;; David T. O'Toole <dto@gnu.org>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -36,6 +36,10 @@
;; - https://common-lisp.net/project/slime/
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)

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

@ -5,7 +5,7 @@
;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -23,12 +23,16 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'ob-core)
(require 'ob-table)
(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
(declare-function org-element-at-point "org-element" ())
(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))
@ -50,7 +54,7 @@ should not be inherited from a source block.")
(interactive "fFile: ")
(let ((lob-ingest-count 0))
(org-babel-map-src-blocks file
(let* ((info (org-babel-get-src-block-info 'light))
(let* ((info (org-babel-get-src-block-info 'no-eval))
(source-name (nth 4 info)))
(when source-name
(setf (nth 1 info)
@ -74,9 +78,10 @@ should not be inherited from a source block.")
Detect if this is context for a Library Of Babel source block and
if so then run the appropriate source block from the Library."
(interactive)
(let ((info (org-babel-lob-get-info)))
(let* ((datum (org-element-context))
(info (org-babel-lob-get-info datum)))
(when info
(org-babel-execute-src-block nil info)
(org-babel-execute-src-block nil info nil (org-element-type datum))
t)))
(defun org-babel-lob--src-info (ref)
@ -114,11 +119,16 @@ after REF in the Library of Babel."
(cdr (assoc-string ref org-babel-library-of-babel))))))))
;;;###autoload
(defun org-babel-lob-get-info (&optional datum)
(defun org-babel-lob-get-info (&optional datum no-eval)
"Return internal representation for Library of Babel function call.
Consider DATUM, when provided, or element at point otherwise.
When optional argument NO-EVAL is non-nil, Babel does not resolve
remote variable references; a process which could likely result
in the execution of other code blocks, and do not evaluate Lisp
values in parameters.
Return nil when not on an appropriate location. Otherwise return
a list compatible with `org-babel-get-src-block-info', which
see."
@ -139,16 +149,16 @@ see."
org-babel-default-lob-header-args
(append
(org-with-point-at begin
(org-babel-params-from-properties language))
(org-babel-params-from-properties language no-eval))
(list
(org-babel-parse-header-arguments
(org-element-property :inside-header context))
(org-element-property :inside-header context) no-eval)
(let ((args (org-element-property :arguments context)))
(and args
(mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args args))))
(org-babel-parse-header-arguments
(org-element-property :end-header context)))))
(org-element-property :end-header context) no-eval))))
nil
(org-element-property :name context)
begin

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

@ -4,7 +4,7 @@
;; Authors: Dieter Schoen
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -35,6 +35,10 @@
;; However, sessions are not yet working.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)
(require 'cl-lib)
@ -395,7 +399,7 @@ fd:close()"
(org-babel-lua-table-or-string results)))))
(defun org-babel-lua-read-string (string)
"Strip \\=' characters from around Lua string."
"Strip single quotes from around Lua string."
(org-unbracket-string "'" "'" string))
(provide 'ob-lua)

6
lisp/org/ob-makefile.el
View file

@ -5,7 +5,7 @@
;; Author: Eric Schulte
;; Thomas S. Dye
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -27,6 +27,10 @@
;; This file exists solely for tangling a Makefile from Org files.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-default-header-args:makefile '())

6
lisp/org/ob-matlab.el
View file

@ -4,7 +4,7 @@
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -35,6 +35,10 @@
;; https://matlab-emacs.sourceforge.net/
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'ob-octave)

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

@ -5,7 +5,7 @@
;; Author: Eric S Fraga
;; Eric Schulte
;; Keywords: literate programming, reproducible research, maxima
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -31,6 +31,10 @@
;; 2) we are adding the "cmdline" header argument
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-tangle-lang-exts)
@ -72,13 +76,16 @@
(defun org-babel-execute:maxima (body params)
"Execute a block of Maxima entries with org-babel.
This function is called by `org-babel-execute-src-block'."
(message "executing Maxima source code 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)) ""))
(in-file (org-babel-temp-file "maxima-" ".max"))
(cmd (format "%s --very-quiet -r 'batchload(%S)$' %s"
org-babel-maxima-command in-file cmdline)))
(cmd (format "%s --very-quiet -r %s %s"
org-babel-maxima-command
(shell-quote-argument
(format "batchload(%S)$" in-file))
cmdline)))
(with-temp-file in-file (insert (org-babel-maxima-expand body params)))
(message cmd)
;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "

6
lisp/org/ob-ocaml.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -35,6 +35,10 @@
;; - tuareg-mode :: https://elpa.nongnu.org/nongnu/tuareg.html
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'comint)
(require 'org-macs)

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

@ -4,7 +4,7 @@
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -29,6 +29,10 @@
;; octave-mode.el and octave-inf.el come with GNU emacs
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)
@ -57,7 +61,7 @@ delete('%s')
")
(defvar org-babel-octave-wrapper-method
"%s
if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid);
if ischar(ans), fid = fopen('%s', 'w'); fdisp(fid, ans); fclose(fid);
else, dlmwrite('%s', ans, '\\t')
end")

6
lisp/org/ob-org.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -27,6 +27,10 @@
;; contents of the code block are returned in a raw result.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(declare-function org-export-string-as "ox"

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

@ -4,9 +4,9 @@
;; Authors: Dan Davison
;; Eric Schulte
;; Maintainer: Corwin Brust
;; Maintainer: Corwin Brust <corwin@bru.st>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -28,6 +28,10 @@
;; Org-Babel support for evaluating perl source code.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-tangle-lang-exts)

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

@ -4,7 +4,7 @@
;; Author: Zhang Weize
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -34,6 +34,10 @@
;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file (when exec mode is `jar')
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-default-header-args:plantuml
@ -65,8 +69,8 @@ You can also configure extra arguments via `org-plantuml-executable-args'."
:package-version '(Org . "9.4")
:type 'string)
(defcustom org-plantuml-executable-args (list "-headless")
"The arguments passed to plantuml executable when executing PlantUML."
(defcustom org-plantuml-args (list "-headless")
"The arguments passed to plantuml when executing PlantUML."
:group 'org-babel
:package-version '(Org . "9.4")
:type '(repeat string))
@ -109,21 +113,25 @@ If BODY does not contain @startXXX ... @endXXX clauses, @startuml
(defun org-babel-execute:plantuml (body params)
"Execute a block of plantuml code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let* ((out-file (or (cdr (assq :file params))
(error "PlantUML requires a \":file\" header argument")))
(let* ((do-export (member "file" (cdr (assq :result-params params))))
(out-file (if do-export
(or (cdr (assq :file params))
(error "No :file provided but :results set to file. For plain text output, set :results to verbatim"))
(org-babel-temp-file "plantuml-" ".txt")))
(cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
(java (or (cdr (assq :java params)) ""))
(executable (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-executable-path)
(t "java")))
(executable-args (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-executable-args)
(executable-args (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-args)
((string= "" org-plantuml-jar-path)
(error "`org-plantuml-jar-path' is not set"))
((not (file-exists-p org-plantuml-jar-path))
(error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
(t (list java
"-jar"
(shell-quote-argument (expand-file-name org-plantuml-jar-path))))))
(t `(,java
"-jar"
,(shell-quote-argument (expand-file-name org-plantuml-jar-path))
,@org-plantuml-args))))
(full-body (org-babel-plantuml-make-body body params))
(cmd (mapconcat #'identity
(append
@ -154,7 +162,10 @@ This function is called by `org-babel-execute-src-block'."
(if (and (string= (file-name-extension out-file) "svg")
org-babel-plantuml-svg-text-to-path)
(org-babel-eval (format "inkscape %s -T -l %s" out-file out-file) ""))
nil)) ;; signal that output has already been written to file
(unless do-export (with-temp-buffer
(insert-file-contents out-file)
(buffer-substring-no-properties
(point-min) (point-max))))))
(defun org-babel-prep-session:plantuml (_session _params)
"Return an error because plantuml does not support sessions."

9
lisp/org/ob-processing.el
View file

@ -3,8 +3,9 @@
;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
;; Author: Jarmo Hurri (adapted from ob-asymptote.el written by Eric Schulte)
;; Maintainer: Jarmo Hurri <jarmo.hurri@iki.fi>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -50,6 +51,10 @@
;; - Processing.js module :: https://processingjs.org/
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'sha1)
@ -88,7 +93,7 @@
;; make-temp-file is repeated until no hyphen is in the
;; name; also sketch dir name must be the same as the
;; basename of the sketch file.
(let* ((temporary-file-directory org-babel-temporary-directory)
(let* ((temporary-file-directory (org-babel-temp-directory))
(sketch-dir
(let (sketch-dir-candidate)
(while

30
lisp/org/ob-python.el
View file

@ -6,7 +6,7 @@
;; Dan Davison
;; Maintainer: Jack Kamm <jackkamm@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -28,12 +28,16 @@
;; Org-Babel support for evaluating python source code.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)
(require 'python)
(declare-function py-shell "ext:python-mode" (&rest args))
(declare-function py-toggle-shells "ext:python-mode" (arg))
(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)
@ -178,9 +182,10 @@ Emacs-lisp table, otherwise return the results as a string."
(substring name 1 (- (length name) 1))
name)))
(defvar py-default-interpreter)
(defvar py-which-bufname)
(defvar python-shell-buffer-name)
(defvar-local org-babel-python--initialized nil
"Flag used to mark that python session has been initialized.")
(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
@ -198,14 +203,20 @@ then create. Return the initialized session."
(let ((python-shell-buffer-name
(org-babel-python-without-earmuffs py-buffer)))
(run-python cmd)
(sleep-for 0 10)))
(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-toggle-shells py-default-interpreter)
(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))
@ -217,6 +228,15 @@ then create. Return the initialized session."
(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)
(org-babel-comint-wait-for-output py-buffer)))
(org-babel-comint-wait-for-output py-buffer))
(setq org-babel-python-buffers
(cons (cons session py-buffer)
(assq-delete-all session org-babel-python-buffers)))

30
lisp/org/ob-ref.el
View file

@ -5,7 +5,7 @@
;; Authors: Eric Schulte
;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -49,12 +49,16 @@
;; #+end_src
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob-core)
(require 'org-macs)
(require 'cl-lib)
(declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
(declare-function org-element-at-point "org-element" ())
(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-end-of-meta-data "org" (&optional full))
@ -62,8 +66,8 @@
(declare-function org-id-find-id-file "org-id" (id))
(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-show-context "org" (&optional key))
(declare-function org-narrow-to-subtree "org" (&optional element))
(declare-function org-fold-show-context "org-fold" (&optional key))
(defvar org-babel-update-intermediate nil
"Update the in-buffer results of code blocks executed to resolve references.")
@ -104,7 +108,7 @@ Emacs Lisp representation of the value of the variable."
(pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)
(org-fold-show-context)
t))))
(defun org-babel-ref-headline-body ()
@ -124,12 +128,14 @@ Emacs Lisp representation of the value of the variable."
(save-excursion
(let ((case-fold-search t)
args new-refere new-header-args new-referent split-file split-ref
index)
index contents)
;; if ref is indexed grab the indices -- beware nested indices
(when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
(when (and (string-match "\\[\\([^\\[]*\\)\\]$" ref)
(let ((str (substring ref 0 (match-beginning 0))))
(= (cl-count ?\( str) (cl-count ?\) str))))
(setq index (match-string 1 ref))
(if (> (length (match-string 1 ref)) 0)
(setq index (match-string 1 ref))
(setq contents t))
(setq ref (substring ref 0 (match-beginning 0))))
;; assign any arguments to pass to source block
(when (string-match
@ -153,7 +159,7 @@ Emacs Lisp representation of the value of the variable."
(setq ref split-ref))
(org-with-wide-buffer
(goto-char (point-min))
(let* ((params (append args '((:results . "silent"))))
(let* ((params (append args '((:results . "none"))))
(regexp (org-babel-named-data-regexp-for-name ref))
(result
(catch :found
@ -171,7 +177,7 @@ Emacs Lisp representation of the value of the variable."
(throw :found
(org-babel-execute-src-block
nil (org-babel-lob-get-info e) params)))
(`src-block
((and `src-block (guard (not contents)))
(throw :found
(org-babel-execute-src-block
nil nil
@ -193,7 +199,7 @@ Emacs Lisp representation of the value of the variable."
(org-babel-execute-src-block nil info params))))
(error "Reference `%s' not found in this buffer" ref))))
(cond
((symbolp result) (format "%S" result))
((and result (symbolp result)) (format "%S" result))
((and index (listp result))
(org-babel-ref-index-list index result))
(t result)))))))))

6
lisp/org/ob-ruby.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -36,6 +36,10 @@
;; https://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)

6
lisp/org/ob-sass.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -38,6 +38,10 @@
;; - sass-mode :: https://github.com/nex3/haml/blob/master/extra/sass-mode.el
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-default-header-args:sass '())

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

@ -5,7 +5,7 @@
;; Authors: Eric Schulte
;; Michael Gauland
;; Keywords: literate programming, reproducible research, scheme
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -38,6 +38,10 @@
;; ELPA.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'geiser nil t)
(require 'geiser-impl nil t)
@ -52,9 +56,12 @@
(defvar geiser-repl-window-allow-split) ; Defined in geiser-repl.el
(declare-function run-geiser "ext:geiser-repl" (impl))
(declare-function geiser "ext:geiser-repl" (impl))
(declare-function geiser-mode "ext:geiser-mode" ())
(declare-function geiser-eval-region "ext:geiser-mode"
(start end &optional and-go raw nomsg))
(declare-function geiser-eval-region/wait "ext:geiser-mode"
(start end &optional timeout))
(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))
@ -114,7 +121,10 @@
(let ((buffer (org-babel-scheme-get-session-buffer name)))
(or buffer
(progn
(run-geiser impl)
(if (fboundp 'geiser)
(geiser impl)
;; Obsolete since Geiser 0.26.
(run-geiser impl))
(when name
(rename-buffer name t)
(org-babel-scheme-set-session-buffer name (current-buffer)))
@ -176,7 +186,13 @@ is true; otherwise returns the last value."
(setq geiser-impl--implementation nil)
(let ((geiser-debug-jump-to-debug-p nil)
(geiser-debug-show-debug-p nil))
(let ((ret (geiser-eval-region (point-min) (point-max))))
;; `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")

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

@ -3,9 +3,9 @@
;; Copyright (C) 2009-2022 Free Software Foundation, Inc.
;; Author: Benjamin Andresen
;; Maintainer: Ken Mankoff
;; Maintainer: Ken Mankoff <mankoff@gmail.com>
;; Keywords: literate programming, interactive shell
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -34,6 +34,10 @@
;; M-x org-babel-screen-test RET
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-screen-location "screen"

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

@ -35,11 +35,15 @@
;; In addition to the normal header arguments, ob-sed also provides
;; :cmd-line and :in-file. :cmd-line allows one to pass other flags to
;; the sed command like the "--in-place" flag which makes sed edit the
;; file pass to it instead of outputting to standard out or to a
;; file passed to it instead of outputting to standard out or to a
;; different file. :in-file is a header arguments that allows one to
;; tell Org Babel which file the sed script to act on.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(defvar org-babel-sed-command "sed"
@ -61,7 +65,7 @@
BODY is the source inside a sed source block and PARAMS is an
association list over the source block configurations. This
function is called by `org-babel-execute-src-block'."
(message "executing sed source code block")
(message "Executing sed source code block")
(let* ((result-params (cdr (assq :result-params params)))
(cmd-line (cdr (assq :cmd-line params)))
(in-file (cdr (assq :in-file params)))

91
lisp/org/ob-shell.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -26,6 +26,10 @@
;; Org-Babel support for evaluating shell source code.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'org-macs)
(require 'shell)
@ -42,6 +46,28 @@
(defvar org-babel-default-header-args:shell '())
(defvar org-babel-shell-names)
(defconst org-babel-shell-set-prompt-commands
'(;; Fish has no PS2 equivalent.
("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="))
"Alist assigning shells with their prompt setting command.
Each element of the alist associates a shell type from
`org-babel-shell-names' with a template used to create a command to
change the default prompt. The template is an argument to `format'
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'
@ -51,7 +77,10 @@ is modified outside the Customize interface."
(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))
(let ((shell-file-name ,name)
(org-babel-prompt-command
(or (alist-get ,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
@ -68,7 +97,7 @@ outside the Customize interface."
:group 'org-babel
:type '(repeat (string :tag "Shell name: "))
:set (lambda (symbol value)
(set-default symbol value)
(set-default-toplevel-value symbol value)
(org-babel-shell-initialize)))
(defcustom org-babel-shell-results-defaults-to-output t
@ -206,6 +235,13 @@ var of the same value."
(mapconcat echo-var var "\n"))
(t (funcall echo-var var)))))
(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
"String to indicate that evaluation has completed.")
(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
"String to indicate that evaluation has completed.")
(defvar org-babel-sh-prompt "org_babel_sh_prompt> "
"String to set prompt in session shell.")
(defun org-babel-sh-initiate-session (&optional session _params)
"Initiate a session named SESSION according to PARAMS."
(when (and session (not (string= session "none")))
@ -213,17 +249,20 @@ var of the same value."
(or (org-babel-comint-buffer-livep session)
(progn
(shell session)
;; Set unique prompt for easier analysis of the output.
(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)
" *"))
;; 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)))))))
(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
"String to indicate that evaluation has completed.")
(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
"String to indicate that evaluation has completed.")
(defun org-babel-sh-evaluate (session body &optional params stdin cmdline)
"Pass BODY to the Shell process in BUFFER.
If RESULT-TYPE equals `output' then return a list of the outputs
@ -249,32 +288,30 @@ return the value of the last statement in BODY."
(set-file-modes script-file #o755)
(with-temp-file stdin-file (insert (or stdin "")))
(with-temp-buffer
(call-process-shell-command
(concat (if shebang script-file
(format "%s %s" shell-file-name script-file))
(and cmdline (concat " " cmdline)))
stdin-file
(current-buffer))
(with-connection-local-variables
(apply #'process-file
(if shebang (file-local-name script-file)
shell-file-name)
stdin-file
(current-buffer)
nil
(if shebang (when cmdline (list cmdline))
(list shell-command-switch
(concat (file-local-name script-file) " " cmdline)))))
(buffer-string))))
(session ; session evaluation
(mapconcat
#'org-babel-sh-strip-weird-long-prompt
(mapcar
#'org-trim
(butlast
(butlast ; Remove eoe indicator
(org-babel-comint-with-output
(session org-babel-sh-eoe-output t body)
(dolist (line (append (split-string (org-trim body) "\n")
(list org-babel-sh-eoe-indicator)))
(insert line)
(comint-send-input nil t)
(while (save-excursion
(goto-char comint-last-input-end)
(not (re-search-forward
comint-prompt-regexp nil t)))
(accept-process-output
(get-buffer-process (current-buffer))))))
2))
(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.
@ -288,7 +325,7 @@ return the value of the last statement in BODY."
(set-file-modes script-file #o755)
(org-babel-eval script-file "")))
(t (org-babel-eval shell-file-name (org-trim body))))))
(when value-is-exit-status
(when (and results value-is-exit-status)
(setq results (car (reverse (split-string results "\n" t)))))
(when results
(let ((result-params (cdr (assq :result-params params))))

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

@ -3,8 +3,9 @@
;; Copyright (C) 2009-2022 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Daniel Kraus <daniel@kraus.my>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -69,6 +70,10 @@
;;
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(declare-function org-table-import "org-table" (file arg))
@ -218,18 +223,18 @@ then look for the parameter into the corresponding connection
defined in `sql-connection-alist', otherwise look into PARAMS.
See `sql-connection-alist' (part of SQL mode) for how to define
database connections."
(if (assq :dbconnection params)
(let* ((dbconnection (cdr (assq :dbconnection params)))
(name-mapping '((:dbhost . sql-server)
(:dbport . sql-port)
(:dbuser . sql-user)
(:dbpassword . sql-password)
(:dbinstance . sql-dbinstance)
(:database . sql-database)))
(mapped-name (cdr (assq name name-mapping))))
(cadr (assq mapped-name
(cdr (assoc dbconnection sql-connection-alist)))))
(cdr (assq name params))))
(or (cdr (assq name params))
(and (assq :dbconnection params)
(let* ((dbconnection (cdr (assq :dbconnection params)))
(name-mapping '((:dbhost . sql-server)
(:dbport . sql-port)
(:dbuser . sql-user)
(:dbpassword . sql-password)
(:dbinstance . sql-dbinstance)
(:database . sql-database)))
(mapped-name (cdr (assq name name-mapping))))
(cadr (assq mapped-name
(cdr (assoc dbconnection sql-connection-alist))))))))
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.

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

@ -3,9 +3,9 @@
;; Copyright (C) 2010-2022 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Nick Savage
;; Maintainer: Nick Savage <nick@nicksavage.ca>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -27,6 +27,10 @@
;; Org-Babel support for evaluating sqlite source code.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob)
(require 'ob-sql)

75
lisp/org/ob-table.el
View file

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -53,6 +53,10 @@
;; are optional.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ob-core)
(require 'org-macs)
@ -108,44 +112,43 @@ as shown in the example below.
;; ensure that all cells prefixed with $'s are strings
(cons (car var)
(delq nil (mapcar
(lambda (el)
(if (eq '$ el)
(prog1 nil (setq quote t))
(prog1
(cond
(quote (format "\"%s\"" el))
((stringp el) (org-no-properties el))
(t el))
(setq quote nil))))
(cdr var)))))
(lambda (el)
(if (eq '$ el)
(prog1 nil (setq quote t))
(prog1
(cond
(quote (format "\"%s\"" el))
((stringp el) (org-no-properties el))
(t el))
(setq quote nil))))
(cdr var)))))
variables)))
(unless (stringp source-block)
(setq source-block (symbol-name source-block)))
(let ((result
(if (and source-block (> (length source-block) 0))
(let ((params
;; FIXME: Why `eval'?!?!?
(eval `(org-babel-parse-header-arguments
(concat
":var results="
,source-block
"[" ,header-args "]"
"("
(mapconcat
(lambda (var-spec)
(if (> (length (cdr var-spec)) 1)
(format "%S='%S"
(car var-spec)
(mapcar #'read (cdr var-spec)))
(format "%S=%s"
(car var-spec) (cadr var-spec))))
',variables ", ")
")")))))
(org-babel-execute-src-block
nil (list "emacs-lisp" "results" params)
'((:results . "silent"))))
"")))
(org-trim (if (stringp result) result (format "%S" result)))))))
`(let ((result
(if ,(and source-block (> (length source-block) 0))
(let ((params
',(org-babel-parse-header-arguments
(concat
":var results="
source-block
"[" header-args "]"
"("
(mapconcat
(lambda (var-spec)
(if (> (length (cdr var-spec)) 1)
(format "%S='%S"
(car var-spec)
(mapcar #'read (cdr var-spec)))
(format "%S=%s"
(car var-spec) (cadr var-spec))))
variables ", ")
")"))))
(org-babel-execute-src-block
nil (list "emacs-lisp" "results" params)
'((:results . "silent"))))
"")))
(org-trim (if (stringp result) result (format "%S" result)))))))
(provide 'ob-table)

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

@ -4,7 +4,7 @@
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -27,6 +27,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'org-src)
(require 'org-macs)
@ -37,7 +40,10 @@
(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-at-point "org-element" ())
(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-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-type "org-element" (element))
(declare-function org-heading-components "org" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
@ -45,6 +51,11 @@
(declare-function outline-previous-heading "outline" ())
(defvar org-id-link-to-org-use-id) ; Dynamically scoped
(defgroup org-babel-tangle nil
"Options for extracting source code from code blocks."
:tag "Org Babel Tangle"
:group 'org-babel)
(defcustom org-babel-tangle-lang-exts
'(("emacs-lisp" . "el")
("elisp" . "el"))
@ -67,22 +78,29 @@ then the name of the language is used."
(defcustom org-babel-post-tangle-hook nil
"Hook run in code files tangled by `org-babel-tangle'."
:group 'org-babel
:group 'org-babel-tangle
:version "24.1"
:type 'hook)
(defcustom org-babel-pre-tangle-hook '(save-buffer)
"Hook run at the beginning of `org-babel-tangle'."
:group 'org-babel
"Hook run at the beginning of `org-babel-tangle' in the original buffer."
:group 'org-babel-tangle
:version "24.1"
:type 'hook)
(defcustom org-babel-tangle-body-hook nil
"Hook run over the contents of each code block body."
:group 'org-babel
:group 'org-babel-tangle
:version "24.1"
:type 'hook)
(defcustom org-babel-tangle-finished-hook nil
"Hook run at the very end of `org-babel-tangle' in the original buffer.
In this way, it is the counterpart to `org-babel-pre-tangle-hook'."
:group 'org-babel-tangle
:package-version '(Org . "9.6")
:type 'hook)
(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]"
"Format of inserted comments in tangled code files.
The following format strings can be used to insert special
@ -99,7 +117,7 @@ non-nil value.
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
:group 'org-babel-tangle
:version "24.1"
:type 'string)
@ -119,7 +137,7 @@ non-nil value.
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
:group 'org-babel-tangle
:version "24.1"
:type 'string)
@ -128,7 +146,7 @@ controlled by the :comments header argument."
of tangle comments. Use `org-babel-tangle-comment-format-beg'
and `org-babel-tangle-comment-format-end' to customize the format
of tangled comments."
:group 'org-babel
:group 'org-babel-tangle
:type 'boolean)
(defcustom org-babel-process-comment-text 'org-remove-indentation
@ -136,10 +154,18 @@ of tangled comments."
inserted as comments in tangled source-code files. The function
should take a single string argument and return a string
result. The default value is `org-remove-indentation'."
:group 'org-babel
:group 'org-babel-tangle
:version "24.1"
:type 'function)
(defcustom org-babel-tangle-default-file-mode #o544
"The default mode used for tangled files, as an integer.
The default value 356 correspands to the octal #o544, which is
read-write permissions for the user, read-only for everyone else."
:group 'org-babel-tangle
:package-version '(Org . "9.6")
:type 'integer)
(defun org-babel-find-file-noselect-refresh (file)
"Find file ensuring that the latest changes on disk are
represented in the file."
@ -177,7 +203,7 @@ export file for all source blocks.
Optional argument LANG-RE can be used to limit the exported
source code blocks by languages matching a regular expression.
Return a list whose CAR is the tangled file name."
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))))
@ -199,7 +225,7 @@ Return a list whose CAR is the tangled file name."
(defun org-babel-tangle (&optional arg target-file lang-re)
"Write code blocks to source-specific files.
Extract the bodies of all source code blocks from the current
file into their own source-specific files.
file into their own source-specific files. Return the list of files.
With one universal prefix argument, only tangle the block at point.
When two universal prefix arguments, only tangle blocks for the
tangle file of the block at point.
@ -225,7 +251,7 @@ matching a regular expression."
org-babel-default-header-args))
(tangle-file
(when (equal arg '(16))
(or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light))))
(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)
(mapc ;; map over file-names
@ -254,7 +280,7 @@ matching a regular expression."
(when she-bang
(unless tangle-mode (setq tangle-mode #o755)))
(when tangle-mode
(add-to-list 'modes tangle-mode))
(add-to-list 'modes (org-babel-interpret-file-mode tangle-mode)))
;; Possibly create the parent directories for file.
(let ((m (funcall get-spec :mkdirp)))
(and m fnd (not (string= m "no"))
@ -271,11 +297,24 @@ matching a regular expression."
lspecs)
(when make-dir
(make-directory fnd 'parents))
;; erase previous file
(when (file-exists-p file-name)
(delete-file file-name))
(write-region nil nil file-name)
(mapc (lambda (mode) (set-file-modes file-name mode)) modes)
(unless
(and (file-exists-p file-name)
(let ((tangle-buf (current-buffer)))
(with-temp-buffer
(insert-file-contents file-name)
(and
(equal (buffer-size)
(buffer-size tangle-buf))
(= 0
(let (case-fold-search)
(compare-buffer-substrings
nil nil nil
tangle-buf nil nil)))))))
;; erase previous file
(when (file-exists-p file-name)
(delete-file 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))
(org-babel-tangle-single-block 1 t)
@ -295,8 +334,39 @@ matching a regular expression."
(org-babel-with-temp-filebuffer file
(run-hooks 'org-babel-post-tangle-hook)))
path-collector))
(run-hooks 'org-babel-tangle-finished-hook)
path-collector))))
(defun org-babel-interpret-file-mode (mode)
"Determine the integer representation of a file MODE specification.
The following forms are currently recognised:
- an integer (returned without modification)
- \"o755\" (chmod style octal)
- \"rwxrw-r--\" (ls style specification)
- \"a=rw,u+x\" (chmod style) *
* The interpretation of these forms relies on `file-modes-symbolic-to-number',
and uses `org-babel-tangle-default-file-mode' as the base mode."
(cond
((integerp mode)
(if (string-match-p "^[0-7][0-7][0-7]$" (format "%o" mode))
mode
(user-error "%1$o is not a valid file mode octal. \
Did you give the decimal value %1$d by mistake?" mode)))
((not (stringp mode))
(error "File mode %S not recognised as a valid format." mode))
((string-match-p "^o0?[0-7][0-7][0-7]$" mode)
(string-to-number (replace-regexp-in-string "^o" "" mode) 8))
((string-match-p "^[ugoa]*\\(?:[+-=][rwxXstugo]*\\)+\\(,[ugoa]*\\(?:[+-=][rwxXstugo]*\\)+\\)*$" mode)
;; Match regexp taken from `file-modes-symbolic-to-number'.
(file-modes-symbolic-to-number mode org-babel-tangle-default-file-mode))
((string-match-p "^[r-][w-][xs-][r-][w-][xs-][r-][w-][x-]$" mode)
(file-modes-symbolic-to-number (concat "u=" (substring mode 0 3)
",g=" (substring mode 3 6)
",o=" (substring mode 6 9))
0))
(t (error "File mode %S not recognised as a valid format. See `org-babel-interpret-file-mode'." mode))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
Call this function inside of a source-code file generated by
@ -387,14 +457,16 @@ code blocks by target file."
(let ((counter 0) last-heading-pos blocks)
(org-babel-map-src-blocks (buffer-file-name)
(let ((current-heading-pos
(org-with-wide-buffer
(org-with-limited-levels (outline-previous-heading)))))
(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))))))
(if (eq last-heading-pos current-heading-pos) (cl-incf counter)
(setq counter 1)
(setq last-heading-pos current-heading-pos)))
(unless (or (org-in-commented-heading-p)
(org-in-archived-heading-p))
(let* ((info (org-babel-get-src-block-info 'light))
(let* ((info (org-babel-get-src-block-info 'no-eval))
(src-lang (nth 0 info))
(src-tfile (cdr (assq :tangle (nth 2 info)))))
(unless (or (string= src-tfile "no")
@ -413,6 +485,33 @@ code blocks by target file."
(mapcar (lambda (b) (cons (car b) (nreverse (cdr b))))
(nreverse blocks))))
(defun org-babel-tangle--unbracketed-link (params)
"Get a raw link to the src block at point, without brackets.
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
(cl-letf (((symbol-function 'org-store-link-functions)
(lambda () nil)))
(org-store-link nil))))
(bare (and (string-match org-link-bracket-re l)
(match-string 1 l))))
(when bare
(if (and org-babel-tangle-use-relative-file-links
(string-match org-link-types-re bare)
(string= (match-string 1 bare) "file"))
(concat "file:"
(file-relative-name (substring bare (match-end 0))
(file-name-directory
(cdr (assq :tangle params)))))
bare))))))
(defun org-babel-tangle-single-block (block-counter &optional only-this-block)
"Collect the tangled source for current block.
Return the list of block attributes needed by
@ -429,16 +528,7 @@ non-nil, return the full association list to be used by
(extra (nth 3 info))
(coderef (nth 6 info))
(cref-regexp (org-src-coderef-regexp coderef))
(link (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 (org-store-link nil))))
(and (string-match org-link-bracket-re l)
(match-string 1 l))))
(link (org-babel-tangle--unbracketed-link params))
(source-name
(or (nth 4 info)
(format "%s:%d"
@ -451,7 +541,9 @@ non-nil, return the full association list to be used by
(body
;; Run the tangle-body-hook.
(let ((body (if (org-babel-noweb-p params :tangle)
(org-babel-expand-noweb-references info)
(if (string= "strip-tangle" (cdr (assq :noweb (nth 2 info))))
(replace-regexp-in-string (org-babel-noweb-wrap) "" (nth 1 info))
(org-babel-expand-noweb-references info))
(nth 1 info))))
(with-temp-buffer
(insert
@ -486,19 +578,13 @@ non-nil, return the full association list to be used by
(match-end 0)
(point-min))))
(point)))))
(src-tfile (cdr (assq :tangle params)))
(result
(list start-line
(if org-babel-tangle-use-relative-file-links
(file-relative-name file)
file)
(if (and org-babel-tangle-use-relative-file-links
(string-match org-link-types-re link)
(string= (match-string 1 link) "file"))
(concat "file:"
(file-relative-name (substring link (match-end 0))
(file-name-directory
(cdr (assq :tangle params)))))
link)
link
source-name
params
(if org-src-preserve-indentation
@ -506,8 +592,7 @@ non-nil, return the full association list to be used by
(org-trim (org-remove-indentation body)))
comment)))
(if only-this-block
(let* ((src-tfile (cdr (assq :tangle (nth 4 result))))
(file-name (org-babel-effective-tangled-filename
(let* ((file-name (org-babel-effective-tangled-filename
(nth 1 result) src-lang src-tfile)))
(list (cons file-name (list (cons src-lang result)))))
result)))
@ -516,19 +601,13 @@ non-nil, return the full association list to be used by
"Return a list of begin and end link comments for the code block at point.
INFO, when non nil, is the source block information, as returned
by `org-babel-get-src-block-info'."
(let ((link-data (pcase (or info (org-babel-get-src-block-info 'light))
(`(,_ ,_ ,_ ,_ ,name ,start ,_)
(let ((link-data (pcase (or info (org-babel-get-src-block-info 'no-eval))
(`(,_ ,_ ,params ,_ ,name ,start ,_)
`(("start-line" . ,(org-with-point-at start
(number-to-string
(line-number-at-pos))))
("file" . ,(buffer-file-name))
("link" . ,(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))
(org-no-properties (org-store-link nil))))
("link" . ,(org-babel-tangle--unbracketed-link params))
("source-name" . ,name))))))
(list (org-fill-template org-babel-tangle-comment-format-beg link-data)
(org-fill-template org-babel-tangle-comment-format-end link-data))))

6
lisp/org/ob.el
View file

@ -4,7 +4,7 @@
;; Authors: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -22,6 +22,10 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org-macs)
(require 'org-compat)
(require 'org-keys)

122
lisp/org/oc-basic.el
View file

@ -66,6 +66,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'bibtex)
(require 'json)
(require 'map)
@ -222,6 +225,10 @@ Return a hash table with citation references as keys and fields alist as values.
(let ((entries (make-hash-table :test #'equal))
(bibtex-sort-ignore-string-entries t))
(bibtex-set-dialect dialect t)
;; Throw an error if bibliography is malformed.
(unless (bibtex-validate)
(user-error "Malformed bibliography at %S"
(or (buffer-file-name) (current-buffer))))
(bibtex-map-entries
(lambda (key &rest _)
;; Normalize entries: field names are turned into symbols
@ -237,7 +244,11 @@ Return a hash table with citation references as keys and fields alist as values.
(cons
(intern (downcase field))
(replace-regexp-in-string "[ \t\n]+" " " value)))))
(bibtex-parse-entry t))
;; Parse, substituting the @string replacements.
;; See Emacs bug#56475 discussion.
(let ((bibtex-string-files `(,(buffer-file-name)))
(bibtex-expand-strings t))
(bibtex-parse-entry t)))
entries)))
entries))
@ -266,21 +277,26 @@ Optional argument INFO is the export state, as a property list."
(when (or (org-file-has-changed-p file)
(not (gethash file org-cite-basic--file-id-cache)))
(insert-file-contents file)
(set-visited-file-name file t)
(puthash file (org-buffer-hash) org-cite-basic--file-id-cache))
(let* ((file-id (cons file (gethash file org-cite-basic--file-id-cache)))
(entries
(or (cdr (assoc file-id org-cite-basic--bibliography-cache))
(let ((table
(pcase (file-name-extension file)
("json" (org-cite-basic--parse-json))
("bib" (org-cite-basic--parse-bibtex 'biblatex))
("bibtex" (org-cite-basic--parse-bibtex 'BibTeX))
(ext
(user-error "Unknown bibliography extension: %S"
ext)))))
(push (cons file-id table) org-cite-basic--bibliography-cache)
table))))
(push (cons file entries) results)))))
(condition-case nil
(unwind-protect
(let* ((file-id (cons file (gethash file org-cite-basic--file-id-cache)))
(entries
(or (cdr (assoc file-id org-cite-basic--bibliography-cache))
(let ((table
(pcase (file-name-extension file)
("json" (org-cite-basic--parse-json))
("bib" (org-cite-basic--parse-bibtex 'biblatex))
("bibtex" (org-cite-basic--parse-bibtex 'BibTeX))
(ext
(user-error "Unknown bibliography extension: %S"
ext)))))
(push (cons file-id table) org-cite-basic--bibliography-cache)
table))))
(push (cons file entries) results))
(set-visited-file-name nil t))
(error (setq org-cite-basic--file-id-cache nil))))))
(when info (plist-put info :cite-basic/bibliography results))
results)))
@ -333,6 +349,20 @@ non-nil."
(org-export-raw-string value)
value)))
(defun org-cite-basic--shorten-names (names)
"Return a list of family names from a list of full NAMES.
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 ")
", ")))
(defun org-cite-basic--number-to-suffix (n)
"Compute suffix associated to number N.
This is used for disambiguation."
@ -349,6 +379,17 @@ This is used for disambiguation."
((= n 27) (throw :complete (cons 0 (cons 0 result))))
(t nil))))))))
(defun org-cite-basic--get-author (entry-or-key &optional info raw)
"Return author associated to ENTRY-OR-KEY.
ENTRY-OR-KEY, INFO and RAW arguments are the same arguments as
used in `org-cite-basic--get-field', which see.
Author is obtained from the \"author\" field, if available, or
from the \"editor\" field otherwise."
(or (org-cite-basic--get-field 'author entry-or-key info raw)
(org-cite-basic--get-field 'editor entry-or-key info raw)))
(defun org-cite-basic--get-year (entry-or-key info &optional no-suffix)
"Return year associated to ENTRY-OR-KEY.
@ -372,7 +413,7 @@ necessary, unless optional argument NO-SUFFIX is non-nil."
;; KEY-SUFFIX-ALIST is an association (KEY . SUFFIX), where KEY is
;; the cite key, as a string, and SUFFIX is the generated suffix
;; string, or the empty string.
(let* ((author (org-cite-basic--get-field 'author entry-or-key info 'raw))
(let* ((author (org-cite-basic--get-author entry-or-key info 'raw))
(year
(or (org-cite-basic--get-field 'year entry-or-key info 'raw)
(let ((date
@ -408,7 +449,7 @@ necessary, unless optional argument NO-SUFFIX is non-nil."
"Format ENTRY according to STYLE string.
ENTRY is an alist, as returned by `org-cite-basic--get-entry'.
Optional argument INFO is the export state, as a property list."
(let ((author (org-cite-basic--get-field 'author entry info))
(let ((author (org-cite-basic--get-author entry info))
(title (org-cite-basic--get-field 'title entry info))
(from
(or (org-cite-basic--get-field 'publisher entry info)
@ -419,7 +460,8 @@ Optional argument INFO is the export state, as a property list."
("plain"
(let ((year (org-cite-basic--get-year entry info 'no-suffix)))
(org-cite-concat
author ". " title (and from (list ", " from)) ", " year ".")))
(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)))
@ -460,13 +502,15 @@ substitutes for the unknown key. Finally, it may be the symbol
(_
(lambda ()
(interactive)
(goto-char beg)
(delete-region beg end)
(insert "@"
(if (= 1 (length suggestions))
(car suggestions)
(completing-read "Did you mean: "
suggestions nil t)))))))
(save-excursion
(goto-char beg)
(delete-region beg end)
(insert
"@"
(if (= 1 (length suggestions))
(car suggestions)
(completing-read "Did you mean: "
suggestions nil t))))))))
(put-text-property beg end 'keymap km)))
(defun org-cite-basic-activate (citation)
@ -536,7 +580,7 @@ INFO is the export state, as a property list."
(suffix (org-element-property :suffix ref)))
(funcall format-ref
prefix
(org-cite-basic--get-field 'author k info)
(org-cite-basic--get-author k info)
(org-cite-basic--get-year k info)
suffix)))
(org-cite-get-references citation)
@ -575,7 +619,7 @@ INFO is the export state as a property list."
INFO is the export state, as a property list."
(and field
(lambda (a b)
(org-string-collate-lessp
(string-collate-lessp
(org-cite-basic--get-field field a info 'raw)
(org-cite-basic--get-field field b info 'raw)
nil t))))
@ -608,7 +652,7 @@ export communication channel, as a property list."
(org-export-data
(mapconcat
(lambda (key)
(let ((author (org-cite-basic--get-field 'author key info)))
(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)
@ -669,15 +713,17 @@ 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
export state, as a property list."
(mapconcat
(lambda (k)
(let ((entry (org-cite-basic--get-entry k info)))
(org-export-data
(org-cite-make-paragraph
(and (org-export-derived-backend-p backend 'latex)
(org-export-raw-string "\\noindent\n"))
(org-cite-basic--print-entry entry style info))
info)))
(org-cite-basic--sort-keys keys info)
(lambda (entry)
(org-export-data
(org-cite-make-paragraph
(and (org-export-derived-backend-p backend 'latex)
(org-export-raw-string "\\noindent\n"))
(org-cite-basic--print-entry entry style info))
info))
(delq nil
(mapcar
(lambda (k) (org-cite-basic--get-entry k info))
(org-cite-basic--sort-keys keys info)))
"\n"))
@ -750,7 +796,7 @@ Return nil if there are no bibliography files or no entries."
(list :cite-basic/bibliography entries)))
(completion
(concat
(let ((author (org-cite-basic--get-field 'author entry nil 'raw)))
(let ((author (org-cite-basic--get-author entry nil 'raw)))
(if author
(truncate-string-to-width
(replace-regexp-in-string " and " "; " author)

229
lisp/org/oc-biblatex.el
View file

@ -41,7 +41,7 @@
;;
;; - author (a), including caps (c), full (f) and caps-full (cf) variants,
;; - locators (l), including bare (b), caps (c) and bare-caps (bc) variants,
;; - noauthor (na),
;; - noauthor (na), including bare (b) variant,
;; - nocite (n),
;; - text (t), including caps (c) variant,
;; - default style, including bare (b), caps (c) and bare-caps (bc) variants.
@ -62,12 +62,16 @@
;; #+print_bibliography: :keyword abc,xyz :title "Primary Sources"
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'map)
(require 'org-macs)
(require 'oc)
(declare-function org-element-property "org-element" (property element))
(declare-function org-export-data "org-export" (data info))
(declare-function org-export-get-next-element "org-export" (blob info &optional n))
;;; Customization
@ -82,6 +86,100 @@ If \"biblatex\" package is already required in the document, e.g., through
(const :tag "No option" nil))
:safe #'string-or-null-p)
(defcustom org-cite-biblatex-styles
'(("author" "caps" "Citeauthor*" nil nil)
("author" "full" "citeauthor" nil nil)
("author" "caps-full" "Citeauthor" nil nil)
("author" nil "citeauthor*" nil nil)
("locators" "bare" "notecite" nil nil)
("locators" "caps" "Pnotecite" nil nil)
("locators" "bare-caps" "Notecite" nil nil)
("locators" nil "pnotecite" nil nil)
("noauthor" "bare" "cite*" nil nil)
("noauthor" nil "autocite*" nil nil)
("nocite" nil "nocite" nil t)
("text" "caps" "Textcite" "Textcites" nil)
("text" nil "textcite" "textcites" nil)
(nil "bare" "cite" "cites" nil)
(nil "caps" "Autocite" "Autocites" nil)
(nil "bare-caps" "Cite" "Cites" nil)
(nil nil "autocite" "autocites" nil))
"List of styles and variants, with associated BibLaTeX commands.
Each style follows the pattern
(NAME VARIANT COMMAND MULTI-COMMAND NO-OPTION)
where:
NAME is the name of the style, as a string, or nil. The nil
style is the default style. As such, it must have an entry in
the list.
VARIANT is the name of the style variant, as a string or nil.
The nil variant is the default variant for the current style.
As such, each style name must be associated to a nil variant.
COMMAND is the LaTeX command to use, as a string. It should
not contain the leading backslash character.
MULTI-COMMAND is the LaTeX command to use when a multi-cite
command is appropriate. When nil, the style is deemed
inappropriate for multi-cites. The command should not contain
the leading backslash character.
NO-OPTION is a boolean. When non-nil, no optional argument
should be added to the LaTeX command.
Each NAME-VARIANT pair should be unique in the list.
It is also possible to provide shortcuts for style and variant
names. See `org-cite-biblatex-style-shortcuts'."
:group 'org-cite
:package-version '(Org . "9.6")
:type '(repeat
(list :tag "Style/variant combination"
;; Name part.
(choice :tag "Style"
(string :tag "Name")
(const :tag "Default style" nil))
;; Variant part.
(choice :tag "Variant"
(string :tag "Name")
(const :tag "Default variant" nil))
;; Command part.
(string :tag "Command name")
(choice :tag "Multicite command"
(string :tag "Command name")
(const :tag "No multicite support" nil))
(choice :tag "Skip optional arguments"
(const :tag "Yes" t)
(const :tag "No" nil)))))
(defcustom org-cite-biblatex-style-shortcuts
'(("a" . "author")
("b" . "bare")
("bc" . "bare-caps")
("c" . "caps")
("cf" . "caps-full")
("f" . "full")
("l" . "locators")
("n" . "nocite")
("na" . "noauthor")
("t" . "text"))
"List of shortcuts associated to style or variant names.
Each entry is a pair (NAME . STYLE-NAME) where NAME is the name
of the shortcut, as a string, and STYLE-NAME is the name of
a style in `org-cite-biblatex-styles'."
:group 'org-cite
:package-version '(Org . "9.6")
:type '(repeat
(cons :tag "Shortcut"
(string :tag "Name")
(string :tag "Full name")))
:safe t)
;;; Internal functions
(defun org-cite-biblatex--package-options (initial style)
@ -166,21 +264,51 @@ INFO is the export state, as a property list."
(org-cite-get-references citation)
""))))
(defun org-cite-biblatex--command (citation info base &optional multi no-opt)
"Return biblatex command using BASE name for CITATION object.
(defun org-cite-biblatex--command (citation info name &optional multi no-opt)
"Return BibLaTeX command NAME for CITATION object.
INFO is the export state, as a property list.
When optional argument MULTI is non-nil, generate a \"multicite\" command when
appropriate. When optional argument NO-OPT is non-nil, do not add optional
arguments to the command."
(format "\\%s%s"
base
(if (and multi (org-cite-biblatex--multicite-p citation))
(concat "s" (org-cite-biblatex--multi-arguments citation info))
When optional argument MULTI is non-nil, use it as a multicite
command name when appropriate. When optional argument NO-OPT is
non-nil, do not add optional arguments to the command."
(if (and multi (org-cite-biblatex--multicite-p citation))
(format "\\%s%s" multi (org-cite-biblatex--multi-arguments citation info))
(format "\\%s%s"
name
(org-cite-biblatex--atomic-arguments
(org-cite-get-references citation) info no-opt))))
(defun org-cite-biblatex--expand-shortcuts (style)
"Return STYLE pair with shortcuts expanded."
(pcase style
(`(,style . ,variant)
(cons (or (alist-get style org-cite-biblatex-style-shortcuts
nil nil #'equal)
style)
(or (alist-get variant org-cite-biblatex-style-shortcuts
nil nil #'equal)
variant)))
(_ (error "This should not happen"))))
(defun org-cite-biblatex-list-styles ()
"List styles and variants supported in `biblatex' citation processor.
The output format is appropriate as a value for `:cite-styles' keyword
in `org-cite-register-processor', which see."
(let ((shortcuts (make-hash-table :test #'equal))
(variants (make-hash-table :test #'equal)))
(pcase-dolist (`(,name . ,full-name) org-cite-biblatex-style-shortcuts)
(push name (gethash full-name shortcuts)))
(pcase-dolist (`(,name ,variant . ,_) org-cite-biblatex-styles)
(unless (null variant) (push variant (gethash name variants))))
(map-apply (lambda (style-name variants)
(cons (cons (or style-name "nil")
(gethash style-name shortcuts))
(mapcar (lambda (v)
(cons v (gethash v shortcuts)))
variants)))
variants)))
;;; Export capability
(defun org-cite-biblatex-export-bibliography (_keys _files _style props &rest _)
@ -210,41 +338,42 @@ PROPS is the local properties of the bibliography, as a property list."
"Export CITATION object.
STYLE is the citation style, as a pair of either strings or nil.
INFO is the export state, as a property list."
(apply
#'org-cite-biblatex--command citation info
(pcase style
;; "author" style.
(`(,(or "author" "a") . ,variant)
(pcase variant
((or "caps" "c") '("Citeauthor*"))
((or "full" "f") '("citeauthor"))
((or "caps-full" "cf") '("Citeauthor"))
(_ '("citeauthor*"))))
;; "locators" style.
(`(,(or "locators" "l") . ,variant)
(pcase variant
((or "bare" "b") '("notecite"))
((or "caps" "c") '("Pnotecite"))
((or "bare-caps" "bc") '("Notecite"))
(_ '("pnotecite"))))
;; "noauthor" style.
(`(,(or "noauthor" "na") . ,_) '("autocite*"))
;; "nocite" style.
(`(,(or "nocite" "n") . ,_) '("nocite" nil t))
;; "text" style.
(`(,(or "text" "t") . ,variant)
(pcase variant
((or "caps" "c") '("Textcite" t))
(_ '("textcite" t))))
;; Default "nil" style.
(`(,_ . ,variant)
(pcase variant
((or "bare" "b") '("cite" t))
((or "caps" "c") '("Autocite" t))
((or "bare-caps" "bc") '("Cite" t))
(_ '("autocite" t))))
;; This should not happen.
(_ (error "Invalid style: %S" style)))))
(pcase-let* ((`(,name . ,variant) (org-cite-biblatex--expand-shortcuts style))
(candidates nil)
(style-match-flag nil))
(catch :match
;; Walk `org-cite-biblatex-styles' and prioritize matching
;; candidates. At the end of the process, the optimal candidate
;; should appear in front of CANDIDATES.
(dolist (style org-cite-biblatex-styles)
(pcase style
;; A matching style-variant pair trumps anything else.
;; Return it.
(`(,(pred (equal name)) ,(pred (equal variant)) . ,_)
(throw :match (setq candidates (list style))))
;; nil-nil style-variant is the fallback value. Consider it
;; only if nothing else matches.
(`(nil nil . ,_)
(unless candidates (push style candidates)))
;; A matching style with default variant trumps a matching
;; variant without the adequate style. Ensure the former
;; appears first in the list.
(`(,(pred (equal name)) nil . ,_)
(push style candidates)
(setq style-match-flag t))
(`(nil ,(pred (equal variant)) . ,_)
(unless style-match-flag (push style candidates)))
;; Discard anything else.
(_ nil))))
(apply
#'org-cite-biblatex--command citation info
(pcase (seq-elt candidates 0) ;; `seq-first' is not available in Emacs 26.
(`(,_ ,_ . ,command-parameters) command-parameters)
('nil
(user-error
"Missing default style or variant in `org-cite-biblatex-styles'"))
(other
(user-error "Invalid entry %S in `org-cite-biblatex-styles'" other))))))
(defun org-cite-biblatex-prepare-preamble (output _keys files style &rest _)
"Prepare document preamble for \"biblatex\" usage.
@ -301,13 +430,7 @@ to the document, and set styles."
:export-bibliography #'org-cite-biblatex-export-bibliography
:export-citation #'org-cite-biblatex-export-citation
:export-finalizer #'org-cite-biblatex-prepare-preamble
:cite-styles
'((("author" "a") ("caps" "c") ("full" "f") ("caps-full" "cf"))
(("locators" "l") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
(("noauthor" "na"))
(("nocite" "n"))
(("text" "t") ("caps" "c"))
(("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))))
:cite-styles #'org-cite-biblatex-list-styles)
(provide 'oc-biblatex)
;;; oc-biblatex.el ends here

87
lisp/org/oc-bibtex.el Normal file
View file

@ -0,0 +1,87 @@
;;; oc-bibtex.el --- Vanilla citation processor for LaTeX -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; This file is part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library registers the `bibtex' citation processor, which
;; provides the "export" capability for citations. It doesn't require
;; any LaTeX package.
;;
;; It supports the following citation styles:
;;
;; - nocite (n),
;; - default.
;;
;; Only suffixes are supported. Prefixes are ignored.
;;
;; Bibliography should consist of ".bib" files only.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'oc)
(declare-function org-element-property "org-element" (property element))
(declare-function org-export-data "org-export" (data info))
;;; Export capability
(defun org-cite-bibtex-export-bibliography (_keys files style &rest _)
"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
","))))
(defun org-cite-bibtex-export-citation (citation style _ info)
"Export CITATION object.
STYLE is the citation style, as a pair of strings or nil. INFO is the export
state, as a property list."
(let ((references (org-cite-get-references citation)))
(format "\\%s%s{%s}"
(pcase style
(`(,(or "nocite" "n") . ,_) "nocite")
(_ "cite"))
(let ((suffix (cdr (org-cite-main-affixes citation))))
(if suffix
(format "[%s]" (org-trim (org-export-data suffix info)))
""))
(mapconcat (lambda (r) (org-element-property :key r))
references
","))))
;;; Register `bibtex' processor
(org-cite-register-processor 'bibtex
:export-bibliography #'org-cite-bibtex-export-bibliography
:export-citation #'org-cite-bibtex-export-citation
:cite-styles
'((("nocite" "n"))
(("nil"))))
(provide 'oc-bibtex)
;;; oc-bibtex.el ends here

198
lisp/org/oc-csl.el
View file

@ -3,6 +3,7 @@
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Maintainer: András Simonyi <andras.simonyi@gmail.com>
;; This file is part of GNU Emacs.
@ -56,11 +57,21 @@
;; The library supports the following citation styles:
;;
;; - author (a), including caps (c), full (f), and caps-full (cf) variants,
;; - author (a), including bare (b), caps (c), bare-caps (bc), full (f),
;; caps-full (cf), and bare-caps-full (bcf) variants,
;; - noauthor (na), including bare (b), caps (c) and bare-caps (bc) variants,
;; - nocite (n),
;; - year (y), including a bare (b) variant,
;; - text (t). including caps (c), full (f), and caps-full (cf) variants,
;; - text (t), including caps (c), full (f), and caps-full (cf) variants,
;; - title (ti), including a bare (b) variant,
;; - locators (l), including a bare (b) variant,
;; - bibentry (b), including a bare (b) variant,
;; - default style, including bare (b), caps (c) and bare-caps (bc) variants.
;;
;; Using "*" as a key in a nocite citation includes all available
;; items in the printed bibliography. The "bibentry" citation style,
;; similarly to biblatex's \fullcite, creates a citation which is
;; similar to the bibliography entry.
;; CSL styles recognize "locator" in citation references' suffix. For example,
;; in the citation
@ -85,11 +96,27 @@
;; The part of the suffix before the locator is appended to reference's prefix.
;; If no locator term is used, but a number is present, then "page" is assumed.
;; Filtered sub-bibliographies can be printed by passing filtering
;; options to the "print_bibliography" keywords. E.g.,
;;
;; #+print_bibliography: :type book keyword: emacs
;;
;; 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 abc,xyz :type article
;; This library was heavily inspired by and borrows from András Simonyi's
;; Citeproc Org (<https://github.com/andras-simonyi/citeproc-org>) library.
;; Many thanks to him!
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'map)
(require 'bibtex)
(require 'json)
(require 'oc)
@ -102,9 +129,11 @@
(declare-function citeproc-create "ext:citeproc")
(declare-function citeproc-citation-create "ext:citeproc")
(declare-function citeproc-append-citations "ext:citeproc")
(declare-function citeproc-add-uncited "ext:citeproc")
(declare-function citeproc-render-citations "ext:citeproc")
(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 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))
@ -133,13 +162,15 @@ If nil then only the fallback en-US locale will be available."
(defcustom org-cite-csl-styles-dir nil
"Directory of CSL style files.
When non-nil, relative style file names are expanded relatively to this
directory. This variable is ignored when style file is absolute."
Relative style file names are expanded according to document's
default directory. If it fails and the variable is non-nil, Org
looks for style files in this directory, too."
:group 'org-cite
:package-version '(Org . "9.5")
:type '(choice
(directory :tag "Styles directory")
(const :tag "Use absolute file names" nil))
(const :tag "No central directory for style files" nil))
;; It's not obvious to me that arbitrary locations are safe.
;;; :safe #'string-or-null-p
)
@ -293,6 +324,12 @@ INFO is the export state, as a property list."
(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."
(member (car (org-cite-citation-style citation info))
'("nocite" "n")))
(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
@ -302,9 +339,13 @@ a property list."
;; "author" style.
(`(,(or "author" "a") . ,variant)
(pcase variant
((or "bare" "b") '(:mode author-only :suppress-affixes t))
((or "caps" "c") '(:mode author-only :capitalize-first t))
((or "full" "f") '(:mode author-only :ignore-et-al t))
((or "bare-caps" "bc") '(:mode author-only :suppress-affixes t :capitalize-first t))
((or "bare-full" "bf") '(:mode author-only :suppress-affixes t :ignore-et-al t))
((or "caps-full" "cf") '(:mode author-only :capitalize-first t :ignore-et-al t))
((or "bare-caps-full" "bcf") '(:mode author-only :suppress-affixes t :capitalize-first t :ignore-et-al t))
(_ '(:mode author-only))))
;; "noauthor" style.
(`(,(or "noauthor" "na") . ,variant)
@ -319,6 +360,21 @@ a property list."
(pcase variant
((or "bare" "b") '(:mode year-only :suppress-affixes t))
(_ '(:mode year-only))))
;; "bibentry" style.
(`(,(or "bibentry" "b") . ,variant)
(pcase variant
((or "bare" "b") '(:mode bib-entry :suppress-affixes t))
(_ '(:mode bib-entry))))
;; "locators" style.
(`(,(or "locators" "l") . ,variant)
(pcase variant
((or "bare" "b") '(:mode locator-only :suppress-affixes t))
(_ '(:mode locator-only))))
;; "title" style.
(`(,(or "title" "ti") . ,variant)
(pcase variant
((or "bare" "b") '(:mode title-only :suppress-affixes t))
(_ '(:mode title-only))))
;; "text" style.
(`(,(or "text" "t") . ,variant)
(pcase variant
@ -365,15 +421,21 @@ corresponding to one of the output formats supported by Citeproc: `html',
INFO is the export state, as a property list.
When file name is relative, expand it according to `org-cite-csl-styles-dir',
or raise an error if the variable is unset."
When file name is relative, look for it in buffer's default
directory, failing that in `org-cite-csl-styles-dir' if non-nil.
Raise an error if no style file can be found."
(pcase (org-cite-bibliography-style info)
('nil org-cite-csl--fallback-style-file)
((and (pred file-name-absolute-p) file) file)
((and (guard org-cite-csl-styles-dir) file)
((and (pred file-exists-p) file) (expand-file-name file))
((and (guard org-cite-csl-styles-dir)
(pred (lambda (f)
(file-exists-p
(expand-file-name f org-cite-csl-styles-dir))))
file)
(expand-file-name file org-cite-csl-styles-dir))
(other
(user-error "Cannot handle relative style file name: %S" other))))
(user-error "CSL style file not found: %S" other))))
(defun org-cite-csl--locale-getter ()
"Return a locale getter.
@ -522,20 +584,91 @@ INFO is the export state, as a property list.
Return an alist (CITATION . OUTPUT) where CITATION object has been rendered as
OUTPUT using Citeproc."
(or (plist-get info :cite-citeproc-rendered-citations)
(let* ((citations (org-cite-list-citations info))
(processor (org-cite-csl--processor info))
(structures
(mapcar (lambda (c) (org-cite-csl--create-structure c info))
citations)))
(citeproc-append-citations structures processor)
(let* ((rendered
(citeproc-render-citations
processor
(org-cite-csl--output-format info)
(org-cite-csl--no-citelinks-p info)))
(result (seq-mapn #'cons citations rendered)))
(plist-put info :cite-citeproc-rendered-citations result)
result))))
(let ((citations (org-cite-list-citations info))
(processor (org-cite-csl--processor info))
normal-citations nocite-ids)
(dolist (citation citations)
(if (org-cite-csl--nocite-p citation info)
(setq nocite-ids (append (org-cite-get-references citation t) nocite-ids))
(push citation normal-citations)))
(let ((structures
(mapcar (lambda (c) (org-cite-csl--create-structure c info))
(nreverse normal-citations))))
(citeproc-append-citations structures processor))
(when nocite-ids
(citeproc-add-uncited nocite-ids processor))
;; All bibliographies have to be rendered in order to have
;; correct citation numbers even if there are several
;; sub-bibliograhies.
(org-cite-csl--rendered-bibliographies info)
(let (result
(rendered (citeproc-render-citations
processor
(org-cite-csl--output-format info)
(org-cite-csl--no-citelinks-p info))))
(dolist (citation citations)
(push (cons citation
(if (org-cite-csl--nocite-p citation info) "" (pop rendered)))
result))
(setq result (nreverse result))
(plist-put info :cite-citeproc-rendered-citations result)
result))))
(defun org-cite-csl--bibliography-filter (bib-props)
"Return the sub-bibliography filter corresponding to bibliography properties.
BIB-PROPS should be a plist representing the properties
associated with a \"print_bibliography\" keyword, as returned by
`org-cite-bibliography-properties'."
(let (result
(remove-keyword-colon (lambda (x) (intern (substring (symbol-name x) 1)))))
(map-do
(lambda (key value)
(pcase key
((or :keyword :notkeyword :nottype :notcsltype :filter)
(dolist (v (split-string value ","))
(push (cons (funcall remove-keyword-colon key) v) result)))
((or :type :csltype)
(if (string-match-p "," value)
(user-error "The \"%s\" print_bibliography option does not support comma-separated values" key)
(push (cons (funcall remove-keyword-colon key) value) result)))))
bib-props)
result))
(defun org-cite-csl--rendered-bibliographies (info)
"Return the rendered bibliographies.
INFO is the export state, as a property list.
Return an (OUTPUTS PARAMETERS) list where OUTPUTS is an alist
of (BIB-PROPS . OUTPUT) pairs where each key is a property list
of a \"print_bibliography\" keyword and the corresponding OUTPUT
value is the bibliography as rendered by Citeproc."
(or (plist-get info :cite-citeproc-rendered-bibliographies)
(let (bib-plists bib-filters)
;; Collect bibliography property lists and the corresponding
;; Citeproc sub-bib filters.
(org-element-map (plist-get info :parse-tree) 'keyword
(lambda (keyword)
(when (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key keyword))
(let ((bib-plist (org-cite-bibliography-properties keyword)))
(push bib-plist bib-plists)
(push (org-cite-csl--bibliography-filter bib-plist) bib-filters)))))
(setq bib-filters (nreverse bib-filters)
bib-plists (nreverse bib-plists))
;; Render and return all bibliographies.
(let ((processor (org-cite-csl--processor info)))
(citeproc-add-subbib-filters bib-filters processor)
(pcase-let* ((format (org-cite-csl--output-format info))
(`(,rendered-bibs . ,parameters)
(citeproc-render-bib
(org-cite-csl--processor info)
format
(org-cite-csl--no-citelinks-p info)))
(outputs (cl-mapcar #'cons bib-plists rendered-bibs))
(result (list outputs parameters)))
(plist-put info :cite-citeproc-rendered-bibliographies result)
result)))))
;;; Export capability
@ -550,16 +683,13 @@ INFO is the export state, as a property list."
;; process.
(org-cite-parse-objects output))))
(defun org-cite-csl-render-bibliography (_keys _files _style _props _backend info)
(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)
(pcase-let* ((format (org-cite-csl--output-format info))
(`(,output . ,parameters)
(citeproc-render-bib
(org-cite-csl--processor info)
format
(org-cite-csl--no-citelinks-p info))))
(pcase-let* ((format (org-cite-csl--output-format info))
(`(,outputs ,parameters) (org-cite-csl--rendered-bibliographies info))
(output (cdr (assoc props outputs))))
(pcase format
('html
(concat
@ -621,11 +751,15 @@ property list."
:export-bibliography #'org-cite-csl-render-bibliography
:export-finalizer #'org-cite-csl-finalizer
:cite-styles
'((("author" "a") ("full" "f") ("caps" "c") ("caps-full" "cf"))
'((("author" "a") ("bare" "b") ("caps" "c") ("full" "f") ("bare-caps" "bc") ("caps-full" "cf") ("bare-caps-full" "bcf"))
(("noauthor" "na") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
(("year" "y") ("bare" "b"))
(("text" "t") ("caps" "c") ("full" "f") ("caps-full" "cf"))
(("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))))
(("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
(("nocite" "n"))
(("title" "ti") ("bare" "b"))
(("bibentry" "b") ("bare" "b"))
(("locators" "l") ("bare" "b"))))
(provide 'oc-csl)
;;; oc-csl.el ends here

4
lisp/org/oc-natbib.el
View file

@ -42,6 +42,10 @@
;; Bibliography accepts any style supported by "natbib" package.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'oc)
(declare-function org-element-property "org-element" (property element))

193
lisp/org/oc.el
View file

@ -61,6 +61,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org-compat)
(require 'org-macs)
(require 'seq)
@ -323,12 +326,6 @@ place note numbers according to rules defined in `org-cite-note-rules'."
See `org-cite-register-processor' for more information about
processors.")
(defun org-cite--get-processor (name)
"Return citation processor named after symbol NAME.
Return nil if no such processor is found."
(seq-find (lambda (p) (eq name (org-cite-processor-name p)))
org-cite--processors))
(defun org-cite-register-processor (name &rest body)
"Mark citation processor NAME as available.
@ -415,14 +412,30 @@ optional keys can be set:
The \"nil\" style denotes the processor fall-back style. It
should have a corresponding entry in the value.
The value can also be a function. It will be called without
any argument and should return a list structured as the above.
Return a non-nil value on a successful operation."
(declare (indent 1))
(unless (and name (symbolp name))
(error "Invalid processor name: %S" name))
(when (org-cite--get-processor name)
(org-cite-unregister-processor name))
(push (apply #'org-cite--make-processor :name name body)
org-cite--processors))
(setq org-cite--processors
(cons (apply #'org-cite--make-processor :name name body)
(seq-remove (lambda (p) (eq name (org-cite-processor-name p)))
org-cite--processors))))
(defun org-cite-try-load-processor (name)
"Try loading citation processor NAME if unavailable.
NAME is a symbol. When the NAME processor is unregistered, try
loading \"oc-NAME\" library beforehand, then cross fingers."
(unless (org-cite-get-processor name)
(require (intern (format "oc-%s" name)) nil t)))
(defun org-cite-get-processor (name)
"Return citation processor named after symbol NAME.
Return nil if no such processor is found."
(seq-find (lambda (p) (eq name (org-cite-processor-name p)))
org-cite--processors))
(defun org-cite-unregister-processor (name)
"Unregister citation processor NAME.
@ -430,7 +443,7 @@ NAME is a symbol. Raise an error if processor is not registered.
Return a non-nil value on a successful operation."
(unless (and name (symbolp name))
(error "Invalid processor name: %S" name))
(pcase (org-cite--get-processor name)
(pcase (org-cite-get-processor name)
('nil (error "Processor %S not registered" name))
(processor
(setq org-cite--processors (delete processor org-cite--processors))))
@ -440,7 +453,7 @@ Return a non-nil value on a successful operation."
"Return non-nil if PROCESSOR is able to handle CAPABILITY.
PROCESSOR is the name of a cite processor, as a symbol. CAPABILITY is
`activate', `export', `follow', or `insert'."
(let ((p (org-cite--get-processor processor)))
(let ((p (org-cite-get-processor processor)))
(pcase capability
((guard (not p)) nil) ;undefined processor
('activate (functionp (org-cite-processor-activate p)))
@ -673,7 +686,10 @@ strings."
(let ((collection
(seq-mapcat
(lambda (name)
(org-cite-processor-cite-styles (org-cite--get-processor name)))
(pcase (org-cite-processor-cite-styles
(org-cite-get-processor name))
((and (pred functionp) f) (funcall f))
(static-data static-data)))
(or processors
(mapcar (pcase-lambda (`(,_ . (,name . ,_))) name)
org-cite-export-processors))))
@ -789,6 +805,39 @@ INFO is a plist used as a communication channel."
(cons (org-not-nil (car global))
(or (cdr local) (cdr global)))))))
(defun org-cite-read-processor-declaration (s)
"Read processor declaration from string S.
Return (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) triplet, when
NAME is the processor name, as a symbol, and both
BIBLIOGRAPHY-STYLE and CITATION-STYLE are strings or nil. Those
strings may contain spaces if they are enclosed within double
quotes.
String S is expected to contain between 1 and 3 tokens. The
function raises an error when it contains too few or too many
tokens. Spurious spaces are ignored."
(with-temp-buffer
(save-excursion (insert s))
(let ((result (list (read (current-buffer)))))
(dotimes (_ 2)
(skip-chars-forward " \t")
(cond
((eobp) (push nil result))
((char-equal ?\" (char-after))
(push (org-not-nil (read (current-buffer)))
result))
(t
(let ((origin (point)))
(skip-chars-forward "^ \t")
(push (org-not-nil (buffer-substring origin (point)))
result)))))
(skip-chars-forward " \t")
(unless (eobp)
(error "Trailing garbage following cite export processor declaration %S"
s))
(nreverse result))))
(defun org-cite-bibliography-style (info)
"Return expected bibliography style.
INFO is a plist used as a communication channel."
@ -1177,7 +1226,7 @@ from the processor set in `org-cite-activate-processor'."
(activate
(or (and name
(org-cite-processor-has-capability-p name 'activate)
(org-cite-processor-activate (org-cite--get-processor name)))
(org-cite-processor-activate (org-cite-get-processor name)))
#'org-cite-fontify-default)))
(when (re-search-forward org-element-citation-prefix-re limit t)
(let ((cite (org-with-point-at (match-beginning 0)
@ -1204,40 +1253,22 @@ INFO is the communication channel, as a plist. It is modified by side-effect."
Export processor is stored as a triplet, or nil.
When non-nil, it is defined as (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) where
NAME is a symbol, whereas BIBLIOGRAPHY-STYLE and CITATION-STYLE are strings,
or nil.
When non-nil, it is defined as (NAME BIBLIOGRAPHY-STYLE
CITATION-STYLE) where NAME is a symbol, whereas
BIBLIOGRAPHY-STYLE and CITATION-STYLE are strings, or nil.
INFO is the communication channel, as a plist. It is modified by side-effect."
INFO is the communication channel, as a plist. It is modified by
side-effect."
(let* ((err
(lambda (s)
(user-error "Invalid cite export processor definition: %S" s)))
(user-error "Invalid cite export processor declaration: %S" s)))
(processor
(pcase (plist-get info :cite-export)
((or "" `nil) nil)
;; Value is a string. It comes from a "cite_export"
;; keyword. It may contain between 1 and 3 tokens, the
;; first one being a symbol and the other (optional) two,
;; strings.
;; keyword.
((and (pred stringp) s)
(with-temp-buffer
(save-excursion (insert s))
(let ((result (list (read (current-buffer)))))
(dotimes (_ 2)
(skip-chars-forward " \t")
(cond
((eobp) (push nil result))
((char-equal ?\" (char-after))
(condition-case _
(push (org-not-nil (read (current-buffer))) result)
(error (funcall err s))))
(t
(let ((origin (point)))
(skip-chars-forward "^ \t")
(push (org-not-nil (buffer-substring origin (point)))
result)))))
(unless (eobp) (funcall err s))
(nreverse result))))
(org-cite-read-processor-declaration s))
;; Value is an alist. It must come from
;; `org-cite-export-processors' variable. Find the most
;; appropriate processor according to current export
@ -1274,8 +1305,9 @@ INFO is the communication channel, as a plist. It is modified by side-effect."
(pcase processor
('nil nil)
(`(,name . ,_)
(org-cite-try-load-processor name)
(cond
((not (org-cite--get-processor name))
((not (org-cite-get-processor name))
(user-error "Unknown processor %S" name))
((not (org-cite-processor-has-capability-p name 'export))
(user-error "Processor %S is unable to handle citation export" name)))))
@ -1288,7 +1320,7 @@ selected citation processor."
(pcase (plist-get info :cite-export)
('nil nil)
(`(,p ,_ ,_)
(funcall (org-cite-processor-export-citation (org-cite--get-processor p))
(funcall (org-cite-processor-export-citation (org-cite-get-processor p))
citation
(org-cite-citation-style citation info)
(plist-get info :back-end)
@ -1304,7 +1336,7 @@ used as a communication channel."
(`(,p ,_ ,_)
(let ((export-bibilography
(org-cite-processor-export-bibliography
(org-cite--get-processor p))))
(org-cite-get-processor p))))
(when export-bibilography
(funcall export-bibilography
(org-cite-list-keys info)
@ -1405,7 +1437,7 @@ channel, as a property list."
('nil output)
(`(,p ,_ ,_)
(let ((finalizer
(org-cite-processor-export-finalizer (org-cite--get-processor p))))
(org-cite-processor-export-finalizer (org-cite-get-processor p))))
(if (not finalizer)
output
(funcall finalizer
@ -1423,16 +1455,17 @@ channel, as a property list."
"Follow citation or citation-reference DATUM.
Following is done according to the processor set in `org-cite-follow-processor'.
ARG is the prefix argument received when calling `org-open-at-point', or nil."
(unless org-cite-follow-processor
(user-error "No processor set to follow citations"))
(org-cite-try-load-processor org-cite-follow-processor)
(let ((name org-cite-follow-processor))
(cond
((null name)
(user-error "No processor set to follow citations"))
((not (org-cite--get-processor name))
((not (org-cite-get-processor name))
(user-error "Unknown processor %S" name))
((not (org-cite-processor-has-capability-p name 'follow))
(user-error "Processor %S cannot follow citations" name))
(t
(let ((follow (org-cite-processor-follow (org-cite--get-processor name))))
(let ((follow (org-cite-processor-follow (org-cite-get-processor name))))
(funcall follow datum arg))))))
@ -1474,8 +1507,15 @@ CONTEXT is the element or object at point, as returned by `org-element-context'.
(not (looking-at-p "\\*+ END[ \t]*$")))
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))))
(match-beginning 4)
(>= (point) (match-beginning 4))
(>= (point) (or
;; Real heading.
(match-beginning 4)
;; If no heading, end of priority.
(match-end 3)
;; ... end of todo keyword.
(match-end 2)
;; ... after stars.
(1+ (match-end 1))))
(or (not (match-beginning 5))
(< (point) (match-beginning 5))))))
;; White spaces after an object or blank lines after an element
@ -1492,7 +1532,7 @@ CONTEXT is the element or object at point, as returned by `org-element-context'.
;; unaffected.
((eq type 'item)
(> (point) (+ (org-element-property :begin context)
(current-indentation)
(org-current-text-indentation)
(if (org-element-property :checkbox context)
5 1))))
;; Other elements are invalid.
@ -1537,38 +1577,42 @@ Citation keys are strings without the leading \"@\"."
(defun org-cite-make-insert-processor (select-key select-style)
"Build a function appropriate as an insert processor.
SELECT-KEY is a function called with one argument. When it is nil, the function
should return a citation key as a string, or nil. Otherwise, the function
should return a list of such keys, or nil. The keys should not have any leading
\"@\" character.
SELECT-KEY is a function called with one argument. When it is
nil, the function should return a citation key as a string, or
nil. Otherwise, the function should return a list of such keys,
or nil. The keys should not have any leading \"@\" character.
SELECT-STYLE is a function called with one argument, the citation object being
edited or constructed so far. It should return a style string, or nil.
SELECT-STYLE is a function called with one argument, the citation
object being edited or constructed so far. It should return
a style string, or nil.
The return value is a function of two arguments: CONTEXT and ARG. CONTEXT is
either a citation reference, a citation object, or nil. ARG is a prefix
argument.
The return value is a function of two arguments: CONTEXT and ARG.
CONTEXT is either a citation reference, a citation object, or
nil. ARG is a prefix argument.
The generated function inserts or edit a citation at point. More specifically,
The generated function inserts or edits a citation at point.
More specifically,
On a citation reference:
- on the prefix or right before the \"@\" character, insert a new reference
before the current one,
- on the prefix or right before the \"@\" character, insert
a new reference before the current one,
- on the suffix, insert it after the reference,
- otherwise, update the cite key, preserving both affixes.
When ARG is non-nil, remove the reference, possibly removing the whole
citation if it contains a single reference.
When ARG is non-nil, remove the reference, possibly removing
the whole citation if it contains a single reference.
On a citation object:
- on the style part, offer to update it,
- on the global prefix, add a new reference before the first one,
- on the global suffix, add a new reference after the last one,
- on the global prefix, add a new reference before the first
one,
- on the global suffix, add a new reference after the last
one.
Elsewhere, insert a citation at point. When ARG is non-nil, offer to complete
style in addition to references."
Elsewhere, insert a citation at point. When ARG is non-nil,
offer to complete style in addition to references."
(unless (and (functionp select-key) (functionp select-style))
(error "Wrong argument type(s)"))
(lambda (context arg)
@ -1589,7 +1633,7 @@ The generated function inserts or edit a citation at point. More specifically,
(if (>= style-end (point))
;; On style part, edit the style.
(let ((style-start (+ 5 begin))
(style (funcall select-style)))
(style (funcall select-style context)))
(unless style (user-error "Aborted"))
(org-with-point-at style-start
(delete-region style-start style-end)
@ -1640,17 +1684,18 @@ The generated function inserts or edit a citation at point. More specifically,
Insertion is done according to the processor set in `org-cite-insert-processor'.
ARG is the prefix argument received when calling interactively the function."
(interactive "P")
(unless org-cite-insert-processor
(user-error "No processor set to insert citations"))
(org-cite-try-load-processor org-cite-insert-processor)
(let ((name org-cite-insert-processor))
(cond
((null name)
(user-error "No processor set to insert citations"))
((not (org-cite--get-processor name))
((not (org-cite-get-processor name))
(user-error "Unknown processor %S" name))
((not (org-cite-processor-has-capability-p name 'insert))
(user-error "Processor %S cannot insert citations" name))
(t
(let ((context (org-element-context))
(insert (org-cite-processor-insert (org-cite--get-processor name))))
(insert (org-cite-processor-insert (org-cite-get-processor name))))
(cond
((memq (org-element-type context) '(citation citation-reference))
(funcall insert context arg))

7
lisp/org/ol-bbdb.el
View file

@ -5,7 +5,7 @@
;; Authors: Carsten Dominik <carsten.dominik@gmail.com>
;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -93,6 +93,9 @@
;;
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'org-compat)
(require 'org-macs)
@ -132,7 +135,7 @@
(defgroup org-bbdb-anniversaries nil
"Customizations for including anniversaries from BBDB into Agenda."
:group 'org-bbdb)
:group 'org-agenda)
(defcustom org-bbdb-default-anniversary-format "birthday"
"Default anniversary class."

70
lisp/org/ol-bibtex.el
View file

@ -107,6 +107,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'bibtex)
(require 'cl-lib)
(require 'org-compat)
@ -133,9 +136,10 @@
(declare-function org-heading-components "org" ())
(declare-function org-insert-heading "org" (&optional arg invisible-ok top))
(declare-function org-map-entries "org" (func &optional match scope &rest skip))
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-narrow-to-subtree "org" (&optional element))
(declare-function org-set-property "org" (property value))
(declare-function org-toggle-tag "org" (tag &optional onoff))
(declare-function org-indent-region "org" (start end))
(declare-function org-search-view "org-agenda" (&optional todo-only string edit-at))
@ -232,6 +236,11 @@
(defvar org-bibtex-entries nil
"List to hold parsed bibtex entries.")
(defgroup org-bibtex nil
"Options for translating between Org headlines and BibTeX entries."
:tag "Org BibTeX"
:group 'org)
(defcustom org-bibtex-autogen-keys nil
"Set to a truth value to use `bibtex-generate-autokey' to generate keys."
:group 'org-bibtex
@ -344,14 +353,20 @@ and `org-tags-exclude-from-inheritance'."
(upcase property)))))))
(when it (org-trim it))))
(defun org-bibtex-put (property value)
(let ((prop (upcase (if (keywordp property)
(substring (symbol-name property) 1)
property))))
(org-set-property
(concat (unless (string= org-bibtex-key-property prop) org-bibtex-prefix)
prop)
value)))
(defun org-bibtex-put (property value &optional insert-raw)
"Set PROPERTY of headline at point to VALUE.
The PROPERTY will be prefixed with `org-bibtex-prefix' when necessary.
With non-nil optional argument INSERT-RAW, insert node property string
at point."
(let* ((prop (upcase (if (keywordp property)
(substring (symbol-name property) 1)
property)))
(prop (concat (unless (string= org-bibtex-key-property prop)
org-bibtex-prefix)
prop)))
(if insert-raw
(insert (format ":%s: %s\n" prop value))
(org-set-property prop value))))
(defun org-bibtex-headline ()
"Return a bibtex entry of the given headline as a string."
@ -703,10 +718,12 @@ Return the number of saved entries."
(interactive "fFile: ")
(org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile)))
(defun org-bibtex-write ()
"Insert a heading built from the first element of `org-bibtex-entries'."
(defun org-bibtex-write (&optional noindent)
"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."
(interactive)
(when (= (length org-bibtex-entries) 0)
(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'
@ -714,14 +731,16 @@ Return the number of saved entries."
(togtag (lambda (tag) (org-toggle-tag tag 'on))))
(org-insert-heading)
(insert (funcall org-bibtex-headline-format-function entry))
(org-bibtex-put "TITLE" (funcall val :title))
(insert "\n:PROPERTIES:\n")
(org-bibtex-put "TITLE" (funcall val :title) 'insert)
(org-bibtex-put org-bibtex-type-property-name
(downcase (funcall val :type)))
(downcase (funcall val :type))
'insert)
(dolist (pair entry)
(pcase (car pair)
(:title nil)
(:type nil)
(:key (org-bibtex-put org-bibtex-key-property (cdr pair)))
(:key (org-bibtex-put org-bibtex-key-property (cdr pair) 'insert))
(:keywords (if org-bibtex-tags-are-keywords
(dolist (kw (split-string (cdr pair) ", *"))
(funcall
@ -729,9 +748,14 @@ Return the number of saved entries."
(replace-regexp-in-string
"[^[:alnum:]_@#%]" ""
(replace-regexp-in-string "[ \t]+" "_" kw))))
(org-bibtex-put (car pair) (cdr pair))))
(_ (org-bibtex-put (car pair) (cdr pair)))))
(mapc togtag org-bibtex-tags)))
(org-bibtex-put (car pair) (cdr pair) 'insert)))
(_ (org-bibtex-put (car pair) (cdr pair) 'insert))))
(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."
@ -745,10 +769,12 @@ Return the number of saved entries."
(defun org-bibtex-import-from-file (file)
"Read bibtex entries from FILE and insert as Org headlines after point."
(interactive "fFile: ")
(dotimes (_ (org-bibtex-read-file file))
(save-excursion (org-bibtex-write))
(re-search-forward org-property-end-re)
(open-line 1) (forward-char 1)))
(let ((pos (point)))
(dotimes (_ (org-bibtex-read-file file))
(save-excursion (org-bibtex-write 'noindent))
(re-search-forward org-property-end-re)
(insert "\n"))
(org-indent-region pos (point))))
(defun org-bibtex-export-to-kill-ring ()
"Export current headline to kill ring as bibtex entry."

8
lisp/org/ol-docview.el
View file

@ -4,7 +4,7 @@
;; Author: Jan Böcker <jan.boecker at jboecker dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -42,6 +42,8 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'doc-view)
(require 'ol)
@ -75,7 +77,9 @@
(string-to-number (match-string 2 link)))))
;; Let Org mode open the file (in-emacs = 1) to ensure
;; org-link-frame-setup is respected.
(org-open-file path 1)
(if (file-exists-p path)
(org-open-file path 1)
(error "No such file: %s" path))
(when page (doc-view-goto-page page))))
(defun org-docview-store-link ()

3
lisp/org/ol-doi.el
View file

@ -26,6 +26,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ol)
(defcustom org-link-doi-server-url "https://doi.org/"

9
lisp/org/ol-eshell.el
View file

@ -23,6 +23,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'eshell)
(require 'esh-mode)
(require 'ol)
@ -46,7 +49,11 @@ followed by a colon."
(eshell-buffer-name (car buffer-and-command))
(command (cadr buffer-and-command)))
(if (get-buffer eshell-buffer-name)
(pop-to-buffer eshell-buffer-name display-comint-buffer-action)
(pop-to-buffer
eshell-buffer-name
(if (boundp 'display-comint-buffer-action) ; Emacs >= 29
display-comint-buffer-action
'(display-buffer-same-window (inhibit-same-window))))
(eshell))
(goto-char (point-max))
(eshell-kill-input)

20
lisp/org/ol-eww.el
View file

@ -4,7 +4,7 @@
;; Author: Marco Wahl <marcowahlsoft>a<gmailcom>
;; Keywords: link, eww
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -44,14 +44,14 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ol)
(require 'cl-lib)
(require 'eww)
;; For Emacsen < 25.
(defvar eww-current-title)
(defvar eww-current-url)
;; Store Org link in Eww mode buffer
(org-link-set-parameters "eww"
@ -67,14 +67,10 @@
(when (eq major-mode 'eww-mode)
(org-link-store-props
:type "eww"
:link (if (< emacs-major-version 25)
eww-current-url
(eww-current-url))
:link (eww-current-url)
:url (url-view-url t)
:description (if (< emacs-major-version 25)
(or eww-current-title eww-current-url)
(or (plist-get eww-data :title)
(eww-current-url))))))
:description (or (plist-get eww-data :title)
(eww-current-url)))))
;; Some auxiliary functions concerning links in Eww buffers

7
lisp/org/ol-gnus.el
View file

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Tassilo Horn <tassilo at member dot fsf dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -31,6 +31,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'gnus-sum)
(require 'gnus-util)
(require 'nnheader)
@ -71,7 +74,7 @@ negates this setting for the duration of the command."
(defcustom org-gnus-no-server nil
"Should Gnus be started using `gnus-no-server'?"
:group 'org-gnus
:group 'org-link-follow
:version "24.4"
:package-version '(Org . "8.0")
:type 'boolean)

86
lisp/org/ol-info.el
View file

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -30,6 +30,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ol)
;; Declare external functions and variables
@ -43,7 +46,8 @@
(org-link-set-parameters "info"
:follow #'org-info-open
:export #'org-info-export
:store #'org-info-store-link)
:store #'org-info-store-link
:insert-description #'org-info-description-as-command)
;; Implementation
(defun org-info-store-link ()
@ -63,24 +67,65 @@
"Follow an Info file and node link specified by PATH."
(org-info-follow-link path))
(defun org-info--link-file-node (path)
"Extract file name and node from info link PATH.
Return cons consisting of file name and node name or \"Top\" if node
part is not specified. Components may be separated by \":\" or by \"#\".
File may be a virtual one, see `Info-virtual-files'."
(if (not path)
'("dir" . "Top")
(string-match "\\`\\([^#:]*\\)\\(?:[#:]:?\\(.*\\)\\)?\\'" path)
(let* ((node (match-string 2 path))
;; Do not reorder, `org-trim' modifies match.
(file (org-trim (match-string 1 path))))
(cons
(if (org-string-nw-p file) file "dir")
(if (org-string-nw-p node) (org-trim node) "Top")))))
(defun org-info-description-as-command (link desc)
"Info link description that can be pasted as command.
For the following LINK
\"info:elisp#Non-ASCII in Strings\"
the result is
info \"(elisp) Non-ASCII in Strings\"
that may be executed as shell command or evaluated by
\\[eval-expression] (wrapped with parenthesis) to read the manual
in Emacs.
Calling convention is similar to `org-link-make-description-function'.
DESC has higher priority and returned when it is not nil or empty string.
If LINK is not an info link then DESC is returned."
(let* ((prefix "info:")
(need-file-node (and (not (org-string-nw-p desc))
(string-prefix-p prefix link))))
(pcase (and need-file-node
(org-info--link-file-node (org-unbracket-string prefix "" link)))
;; Unlike (info "dir"), "info dir" shell command opens "(coreutils)dir invocation".
(`("dir" . "Top") "info \"(dir)\"")
(`(,file . "Top") (format "info %s" file))
(`(,file . ,node) (format "info \"(%s) %s\"" file node))
(_ desc))))
(defun org-info-follow-link (name)
"Follow an Info file and node link specified by NAME."
(if (or (string-match "\\(.*\\)\\(?:#\\|::\\)\\(.*\\)" name)
(string-match "\\(.*\\)" name))
(let ((filename (match-string 1 name))
(nodename-or-index (or (match-string 2 name) "Top")))
(require 'info)
;; If nodename-or-index is invalid node name, then look it up
;; in the index.
(condition-case nil
(Info-find-node filename nodename-or-index)
(user-error (Info-find-node filename "Top")
(condition-case nil
(Info-index nodename-or-index)
(user-error "Could not find '%s' node or index entry"
nodename-or-index)))))
(user-error "Could not open: %s" name)))
(pcase-let ((`(,filename . ,nodename-or-index)
(org-info--link-file-node name)))
(require 'info)
;; If nodename-or-index is invalid node name, then look it up
;; in the index.
(condition-case nil
(Info-find-node filename nodename-or-index)
(user-error (Info-find-node filename "Top")
(condition-case nil
(Info-index nodename-or-index)
(user-error "Could not find '%s' node or index entry"
nodename-or-index))))))
(defconst org-info-emacs-documents
'("ada-mode" "auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x"
@ -95,7 +140,8 @@
Taken from <https://www.gnu.org/software/emacs/manual/html_mono/.>")
(defconst org-info-other-documents
'(("libc" . "https://www.gnu.org/software/libc/manual/html_mono/libc.html")
'(("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
@ -129,9 +175,7 @@ See `org-info-emacs-documents' and `org-info-other-documents' for details."
(defun org-info-export (path desc format)
"Export an info link.
See `org-link-parameters' for details about PATH, DESC and FORMAT."
(let* ((parts (split-string path "#\\|::"))
(manual (car parts))
(node (or (nth 1 parts) "Top")))
(pcase-let ((`(,manual . ,node) (org-info--link-file-node path)))
(pcase format
(`html
(format "<a href=\"%s#%s\">%s</a>"

3
lisp/org/ol-irc.el
View file

@ -48,6 +48,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ol)
(declare-function erc-buffer-filter "erc" (predicate &optional proc))

25
lisp/org/ol-man.el
View file

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Maintainer: Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -24,6 +24,9 @@
;;
;;; Commentary:
(require 'org-macs)
(org-assert-version)
(require 'ol)
(org-link-set-parameters "man"
@ -43,12 +46,22 @@ If PATH contains extra ::STRING which will use `occur' to search
matched strings in man buffer."
(string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path)
(let* ((command (match-string 1 path))
(search (match-string 2 path)))
(funcall org-man-command command)
(search (match-string 2 path))
(buffer (funcall org-man-command command)))
(when search
(with-current-buffer (concat "*Man " command "*")
(goto-char (point-min))
(search-forward search)))))
(with-current-buffer buffer
(goto-char (point-min))
(unless (search-forward search nil t)
(let ((process (get-buffer-process buffer)))
(while (process-live-p process)
(accept-process-output process)))
(goto-char (point-min))
(search-forward search))
(forward-line -1)
(let ((point (point)))
(let ((window (get-buffer-window buffer)))
(set-window-point window point)
(set-window-start window point)))))))
(defun org-man-store-link ()
"Store a link to a README file."

5
lisp/org/ol-mhe.el
View file

@ -4,7 +4,7 @@
;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -30,6 +30,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org-macs)
(require 'ol)

5
lisp/org/ol-rmail.el
View file

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -30,6 +30,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ol)
;; Declare external functions and variables

5
lisp/org/ol-w3m.el
View file

@ -4,7 +4,7 @@
;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
@ -41,6 +41,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ol)
(defvar w3m-current-url)

222
lisp/org/ol.el
View file

@ -27,8 +27,12 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org-compat)
(require 'org-macs)
(require 'org-fold)
(defvar clean-buffer-list-kill-buffer-names)
(defvar org-agenda-buffer-name)
@ -38,7 +42,6 @@
(defvar org-inhibit-startup)
(defvar org-outline-regexp-bol)
(defvar org-src-source-file-name)
(defvar org-time-stamp-formats)
(defvar org-ts-regexp)
(declare-function calendar-cursor-to-date "calendar" (&optional error event))
@ -47,7 +50,7 @@
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-do-occur "org" (regexp &optional cleanup))
(declare-function org-element-at-point "org-element" ())
(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-context "org-element" (&optional element))
(declare-function org-element-lineage "org-element" (datum &optional types with-self))
@ -66,10 +69,10 @@
(declare-function org-mode "org" ())
(declare-function org-occur "org" (regexp &optional keep-previous callback))
(declare-function org-open-file "org" (path &optional in-emacs line search))
(declare-function org-overview "org" ())
(declare-function org-cycle-overview "org-cycle" ())
(declare-function org-restart-font-lock "org" ())
(declare-function org-run-like-in-org-mode "org" (cmd))
(declare-function org-show-context "org" (&optional key))
(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-src-edit-buffer-p "org-src" (&optional buffer))
@ -140,6 +143,19 @@ link.
Function that inserts a link with completion. The function
takes one optional prefix argument.
`:insert-description'
String or function used as a default when prompting users for a
link's description. A string is used as-is, a function is
called with two arguments: the link location (a string such as
\"~/foobar\", \"id:some-org-id\" or \"https://www.foo.com\")
and the description generated by `org-insert-link'. It should
return the description to use (this reflects the behaviour of
`org-link-make-description-function'). If it returns nil, no
default description is used, but no error is thrown (from the
user's perspective, this is equivalent to a default description
of \"\").
`:display'
Value for `invisible' text property on the hidden parts of the
@ -199,7 +215,9 @@ You can interactively set the value of this variable by calling
This function must take two parameters: the first one is the
link, the second one is the description generated by
`org-insert-link'. The function should return the description to
use."
use. If it returns nil, no default description is used, but no
error is thrown (from the user’s perspective, this is equivalent
to a default description of \"\")."
:group 'org-link
:type '(choice (const nil) (function))
:safe #'null)
@ -604,6 +622,22 @@ 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
@ -700,7 +734,7 @@ followed by another \"%[A-F0-9]{2}\" group."
(make-indirect-buffer (current-buffer)
indirect-buffer-name
'clone))))
(with-current-buffer indirect-buffer (org-overview))
(with-current-buffer indirect-buffer (org-cycle-overview))
indirect-buffer))))
(defun org-link--search-radio-target (target)
@ -718,7 +752,7 @@ White spaces are not significant."
(let ((object (org-element-context)))
(when (eq (org-element-type object) 'radio-target)
(goto-char (org-element-property :begin object))
(org-show-context 'link-search)
(org-fold-show-context 'link-search)
(throw :radio-match nil))))
(goto-char origin)
(user-error "No match for radio target: %s" target))))
@ -761,6 +795,13 @@ syntax around the string."
(t nil))))
string))
(defun org-link--reveal-maybe (region _)
"Reveal folded link in REGION when needed.
This function is intended to be used as :fragile property of a folding
spec."
(org-with-point-at (car region)
(not (org-in-regexp org-link-any-re))))
;;; Public API
@ -975,7 +1016,9 @@ LINK is escaped with backslashes for inclusion in buffer."
(replace-regexp-in-string "]\\'"
(concat "\\&" zero-width-space)
(org-trim description))))))
(if (not (org-string-nw-p link)) description
(if (not (org-string-nw-p link))
(or description
(error "Empty link"))
(format "[[%s]%s]"
(org-link-escape link)
(if description (format "[%s]" description) "")))))
@ -1257,7 +1300,7 @@ of matched result, which is either `dedicated' or `fuzzy'."
(error "No match for fuzzy expression: %s" normalized)))
;; Disclose surroundings of match, if appropriate.
(when (and (derived-mode-p 'org-mode) (not stealth))
(org-show-context 'link-search))
(org-fold-show-context 'link-search))
type))
(defun org-link-heading-search-string (&optional string)
@ -1322,7 +1365,7 @@ PATH is the sexp to evaluate, as a string."
(string-match-p org-link-elisp-skip-confirm-regexp path))
(not org-link-elisp-confirm-function)
(funcall org-link-elisp-confirm-function
(format "Execute %S as Elisp? "
(format "Execute %s as Elisp? "
(org-add-props path nil 'face 'org-warning))))
(message "%s => %s" path
(if (eq ?\( (string-to-char path))
@ -1377,7 +1420,7 @@ PATH is the command to execute, as a string."
(string-match-p org-link-shell-skip-confirm-regexp path))
(not org-link-shell-confirm-function)
(funcall org-link-shell-confirm-function
(format "Execute %S in shell? "
(format "Execute %s in shell? "
(org-add-props path nil 'face 'org-warning))))
(let ((buf (generate-new-buffer "*Org Shell Output*")))
(message "Executing %s" path)
@ -1430,7 +1473,7 @@ is non-nil, move backward."
(`nil nil)
(link
(goto-char (org-element-property :begin link))
(when (org-invisible-p) (org-show-context))
(when (org-invisible-p) (org-fold-show-context 'link-search))
(throw :found t)))))
(goto-char pos)
(setq org-link--search-failed t)
@ -1443,14 +1486,18 @@ 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."
(if org-link-descriptive
(org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible nil)
(org-fold-core-set-folding-spec-property (car org-link--link-folding-spec) :visible t)))
;;;###autoload
(defun org-toggle-link-display ()
"Toggle the literal or descriptive display of links."
"Toggle the literal or descriptive display of links in current buffer."
(interactive)
(if org-link-descriptive (remove-from-invisibility-spec '(org-link))
(add-to-invisibility-spec '(org-link)))
(org-restart-font-lock)
(setq org-link-descriptive (not org-link-descriptive)))
(setq org-link-descriptive (not org-link-descriptive))
(org-link-descriptive-ensure))
;;;###autoload
(defun org-store-link (arg &optional interactive?)
@ -1519,10 +1566,8 @@ non-nil."
t))))
(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 link value.
(setq desc (if (plist-member org-store-link-plist :description)
(plist-get org-store-link-plist :description)
link)))
;; it, even if it is nil. Otherwise, fallback to nil (ask user).
(setq desc (plist-get org-store-link-plist :description)))
;; Store a link from a remote editing buffer.
((org-src-edit-buffer-p)
@ -1563,7 +1608,7 @@ non-nil."
(t (setq link nil)))))
;; We are in the agenda, link to referenced location
((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name))
((eq major-mode 'org-agenda-mode)
(let ((m (or (get-text-property (point) 'org-hd-marker)
(get-text-property (point) 'org-marker))))
(when m
@ -1574,10 +1619,8 @@ non-nil."
(let ((cd (calendar-cursor-to-date)))
(setq link
(format-time-string
(car org-time-stamp-formats)
(apply 'encode-time
(list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
nil nil nil))))
(org-time-stamp-format)
(org-encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd))))
(org-link-store-props :type "calendar" :date cd)))
((eq major-mode 'image-mode)
@ -1592,7 +1635,7 @@ non-nil."
(setq file (if file
(abbreviate-file-name
(expand-file-name (dired-get-filename nil t)))
;; otherwise, no file so use current directory.
;; Otherwise, no file so use current directory.
default-directory))
(setq cpltxt (concat "file:" file)
link cpltxt)))
@ -1605,24 +1648,23 @@ non-nil."
((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
(org-with-limited-levels
(cond
;; Store a link using the target at point.
(setq custom-id (org-entry-get nil "CUSTOM_ID"))
(cond
;; Store a link using the target at point
((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
(setq cpltxt
(setq link
(concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))
"::" (match-string 1))
link cpltxt))
;; Store a link using the CUSTOM_ID property.
((setq custom-id (org-entry-get nil "CUSTOM_ID"))
(setq cpltxt
(concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))
"::#" custom-id)
link cpltxt))
;; Store a link using (and perhaps creating) the ID property.
;; Target may be shortened when link is inserted.
;; 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?
@ -1631,13 +1673,12 @@ non-nil."
'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 (or (plist-get org-store-link-plist
:description)
"")))
(setq desc (plist-get org-store-link-plist :description)))
(error
;; Probably before first headline, link only to file.
;; Probably before first headline, link only to file
(concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer))))))))
@ -1697,8 +1738,7 @@ non-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)
desc (or desc cpltxt))
(setq link (or link cpltxt))
(cond ((not desc))
((equal desc "NONE") (setq desc nil))
(t (setq desc (org-link-display-format desc))))
@ -1728,6 +1768,9 @@ The history can be used to select a link previously stored with
press `RET' at the prompt), the link defaults to the most recently
stored link. As `SPC' triggers completion in the minibuffer, you need to
use `M-SPC' or `C-q SPC' to force the insertion of a space character.
Completion candidates include link descriptions.
If there is a link under cursor then edit it.
You will also be prompted for a description, and if one is given, it will
be displayed in the buffer instead of the link.
@ -1753,11 +1796,14 @@ prefix negates `org-link-keep-stored-after-insertion'.
If the LINK-LOCATION parameter is non-nil, this value will be used as
the link location instead of reading one interactively.
If the DESCRIPTION parameter is non-nil, this value will be used as the
default description. Otherwise, if `org-link-make-description-function'
is non-nil, this function will be called with the link target, and the
result will be the default link description. When called non-interactively,
don't allow to edit the default description."
If the DESCRIPTION parameter is non-nil, this value will be used
as the default description. If not, and the chosen link type has
a non-nil `:insert-description' parameter, that is used to
generate a description as described in `org-link-parameters'
docstring. Otherwise, if `org-link-make-description-function' is
non-nil, this function will be called with the link target, and
the result will be the default link description. When called
non-interactively, don't allow to edit the default description."
(interactive "P")
(let* ((wcf (current-window-configuration))
(origbuf (current-buffer))
@ -1767,7 +1813,10 @@ don't allow to edit the default description."
(desc region)
(link link-location)
(abbrevs org-link-abbrev-alist-local)
entry all-prefixes auto-desc)
(all-prefixes (append (mapcar #'car abbrevs)
(mapcar #'car org-link-abbrev-alist)
(org-link-types)))
entry)
(cond
(link-location) ; specified by arg, just use it.
((org-in-regexp org-link-bracket-re 1)
@ -1808,9 +1857,6 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(unless (pos-visible-in-window-p (point-max))
(org-fit-window-to-buffer))
(and (window-live-p cw) (select-window cw))))
(setq all-prefixes (append (mapcar #'car abbrevs)
(mapcar #'car org-link-abbrev-alist)
(org-link-types)))
(unwind-protect
;; Fake a link history, containing the stored links.
(let ((org-link--history
@ -1821,15 +1867,19 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
"Link: "
(append
(mapcar (lambda (x) (concat x ":")) all-prefixes)
(mapcar #'car org-stored-links))
(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.
(delq nil (mapcar 'cadr org-stored-links)))
nil nil nil
'org-link--history
(caar org-stored-links)))
(unless (org-string-nw-p link) (user-error "No link selected"))
(dolist (l org-stored-links)
(when (equal link (cadr l))
(setq link (car l))
(setq auto-desc t)))
(setq link (car l))))
(when (or (member link all-prefixes)
(and (equal ":" (substring link -1))
(member (substring link 0 -1) all-prefixes)
@ -1906,21 +1956,40 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(when (equal desc origpath)
(setq desc path)))))
(unless auto-desc
(let ((initial-input
(cond
(description)
((not org-link-make-description-function) desc)
(t (condition-case nil
(funcall org-link-make-description-function link desc)
(error
(message "Can't get link description from %S"
(symbol-name org-link-make-description-function))
(sit-for 2)
nil))))))
(setq desc (if (called-interactively-p 'any)
(read-string "Description: " initial-input)
initial-input))))
(let* ((type
(cond
((and all-prefixes
(string-match (rx-to-string `(: string-start (submatch (or ,@all-prefixes)) ":")) link))
(match-string 1 link))
((file-name-absolute-p link) "file")
((string-match "\\`\\.\\.?/" link) "file")))
(initial-input
(cond
(description)
(desc)
((org-link-get-parameter type :insert-description)
(let ((def (org-link-get-parameter type :insert-description)))
(condition-case nil
(cond
((stringp def) def)
((functionp def)
(funcall def link desc)))
(error
(message "Can't get link description from org link parameter `:insert-description': %S"
def)
(sit-for 2)
nil))))
(org-link-make-description-function
(condition-case nil
(funcall org-link-make-description-function link desc)
(error
(message "Can't get link description from %S"
org-link-make-description-function)
(sit-for 2)
nil))))))
(setq desc (if (called-interactively-p 'any)
(read-string "Description: " initial-input)
initial-input)))
(unless (org-string-nw-p desc) (setq desc nil))
(when remove (apply #'delete-region remove))
@ -1989,6 +2058,10 @@ Also refresh fontification if needed."
(cl-pushnew (org-element-property :value obj) rtn
:test #'equal))))
rtn))))
(setq targets
(sort targets
(lambda (a b)
(> (length a) (length b)))))
(setq org-target-link-regexp
(and targets
(concat before-re
@ -2012,7 +2085,8 @@ Also refresh fontification if needed."
(list old-regexp org-target-link-regexp)
"\\|")
after-re)))))
(when (featurep 'org-element)
(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))))))

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

File diff suppressed because it is too large Load diff

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

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -28,6 +28,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org)
(require 'cl-lib)
@ -35,6 +38,9 @@
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
;; From org-element.el
(defvar org-element--cache-avoid-synchronous-headline-re-parsing)
(defcustom org-archive-default-command 'org-archive-subtree
"The default archiving command."
:group 'org-archive
@ -233,7 +239,7 @@ direct children of this heading."
(tr-org-odd-levels-only org-odd-levels-only)
(this-buffer (current-buffer))
(time (format-time-string
(substring (cdr org-time-stamp-formats) 1 -1)))
(org-time-stamp-format 'with-time 'no-brackets)))
(file (abbreviate-file-name
(or (buffer-file-name (buffer-base-buffer))
(error "No file associated to buffer"))))
@ -253,7 +259,9 @@ direct children of this heading."
(if (local-variable-p 'org-odd-levels-only (current-buffer))
org-odd-levels-only
tr-org-odd-levels-only))
level datetree-date datetree-subheading-p)
level datetree-date datetree-subheading-p
;; Suppress on-the-fly headline updates.
(org-element--cache-avoid-synchronous-headline-re-parsing t))
(when (string-match "\\`datetree/\\(\\**\\)" heading)
;; "datetree/" corresponds to 3 levels of headings.
(let ((nsub (length (match-string 1 heading))))
@ -319,7 +327,7 @@ direct children of this heading."
(org-todo-regexp tr-org-todo-regexp)
(org-todo-line-regexp tr-org-todo-line-regexp))
(goto-char (point-min))
(org-show-all '(headings blocks))
(org-fold-show-all '(headings blocks))
(if (and heading (not (and datetree-date (not datetree-subheading-p))))
(progn
(if (re-search-forward
@ -334,7 +342,7 @@ direct children of this heading."
(insert (if datetree-date "" "\n") heading "\n")
(end-of-line 0))
;; Make the subtree visible
(outline-show-subtree)
(org-fold-show-subtree)
(if org-archive-reversed-order
(progn
(org-back-to-heading t)
@ -412,7 +420,7 @@ direct children of this heading."
(if (eq this-buffer buffer)
(concat "under heading: " heading)
(concat "in file: " (abbreviate-file-name afile)))))))
(org-reveal)
(org-fold-reveal)
(if (looking-at "^[ \t]*$")
(outline-next-visible-heading 1))))
@ -448,6 +456,8 @@ Archiving time is retained in the ARCHIVE_TIME node property."
(setq leader (match-string 0)
level (funcall outline-level))
(setq pos (point-marker))
;; Advance POS upon insertion in front of it.
(set-marker-insertion-type pos t)
(condition-case nil
(outline-up-heading 1 t)
(error (setq e (point-max)) (goto-char (point-min))))
@ -480,15 +490,15 @@ Archiving time is retained in the ARCHIVE_TIME node property."
(org-set-property
"ARCHIVE_TIME"
(format-time-string
(substring (cdr org-time-stamp-formats) 1 -1)))
(org-time-stamp-format 'with-time 'no-brackets)))
(outline-up-heading 1 t)
(org-flag-subtree t)
(org-fold-subtree t)
(org-cycle-show-empty-lines 'folded)
(when org-provide-todo-statistics
;; Update TODO statistics of parent.
(org-update-parent-todo-statistics))
(goto-char pos)))
(org-reveal)
(org-fold-reveal)
(if (looking-at "^[ \t]*$")
(outline-next-visible-heading 1))))
@ -597,7 +607,7 @@ the children that do not contain any open TODO items."
(save-excursion
(org-back-to-heading t)
(setq set (org-toggle-tag org-archive-tag))
(when set (org-flag-subtree t)))
(when set (org-fold-subtree t)))
(and set (beginning-of-line 1))
(message "Subtree %s" (if set "archived" "unarchived"))))))

6
lisp/org/org-attach-git.el
View file

@ -29,6 +29,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org-attach)
(require 'vc-git)
@ -43,7 +46,8 @@
(defcustom org-attach-git-annex-auto-get 'ask
"Confirmation preference for automatically getting annex files.
If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get."
If this is the symbol `ask', prompt using `y-or-n-p'.
If t, always get. If nil, never get."
:group 'org-attach
:package-version '(Org . "9.0")
:version "26.1"

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

@ -34,6 +34,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'org)
(require 'ol)
@ -123,8 +126,8 @@ lns create a symbol link. Note that this is not supported
Enabling inheritance for `org-attach' implies two things. First,
that attachment links will look through all parent headings until
it finds the linked attachment. Second, that running org-attach
inside a node without attachments will make org-attach operate on
it finds the linked attachment. Second, that running `org-attach'
inside a node without attachments will make `org-attach' operate on
the first parent heading it finds with an attachment.
Selective means to respect the inheritance setting in
@ -136,7 +139,10 @@ Selective means to respect the inheritance setting in
(const :tag "Respect org-use-property-inheritance" selective)))
(defcustom org-attach-store-link-p nil
"Non-nil means store a link to a file when attaching it."
"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"
:type '(choice
@ -160,28 +166,57 @@ When set to `query', ask the user instead."
"Translate an UUID ID into a folder-path.
Default format for how Org translates ID properties to a path for
attachments. Useful if ID is generated with UUID."
(format "%s/%s"
(substring id 0 2)
(substring id 2)))
(and (< 2 (length id))
(format "%s/%s"
(substring id 0 2)
(substring id 2))))
(defun org-attach-id-ts-folder-format (id)
"Translate an ID based on a timestamp to a folder-path.
Useful way of translation if ID is generated based on ISO8601
timestamp. Splits the attachment folder hierarchy into
year-month, the rest."
(format "%s/%s"
(substring id 0 6)
(substring id 6)))
(and (< 6 (length id))
(format "%s/%s"
(substring id 0 6)
(substring id 6))))
(defcustom org-attach-id-to-path-function-list '(org-attach-id-uuid-folder-format
org-attach-id-ts-folder-format)
"List of functions parsing an ID string into a folder-path.
The first function in this list defines the preferred function
which will be used when creating new attachment folders. All
functions of this list will be tried when looking for existing
attachment folders based on ID."
(defun org-attach-id-fallback-folder-format (id)
"Return \"__/X/ID\" folder path as a dumb fallback.
X is the first character in the ID string.
This function may be appended to `org-attach-id-path-function-list' to
provide a fallback for non-standard ID values that other functions in
`org-attach-id-path-function-list' are unable to handle. For example,
when the ID is too short for `org-attach-id-ts-folder-format'.
However, we recommend to define a more specific function spreading
entries over multiple folders. This function may create a large
number of entries in a single folder, which may cause issues on some
systems."
(format "__/%s/%s" (substring id 0 1) id))
(defcustom org-attach-id-to-path-function-list
'(org-attach-id-uuid-folder-format
org-attach-id-ts-folder-format
org-attach-id-fallback-folder-format)
"List of functions used to derive attachment path from an ID string.
The functions are called with a single ID argument until the return
value is an existing folder. If no folder has been created yet for
the given ID, then the first non-nil value defines the attachment
dir to be created.
Usually, the ID format passed to the functions is defined by
`org-id-method'. It is advised that the first function in the list do
not generate all the attachment dirs inside the same parent dir. Some
file systems may have performance issues in such scenario.
Care should be taken when customizing this variable. Previously
created attachment folders might not be correctly mapped upon removing
functions from the list. Then, Org will not be able to detect the
existing attachments."
:group 'org-attach
:package-version '(Org . "9.3")
:package-version '(Org . "9.6")
:type '(repeat (function :tag "Function with ID as input")))
(defvar org-attach-after-change-hook nil
@ -314,16 +349,17 @@ Shows a list of commands and prompts for another key to execute a command."
(concat (mapcar #'caar org-attach-commands)))))
(message msg)
(while (and (setq c (read-char-exclusive))
(memq c '(14 16 22 134217846)))
(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 t)
(call-interactively command)
(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)
"Return the directory associated with the current outline node.
First check for DIR property, then ID property.
@ -335,7 +371,7 @@ will be invoked to access the directory for the current entry.
Note that this method returns the directory as declared by ID or
DIR even if the directory doesn't exist in the filesystem.
If CREATE-IF-NOT-EXIST-P is non-nil, `org-attach-dir-get-create'
If CREATE-IF-NOT-EXISTS-P is non-nil, `org-attach-dir-get-create'
is run. If NO-FS-CHECK is non-nil, the function returns the path
to the attachment even if it has not yet been initialized in the
filesystem.
@ -353,7 +389,7 @@ If no attachment directory can be derived, return nil."
(org-attach-check-absolute-path attach-dir))
((setq id (org-entry-get nil "ID" org-attach-use-inheritance))
(org-attach-check-absolute-path nil)
(setq attach-dir (org-attach-dir-from-id id 'try-all))))
(setq attach-dir (org-attach-dir-from-id id 'existing))))
(if no-fs-check
attach-dir
(when (and attach-dir (file-directory-p attach-dir))
@ -374,38 +410,40 @@ If the attachment by some reason cannot be created an error will be raised."
(setq answer (read-char-exclusive)))
(cond
((or (eq org-attach-preferred-new-method 'id) (eq answer ?1))
(setq attach-dir (org-attach-dir-from-id (org-id-get nil t))))
(let ((id (org-id-get nil t)))
(or (setq attach-dir (org-attach-dir-from-id id))
(error "Failed to get folder for id %s, \
adjust `org-attach-id-to-path-function-list'"
id))))
((or (eq org-attach-preferred-new-method 'dir) (eq answer ?2))
(setq attach-dir (org-attach-set-directory)))
((eq org-attach-preferred-new-method 'nil)
(error "No existing directory. DIR or ID property has to be explicitly created")))))
(error "No existing directory. DIR or ID property has to be explicitly created")))))
(unless attach-dir
(error "No attachment directory is associated with the current node"))
(unless (file-directory-p attach-dir)
(make-directory attach-dir t))
attach-dir))
(defun org-attach-dir-from-id (id &optional try-all)
(defun org-attach-dir-from-id (id &optional existing)
"Return a folder path based on `org-attach-id-dir' and ID.
If TRY-ALL is non-nil, try all id-to-path functions in
`org-attach-id-to-path-function-list' and return the first path
that exist in the filesystem, or the first one if none exist.
Otherwise only use the first function in that list."
(let ((attach-dir-preferred (expand-file-name
(funcall (car org-attach-id-to-path-function-list) id)
(expand-file-name org-attach-id-dir))))
(if try-all
(let ((attach-dir attach-dir-preferred)
(fun-list (cdr org-attach-id-to-path-function-list)))
(while (and fun-list (not (file-directory-p attach-dir)))
(setq attach-dir (expand-file-name
(funcall (car fun-list) id)
(expand-file-name org-attach-id-dir)))
(setq fun-list (cdr fun-list)))
(if (file-directory-p attach-dir)
attach-dir
attach-dir-preferred))
attach-dir-preferred)))
Try id-to-path functions in `org-attach-id-to-path-function-list'
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))
preferred first)
(while (and fun-list
(not preferred))
(let* ((name (funcall (car fun-list) id))
(candidate (and name (expand-file-name name 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))))))
(or preferred first)))
(defun org-attach-check-absolute-path (dir)
"Check if we have enough information to root the attachment directory.
@ -483,8 +521,11 @@ DIR-property exists (that is different from the unset one)."
(org-attach-tag 'off))
(defun org-attach-url (url)
"Attach URL."
(interactive "MURL of the file to attach: \n")
(let ((org-attach-method 'url))
(let ((org-attach-method 'url)
(org-safe-remote-resources ; Assume saftey if in an interactive session.
(if noninteractive org-safe-remote-resources '(""))))
(org-attach-attach url)))
(defun org-attach-buffer (buffer-name)
@ -503,7 +544,7 @@ if it would overwrite an existing filename."
(defun org-attach-attach (file &optional visit-dir method)
"Move/copy/link FILE into the attachment directory of the current outline node.
If VISIT-DIR is non-nil, visit the directory with dired.
If VISIT-DIR is non-nil, visit the directory with `dired'.
METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
`org-attach-method'."
(interactive
@ -516,15 +557,24 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
current-prefix-arg
nil))
(setq method (or method org-attach-method))
(when (file-directory-p file)
(setq file (directory-file-name file)))
(let ((basename (file-name-nondirectory file)))
(let* ((attach-dir (org-attach-dir 'get-create))
(attach-file (expand-file-name basename attach-dir)))
(cond
((eq method 'mv) (rename-file file attach-file))
((eq method 'cp) (copy-file file attach-file))
((eq method 'cp)
(if (file-directory-p file)
(copy-directory file attach-file nil nil t)
(copy-file file attach-file)))
((eq method 'ln) (add-name-to-file file attach-file))
((eq method 'lns) (make-symbolic-link file attach-file))
((eq method 'url) (url-copy-file file attach-file)))
((eq method 'lns) (make-symbolic-link file attach-file 1))
((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."
file))))
(run-hook-with-args 'org-attach-after-change-hook attach-dir)
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
@ -574,27 +624,27 @@ The attachment is created as an Emacs buffer."
(find-file (expand-file-name file attach-dir))
(message "New attachment %s" file)))
(defun org-attach-delete-one (&optional file)
"Delete a single attachment."
(defun org-attach-delete-one (&optional attachment)
"Delete a single ATTACHMENT."
(interactive)
(let* ((attach-dir (org-attach-dir))
(files (org-attach-file-list attach-dir))
(file (or file
(attachment (or attachment
(completing-read
"Delete attachment: "
(mapcar (lambda (f)
(list (file-name-nondirectory f)))
files)))))
(setq file (expand-file-name file attach-dir))
(unless (file-exists-p file)
(error "No such attachment: %s" file))
(delete-file file)
(setq attachment (expand-file-name attachment attach-dir))
(unless (file-exists-p attachment)
(error "No such attachment: %s" attachment))
(delete-file attachment)
(run-hook-with-args 'org-attach-after-change-hook attach-dir)))
(defun org-attach-delete-all (&optional force)
"Delete all attachments from the current outline node.
This actually deletes the entire attachment directory.
A safer way is to open the directory in dired and delete from there.
A safer way is to open the directory in `dired' and delete from there.
With prefix argument FORCE, directory will be recursively deleted
with no prompts."
@ -629,12 +679,12 @@ empty attachment directories."
t))
(delete-directory attach-dir))))))
(defun org-attach-file-list (dir)
"Return a list of files in the attachment directory.
(defun org-attach-file-list (directory)
"Return a list of files in the attachment DIRECTORY.
This ignores files ending in \"~\"."
(delq nil
(mapcar (lambda (x) (if (string-match "^\\.\\.?\\'" x) nil x))
(directory-files dir nil "[^~]\\'"))))
(directory-files directory nil "[^~]\\'"))))
(defun org-attach-reveal ()
"Show the attachment directory of the current outline node.
@ -645,7 +695,7 @@ exist yet. Respects `org-attach-preferred-new-method'."
(org-open-file (org-attach-dir-get-create)))
(defun org-attach-reveal-in-emacs ()
"Show the attachment directory of the current outline node in dired.
"Show the attachment directory of the current outline node in `dired'.
Will create an attachment and folder if it doesn't exist yet.
Respects `org-attach-preferred-new-method'."
(interactive)
@ -749,14 +799,14 @@ This function is called by `org-archive-hook'. The option
;;;###autoload
(defun org-attach-dired-to-subtree (files)
"Attach FILES marked or current file in dired to subtree in other window.
"Attach FILES marked or current file in `dired' to subtree in other window.
Takes the method given in `org-attach-method' for the attach action.
Precondition: Point must be in a dired buffer.
Precondition: Point must be in a `dired' buffer.
Idea taken from `gnus-dired-attach'."
(interactive
(list (dired-get-marked-files)))
(unless (eq major-mode 'dired-mode)
(user-error "This command must be triggered in a dired buffer"))
(user-error "This command must be triggered in a `dired' buffer"))
(let ((start-win (selected-window))
(other-win
(get-window-with-predicate
@ -776,7 +826,7 @@ Idea taken from `gnus-dired-attach'."
(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe)
(add-hook 'org-export-before-parsing-hook 'org-attach-expand-links)
(add-hook 'org-export-before-parsing-functions 'org-attach-expand-links)
(provide 'org-attach)

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

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -47,6 +47,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'org)
(require 'org-refile)
@ -57,7 +60,7 @@
(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-decrypt-entry "org-crypt" ())
(declare-function org-element-at-point "org-element" ())
(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-encrypt-entry "org-crypt" ())
@ -83,7 +86,7 @@
(defvar org-table-hlines)
(defvar org-capture-clock-was-started nil
"Internal flag, noting if the clock was started.")
"Internal flag, keeping marker to the started clock.")
(defvar org-capture-last-stored-marker (make-marker)
"Marker pointing to the entry most recently stored with `org-capture'.")
@ -294,6 +297,21 @@ properties are:
:no-save Do not save the target file after finishing the capture.
:hook A nullary function or list of nullary functions run before
`org-capture-mode-hook' when the template is selected.
:prepare-finalize A nullary function or list of nullary functions run before
`org-capture-prepare-finalize-hook'
when the template is selected.
:before-finalize A nullary function or list of nullary functions run before
`org-capture-before-finalize-hook'
when the template is selected.
:after-finalize A nullary function or list of nullary functions run before
`org-capture-after-finalize-hook'
when the template is selected.
The template defines the text to be inserted. Often this is an
Org mode entry (so the first line should start with a star) that
will be filed as a child of the target headline. It can also be
@ -309,6 +327,8 @@ be replaced with content and expanded:
introduced with %[pathname] are expanded this way.
Since this happens after expanding non-interactive
%-escapes, those can be used to fill the expression.
The evaluation happens with Org mode set as major mode
in a temporary buffer.
%<...> The result of `format-time-string' on the ... format
specification.
%t Time stamp, date only. The time stamp is the current
@ -373,8 +393,8 @@ 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.5")
:set (lambda (s v) (set s (org-capture-upgrade-templates v)))
:package-version '(Org . "9.6")
:set (lambda (s v) (set-default-toplevel-value s (org-capture-upgrade-templates v)))
:type
(let ((file-variants '(choice :tag "Filename "
(file :tag "Literal")
@ -558,7 +578,8 @@ For example, if you have a capture template \"c\" and you want
this template to be accessible only from `message-mode' buffers,
use this:
\\='((\"c\" ((in-mode . \"message-mode\"))))
(setq org-capture-templates-contexts
\\='((\"c\" ((in-mode . \"message-mode\")))))
Here are the available contexts definitions:
@ -576,7 +597,8 @@ accessible if there is at least one valid check.
You can also bind a key to another capture template depending on
contextual rules.
\\='((\"c\" \"d\" ((in-mode . \"message-mode\"))))
(setq org-capture-templates-contexts
\\='((\"c\" \"d\" ((in-mode . \"message-mode\")))))
Here it means: in `message-mode buffers', use \"c\" as the
key for the capture template otherwise associated with \"d\".
@ -712,7 +734,8 @@ of the day at point (if any) or the current HH:MM time."
(org-capture-put :interrupted-clock
(copy-marker org-clock-marker)))
(org-clock-in)
(setq-local org-capture-clock-was-started t))
(setq-local org-capture-clock-was-started
(copy-marker org-clock-marker)))
(error "Could not start the clock in this capture buffer")))
(when (org-capture-get :immediate-finish)
(org-capture-finalize))))))))
@ -733,6 +756,17 @@ of the day at point (if any) or the current HH:MM time."
(format "* Template function %S not found" f)))
(_ "* Invalid capture template"))))
(defun org-capture--run-template-functions (keyword &optional local)
"Run funcitons associated with KEYWORD on template's plist.
For valid values of KEYWORD see `org-capture-templates'.
If LOCAL is non-nil use the buffer-local value of `org-capture-plist'."
;; Used in place of `run-hooks' because these functions have no associated symbol.
;; They are stored directly on `org-capture-plist'.
(let ((value (org-capture-get keyword local)))
(if (functionp value)
(funcall value)
(mapc #'funcall value))))
(defun org-capture-finalize (&optional stay-with-capture)
"Finalize the capture process.
With prefix argument STAY-WITH-CAPTURE, jump to the location of the
@ -744,6 +778,7 @@ captured item after finalizing."
(buffer-base-buffer (current-buffer)))
(error "This does not seem to be a capture buffer for Org mode"))
(org-capture--run-template-functions :prepare-finalize 'local)
(run-hooks 'org-capture-prepare-finalize-hook)
;; Update `org-capture-plist' with the buffer-local value. Since
@ -753,10 +788,7 @@ captured item after finalizing."
;; Did we start the clock in this capture buffer?
(when (and org-capture-clock-was-started
org-clock-marker
(eq (marker-buffer org-clock-marker) (buffer-base-buffer))
(>= org-clock-marker (point-min))
(< org-clock-marker (point-max)))
(equal org-clock-marker org-capture-clock-was-started))
;; Looks like the clock we started is still running.
(if org-capture-clock-keep
;; User may have completed clocked heading from the template.
@ -816,6 +848,7 @@ captured item after finalizing."
;; the indirect buffer has been killed.
(org-capture-store-last-position)
(org-capture--run-template-functions :before-finalize 'local)
;; Run the hook
(run-hooks 'org-capture-before-finalize-hook))
@ -864,6 +897,9 @@ captured item after finalizing."
;; Restore the window configuration before capture
(set-window-configuration return-wconf))
;; Do not use the local arg to `org-capture--run-template-functions' here.
;; The buffer-local value has been stored on `org-capture-plist'.
(org-capture--run-template-functions :after-finalize)
(run-hooks 'org-capture-after-finalize-hook)
;; Special cases
(cond
@ -1050,9 +1086,10 @@ Store them in the capture property list."
prompt-time
;; Use 00:00 when no time is given for another
;; date than today?
(apply #'encode-time 0 0
org-extend-today-until
(cl-cdddr (decode-time prompt-time)))))
(org-encode-time
(apply #'list
0 0 org-extend-today-until
(cl-cdddr (decode-time prompt-time))))))
(time-to-days prompt-time)))
(t
;; Current date, possibly corrected for late night
@ -1129,7 +1166,7 @@ may have been stored before."
(org-switch-to-buffer-other-window
(org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
(widen)
(org-show-all)
(org-fold-show-all)
(goto-char (org-capture-get :pos))
(setq-local outline-level 'org-outline-level)
(pcase (org-capture-get :type)
@ -1139,6 +1176,7 @@ may have been stored before."
(`item (org-capture-place-item))
(`checkitem (org-capture-place-item)))
(setq-local org-capture-current-plist org-capture-plist)
(org-capture--run-template-functions :hook 'local)
(org-capture-mode 1))
(defun org-capture-place-entry ()
@ -1171,8 +1209,11 @@ may have been stored before."
(goto-char (point-min))
(unless (org-at-heading-p) (outline-next-heading)))
;; Otherwise, insert as a top-level entry at the end of the file.
(t (goto-char (point-max))))
(let ((origin (point)))
(t (goto-char (point-max))
;; Make sure that last point is not folded.
(org-fold-core-cycle-over-indirect-buffers
(org-fold-region (max 1 (1- (point-max))) (point-max) nil))))
(let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
(org-capture-empty-lines-before)
(let ((beg (point)))
@ -1237,7 +1278,7 @@ may have been stored before."
(point))
beg)))))))
;; Insert template.
(let ((origin (point)))
(let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
;; When a new list is created, always obey to `:empty-lines' and
;; friends.
@ -1264,7 +1305,7 @@ may have been stored before."
(when item
(let ((i (save-excursion
(goto-char (org-element-property :post-affiliated item))
(current-indentation))))
(org-current-text-indentation))))
(save-excursion
(goto-char beg)
(save-excursion
@ -1338,7 +1379,7 @@ may have been stored before."
;; No table found. Create it with an empty header.
(goto-char end)
(unless (bolp) (insert "\n"))
(let ((origin (point)))
(let ((origin (point-marker)))
(insert "| |\n|---|\n")
(narrow-to-region origin (point))))
;; In the current table, find the appropriate location for TEXT.
@ -1367,7 +1408,7 @@ may have been stored before."
(t
(goto-char (org-table-end))))
;; Insert text and position point according to template.
(let ((origin (point)))
(let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
(let ((beg (point))
(end (save-excursion
@ -1399,7 +1440,7 @@ Of course, if exact position has been required, just put it there."
(t
;; Beginning or end of file.
(goto-char (if (org-capture-get :prepend) (point-min) (point-max)))))
(let ((origin (point)))
(let ((origin (point-marker)))
(unless (bolp) (insert "\n"))
(org-capture-empty-lines-before)
(org-capture-position-for-last-stored (point))
@ -1569,14 +1610,16 @@ Lisp programs can force the template by setting KEYS to a string."
"Fill a TEMPLATE and return the filled template as a string.
The template may still contain \"%?\" for cursor positioning.
INITIAL content and/or ANNOTATION may be specified, but will be overridden
by their respective `org-store-link-plist' properties if present."
by their respective `org-store-link-plist' properties if present.
Expansion occurs in a temporary Org mode buffer."
(let* ((template (or template (org-capture-get :template)))
(buffer (org-capture-get :buffer))
(file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
(time (let* ((c (or (org-capture-get :default-time) (current-time)))
(d (decode-time c)))
(if (< (nth 2 d) org-extend-today-until)
(encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d))
(org-encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d))
c)))
(v-t (format-time-string (org-time-stamp-format nil) time))
(v-T (format-time-string (org-time-stamp-format t) time))
@ -1642,6 +1685,7 @@ by their respective `org-store-link-plist' properties if present."
(setq buffer-file-name nil)
(setq mark-active nil)
(insert template)
(org-mode)
(goto-char (point-min))
;; %[] insert contents of a file.
(save-excursion
@ -1817,12 +1861,7 @@ by their respective `org-store-link-plist' properties if present."
(setq org-capture--prompt-history
(gethash prompt org-capture--prompt-history-table))
(push (org-completing-read
;; `format-prompt' is new in Emacs 28.1.
(if (fboundp 'format-prompt)
(format-prompt (or prompt "Enter string") default)
(concat (or prompt "Enter string")
(and default (format " [%s]" default))
": "))
(org-format-prompt (or prompt "Enter string") default)
completions
nil nil nil 'org-capture--prompt-history default)
strings)

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

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -28,6 +28,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'org)
@ -35,6 +38,8 @@
(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" ())
(defvar org-element-use-cache)
(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
(declare-function org-inlinetask-goto-end "org-inlinetask" ())
@ -50,7 +55,6 @@
(defvar org-frame-title-format-backup nil)
(defvar org-state)
(defvar org-link-bracket-re)
(defvar org-time-stamp-formats)
(defgroup org-clock nil
"Options concerning clocking working time in Org mode."
@ -321,6 +325,7 @@ string as argument."
:link nil
:narrow '40!
:indent t
:filetitle nil
:hidefiles nil
:formula nil
:timestamp nil
@ -329,7 +334,7 @@ string as argument."
:formatter nil)
"Default properties for clock tables."
:group 'org-clock
:version "24.1"
:package-version '(Org . "9.6")
:type 'plist)
(defcustom org-clock-clocktable-formatter 'org-clocktable-write-default
@ -439,8 +444,8 @@ This uses the same format as `frame-title-format', which see."
you can do \"~$ sudo apt-get install xprintidle\" if you are using
a Debian-based distribution.
Alternatively, can find x11idle.c in the org-contrib repository at
https://git.sr.ht/~bzg/org-contrib"
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")
@ -489,7 +494,7 @@ This variable only has effect if set with \\[customize]."
(if value
(add-hook 'kill-emacs-query-functions #'org-clock-kill-emacs-query)
(remove-hook 'kill-emacs-query-functions #'org-clock-kill-emacs-query))
(set symbol value))
(set-default-toplevel-value symbol value))
:type 'boolean
:package-version '(Org . "9.5"))
@ -694,7 +699,10 @@ pointing to it."
org-odd-levels-only)
(length prefix))))))
(when (and cat task)
(insert (format "[%c] %-12s %s\n" i cat task))
(if (string-match-p "[[:print:]]" (make-string 1 i))
(insert (format "[%c] %-12s %s\n" i cat task))
;; Avoid non-printable characters.
(insert (format "[N/A] %-12s %s\n" cat task)))
(cons i marker)))))
(defvar org-clock-task-overrun nil
@ -767,7 +775,7 @@ The time returned includes the time spent on this task in
previous clocking intervals."
(let ((currently-clocked-time
(floor (org-time-convert-to-integer
(org-time-since org-clock-start-time))
(time-since org-clock-start-time))
60)))
(+ currently-clocked-time (or org-clock-total-time 0))))
@ -997,7 +1005,7 @@ CLOCK is a cons cell of the form (MARKER START-TIME)."
(org-clock-clock-out clock fail-quietly))
((org-is-active-clock clock) nil)
(t (org-clock-clock-in clock t))))
((pred (org-time-less-p nil))
((pred (time-less-p nil))
(error "RESOLVE-TO must refer to a time in the past"))
(_
(when restart (error "RESTART is not valid here"))
@ -1030,7 +1038,7 @@ CLOCK is a cons cell of the form (MARKER START-TIME)."
(let ((element (org-element-at-point)))
(when (eq (org-element-type element) 'drawer)
(when (> (org-element-property :end element) (car clock))
(org-hide-drawer-toggle 'off nil element))
(org-fold-hide-drawer-toggle 'off nil element))
(throw 'exit nil)))))))))))
(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
@ -1094,12 +1102,12 @@ to be CLOCKED OUT."))))
?j ?J ?i ?q ?t ?T)))
(or (ding) t)))
(setq char-pressed
(read-char (concat (funcall prompt-fn clock)
" [jkKtTgGSscCiq]? ")
nil 45)))
(read-char-exclusive (concat (funcall prompt-fn clock)
" [jkKtTgGSscCiq]? ")
nil 45)))
(and (not (memq char-pressed '(?i ?q))) char-pressed)))))
(default
(floor (org-time-convert-to-integer (org-time-since last-valid))
(floor (org-time-convert-to-integer (time-since last-valid))
60))
(keep
(or (and (memq ch '(?k ?K))
@ -1107,14 +1115,14 @@ to be CLOCKED OUT."))))
(and (memq ch '(?t ?T))
(floor
(/ (float-time
(org-time-subtract (org-read-date t t) last-valid))
(time-subtract (org-read-date t t) last-valid))
60)))))
(gotback
(and (memq ch '(?g ?G))
(read-number "Got back how many minutes ago: " default)))
(subtractp (memq ch '(?s ?S)))
(barely-started-p (org-time-less-p
(org-time-subtract last-valid (cdr clock))
(barely-started-p (time-less-p
(time-subtract last-valid (cdr clock))
45))
(start-over (and subtractp barely-started-p)))
(cond
@ -1141,9 +1149,9 @@ to be CLOCKED OUT."))))
(and gotback (= gotback default)))
'now)
(keep
(org-time-add last-valid (* 60 keep)))
(time-add last-valid (* 60 keep)))
(gotback
(org-time-since (* 60 gotback)))
(time-since (* 60 gotback)))
(t
(error "Unexpected, please report this as a bug")))
(and gotback last-valid)
@ -1173,7 +1181,7 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(format
"Dangling clock started %d mins ago"
(floor (org-time-convert-to-integer
(org-time-since (cdr clock)))
(time-since (cdr clock)))
60))))
(or last-valid
(cdr clock)))))))))))
@ -1191,8 +1199,7 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(defvar org-x11idle-exists-p
;; Check that x11idle exists
(and (eq window-system 'x)
(eq 0 (call-process-shell-command
(and (eq 0 (call-process-shell-command
(format "command -v %s" org-clock-x11idle-program-name)))
;; Check that x11idle can retrieve the idle time
;; FIXME: Why "..-shell-command" rather than just `call-process'?
@ -1224,9 +1231,11 @@ so long."
org-clock-marker (marker-buffer org-clock-marker))
(let* ((org-clock-user-idle-seconds (org-user-idle-seconds))
(org-clock-user-idle-start
(org-time-since org-clock-user-idle-seconds))
(time-since org-clock-user-idle-seconds))
(org-clock-resolving-clocks-due-to-idleness t))
(if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))
(when (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))
(cancel-timer org-clock-idle-timer)
(setq org-clock-idle-timer nil)
(org-clock-resolve
(cons org-clock-marker
org-clock-start-time)
@ -1235,7 +1244,10 @@ so long."
(/ (float-time
(time-since org-clock-user-idle-start))
60)))
org-clock-user-idle-start)))))
org-clock-user-idle-start)
(when (and (org-clocking-p) (not org-clock-idle-timer))
(setq org-clock-idle-timer
(run-with-timer 60 60 #'org-resolve-clocks-if-idle)))))))
(defvar org-clock-current-task nil "Task currently clocked in.")
(defvar org-clock-out-time nil) ; store the time of the last clock-out
@ -1262,7 +1274,8 @@ time as the start time. See `org-clock-continuously' to make this
the default behavior."
(interactive "P")
(setq org-clock-notification-was-shown nil)
(org-refresh-effort-properties)
(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)))
@ -1316,7 +1329,7 @@ the default behavior."
;; Clock in at which position?
(setq target-pos
(if (and (eobp) (not (org-at-heading-p)))
(line-beginning-position 0)
(org-with-wide-buffer (line-beginning-position 0))
(point)))
(save-excursion
(when (and selected-task (marker-buffer selected-task))
@ -1340,8 +1353,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
"\\>"))))
(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)
@ -1367,14 +1380,14 @@ the default behavior."
(sit-for 2)
(throw 'abort nil))
(t
(insert-before-markers "\n")
(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)
(indent-line-to (max 0 (- (current-indentation) 2))))
(insert org-clock-string " ")
(insert-and-inherit org-clock-string " ")
(setq org-clock-effort (org-entry-get (point) org-effort-property))
(setq org-clock-total-time (org-clock-sum-current-item
(org-clock-get-sum-start)))
@ -1385,7 +1398,7 @@ the default behavior."
(format
"You stopped another clock %d mins ago; start this one from then? "
(/ (org-time-convert-to-integer
(org-time-subtract
(time-subtract
(org-current-time org-clock-rounding-minutes t)
leftover))
60)))
@ -1514,7 +1527,7 @@ The time is always returned as UTC."
(day (nth 3 dt)))
(if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day)))
(setf (nth 2 dt) org-extend-today-until)
(apply #'encode-time 0 0 (nthcdr 2 dt))))
(org-encode-time (apply #'list 0 0 (nthcdr 2 dt)))))
((or (equal cmt "all")
(and (or (not cmt) (equal cmt "auto"))
(not lr)))
@ -1575,19 +1588,23 @@ line and position cursor in that line."
count (1+ count))))))
(cond
((null positions)
;; Skip planning line and property drawer, if any.
(org-end-of-meta-data)
(unless (bolp) (insert "\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 ":" drawer ":\n:END:\n")
(org-indent-region beg (point))
(org-flag-region
(line-end-position -1) (1- (point)) t 'outline)
(forward-line -1))))
(org-fold-core-ignore-modifications
;; Skip planning line and property drawer, if any.
(org-end-of-meta-data)
(unless (bolp) (insert-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")
(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))
(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
;; all clocks in the section and wrap them within the drawer.
@ -1596,28 +1613,29 @@ line and position cursor in that line."
drawer)
;; Skip planning line and property drawer, if any.
(org-end-of-meta-data)
(let ((beg (point)))
(insert
(mapconcat
(lambda (p)
(save-excursion
(goto-char p)
(org-trim (delete-and-extract-region
(save-excursion (skip-chars-backward " \r\t\n")
(line-beginning-position 2))
(line-beginning-position 2)))))
positions "\n")
"\n:END:\n")
(let ((end (point-marker)))
(goto-char beg)
(save-excursion (insert ":" drawer ":\n"))
(org-flag-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))
(set-marker end nil))))
(org-fold-core-ignore-modifications
(let ((beg (point)))
(insert-and-inherit
(mapconcat
(lambda (p)
(save-excursion
(goto-char p)
(org-trim (delete-and-extract-region
(save-excursion (skip-chars-backward " \r\t\n")
(line-beginning-position 2))
(line-beginning-position 2)))))
positions "\n")
"\n:END:\n")
(let ((end (point-marker)))
(goto-char beg)
(save-excursion (insert-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))
(set-marker end nil)))))
(org-log-states-order-reversed (goto-char (car (last positions))))
(t (goto-char (car positions))))))))
@ -1665,25 +1683,26 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(setq ts (match-string 2))
(if fail-quietly (throw 'exit nil) (error "Clock start time is gone")))
(goto-char (match-end 0))
(delete-region (point) (line-end-position))
(insert "--")
(setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
(setq s (org-time-convert-to-integer
(time-subtract
(org-time-string-to-time te)
(org-time-string-to-time ts)))
h (floor s 3600)
m (floor (mod s 3600) 60))
(insert " => " (format "%2d:%02d" h m))
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
;; Possibly remove zero time clocks.
(when (and org-clock-out-remove-zero-time-clocks
(= 0 h m))
(setq remove t)
(delete-region (line-beginning-position)
(line-beginning-position 2)))
(org-clock-remove-empty-clock-drawer)
(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 s (org-time-convert-to-integer
(time-subtract
(org-time-string-to-time te)
(org-time-string-to-time ts)))
h (floor s 3600)
m (floor (mod s 3600) 60))
(insert-and-inherit " => " (format "%2d:%02d" h m))
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
;; Possibly remove zero time clocks.
(when (and org-clock-out-remove-zero-time-clocks
(= 0 h m))
(setq remove t)
(delete-region (line-beginning-position)
(line-beginning-position 2)))
(org-clock-remove-empty-clock-drawer))
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
(setq org-clock-mode-line-timer nil))
@ -1705,9 +1724,11 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(match-string 2))))
(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
"\\>"))))
(not (looking-at
(concat
org-outline-regexp "[ \t]*"
org-clock-out-switch-to-state
"\\>"))))
(org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update)
(message (if remove
@ -1837,10 +1858,10 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
(org-show-entry)
(org-fold-show-entry)
(org-back-to-heading t)
(recenter org-clock-goto-before-context)
(org-reveal)
(org-fold-reveal)
(if recent
(message "No running clock, this is the most recently clocked task"))
(run-hooks 'org-clock-goto-hook)))
@ -1898,65 +1919,66 @@ 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)
(cond
((match-end 2)
;; Two time stamps.
(let* ((ts (float-time
(apply #'encode-time
(save-match-data
(org-parse-time-string (match-string 2))))))
(te (float-time
(apply #'encode-time
(org-parse-time-string (match-string 3)))))
(dt (- (if tend (min te tend) te)
(if tstart (max ts tstart) ts))))
(when (> dt 0) (cl-incf t1 (floor dt 60)))))
((match-end 4)
;; A naked time.
(setq t1 (+ t1 (string-to-number (match-string 5))
(* 60 (string-to-number (match-string 4))))))
(t ;A headline
;; Add the currently clocking item time to the total.
(when (and org-clock-report-include-clocking-task
(eq (org-clocking-buffer) (current-buffer))
(eq (marker-position org-clock-hd-marker) (point))
tstart
tend
(>= (float-time org-clock-start-time) tstart)
(<= (float-time org-clock-start-time) tend))
(let ((time (floor (org-time-convert-to-integer
(org-time-since org-clock-start-time))
60)))
(setq t1 (+ t1 time))))
(let* ((headline-forced
(get-text-property (point)
:org-clock-force-headline-inclusion))
(headline-included
(or (null headline-filter)
(save-excursion
(save-match-data (funcall headline-filter))))))
(setq level (- (match-end 1) (match-beginning 1)))
(when (>= level lmax)
(setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
(when (or (> t1 0) (> (aref ltimes level) 0))
(when (or headline-included headline-forced)
(if headline-included
(cl-loop for l from 0 to level do
(aset ltimes l (+ (aref ltimes l) t1))))
(setq time (aref ltimes level))
(goto-char (match-beginning 0))
(put-text-property (point) (line-end-position)
(or propname :org-clock-minutes) time)
(when headline-filter
(save-excursion
(save-match-data
(while (org-up-heading-safe)
(put-text-property
(point) (line-end-position)
:org-clock-force-headline-inclusion t))))))
(setq t1 0)
(cl-loop for l from level to (1- lmax) do
(aset ltimes l 0)))))))
(let ((element-type
(org-element-type
(save-match-data
(org-element-at-point)))))
(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))
(dt (- (if tend (min te tend) te)
(if tstart (max ts tstart) ts))))
(when (> dt 0) (cl-incf t1 (floor dt 60)))))
((match-end 4)
;; A naked time.
(setq t1 (+ t1 (string-to-number (match-string 5))
(* 60 (string-to-number (match-string 4))))))
((memq element-type '(headline inlinetask)) ;A headline
;; Add the currently clocking item time to the total.
(when (and org-clock-report-include-clocking-task
(eq (org-clocking-buffer) (current-buffer))
(eq (marker-position org-clock-hd-marker) (point))
tstart
tend
(>= (float-time org-clock-start-time) tstart)
(<= (float-time org-clock-start-time) tend))
(let ((time (floor (org-time-convert-to-integer
(time-since org-clock-start-time))
60)))
(setq t1 (+ t1 time))))
(let* ((headline-forced
(get-text-property (point)
:org-clock-force-headline-inclusion))
(headline-included
(or (null headline-filter)
(save-excursion
(save-match-data (funcall headline-filter))))))
(setq level (- (match-end 1) (match-beginning 1)))
(when (>= level lmax)
(setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
(when (or (> t1 0) (> (aref ltimes level) 0))
(when (or headline-included headline-forced)
(if headline-included
(cl-loop for l from 0 to level do
(aset ltimes l (+ (aref ltimes l) t1))))
(setq time (aref ltimes level))
(goto-char (match-beginning 0))
(put-text-property (point) (line-end-position)
(or propname :org-clock-minutes) time)
(when headline-filter
(save-excursion
(save-match-data
(while (org-up-heading-safe)
(put-text-property
(point) (line-end-position)
:org-clock-force-headline-inclusion t))))))
(setq t1 0)
(cl-loop for l from level to (1- lmax) do
(aset ltimes l 0))))))))
(setq org-clock-file-total-minutes (aref ltimes 0))))))
(defun org-clock-sum-current-item (&optional tstart)
@ -2109,7 +2131,7 @@ fontified, and then returned."
(org-mode)
(org-create-dblock props)
(org-update-dblock)
(org-font-lock-ensure)
(font-lock-ensure)
(forward-line 2)
(buffer-substring (point) (progn
(re-search-forward "^[ \t]*#\\+END" nil t)
@ -2123,10 +2145,12 @@ If point is inside an existing clocktable block, update it.
Otherwise, insert a new one.
The new table inherits its properties from the variable
`org-clock-clocktable-default-properties'. The scope of the
clocktable, when not specified in the previous variable, is
`subtree' when the function is called from within a subtree, and
`file' elsewhere.
`org-clock-clocktable-default-properties'.
The scope of the clocktable, when not specified in the previous
variable, is `subtree' of the current heading when the function is
called from inside heading, and `file' elsewhere (before the first
heading).
When called with a prefix argument, move to the first clock table
in the buffer and update it."
@ -2134,7 +2158,7 @@ in the buffer and update it."
(org-clock-remove-overlays)
(when arg
(org-find-dblock "clocktable")
(org-show-entry))
(org-fold-show-entry))
(pcase (org-in-clocktable-p)
(`nil
(org-create-dblock
@ -2342,16 +2366,16 @@ have priority."
(let* ((start (pcase key
(`interactive (org-read-date nil t nil "Range start? "))
(`untilnow nil)
(_ (encode-time 0 m h d month y))))
(_ (org-encode-time 0 m h d month y))))
(end (pcase key
(`interactive (org-read-date nil t nil "Range end? "))
(`untilnow (current-time))
(_ (encode-time 0
m ;; (or m1 m)
(or h1 h)
(or d1 d)
(or month1 month)
(or y1 y)))))
(_ (org-encode-time 0
m ;; (or m1 m)
(or h1 h)
(or d1 d)
(or month1 month)
(or y1 y)))))
(text
(pcase key
((or `day `today) (format-time-string "%A, %B %d, %Y" start))
@ -2364,7 +2388,7 @@ have priority."
(`interactive "(Range interactively set)")
(`untilnow "now"))))
(if (not as-strings) (list start end text)
(let ((f (cdr org-time-stamp-formats)))
(let ((f (org-time-stamp-format 'with-time)))
(list (and start (format-time-string f start))
(format-time-string f end)
text))))))
@ -2419,14 +2443,14 @@ the currently selected interval size."
(cond
(d (setq ins (format-time-string
"%Y-%m-%d"
(encode-time 0 0 0 (+ d n) nil y)))) ;; m
(org-encode-time 0 0 0 (+ d n) nil y)))) ;; m
((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
(require 'cal-iso)
(setq date (calendar-gregorian-from-absolute
(calendar-iso-to-absolute (list (+ mw n) 1 y))))
(setq ins (format-time-string
"%G-W%V"
(encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
(org-encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
(require 'cal-iso)
; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year
@ -2443,11 +2467,11 @@ the currently selected interval size."
(calendar-iso-to-absolute (org-quarter-to-date (+ mw n) y))))
(setq ins (format-time-string
(concat (number-to-string y) "-Q" (number-to-string (+ mw n)))
(encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
(org-encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
(mw
(setq ins (format-time-string
"%Y-%m"
(encode-time 0 0 0 1 (+ mw n) y))))
(org-encode-time 0 0 0 1 (+ mw n) y))))
(y
(setq ins (number-to-string (+ y n))))))
(t (user-error "Cannot shift clocktable block")))
@ -2574,6 +2598,7 @@ from the dynamic block definition."
(emph (plist-get params :emphasize))
(compact? (plist-get params :compact))
(narrow (or (plist-get params :narrow) (and compact? '40!)))
(filetitle (plist-get params :filetitle))
(level? (and (not compact?) (plist-get params :level)))
(timestamp (plist-get params :timestamp))
(tags (plist-get params :tags))
@ -2713,7 +2738,10 @@ from the dynamic block definition."
(if (eq formula '%) " %s |" "")
"\n")
(file-name-nondirectory file-name)
(if filetitle
(or (org-get-title file-name)
(file-name-nondirectory file-name))
(file-name-nondirectory file-name))
(if level? "| " "") ;level column, maybe
(if timestamp "| " "") ;timestamp column, maybe
(if tags "| " "") ;tags column, maybe
@ -2819,6 +2847,7 @@ a number of clock tables."
(`semimonth "Semimonthly report starting on: ")
(`month "Monthly report starting on: ")
(`year "Annual report starting on: ")
(`quarter "Quarterly report starting on: ")
(_ (user-error "Unknown `:step' specification: %S" step))))
(week-start (or (plist-get params :wstart) 1))
(month-start (or (plist-get params :mstart) 1))
@ -2835,7 +2864,7 @@ a number of clock tables."
(pcase (if range (car range) (plist-get params :tstart))
((and (pred numberp) n)
(pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
(encode-time 0 0 org-extend-today-until d m y)))
(org-encode-time 0 0 org-extend-today-until d m y)))
(timestamp
(seconds-to-time
(org-matcher-time (or timestamp
@ -2845,7 +2874,7 @@ a number of clock tables."
(pcase (if range (nth 1 range) (plist-get params :tend))
((and (pred numberp) n)
(pcase-let ((`(,m ,d ,y) (calendar-gregorian-from-absolute n)))
(encode-time 0 0 org-extend-today-until d m y)))
(org-encode-time 0 0 org-extend-today-until d m y)))
(timestamp (seconds-to-time (org-matcher-time timestamp))))))
(while (time-less-p start end)
(unless (bolp) (insert "\n"))
@ -2857,20 +2886,22 @@ a number of clock tables."
;; Compute NEXT, which is the end of the current clock table,
;; according to step.
(let* ((next
(apply #'encode-time
(pcase-let
((`(,_ ,_ ,_ ,d ,m ,y ,dow . ,_) (decode-time start)))
(pcase step
(`day (list 0 0 org-extend-today-until (1+ d) m y))
(`week
(let ((offset (if (= dow week-start) 7
(mod (- week-start dow) 7))))
(list 0 0 org-extend-today-until (+ d offset) m y)))
(`semimonth (list 0 0 0
(if (< d 16) 16 1)
(if (< d 16) m (1+ m)) y))
(`month (list 0 0 0 month-start (1+ m) y))
(`year (list 0 0 org-extend-today-until 1 1 (1+ y)))))))
;; In Emacs-27 and Emacs-28 `encode-time' does not support 6 elements
;; list argument so `org-encode-time' can not be outside of `pcase'.
(pcase-let
((`(,_ ,_ ,_ ,d ,m ,y ,dow . ,_) (decode-time start)))
(pcase step
(`day (org-encode-time 0 0 org-extend-today-until (1+ d) m y))
(`week
(let ((offset (if (= dow week-start) 7
(mod (- week-start dow) 7))))
(org-encode-time 0 0 org-extend-today-until (+ d offset) m y)))
(`semimonth (org-encode-time 0 0 0
(if (< d 16) 16 1)
(if (< d 16) m (1+ m)) y))
(`month (org-encode-time 0 0 0 month-start (1+ m) y))
(`quarter (org-encode-time 0 0 0 month-start (+ 3 m) y))
(`year (org-encode-time 0 0 org-extend-today-until 1 1 (1+ y))))))
(table-begin (line-beginning-position 0))
(step-time
;; Write clock table between START and NEXT.
@ -3035,20 +3066,31 @@ Otherwise, return nil."
(org-time-string-to-time (match-string 1)))
(org-clock-update-mode-line)))
(t
(and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
(end-of-line 1)
(setq ts (match-string 1)
te (match-string 3))
(setq s (- (float-time
(apply #'encode-time (org-parse-time-string te)))
(float-time
(apply #'encode-time (org-parse-time-string ts))))
neg (< s 0)
s (abs s)
h (floor (/ s 3600))
s (- s (* 3600 h))
m (floor (/ s 60))
s (- s (* 60 s)))
;; Prevent recursive call from `org-timestamp-change'.
(cl-letf (((symbol-function 'org-clock-update-time-maybe) #'ignore))
;; Update timestamps.
(save-excursion
(goto-char (match-beginning 1)) ; opening timestamp
(save-match-data (org-timestamp-change 0 'day)))
;; Refresh match data.
(looking-at re)
(save-excursion
(goto-char (match-beginning 3)) ; closing timestamp
(save-match-data (org-timestamp-change 0 'day))))
;; Refresh match data.
(looking-at re)
(and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
(end-of-line 1)
(setq ts (match-string 1)
te (match-string 3))
(setq s (- (org-time-string-to-seconds te)
(org-time-string-to-seconds ts))
neg (< s 0)
s (abs s)
h (floor (/ s 3600))
s (- s (* 3600 h))
m (floor (/ s 60))
s (- s (* 60 s)))
(insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
t))))))
@ -3119,7 +3161,7 @@ The details of what will be saved are regulated by the variable
(let ((org-clock-in-resume 'auto-restart)
(org-clock-auto-clock-resolution nil))
(org-clock-in)
(when (org-invisible-p) (org-show-context))))))
(when (org-invisible-p) (org-fold-show-context))))))
(_ nil)))))
(defun org-clock-kill-emacs-query ()

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

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -28,6 +28,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'org)
@ -159,8 +162,8 @@ See `org-columns-summary-types' for details.")
(defun org-columns-content ()
"Switch to contents view while in columns view."
(interactive)
(org-overview)
(org-content))
(org-cycle-overview)
(org-cycle-content))
(org-defkey org-columns-map "c" #'org-columns-content)
(org-defkey org-columns-map "o" #'org-overview)
@ -377,7 +380,8 @@ This is needed to later remove this relative remapping.")
COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument
DATELINE is non-nil when the face used should be
`org-agenda-column-dateline'."
(when (ignore-errors (require 'face-remap))
(when (and (ignore-errors (require 'face-remap))
org-columns-header-line-remap)
(setq org-columns-header-line-remap
(face-remap-add-relative 'header-line '(:inherit default))))
(save-excursion
@ -512,9 +516,9 @@ for the duration of the command.")
(defun org-columns-remove-overlays ()
"Remove all currently active column overlays."
(interactive)
(when (and (fboundp 'face-remap-remove-relative)
org-columns-header-line-remap)
(face-remap-remove-relative org-columns-header-line-remap))
(when org-columns-header-line-remap
(face-remap-remove-relative org-columns-header-line-remap)
(setq org-columns-header-line-remap nil))
(when org-columns-overlays
(when (local-variable-p 'org-previous-header-line-format)
(setq header-line-format org-previous-header-line-format)
@ -556,7 +560,7 @@ for the duration of the command.")
(defun org-columns-check-computed ()
"Throw an error if current column value is computed."
(let ((spec (nth (current-column) org-columns-current-fmt-compiled)))
(let ((spec (nth (org-current-text-column) org-columns-current-fmt-compiled)))
(and
(nth 3 spec)
(assoc spec (get-text-property (line-beginning-position) 'org-summaries))
@ -697,9 +701,9 @@ FUN is a function called with no argument."
(let ((hide-body (and (/= (line-end-position) (point-max))
(save-excursion
(move-beginning-of-line 2)
(org-at-heading-p t)))))
(org-at-heading-p)))))
(unwind-protect (funcall fun)
(when hide-body (outline-hide-entry)))))
(when hide-body (org-fold-hide-entry)))))
(defun org-columns-previous-allowed-value ()
"Switch to the previous allowed value for this column."
@ -712,7 +716,8 @@ When PREVIOUS is set, go to the previous value. When NTH is
an integer, select that value."
(interactive)
(org-columns-check-computed)
(let* ((column (current-column))
(let* ((column (org-current-text-column))
(visible-column (current-column))
(key (get-char-property (point) 'org-columns-key))
(value (get-char-property (point) 'org-columns-value))
(pom (or (get-text-property (line-beginning-position) 'org-hd-marker)
@ -762,7 +767,7 @@ an integer, select that value."
;; the right place on the current line.
(let ((org-columns-inhibit-recalculation)) (org-columns-redo))
(org-columns-update key)
(org-move-to-column column))))))
(org-move-to-column visible-column))))))
(defun org-colview-construct-allowed-dates (s)
"Construct a list of three dates around the date in S.
@ -772,9 +777,8 @@ around it."
(when (and s (string-match (concat "^" org-ts-regexp3 "$") s))
(let* ((time (org-parse-time-string s 'nodefaults))
(active (equal (string-to-char s) ?<))
(fmt (funcall (if (nth 1 time) 'cdr 'car) org-time-stamp-formats))
(fmt (org-time-stamp-format (nth 1 time) (not active)))
time-before time-after)
(unless active (setq fmt (concat "[" (substring fmt 1 -1) "]")))
(setf (car time) (or (car time) 0))
(setf (nth 1 time) (or (nth 1 time) 0))
(setf (nth 2 time) (or (nth 2 time) 0))
@ -782,7 +786,7 @@ around it."
(setq time-after (copy-sequence time))
(setf (nth 3 time-before) (1- (nth 3 time)))
(setf (nth 3 time-after) (1+ (nth 3 time)))
(mapcar (lambda (x) (format-time-string fmt (apply #'encode-time x)))
(mapcar (lambda (x) (format-time-string fmt (org-encode-time x)))
(list time-before time time-after)))))
(defun org-columns-open-link (&optional arg)
@ -924,14 +928,14 @@ details."
(if spec
(progn (setcar spec (car new))
(setcdr spec (cdr new)))
(push new (nthcdr (current-column) org-columns-current-fmt-compiled)))
(push new (nthcdr (org-current-text-column) org-columns-current-fmt-compiled)))
(org-columns-store-format)
(org-columns-redo)))
(defun org-columns-delete ()
"Delete the column at point from columns view."
(interactive)
(let ((spec (nth (current-column) org-columns-current-fmt-compiled)))
(let ((spec (nth (org-current-text-column) org-columns-current-fmt-compiled)))
(when (y-or-n-p (format "Are you sure you want to remove column %S? "
(nth 1 spec)))
(setq org-columns-current-fmt-compiled
@ -941,18 +945,18 @@ details."
;; updating it may prove counter-intuitive. See comments in
;; `org-columns-move-right' for details.
(let ((org-columns-inhibit-recalculation t)) (org-columns-redo))
(when (>= (current-column) (length org-columns-current-fmt-compiled))
(when (>= (org-current-text-column) (length org-columns-current-fmt-compiled))
(backward-char)))))
(defun org-columns-edit-attributes ()
"Edit the attributes of the current column."
(interactive)
(org-columns-new (nth (current-column) org-columns-current-fmt-compiled)))
(org-columns-new (nth (org-current-text-column) org-columns-current-fmt-compiled)))
(defun org-columns-widen (arg)
"Make the column wider by ARG characters."
(interactive "p")
(let* ((n (current-column))
(let* ((n (org-current-text-column))
(entry (nth n org-columns-current-fmt-compiled))
(width (aref org-columns-current-maxwidths n)))
(setq width (max 1 (+ width arg)))
@ -968,7 +972,7 @@ details."
(defun org-columns-move-right ()
"Swap this column with the one to the right."
(interactive)
(let* ((n (current-column))
(let* ((n (org-current-text-column))
(cell (nthcdr n org-columns-current-fmt-compiled))
e)
(when (>= n (1- (length org-columns-current-fmt-compiled)))
@ -992,7 +996,7 @@ details."
(defun org-columns-move-left ()
"Swap this column with the one to the left."
(interactive)
(let* ((n (current-column)))
(let* ((n (org-current-text-column)))
(when (= n 0)
(error "Cannot shift this column further to the left"))
(backward-char 1)
@ -1024,7 +1028,7 @@ the current buffer."
;; No COLUMNS keyword in the buffer. Insert one at the
;; beginning, right before the first heading, if any.
(goto-char (point-min))
(unless (org-at-heading-p t) (outline-next-heading))
(unless (org-at-heading-p) (outline-next-heading))
(let ((inhibit-read-only t))
(insert-before-markers "#+COLUMNS: " fmt "\n"))))
(setq-local org-columns-default-format fmt))))))
@ -1038,7 +1042,7 @@ the current buffer."
(let ((key (overlay-get ov 'org-columns-key)))
(when (and key (equal key p) (overlay-start ov))
(goto-char (overlay-start ov))
(let* ((spec (nth (current-column) org-columns-current-fmt-compiled))
(let* ((spec (nth (org-current-text-column) org-columns-current-fmt-compiled))
(value
(or (cdr (assoc spec
(get-text-property (line-beginning-position)
@ -1048,7 +1052,7 @@ the current buffer."
(let ((displayed (org-columns--displayed-value spec value))
(format (overlay-get ov 'org-columns-format))
(width
(aref org-columns-current-maxwidths (current-column))))
(aref org-columns-current-maxwidths (org-current-text-column))))
(overlay-put ov 'org-columns-value value)
(overlay-put ov 'org-columns-value-modified displayed)
(overlay-put ov

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

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -29,9 +29,17 @@
;;; Code:
(require 'cl-lib)
(require 'seq)
(require 'org-macs)
(eval-when-compile (require 'subr-x)) ; Emacs < 28
;; We rely on org-compat when generating Org version. Checking Org
;; version here will interfere with Org build process.
;; (org-assert-version)
(declare-function org-agenda-diary-entry "org-agenda")
(declare-function org-agenda-maybe-redo "org-agenda" ())
(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
@ -40,7 +48,9 @@
(declare-function org-align-tags "org" (&optional all))
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-at-table.el-p "org-table" ())
(declare-function org-element-at-point "org-element" ())
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(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))
@ -48,18 +58,29 @@
(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))
(declare-function org-hide-block-toggle "org" (&optional force no-error element))
(declare-function org-fold-hide-block-toggle "org-fold" (&optional force no-error element))
(declare-function org-link-display-format "ol" (s))
(declare-function org-link-set-parameters "ol" (type &rest rest))
(declare-function org-log-into-drawer "org" ())
(declare-function org-make-tag-string "org" (tags))
(declare-function org-next-visible-heading "org" (arg))
(declare-function org-reduced-level "org" (l))
(declare-function org-return "org" (&optional indent arg interactive))
(declare-function org-show-context "org" (&optional key))
(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function org-table-end "org-table" (&optional table-type))
(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 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" ())
(declare-function org-fold-region "org-fold" (from to flag &optional spec))
(declare-function org-fold-show-all "org-fold" (&optional types))
(declare-function org-fold-show-children "org-fold" (&optional level))
(declare-function org-fold-show-entry "org-fold" (&optional hide-drawers))
;; `org-string-equal-ignore-case' is in _this_ file but isn't at the
;; top-level.
(declare-function org-string-equal-ignore-case "org-compat" (string1 string2))
(defvar calendar-mode-map)
(defvar org-complex-heading-regexp)
@ -70,6 +91,7 @@
(defvar org-table-dataline-regexp)
(defvar org-table-tab-recognizes-table.el)
(defvar org-table1-hline-regexp)
(defvar org-fold-core-style)
;;; Emacs < 29 compatibility
@ -99,10 +121,39 @@ the symbol of the calling function, for example."
(when (not (equal attr cachedattr))
(puthash sym attr org-file-has-changed-p--hash-table)))))
(if (fboundp 'string-equal-ignore-case)
(defalias 'org-string-equal-ignore-case #'string-equal-ignore-case)
;; From Emacs subr.el.
(defun org-string-equal-ignore-case (string1 string2)
"Like `string-equal', but case-insensitive.
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))))
;;; Emacs < 28.1 compatibility
(if (fboundp 'file-name-concat)
(defalias 'org-file-name-concat #'file-name-concat)
(defun org-file-name-concat (directory &rest components)
"Append COMPONENTS to DIRECTORY and return the resulting string.
Elements in COMPONENTS must be a string or nil.
DIRECTORY or the non-final elements in COMPONENTS may or may not end
with a slash -- if they don't end with a slash, a slash will be
inserted before contatenating."
(save-match-data
(mapconcat
#'identity
(delq nil
(mapcar
(lambda (str)
(when (and str (not (seq-empty-p str))
(string-match "\\(.+\\)/?" str))
(match-string 1 str)))
(cons directory components)))
"/"))))
(if (fboundp 'directory-empty-p)
(defalias 'org-directory-empty-p #'directory-empty-p)
(defun org-directory-empty-p (dir)
@ -110,9 +161,47 @@ the symbol of the calling function, for example."
(and (file-directory-p dir)
(null (directory-files dir nil directory-files-no-dot-files-regexp t)))))
(if (fboundp 'string-clean-whitespace)
(defalias 'org-string-clean-whitespace #'string-clean-whitespace)
;; From Emacs subr-x.el.
(defun org-string-clean-whitespace (string)
"Clean up whitespace in STRING.
All sequences of whitespaces in STRING are collapsed into a
single space character, and leading/trailing whitespace is
removed."
(let ((blank "[[:blank:]\r\n]+"))
(string-trim (replace-regexp-in-string blank " " string t t)
blank blank))))
(if (fboundp 'format-prompt)
(defalias 'org-format-prompt #'format-prompt)
;; From Emacs minibuffer.el, inlining
;; `minibuffer-default-prompt-format' value and replacing `length<'
;; (both new in Emacs 28.1).
(defun org-format-prompt (prompt default &rest format-args)
"Compatibility substitute for `format-prompt'."
(concat
(if (null format-args)
prompt
(apply #'format prompt format-args))
(and default
(or (not (stringp default))
(> (length default) 0))
(format " (default %s)"
(if (consp default)
(car default)
default)))
": ")))
;;; Emacs < 27.1 compatibility
(unless (fboundp 'combine-change-calls)
;; A stub when `combine-change-calls' was not yet there.
(defmacro combine-change-calls (_beg _end &rest body)
(declare (debug (form form def-body)) (indent 2))
`(progn ,@body)))
(if (version< emacs-version "27.1")
(defsubst org-replace-buffer-contents (source &optional _max-secs _max-costs)
(replace-buffer-contents source))
@ -189,6 +278,16 @@ extension beyond end of line was not controllable."
(define-obsolete-function-alias 'org-babel-edit-distance 'org-string-distance
"9.5")
(unless (fboundp 'with-connection-local-variables)
;; Added in Emacs 27: commit:21f54feee8, 2019-03-09.
;; Redefining it using the old function `with-connection-local-profiles'.
(defmacro with-connection-local-variables (&rest body)
"Apply connection-local variables according to `default-directory'.
Execute BODY, and unwind connection-local variables."
(declare (debug t))
`(with-connection-local-profiles (connection-local-get-profiles nil)
,@body)))
;;; Emacs < 26.1 compatibility
@ -213,70 +312,6 @@ is a Lisp timestamp in the same style as `current-time'."
This is a floating point number if the size is too large for an integer."
(nth 7 attributes)))
;;; Emacs < 25.1 compatibility
(when (< emacs-major-version 25)
(defalias 'outline-hide-entry 'hide-entry)
(defalias 'outline-hide-sublevels 'hide-sublevels)
(defalias 'outline-hide-subtree 'hide-subtree)
(defalias 'outline-show-branches 'show-branches)
(defalias 'outline-show-children 'show-children)
(defalias 'outline-show-entry 'show-entry)
(defalias 'outline-show-subtree 'show-subtree)
(defalias 'xref-find-definitions 'find-tag)
(defalias 'format-message 'format)
(defalias 'gui-get-selection 'x-get-selection))
(unless (fboundp 'directory-name-p)
(defun directory-name-p (name)
"Return non-nil if NAME ends with a directory separator character."
(let ((len (length name))
(lastc ?.))
(if (> len 0)
(setq lastc (aref name (1- len))))
(or (= lastc ?/)
(and (memq system-type '(windows-nt ms-dos))
(= lastc ?\\))))))
;; `string-collate-lessp' is new in Emacs 25.
(if (fboundp 'string-collate-lessp)
(defalias 'org-string-collate-lessp
'string-collate-lessp)
(defun org-string-collate-lessp (s1 s2 &optional _ _)
"Return non-nil if STRING1 is less than STRING2 in lexicographic order.
Case is significant."
(string< s1 s2)))
;; The time- functions below translate nil to 'current-time' and
;; accept an integer as of Emacs 25. 'decode-time' and
;; 'format-time-string' accept nil on Emacs 24 but don't accept an
;; integer until Emacs 25.
(if (< emacs-major-version 25)
(let ((convert
(lambda (time)
(cond ((not time) (current-time))
((numberp time) (seconds-to-time time))
(t time)))))
(defun org-decode-time (&optional time)
(decode-time (funcall convert time)))
(defun org-format-time-string (format-string &optional time universal)
(format-time-string format-string (funcall convert time) universal))
(defun org-time-add (a b)
(time-add (funcall convert a) (funcall convert b)))
(defun org-time-subtract (a b)
(time-subtract (funcall convert a) (funcall convert b)))
(defun org-time-since (time)
(time-since (funcall convert time)))
(defun org-time-less-p (t1 t2)
(time-less-p (funcall convert t1) (funcall convert t2))))
(defalias 'org-decode-time 'decode-time)
(defalias 'org-format-time-string 'format-time-string)
(defalias 'org-time-add 'time-add)
(defalias 'org-time-subtract 'time-subtract)
(defalias 'org-time-since 'time-since)
(defalias 'org-time-less-p 'time-less-p))
;;; Obsolete aliases (remove them after the next major release).
@ -298,6 +333,11 @@ Case is significant."
(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "9.0")
(define-obsolete-function-alias 'org-file-remote-p 'file-remote-p "9.2")
(define-obsolete-function-alias 'org-show-context 'org-fold-show-context "9.6")
(define-obsolete-function-alias 'org-show-entry 'org-fold-show-entry "9.6")
(define-obsolete-function-alias 'org-show-children 'org-fold-show-children "9.6")
(defmacro org-re (s)
"Replace posix classes in regular expression S."
(declare (debug (form))
@ -322,6 +362,14 @@ Counting starts at 1."
"use cl-subseq (note the 0-based counting)."
"9.0")
;;;; Functions available since Emacs 25.1
(define-obsolete-function-alias 'org-string-collate-lessp 'string-collate-lessp "9.6")
(define-obsolete-function-alias 'org-decode-time 'decode-time "9.6")
(define-obsolete-function-alias 'org-format-time-string 'format-time-string "9.6")
(define-obsolete-function-alias 'org-time-add 'time-add "9.6")
(define-obsolete-function-alias 'org-time-subtract 'time-subtract "9.6")
(define-obsolete-function-alias 'org-time-since 'time-since "9.6")
(define-obsolete-function-alias 'org-time-less-p 'time-less-p "9.6")
;;;; Functions available since Emacs 24.3
(define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "9.0")
@ -336,12 +384,20 @@ 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-function-alias 'org-timestamp-format
'org-format-timestamp "Org 9.6")
(define-obsolete-variable-alias 'org-export-before-processing-hook
'org-export-before-processing-functions "Org 9.6")
(define-obsolete-variable-alias 'org-export-before-parsing-hook
'org-export-before-parsing-functions "Org 9.6")
(define-obsolete-function-alias 'org-element-remove-indentation
'org-remove-indentation "9.0")
(define-obsolete-variable-alias 'org-latex-create-formula-image-program
'org-preview-latex-default-process "9.0")
(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory
'org-preview-latex-image-directory "9.0")
(define-obsolete-variable-alias 'org-latex-listings
'org-latex-src-block-backend "9.6")
(define-obsolete-function-alias 'org-table-p 'org-at-table-p "9.0")
(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "9.0")
(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "8.3")
@ -399,6 +455,80 @@ Counting starts at 1."
(define-obsolete-function-alias 'org-remove-latex-fragment-image-overlays
'org-clear-latex-preview "9.3")
(define-obsolete-function-alias 'org-hide-archived-subtrees
'org-fold-hide-archived-subtrees "9.6")
(define-obsolete-function-alias 'org-flag-region
'org-fold-region "9.6")
(define-obsolete-function-alias 'org-flag-subtree
'org-fold-subtree "9.6")
(define-obsolete-function-alias 'org-hide-entry
'org-fold-hide-entry "9.6")
(define-obsolete-function-alias 'org-show-subtree
'org-fold-show-subtree "9.6")
(define-obsolete-function-alias 'org--hide-wrapper-toggle
'org-fold--hide-wrapper-toggle "9.6")
(define-obsolete-function-alias 'org-hide-block-toggle
'org-fold-hide-block-toggle "9.6")
(define-obsolete-function-alias 'org-hide-drawer-toggle
'org-fold-hide-drawer-toggle "9.6")
(define-obsolete-function-alias 'org--hide-drawers
'org-fold--hide-drawers "9.6")
(define-obsolete-function-alias 'org-hide-block-all
'org-fold-hide-block-all "9.6")
(define-obsolete-function-alias 'org-hide-drawer-all
'org-fold-hide-drawer-all "9.6")
(define-obsolete-function-alias 'org-show-all
'org-fold-show-all "9.6")
(define-obsolete-function-alias 'org-set-startup-visibility
'org-cycle-set-startup-visibility "9.6")
(define-obsolete-function-alias 'org-show-set-visibility
'org-fold-show-set-visibility "9.6")
(define-obsolete-function-alias 'org-check-before-invisible-edit
'org-fold-check-before-invisible-edit "9.6")
(define-obsolete-function-alias 'org-flag-above-first-heading
'org-fold-flag-above-first-heading "9.6")
(define-obsolete-function-alias 'org-show-branches-buffer
'org-fold-show-branches-buffer "9.6")
(define-obsolete-function-alias 'org-show-siblings
'org-fold-show-siblings "9.6")
(define-obsolete-function-alias 'org-show-hidden-entry
'org-fold-show-hidden-entry "9.6")
(define-obsolete-function-alias 'org-flag-heading
'org-fold-heading "9.6")
(define-obsolete-function-alias 'org-set-startup-visibility
'org-cycle-set-startup-visibility "9.6")
(define-obsolete-function-alias 'org-set-visibility-according-to-property
'org-cycle-set-visibility-according-to-property "9.6")
(define-obsolete-variable-alias 'org-scroll-position-to-restore
'org-cycle-scroll-position-to-restore "9.6")
(define-obsolete-function-alias 'org-optimize-window-after-visibility-change
'org-cycle-optimize-window-after-visibility-change "9.6")
(define-obsolete-function-alias 'org-force-cycle-archived
'org-cycle-force-archived "9.6")
(define-obsolete-variable-alias 'org-attach-directory
'org-attach-id-dir "9.3")
(make-obsolete 'org-attach-store-link "No longer used" "9.4")
@ -406,6 +536,17 @@ Counting starts at 1."
(define-obsolete-function-alias 'org-file-url-p 'org-url-p "9.5")
(define-obsolete-variable-alias 'org-show-context-detail
'org-fold-show-context-detail "9.6")
(define-obsolete-variable-alias 'org-catch-invisible-edits
'org-fold-catch-invisible-edits "9.6")
(define-obsolete-variable-alias 'org-reveal-start-hook
'org-fold-reveal-start-hook "9.6")
(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")
(defun org-in-fixed-width-region-p ()
"Non-nil if point in a fixed-width region."
(save-match-data
@ -414,6 +555,19 @@ Counting starts at 1."
"use `org-element' library"
"9.0")
;; FIXME: Unused; obsoleted; to be removed.
(defun org-let (list &rest body) ;FIXME: So many kittens are suffering here.
(declare (indent 1) (obsolete cl-progv "2021"))
(eval (cons 'let (cons list body))))
;; FIXME: Unused; obsoleted; to be removed.
(defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go?
(declare (indent 2) (obsolete cl-progv "2021"))
(eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
(make-obsolete 'org-let "to be removed" "9.6")
(make-obsolete 'org-let2 "to be removed" "9.6")
(defun org-compatible-face (inherits specs)
"Make a compatible face specification.
If INHERITS is an existing face and if the Emacs version supports
@ -682,7 +836,7 @@ use of this function is for the stuck project list."
(defun org-show-block-all ()
"Unfold all blocks in the current buffer."
(interactive)
(remove-overlays nil nil 'invisible 'org-hide-block))
(org-fold-show-all '(blocks)))
(make-obsolete 'org-show-block-all
"use `org-show-all' instead."
@ -725,7 +879,7 @@ 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-flag-region beg end flag 'outline)
(if (and beg end) (org-fold-region beg end flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
(let ((drawer
(or element
(and (save-excursion
@ -734,12 +888,12 @@ region as a drawer without further ado."
(org-element-at-point)))))
(when (memq (org-element-type drawer) '(drawer property-drawer))
(let ((post (org-element-property :post-affiliated drawer)))
(org-flag-region
(org-fold-region
(save-excursion (goto-char post) (line-end-position))
(save-excursion (goto-char (org-element-property :end drawer))
(skip-chars-backward " \t\n")
(line-end-position))
flag 'outline)
flag (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))
;; 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)))
@ -751,7 +905,7 @@ Unlike to `org-hide-block-toggle', this function does not throw
an error. Return a non-nil value when toggling is successful."
(declare (obsolete "use `org-hide-block-toggle' instead." "9.4"))
(interactive)
(org-hide-block-toggle nil t))
(org-fold-hide-block-toggle nil t))
(defun org-hide-block-toggle-all ()
"Toggle the visibility of all blocks in the current buffer."
@ -767,7 +921,7 @@ an error. Return a non-nil value when toggling is successful."
(save-excursion
(save-match-data
(goto-char (match-beginning 0))
(org-hide-block-toggle)))))))
(org-fold-hide-block-toggle)))))))
(defun org-return-indent ()
"Goto next table row or insert a newline and indent.
@ -807,6 +961,159 @@ context. See the individual commands for more information."
(define-obsolete-function-alias 'org-get-last-sibling 'org-get-previous-sibling "9.4")
(define-obsolete-function-alias 'org-publish-cache-ctime-of-src
'org-publish-cache-mtime-of-src "9.6")
(define-obsolete-function-alias 'org-truely-invisible-p
'org-truly-invisible-p "9.6"
"Compatibility alias for legacy misspelling of `org-truly-invisible-p'.")
(defconst org-latex-babel-language-alist
'(("af" . "afrikaans")
("bg" . "bulgarian")
("ca" . "catalan")
("cs" . "czech")
("cy" . "welsh")
("da" . "danish")
("de" . "germanb")
("de-at" . "naustrian")
("de-de" . "ngerman")
("el" . "greek")
("en" . "english")
("en-au" . "australian")
("en-ca" . "canadian")
("en-gb" . "british")
("en-ie" . "irish")
("en-nz" . "newzealand")
("en-us" . "american")
("es" . "spanish")
("et" . "estonian")
("eu" . "basque")
("fi" . "finnish")
("fr" . "french")
("fr-ca" . "canadien")
("gl" . "galician")
("hr" . "croatian")
("hu" . "hungarian")
("id" . "indonesian")
("is" . "icelandic")
("it" . "italian")
("la" . "latin")
("ms" . "malay")
("nl" . "dutch")
("nb" . "norsk")
("nn" . "nynorsk")
("no" . "norsk")
("pl" . "polish")
("pt" . "portuguese")
("pt-br" . "brazilian")
("ro" . "romanian")
("ru" . "russian")
("sa" . "sanskrit")
("sb" . "uppersorbian")
("sk" . "slovak")
("sl" . "slovene")
("sq" . "albanian")
("sr" . "serbian")
("sv" . "swedish")
("ta" . "tamil")
("tr" . "turkish")
("uk" . "ukrainian"))
"Alist between language code and corresponding Babel option.")
(defconst org-latex-polyglossia-language-alist
'(("am" "amharic")
("ar" "arabic")
("ast" "asturian")
("bg" "bulgarian")
("bn" "bengali")
("bo" "tibetan")
("br" "breton")
("ca" "catalan")
("cop" "coptic")
("cs" "czech")
("cy" "welsh")
("da" "danish")
("de" "german" "german")
("de-at" "german" "austrian")
("de-de" "german" "german")
("dsb" "lsorbian")
("dv" "divehi")
("el" "greek")
("en" "english" "usmax")
("en-au" "english" "australian")
("en-gb" "english" "uk")
("en-nz" "english" "newzealand")
("en-us" "english" "usmax")
("eo" "esperanto")
("es" "spanish")
("et" "estonian")
("eu" "basque")
("fa" "farsi")
("fi" "finnish")
("fr" "french")
("fu" "friulan")
("ga" "irish")
("gd" "scottish")
("gl" "galician")
("he" "hebrew")
("hi" "hindi")
("hr" "croatian")
("hsb" "usorbian")
("hu" "magyar")
("hy" "armenian")
("ia" "interlingua")
("id" "bahasai")
("is" "icelandic")
("it" "italian")
("kn" "kannada")
("la" "latin" "modern")
("la-classic" "latin" "classic")
("la-medieval" "latin" "medieval")
("la-modern" "latin" "modern")
("lo" "lao")
("lt" "lithuanian")
("lv" "latvian")
("ml" "malayalam")
("mr" "maranthi")
("nb" "norsk")
("nko" "nko")
("nl" "dutch")
("nn" "nynorsk")
("no" "norsk")
("oc" "occitan")
("pl" "polish")
("pms" "piedmontese")
("pt" "portuges")
("pt-br" "brazilian")
("rm" "romansh")
("ro" "romanian")
("ru" "russian")
("sa" "sanskrit")
("se" "samin")
("sk" "slovak")
("sl" "slovenian")
("sq" "albanian")
("sr" "serbian")
("sv" "swedish")
("syr" "syriac")
("ta" "tamil")
("te" "telugu")
("th" "thai")
("tk" "turkmen")
("tr" "turkish")
("uk" "ukrainian")
("ur" "urdu")
("vi" "vietnamese"))
"Alist between language code and corresponding Polyglossia option.")
(make-obsolete-variable 'org-latex-babel-language-alist
"set `org-latex-language-alist' instead." "9.6")
(make-obsolete-variable 'org-latex-polyglossia-language-alist
"set `org-latex-language-alist' instead." "9.6")
;;;; Obsolete link types
(eval-after-load 'ol
@ -815,6 +1122,8 @@ context. See the individual commands for more information."
(org-link-set-parameters "file+sys"))) ;since Org 9.0
;;; Miscellaneous functions
@ -831,12 +1140,6 @@ context. See the individual commands for more information."
((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
(w32-get-clipboard-data))))
;; `set-transient-map' is only in Emacs >= 24.4
(defalias 'org-set-transient-map
(if (fboundp 'set-transient-map)
'set-transient-map
'set-temporary-overlay-map))
;;; Region compatibility
@ -888,13 +1191,6 @@ Pass COLUMN and FORCE to `move-to-column'."
string)
(apply 'kill-new string args))
;; `font-lock-ensure' is only available from 24.4.50 on
(defalias 'org-font-lock-ensure
(if (fboundp 'font-lock-ensure)
#'font-lock-ensure
(lambda (&optional _beg _end)
(with-no-warnings (font-lock-fontify-buffer)))))
;; `file-local-name' was added in Emacs 26.1.
(defalias 'org-babel-local-file-name
(if (fboundp 'file-local-name)
@ -921,37 +1217,8 @@ Pass COLUMN and FORCE to `move-to-column'."
(defun org-release () "N/A")
(defun org-git-version () "N/A !!check installation!!"))))))
;;; Functions for Emacs < 24.4 compatibility
(defun org-define-error (name message)
"Define NAME as a new error signal.
MESSAGE is a string that will be output to the echo area if such
an error is signaled without being caught by a `condition-case'.
Implements `define-error' for older emacsen."
(if (fboundp 'define-error) (define-error name message)
(put name 'error-conditions
(copy-sequence (cons name (get 'error 'error-conditions))))))
(unless (fboundp 'string-equal-ignore-case)
;; From Emacs subr.el.
(defun string-equal-ignore-case (string1 string2)
"Like `string-equal', but case-insensitive.
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))))
(unless (fboundp 'string-suffix-p)
;; From Emacs subr.el.
(defun string-suffix-p (suffix string &optional ignore-case)
"Return non-nil if SUFFIX is a suffix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
(let ((start-pos (- (length string) (length suffix))))
(and (>= start-pos 0)
(eq t (compare-strings suffix nil nil
string start-pos nil ignore-case))))))
(define-obsolete-function-alias 'org-define-error #'define-error "9.6")
(define-obsolete-function-alias 'org-without-partial-completion 'progn "9.6")
;;; Integration with and fixes for other packages
@ -964,7 +1231,6 @@ attention to case differences."
(defcustom org-imenu-depth 2
"The maximum level for Imenu access to Org headlines.
This also applied for speedbar access."
:group 'org-imenu-and-speedbar
:type 'integer)
;;;; Imenu
@ -1004,7 +1270,7 @@ This also applied for speedbar access."
(add-hook 'imenu-after-jump-hook
(lambda ()
(when (derived-mode-p 'org-mode)
(org-show-context 'org-goto))))
(org-fold-show-context 'org-goto))))
(add-hook 'org-mode-hook
(lambda ()
(setq imenu-create-index-function 'org-imenu-get-tree)))))
@ -1069,7 +1335,7 @@ To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
(define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
(define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
(add-hook 'speedbar-visiting-tag-hook
(lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
(lambda () (and (derived-mode-p 'org-mode) (org-fold-show-context 'org-goto))))))
;;;; Add Log
@ -1117,8 +1383,8 @@ ELEMENT is the element at point."
(or (not (match-beginning 5))
(< (point) (match-beginning 5)))
;; Ignore checks in code, verbatim and others.
(org--flyspell-object-check-p (org-element-at-point)))
(let* ((element (org-element-at-point))
(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)))
(cond
;; Ignore checks in all affiliated keywords but captions.
@ -1133,7 +1399,7 @@ ELEMENT is the element at point."
(and log
(let ((drawer (org-element-lineage element '(drawer))))
(and drawer
(string-equal-ignore-case
(org-string-equal-ignore-case
log (org-element-property :drawer-name drawer))))))
nil)
(t
@ -1175,16 +1441,16 @@ ELEMENT is the element at point."
;;;; Bookmark
(defun org-bookmark-jump-unhide ()
(defun org-bookmark-jump-unhide (&rest _)
"Unhide the current position, to show the bookmark location."
(and (derived-mode-p 'org-mode)
(or (org-invisible-p)
(save-excursion (goto-char (max (point-min) (1- (point))))
(org-invisible-p)))
(org-show-context 'bookmark-jump)))
(org-fold-show-context 'bookmark-jump)))
;; Make `bookmark-jump' shows the jump location if it was hidden.
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
(add-hook 'bookmark-after-jump-hook #'org-bookmark-jump-unhide)
;;;; Calendar
@ -1237,42 +1503,29 @@ key."
;;;; Saveplace
;; Make sure saveplace shows the location if it was hidden
(eval-after-load 'saveplace
'(defadvice save-place-find-file-hook (after org-make-visible activate)
"Make the position visible."
(org-bookmark-jump-unhide)))
(advice-add 'save-place-find-file-hook :after #'org-bookmark-jump-unhide)
;;;; Ecb
;; Make sure ecb shows the location if it was hidden
(eval-after-load 'ecb
'(defadvice ecb-method-clicked (after esf/org-show-context activate)
"Make hierarchy visible when jumping into location from ECB tree buffer."
(when (derived-mode-p 'org-mode)
(org-show-context))))
(advice-add 'ecb-method-clicked :after #'org--ecb-show-context)
(defun org--ecb-show-context (&rest _)
"Make hierarchy visible when jumping into location from ECB tree buffer."
(when (derived-mode-p 'org-mode)
(org-fold-show-context)))
;;;; Simple
(defun org-mark-jump-unhide ()
(defun org-mark-jump-unhide (&rest _)
"Make the point visible with `org-show-context' after jumping to the mark."
(when (and (derived-mode-p 'org-mode)
(org-invisible-p))
(org-show-context 'mark-goto)))
(org-fold-show-context 'mark-goto)))
(eval-after-load 'simple
'(defadvice pop-to-mark-command (after org-make-visible activate)
"Make the point visible with `org-show-context'."
(org-mark-jump-unhide)))
(advice-add 'pop-to-mark-command :after #'org-mark-jump-unhide)
(eval-after-load 'simple
'(defadvice exchange-point-and-mark (after org-make-visible activate)
"Make the point visible with `org-show-context'."
(org-mark-jump-unhide)))
(eval-after-load 'simple
'(defadvice pop-global-mark (after org-make-visible activate)
"Make the point visible with `org-show-context'."
(org-mark-jump-unhide)))
(advice-add 'exchange-point-and-mark :after #'org-mark-jump-unhide)
(advice-add 'pop-global-mark :after #'org-mark-jump-unhide)
;;;; Session
@ -1281,11 +1534,82 @@ key."
(eval-after-load 'session
'(add-to-list 'session-globals-exclude 'org-mark-ring))
;;;; outline-mode
;; Folding in outline-mode is not compatible with org-mode folding
;; anymore. Working around to avoid breakage of external packages
;; assuming the compatibility.
(define-advice outline-flag-region (:around (oldfun from to flag &rest extra) fix-for-org-fold)
"Run `org-fold-region' when in org-mode."
(if (derived-mode-p 'org-mode)
(org-fold-region (max from (point-min)) (min to (point-max)) flag 'headline)
;; Apply EXTRA to avoid breakages if adviced function definition
;; changes.
(apply oldfun from to flag extra)))
(define-advice outline-next-visible-heading (:around (oldfun arg &rest extra) fix-for-org-fold)
"Run `org-next-visible-heading' when in org-mode."
(if (derived-mode-p 'org-mode)
(org-next-visible-heading arg)
;; Apply EXTRA to avoid breakages if adviced function definition
;; changes.
(apply oldfun arg extra)))
(define-advice outline-back-to-heading (:around (oldfun &optional invisible-ok &rest extra) fix-for-org-fold)
"Run `org-back-to-heading' when in org-mode."
(if (derived-mode-p 'org-mode)
(progn
(beginning-of-line)
(or (org-at-heading-p (not invisible-ok))
(let (found)
(save-excursion
(while (not found)
(or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
nil t)
(signal 'outline-before-first-heading nil))
(setq found (and (or invisible-ok (not (org-fold-folded-p)))
(point)))))
(goto-char found)
found)))
;; Apply EXTRA to avoid breakages if adviced function definition
;; changes.
(apply oldfun invisible-ok extra)))
(define-advice outline-on-heading-p (:around (oldfun &optional invisible-ok &rest extra) fix-for-org-fold)
"Run `org-at-heading-p' when in org-mode."
(if (derived-mode-p 'org-mode)
(org-at-heading-p (not invisible-ok))
;; Apply EXTRA to avoid breakages if adviced function definition
;; changes.
(apply oldfun invisible-ok extra)))
(define-advice outline-hide-sublevels (:around (oldfun levels &rest extra) fix-for-org-fold)
"Run `org-fold-hide-sublevels' when in org-mode."
(if (derived-mode-p 'org-mode)
(org-fold-hide-sublevels levels)
;; Apply EXTRA to avoid breakages if adviced function definition
;; changes.
(apply oldfun levels extra)))
(define-advice outline-toggle-children (:around (oldfun &rest extra) fix-for-org-fold)
"Run `org-fold-hide-sublevels' when in org-mode."
(if (derived-mode-p 'org-mode)
(save-excursion
(org-back-to-heading)
(if (not (org-fold-folded-p (line-end-position)))
(org-fold-hide-subtree)
(org-fold-show-children)
(org-fold-show-entry 'hide-drawers)))
;; Apply EXTRA to avoid breakages if adviced function definition
;; changes.
(apply oldfun extra)))
;; TODO: outline-headers-as-kill
;;;; Speed commands
(make-obsolete-variable 'org-speed-commands-user
"configure `org-speed-commands' instead." "9.5")
(provide 'org-compat)
;; Local variables:

16
lisp/org/org-crypt.el
View file

@ -54,6 +54,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org-macs)
(require 'org-compat)
@ -73,7 +76,7 @@
(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-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-flag-subtree "org" (flag))
(declare-function org-fold-subtree "org-fold" (flag))
(declare-function org-make-tags-matcher "org" (match))
(declare-function org-previous-visible-heading "org" (arg))
(declare-function org-scan-tags "org" (action matcher todo-only &optional start-level))
@ -196,8 +199,9 @@ See `org-crypt-disable-auto-save'."
Assume `epg-context' is set."
(and org-crypt-key
(or (epg-list-keys epg-context
(or (org-entry-get nil "CRYPTKEY" 'selective)
org-crypt-key))
(pcase (org-entry-get nil "CRYPTKEY" 'selective 'literal-nil)
("nil" "")
(key (or key org-crypt-key ""))))
(bound-and-true-p epa-file-encrypt-to)
(progn
(message "No crypt key set, using symmetric encryption.")
@ -243,7 +247,7 @@ Assume `epg-context' is set."
(error (error-message-string err)))))
(when folded-heading
(goto-char folded-heading)
(org-flag-subtree t))
(org-fold-subtree t))
nil)))))
;;;###autoload
@ -280,7 +284,7 @@ Assume `epg-context' is set."
'org-crypt-text encrypted-text))
(when folded-heading
(goto-char folded-heading)
(org-flag-subtree t))
(org-fold-subtree t))
nil)))
(_ nil)))
@ -313,7 +317,7 @@ Assume `epg-context' is set."
'org-mode-hook
(lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t))))
(add-hook 'org-reveal-start-hook 'org-decrypt-entry)
(add-hook 'org-fold-reveal-start-hook 'org-decrypt-entry)
(provide 'org-crypt)

25
lisp/org/org-ctags.el
View file

@ -135,6 +135,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(eval-when-compile (require 'cl-lib))
(require 'org)
@ -155,7 +158,6 @@ See the ctags documentation for more information.")
(defcustom org-ctags-path-to-ctags
(if (executable-find "ctags-exuberant") "ctags-exuberant" "ctags")
"Name of the ctags executable file."
:group 'org-ctags
:version "24.1"
:type 'file)
@ -164,7 +166,6 @@ See the ctags documentation for more information.")
org-ctags-ask-rebuild-tags-file-then-find-tag
org-ctags-ask-append-topic)
"List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS by ORG-CTAGS."
:group 'org-ctags
:version "24.1"
:type 'hook
:options '(org-ctags-find-tag
@ -186,7 +187,6 @@ Created as a local variable in each buffer.")
"Text to insert when creating a new org file via opening a hyperlink.
The following patterns are replaced in the string:
`%t' - replaced with the capitalized title of the hyperlink"
:group 'org-ctags
:version "24.1"
:type 'string)
@ -205,7 +205,8 @@ The following patterns are replaced in the string:
(visit-tags-table tags-filename))))))
(defadvice visit-tags-table (after org-ctags-load-tag-list activate compile)
(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
(org-ctags-all-tags-in-current-tags-table))))
@ -227,7 +228,7 @@ If the tag is found, return a list containing the filename, line number, and
buffer position where the tag is found."
(interactive "sTag: ")
(unless tags-file-name
(call-interactively (visit-tags-table)))
(call-interactively #'visit-tags-table))
(save-excursion
(visit-tags-table-buffer 'same)
(when tags-file-name
@ -254,7 +255,7 @@ Return the list."
(interactive)
(let ((taglist nil))
(unless tags-file-name
(call-interactively (visit-tags-table)))
(call-interactively #'visit-tags-table))
(save-excursion
(visit-tags-table-buffer 'same)
(with-current-buffer (get-file-buffer tags-file-name)
@ -293,8 +294,9 @@ The new topic will be titled NAME (or TITLE if supplied)."
;;;; Misc interoperability with etags system =================================
(defadvice xref-find-definitions
(before org-ctags-set-org-mark-before-finding-tag activate compile)
(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
(when (and (derived-mode-p 'org-mode) org-ctags-enabled-p)
@ -435,7 +437,7 @@ to append a new topic."
Like ORG-CTAGS-FIND-TAG, but calls the external ctags program first,
to rebuild (update) the TAGS file."
(unless tags-file-name
(call-interactively (visit-tags-table)))
(call-interactively #'visit-tags-table))
(when (buffer-file-name)
(org-ctags-create-tags))
(org-ctags-find-tag name))
@ -508,10 +510,7 @@ Uses `ido-mode' if available.
If the user enters a string that does not match an existing tag, create
a new topic."
(interactive)
(let* ((completing-read-fn (if (fboundp 'ido-completing-read)
'ido-completing-read
'completing-read))
(tag (funcall completing-read-fn "Topic: " org-ctags-tag-list
(let* ((tag (ido-completing-read "Topic: " org-ctags-tag-list
nil 'confirm nil 'org-ctags-find-tag-history)))
(when tag
(cond

817
lisp/org/org-cycle.el Normal file
View file

@ -0,0 +1,817 @@
;;; org-cycle.el --- Visibility cycling of Org entries -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2020-2020 Free Software Foundation, Inc.
;;
;; Maintainer: Ihor Radchenko <yantar92 at gmail dot com>
;; Keywords: folding, visibility cycling, invisible text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;; This file contains code controlling global folding state in buffer
;; and TAB-cycling.
;;; Code:
(require 'org-macs)
(org-assert-version)
(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-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))
(declare-function org-subtree-end-visible-p "org" ())
(declare-function org-narrow-to-subtree "org" (&optional element))
(declare-function org-next-visible-heading "org" (arg))
(declare-function org-at-property-p "org" ())
(declare-function org-re-property "org" (property &optional literal allow-null value))
(declare-function org-remove-inline-images "org" (&optional beg end))
(declare-function org-item-beginning-re "org" ())
(declare-function org-at-heading-p "org" (&optional invisible-not-ok))
(declare-function org-at-item-p "org" ())
(declare-function org-before-first-heading-p "org" ())
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-entry-end-position "org" ())
(declare-function org-try-cdlatex-tab "org" ())
(declare-function org-cycle-level "org" ())
(declare-function org-table-next-field "org-table" ())
(declare-function org-table-justify-field-maybe "org-table" (&optional new))
(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
(declare-function org-list-get-all-items "org-list" (item struct prevs))
(declare-function org-list-get-bottom-point "org-list" (struct))
(declare-function org-list-prevs-alist "org-list" (struct))
(declare-function org-list-set-item-visibility "org-list" (item struct view))
(declare-function org-list-search-forward "org-list" (regexp &optional bound noerror))
(declare-function org-list-has-child-p "org-list" (item struct))
(declare-function org-list-get-item-end-before-blank "org-list" (item struct))
(declare-function org-list-struct "org-list" ())
(declare-function org-cycle-item-indentation "org-list" ())
(declare-function outline-previous-heading "outline" ())
(declare-function outline-next-heading "outline" ())
(declare-function outline-end-of-heading "outline" ())
(declare-function outline-up-heading "outline" (arg &optional invisible-ok))
(defvar org-drawer-regexp)
(defvar org-odd-levels-only)
(defvar org-startup-folded)
(defvar org-archive-tag)
(defvar org-cycle-include-plain-lists)
(defvar org-outline-regexp-bol)
(defvar-local org-cycle-global-status nil)
(put 'org-cycle-global-status 'org-state t)
(defvar-local org-cycle-subtree-status nil)
(put 'org-cycle-subtree-status 'org-state t)
;;;; Customisation:
(defgroup org-cycle nil
"Options concerning visibility cycling in Org mode."
:tag "Org Cycle"
:group 'org-structure)
(defcustom org-cycle-skip-children-state-if-no-children t
"Non-nil means skip CHILDREN state in entries that don't have any."
:group 'org-cycle
:type 'boolean)
(defcustom org-cycle-max-level nil
"Maximum level which should still be subject to visibility cycling.
Levels higher than this will, for cycling, be treated as text, not a headline.
When `org-odd-levels-only' is set, a value of N in this variable actually
means 2N-1 stars as the limiting headline.
When nil, cycle all levels.
Note that the limiting level of cycling is also influenced by
`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but
`org-inlinetask-min-level' is, cycling will be limited to levels one less
than its value."
:group 'org-cycle
:type '(choice
(const :tag "No limit" nil)
(integer :tag "Maximum level")))
(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
#+STARTUP: hideblocks
#+STARTUP: nohideblocks"
:group 'org-startup
:group 'org-cycle
:type 'boolean)
(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
#+STARTUP: hidedrawers
#+STARTUP: nohidedrawers"
:group 'org-startup
:group 'org-cycle
:type 'boolean)
(defcustom org-cycle-global-at-bob nil
"Cycle globally if cursor is at beginning of buffer and not at a headline.
This makes it possible to do global cycling without having to use `S-TAB'
or `\\[universal-argument] TAB'. For this special case to work, the first \
line of the buffer
must not be a headline -- it may be empty or some other text.
When used in this way, `org-cycle-hook' is disabled temporarily to make
sure the cursor stays at the beginning of the buffer.
When this option is nil, don't do anything special at the beginning of
the buffer."
:group 'org-cycle
:type 'boolean)
(defcustom org-cycle-level-after-item/entry-creation t
"Non-nil means cycle entry level or item indentation in new empty entries.
When the cursor is at the end of an empty headline, i.e., with only stars
and maybe a TODO keyword, TAB will then switch the entry to become a child,
and then all possible ancestor states, before returning to the original state.
This makes data entry extremely fast: M-RET to create a new headline,
on TAB to make it a child, two or more tabs to make it a (grand-)uncle.
When the cursor is at the end of an empty plain list item, one TAB will
make it a subitem, two or more tabs will back up to make this an item
higher up in the item hierarchy."
:group 'org-cycle
:type 'boolean)
(defcustom org-cycle-emulate-tab t
"Where should `org-cycle' emulate TAB.
nil Never
white Only in completely white lines
whitestart Only at the beginning of lines, before the first non-white char
t Everywhere except in headlines
exc-hl-bol Everywhere except at the start of a headline
If TAB is used in a place where it does not emulate TAB, the current subtree
visibility is cycled."
:group 'org-cycle
:type '(choice (const :tag "Never" nil)
(const :tag "Only in completely white lines" white)
(const :tag "Before first char in a line" whitestart)
(const :tag "Everywhere except in headlines" t)
(const :tag "Everywhere except at bol in headlines" exc-hl-bol)))
(defcustom org-cycle-separator-lines 2
"Number of empty lines needed to keep an empty line between collapsed trees.
If you leave an empty line between the end of a subtree and the following
headline, this empty line is hidden when the subtree is folded.
Org mode will leave (exactly) one empty line visible if the number of
empty lines is equal or larger to the number given in this variable.
So the default 2 means at least 2 empty lines after the end of a subtree
are needed to produce free space between a collapsed subtree and the
following headline.
If the number is negative, and the number of empty lines is at least -N,
all empty lines are shown.
Special case: when 0, never leave empty lines in collapsed view."
:group 'org-cycle
:type 'integer)
(put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
(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
the new state that will be set right after running this hook. The
argument is a symbol. Before a global state change, it can have the values
`overview', `content', or `all'. Before a local state change, it can have
the values `folded', `children', or `subtree'."
:group 'org-cycle
:type 'hook)
(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
org-cycle-show-empty-lines
org-cycle-optimize-window-after-visibility-change
org-cycle-display-inline-images)
"Hook that is run after `org-cycle' has changed the buffer visibility.
The function(s) in this hook must accept a single argument which indicates
the new state that was set by the most recent `org-cycle' command. The
argument is a symbol. After a global state change, it can have the values
`overview', `contents', or `all'. After a local state change, it can have
the values `folded', `children', or `subtree'."
:group 'org-cycle
:package-version '(Org . "9.4")
:type 'hook)
(defcustom org-cycle-open-archived-trees nil
"Non-nil means `org-cycle' will open archived trees.
An archived tree is a tree marked with the tag ARCHIVE.
When nil, archived trees will stay folded. You can still open them with
normal outline commands like `show-all', but not with the cycling commands."
:group 'org-archive
:group 'org-cycle
:type 'boolean)
(defcustom org-cycle-inline-images-display nil
"Non-nil means auto display inline images under subtree when cycling."
:group 'org-startup
:group 'org-cycle
:package-version '(Org . "9.6")
:type 'boolean)
(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.
This hook runs as the first action when TAB is pressed, even before
`org-cycle' messes around with the `outline-regexp' to cater for
inline tasks and plain list item folding.
If any function in this hook returns t, any other actions that
would have been caused by TAB (such as table field motion or visibility
cycling) will not occur.")
;;;; Implementation:
(defun org-cycle-hide-drawers (state)
"Re-hide all drawers after a visibility state change.
STATE should be one of the symbols listed in the docstring of
`org-cycle-hook'."
(when (derived-mode-p 'org-mode)
(cond ((not (memq state '(overview folded contents)))
(let* ((global? (eq state 'all))
(beg (if global? (point-min) (line-beginning-position)))
(end (cond (global? (point-max))
((eq state 'children) (org-entry-end-position))
(t (save-excursion (org-end-of-subtree t t))))))
(org-fold--hide-drawers beg end)))
((memq state '(overview contents))
;; Hide drawers before first heading.
(let ((beg (point-min))
(end (save-excursion
(goto-char (point-min))
(if (org-before-first-heading-p)
(org-entry-end-position)
(point-min)))))
(when (< beg end)
(org-fold--hide-drawers beg end)))))))
;;;###autoload
(defun org-cycle (&optional arg)
"TAB-action and visibility cycling for Org mode.
This is the command invoked in Org mode by the `TAB' key. Its main
purpose is outline visibility cycling, but it also invokes other actions
in special contexts.
When this function is called with a `\\[universal-argument]' prefix, rotate \
the entire
buffer through 3 states (global cycling)
1. OVERVIEW: Show only top-level headlines.
2. CONTENTS: Show all headlines of all levels, but no body text.
3. SHOW ALL: Show everything.
With a `\\[universal-argument] \\[universal-argument]' prefix argument, \
switch to the startup visibility,
determined by the variable `org-startup-folded', and by any VISIBILITY
properties in the buffer.
With a `\\[universal-argument] \\[universal-argument] \
\\[universal-argument]' prefix argument, show the entire buffer, including
any drawers.
When inside a table, re-align the table and move to the next field.
When point is at the beginning of a headline, rotate the subtree started
by this line through 3 different states (local cycling)
1. FOLDED: Only the main headline is shown.
2. CHILDREN: The main headline and the direct children are shown.
From this state, you can move to one of the children
and zoom in further.
3. SUBTREE: Show the entire subtree, including body text.
If there is no subtree, switch directly from CHILDREN to FOLDED.
When point is at the beginning of an empty headline and the variable
`org-cycle-level-after-item/entry-creation' is set, cycle the level
of the headline by demoting and promoting it to likely levels. This
speeds up creation document structure by pressing `TAB' once or several
times right after creating a new headline.
When there is a numeric prefix, go up to a heading with level ARG, do
a `show-subtree' and return to the previous cursor position. If ARG
is negative, go up that many levels.
When point is not at the beginning of a headline, execute the global
binding for `TAB', which is re-indenting the line. See the option
`org-cycle-emulate-tab' for details.
As a special case, if point is at the very beginning of the buffer, if
there is no headline there, and if the variable `org-cycle-global-at-bob'
is non-nil, this function acts as if called with prefix argument \
\(`\\[universal-argument] TAB',
same as `S-TAB') also when called without prefix argument."
(interactive "P")
(org-load-modules-maybe)
(unless (or (run-hook-with-args-until-success 'org-cycle-tab-first-hook)
(and org-cycle-level-after-item/entry-creation
(or (org-cycle-level)
(org-cycle-item-indentation))))
(let* ((limit-level
(or org-cycle-max-level
(and (boundp 'org-inlinetask-min-level)
org-inlinetask-min-level
(1- org-inlinetask-min-level))))
(nstars
(and limit-level
(if org-odd-levels-only
(1- (* 2 limit-level))
limit-level)))
(org-outline-regexp
(format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+"))))
(cond
((equal arg '(16))
(setq last-command 'dummy)
(org-cycle-set-startup-visibility)
(org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
((equal arg '(64))
(org-fold-show-all)
(org-unlogged-message "Entire buffer visible, including drawers"))
((equal arg '(4)) (org-cycle-internal-global))
;; Show-subtree, ARG levels up from here.
((integerp arg)
(save-excursion
(org-back-to-heading)
(outline-up-heading (if (< arg 0) (- arg)
(- (funcall outline-level) arg)))
(org-fold-show-subtree)))
;; Global cycling at BOB: delegate to `org-cycle-internal-global'.
((and org-cycle-global-at-bob
(bobp)
(not (looking-at org-outline-regexp)))
(let ((org-cycle-hook
(remq 'org-cycle-optimize-window-after-visibility-change
org-cycle-hook)))
(org-cycle-internal-global)))
;; Try CDLaTeX TAB completion.
((org-try-cdlatex-tab))
;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
((and (featurep 'org-inlinetask)
(org-inlinetask-at-task-p)
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
(org-inlinetask-toggle-visibility))
(t
(let ((pos (point))
(element (org-element-at-point)))
(cond
;; Try toggling visibility for block at point.
((org-fold-hide-block-toggle nil t element))
;; Try toggling visibility for drawer at point.
((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))
(eq 'table.el (org-element-property :type element)))
(message (substitute-command-keys "\\<org-mode-map>\
Use `\\[org-edit-special]' to edit table.el tables"))
(org-table-justify-field-maybe)
(call-interactively #'org-table-next-field)))
((run-hook-with-args-until-success
'org-tab-after-check-for-table-hook))
;; At an item/headline: delegate to `org-cycle-internal-local'.
((and (or (and org-cycle-include-plain-lists
(let ((item (org-element-lineage element
'(item plain-list)
t)))
(and item
(= (line-beginning-position)
(org-element-property :post-affiliated
item)))))
(org-match-line org-outline-regexp))
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
(org-cycle-internal-local))
;; From there: TAB emulation and template completion.
(buffer-read-only (org-back-to-heading))
((run-hook-with-args-until-success
'org-tab-after-check-for-cycling-hook))
((run-hook-with-args-until-success
'org-tab-before-tab-emulation-hook))
((and (eq org-cycle-emulate-tab 'exc-hl-bol)
(or (not (bolp))
(not (looking-at org-outline-regexp))))
(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]*"))
(or (and (eq org-cycle-emulate-tab 'white)
(= (match-end 0) (line-end-position)))
(and (eq org-cycle-emulate-tab 'whitestart)
(>= (match-end 0) pos)))))
(call-interactively (global-key-binding (kbd "TAB"))))
(t
(save-excursion
(org-back-to-heading)
(org-cycle))))))))))
(defun org-cycle-force-archived ()
"Cycle subtree even if it is archived."
(interactive)
(setq this-command 'org-cycle)
(let ((org-cycle-open-archived-trees t))
(call-interactively 'org-cycle)))
(defun org-cycle-internal-global ()
"Do the global cycling action."
;; Hack to avoid display of messages for .org attachments in Gnus
(let ((ga (string-match-p "\\*fontification" (buffer-name))))
(cond
((and (eq last-command this-command)
(eq org-cycle-global-status 'overview))
;; We just created the overview - now do table of contents
;; This can be slow in very large buffers, so indicate action
(run-hook-with-args 'org-cycle-pre-hook 'contents)
(unless ga (org-unlogged-message "CONTENTS..."))
(org-cycle-content)
(unless ga (org-unlogged-message "CONTENTS...done"))
(setq org-cycle-global-status 'contents)
(run-hook-with-args 'org-cycle-hook 'contents))
((and (eq last-command this-command)
(eq org-cycle-global-status 'contents))
;; We just showed the table of contents - now show everything
(run-hook-with-args 'org-cycle-pre-hook 'all)
(org-fold-show-all '(headings blocks))
(unless ga (org-unlogged-message "SHOW ALL"))
(setq org-cycle-global-status 'all)
(run-hook-with-args 'org-cycle-hook 'all))
(t
;; Default action: go to overview
(run-hook-with-args 'org-cycle-pre-hook 'overview)
(org-cycle-overview)
(unless ga (org-unlogged-message "OVERVIEW"))
(setq org-cycle-global-status 'overview)
(run-hook-with-args 'org-cycle-hook 'overview)))))
(defun org-cycle-internal-local ()
"Do the local cycling action."
(let ((goal-column 0) eoh eol eos has-children children-skipped struct)
;; First, determine end of headline (EOH), end of subtree or item
;; (EOS), and if item or heading has children (HAS-CHILDREN).
(save-excursion
(if (org-at-item-p)
(progn
(beginning-of-line)
(setq struct (org-list-struct))
(setq eoh (line-end-position))
(setq eos (org-list-get-item-end-before-blank (point) struct))
(setq has-children (org-list-has-child-p (point) struct)))
(org-back-to-heading)
(setq eoh (save-excursion (outline-end-of-heading) (point)))
(setq eos (save-excursion
(org-end-of-subtree t t)
(unless (eobp) (forward-char -1))
(point)))
(setq has-children
(or
(save-excursion
(let ((level (funcall outline-level)))
(outline-next-heading)
(and (org-at-heading-p)
(> (funcall outline-level) level))))
(and (eq org-cycle-include-plain-lists 'integrate)
(save-excursion
(org-list-search-forward (org-item-beginning-re) eos t))))))
;; Determine end invisible part of buffer (EOL)
(beginning-of-line 2)
(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)))
(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))))
(setq eol (point)))
;; Find out what to do next and set `this-command'
(cond
((= eos eoh)
;; Nothing is hidden behind this heading
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-pre-hook 'empty))
(org-unlogged-message "EMPTY ENTRY")
(setq org-cycle-subtree-status nil)
(save-excursion
(goto-char eos)
(org-with-limited-levels
(outline-next-heading))
(when (org-invisible-p) (org-fold-heading nil))))
((and (or (>= eol eos)
(save-excursion (goto-char eol) (skip-chars-forward "[:space:]" eos) (= (point) eos)))
(or has-children
(not (setq children-skipped
org-cycle-skip-children-state-if-no-children))))
;; Entire subtree is hidden in one line: children view
(unless (org-before-first-heading-p)
(org-with-limited-levels
(run-hook-with-args 'org-cycle-pre-hook 'children)))
(if (org-at-item-p)
(org-list-set-item-visibility (line-beginning-position) struct 'children)
(org-fold-show-entry)
(org-with-limited-levels (org-fold-show-children))
(org-fold-show-set-visibility 'tree)
;; Fold every list in subtree to top-level items.
(when (eq org-cycle-include-plain-lists 'integrate)
(save-excursion
(org-back-to-heading)
(while (org-list-search-forward (org-item-beginning-re) eos t)
(beginning-of-line 1)
(let* ((struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(end (org-list-get-bottom-point struct)))
(dolist (e (org-list-get-all-items (point) struct prevs))
(org-list-set-item-visibility e struct 'folded))
(goto-char (if (< end eos) end eos)))))))
(org-unlogged-message "CHILDREN")
(save-excursion
(goto-char eos)
(org-with-limited-levels
(outline-next-heading))
(when (and
;; Subtree does not end at the end of visible section of the
;; buffer.
(< (point) (point-max))
(org-invisible-p))
;; Reveal the following heading line.
(org-fold-heading nil)))
(setq org-cycle-subtree-status 'children)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'children)))
((or children-skipped
(and (eq last-command this-command)
(eq org-cycle-subtree-status 'children)))
;; We just showed the children, or no children are there,
;; now show everything.
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-pre-cycle-hook 'subtree))
(org-fold-region eoh eos nil 'outline)
(org-unlogged-message
(if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
(setq org-cycle-subtree-status 'subtree)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'subtree)))
(t
;; Default action: hide the subtree.
(run-hook-with-args 'org-cycle-pre-hook 'folded)
(org-fold-region eoh eos t 'outline)
(org-unlogged-message "FOLDED")
(setq org-cycle-subtree-status 'folded)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'folded))))))
;;;###autoload
(defun org-cycle-global (&optional arg)
"Cycle the global visibility. For details see `org-cycle'.
With `\\[universal-argument]' prefix ARG, switch to startup visibility.
With a numeric prefix, show all headlines up to that level."
(interactive "P")
(cond
((integerp arg)
(org-cycle-content arg)
(setq org-cycle-global-status 'contents))
((equal arg '(4))
(org-cycle-set-startup-visibility)
(org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
(t
(org-cycle '(4)))))
(defun org-cycle-set-startup-visibility ()
"Set the visibility required by startup options and properties."
(cond
((eq org-startup-folded t)
(org-cycle-overview))
((eq org-startup-folded 'content)
(org-cycle-content))
((eq org-startup-folded 'show2levels)
(org-cycle-content 2))
((eq org-startup-folded 'show3levels)
(org-cycle-content 3))
((eq org-startup-folded 'show4levels)
(org-cycle-content 4))
((eq org-startup-folded 'show5levels)
(org-cycle-content 5))
((or (eq org-startup-folded 'showeverything)
(eq org-startup-folded nil))
(org-fold-show-all)))
(unless (eq org-startup-folded 'showeverything)
(when org-cycle-hide-block-startup (org-fold-hide-block-all))
(org-cycle-set-visibility-according-to-property)
(org-cycle-hide-archived-subtrees 'all)
(when org-cycle-hide-drawer-startup (org-cycle-hide-drawers 'all))
(org-cycle-show-empty-lines t)))
(defun org-cycle-set-visibility-according-to-property ()
"Switch subtree visibility according to VISIBILITY property."
(interactive)
(let ((regexp (org-re-property "VISIBILITY")))
(org-with-point-at 1
(while (re-search-forward regexp nil t)
(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"
(org-fold-subtree t))
("children"
(org-fold-show-hidden-entry)
(org-fold-show-children))
("content"
(save-excursion
(save-restriction
(org-narrow-to-subtree)
(org-cycle-content))))
((or "all" "showall")
(org-fold-show-subtree))
(_ nil)))
(org-end-of-subtree)))))))
(defun org-cycle-overview ()
"Switch to overview mode, showing only top-level headlines."
(interactive)
(save-excursion
(goto-char (point-min))
;; Hide top-level drawer.
(save-restriction
(narrow-to-region (point-min) (or (re-search-forward org-outline-regexp-bol nil t) (point-max)))
(org-fold-hide-drawer-all))
(goto-char (point-min))
(when (re-search-forward org-outline-regexp-bol nil t)
(let* ((last (line-end-position))
(level (- (match-end 0) (match-beginning 0) 1))
(regexp (format "^\\*\\{1,%d\\} " level)))
(while (re-search-forward regexp nil :move)
(org-fold-region last (line-end-position 0) t 'outline)
(setq last (line-end-position))
(setq level (- (match-end 0) (match-beginning 0) 1))
(setq regexp (format "^\\*\\{1,%d\\} " level)))
(org-fold-region last (point) t 'outline)))))
(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."
(interactive "p")
(org-fold-show-all '(headings))
(save-excursion
(goto-char (point-min))
;; Hide top-level drawer.
(save-restriction
(narrow-to-region (point-min) (or (re-search-forward org-outline-regexp-bol nil t) (point-max)))
(org-fold-hide-drawer-all))
(goto-char (point-max))
(let ((regexp (if (and (wholenump arg) (> arg 0))
(format "^\\*\\{1,%d\\} " arg)
"^\\*+ "))
(last (point)))
(while (re-search-backward regexp nil t)
(org-fold-region (line-end-position) last t 'outline)
(setq last (line-end-position 0))))))
(defvar org-cycle-scroll-position-to-restore nil
"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'."
(when (get-buffer-window (current-buffer))
(let ((repeat (eq last-command this-command)))
(unless repeat
(setq org-cycle-scroll-position-to-restore nil))
(cond
((eq state 'content) nil)
((eq state 'all) nil)
((and org-cycle-scroll-position-to-restore repeat
(eq state 'folded))
(set-window-start nil org-cycle-scroll-position-to-restore))
((eq state 'folded) nil)
((eq state 'children)
(setq org-cycle-scroll-position-to-restore (window-start))
(or (org-subtree-end-visible-p) (recenter 1)))
((eq state 'subtree)
(unless repeat
(setq org-cycle-scroll-position-to-restore (window-start)))
(or (org-subtree-end-visible-p) (recenter 1)))))))
(defun org-cycle-show-empty-lines (state)
"Show empty lines above all visible headlines.
The region to be covered depends on STATE when called through
`org-cycle-hook'. Lisp program can use t for STATE to get the
entire buffer covered. Note that an empty line is only shown if there
are at least `org-cycle-separator-lines' empty lines before the headline."
(when (/= org-cycle-separator-lines 0)
(save-excursion
(let* ((n (abs org-cycle-separator-lines))
(re (cond
((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
(t (let ((ns (number-to-string (- n 2))))
(concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
"[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
beg end)
(cond
((memq state '(overview contents t))
(setq beg (point-min) end (point-max)))
((memq state '(children folded))
(setq beg (point)
end (progn (org-end-of-subtree t t)
(line-beginning-position 2)))))
(when beg
(goto-char beg)
(while (re-search-forward re end t)
(unless (org-invisible-p (match-end 1))
(let ((e (match-end 1))
(b (if (>= org-cycle-separator-lines 0)
(match-beginning 1)
(save-excursion
(goto-char (match-beginning 0))
(skip-chars-backward " \t\n")
(line-end-position)))))
(org-fold-region b e nil 'outline))))))))
;; Never hide empty lines at the end of the file.
(save-excursion
(goto-char (point-max))
(outline-previous-heading)
(outline-end-of-heading)
(when (and (looking-at "[ \t\n]+")
(= (match-end 0) (point-max)))
(org-fold-region (point) (match-end 0) nil 'outline))))
(defun org-cycle-hide-archived-subtrees (state)
"Re-hide all archived subtrees after a visibility state change.
STATE should be one of the symbols listed in the docstring of
`org-cycle-hook'."
(when (and (not org-cycle-open-archived-trees)
(not (memq state '(overview folded))))
(let ((globalp (memq state '(contents all))))
(if globalp
(org-fold-hide-archived-subtrees (point-min) (point-max))
(org-fold-hide-archived-subtrees
(point)
(save-excursion
(org-end-of-subtree t))))
(when (and (not globalp)
(member org-archive-tag
(org-get-tags nil 'local)))
(message "%s" (substitute-command-keys
"Subtree is archived and stays closed. Use \
`\\[org-cycle-force-archived]' to cycle it anyway."))))))
(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."
(when org-cycle-inline-images-display
(pcase state
('children
(org-with-wide-buffer
(org-narrow-to-subtree)
;; If has nested headlines, beg,end only from parent headline
;; to first child headline which reference to upper
;; let-binding `org-next-visible-heading'.
(org-display-inline-images
nil nil
(point-min) (progn (org-next-visible-heading 1) (point)))))
('subtree
(org-with-wide-buffer
(org-narrow-to-subtree)
;; If has nested headlines, also inline display images under all sub-headlines.
(org-display-inline-images nil nil (point-min) (point-max))))
('folded
(org-with-wide-buffer
(org-narrow-to-subtree)
(if (numberp (point-max))
(org-remove-inline-images (point-min) (point-max))
(ignore)))))))
(provide 'org-cycle)
;;; org-cycle.el ends here

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

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -30,6 +30,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org)
(defvar org-datetree-base-level 1
@ -137,7 +140,7 @@ will be built under the headline at point."
(let* ((year (calendar-extract-year d))
(month (calendar-extract-month d))
(day (calendar-extract-day d))
(time (encode-time 0 0 0 day month year))
(time (org-encode-time 0 0 0 day month year))
(iso-date (calendar-iso-from-absolute
(calendar-absolute-from-gregorian d)))
(weekyear (nth 2 iso-date))
@ -185,8 +188,7 @@ inserted into the buffer."
(defun org-datetree-insert-line (year &optional month day text)
(delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point))
(when (assq 'heading org-blank-before-new-entry)
(insert "\n"))
(when (org--blank-before-heading-p) (insert "\n"))
(insert "\n" (make-string org-datetree-base-level ?*) " \n")
(backward-char)
(when month (org-do-demote))
@ -197,14 +199,14 @@ inserted into the buffer."
(when month
(insert
(if day
(format-time-string "-%m-%d %A" (encode-time 0 0 0 day month year))
(format-time-string "-%m %B" (encode-time 0 0 0 1 month year))))))
(format-time-string "-%m-%d %A" (org-encode-time 0 0 0 day month year))
(format-time-string "-%m %B" (org-encode-time 0 0 0 1 month year))))))
(when (and day org-datetree-add-timestamp)
(save-excursion
(insert "\n")
(org-indent-line)
(org-insert-time-stamp
(encode-time 0 0 0 day month year)
(org-encode-time 0 0 0 day month year)
nil
(eq org-datetree-add-timestamp 'inactive))))
(beginning-of-line))

54
lisp/org/org-duration.el
View file

@ -51,6 +51,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'org-macs)
@ -98,7 +101,7 @@ sure to call the following command:
:version "26.1"
:package-version '(Org . "9.1")
:set (lambda (var val)
(set-default var val)
(set-default-toplevel-value var val)
;; Avoid recursive load at startup.
(when (featurep 'org-duration)
(org-duration-set-regexps)))
@ -284,30 +287,31 @@ translated into 0.0.
Return value as a float. Raise an error if duration format is
not recognized."
(cond
((equal duration "") 0.0)
((numberp duration) (float duration))
((string-match-p org-duration--h:mm-re duration)
(pcase-let ((`(,hours ,minutes ,seconds)
(mapcar #'string-to-number (split-string duration ":"))))
(+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
((string-match-p org-duration--full-re duration)
(let ((minutes 0)
(s 0))
(while (string-match org-duration--unit-re duration s)
(setq s (match-end 0))
(let ((value (string-to-number (match-string 1 duration)))
(unit (match-string 2 duration)))
(cl-incf minutes (* value (org-duration--modifier unit canonical)))))
(float minutes)))
((string-match org-duration--mixed-re duration)
(let ((units-part (match-string 1 duration))
(hms-part (match-string 2 duration)))
(+ (org-duration-to-minutes units-part)
(org-duration-to-minutes hms-part))))
((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
(float (string-to-number duration)))
(t (error "Invalid duration format: %S" duration))))
(save-match-data
(cond
((equal duration "") 0.0)
((numberp duration) (float duration))
((string-match-p org-duration--h:mm-re duration)
(pcase-let ((`(,hours ,minutes ,seconds)
(mapcar #'string-to-number (split-string duration ":"))))
(+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
((string-match-p org-duration--full-re duration)
(let ((minutes 0)
(s 0))
(while (string-match org-duration--unit-re duration s)
(setq s (match-end 0))
(let ((value (string-to-number (match-string 1 duration)))
(unit (match-string 2 duration)))
(cl-incf minutes (* value (org-duration--modifier unit canonical)))))
(float minutes)))
((string-match org-duration--mixed-re duration)
(let ((units-part (match-string 1 duration))
(hms-part (match-string 2 duration)))
(+ (org-duration-to-minutes units-part)
(org-duration-to-minutes hms-part))))
((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
(float (string-to-number duration)))
(t (error "Invalid duration format: %S" duration)))))
;;;###autoload
(defun org-duration-from-minutes (minutes &optional fmt canonical)

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

File diff suppressed because it is too large Load diff

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

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>,
;; Ulf Stegemann <ulf at zeitform dot de>
;; Keywords: outlines, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -27,6 +27,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(declare-function org-mode "org" ())
(declare-function org-toggle-pretty-entities "org" ())
(declare-function org-table-align "org-table" ())
@ -89,8 +92,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("aacute" "\\'{a}" nil "&aacute;" "a" "á" "á")
("Acirc" "\\^{A}" nil "&Acirc;" "A" "Â" "Â")
("acirc" "\\^{a}" nil "&acirc;" "a" "â" "â")
("Amacr" "\\bar{A}" nil "&Amacr;" "A" "Ã" "Ã")
("amacr" "\\bar{a}" nil "&amacr;" "a" "ã" "ã")
("Amacr" "\\={A}" nil "&Amacr;" "A" "Ã" "Ã")
("amacr" "\\={a}" nil "&amacr;" "a" "ã" "ã")
("Atilde" "\\~{A}" nil "&Atilde;" "A" "Ã" "Ã")
("atilde" "\\~{a}" nil "&atilde;" "a" "ã" "ã")
("Auml" "\\\"{A}" nil "&Auml;" "Ae" "Ä" "Ä")
@ -307,7 +310,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("trade" "\\texttrademark{}" nil "&trade;" "TM" "TM" "™")
"** Science et al."
("minus" "\\minus" t "&minus;" "-" "-" "−")
("minus" "-" t "&minus;" "-" "-" "−")
("pm" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
("plusmn" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
("times" "\\texttimes{}" nil "&times;" "*" "×" "×")

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

@ -4,7 +4,7 @@
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -28,6 +28,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(defgroup org-faces nil
"Faces in Org mode."
:tag "Org Faces"
@ -338,7 +341,7 @@ determines if it is a foreground or a background color."
(defvar org-tags-special-faces-re nil)
(defun org-set-tag-faces (var value)
(set var value)
(set-default-toplevel-value var value)
(if (not value)
(setq org-tags-special-faces-re nil)
(setq org-tags-special-faces-re
@ -455,6 +458,10 @@ verse and quote blocks are fontified using the `org-verse' and
"Face used for the line delimiting the end of source blocks."
:group 'org-faces)
(defface org-inline-src-block '((t (:inherit org-block)))
"Face used for inline source blocks as a whole."
:group 'org-faces)
(defface org-verbatim '((t (:inherit shadow)))
"Face for fixed-with text like code snippets."
:group 'org-faces
@ -593,7 +600,7 @@ See also `org-agenda-deadline-faces'.")
(0.0 . org-upcoming-distant-deadline))
"Faces for showing deadlines in the agenda.
This is a list of cons cells. The cdr of each cell is a face to be used,
and it can also just be like \\='(:foreground \"yellow\").
and it can also just be like (:foreground \"yellow\").
Each car is a fraction of the head-warning time that must have passed for
this the face in the cdr to be used for display. The numbers must be
given in descending order. The head-warning time is normally taken

9
lisp/org/org-feed.el
View file

@ -4,7 +4,7 @@
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -88,6 +88,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org)
(require 'sha1)
@ -412,8 +415,8 @@ it can be a list structured like an entry in `org-feed-alist'."
;; Normalize the visibility of the inbox tree
(goto-char inbox-pos)
(org-flag-subtree t)
(org-show-children)
(org-fold-subtree t)
(org-fold-show-children)
;; Hooks and messages
(when org-feed-save-after-adding (save-buffer))

1511
lisp/org/org-fold-core.el Normal file
View file

File diff suppressed because it is too large Load diff

906
lisp/org/org-fold.el Normal file
View file

@ -0,0 +1,906 @@
;;; org-fold.el --- Folding of Org entries -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2020-2020 Free Software Foundation, Inc.
;;
;; Author: Ihor Radchenko <yantar92 at gmail dot com>
;; Keywords: folding, invisible text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;; This file contains code handling temporary invisibility (folding
;; and unfolding) of text in org buffers.
;; The folding is implemented using generic org-fold-core library. This file
;; contains org-specific implementation of the folding. Also, various
;; useful functions from org-fold-core are aliased under shorted `org-fold'
;; prefix.
;; The following features are implemented:
;; - Folding/unfolding various Org mode elements and regions of Org buffers:
;; + Region before first heading;
;; + Org headings, their text, children (subtree), siblings, parents, etc;
;; + Org blocks and drawers
;; - Revealing Org structure around invisible point location
;; - Revealing folded Org elements broken by user edits
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org-macs)
(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)
(defvar org-link-descriptive)
(defvar org-outline-regexp-bol)
(defvar org-archive-tag)
(defvar org-custom-properties-overlays)
(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-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-property "org-element" (property element))
(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" ())
(declare-function org-get-tags "org" (&optional pos local fontify))
(declare-function org-get-valid-level "org" (level &optional change))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-goto-sibling "org" (&optional previous))
(declare-function org-block-map "org" (function &optional start end))
(declare-function org-map-region "org" (fun beg end))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-back-to-heading-or-point-min "org" (&optional invisible-ok))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-at-heading-p "org" (&optional invisible-not-ok))
(declare-function org-cycle-hide-drawers "org-cycle" (state))
(declare-function outline-show-branches "outline" ())
(declare-function outline-hide-sublevels "outline" (levels))
(declare-function outline-get-next-sibling "outline" ())
(declare-function outline-invisible-p "outline" (&optional pos))
(declare-function outline-next-heading "outline" ())
;;; Customization
(defgroup org-fold-reveal-location nil
"Options about how to make context of a location visible."
:tag "Org Reveal Location"
:group 'org-structure)
(defcustom org-fold-show-context-detail '((agenda . local)
(bookmark-jump . lineage)
(isearch . lineage)
(default . ancestors))
"Alist between context and visibility span when revealing a location.
\\<org-mode-map>Some actions may move point into invisible
locations. As a consequence, Org always exposes a neighborhood
around point. How much is shown depends on the initial action,
or context. Valid contexts are
agenda when exposing an entry from the agenda
org-goto when using the command `org-goto' (`\\[org-goto]')
occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /')
tags-tree when constructing a sparse tree based on tags matches
link-search when exposing search matches associated with a link
mark-goto when exposing the jump goal of a mark
bookmark-jump when exposing a bookmark location
isearch when exiting from an incremental search
default default for all contexts not set explicitly
Allowed visibility spans are
minimal show current headline; if point is not on headline,
also show entry
local show current headline, entry and next headline
ancestors show current headline and its direct ancestors; if
point is not on headline, also show entry
ancestors-full show current subtree and its direct ancestors
lineage show current headline, its direct ancestors and all
their children; if point is not on headline, also show
entry and first child
tree show current headline, its direct ancestors and all
their children; if point is not on headline, also show
entry and all children
canonical show current headline, its direct ancestors along with
their entries and children; if point is not located on
the headline, also show current entry and all children
As special cases, a nil or t value means show all contexts in
`minimal' or `canonical' view, respectively.
Some views can make displayed information very compact, but also
make it harder to edit the location of the match. In such
a case, use the command `org-fold-reveal' (`\\[org-fold-reveal]') to show
more context."
:group 'org-fold-reveal-location
:version "26.1"
:package-version '(Org . "9.0")
:type '(choice
(const :tag "Canonical" t)
(const :tag "Minimal" nil)
(repeat :greedy t :tag "Individual contexts"
(cons
(choice :tag "Context"
(const agenda)
(const org-goto)
(const occur-tree)
(const tags-tree)
(const link-search)
(const mark-goto)
(const bookmark-jump)
(const isearch)
(const default))
(choice :tag "Detail level"
(const minimal)
(const local)
(const ancestors)
(const ancestors-full)
(const lineage)
(const tree)
(const canonical))))))
(defvar org-fold-reveal-start-hook nil
"Hook run before revealing a location.")
(defcustom org-fold-catch-invisible-edits 'smart
"Check if in invisible region before inserting or deleting a character.
Valid values are:
nil Do not check, so just do invisible edits.
error Throw an error and do nothing.
show Make point visible, and do the requested edit.
show-and-error Make point visible, then throw an error and abort the edit.
smart Make point visible, and do insertion/deletion if it is
adjacent to visible text and the change feels predictable.
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?"
:group 'org-edit-structure
:version "24.1"
:type '(choice
(const :tag "Do not check" nil)
(const :tag "Throw error when trying to edit" error)
(const :tag "Unhide, but do not do the edit" show-and-error)
(const :tag "Show invisible part and do the edit" show)
(const :tag "Be smart and do the right thing" smart)))
;;; Core functionality
;;; API
;;;; Modifying folding specs
(defalias 'org-fold-folding-spec-p #'org-fold-core-folding-spec-p)
(defalias 'org-fold-add-folding-spec #'org-fold-core-add-folding-spec)
(defalias 'org-fold-remove-folding-spec #'org-fold-core-remove-folding-spec)
(defun org-fold-initialize (ellipsis)
"Setup folding in current Org buffer."
(setq-local org-fold-core-isearch-open-function #'org-fold--isearch-reveal)
(setq-local org-fold-core-extend-changed-region-functions (list #'org-fold--extend-changed-region))
;; FIXME: Converting org-link + org-description to overlays when
;; search matches hidden "[[" part of the link, reverses priority of
;; link and description and hides the whole link. Working around
;; this until there will be no need to convert text properties to
;; overlays for isearch.
(setq-local org-fold-core--isearch-special-specs '(org-link))
(org-fold-core-initialize
`((,(if (eq org-fold-core-style 'text-properties) 'org-fold-outline 'outline)
(:ellipsis . ,ellipsis)
(:fragile . ,#'org-fold--reveal-outline-maybe)
(:isearch-open . 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
;; :rear-sticky conforms to the overlay properties in outline.el
;; and the older Org versions as in `outline-flag-region'.
(:front-sticky . t)
(:rear-sticky . nil)
(:alias . (headline heading outline inlinetask plain-list)))
(,(if (eq org-fold-core-style 'text-properties) 'org-fold-block 'org-hide-block)
(:ellipsis . ,ellipsis)
(:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
(:isearch-open . t)
(:front-sticky . t)
(:alias . ( block center-block comment-block
dynamic-block example-block export-block
quote-block special-block src-block
verse-block)))
(,(if (eq org-fold-core-style 'text-properties) 'org-fold-drawer 'org-hide-drawer)
(:ellipsis . ,ellipsis)
(:fragile . ,#'org-fold--reveal-drawer-or-block-maybe)
(:isearch-open . t)
(:front-sticky . t)
(:alias . (drawer property-drawer)))
,org-link--description-folding-spec
,org-link--link-folding-spec)))
;;;; Searching and examining folded text
(defalias 'org-fold-folded-p #'org-fold-core-folded-p)
(defalias 'org-fold-get-folding-spec #'org-fold-core-get-folding-spec)
(defalias 'org-fold-get-folding-specs-in-region #'org-fold-core-get-folding-specs-in-region)
(defalias 'org-fold-get-region-at-point #'org-fold-core-get-region-at-point)
(defalias 'org-fold-get-regions #'org-fold-core-get-regions)
(defalias 'org-fold-next-visibility-change #'org-fold-core-next-visibility-change)
(defalias 'org-fold-previous-visibility-change #'org-fold-core-previous-visibility-change)
(defalias 'org-fold-next-folding-state-change #'org-fold-core-next-folding-state-change)
(defalias 'org-fold-previous-folding-state-change #'org-fold-core-previous-folding-state-change)
(defalias 'org-fold-search-forward #'org-fold-core-search-forward)
;;;;; Macros
(defalias 'org-fold-save-outline-visibility #'org-fold-core-save-visibility)
;;;; Changing visibility (regions, blocks, drawers, headlines)
;;;;; Region visibility
(defalias 'org-fold-region #'org-fold-core-region)
(defalias 'org-fold-regions #'org-fold-core-regions)
(defun org-fold-show-all (&optional types)
"Show all contents in the visible part of the buffer.
By default, the function expands headings, blocks and drawers.
When optional argument TYPES is a list of symbols among `blocks',
`drawers' and `headings', to only expand one specific type."
(interactive)
(dolist (type (or types '(blocks drawers headings)))
(org-fold-region (point-min) (point-max) nil
(pcase type
(`blocks 'block)
(`drawers 'drawer)
(`headings 'headline)
(_ (error "Invalid type: %S" type))))))
(defun org-fold-flag-above-first-heading (&optional arg)
"Hide from bob up to the first heading.
Move point to the beginning of first heading or end of buffer."
(goto-char (point-min))
(unless (org-at-heading-p)
(outline-next-heading))
(unless (bobp)
(org-fold-region 1 (1- (point)) (not arg) 'outline)))
;;;;; Heading visibility
(defun org-fold-heading (flag &optional entry)
"Fold/unfold the current heading. FLAG non-nil means make invisible.
When ENTRY is non-nil, show the entire entry."
(save-excursion
(org-back-to-heading t)
;; Check if we should show the entire entry
(if (not entry)
(org-fold-region
(line-end-position 0) (line-end-position) flag 'outline)
(org-fold-show-entry)
(save-excursion
;; FIXME: potentially catches inlinetasks
(and (outline-next-heading)
(org-fold-heading nil))))))
(defun org-fold-hide-entry ()
"Hide the body directly following this heading."
(interactive)
(save-excursion
(org-back-to-heading-or-point-min t)
(when (org-at-heading-p) (forward-line))
(unless (or (eobp) (org-at-heading-p)) ; Current headline is empty.
(org-fold-region
(line-end-position 0)
(save-excursion
(if (re-search-forward
(concat "[\r\n]" (org-get-limited-outline-regexp)) nil t)
(line-end-position 0)
(point-max)))
t
'outline))))
(defun org-fold-subtree (flag)
"Hide (when FLAG) or reveal subtree at point."
(save-excursion
(org-back-to-heading t)
(org-fold-region
(line-end-position)
(progn (org-end-of-subtree t t) (if (eobp) (point) (1- (point))))
flag
'outline)))
;; Replaces `outline-hide-subtree'.
(defun org-fold-hide-subtree ()
"Hide everything after this heading at deeper levels."
(interactive)
(org-fold-subtree t))
;; Replaces `outline-hide-sublevels'
(defun org-fold-hide-sublevels (levels)
"Hide everything but the top LEVELS levels of headers, in whole buffer.
This also unhides the top heading-less body, if any.
Interactively, the prefix argument supplies the value of LEVELS.
When invoked without a prefix argument, LEVELS defaults to the level
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)
(looking-at outline-regexp))
(funcall outline-level))
(t 1))))
(if (< levels 1)
(error "Must keep at least one level of headers"))
(save-excursion
(let* ((beg (progn
(goto-char (point-min))
;; Skip the prelude, if any.
(unless (org-at-heading-p) (outline-next-heading))
(point)))
(end (progn
(goto-char (point-max))
;; Keep empty last line, if available.
(max (point-min) (if (bolp) (1- (point)) (point))))))
(if (< end beg)
(setq beg (prog1 end (setq end beg))))
;; First hide everything.
(org-fold-region beg end t 'headline)
;; Then unhide the top level headers.
(org-map-region
(lambda ()
(when (<= (funcall outline-level) levels)
(org-fold-heading nil)))
beg end)
;; Finally unhide any trailing newline.
(goto-char (point-max))
(if (and (bolp) (not (bobp)) (outline-invisible-p (1- (point))))
(org-fold-region (max (point-min) (1- (point))) (point) nil)))))
(defun org-fold-show-entry (&optional hide-drawers)
"Show the body directly following its heading.
Show the heading too, if it is currently invisible."
(interactive)
(save-excursion
(org-back-to-heading-or-point-min t)
(org-fold-region
(line-end-position 0)
(save-excursion
(if (re-search-forward
(concat "[\r\n]\\(" (org-get-limited-outline-regexp) "\\)") nil t)
(match-beginning 1)
(point-max)))
nil
'outline)
(when hide-drawers (org-cycle-hide-drawers 'children))))
(defalias 'org-fold-show-hidden-entry #'org-fold-show-entry
"Show an entry where even the heading is hidden.")
(defun org-fold-show-siblings ()
"Show all siblings of the current headline."
(save-excursion
(while (org-goto-sibling) (org-fold-heading nil)))
(save-excursion
(while (org-goto-sibling 'previous)
(org-fold-heading nil))))
(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."
(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))
(max-level (org-get-valid-level
current-level
(if level (prefix-numeric-value level) 1)))
(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
(cond
((not (featurep 'org-inlinetask)) "")
(org-odd-levels-only (- (* 2 org-inlinetask-min-level)
3))
(t (1- org-inlinetask-min-level))))))
;; Display parent heading.
(org-fold-heading nil)
(forward-line)
;; Display children. First child may be deeper than expected
;; 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))
(org-fold-heading nil))))))
(defun org-fold-show-subtree ()
"Show everything after this heading at deeper levels."
(interactive)
(org-fold-region
(point) (save-excursion (org-end-of-subtree t t)) nil 'outline))
(defun org-fold-show-branches ()
"Show all subheadings of this heading, but not their bodies."
(interactive)
(org-fold-show-children 1000))
(defun org-fold-show-branches-buffer ()
"Show all branches in the buffer."
(org-fold-flag-above-first-heading)
(org-fold-hide-sublevels 1)
(unless (eobp)
(org-fold-show-branches)
(while (outline-get-next-sibling)
(org-fold-show-branches)))
(goto-char (point-min)))
;;;;; Blocks and drawers visibility
(defun org-fold--hide-wrapper-toggle (element category force no-error)
"Toggle visibility for ELEMENT.
ELEMENT is a block or drawer type parsed element. CATEGORY is
either `block' or `drawer'. When FORCE is `off', show the block
or drawer. If it is non-nil, hide it unconditionally. Throw an
error when not at a block or drawer, unless NO-ERROR is non-nil.
Return a non-nil value when toggling is successful."
(let ((type (org-element-type element)))
(cond
((memq type
(pcase category
(`drawer '(drawer property-drawer))
(`block '(center-block
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))
(start (save-excursion
(goto-char post)
(line-end-position)))
(end (save-excursion
(goto-char (org-element-property :end element))
(skip-chars-backward " \t\n")
(line-end-position))))
;; Do nothing when not before or at the block opening line or
;; at the block closing line.
(unless (let ((eol (line-end-position)))
(and (> eol start) (/= eol end)))
(org-fold-region start end
(cond ((eq force 'off) nil)
(force t)
((org-fold-folded-p start category) nil)
(t t))
category)
;; When the block is hidden away, make sure point is left in
;; a visible part of the buffer.
(when (invisible-p (max (1- (point)) (point-min)))
(goto-char post))
;; Signal success.
t)))
(no-error nil)
(t
(user-error (format "%s@%s: %s"
(buffer-file-name (buffer-base-buffer))
(point)
(if (eq category 'drawer)
"Not at a drawer"
"Not at a block")))))))
(defun org-fold-hide-block-toggle (&optional force no-error element)
"Toggle the visibility of the current block.
When optional argument FORCE is `off', make block visible. If it
is non-nil, hide it unconditionally. Throw an error when not at
a block, unless NO-ERROR is non-nil. When optional argument
ELEMENT is provided, consider it instead of the current block.
Return a non-nil value when toggling is successful."
(interactive)
(org-fold--hide-wrapper-toggle
(or element (org-element-at-point)) 'block force no-error))
(defun org-fold-hide-drawer-toggle (&optional force no-error element)
"Toggle the visibility of the current drawer.
When optional argument FORCE is `off', make drawer visible. If
it is non-nil, hide it unconditionally. Throw an error when not
at a drawer, unless NO-ERROR is non-nil. When optional argument
ELEMENT is provided, consider it instead of the current drawer.
Return a non-nil value when toggling is successful."
(interactive)
(org-fold--hide-wrapper-toggle
(or element (org-element-at-point)) 'drawer force no-error))
(defun org-fold-hide-block-all ()
"Fold all blocks in the current buffer."
(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)))
(org-fold--hide-drawers begin end)))
(defun org-fold--hide-drawers (begin end)
"Hide all drawers between BEGIN and END."
(save-excursion
(goto-char begin)
(while (and (< (point) end)
(re-search-forward org-drawer-regexp end t))
;; Skip folded drawers
(if (org-fold-folded-p nil 'drawer)
(goto-char (org-fold-next-folding-state-change 'drawer nil end))
(let* ((drawer (org-element-at-point))
(type (org-element-type drawer)))
(when (memq type '(drawer property-drawer))
(org-fold-hide-drawer-toggle t nil drawer)
;; 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))))))))
(defun org-fold-hide-archived-subtrees (beg end)
"Re-hide all archived subtrees after a visibility state change."
(org-with-wide-buffer
(let ((case-fold-search nil)
(re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
(goto-char beg)
;; Include headline point is currently on.
(beginning-of-line)
(while (and (< (point) end) (re-search-forward re end t))
(when (member org-archive-tag (org-get-tags nil t))
(org-fold-subtree t)
(org-end-of-subtree t))))))
;;;;; Reveal point location
(defun org-fold-show-context (&optional key)
"Make sure point and context are visible.
Optional argument KEY, when non-nil, is a symbol. See
`org-fold-show-context-detail' for allowed values and how much is to
be shown."
(org-fold-show-set-visibility
(cond ((symbolp org-fold-show-context-detail) org-fold-show-context-detail)
((cdr (assq key org-fold-show-context-detail)))
(t (cdr (assq 'default org-fold-show-context-detail))))))
(defvar org-hide-emphasis-markers); Defined in org.el
(defvar org-pretty-entities); Defined in org.el
(defun org-fold-show-set-visibility (detail)
"Set visibility around point according to DETAIL.
DETAIL is either nil, `minimal', `local', `ancestors',
`ancestors-full', `lineage', `tree', `canonical' or t. See
`org-show-context-detail' for more information."
;; Show current heading and possibly its entry, following headline
;; or all children.
(if (and (org-at-heading-p) (not (eq detail 'local)))
(org-fold-heading nil)
(org-fold-show-entry)
;; If point is hidden make sure to expose it.
(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.
(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))))))
(unless (org-before-first-heading-p)
(org-with-limited-levels
(cl-case detail
((tree canonical t) (org-fold-show-children))
((nil minimal ancestors ancestors-full))
(t (save-excursion
(outline-next-heading)
(org-fold-heading nil)))))))
;; Show whole subtree.
(when (eq detail 'ancestors-full) (org-fold-show-subtree))
;; Show all siblings.
(when (eq detail 'lineage) (org-fold-show-siblings))
;; Show ancestors, possibly with their children.
(when (memq detail '(ancestors ancestors-full lineage tree canonical t))
(save-excursion
(while (org-up-heading-safe)
(org-fold-heading nil)
(when (memq detail '(canonical t)) (org-fold-show-entry))
(when (memq detail '(tree canonical t)) (org-fold-show-children))))))
(defun org-fold-reveal (&optional siblings)
"Show current entry, hierarchy above it, and the following headline.
This can be used to show a consistent set of context around
locations exposed with `org-fold-show-context'.
With optional argument SIBLINGS, on each level of the hierarchy all
siblings are shown. This repairs the tree structure to what it would
look like when opened with hierarchical calls to `org-cycle'.
With a \\[universal-argument] \\[universal-argument] prefix, \
go to the parent and show the entire tree."
(interactive "P")
(run-hooks 'org-fold-reveal-start-hook)
(cond ((equal siblings '(4)) (org-fold-show-set-visibility 'canonical))
((equal siblings '(16))
(save-excursion
(when (org-up-heading-safe)
(org-fold-show-subtree)
(run-hook-with-args 'org-cycle-hook 'subtree))))
(t (org-fold-show-set-visibility 'lineage))))
;;; Make isearch search in some text hidden via text properties.
(defun org-fold--isearch-reveal (&rest _)
"Reveal text at POS found by isearch."
(org-fold-show-context 'isearch))
;;; Handling changes in folded elements
(defun org-fold--extend-changed-region (from to)
"Consider folded regions in the next/previous line when fixing
region visibility.
This function is intended to be used as a member of
`org-fold-core-extend-changed-region-functions'."
;; If the edit is done in the first line of a folded drawer/block,
;; the folded text is only starting from the next line and needs to
;; be checked.
(setq to (save-excursion (goto-char to) (line-beginning-position 2)))
;; If the ":END:" line of the drawer is deleted, the folded text is
;; only ending at the previous line and needs to be checked.
(setq from (save-excursion (goto-char from) (line-beginning-position 0)))
(cons from to))
(defun org-fold--reveal-headline-at-point ()
"Reveal header line and empty contents inside.
Reveal the header line and, if present, also reveal its contents, when
the contents consists of blank lines.
Assume that point is located at the header line."
(org-with-wide-buffer
(beginning-of-line)
(org-fold-region
(max (point-min) (1- (point)))
(let ((endl (line-end-position)))
(save-excursion
(goto-char endl)
(skip-chars-forward "\n\t\r ")
;; Unfold blank lines after newly inserted headline.
(if (equal (point)
(save-excursion
(goto-char endl)
(org-end-of-subtree)
(skip-chars-forward "\n\t\r ")))
(point)
endl)))
nil 'headline)))
(defun org-fold--reveal-outline-maybe (region _)
"Reveal folded outline in REGION when needed.
This function is intended to be used as :fragile property of
`org-fold-outline' spec. See `org-fold-core--specs' for details."
(save-match-data
(org-with-wide-buffer
(goto-char (car region))
;; The line before beginning of the fold should be either a
;; headline or a list item.
(backward-char)
(beginning-of-line)
;; Make sure that headline is not partially hidden.
(unless (org-fold-folded-p nil 'headline)
(org-fold--reveal-headline-at-point))
;; Never hide level 1 headlines
(save-excursion
(goto-char (line-end-position))
(unless (>= (point) (cdr region))
(when (re-search-forward (rx bol "* ") (cdr region) t)
(org-fold--reveal-headline-at-point))))
;; Make sure that headline after is not partially hidden.
(goto-char (cdr region))
(beginning-of-line)
(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)
(unless (let ((case-fold-search t))
(looking-at (rx-to-string
`(or (regex ,(org-item-re))
(regex ,org-outline-regexp-bol)))))
t))))
(defun org-fold--reveal-drawer-or-block-maybe (region spec)
"Reveal folded drawer/block (according to SPEC) in REGION when needed.
This function is intended to be used as :fragile property of
`org-fold-drawer' or `org-fold-block' spec."
(let ((begin-re (cond
((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer))
org-drawer-regexp)
;; Group one below contains the type of the block.
((eq spec (org-fold-core-get-folding-spec-from-alias 'block))
(rx bol (zero-or-more (any " " "\t"))
"#+begin"
(or ":"
(seq "_"
(group (one-or-more (not (syntax whitespace))))))))))
;; To be determined later. May depend on `begin-re' match (i.e. for blocks).
end-re)
(save-match-data ; we should not clobber match-data in after-change-functions
(let ((fold-begin (car region))
(fold-end (cdr region)))
(let (unfold?)
(catch :exit
;; The line before folded text should be beginning of
;; the drawer/block.
(save-excursion
(goto-char fold-begin)
;; The line before beginning of the fold should be the
;; first line of the drawer/block.
(backward-char)
(beginning-of-line)
(unless (let ((case-fold-search t))
(looking-at begin-re)) ; the match-data will be used later
(throw :exit (setq unfold? t))))
;; Set `end-re' for the current drawer/block.
(setq end-re
(cond
((eq spec (org-fold-core-get-folding-spec-from-alias 'drawer))
org-property-end-re)
((eq spec (org-fold-core-get-folding-spec-from-alias 'block))
(let ((block-type (match-string 1))) ; the last match is from `begin-re'
(concat (rx bol (zero-or-more (any " " "\t")) "#+end")
(if block-type
(concat "_"
(regexp-quote block-type)
(rx (zero-or-more (any " " "\t")) eol))
(rx (opt ":") (zero-or-more (any " " "\t")) eol)))))))
;; The last line of the folded text should match `end-re'.
(save-excursion
(goto-char fold-end)
(beginning-of-line)
(unless (let ((case-fold-search t))
(looking-at end-re))
(throw :exit (setq unfold? t))))
;; There should be no `end-re' or
;; `org-outline-regexp-bol' anywhere in the
;; drawer/block body.
(save-excursion
(goto-char fold-begin)
(when (save-excursion
(let ((case-fold-search t))
(re-search-forward (rx-to-string `(or (regex ,end-re)
(regex ,org-outline-regexp-bol)))
(max (point)
(1- (save-excursion
(goto-char fold-end)
(line-beginning-position))))
t)))
(throw :exit (setq unfold? t)))))
unfold?)))))
;; Catching user edits inside invisible text
(defun org-fold-check-before-invisible-edit (kind)
"Check if editing KIND is dangerous with invisible text around.
The detailed reaction depends on the user option
`org-fold-catch-invisible-edits'."
;; First, try to get out of here as quickly as possible, to reduce overhead
(when (and org-fold-catch-invisible-edits
(or (not (boundp 'visible-mode)) (not visible-mode))
(or (org-invisible-p)
(org-invisible-p (max (point-min) (1- (point))))))
;; OK, we need to take a closer look. Only consider invisibility
;; caused by folding of headlines, drawers, and blocks. Edits
;; inside links will be handled by font-lock.
(let* ((invisible-at-point (org-fold-folded-p (point) '(headline drawer block)))
(invisible-before-point
(and (not (bobp))
(org-fold-folded-p (1- (point)) '(headline drawer block))))
(border-and-ok-direction
(or
;; Check if we are acting predictably before invisible
;; text.
(and invisible-at-point (not invisible-before-point)
(memq kind '(insert delete-backward)))
;; Check if we are acting predictably after invisible text
;; This works not well, and I have turned it off. It seems
;; better to always show and stop after invisible text.
;; (and (not invisible-at-point) invisible-before-point
;; (memq kind '(insert delete)))
)))
(when (or invisible-at-point invisible-before-point)
(when (eq org-fold-catch-invisible-edits 'error)
(user-error "Editing in invisible areas is prohibited, make them visible first"))
(if (and org-custom-properties-overlays
(y-or-n-p "Display invisible properties in this buffer? "))
(org-toggle-custom-properties-visibility)
;; Make the area visible
(save-excursion
(org-fold-show-set-visibility 'local))
(when invisible-before-point
(org-with-point-at (1- (point)) (org-fold-show-set-visibility 'local)))
(cond
((eq org-fold-catch-invisible-edits 'show)
;; That's it, we do the edit after showing
(message
"Unfolding invisible region around point before editing")
(sit-for 1))
((and (eq org-fold-catch-invisible-edits 'smart)
border-and-ok-direction)
(message "Unfolding invisible region around point before editing"))
(t
;; Don't do the edit, make the user repeat it in full visibility
(user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
(provide 'org-fold)
;;; org-fold.el ends here

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

@ -4,7 +4,7 @@
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -28,6 +28,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
;;;; Declarations
(require 'cl-lib)
@ -39,7 +42,7 @@
(declare-function org-back-over-empty-lines "org" ())
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-edit-footnote-reference "org-src" ())
(declare-function org-element-at-point "org-element" ())
(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))
@ -52,7 +55,7 @@
(declare-function org-inside-LaTeX-fragment-p "org" ())
(declare-function org-inside-latex-macro-p "org" ())
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-show-context "org" (&optional key))
(declare-function org-fold-show-context "org-fold" (&optional key))
(declare-function outline-next-heading "outline")
(defvar electric-indent-mode)
@ -91,13 +94,13 @@ Match group 1 contains definition's label.")
(defcustom org-footnote-section "Footnotes"
"Outline heading containing footnote definitions.
This can be nil, to place footnotes locally at the end of the
current outline node. If can also be the name of a special
outline heading under which footnotes should be put.
This can be nil, to place footnotes locally at the end of the current
outline node. It can also be a string representing the name of a
special outline heading under which footnotes should be put.
This variable defines the place where Org puts the definition
automatically, i.e. when creating the footnote, and when sorting
the notes. However, by hand you may place definitions
the notes. However, by hand, you may place definitions
*anywhere*.
If this is a string, during export, all subtrees starting with
@ -110,7 +113,7 @@ you will need to run the following command after the change:
:group 'org-footnote
:initialize 'custom-initialize-default
:set (lambda (var val)
(set var val)
(set-default-toplevel-value var val)
(when (fboundp 'org-element-cache-reset)
(org-element-cache-reset 'all)))
:type '(choice
@ -555,7 +558,7 @@ value if point was successfully moved."
(goto-char def-start)
(looking-at (format "\\[fn:%s[]:]" (regexp-quote label)))
(goto-char (match-end 0))
(org-show-context 'link-search)
(org-fold-show-context 'link-search)
(when (derived-mode-p 'org-mode)
(message "%s" (substitute-command-keys
"Edit definition and go back with \
@ -581,7 +584,7 @@ value if point was successfully moved."
(user-error "Reference is outside narrowed part of buffer")))
(org-mark-ring-push)
(goto-char start)
(org-show-context 'link-search)))
(org-fold-show-context 'link-search)))
;;;; Getters

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

@ -22,6 +22,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org)
(require 'org-refile)
@ -110,10 +113,8 @@ When nil, you can use these keybindings to navigate the buffer:
(org-defkey map [(down)] 'outline-next-visible-heading)
(org-defkey map [(up)] 'outline-previous-visible-heading)
(if org-goto-auto-isearch
(if (fboundp 'define-key-after)
(define-key-after map [t] 'org-goto-local-auto-isearch)
nil)
(org-defkey map "q" 'org-goto-quit)
(define-key-after map [t] 'org-goto-local-auto-isearch)
(org-defkey map "q" 'org-goto-quit)
(org-defkey map "n" 'outline-next-visible-heading)
(org-defkey map "p" 'outline-previous-visible-heading)
(org-defkey map "f" 'outline-forward-same-level)
@ -157,7 +158,7 @@ When nil, you can use these keybindings to navigate the buffer:
(when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char)
(isearch-mode t)
(isearch-process-search-char (string-to-char keys))
(org-font-lock-ensure))))
(font-lock-ensure))))
(defun org-goto-ret (&optional _arg)
"Finish `org-goto' by going to the new location."
@ -222,13 +223,13 @@ position or nil."
" Just type for auto-isearch."
" n/p/f/b/u to navigate, q to quit.")))))
(org-fit-window-to-buffer (get-buffer-window "*Org Help*"))
(org-overview)
(org-cycle-overview)
(setq buffer-read-only t)
(if (and (boundp 'org-goto-start-pos)
(integer-or-marker-p org-goto-start-pos))
(progn (goto-char org-goto-start-pos)
(when (org-invisible-p)
(org-show-set-visibility 'lineage)))
(org-fold-show-set-visibility 'lineage)))
(goto-char (point-min)))
(let (org-special-ctrl-a/e) (org-beginning-of-line))
(message "Select location and press RET")
@ -279,7 +280,7 @@ With a prefix argument, use the alternative interface: e.g., if
(org-mark-ring-push org-goto-start-pos)
(goto-char selected-point)
(when (or (org-invisible-p) (org-invisible-p2))
(org-show-context 'org-goto)))
(org-fold-show-context 'org-goto)))
(message "Quit"))))
(provide 'org-goto)

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

@ -4,7 +4,7 @@
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -28,6 +28,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'cl-lib)
(require 'org)
(require 'org-agenda)
@ -423,8 +426,7 @@ current time."
"Insert consistency graph for any habitual tasks."
(let ((inhibit-read-only t)
(buffer-invisibility-spec '(org-link))
(moment (org-time-subtract nil
(* 3600 org-extend-today-until))))
(moment (time-subtract nil (* 3600 org-extend-today-until))))
(save-excursion
(goto-char (if line (line-beginning-position) (point-min)))
(while (not (eobp))

66
lisp/org/org-id.el
View file

@ -4,7 +4,7 @@
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -70,12 +70,17 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org)
(require 'org-refile)
(require 'ol)
(declare-function message-make-fqdn "message" ())
(declare-function org-goto-location "org-goto" (&optional _buf help))
;; Declared inside `org-element-with-disabled-cache' macro.
(declare-function org-element--cache-active-p "org-element.el" (&optional called-from-cache-change-func-p))
;;; Customization
@ -330,7 +335,7 @@ Move the cursor to that entry in that buffer."
(pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)))
(org-fold-show-context)))
;;;###autoload
(defun org-id-find (id &optional markerp)
@ -488,8 +493,8 @@ and TIME is a Lisp time value (HI LO USEC)."
(defun org-id-update-id-locations (&optional files silent)
"Scan relevant files for IDs.
Store the relation between files and corresponding IDs.
This will scan all agenda files, all associated archives, and all
files currently mentioned in `org-id-locations'.
This will scan all agenda files, all associated archives, all open Org
files, and all files currently mentioned in `org-id-locations'.
When FILES is given, scan also these files.
If SILENT is non-nil, messages are suppressed."
(interactive)
@ -512,6 +517,8 @@ If SILENT is non-nil, messages are suppressed."
org-id-extra-files)
;; All files known to have IDs.
org-id-files
;; All Org files open in Emacs.
(mapcar #'buffer-file-name (org-buffer-list 'files t))
;; Additional files from function call.
files)))))
(nfiles (length files))
@ -521,30 +528,31 @@ If SILENT is non-nil, messages are suppressed."
(ndup 0)
(i 0))
(with-temp-buffer
(delay-mode-hooks
(org-mode)
(dolist (file files)
(when (file-exists-p file)
(unless silent
(cl-incf i)
(message "Finding ID locations (%d/%d files): %s" i nfiles file))
(insert-file-contents file nil nil nil 'replace)
(let ((ids nil)
(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)))
(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))
(silent nil)
(t
(message "Duplicate ID %S" id)
(cl-incf ndup)))))))))))
(org-element-with-disabled-cache
(delay-mode-hooks
(org-mode)
(dolist (file files)
(when (file-exists-p file)
(unless silent
(cl-incf i)
(message "Finding ID locations (%d/%d files): %s" i nfiles file))
(insert-file-contents file nil nil nil 'replace)
(let ((ids nil)
(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)))
(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))
(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.
@ -741,7 +749,7 @@ or filename if no title."
(funcall cmd (marker-buffer m)))
(goto-char m)
(move-marker m nil)
(org-show-context)))
(org-fold-show-context)))
(org-link-set-parameters "id" :follow #'org-id-open)

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

@ -4,7 +4,7 @@
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
@ -36,6 +36,9 @@
;;
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org-macs)
(require 'org-compat)
(require 'org)
@ -330,7 +333,7 @@ stopped."
(let* ((case-fold-search t)
(limited-re (org-get-limited-outline-regexp))
(level (or (org-current-level) 0))
(time-limit (and delay (org-time-add nil delay))))
(time-limit (and delay (time-add nil delay))))
;; For each line, set `line-prefix' and `wrap-prefix'
;; properties depending on the type of line (headline, inline
;; task, item or other).
@ -343,7 +346,7 @@ stopped."
;; In asynchronous mode, take a break of
;; `org-indent-agent-resume-delay' every DELAY to avoid
;; blocking any other idle timer or process output.
((and delay (org-time-less-p time-limit nil))
((and delay (time-less-p time-limit nil))
(setq org-indent-agent-resume-timer
(run-with-idle-timer
(time-add (current-idle-time) org-indent-agent-resume-delay)
@ -409,7 +412,13 @@ This function is meant to be called by `after-change-functions'."
(goto-char beg)
(beginning-of-line)
(re-search-forward
(org-with-limited-levels org-outline-regexp-bol) end t)))
(org-with-limited-levels org-outline-regexp-bol)
(save-excursion
(goto-char end)
;; Extend to headline if END is within its
;; headline stars.
(line-end-position))
t)))
(let ((end (save-excursion
(goto-char end)
(org-with-limited-levels (outline-next-heading))

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

@ -4,7 +4,7 @@
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
@ -78,6 +78,9 @@
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'org)
(defgroup org-inlinetask nil
@ -305,8 +308,10 @@ If the task has an end part, also demote it."
(add-text-properties (match-beginning 3) (match-end 3)
'(face org-inlinetask font-lock-fontified t)))))
(defun org-inlinetask-toggle-visibility ()
"Toggle visibility of inline task at point."
(defun org-inlinetask-toggle-visibility (&optional state)
"Toggle visibility of inline task at point.
When optional argument STATE is `fold', fold unconditionally.
When STATE is `unfold', unfold unconditionally."
(let ((end (save-excursion
(org-inlinetask-goto-end)
(if (bolp) (1- (point)) (point))))
@ -317,9 +322,11 @@ If the task has an end part, also demote it."
;; Nothing to show/hide.
((= end start))
;; Inlinetask was folded: expand it.
((eq (get-char-property (1+ start) 'invisible) 'outline)
(org-flag-region start end nil 'outline))
(t (org-flag-region start end t 'outline)))))
((and (not (eq state 'fold))
(or (eq state 'unfold)
(org-fold-get-folding-spec 'headline (1+ start))))
(org-fold-region start end nil 'headline))
(t (org-fold-region start end t 'headline)))))
(defun org-inlinetask-hide-tasks (state)
"Hide inline tasks in buffer when STATE is `contents' or `children'.
@ -330,14 +337,14 @@ This function is meant to be used in `org-cycle-hook'."
(save-excursion
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(org-inlinetask-toggle-visibility)
(org-inlinetask-toggle-visibility 'fold)
(org-inlinetask-goto-end)))))
(`children
(save-excursion
(while
(or (org-inlinetask-at-task-p)
(and (outline-next-heading) (org-inlinetask-at-task-p)))
(org-inlinetask-toggle-visibility)
(org-inlinetask-toggle-visibility 'fold)
(org-inlinetask-goto-end))))))
(defun org-inlinetask-remove-END-maybe ()

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

@ -1,17 +0,0 @@
;;; org-install.el --- backward compatibility file for obsolete configuration -*- lexical-binding: t -*-
;;
;;; Code:
;;
;; The file org-install is obsolete.
;;
;; It is provided here so that (require 'org-install) does not
;; trigger an error for users with obsolete Emacs configuration.
;; You can safely remove (require 'org-install) from your config."
(provide 'org-install)
;; Local Variables:
;; no-byte-compile: t
;; coding: utf-8
;; End:
;;; org-install.el ends here

Some files were not shown because too many files have changed in this diff Show more