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

Update Org to 9.3

Browse source
This commit is contained in:
Bastien 2019-12-03 23:27:04 +01:00
parent 821de96843
commit 165f738382
101 changed files with 34257 additions and 26610 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28365
doc/misc/org.texi
View file

File diff suppressed because it is too large Load diff

922
etc/ORG-NEWS
View file

@ -1,5 +1,7 @@
ORG NEWS -- history of user-visible changes. -*- mode: org; coding: utf-8 -*-
#+STARTUP: overview
#+LINK: doc https://orgmode.org/worg/doc.html#%s
#+LINK: git https://code.orgmode.org/bzg/org-mode/commit/%s
@ -8,6 +10,907 @@ See the end of the file for license conditions.
Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
* Version Next
** New features
*** Property drawers before first headline, outline level 0
Property drawers will now work before first headline and Org mode is
moving more towards making things before the first headline behave
just as if it was at outline level 0. Inheritance for properties will
work also for this level. In other words; defining things in a
property drawer before the first headline will make them "inheritable"
for all headlines.
* Version 9.3
** Incompatible changes
*** Change bracket link escaping syntax
Org used to percent-encode sensitive characters in the URI part of the
bracket links.
Now, escaping mechanism uses the usual backslash character, according
to the following rules, applied in order:
1. All consecutive =\= characters at the end of the link must be
escaped;
2. Any =]= character at the very end of the link must be escaped;
3. All consecutive =\= characters preceding =][= or =]]= patterns must
be escaped;
4. Any =]= character followed by either =[= or =]= must be escaped;
5. Others =]= and =\= characters need not be escaped.
When in doubt, use the function ~org-link-escape~ in order to turn
a link string into its properly escaped form.
The following function will help switching your links to the new
syntax:
#+begin_src emacs-lisp
(defun org-update-link-syntax (&optional no-query)
"Update syntax for links in current buffer.
Query before replacing a link, unless optional argument NO-QUERY
is non-nil."
(interactive "P")
(org-with-point-at 1
(let ((case-fold-search t))
(while (re-search-forward "\\[\\[[^]]*?%\\(?:2[05]\\|5[BD]\\)" nil t)
(let ((object (save-match-data (org-element-context))))
(when (and (eq 'link (org-element-type object))
(= (match-beginning 0)
(org-element-property :begin object)))
(goto-char (org-element-property :end object))
(let* ((uri-start (+ 2 (match-beginning 0)))
(uri-end (save-excursion
(goto-char uri-start)
(re-search-forward "\\][][]" nil t)
(match-beginning 0)))
(uri (buffer-substring-no-properties uri-start uri-end)))
(when (or no-query
(y-or-n-p
(format "Possibly obsolete URI syntax: %S. Fix? "
uri)))
(setf (buffer-substring uri-start uri-end)
(org-link-escape (org-link-decode uri)))))))))))
#+end_src
The old ~org-link-escape~ and ~org-link-unescape~ functions have been
renamed into ~org-link-encode~ and ~org-link-decode~.
*** Change match group number in ~org-link-bracket-re~
Link description, if any, is located in match group 2 instead of match
group 3.
*** ob-clojure does not auto prepend ~(ns ..)~ statement anymore
When tangling, user usually just wants to tangle literally code instead
of prepend inserting a ~(ns ..)~ statement before source block
code. Now, when you have no ~:ns~ header argument specified, this
behavior will not happen automatically.
*** Change in behavior on exit from an Org edit buffer
Org will no longer attempt to restore the window configuration in the
frame to which the user returns after editing a source block with
~org-edit-src-code~. Instead, the window configuration will remain as
it is.
*** Change default value for ~org-email-link-description-format~
When linking from a mail buffer, Org used to truncate the subject of
the message to 30 characters in order to build the description of the
link. This behavior was considered as too surprising. As
a consequence, Org no longer truncates subjects.
You can get the old behaviour back with the following:
: (setq org-email-link-description-format "Email %c: %.30s")
*** ~:file~ header argument no longer assume "file" ~:results~
The "file" ~:results~ value is now mandatory for a code block
returning a link to a file. The ~:file~ or ~:file-ext~ header
arguments no longer imply a "file" result is expected.
*** Plain numbers are hours in Column View mode
See [[git:3367ac9457]] for details.
*** All LaTeX preview backends use now xcolor
The dvipng backend was previously relying on fg and bg parameters to
be passed to the CLI. This didn't work when xcolor was directly or
indirectly used in the document (e.g. tkiz is a user of xcolor). Since
every other backend was already using xcolor to set fg and bg, the CLI
alternative was removed and there is no more a :use-xcolor options
since now it's implicitly always true.
*** Org-Attach Git commit
[[*Org-Attach has been refactored and extended][Refactoring of Org-Attach]] affected the Git commit functionality. Not
much, but the following changes are required if you still need to
auto-commit attachments to git:
- Customization of ~org-attach-annex-auto-get~ needs to be renamed to
~org-attach-git-annex-auto-get~.
- Customization of ~org-attach-commit~ is no longer needed. Instead
one need to require the =org-attach-git= module in the startup.
** New features
*** New option to wrap source code lines in HTML export
When new option ~html-wrap-src-lines~ (with variable
~org-html-wrap-src-lines~) is non-nil, HTML export wraps source code
lines in HTML ~code~ elements.
*** New option to handle schedules and deadlines in iCalendar export
Export ignore done tasks with a deadline when
~org-icalendar-use-deadline~ contains ~event-if-todo-not-done~.
Likewise, scheduled done tasks are also ignored when
~org-icalendar-use-scheduled~ contains the same symbol.
*** Add split-window-right option for src block edit window placement
Given the increasing popularity of wide screen monitors, splitting
horizontally may make more sense than splitting vertically. An
option, ~split-window-right~, to request horizontal splitting has been
added to ~org-src-window-setup~.
*** Org-Attach has been refactored and extended
Org attach has been refactored and the functionality extended. It
should now be easier to understand how it works. A few improvements
and extra options have been added as well.
From the initial comment in org-attach source-code:
- Attachments are managed either by using a custom property DIR or by
using property ID from org-id. When DIR is defined, a location in
the filesystem is directly attached to the outline node. When
org-id is used, attachments are stored in a folder named after the
ID, in a location defined by ~org-attach-id-dir~. DIR has
precedence over ID when both parameters are defined for the current
outline node (also when inherited parameters are taken into
account).
From now on inheritance requires no extra property and will adhere to
~org-attach-use-inheritance~ by default. Inheritance can be
customized to always be activated or never be activated in
~org-attach-use-inheritance~.
The ATTACH_DIR property is deprecated in favour of the shorter
property DIR. Links to folders inside the DIR property can now be
declared as relative links. This is not enabled by default, but can
be set in ~org-attach-dir-relative~.
When adding new attachment to the outline node the preferred way of
doing so can be customized. Take a look at
~org-attach-preferred-new-method~. It defaults to using ID since that
was the behaviour before this change.
If both DIR and ID properties are set on the same node, DIR has
precedence and will be used.
One can now also choose to build attachment-directory-paths in a
customized way. This is an advanced topic, but in some case it makes
sense to parse an ID in a different way than the default one. Create
your own function and add it to the beginning of
~org-attach-id-to-path-function~list~ if you want to customize the ID
based folder structure.
If you've used ATTACH_DIR properties to manage attachments, use the
following code to rename that property to DIR which supports the same
functionality. ATTACH_DIR_INHERIT is no longer supported and is
removed.
#+begin_src emacs-lisp
(defun org-update-attach-properties ()
"Change properties for Org-Attach."
(interactive)
(org-with-point-at 1
(while (outline-next-heading)
(let ((DIR (org--property-local-values "ATTACH_DIR" nil)))
(when DIR
(org-set-property "DIR" (car DIR))
(org-delete-property "ATTACH_DIR"))))
(org-delete-property-globally "ATTACH_DIR_INHERIT")))
#+end_src
For those who hate breaking changes, even though the changes are made
to clean things up; fear not. ATTACH_DIR will still continue to work.
It's just not documented any longer. When you get the chance, run the
code above to clean things up anyways!
**** New hooks
Two hooks are added to org-attach:
- org-attach-after-change-hook
- org-attach-open-hook
They are added mostly for internal restructuring purposes, but can
ofc. be used for other things as well.
*** New link-type: Attachment
Attachment-links are now first-class citizens. They mimic file-links
in everything they do but use the existing attachment-folder as a base
when expanding the links. Both =DIR= and =ID= properties are used to
try to resolve the links, in exactly the same way as Org-Attach uses
those properties.
*** Handle overlay specification for notes in Beamer export
This aligns Beamer notes with slide overlays.
*** Add support for lettered lists in Texinfo
Using =:enum A= or =:enum a= Texinfo attribute switches an otherwise
numbered list to a lettered list.
*** Add a dispatcher command to insert dynamic blocks
You can add new dynamic blocks with function
~org-dynamic-block-define~. All such dynamic blocks can be used by
~org-dynamic-block-insert-dblock~ command.
*** Babel
**** ob-emacs-lisp sets ~lexical-binding~ in Org edit buffers
When editing an Elisp src block, the editing buffer's
~lexical-binding~ is set according to the src block's =:lexical=
parameter.
**** Add LaTeX output support in PlantUML
*** New minor mode to display headline numbering
Use =<M-x org-num-mode>= to get a visual indication of the numbering
in the outline. The numbering is also automatically updated upon
changes in the buffer.
*** New property =HTML_HEADLINE_CLASS= in HTML export
The new property =HTML_HEADLINE_CLASS= assigns a class attribute to
a headline.
*** Allow LaTeX attributes and captions for "table.el" tables
Supported LaTeX attributes are ~:float~, ~:center~, ~:font~ and
~:caption~.
*** Attach buffer contents to headline
With =<b>= key from attachment dispatcher (=<C-c C-a>=), it is now
possible to write the contents of a buffer to a file in the headline
attachment directory.
*** iCalendar export respects a =CLASS= property
Set the =CLASS= property on an entry to specify a visibility class for
that entry only during iCalendar export. The property can be set to
anything the calendar server supports. The iCalendar standard defines
the values =PUBLIC=, =CONFIDENTIAL=, =PRIVATE=, which can be
interpreted as publicly visible, accessible to a specific group, and
private respectively.
This property can be inherited during iCalendar export, depending on
the value of ~org-use-property-inheritance~.
*** New parameter for =INCLUDE= keyword
Add =:coding CODING-SYSTEM= to include files using a different coding
system than the main Org document. For example:
#+begin_example
,#+INCLUDE: "myfile.cmd" src cmd :coding cp850-dos
#+end_example
*** New values in clock tables' step: =month= and =year=
*** ODT export handles numbers cookies in lists
*** New cell movement functions in tables
~S-<UP>~, ~S-<DOWN>~, ~S-<RIGHT>~, and ~S-<LEFT>~ now move cells in
the corresponding direction by swapping with the adjacent cell.
*** New option to natively fontify LaTeX snippets and environments
A 'native option was added to org-highlight-latex-and-related. It
matches the same structures than 'latex but it calls
org-src-font-lock-fontify-block instead, thus bringing about full
LaTeX font locking.
*** ~org-clone-subtree-with-time-shift~ learnt to shift backward in time
=<C-c C-x c>= (~org-clone-subtree-with-time-shift~) now takes a
negative value as a valid repeater to shift time stamps in backward
in cloned subtrees. You can give, for example, ‘-3d’ to shift three
days in the past.
*** Toggle display of all vs. undone scheduled habits conveniently
=<C-u K>= (~org-habit-toggle-display-in-agenda~) in an agenda toggles
the display of all habits to those which are undone and scheduled.
This is a function for convenience.
*** New parameter for SQL Babel blocks: ~:dbconnection~
The new parameter ~:dbconnection~ allows to specify a connection name
in a SQL block header: this name is used to look up connection
parameters in ~sql-connection-alist~.
*** New =:scale= attribute supported by LaTeX exporters
The builtin "latex" exporters now accept and use a =:scale= attribute,
which scales an image by a given factor.
This attribute is wrapped adound the =scale= parameter of LaTeX's
=\includegraphics= (bitmap images) or a TiKZ's =\scalebox=.
Therefore, its value should be some string palatable to LaTeX as
a positive float Its default value is an empty string (i.e. disabled).
This attribute overrides the =:width= and =:height= attributes.
#+begin_example
,#+name: Beastie
,#+caption: I think I saw this curious horse already, but where ?
,#+LATEX_ATTR: :scale 2
[[https://orgmode.org/img/org-mode-unicorn-logo.png]]
#+end_example
*** Allow specifying the target for a table of contents
The =+TOC= keyword now accepts a =:target:= attribute that specifies
the headline to use for making the table of contents.
#+begin_example
,* Target
:PROPERTIES:
:CUSTOM_ID: TargetSection
:END:
,** Heading A
,** Heading B
,* Another section
,#+TOC: headlines 1 :target "#TargetSection"
#+end_example
** New functions
*** ~org-dynamic-block-insert-dblock~
Use default keybinding =<C-c C-x x>= to run command
~org-dynamic-block-insert-dblock~. It will prompt user to select
dynamic block in ~org-dynamic-block-alist~.
*** ~org-table-cell-up~
*** ~org-table-cell-down~
*** ~org-table-cell-left~
*** ~org-table-cell-right~
*** ~org-habit-toggle-display-in-agenda~
** Removed functions and variables
*** Removed Org Drill
You can install it back from MELPA.
*** ~org-babel-set-current-result-hash~
*** ~org-capture-insert-template-here~
*** ~org-attach-directory~
It has been deprecated in favour of ~org-attach-id-dir~ which is less
ambiguous given the restructured org-attach.
*** ~org-enable-fixed-width-editor~
This variable was not used through the code base.
** Miscellaneous
*** Change signature for ~org-list-to-subtree~
The function now accepts the level of the subtree as an optional
argument. It no longer deduces it from the current level.
*** LaTeX preview is simplified
Function ~org-latex-preview~, formerly known as
~org-toggle-latex-fragment~, has a hopefully simpler and more
predictable behavior. See its docstring for details.
*** ~org-table-copy-down~ supports patterns
When ~org-table-copy-increment~ is non-nil, it is now possible to
increment fields like =A1=, or =0A=, i.e., any string prefixed or
suffixed with a whole number.
*** No more special indentation for description items
Descriptions items are indented like regular ones, i.e., text starts
after the bullet. Special indentation used to introduce bugs when
inserting sub-items in a description list.
*** New hook: ~org-todo-repeat-hook~
This hook was actually introduced in Org 9.2.1, but wasn't advertised.
*** Org Table reads numbers starting with 0 as strings
*** Disable fast tag selection interface via prefix arg
A call of ~org-set-tags-command~ with prefix argument C-u C-u avoids
the fast tag selection interface and instead offers the plain
interface.
*** ~:mkdirp~ now supports create directory for ~:dir~ path
The ~:mkdirp~ header argument used to only work for ~:tangle~ tangle
files. Now ~:mkdirp~ works for ~:dir~ too. This is more convenient for
specify default directory and with ~:file~ header argument.
*** New variable: ~org-agenda-breadcrumbs-separator~
If breadcrumbs are showed in org-agenda with the help of "%b" format
in ~org-agenda-prefix-format~, user can customize breadcrumbs's
separator using ~org-agenda-breadcrumbs-separator~.
*** New variable ~org-attach-commands~
This variable makes it possible to customize the list of commands for
the attachment dispatcher.
*** New ID method based on timestamp
If one chooses, it is now possible to create ID's based on timestamp
(ISO8601) instead of UUID by changing org-id-method to ts.
For an improved folder structure when using timestamp as ID, make sure
to promote ~org-attach-id-ts-folder-format~ to the first element of
~org-attach-id-to-path-function-list~ in your configuration at the
same time.
*** New customization: ~org-id-locations-relative~
New customization to make the persisting of org-id-locations between
sessions to store links to files as relative instead of absolute. The
links will be stored as relative to the path of org-id-locations-file.
*** ~org-ctrl-c-tab~ is functional before the first headline
I.e. treat the whole file as if it was a subtree.
Also fold everything below the chosen level. Former behavior was to
leave unfolded subtrees unfolded.
*** ~org-kill-note-or-show-branches~ is functional before the first headline
I.e. treat the whole file as if it was a subtree.
*** Respect narrowing when agenda command is restricted to buffer
* Version 9.2
** Incompatible changes
*** Removal of OrgStruct mode mode and radio lists
OrgStruct minor mode and radio lists mechanism (~org-list-send-list~
and ~org-list-radio-lists-templates~) are removed from the code base.
Note that only radio /lists/ have been removed, not radio tables.
If you want to manipulate lists like in Org in other modes, we suggest
to use orgalist.el, which you can install from GNU ELPA.
If you want to use Org folding outside of Org buffers, you can have a
look at the outshine package in the MELPA repository.
*** Change in the structure template expansion
Org 9.2 comes with a new template expansion mechanism, combining
~org-insert-structure-template~ bound to ~C-c C-,~.
If you customized the ~org-structure-template-alist~ option manually,
you probably need to update it, see the docstring for accepted values.
If you prefer using previous patterns, e.g. =<s=, you can activate
them again by requiring Org Tempo library:
: (require 'org-tempo)
or add it to ~org-modules~.
If you need complex templates, look at the ~tempo-define-template~
function or at solutions like Yasnippet.
*** Change to Noweb expansion
Expansion check =:noweb-ref= only if no matching named block is found
in the buffer. As a consequence, any =:noweb-ref= value matching the
name of a source block in the buffer is ignored. A simple fix is to
give every concerned source-block, including the named one, a new,
unique, Noweb reference.
#+BEGIN_SRC org
,#+NAME: foo
,#+BEGIN_SRC emacs-lisp
1
,#+END_SRC
,#+BEGIN_SRC emacs-lisp :noweb-ref foo
2
,#+END_SRC
,#+BEGIN_SRC emacs-lisp :noweb yes
<<foo>>
,#+END_SRC
#+END_SRC
should become
#+BEGIN_SRC org
,#+NAME: foo
,#+BEGIN_SRC emacs-lisp :noweb-ref bar
1
,#+END_SRC
,#+BEGIN_SRC emacs-lisp :noweb-ref bar
2
,#+END_SRC
,#+BEGIN_SRC emacs-lisp :noweb yes
<<bar>>
,#+END_SRC
#+END_SRC
*** Default/accepted values of ~org-calendar-to-agenda-key~
The default value and accepted value of ~org-calendar-to-agenda-key~
changed. This is an excerpt of the new docstring:
: When set to ‘default’, bind the function to ‘c’, but only if it is
: available in the Calendar keymap. This is the default choice because
: ‘c’ can then be used to switch back and forth between agenda and calendar.
:
: When nil, ‘org-calendar-goto-agenda’ is not bound to any key.
Check the full docstring for more.
*** Change the signature of the ~org-set-effort~ function
Here is the new docstring:
: (org-set-effort &optional INCREMENT VALUE)
:
: Set the effort property of the current entry.
: If INCREMENT is non-nil, set the property to the next allowed
: value. Otherwise, if optional argument VALUE is provided, use
: it. Eventually, prompt for the new value if none of the previous
: variables is set.
*** Placeholders in =(eval ...)= macros are always strings
Within =(eval ...)= macros, =$1=-like placeholders are always replaced
with a string. As a consequence, they must not be enclosed within
quotes. As an illustration, consider the following, now valid,
examples:
#+begin_example
,#+macro: join (eval (concat $1 $2))
,#+macro: sum (eval (+ (string-to-number $1) (string-to-number $2)))
{{{join(a,b)}}} => ab
{{{sum(1,2)}}} => 3
#+end_example
However, there is no change in non-eval macros:
#+begin_example
,#+macro: disp argument: $1
{{{disp(text)}}} => argument: text
#+end_example
*** =align= STARTUP value no longer narrow table columns
Columns narrowing (or shrinking) is now dynamic. See [[*Dynamically
narrow table columns]] for details. In particular, it is decoupled from
aligning.
If you need to automatically shrink columns upon opening an Org
document, use =shrink= value instead, or in addition to align:
#+BEGIN_EXAMPLE
,#+STARTUP: align shrink
#+END_EXAMPLE
*** ~org-get-tags~ meaning change
Function ~org-get-tags~ used to return local tags to the current
headline. It now returns all the inherited tags in addition to the
local tags. In order to get the old behaviour back, you can use:
: (org-get-tags nil t)
*** Alphabetic sorting in tables and lists
When sorting alphabetically, ~org-table-sort-lines~ and ~org-sort-list~
now sort according to the locale’s collation rules instead of by
code-point.
*** Change the name of the :tags clocktable option to :match
The =:match= (renamed from =:tags=) option allows to limit clock entries
to those matching a todo-tags matcher.
The old =:tags= option can be set to =t= to display a headline's tags in a
dedicated column.
This is consistent with the naming of =org-dblock-write:columnview=
options, where =:match= is also used as a headlines filter.
** New features
*** Add ~:session~ support of ob-clojure for CIDER
You can initialize source block session with Babel default keybinding
=[C-c C-v C-z]= to use =sesman= session manager to link current
project, directory or buffer with specific Clojure session, or
=cider-jack-in= a new CIDER REPL if no CIDER REPLs available. In older
CIDER version which has not =sesman= integrated, only has
=cider-jack-in= without Clojure project is supported.
#+begin_src clojure :session
(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
~:file~ header argument, without actually writing any result to it:
#+begin_example
,#+begin_src shell :dir "data/tmp" :results link :file "crackzor_1.0.c.gz"
wget -c "http://ben.akrin.com/crackzor/crackzor_1.0.c.gz"
,#+end_src
,#+results:
[[file:data/tmp/crackzor_1.0.c.gz]]
#+end_example
*** Add ~:session~ support of ob-js for js-comint
#+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.
*** Org Tempo may used for snippet expansion of structure template.
See manual and the commentary section in ~org-tempo.el~ for details.
*** Exclude unnumbered headlines from table of contents
Set their =UNNUMBERED= property to the special =notoc= value. See
manual for details.
*** ~org-archive~ functions update status cookies
Archiving headers through ~org-archive-subtree~ and
~org-archive-to-archive-sibling~ such as the ones listed below:
#+BEGIN_SRC org
,* Top [1/2]
,** DONE Completed
,** TODO Working
#+END_SRC
Will update the status cookie in the top level header.
*** Disable =org-agenda-overriding-header= by setting to empty string
The ~org-agenda-overriding-header~ inserted into agenda views can now
be disabled by setting it to an empty string.
*** Dynamically narrow table columns
With ~C-c TAB~, it is now possible to narrow a column to the width
specified by a width cookie in the column, or to 1 character if there
is no such cookie. The same keybinding expands a narrowed column to
its previous state.
Editing the column automatically expands the whole column to its full
size.
*** =org-columns-summary-types= entries can take an optional COLLECT function
You can use this to make collection of a property from an entry
conditional on another entry. E.g. given this configuration:
#+BEGIN_SRC emacs-lisp
(defun custom/org-collect-confirmed (property)
"Return `PROPERTY' for `CONFIRMED' entries"
(let ((prop (org-entry-get nil property))
(confirmed (org-entry-get nil "CONFIRMED")))
(if (and prop (string= "[X]" confirmed))
prop
"0")))
(setq org-columns-summary-types
'(("X+" org-columns--summary-sum
custom/org-collect-confirmed)))
#+END_SRC
You can have a file =bananas.org= containing:
#+BEGIN_SRC org
,#+columns: %ITEM %CONFIRMED %Bananas{+} %Bananas(Confirmed Bananas){X+}
,* All shipments
,** Shipment 1
:PROPERTIES:
:CONFIRMED: [X]
:Bananas: 4
:END:
,** Shipment 2
:PROPERTIES:
:CONFIRMED: [ ]
:BANANAS: 7
:END:
#+END_SRC
... and when going to the top of that file and entering column view
you should expect to see something like:
| ITEM | CONFIRMED | Bananas | Confirmed Bananas |
|---------------+-----------+---------+-------------------|
| All shipments | | 11 | 4 |
| Shipment 1 | [X] | 4 | 4 |
| Shipment 2 | [ ] | 7 | 7 |
#+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
matcher.
*** Add support for Oracle's database alias in Babel blocks
=ob-sql= library already support running SQL blocks against an Oracle
database using ~sqlplus~. Now it's possible to use alias names
defined in =TNSNAMES= file instead of specifying full connection
parameters. See example below.
#+BEGIN_SRC org
you can use the previous full connection parameters
,#+BEGIN_SRC sql :engine oracle :dbuser me :dbpassword my_insecure_password :database my_db_name :dbhost my_db_host :dbport 1521
select sysdate from dual;
,#+END_SRC
or the alias defined in your TNSNAMES file
,#+BEGIN_SRC sql :engine oracle :dbuser me :dbpassword my_insecure_password :database my_tns_alias
select sysdate from dual;
,#+END_SRC
#+END_SRC
*** ~org-agenda-set-restriction-lock~ toggle agenda restriction at point
You can set an agenda restriction lock with =C-x C-x <= or with =<= at the
beginning of a headline when using Org speed commands. Now, if there
is already a restriction at point, hitting =<= again (or =C-x C-x <=) will
remove it.
*** Headlines can now link to themselves in HTML export
When enabling ~org-html-self-link-headlines~ the headlines exported to
HTML contain a hyperlink to themselves.
** New commands and functions
*** ~org-insert-structure-template~
This function can be used to wrap existing text of Org elements in
a #+BEGIN_FOO/#+END_FOO block. Bound to C-c C-x w by default.
*** ~org-export-excluded-from-toc-p~
See docstring for details.
*** ~org-timestamp-to-time~
*** ~org-timestamp-from-string~
*** ~org-timestamp-from-time~
*** ~org-attach-dired-to-subtree~
See docstring for details.
*** ~org-toggle-narrow-to-subtree~
Toggle the narrowing state of the buffer: when in a narrowed state,
widen, otherwise call ~org-narrow-to-subtree~ to narrow.
This is attached to the "s" speed command, so that hitting "s" twice
will go back to the widen state.
*** ~org-browse-news~
Browse https://orgmode.org/Changes.html to let users read information
about the last major release.
There is a new menu entry for this in the "Documentation" menu item.
*** ~org-info-find-node~
From an Org file or an agenda switch to a suitable info page depending
on the context.
The function is bound to =C-c C-x I=.
** Removed commands and functions
*** ~org-outline-overlay-data~
Use ~org-save-outline-visibility~ instead.
*** ~org-set-outline-overlay-data~
Use ~org-save-outline-visibility~ instead.
*** ~org-get-string-indentation~
It was not used throughout the code base.
*** ~org-fix-indentation~
It was not used throughout code base.
*** ~org-context-p~
Use ~org-element-at-point~ instead.
*** ~org-preserve-lc~
It is no longer used in the code base.
*** ~org-try-structure-completion~
Org Tempo may be used as a replacement. See details above.
** Removed options
*** org-babel-use-quick-and-dirty-noweb-expansion
See [[*Change to Noweb expansion][Change to Noweb expansion]] for explanations.
** Miscellaneous
*** New default value for ~org-texinfo-table-scientific-notation~
It is now nil, which means numbers in scientific notation are not
handled specially by default.
*** New default value for ~org-latex-table-scientific-notation~
It is now nil, which means numbers in scientific notation are not
handled specially by default.
*** New face: ~org-upcoming-distant-deadline~
It is meant to be used as the face for distant deadlines, see
~org-agenda-deadline-faces~
*** ~org-paste-subtree~ no longer breaks sections
Unless point is at the beginning of a headline, ~org-paste-subtree~
now pastes the tree before the next visible headline. If you need to
break the section, use ~org-yank~ instead.
*** ~org-table-insert-column~ inserts a column to the right
It used to insert it on the left. With this change,
~org-table-insert-column~ and ~org-table-delete-column~ are
reciprocal.
*** ~org-publish-resolve-external-link~ accepts a new optional argument.
*** ~org-irc.el~ now supports exporting =irc:= links properly
Previously, irc links were exported by ~ox-md~ and ~ox-html~ as normal
file links, which lead to them being broken in web browsers. Now both
of these exporters will properly export to =irc:= links, which will
open properly in irc clients from web browsers.
*** ~org-comment-dwim~ (bound to =M-;=) now comments headings, if point is on a heading
*** Add support for open source block in window below
Set option ~org-src-window-setup~ to ~split-window-below~.
*** Alphabetic sorting in headings and tags now uses the locale’s sorting rules
When sorting alphabetically, ~org-sort-entries~ and
~org-tags-sort-function~ now sort according to the locale’s collation
rules instead of by code-point.
*** New speed command "k" to kill (cut) the subtree at point
* Version 9.1
** Incompatible changes
@ -137,7 +1040,6 @@ See docstring for details.
=org-agenda-tags-column= can now be set to =auto=, which will
automatically align tags to the right edge of the window. This is now
the default setting.
*** New value for ~org-publish-sitemap-sort-folders~
The new ~ignore~ value effectively allows toggling inclusion of
@ -204,7 +1106,7 @@ value of the code will be displayed in the results section.
**** Maxima: new headers ~:prologue~ and ~:epilogue~
Babel options ~:prologue~ and ~:epilogue~ have been implemented for
Maxima src blocks which prepend and append, respectively, the given
Maxima source blocks which prepend and append, respectively, the given
code strings. This can be useful for specifying formatting settings
which would add clutter to exported code. For instance, you can use
this ~:prologue "fpprintprec: 2; linel: 50;"~ for presenting Maxima
@ -486,7 +1388,7 @@ is now obsolete.
Now ~=...=~ markup uses ~@samp{}~ instead of ~@verb{}~. You can use
~@verb{}~ again by customizing the variable.
*** Texinfo exports example blocks as ~@example~
*** Texinfo exports inline src blocks as ~@code{}~
*** Texinfo exports inline source blocks as ~@code{}~
*** Texinfo default table markup is ~@asis~
It used to be ~@samp~ but ~@asis~ is neutral and, therefore, more
suitable as a default value.
@ -1303,9 +2205,9 @@ docstring for more information.
** New features
*** Default lexical evaluation of emacs-lisp src blocks
*** Default lexical evaluation of emacs-lisp source blocks
Emacs-lisp src blocks in babel are now evaluated using lexical
Emacs-lisp source blocks in Babel are now evaluated using lexical
scoping. There is a new header to control this behavior.
The default results in an eval with lexical scoping.
@ -1324,7 +2226,7 @@ without changing the headline.
*** Hierarchies of tags
The functionality of nesting tags in hierarchies is added to org-mode.
The functionality of nesting tags in hierarchies is added to Org mode.
This is the generalization of what was previously called "Tag groups"
in the manual. That term is now changed to "Tag hierarchy".
@ -1746,7 +2648,7 @@ everywhere in the buffer, possibly corrupting URLs.
This undocumented option defaulted to the value of =shell-file-name= at
the time of loading =ob-shell=. The new behavior is to use the value
of =shell-file-name= directly when the shell langage is =shell=. To chose
of =shell-file-name= directly when the shell language is =shell=. To chose
a different shell, either customize =shell-file-name= or bind this
variable locally.
@ -2918,7 +3820,7 @@ See https://orgmode.org/elpa/
| =C-c C-x E= | =E= | [[doc::org-inc-effort][org-inc-effort]] |
| | =#= | [[doc::org-toggle-comment][org-toggle-comment]] |
| | =:= | [[doc::org-columns][org-columns]] |
| | =W= | Set =APPT_WARNTIME= |
| | =W= | Set =APPT_WARNTIME= |
| =k= | | [[doc::org-agenda-capture][org-agenda-capture]] |
| C-c , | , | [[doc::org-priority][org-priority]] |
@ -3754,7 +4656,7 @@ that Calc formulas can operate on them.
**** org-ctags.el (Paul Sexton)
Targets like =<<my target>>= can now be found by Emacs' etag
functionality, and Org-mode links can be used to link to
functionality, and Org-mode links can be used to to link to
etags, also in non-Org-mode files. For details, see the file
/org-ctags.el/.
@ -3824,7 +4726,7 @@ that Calc formulas can operate on them.
: Percent escaping is used in Org mode to escape certain characters
: in links that would either break the parser (e.g. square brackets
: in link target oder description) or are not allowed to appear in
: in link target or description) or are not allowed to appear in
: a particular link type (e.g. non-ascii characters in a http:
: link).
:

39
etc/refcards/orgcard.tex
View file

@ -1,7 +1,5 @@
% Reference Card for Org Mode
\def\orgversionnumber{9.1.9}
\def\versionyear{2018} % latest update
\input emacsver.tex
\input org-version.tex
%**start of header
\newcount\columnsperpage
@ -79,9 +77,6 @@
\centerline{Released under the terms of the GNU General Public License}
\centerline{version 3 or later.}
\centerline{For more Emacs documentation, and the \TeX{} source for this card, see}
\centerline{the Emacs distribution, or {\tt https://www.gnu.org/software/emacs}}
\endgroup}
% make \bye not \outer so that the \def\bye in the \else clause below
@ -271,8 +266,10 @@
\def\threecol#1#2#3{\hskip\keyindent\relax#1\hfil&\kbd{#2}\hfil\quad
&\kbd{#3}\hfil\quad\cr}
\def\noteone{{\small \hfill [1]}}
\def\notetwo{{\small \hfill [2]}}
%\def\noteone{{\small \hfill [1]}}
%\def\notetwo{{\small \hfill [2]}}
\def\noteone{{\small [1]}}
\def\notetwo{{\small [2]}}
%**end of header
@ -292,6 +289,7 @@ \section{Visibility Cycling}
\key{restore property-dependent startup visibility}{C-u C-u TAB}
\metax{show the whole file, including drawers}{C-u C-u C-u TAB}
\key{reveal context around point}{C-c C-r}
\metax{toggle indented view}{M-x org-indent-mode}
\section{Motion}
@ -458,7 +456,7 @@ \section{Working with Code (Babel)}
\key{go to the next code block}{C-c C-v n}
\key{go to the previous code block}{C-c C-v p}
\key{demarcate a code block}{C-c C-v d}
\key{execute the next key sequence in the code edit buffer}{C-c C-v x}
\key{execute next key sequence in code edit buffer}{C-c C-v x}
\key{execute all code blocks in current buffer}{C-c C-v b}
\key{execute all code blocks in current subtree}{C-c C-v s}
\key{tangle code blocks in current file}{C-c C-v t}
@ -468,13 +466,14 @@ \section{Working with Code (Babel)}
\key{load the current code block into a session}{C-c C-v l}
\key{view sha1 hash of the current code block}{C-c C-v a}
\section{Completion}
\section{Completion and Template Insertion}
In-buffer completion completes TODO keywords at headline start, TeX
macros after ``{\tt \\}'', option keywords after ``{\tt \#-}'', TAGS
after ``{\tt :}'', and dictionary words elsewhere.
\key{complete word at point}{M-TAB}
\key{structure template (insert or wrap region)}{C-c C-,}
\newcolumn
@ -485,8 +484,8 @@ \section{Completion}
\section{TODO Items and Checkboxes}
\key{rotate the state of the current item}{C-c C-t}
\metax{select next/previous state}{S-LEFT/RIGHT}
\metax{select next/previous set}{C-S-LEFT/RIGHT}
\metax{select next/previous state}{\quad\quad S-LEFT/RIGHT}
\metax{select next/previous set}{\quad\quad\quad C-S-LEFT/RIGHT}
\key{toggle ORDERED property}{C-c C-x o}
\key{view TODO items in a sparse tree}{C-c / t}
@ -512,19 +511,19 @@ \section{Properties and Column View}
\key{set property/effort}{C-c C-x p/e}
\key{special commands in property lines}{C-c C-c}
\key{next/previous allowed value}{S-left/right}
\key{next/previous allowed value}{S-LEFT/RIGHT}
\key{turn on column view}{C-c C-x C-c}
\key{capture columns view in dynamic block}{C-c C-x i}
\key{quit column view}{q}
\key{show full value}{v}
\key{edit value}{e}
\metax{next/previous allowed value}{n/p or S-left/right}
\metax{next/previous allowed value}{n/p or S-LEFT/RIGHT}
\key{edit allowed values list}{a}
\key{make column wider/narrower}{> / <}
\key{move column left/right}{M-left/right}
\key{add new column}{M-S-right}
\key{Delete current column}{M-S-left}
\key{move column left/right}{M-LEFT/RIGHT}
\key{add new column}{M-S-RIGHT}
\key{Delete current column}{M-S-LEFT}
\section{Timestamps}
@ -536,8 +535,8 @@ \section{Timestamps}
\key{insert SCHEDULED timestamp}{C-c C-s}
\key{create sparse tree with all deadlines due}{C-c / d}
\key{the time between 2 dates in a time range}{C-c C-y}
\metax{change timestamp at cursor $\pm 1$ day}{S-RIGHT/LEFT\notetwo}
\key{change year/month/day at cursor by $\pm 1$}{S-UP/DOWN\notetwo}
\metax{change timestamp at cursor $\pm 1$ day}{\quad\quad\quad\quad S-RIGHT/LEFT \notetwo}
\key{change year/month/day at cursor by $\pm 1$}{S-UP/DOWN \notetwo}
\key{access the calendar for the current date}{C-c >}
\key{insert timestamp matching date in calendar}{C-c <}
\key{access agenda for current date}{C-c C-o}
@ -666,8 +665,6 @@ \section{Exporting and Publishing}
\key{toggle fixed width for entry or region}{C-c :}
\key{toggle pretty display of scripts, entities}{C-c C-x {\tt\char`\\}}
{\bf Comments: Text not being exported}
Lines starting with \kbd{\#} and subtrees starting with COMMENT are
never exported.

59
etc/schema/schemas.xml
View file

@ -1,64 +1,7 @@
<!-- Copyright (C) 2003-2004, 2007-2019 Free Software Foundation, Inc.
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/>. -->
<?xml version="1.0"?>
<locatingRules xmlns="http://thaiopensource.com/ns/locating-rules/1.0">
<transformURI fromPattern="*.xml" toPattern="*.rnc"/>
<uri pattern="*.xsl" typeId="XSLT"/>
<uri pattern="*.html" typeId="XHTML"/>
<uri pattern="*.rng" typeId="RELAX NG"/>
<uri pattern="*.rdf" typeId="RDF"/>
<uri pattern="*.dbk" typeId="DocBook"/>
<namespace ns="http://www.w3.org/1999/XSL/Transform" typeId="XSLT"/>
<namespace ns="http://www.w3.org/1999/02/22-rdf-syntax-ns#" typeId="RDF"/>
<namespace ns="http://www.w3.org/1999/xhtml" typeId="XHTML"/>
<namespace ns="http://relaxng.org/ns/structure/1.0" typeId="RELAX NG"/>
<namespace ns="http://thaiopensource.com/ns/locating-rules/1.0"
uri="locate.rnc"/>
<documentElement localName="stylesheet" typeId="XSLT"/>
<documentElement prefix="xsl" localName="transform" typeId="XSLT"/>
<documentElement localName="html" typeId="XHTML"/>
<documentElement localName="grammar" typeId="RELAX NG"/>
<documentElement prefix="" localName="article" typeId="DocBook"/>
<documentElement prefix="" localName="book" typeId="DocBook"/>
<documentElement prefix="" localName="chapter" typeId="DocBook"/>
<documentElement prefix="" localName="part" typeId="DocBook"/>
<documentElement prefix="" localName="refentry" typeId="DocBook"/>
<documentElement prefix="" localName="section" typeId="DocBook"/>
<documentElement localName="RDF" typeId="RDF"/>
<documentElement prefix="rdf" typeId="RDF"/>
<documentElement localName="locatingRules" uri="locate.rnc"/>
<typeId id="XSLT" uri="xslt.rnc"/>
<typeId id="RELAX NG" uri="relaxng.rnc"/>
<typeId id="XHTML" uri="xhtml.rnc"/>
<typeId id="DocBook" uri="docbook.rnc"/>
<typeId id="RDF" uri="rdfxml.rnc"/>
<documentElement prefix="office" typeId="OpenDocument"/>
<documentElement prefix="manifest" localName="manifest" typeId="OpenDocument Manifest"/>
<typeId id="OpenDocument" uri="od-schema-v1.2-os.rnc"/>
<typeId id="OpenDocument Manifest" uri="od-manifest-schema-v1.2-os.rnc"/>
</locatingRules>

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

@ -34,11 +34,9 @@
(require 'cc-mode)
(require 'ob)
(require 'org-macs)
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp"))
@ -375,8 +373,8 @@ FORMAT can be either a format string or a function which is called with VAL."
(pcase (org-babel-C-val-to-base-type v)
(`stringp (setq type 'stringp))
(`floatp
(if (or (not type) (eq type 'integerp))
(setq type 'floatp)))
(when (or (not type) (eq type 'integerp))
(setq type 'floatp)))
(`integerp
(unless type (setq type 'integerp)))))
val)
@ -395,9 +393,9 @@ of the same value."
(setq val (string-to-char val))))
(let* ((type-data (org-babel-C-val-to-C-type val))
(type (car type-data))
(formated (org-babel-C-format-val type-data val))
(suffix (car formated))
(data (cdr formated)))
(formatted (org-babel-C-format-val type-data val))
(suffix (car formatted))
(data (cdr formatted)))
(format "%s %s%s = %s;"
type
var

2
lisp/org/ob-J.el
View file

@ -31,8 +31,8 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function j-console-ensure-session "ext:j-console" ())
(defcustom org-babel-J-command "jconsole"

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

@ -27,6 +27,7 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(require 'calc)
(require 'calc-trail)
(require 'calc-store)
@ -34,7 +35,6 @@
(declare-function calc-store-into "calc-store" (&optional var))
(declare-function calc-recall "calc-store" (&optional var))
(declare-function math-evaluate-expr "calc-ext" (x))
(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-default-header-args:calc nil
"Default arguments for evaluating a calc source block.")

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

@ -41,26 +41,30 @@
;;; Code:
(require 'cl-lib)
(require 'ob)
(require 'org-macs)
(declare-function cider-jack-in "ext:cider" (&optional prompt-project cljs-too))
(declare-function cider-current-connection "ext:cider-client" (&optional type))
(declare-function cider-current-ns "ext:cider-client" ())
(declare-function cider-repls "ext:cider-connection" (&optional type ensure))
(declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2))
(declare-function nrepl-dict-get "ext:nrepl-client" (dict key))
(declare-function nrepl-dict-put "ext:nrepl-client" (dict key value))
(declare-function nrepl-request:eval "ext:nrepl-client"
(input callback connection &optional session ns line column additional-params))
(declare-function nrepl-sync-request:eval "ext:nrepl-client"
(input connection session &optional ns))
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function nrepl-request:eval "ext:nrepl-client" (input callback connection &optional ns line column additional-params tooling))
(declare-function nrepl-sync-request:eval "ext:nrepl-client" (input connection &optional ns tooling))
(declare-function slime-eval "ext:slime" (sexp &optional package))
(defvar nrepl-sync-request-timeout)
(defvar cider-buffer-ns)
(defvar sesman-system)
(defvar cider-version)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
(defvar org-babel-default-header-args:clojure '())
(defvar org-babel-header-args:clojure '((package . :any)))
(defvar org-babel-header-args:clojure '((ns . :any)
(package . :any)))
(defcustom org-babel-clojure-sync-nrepl-timeout 10
"Timeout value, in seconds, of a Clojure sync call.
@ -80,19 +84,39 @@ If the value is nil, timeout is disabled."
(const :tag "cider" cider)
(const :tag "SLIME" slime)))
(defcustom org-babel-clojure-default-ns "user"
"Default Clojure namespace for source block when finding ns failed."
:type 'string
:group 'org-babel)
(defun org-babel-clojure-cider-current-ns ()
"Like `cider-current-ns' except `cider-find-ns'."
(or cider-buffer-ns
(let ((repl-buf (cider-current-connection)))
(and repl-buf (buffer-local-value 'cider-buffer-ns repl-buf)))
org-babel-clojure-default-ns))
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let* ((vars (org-babel--get-vars params))
(ns (or (cdr (assq :ns params))
(org-babel-clojure-cider-current-ns)))
(result-params (cdr (assq :result-params params)))
(print-level nil) (print-length nil)
(print-level nil)
(print-length nil)
(body (org-trim
(if (null vars) (org-trim body)
(concat "(let ["
(mapconcat
(lambda (var)
(format "%S (quote %S)" (car var) (cdr var)))
vars "\n ")
"]\n" body ")")))))
(concat
;; Source block specified namespace :ns.
(and (cdr (assq :ns params)) (format "(ns %s)\n" ns))
;; Variables binding.
(if (null vars) (org-trim body)
(format "(let [%s]\n%s)"
(mapconcat
(lambda (var)
(format "%S (quote %S)" (car var) (cdr var)))
vars
"\n ")
body))))))
(if (or (member "code" result-params)
(member "pp" result-params))
(format "(clojure.pprint/pprint (do %s))" body)
@ -102,9 +126,9 @@ If the value is nil, timeout is disabled."
"Execute a block of Clojure code with Babel.
The underlying process performed by the code block can be output
using the :show-process parameter."
(let ((expanded (org-babel-expand-body:clojure body params))
(response (list 'dict))
result)
(let* ((expanded (org-babel-expand-body:clojure body params))
(response (list 'dict))
result)
(cl-case org-babel-clojure-backend
(cider
(require 'cider)
@ -117,8 +141,7 @@ using the :show-process parameter."
(let ((nrepl-sync-request-timeout
org-babel-clojure-sync-nrepl-timeout))
(nrepl-sync-request:eval expanded
(cider-current-connection)
(cider-current-ns))))
(cider-current-connection))))
(setq result
(concat
(nrepl-dict-get response
@ -152,8 +175,7 @@ using the :show-process parameter."
(nrepl--merge response resp)
;; Update the status of the nREPL output session.
(setq status (nrepl-dict-get response "status")))
(cider-current-connection)
(cider-current-ns))
(cider-current-connection))
;; Wait until the nREPL code finished to be processed.
(while (not (member "done" status))
@ -193,6 +215,69 @@ using the :show-process parameter."
(condition-case nil (org-babel-script-escape result)
(error result)))))
(defun org-babel-clojure-initiate-session (&optional session _params)
"Initiate a session named SESSION according to PARAMS."
(when (and session (not (string= session "none")))
(save-window-excursion
(cond
((org-babel-comint-buffer-livep session) nil)
;; CIDER jack-in to the Clojure project directory.
((eq org-babel-clojure-backend 'cider)
(require 'cider)
(let ((session-buffer
(save-window-excursion
(if (version< cider-version "0.18.0")
;; Older CIDER (without sesman) still need to use
;; old way.
(cider-jack-in nil) ;jack-in without project
;; New CIDER (with sesman to manage sessions).
(unless (cider-repls)
(let ((sesman-system 'CIDER))
(call-interactively 'sesman-link-with-directory))))
(current-buffer))))
(when (org-babel-comint-buffer-livep session-buffer)
(sit-for .25)
session-buffer)))
((eq org-babel-clojure-backend 'slime)
(error "Session evaluation with SLIME is not supported"))
(t
(error "Session initiate failed")))
(get-buffer session))))
(defun org-babel-prep-session:clojure (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let ((session (org-babel-clojure-initiate-session session))
(var-lines (org-babel-variable-assignments:clojure params)))
(when session
(org-babel-comint-in-buffer session
(dolist (var var-lines)
(insert var)
(comint-send-input nil t)
(org-babel-comint-wait-for-output session)
(sit-for .1)
(goto-char (point-max)))))
session))
(defun org-babel-clojure-var-to-clojure (var)
"Convert src block's VAR to Clojure variable."
(cond
((listp var)
(replace-regexp-in-string "(" "'(" var))
((stringp var)
;; Wrap Babel passed-in header argument value with quotes in Clojure.
(format "\"%s\"" var))
(t
(format "%S" var))))
(defun org-babel-variable-assignments:clojure (params)
"Return a list of Clojure statements assigning the block's variables in PARAMS."
(mapcar
(lambda (pair)
(format "(def %s %s)"
(car pair)
(org-babel-clojure-var-to-clojure (cdr pair))))
(org-babel--get-vars params)))
(provide 'ob-clojure)
;;; ob-clojure.el ends here

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

@ -36,7 +36,7 @@
(defun org-babel-comint-buffer-livep (buffer)
"Check if BUFFER is a comint buffer with a live process."
(let ((buffer (if buffer (get-buffer buffer))))
(let ((buffer (when buffer (get-buffer buffer))))
(and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer)))
(defmacro org-babel-comint-in-buffer (buffer &rest body)

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

@ -35,6 +35,7 @@
(defvar org-babel-library-of-babel)
(defvar org-edit-src-content-indentation)
(defvar org-link-file-path-type)
(defvar org-src-lang-modes)
(defvar org-src-preserve-indentation)
@ -47,10 +48,8 @@
(declare-function org-babel-ref-resolve "ob-ref" (ref))
(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
(declare-function org-completing-read "org" (&rest args))
(declare-function org-current-level "org" ())
(declare-function org-cycle "org" (&optional arg))
(declare-function org-do-remove-indentation "org" (&optional n))
(declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name))
(declare-function org-edit-src-exit "org-src" ())
(declare-function org-element-at-point "org-element" ())
@ -60,9 +59,7 @@
(declare-function org-element-type "org-element" (element))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-escape-code-in-region "org-src" (beg end))
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-in-regexp "org" (regexp &optional nlines visually))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-indent-line "org" ())
(declare-function org-list-get-list-end "org-list" (item struct prevs))
(declare-function org-list-prevs-alist "org-list" (struct))
@ -75,24 +72,18 @@
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-next-block "org" (arg &optional backward block-regexp))
(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
(declare-function org-outline-overlay-data "org" (&optional use-markers))
(declare-function org-previous-block "org" (arg &optional block-regexp))
(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-reverse-string "org" (string))
(declare-function org-set-outline-overlay-data "org" (data))
(declare-function org-show-context "org" (&optional key))
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-src-get-lang-mode "org-src" (lang))
(declare-function org-table-align "org-table" ())
(declare-function org-table-end "org-table" (&optional table-type))
(declare-function org-table-import "org-table" (file arg))
(declare-function org-table-to-lisp "org-table" (&optional txt))
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function org-unescape-code-in-string "org-src" (s))
(declare-function org-uniquify "org" (list))
(declare-function orgtbl-to-generic "org-table" (table params))
(declare-function orgtbl-to-orgtbl "org-table" (table params))
(declare-function outline-show-all "outline" ())
(declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag))
(defgroup org-babel nil
@ -186,9 +177,14 @@ This string must include a \"%s\" which will be replaced by the results."
:safe #'booleanp)
(defun org-babel-noweb-wrap (&optional regexp)
(concat org-babel-noweb-wrap-start
(or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
org-babel-noweb-wrap-end))
"Return regexp matching a Noweb reference.
Match any reference, or only those matching REGEXP, if non-nil.
When matching, reference is stored in match group 1."
(concat (regexp-quote org-babel-noweb-wrap-start)
(or regexp "\\([^ \t\n]\\(?:.*?[^ \t\n]\\)?\\)")
(regexp-quote org-babel-noweb-wrap-end)))
(defvar org-babel-src-name-regexp
"^[ \t]*#\\+name:[ \t]*"
@ -416,7 +412,7 @@ then run `org-babel-switch-to-session'."
(post . :any)
(prologue . :any)
(results . ((file list vector table scalar verbatim)
(raw html latex org code pp drawer)
(raw html latex org code pp drawer link graphics)
(replace silent none append prepend)
(output value)))
(rownames . ((no yes)))
@ -532,7 +528,7 @@ to raise errors for all languages.")
"Hook for functions to be called after `org-babel-execute-src-block'")
(defun org-babel-named-src-block-regexp-for-name (&optional name)
"Generate a regexp used to match a src block named NAME.
"Generate a regexp used to match a source block named NAME.
If NAME is nil, match any name. Matched name is then put in
match group 9. Other match groups are defined in
`org-babel-src-block-regexp'."
@ -566,7 +562,7 @@ Remove final newline character and spurious indentation."
;;; functions
(defvar org-babel-current-src-block-location nil
"Marker pointing to the src block currently being executed.
"Marker pointing to the source block currently being executed.
This may also point to a call line or an inline code block. If
multiple blocks are being executed (e.g., in chained execution
through use of the :var header argument) this marker points to
@ -577,9 +573,10 @@ the outer-most code block.")
(defun org-babel-get-src-block-info (&optional light datum)
"Extract information from a source block or inline source block.
Optional argument LIGHT does not resolve remote variable
references; a process which could likely result in the execution
of other code blocks.
When optional argument LIGHT 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.
By default, consider the block at point. However, when optional
argument DATUM is provided, extract information from that parsed
@ -610,8 +607,9 @@ a list with the following pattern:
;; properties applicable to its location within
;; the document.
(org-with-point-at (org-element-property :begin datum)
(org-babel-params-from-properties lang))
(mapcar #'org-babel-parse-header-arguments
(org-babel-params-from-properties lang light))
(mapcar (lambda (h)
(org-babel-parse-header-arguments h light))
(cons (org-element-property :parameters datum)
(org-element-property :header datum)))))
(or (org-element-property :switches datum) "")
@ -654,7 +652,7 @@ block."
(let* ((params (nth 2 info))
(cache (let ((c (cdr (assq :cache params))))
(and (not arg) c (string= "yes" c))))
(new-hash (and cache (org-babel-sha1-hash info)))
(new-hash (and cache (org-babel-sha1-hash info :eval)))
(old-hash (and cache (org-babel-current-result-hash)))
(current-cache (and new-hash (equal new-hash old-hash))))
(cond
@ -681,9 +679,16 @@ block."
(replace-regexp-in-string
(org-src-coderef-regexp coderef) "" expand nil nil 1))))
(dir (cdr (assq :dir params)))
(mkdirp (cdr (assq :mkdirp params)))
(default-directory
(or (and dir (file-name-as-directory (expand-file-name dir)))
default-directory))
(cond
((not dir) default-directory)
((member mkdirp '("no" "nil" nil))
(file-name-as-directory (expand-file-name dir)))
(t
(let ((d (file-name-as-directory (expand-file-name dir))))
(make-directory d 'parents)
d))))
(cmd (intern (concat "org-babel-execute:" lang)))
result)
(unless (fboundp cmd)
@ -703,13 +708,20 @@ block."
(not (listp r)))
(list (list r))
r)))
(let ((file (cdr (assq :file params))))
(let ((file (and (member "file" result-params)
(cdr (assq :file params)))))
;; If non-empty result and :file then write to :file.
(when file
(when result
;; If `:results' are special types like `link' or
;; `graphics', don't write result to `:file'. Only
;; insert a link to `:file'.
(when (and result
(not (or (member "link" result-params)
(member "graphics" result-params))))
(with-temp-file file
(insert (org-babel-format-result
result (cdr (assq :sep params))))))
result
(cdr (assq :sep params))))))
(setq result file))
;; Possibly perform post process provided its
;; appropriate. Dynamically bind "*this*" to the
@ -1013,7 +1025,7 @@ evaluation mechanisms."
(call-interactively
(key-binding (or key (read-key-sequence nil))))))
(defvar org-bracket-link-regexp)
(defvar org-link-bracket-re)
(defun org-babel-active-location-p ()
(memq (org-element-type (save-match-data (org-element-context)))
@ -1021,30 +1033,32 @@ evaluation mechanisms."
;;;###autoload
(defun org-babel-open-src-block-result (&optional re-run)
"If `point' is on a src block then open the results of the
source code block, otherwise return nil. With optional prefix
argument RE-RUN the source-code block is evaluated even if
results already exist."
"Open results of source block at point.
If `point' is on a source block then open the results of the source
code block, otherwise return nil. With optional prefix argument
RE-RUN the source-code block is evaluated even if results already
exist."
(interactive "P")
(let ((info (org-babel-get-src-block-info 'light)))
(when info
(save-excursion
;; go to the results, if there aren't any then run the block
(goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
(progn (org-babel-execute-src-block)
(org-babel-where-is-src-block-result))))
(end-of-line 1)
(while (looking-at "[\n\r\t\f ]") (forward-char 1))
;; open the results
(if (looking-at org-bracket-link-regexp)
;; file results
(org-open-at-point)
(let ((r (org-babel-format-result
(org-babel-read-result) (cdr (assq :sep (nth 2 info))))))
(pop-to-buffer (get-buffer-create "*Org-Babel Results*"))
(delete-region (point-min) (point-max))
(insert r)))
t))))
(pcase (org-babel-get-src-block-info 'light)
(`(,_ ,_ ,arguments ,_ ,_ ,start ,_)
(save-excursion
;; Go to the results, if there aren't any then run the block.
(goto-char start)
(goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
(progn (org-babel-execute-src-block)
(org-babel-where-is-src-block-result))))
(end-of-line)
(skip-chars-forward " \r\t\n")
;; Open the results.
(if (looking-at org-link-bracket-re) (org-open-at-point)
(let ((r (org-babel-format-result (org-babel-read-result)
(cdr (assq :sep arguments)))))
(pop-to-buffer (get-buffer-create "*Org Babel Results*"))
(erase-buffer)
(insert r)))
t))
(_ nil)))
;;;###autoload
(defmacro org-babel-map-src-blocks (file &rest body)
@ -1224,11 +1238,14 @@ the current subtree."
(widen))))
;;;###autoload
(defun org-babel-sha1-hash (&optional info)
"Generate an sha1 hash based on the value of info."
(defun org-babel-sha1-hash (&optional info context)
"Generate a sha1 hash based on the value of INFO.
CONTEXT specifies the context of evaluation. It can be `:eval',
`:export', `:tangle'. A nil value means `:eval'."
(interactive)
(let ((print-level nil)
(info (or info (org-babel-get-src-block-info))))
(info (or info (org-babel-get-src-block-info)))
(context (or context :eval)))
(setf (nth 2 info)
(sort (copy-sequence (nth 2 info))
(lambda (a b) (string< (car a) (car b)))))
@ -1256,8 +1273,9 @@ the current subtree."
;; expanded body
(lang (nth 0 info))
(params (nth 2 info))
(body (if (org-babel-noweb-p params :eval)
(org-babel-expand-noweb-references info) (nth 1 info)))
(body (if (org-babel-noweb-p params context)
(org-babel-expand-noweb-references info)
(nth 1 info)))
(expand-cmd (intern (concat "org-babel-expand-body:" lang)))
(assignments-cmd (intern (concat "org-babel-variable-assignments:"
lang)))
@ -1288,19 +1306,6 @@ the current subtree."
(looking-at org-babel-result-regexp)
(match-string-no-properties 1)))))
(defun org-babel-set-current-result-hash (hash info)
"Set the current in-buffer hash to HASH."
(org-with-wide-buffer
(goto-char (org-babel-where-is-src-block-result nil info))
(looking-at org-babel-result-regexp)
(goto-char (match-beginning 1))
(mapc #'delete-overlay (overlays-at (point)))
(forward-char org-babel-hash-show)
(mapc #'delete-overlay (overlays-at (point)))
(replace-match hash nil nil nil 1)
(beginning-of-line)
(org-babel-hide-hash)))
(defun org-babel-hide-hash ()
"Hide the hash in the current results line.
Only the initial `org-babel-hash-show' characters of the hash
@ -1426,24 +1431,27 @@ portions of results lines."
(lambda () (add-hook 'change-major-mode-hook
'org-babel-show-result-all 'append 'local)))
(defvar org-file-properties)
(defun org-babel-params-from-properties (&optional lang)
"Retrieve parameters specified as properties.
Return a list of association lists of source block params
(defun org-babel-params-from-properties (&optional lang no-eval)
"Retrieve source block parameters specified as properties.
LANG is the language of the source block, as a string. When
optional argument NO-EVAL is non-nil, do not evaluate Lisp values
in parameters.
Return a list of association lists of source block parameters
specified in the properties of the current outline entry."
(save-match-data
(list
;; header arguments specified with the header-args property at
;; Header arguments specified with the header-args property at
;; point of call.
(org-babel-parse-header-arguments
(org-entry-get org-babel-current-src-block-location
"header-args"
'inherit))
(and lang ; language-specific header arguments at point of call
(org-entry-get (point) "header-args" 'inherit)
no-eval)
;; Language-specific header arguments at point of call.
(and lang
(org-babel-parse-header-arguments
(org-entry-get org-babel-current-src-block-location
(concat "header-args:" lang)
'inherit))))))
(org-entry-get (point) (concat "header-args:" lang) 'inherit)
no-eval)))))
(defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS.
@ -1531,9 +1539,11 @@ balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)."
(cons el acc))))
list :initial-value nil))))
(defun org-babel-parse-header-arguments (arg-string)
"Parse a string of header arguments returning an alist."
(when (> (length arg-string) 0)
(defun org-babel-parse-header-arguments (string &optional no-eval)
"Parse header arguments in STRING.
When optional argument NO-EVAL is non-nil, do not evaluate Lisp
in parameters. Return an alist."
(when (org-string-nw-p string)
(org-babel-parse-multiple-vars
(delq nil
(mapcar
@ -1542,10 +1552,12 @@ balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)."
"\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
arg)
(cons (intern (match-string 1 arg))
(org-babel-read (org-babel-chomp (match-string 2 arg))))
(org-babel-read (org-babel-chomp (match-string 2 arg))
no-eval))
(cons (intern (org-babel-chomp arg)) nil)))
(let ((raw (org-babel-balanced-split arg-string '((32 9) . 58))))
(cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw)))))))))
(let ((raw (org-babel-balanced-split string '((32 9) . 58))))
(cons (car raw)
(mapcar (lambda (r) (concat ":" r)) (cdr raw)))))))))
(defun org-babel-parse-multiple-vars (header-arguments)
"Expand multiple variable assignments behind a single :var keyword.
@ -1845,7 +1857,7 @@ With optional prefix argument ARG, jump backward ARG many source blocks."
;;;###autoload
(defun org-babel-mark-block ()
"Mark current src block."
"Mark current source block."
(interactive)
(let ((head (org-babel-where-is-src-block-head)))
(when head
@ -1876,7 +1888,7 @@ region is not active then the point is demarcated."
(save-excursion
(goto-char place)
(let ((lang (nth 0 info))
(indent (make-string (org-get-indentation) ?\s)))
(indent (make-string (current-indentation) ?\s)))
(when (string-match "^[[:space:]]*$"
(buffer-substring (point-at-bol)
(point-at-eol)))
@ -2083,7 +2095,7 @@ Return nil if ELEMENT cannot be read."
(`paragraph
;; Treat paragraphs containing a single link specially.
(skip-chars-forward " \t")
(if (and (looking-at org-bracket-link-regexp)
(if (and (looking-at org-link-bracket-re)
(save-excursion
(goto-char (match-end 0))
(skip-chars-forward " \r\t\n")
@ -2125,7 +2137,7 @@ Return nil if ELEMENT cannot be read."
If the path of the link is a file path it is expanded using
`expand-file-name'."
(let* ((case-fold-search t)
(raw (and (looking-at org-bracket-link-regexp)
(raw (and (looking-at org-link-bracket-re)
(org-no-properties (match-string 1))))
(type (and (string-match org-link-types-re raw)
(match-string 1 raw))))
@ -2206,10 +2218,10 @@ code ---- the results are extracted in the syntax of the source
optional LANG argument.
list ---- the results are rendered as a list. This option not
allowed for inline src blocks.
allowed for inline source blocks.
table --- the results are rendered as a table. This option not
allowed for inline src blocks.
allowed for inline source blocks.
INFO may provide the values of these header arguments (in the
`header-arguments-alist' see the docstring for
@ -2273,7 +2285,7 @@ INFO may provide the values of these header arguments (in the
(goto-char (org-element-property :end inline))
(skip-chars-backward " \t"))
(unless inline
(setq indent (org-get-indentation))
(setq indent (current-indentation))
(forward-line 1))
(setq beg (point))
(cond
@ -2297,7 +2309,7 @@ INFO may provide the values of these header arguments (in the
(setq start inline-start)
(setq finish inline-finish)
(setq no-newlines t))
(let ((before-finish (marker-position end)))
(let ((before-finish (copy-marker end)))
(goto-char end)
(insert (concat finish (unless no-newlines "\n")))
(goto-char beg)
@ -2362,24 +2374,24 @@ INFO may provide the values of these header arguments (in the
;; possibly wrap result
(cond
((assq :wrap (nth 2 info))
(let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS")))
(funcall wrap (concat "#+BEGIN_" name)
(concat "#+END_" (car (split-string name)))
(let ((name (or (cdr (assq :wrap (nth 2 info))) "results")))
(funcall wrap (concat "#+begin_" name)
(concat "#+end_" (car (split-string name)))
nil nil (concat "{{{results(@@" name ":") "@@)}}}")))
((member "html" result-params)
(funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil
(funcall wrap "#+begin_export html" "#+end_export" nil nil
"{{{results(@@html:" "@@)}}}"))
((member "latex" result-params)
(funcall wrap "#+BEGIN_EXPORT latex" "#+END_EXPORT" nil nil
(funcall wrap "#+begin_export latex" "#+end_export" nil nil
"{{{results(@@latex:" "@@)}}}"))
((member "org" result-params)
(goto-char beg) (when (org-at-table-p) (org-cycle))
(funcall wrap "#+BEGIN_SRC org" "#+END_SRC" nil nil
(funcall wrap "#+begin_src org" "#+end_src" nil nil
"{{{results(src_org{" "})}}}"))
((member "code" result-params)
(let ((lang (or lang "none")))
(funcall wrap (format "#+BEGIN_SRC %s%s" lang results-switches)
"#+END_SRC" nil nil
(funcall wrap (format "#+begin_src %s%s" lang results-switches)
"#+end_src" nil nil
(format "{{{results(src_%s[%s]{" lang results-switches)
"})}}}")))
((member "raw" result-params)
@ -2388,7 +2400,7 @@ INFO may provide the values of these header arguments (in the
;; Stay backward compatible with <7.9.2
(member "wrap" result-params))
(goto-char beg) (when (org-at-table-p) (org-cycle))
(funcall wrap ":RESULTS:" ":END:" 'no-escape nil
(funcall wrap ":results:" ":end:" 'no-escape nil
"{{{results(" ")}}}"))
((and inline (member "file" result-params))
(funcall wrap nil nil nil nil "{{{results(" ")}}}"))
@ -2469,7 +2481,7 @@ in the buffer."
(defun org-babel-result-end ()
"Return the point at the end of the current set of results."
(cond ((looking-at-p "^[ \t]*$") (point)) ;no result
((looking-at-p (format "^[ \t]*%s[ \t]*$" org-bracket-link-regexp))
((looking-at-p (format "^[ \t]*%s[ \t]*$" org-link-bracket-re))
(line-beginning-position 2))
(t
(let ((element (org-element-at-point)))
@ -2489,15 +2501,20 @@ in the buffer."
If the `default-directory' is different from the containing
file's directory then expand relative links."
(when (stringp result)
(format "[[file:%s]%s]"
(if (and default-directory
buffer-file-name
(not (string= (expand-file-name default-directory)
(expand-file-name
(file-name-directory buffer-file-name)))))
(expand-file-name result default-directory)
result)
(if description (concat "[" description "]") ""))))
(let ((same-directory?
(and buffer-file-name
(not (string= (expand-file-name default-directory)
(expand-file-name
(file-name-directory buffer-file-name)))))))
(format "[[file:%s]%s]"
(if (and default-directory buffer-file-name same-directory?)
(if (eq org-link-file-path-type 'adaptive)
(file-relative-name
(expand-file-name result default-directory)
(file-name-directory (buffer-file-name)))
(expand-file-name result default-directory))
result)
(if description (concat "[" description "]") "")))))
(defun org-babel-examplify-region (beg end &optional results-switches inline)
"Comment out region using the inline `==' or `: ' org example quote."
@ -2535,7 +2552,7 @@ file's directory then expand relative links."
(unless (eq (org-element-type element) 'src-block)
(error "Not in a source block"))
(goto-char (org-babel-where-is-src-block-head element))
(let* ((ind (org-get-indentation))
(let* ((ind (current-indentation))
(body-start (line-beginning-position 2))
(body (org-element-normalize-string
(if (or org-src-preserve-indentation
@ -2621,19 +2638,6 @@ parameters when merging lists."
results
(split-string
(if (stringp value) value (eval value t))))))
(`(,(or :file :file-ext) . ,value)
;; `:file' and `:file-ext' are regular keywords but they
;; imply a "file" `:results' and a "results" `:exports'.
(when value
(setq results
(funcall merge results-exclusive-groups results '("file")))
(unless (or (member "both" exports)
(member "none" exports)
(member "code" exports))
(setq exports
(funcall merge
exports-exclusive-groups exports '("results"))))
(push pair params)))
(`(:exports . ,value)
(setq exports (funcall merge
exports-exclusive-groups
@ -2662,12 +2666,6 @@ parameters when merging lists."
;; Return merged params.
params))
(defvar org-babel-use-quick-and-dirty-noweb-expansion nil
"Set to true to use regular expressions to expand noweb references.
This results in much faster noweb reference expansion but does
not properly allow code blocks to inherit the \":noweb-ref\"
header argument from buffer or subtree wide properties.")
(defun org-babel-noweb-p (params context)
"Check if PARAMS require expansion in CONTEXT.
CONTEXT may be one of :tangle, :export or :eval."
@ -2714,16 +2712,8 @@ block but are passed literally to the \"example-block\"."
(body (nth 1 info))
(ob-nww-start org-babel-noweb-wrap-start)
(ob-nww-end org-babel-noweb-wrap-end)
(comment (string= "noweb" (cdr (assq :comments (nth 2 info)))))
(rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
":noweb-ref[ \t]+" "\\)"))
(new-body "")
(nb-add (lambda (text) (setq new-body (concat new-body text))))
(c-wrap (lambda (text)
(with-temp-buffer
(funcall (intern (concat lang "-mode")))
(comment-region (point) (progn (insert text) (point)))
(org-trim (buffer-string)))))
index source-name evaluate prefix)
(with-temp-buffer
(setq-local org-babel-noweb-wrap-start ob-nww-start)
@ -2755,63 +2745,77 @@ block but are passed literally to the \"example-block\"."
(let ((raw (org-babel-ref-resolve source-name)))
(if (stringp raw) raw (format "%S" raw)))
(or
;; Retrieve from the library of babel.
(nth 2 (assoc (intern source-name)
org-babel-library-of-babel))
;; Retrieve from the Library of Babel.
(nth 2 (assoc-string source-name org-babel-library-of-babel))
;; Return the contents of headlines literally.
(save-excursion
(when (org-babel-ref-goto-headline-id source-name)
(org-babel-ref-headline-body)))
(org-babel-ref-headline-body)))
;; Find the expansion of reference in this buffer.
(let ((rx (concat rx-prefix source-name "[ \t\n]"))
expansion)
(save-excursion
(goto-char (point-min))
(if org-babel-use-quick-and-dirty-noweb-expansion
(while (re-search-forward rx nil t)
(let* ((i (org-babel-get-src-block-info 'light))
(body (if (org-babel-noweb-p (nth 2 i) :eval)
(org-babel-expand-noweb-references i)
(nth 1 i)))
(sep (or (cdr (assq :noweb-sep (nth 2 i)))
"\n"))
(full (if comment
(let ((cs (org-babel-tangle-comment-links i)))
(concat (funcall c-wrap (car cs)) "\n"
body "\n"
(funcall c-wrap (cadr cs))))
body)))
(setq expansion (cons sep (cons full expansion)))))
(org-babel-map-src-blocks nil
(let ((i (let ((org-babel-current-src-block-location (point)))
(org-babel-get-src-block-info 'light))))
(when (equal (or (cdr (assq :noweb-ref (nth 2 i)))
(nth 4 i))
source-name)
(let* ((body (if (org-babel-noweb-p (nth 2 i) :eval)
(org-babel-expand-noweb-references i)
(nth 1 i)))
(sep (or (cdr (assq :noweb-sep (nth 2 i)))
"\n"))
(full (if comment
(let ((cs (org-babel-tangle-comment-links i)))
(concat (funcall c-wrap (car cs)) "\n"
body "\n"
(funcall c-wrap (cadr cs))))
body)))
(setq expansion
(cons sep (cons full expansion)))))))))
(and expansion
(mapconcat #'identity (nreverse (cdr expansion)) "")))
(save-excursion
(goto-char (point-min))
(let* ((name-regexp
(org-babel-named-src-block-regexp-for-name
source-name))
(comment
(string= "noweb"
(cdr (assq :comments (nth 2 info)))))
(c-wrap
(lambda (s)
;; Comment, according to LANG mode,
;; string S. Return new string.
(with-temp-buffer
(funcall (org-src-get-lang-mode lang))
(comment-region (point)
(progn (insert s) (point)))
(org-trim (buffer-string)))))
(expand-body
(lambda (i)
;; Expand body of code blocked
;; represented by block info I.
(let ((b (if (org-babel-noweb-p (nth 2 i) :eval)
(org-babel-expand-noweb-references i)
(nth 1 i))))
(if (not comment) b
(let ((cs (org-babel-tangle-comment-links i)))
(concat (funcall c-wrap (car cs)) "\n"
b "\n"
(funcall c-wrap (cadr cs)))))))))
(if (and (re-search-forward name-regexp nil t)
(not (org-in-commented-heading-p)))
;; Found a source block named SOURCE-NAME.
;; Assume it is unique; do not look after
;; `:noweb-ref' header argument.
(funcall expand-body
(org-babel-get-src-block-info 'light))
;; Though luck. We go into the long process
;; of checking each source block and expand
;; those with a matching Noweb reference.
(let ((expansion nil))
(org-babel-map-src-blocks nil
(unless (org-in-commented-heading-p)
(let* ((info
(org-babel-get-src-block-info 'light))
(parameters (nth 2 info)))
(when (equal source-name
(cdr (assq :noweb-ref parameters)))
(push (funcall expand-body info) expansion)
(push (or (cdr (assq :noweb-sep parameters))
"\n")
expansion)))))
(when expansion
(mapconcat #'identity
(nreverse (cdr expansion))
""))))))
;; Possibly raise an error if named block doesn't exist.
(if (or org-babel-noweb-error-all-langs
(member lang org-babel-noweb-error-langs))
(error "%s" (concat
(org-babel-noweb-wrap source-name)
"could not be resolved (see "
"`org-babel-noweb-error-langs')"))
(error "%s could not be resolved (see \
`org-babel-noweb-error-langs')"
(org-babel-noweb-wrap source-name))
"")))
"[\n\r]") (concat "\n" prefix))))))
"[\n\r]")
(concat "\n" prefix))))))
(funcall nb-add (buffer-substring index (point-max))))
new-body))
@ -2927,30 +2931,30 @@ situations in which is it not appropriate."
(defun org-babel--string-to-number (string)
"If STRING represents a number return its value.
Otherwise return nil."
(and (string-match-p "\\`-?[0-9]*\\.?[0-9]*\\'" string)
(and (string-match-p "\\`-?\\([0-9]\\|\\([1-9]\\|[0-9]*\\.\\)[0-9]*\\)\\'" string)
(string-to-number string)))
(defun org-babel-import-elisp-from-file (file-name &optional separator)
"Read the results located at FILE-NAME into an elisp table.
If the table is trivial, then return it as a scalar."
(let (result)
(save-window-excursion
(with-temp-buffer
(condition-case err
(progn
(org-table-import file-name separator)
(delete-file file-name)
(setq result (mapcar (lambda (row)
(mapcar #'org-babel-string-read row))
(org-table-to-lisp))))
(error (message "Error reading results: %s" err) nil)))
(if (null (cdr result)) ;; if result is trivial vector, then scalarize it
(if (consp (car result))
(if (null (cdr (car result)))
(caar result)
result)
(car result))
result))))
(save-window-excursion
(let ((result
(with-temp-buffer
(condition-case err
(progn
(org-table-import file-name separator)
(delete-file file-name)
(delq nil
(mapcar (lambda (row)
(and (not (eq row 'hline))
(mapcar #'org-babel-string-read row)))
(org-table-to-lisp))))
(error (message "Error reading results: %s" err) nil)))))
(pcase result
(`((,scalar)) scalar)
(`((,_ ,_ . ,_)) result)
(`(,scalar) scalar)
(_ result)))))
(defun org-babel-string-read (cell)
"Strip nested \"s from around strings."
@ -3136,7 +3140,8 @@ after the babel API for OLD-type source blocks is fully defined.
Callers of this function will probably want to add an entry to
`org-src-lang-modes' as well."
(dolist (fn '("execute" "expand-body" "prep-session"
"variable-assignments" "load-session"))
"variable-assignments" "load-session"
"edit-prep"))
(let ((sym (intern-soft (concat "org-babel-" fn ":" old))))
(when (and sym (fboundp sym))
(defalias (intern (concat "org-babel-" fn ":" new)) sym))))
@ -3147,10 +3152,6 @@ Callers of this function will probably want to add an entry to
(when (and sym (boundp sym))
(defvaralias (intern (concat "org-babel-" var ":" new)) sym)))))
(defun org-babel-strip-quotes (string)
"Strip \\\"s from around a string, if applicable."
(org-unbracket-string "\"" "\"" string))
(provide 'ob-core)
;; Local variables:

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

@ -69,6 +69,8 @@ This function is called by `org-babel-execute-src-block'."
(cmdline (or (cdr (assq :cmdline params))
(format "-T%s" (file-name-extension out-file))))
(cmd (or (cdr (assq :cmd params)) "dot"))
(coding-system-for-read 'utf-8) ;use utf-8 with sub-processes
(coding-system-for-write 'utf-8)
(in-file (org-babel-temp-file "dot-")))
(with-temp-file in-file
(insert (org-babel-expand-body:dot body params)))

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

@ -26,7 +26,13 @@
;; Org-Babel support for evaluating emacs-lisp code
;;; Code:
(require 'ob)
(require 'ob-core)
(declare-function org-babel--get-vars "ob" (params))
(declare-function org-babel-result-cond "ob" (result-params scalar-form &rest table-forms))
(declare-function org-babel-reassemble-table "ob" (table colnames rownames))
(declare-function org-babel-pick-name "ob" (names selector))
(defconst org-babel-header-args:emacs-lisp '((lexical . :any))
"Emacs-lisp specific header arguments.")
@ -34,10 +40,11 @@
(defvar org-babel-default-header-args:emacs-lisp '((:lexical . "no"))
"Default arguments for evaluating an emacs-lisp source block.
A value of \"yes\" or t causes src blocks to be eval'd using
A value of \"yes\" or t causes source blocks to be eval'd using
lexical scoping. It can also be an alist mapping symbols to
their value. It is used as the optional LEXICAL argument to
`eval', which see.")
their value. It is used both as the optional LEXICAL argument to
`eval', and as the value for `lexical-binding' in buffers created
by `org-edit-src-code'.")
(defun org-babel-expand-body:emacs-lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
@ -65,9 +72,7 @@ their value. It is used as the optional LEXICAL argument to
(member "pp" result-params))
(concat "(pp " body ")")
body))
(if (listp lexical)
lexical
(member lexical '("yes" "t"))))))
(org-babel-emacs-lisp-lexical lexical))))
(org-babel-result-cond result-params
(let ((print-level nil)
(print-length nil))
@ -82,6 +87,23 @@ their value. It is used as the optional LEXICAL argument to
(org-babel-pick-name (cdr (assq :rowname-names params))
(cdr (assq :rownames params))))))))
(defun org-babel-emacs-lisp-lexical (lexical)
"Interpret :lexical source block argument.
Convert LEXICAL into the form appropriate for `lexical-binding'
and the LEXICAL argument to `eval'."
(if (listp lexical)
lexical
(not (null (member lexical '("yes" "t"))))))
(defun org-babel-edit-prep:emacs-lisp (info)
"Set `lexical-binding' in Org edit buffer.
Set `lexical-binding' in Org edit buffer according to the
corresponding :lexical source block argument."
(setq lexical-binding
(org-babel-emacs-lisp-lexical
(org-babel-read
(cdr (assq :lexical (nth 2 info)))))))
(org-babel-make-language-alias "elisp" "emacs-lisp")
(provide 'ob-emacs-lisp)

102
lisp/org/ob-eshell.el Normal file
View file

@ -0,0 +1,102 @@
;;; ob-eshell.el --- Babel Functions for Eshell -*- lexical-binding: t; -*-
;; Copyright (C) 2018 Free Software Foundation, Inc.
;; Author: stardiviner <numbchild@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: 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:
;; Org Babel support for evaluating Eshell source code.
;;; Code:
(require 'ob)
(require 'eshell)
(defvar org-babel-default-header-args:eshell '())
(defun org-babel-execute:eshell (body params)
"Execute a block of Eshell code BODY with PARAMS.
This function is called by `org-babel-execute-src-block'.
The BODY can be any code which allowed executed in Eshell.
Eshell allow to execute normal shell command and Elisp code.
More details please reference Eshell Info.
The PARAMS are variables assignments."
(let* ((session (org-babel-eshell-initiate-session
(cdr (assq :session params))))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:eshell params))))
(if session
(progn
(with-current-buffer session
(dolist (line (split-string full-body "\n"))
(goto-char eshell-last-output-end)
(insert line)
(eshell-send-input))
;; get output of last input
;; TODO: collect all output instead of last command's output.
(goto-char eshell-last-input-end)
(buffer-substring-no-properties (point) eshell-last-output-start)))
(with-temp-buffer
(eshell-command full-body t)
(buffer-string)))))
(defun org-babel-prep-session:eshell (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-eshell-initiate-session session))
;; Eshell session buffer is read from variable `eshell-buffer-name'.
(eshell-buffer-name session)
(var-lines (org-babel-variable-assignments:eshell params)))
(call-interactively #'eshell)
(mapc #'eshell-command var-lines)
session))
(defun ob-eshell-session-live-p (session)
"Non-nil if Eshell SESSION exists."
(get-buffer session))
(defun org-babel-eshell-initiate-session (&optional session _params)
"Initiate a session named SESSION."
(when (and session (not (string= session "none")))
(save-window-excursion
(unless (ob-eshell-session-live-p session)
(let ((eshell-buffer-name session)) (eshell))))
session))
(defun org-babel-variable-assignments:eshell (params)
"Convert ob-eshell :var specified variables into Eshell variables assignments."
(mapcar
(lambda (pair)
(format "(setq %s %S)" (car pair) (cdr pair)))
(org-babel--get-vars params)))
(defun org-babel-load-session:eshell (session body params)
"Load BODY into SESSION with PARAMS."
(save-window-excursion
(let ((buffer (org-babel-prep-session:eshell session params)))
(with-current-buffer buffer
(goto-char (point-max))
(insert (org-babel-chomp body)))
buffer)))
(provide 'ob-eshell)
;;; ob-eshell.el ends here

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

@ -32,8 +32,6 @@
(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-fill-template "org" (template alist))
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(defvar org-src-preserve-indentation)
@ -85,7 +83,7 @@ none ---- do not display either code or results upon export
Assume point is at block opening line."
(interactive)
(save-excursion
(let* ((info (org-babel-get-src-block-info 'light))
(let* ((info (org-babel-get-src-block-info))
(lang (nth 0 info))
(raw-params (nth 2 info))
hash)
@ -108,7 +106,7 @@ Assume point is at block opening line."
(symbol-value lang-headers))
(append (org-babel-params-from-properties lang)
(list raw-params)))))))
(setf hash (org-babel-sha1-hash info)))
(setf hash (org-babel-sha1-hash info :export)))
(org-babel-exp-do-export info 'block hash)))))
(defcustom org-babel-exp-call-line-template
@ -210,9 +208,9 @@ this template."
(progn (goto-char end)
(skip-chars-forward " \t")
(point)))
;; Otherwise: remove inline src block but
;; preserve following white spaces. Then
;; insert value.
;; 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)
@ -244,7 +242,7 @@ this template."
(insert rep))))
(`src-block
(let ((match-start (copy-marker (match-beginning 0)))
(ind (org-get-indentation)))
(ind (current-indentation)))
;; Take care of matched block: compute
;; replacement string. In particular, a nil
;; REPLACEMENT means the block is left as-is

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

@ -33,9 +33,9 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(declare-function forth-proc "ext:gforth" ())
(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-default-header-args:forth '((:session . "yes"))
"Default header arguments for forth code blocks.")

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

@ -28,13 +28,12 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(require 'cc-mode)
(require 'cl-lib)
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
@ -109,7 +108,7 @@ its header arguments."
"Wrap body in a \"program ... end program\" block if none exists."
(if (string-match "^[ \t]*program[ \t]*.*" (capitalize body))
(let ((vars (org-babel--get-vars params)))
(if vars (error "Cannot use :vars if `program' statement is present"))
(when vars (error "Cannot use :vars if `program' statement is present"))
body)
(format "program main\n%s\nend program main\n" body)))

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

@ -39,9 +39,9 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(declare-function org-time-string-to-time "org" (s))
(declare-function org-combine-plists "org" (&rest plists))
(declare-function orgtbl-to-generic "org-table" (table params))
(declare-function gnuplot-mode "ext:gnuplot-mode" ())
(declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt))

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

@ -40,10 +40,9 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(require 'comint)
(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function haskell-mode "ext:haskell-mode" ())
(declare-function run-haskell "ext:inf-haskell" (&optional arg))
(declare-function inferior-haskell-load-file
@ -75,17 +74,16 @@
(org-babel-variable-assignments:haskell params)))
(session (org-babel-haskell-initiate-session session params))
(comint-preoutput-filter-functions
(cons 'ansi-color-filter-apply comint-preoutput-filter-functions))
(cons 'ansi-color-filter-apply comint-preoutput-filter-functions))
(raw (org-babel-comint-with-output
(session org-babel-haskell-eoe t full-body)
(insert (org-trim full-body))
(comint-send-input nil t)
(insert org-babel-haskell-eoe)
(comint-send-input nil t)))
(results (mapcar
#'org-babel-strip-quotes
(cdr (member org-babel-haskell-eoe
(reverse (mapcar #'org-trim raw)))))))
(results (mapcar #'org-strip-quotes
(cdr (member org-babel-haskell-eoe
(reverse (mapcar #'org-trim raw)))))))
(org-babel-reassemble-table
(let ((result
(pcase result-type

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

@ -41,6 +41,11 @@
(require 'ob)
(declare-function run-mozilla "ext:moz" (arg))
(declare-function httpd-start "ext:simple-httpd" ())
(declare-function run-skewer "ext:skewer-mode" ())
(declare-function skewer-repl "ext:skewer-repl" ())
(declare-function indium-run-node "ext:indium-nodejs" (command))
(declare-function indium-eval "ext:indium-interaction" (string &optional callback))
(defvar org-babel-default-header-args:js '()
"Default header arguments for js code blocks.")
@ -52,7 +57,12 @@
"Name of command used to evaluate js blocks."
:group 'org-babel
:version "24.1"
:type 'string)
:type '(choice (const "node")
(const "mozrepl")
(const "skewer-mode")
(const "indium")
(const "js-comint"))
:safe #'stringp)
(defvar org-babel-js-function-wrapper
"require('sys').print(require('sys').inspect(function(){\n%s\n}()));"
@ -62,22 +72,13 @@
"Execute a block of Javascript code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let* ((org-babel-js-cmd (or (cdr (assq :cmd params)) org-babel-js-cmd))
(session (cdr (assq :session params)))
(result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:js params)))
(result (if (not (string= (cdr (assq :session params)) "none"))
;; session evaluation
(let ((session (org-babel-prep-session:js
(cdr (assq :session params)) params)))
(nth 1
(org-babel-comint-with-output
(session (format "%S" org-babel-js-eoe) t body)
(mapc
(lambda (line)
(insert (org-babel-chomp line))
(comint-send-input nil t))
(list body (format "%S" org-babel-js-eoe))))))
;; external evaluation
(result (cond
;; no session specified, external evaluation
((string= session "none")
(let ((script-file (org-babel-temp-file "js-script-")))
(with-temp-file script-file
(insert
@ -87,7 +88,24 @@ This function is called by `org-babel-execute-src-block'."
full-body)))
(org-babel-eval
(format "%s %s" org-babel-js-cmd
(org-babel-process-file-name script-file)) "")))))
(org-babel-process-file-name script-file)) "")))
;; Indium Node REPL. Separate case because Indium
;; REPL is not inherited from Comint mode.
((string= session "*JS REPL*")
(require 'indium-repl)
(unless (get-buffer session)
(indium-run-node org-babel-js-cmd))
(indium-eval full-body))
;; session evaluation
(t
(let ((session (org-babel-prep-session:js
(cdr (assq :session params)) params)))
(nth 1
(org-babel-comint-with-output
(session (format "%S" org-babel-js-eoe) t body)
(dolist (code (list body (format "%S" org-babel-js-eoe)))
(insert (org-babel-chomp code))
(comint-send-input nil t)))))))))
(org-babel-result-cond (cdr (assq :result-params params))
result (org-babel-js-read result))))
@ -123,11 +141,13 @@ specifying a variable of the same value."
(var-lines (org-babel-variable-assignments:js params)))
(when session
(org-babel-comint-in-buffer session
(sit-for .5) (goto-char (point-max))
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)
(sit-for .1) (goto-char (point-max))) var-lines)))
(goto-char (point-max))
(dolist (var var-lines)
(insert var)
(comint-send-input nil t)
(org-babel-comint-wait-for-output session)
(sit-for .1)
(goto-char (point-max)))))
session))
(defun org-babel-variable-assignments:js (params)
@ -137,25 +157,47 @@ specifying a variable of the same value."
(car pair) (org-babel-js-var-to-js (cdr pair))))
(org-babel--get-vars params)))
(defun org-babel-js-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
(defun org-babel-js-initiate-session (&optional session _params)
"If there is not a current inferior-process-buffer in `SESSION'
then create. Return the initialized session."
(unless (string= session "none")
(cond
((string= "mozrepl" org-babel-js-cmd)
(require 'moz)
(let ((session-buffer (save-window-excursion
(run-mozilla nil)
(rename-buffer session)
(current-buffer))))
(if (org-babel-comint-buffer-livep session-buffer)
(progn (sit-for .25) session-buffer)
(sit-for .5)
(org-babel-js-initiate-session session))))
((string= "node" org-babel-js-cmd )
(error "Session evaluation with node.js is not supported"))
(t
(error "Sessions are only supported with mozrepl add \":cmd mozrepl\"")))))
(cond
((string= session "none")
(warn "Session evaluation of ob-js is not supported"))
((string= "*skewer-repl*" session)
(require 'skewer-repl)
(let ((session-buffer (get-buffer "*skewer-repl*")))
(if (and session-buffer
(org-babel-comint-buffer-livep (get-buffer session-buffer))
(comint-check-proc session-buffer))
session-buffer
;; start skewer REPL.
(httpd-start)
(run-skewer)
(skewer-repl)
session-buffer)))
((string= "*Javascript REPL*" session)
(require 'js-comint)
(let ((session-buffer "*Javascript REPL*"))
(if (and (org-babel-comint-buffer-livep (get-buffer session-buffer))
(comint-check-proc session-buffer))
session-buffer
(call-interactively 'run-js)
(sit-for .5)
session-buffer)))
((string= "mozrepl" org-babel-js-cmd)
(require 'moz)
(let ((session-buffer (save-window-excursion
(run-mozilla nil)
(rename-buffer session)
(current-buffer))))
(if (org-babel-comint-buffer-livep session-buffer)
(progn (sit-for .25) session-buffer)
(sit-for .5)
(org-babel-js-initiate-session session))))
((string= "node" org-babel-js-cmd )
(error "Session evaluation with node.js is not supported"))
(t
(error "Sessions are only supported with mozrepl add \":cmd mozrepl\""))))
(provide 'ob-js)

106
lisp/org/ob-keys.el
View file

@ -1,106 +0,0 @@
;;; ob-keys.el --- Key Bindings for Babel -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2019 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: 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:
;; Add Org Babel keybindings to the Org mode keymap for exposing
;; Org Babel functions. These will all share a common prefix. See
;; the value of `org-babel-key-bindings' for a list of interactive
;; functions and their associated keys.
;;; Code:
(require 'ob-core)
(defvar org-babel-key-prefix "\C-c\C-v"
"The key prefix for Babel interactive key-bindings.
See `org-babel-key-bindings' for the list of interactive babel
functions which are assigned key bindings, and see
`org-babel-map' for the actual babel keymap.")
(defvar org-babel-map (make-sparse-keymap)
"The keymap for interactive Babel functions.")
;;;###autoload
(defun org-babel-describe-bindings ()
"Describe all keybindings behind `org-babel-key-prefix'."
(interactive)
(describe-bindings org-babel-key-prefix))
(defvar org-babel-key-bindings
'(("p" . org-babel-previous-src-block)
("\C-p" . org-babel-previous-src-block)
("n" . org-babel-next-src-block)
("\C-n" . org-babel-next-src-block)
("e" . org-babel-execute-maybe)
("\C-e" . org-babel-execute-maybe)
("o" . org-babel-open-src-block-result)
("\C-o" . org-babel-open-src-block-result)
("\C-v" . org-babel-expand-src-block)
("v" . org-babel-expand-src-block)
("u" . org-babel-goto-src-block-head)
("\C-u" . org-babel-goto-src-block-head)
("g" . org-babel-goto-named-src-block)
("r" . org-babel-goto-named-result)
("\C-r" . org-babel-goto-named-result)
("\C-b" . org-babel-execute-buffer)
("b" . org-babel-execute-buffer)
("\C-s" . org-babel-execute-subtree)
("s" . org-babel-execute-subtree)
("\C-d" . org-babel-demarcate-block)
("d" . org-babel-demarcate-block)
("\C-t" . org-babel-tangle)
("t" . org-babel-tangle)
("\C-f" . org-babel-tangle-file)
("f" . org-babel-tangle-file)
("\C-c" . org-babel-check-src-block)
("c" . org-babel-check-src-block)
("\C-j" . org-babel-insert-header-arg)
("j" . org-babel-insert-header-arg)
("\C-l" . org-babel-load-in-session)
("l" . org-babel-load-in-session)
("\C-i" . org-babel-lob-ingest)
("i" . org-babel-lob-ingest)
("\C-I" . org-babel-view-src-block-info)
("I" . org-babel-view-src-block-info)
("\C-z" . org-babel-switch-to-session)
("z" . org-babel-switch-to-session-with-code)
("\C-a" . org-babel-sha1-hash)
("a" . org-babel-sha1-hash)
("h" . org-babel-describe-bindings)
("\C-x" . org-babel-do-key-sequence-in-edit-buffer)
("x" . org-babel-do-key-sequence-in-edit-buffer)
("k" . org-babel-remove-result-one-or-many)
("\C-\M-h" . org-babel-mark-block))
"Alist of key bindings and interactive Babel functions.
This list associates interactive Babel functions
with keys. Each element of this list will add an entry to the
`org-babel-map' using the letter key which is the `car' of the
a-list placed behind the generic `org-babel-key-prefix'.")
(provide 'ob-keys)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; ob-keys.el ends here

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

@ -31,12 +31,12 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(declare-function org-create-formula-image "org" (string tofile options buffer &optional type))
(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-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex"))

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

@ -33,7 +33,9 @@
;;; Code:
(require 'ob)
(require 'outline)
(declare-function org-show-all "org" (&optional types))
(defalias 'lilypond-mode 'LilyPond-mode)
(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
@ -264,7 +266,7 @@ LINE is the erroneous line."
(setq case-fold-search nil)
(if (search-forward line nil t)
(progn
(outline-show-all)
(org-show-all)
(set-mark (point))
(goto-char (- (point) (length line))))
(goto-char temp))))

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

@ -37,10 +37,10 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(declare-function sly-eval "ext:sly" (sexp &optional package))
(declare-function slime-eval "ext:slime" (sexp &optional package))
(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp"))
@ -107,7 +107,7 @@ a property list containing the parameters of the block."
(point-min) (point-max)))))
(cdr (assq :package params)))))))
(org-babel-result-cond (cdr (assq :result-params params))
result
(org-strip-quotes result)
(condition-case nil
(read (org-babel-lisp-vector-to-list result))
(error result))))

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

@ -62,7 +62,7 @@ should not be inherited from a source block.")
(cons (cons source info)
(assq-delete-all source org-babel-library-of-babel))))
(cl-incf lob-ingest-count))))
(message "%d src block%s added to Library of Babel"
(message "%d source block%s added to Library of Babel"
lob-ingest-count (if (> lob-ingest-count 1) "s" ""))
lob-ingest-count))
@ -138,9 +138,8 @@ see."
header
org-babel-default-lob-header-args
(append
(org-with-wide-buffer
(goto-char begin)
(org-babel-params-from-properties language))
(org-with-point-at begin
(org-babel-params-from-properties language))
(list
(org-babel-parse-header-arguments
(org-element-property :inside-header context))

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

@ -34,10 +34,9 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(require 'cl-lib)
(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function lua-shell "ext:lua-mode" (&optional argprompt))
(declare-function lua-toggle-shells "ext:lua-mode" (arg))
(declare-function run-lua "ext:lua" (cmd &optional dedicated show))
@ -149,7 +148,7 @@ specifying a variable of the same value."
(if (eq var 'hline)
org-babel-lua-hline-to
(format
(if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S")
(if (and (stringp var) (string-match "[\n\r]" var)) "[=[%s]=]" "%S")
(if (stringp var) (substring-no-properties var) var)))))
(defun org-babel-lua-table-or-string (results)
@ -291,13 +290,13 @@ last statement in BODY, as elisp."
(let ((raw
(pcase result-type
(`output (org-babel-eval org-babel-lua-command
(concat (if preamble (concat preamble "\n"))
(concat preamble (and preamble "\n")
body)))
(`value (let ((tmp-file (org-babel-temp-file "lua-")))
(org-babel-eval
org-babel-lua-command
(concat
(if preamble (concat preamble "\n") "")
preamble (and preamble "\n")
(format
(if (member "pp" result-params)
org-babel-lua-pp-wrapper-method

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

@ -37,11 +37,11 @@
;;; Code:
(require 'ob)
(require 'comint)
(require 'org-macs)
(declare-function tuareg-run-caml "ext:tuareg" ())
(declare-function tuareg-run-ocaml "ext:tuareg" ())
(declare-function tuareg-interactive-send-input "ext:tuareg" ())
(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml"))
@ -83,11 +83,11 @@
(raw (org-trim clean))
(result-params (cdr (assq :result-params params))))
(string-match
"\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$"
"\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =[[:space:]]+\\(\\(.\\|\n\\)+\\)$"
raw)
(let ((output (match-string 1 raw))
(type (match-string 3 raw))
(value (match-string 5 raw)))
(value (match-string 4 raw)))
(org-babel-reassemble-table
(org-babel-result-cond result-params
(cond

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

@ -30,10 +30,10 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(declare-function matlab-shell "ext:matlab-mode")
(declare-function matlab-shell-run-region "ext:matlab-mode")
(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-default-header-args:matlab '())
(defvar org-babel-default-header-args:octave '())
@ -237,13 +237,11 @@ value of the last statement in BODY, as elisp."
(`output
(setq results
(if matlabp
(cdr (reverse (delq "" (mapcar
#'org-babel-strip-quotes
(mapcar #'org-trim raw)))))
(cdr (reverse (delq "" (mapcar #'org-strip-quotes
(mapcar #'org-trim raw)))))
(cdr (member org-babel-octave-eoe-output
(reverse (mapcar
#'org-babel-strip-quotes
(mapcar #'org-trim raw)))))))
(reverse (mapcar #'org-strip-quotes
(mapcar #'org-trim raw)))))))
(mapconcat #'identity (reverse results) "\n")))))
(defun org-babel-octave-import-elisp-from-file (file-name)
@ -254,9 +252,9 @@ This removes initial blank and comment lines and then calls
(with-temp-file temp-file
(insert-file-contents file-name)
(re-search-forward "^[ \t]*[^# \t]" nil t)
(if (< (setq beg (point-min))
(setq end (point-at-bol)))
(delete-region beg end)))
(when (< (setq beg (point-min))
(setq end (point-at-bol)))
(delete-region beg end)))
(org-babel-import-elisp-from-file temp-file '(16))))
(provide 'ob-octave)

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

@ -60,16 +60,19 @@ are expected to be scalar variables."
(defun org-babel-plantuml-make-body (body params)
"Return PlantUML input string.
BODY is the content of the source block and PARAMS is a property list
of source block parameters. This function relies on the
`org-babel-expand-body:generic' function to extract `:var' entries
from PARAMS and on the `org-babel-variable-assignments:plantuml'
function to convert variables to PlantUML assignments."
(concat
"@startuml\n"
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:plantuml params))
"\n@enduml"))
function to convert variables to PlantUML assignments.
If BODY does not contain @startXXX ... @endXXX clauses, @startuml
... @enduml will be added."
(let ((assignments (org-babel-variable-assignments:plantuml params)))
(if (string-prefix-p "@start" body t) assignments
(format "@startuml\n%s\n@enduml"
(org-babel-expand-body:generic body params assignments)))))
(defun org-babel-execute:plantuml (body params)
"Execute a block of plantuml code with org-babel.
@ -93,6 +96,8 @@ This function is called by `org-babel-execute-src-block'."
" -teps" "")
(if (string= (file-name-extension out-file) "pdf")
" -tpdf" "")
(if (string= (file-name-extension out-file) "tex")
" -tlatex" "")
(if (string= (file-name-extension out-file) "vdx")
" -tvdx" "")
(if (string= (file-name-extension out-file) "xmi")

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

@ -28,9 +28,8 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(declare-function org-remove-indentation "org" )
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function py-shell "ext:python-mode" (&optional argprompt))
(declare-function py-toggle-shells "ext:python-mode" (arg))
(declare-function run-python "ext:python" (&optional cmd dedicated show))
@ -266,13 +265,13 @@ last statement in BODY, as elisp."
(let ((raw
(pcase result-type
(`output (org-babel-eval org-babel-python-command
(concat (if preamble (concat preamble "\n"))
(concat preamble (and preamble "\n")
body)))
(`value (let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-eval
org-babel-python-command
(concat
(if preamble (concat preamble "\n") "")
preamble (and preamble "\n")
(format
(if (member "pp" result-params)
org-babel-python-pp-wrapper-method
@ -308,9 +307,21 @@ last statement in BODY, as elisp."
(list (format "open('%s', 'w').write(str(_))"
(org-babel-process-file-name tmp-file
'noquote)))))))
(last-indent 0)
(input-body (lambda (body)
(mapc (lambda (line) (insert line) (funcall send-wait))
(split-string body "[\r\n]"))
(dolist (line (split-string body "[\r\n]"))
;; Insert a blank line to end an indent
;; block.
(let ((curr-indent (string-match "\\S-" line)))
(if curr-indent
(progn
(when (< curr-indent last-indent)
(insert "")
(funcall send-wait))
(setq last-indent curr-indent))
(setq last-indent 0)))
(insert line)
(funcall send-wait))
(funcall send-wait)))
(results
(pcase result-type

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

@ -37,8 +37,8 @@
;; - resource-id :: the id or name of the resource
;; So an example of a simple src block referencing table data in the
;; same file would be
;; So an example of a simple source block referencing table data in
;; the same file would be
;; #+NAME: sandbox
;; | 1 | 2 | 3 |
@ -50,6 +50,7 @@
;;; Code:
(require 'ob-core)
(require 'org-macs)
(require 'cl-lib)
(declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
@ -63,7 +64,6 @@
(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-trim "org" (s &optional keep-lead))
(defvar org-babel-update-intermediate nil
"Update the in-buffer results of code blocks executed to resolve references.")

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

@ -37,8 +37,8 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function run-ruby "ext:inf-ruby" (&optional command name))
(declare-function xmp "ext:rcodetools" (&optional option))

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

@ -112,10 +112,9 @@
(or buffer
(progn
(run-geiser impl)
(if name
(progn
(rename-buffer name t)
(org-babel-scheme-set-session-buffer name (current-buffer))))
(when name
(rename-buffer name t)
(org-babel-scheme-set-session-buffer name (current-buffer)))
(current-buffer)))))
(defun org-babel-scheme-make-session-name (buffer name impl)
@ -214,6 +213,7 @@ This function is called by `org-babel-execute-src-block'."
(session (org-babel-scheme-make-session-name
source-buffer-name (cdr (assq :session params)) impl))
(full-body (org-babel-expand-body:scheme body params))
(result-params (cdr (assq :result-params params)))
(result
(org-babel-scheme-execute-with-geiser
full-body ; code
@ -227,7 +227,9 @@ This function is called by `org-babel-execute-src-block'."
(cdr (assq :colnames params)))
(org-babel-pick-name (cdr (assq :rowname-names params))
(cdr (assq :rownames params))))))
(org-babel-scheme--table-or-string table))))))
(org-babel-result-cond result-params
result
(org-babel-scheme--table-or-string table)))))))
(provide 'ob-scheme)

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

@ -4,7 +4,7 @@
;; Author: Bjarte Johansen
;; Keywords: literate programming, reproducible research
;; Version: 0.1.0
;; Version: 0.1.1
;; This file is part of GNU Emacs.
@ -79,7 +79,7 @@ function is called by `org-babel-execute-src-block'."
(cmd (mapconcat #'identity
(remq nil
(list org-babel-sed-command
(format "--file=\"%s\"" code-file)
(format "-f \"%s\"" code-file)
cmd-line
in-file))
" ")))

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

@ -27,6 +27,7 @@
;;; Code:
(require 'ob)
(require 'org-macs)
(require 'shell)
(require 'cl-lib)
@ -36,7 +37,6 @@
(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)
t)
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function orgtbl-to-generic "org-table" (table params))
(defvar org-babel-default-header-args:shell '())
@ -57,10 +57,11 @@ is modified outside the Customize interface."
'org-babel-variable-assignments:shell
,(format "Return list of %s statements assigning to the block's \
variables."
name)))))
name)))
(eval `(defvar ,(intern (concat "org-babel-default-header-args:" name)) '()))))
(defcustom org-babel-shell-names
'("sh" "bash" "csh" "ash" "dash" "ksh" "mksh" "posh")
'("sh" "bash" "zsh" "fish" "csh" "ash" "dash" "ksh" "mksh" "posh")
"List of names of shell supported by babel shell code blocks.
Call `org-babel-shell-initialize' when modifying this variable
outside the Customize interface."
@ -206,62 +207,60 @@ var of the same value."
If RESULT-TYPE equals `output' then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals `value' then
return the value of the last statement in BODY."
(let ((results
(cond
((or stdin cmdline) ; external shell script w/STDIN
(let ((script-file (org-babel-temp-file "sh-script-"))
(stdin-file (org-babel-temp-file "sh-stdin-"))
(shebang (cdr (assq :shebang params)))
(padline (not (string= "no" (cdr (assq :padline params))))))
(with-temp-file script-file
(when shebang (insert (concat shebang "\n")))
(when padline (insert "\n"))
(insert body))
(set-file-modes script-file #o755)
(with-temp-file stdin-file (insert (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))
(buffer-string))))
(session ; session evaluation
(mapconcat
#'org-babel-sh-strip-weird-long-prompt
(mapcar
#'org-trim
(butlast
(org-babel-comint-with-output
(session org-babel-sh-eoe-output t body)
(mapc
(lambda (line)
(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)))))
(append
(split-string (org-trim body) "\n")
(list org-babel-sh-eoe-indicator))))
2)) "\n"))
('otherwise ; external shell script
(if (and (cdr (assq :shebang params))
(> (length (cdr (assq :shebang params))) 0))
(let ((script-file (org-babel-temp-file "sh-script-"))
(shebang (cdr (assq :shebang params)))
(padline (not (equal "no" (cdr (assq :padline params))))))
(with-temp-file script-file
(when shebang (insert (concat shebang "\n")))
(when padline (insert "\n"))
(insert body))
(set-file-modes script-file #o755)
(org-babel-eval script-file ""))
(org-babel-eval shell-file-name (org-trim body)))))))
(let* ((shebang (cdr (assq :shebang params)))
(results
(cond
((or stdin cmdline) ; external shell script w/STDIN
(let ((script-file (org-babel-temp-file "sh-script-"))
(stdin-file (org-babel-temp-file "sh-stdin-"))
(padline (not (string= "no" (cdr (assq :padline params))))))
(with-temp-file script-file
(when shebang (insert shebang "\n"))
(when padline (insert "\n"))
(insert 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))
(buffer-string))))
(session ; session evaluation
(mapconcat
#'org-babel-sh-strip-weird-long-prompt
(mapcar
#'org-trim
(butlast
(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))
"\n"))
;; External shell script, with or without a predefined
;; shebang.
((org-string-nw-p shebang)
(let ((script-file (org-babel-temp-file "sh-script-"))
(padline (not (equal "no" (cdr (assq :padline params))))))
(with-temp-file script-file
(insert shebang "\n")
(when padline (insert "\n"))
(insert body))
(set-file-modes script-file #o755)
(org-babel-eval script-file "")))
(t
(org-babel-eval shell-file-name (org-trim body))))))
(when results
(let ((result-params (cdr (assq :result-params params))))
(org-babel-result-cond result-params

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

@ -39,6 +39,7 @@
;; - dbport
;; - dbuser
;; - dbpassword
;; - dbconnection (to reference connections in sql-connection-alist)
;; - database
;; - colnames (default, nil, means "yes")
;; - result-params
@ -73,6 +74,7 @@
(declare-function org-table-to-lisp "org-table" (&optional txt))
(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p))
(defvar sql-connection-alist)
(defvar org-babel-default-header-args:sql '())
(defconst org-babel-header-args:sql
@ -111,8 +113,24 @@ Pass nil to omit that arg."
(when database (concat "-d" database))))))
(defun org-babel-sql-dbstring-oracle (host port user password database)
"Make Oracle command line args for database connection."
(format "%s/%s@%s:%s/%s" user password host port database))
"Make Oracle command line arguments for database connection.
If HOST and PORT are nil then don't pass them. This allows you
to use names defined in your \"TNSNAMES\" file. So you can
connect with
<user>/<password>@<host>:<port>/<database>
or
<user>/<password>@<database>
using its alias."
(cond ((and user password database host port)
(format "%s/%s@%s:%s/%s" user password host port database))
((and user password database)
(format "%s/%s@%s" user password database))
(t (user-error "Missing information to connect to database"))))
(defun org-babel-sql-dbstring-mssql (host user password database)
"Make sqlcmd command line args for database connection.
@ -158,16 +176,35 @@ Otherwise, use Emacs' standard conversion function."
((string= "windows-nt" system-type) file)
(t (format "%S" (convert-standard-filename file)))))
(defun org-babel-find-db-connection-param (params name)
"Return database connection parameter NAME.
Given a parameter NAME, if :dbconnection is defined in PARAMS
then look for the parameter into the corresponding connection
defined in `sql-connection-alist`, otherwise look into PARAMS.
Look `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)
(:database . sql-database)))
(mapped-name (cdr (assq name name-mapping))))
(cadr (assq mapped-name
(cdr (assoc dbconnection sql-connection-alist)))))
(cdr (assq name params))))
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (cdr (assq :result-params params)))
(cmdline (cdr (assq :cmdline params)))
(dbhost (cdr (assq :dbhost params)))
(dbport (cdr (assq :dbport params)))
(dbuser (cdr (assq :dbuser params)))
(dbpassword (cdr (assq :dbpassword params)))
(database (cdr (assq :database params)))
(dbhost (org-babel-find-db-connection-param params :dbhost))
(dbport (org-babel-find-db-connection-param params :dbport))
(dbuser (org-babel-find-db-connection-param params :dbuser))
(dbpassword (org-babel-find-db-connection-param params :dbpassword))
(database (org-babel-find-db-connection-param params :database))
(engine (cdr (assq :engine params)))
(colnames-p (not (equal "no" (cdr (assq :colnames params)))))
(in-file (org-babel-temp-file "sql-in-"))
@ -241,6 +278,7 @@ SET NEWPAGE 0
SET TAB OFF
SET SPACE 0
SET LINESIZE 9999
SET TRIMOUT ON TRIMSPOOL ON
SET ECHO OFF
SET FEEDBACK OFF
SET VERIFY OFF

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

@ -28,7 +28,6 @@
;;; Code:
(require 'ob)
(declare-function org-fill-template "org" (template alist))
(declare-function org-table-convert-region "org-table"
(beg0 end0 &optional separator))
(declare-function orgtbl-to-csv "org-table" (table params))

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

@ -54,8 +54,7 @@
;;; Code:
(require 'ob-core)
(declare-function org-trim "org" (s &optional keep-lead))
(require 'org-macs)
(defun org-babel-table-truncate-at-newline (string)
"Replace newline character with ellipses.

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

@ -30,6 +30,7 @@
(require 'cl-lib)
(require 'org-src)
(require 'org-macs)
(require 'ol)
(declare-function make-directory "files" (dir &optional parents))
(declare-function org-at-heading-p "org" (&optional ignored))
@ -38,18 +39,9 @@
(declare-function org-before-first-heading-p "org" ())
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-type "org-element" (element))
(declare-function org-fill-template "org" (template alist))
(declare-function org-heading-components "org" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-link-escape "org" (text &optional table merge))
(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-store-link "org" (arg))
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function outline-previous-heading "outline" ())
(declare-function org-id-find "org-id" (id &optional markerp))
(defvar org-link-types-re)
(defcustom org-babel-tangle-lang-exts
'(("emacs-lisp" . "el")
@ -182,7 +174,7 @@ export file for all source blocks. Optional argument LANG can be
used to limit the exported source code blocks by language.
Return a list whose CAR is the tangled file name."
(interactive "fFile to tangle: \nP")
(let ((visited-p (get-file-buffer (expand-file-name file)))
(let ((visited-p (find-buffer-visiting (expand-file-name file)))
to-be-removed)
(prog1
(save-window-excursion
@ -236,13 +228,7 @@ used to limit the exported source code blocks by language."
(let* ((lang (car by-lang))
(specs (cdr by-lang))
(ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
(lang-f (intern
(concat
(or (and (cdr (assoc lang org-src-lang-modes))
(symbol-name
(cdr (assoc lang org-src-lang-modes))))
lang)
"-mode")))
(lang-f (org-src-get-lang-mode lang))
she-banged)
(mapc
(lambda (spec)
@ -333,8 +319,6 @@ references."
(delete-region (save-excursion (beginning-of-line 1) (point))
(save-excursion (end-of-line 1) (forward-char 1) (point)))))
(defvar org-stored-links)
(defvar org-bracket-link-regexp)
(defun org-babel-spec-to-string (spec)
"Insert SPEC into the current file.
@ -409,7 +393,8 @@ can be used to limit the collected code blocks by target file."
(if by-lang (setcdr by-lang (cons block (cdr by-lang)))
(push (cons src-lang (list block)) blocks)))))))
;; Ensure blocks are in the correct order.
(mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) blocks)))
(mapcar (lambda (b) (cons (car b) (nreverse (cdr b))))
(nreverse blocks))))
(defun org-babel-tangle-single-block (block-counter &optional only-this-block)
"Collect the tangled source for current block.
@ -429,7 +414,7 @@ non-nil, return the full association list to be used by
(match-string 1 extra))
org-coderef-label-format))
(link (let ((l (org-no-properties (org-store-link nil))))
(and (string-match org-bracket-link-regexp l)
(and (string-match org-link-bracket-re l)
(match-string 1 l))))
(source-name
(or (nth 4 info)
@ -503,22 +488,21 @@ non-nil, return the full association list to be used by
result)))
(defun org-babel-tangle-comment-links (&optional info)
"Return a list of begin and end link comments for the code block at point."
(let ((link-data
`(("start-line" . ,(number-to-string
(org-babel-where-is-src-block-head)))
("file" . ,(buffer-file-name))
("link" . ,(org-link-escape
(progn
(call-interactively #'org-store-link)
(org-no-properties (car (pop org-stored-links))))))
("source-name" .
,(nth 4 (or info (org-babel-get-src-block-info 'light)))))))
"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 ,_)
`(("start-line" . ,(org-with-point-at start
(number-to-string
(line-number-at-pos))))
("file" . ,(buffer-file-name))
("link" . ,(org-no-properties (org-store-link nil)))
("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))))
;; de-tangling functions
(defvar org-bracket-link-analytic-regexp)
(defun org-babel-detangle (&optional source-code-file)
"Propagate changes in source file back original to Org file.
This requires that code blocks were tangled with link comments
@ -528,9 +512,9 @@ which enable the original code blocks to be found."
(when source-code-file (find-file source-code-file))
(goto-char (point-min))
(let ((counter 0) new-body end)
(while (re-search-forward org-bracket-link-analytic-regexp nil t)
(while (re-search-forward org-link-bracket-re nil t)
(when (re-search-forward
(concat " " (regexp-quote (match-string 5)) " ends here"))
(concat " " (regexp-quote (match-string 2)) " ends here"))
(setq end (match-end 0))
(forward-line -1)
(save-excursion
@ -544,17 +528,15 @@ which enable the original code blocks to be found."
"Jump from a tangled code file to the related Org mode file."
(interactive)
(let ((mid (point))
start body-start end
target-buffer target-char link path block-name body)
start body-start end target-buffer target-char link block-name body)
(save-window-excursion
(save-excursion
(while (and (re-search-backward org-bracket-link-analytic-regexp nil t)
(while (and (re-search-backward org-link-bracket-re nil t)
(not ; ever wider searches until matching block comments
(and (setq start (line-beginning-position))
(setq body-start (line-beginning-position 2))
(setq link (match-string 0))
(setq path (match-string 3))
(setq block-name (match-string 5))
(setq block-name (match-string 2))
(save-excursion
(save-match-data
(re-search-forward
@ -564,12 +546,9 @@ which enable the original code blocks to be found."
(unless (and start (< start mid) (< mid end))
(error "Not in tangled code"))
(setq body (buffer-substring body-start end)))
(when (string-match "::" path)
(setq path (substring path 0 (match-beginning 0))))
(find-file (or (car (org-id-find path)) path))
(setq target-buffer (current-buffer))
;; Go to the beginning of the relative block in Org file.
(org-open-link-from-string link)
(org-link-open-from-string link)
(setq target-buffer (current-buffer))
(if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name)
(let ((n (string-to-number (match-string 1 block-name))))
(if (org-before-first-heading-p) (goto-char (point-min))
@ -583,10 +562,12 @@ which enable the original code blocks to be found."
(t (org-babel-next-src-block (1- n)))))
(org-babel-goto-named-src-block block-name))
(goto-char (org-babel-where-is-src-block-head))
;; Preserve location of point within the source code in tangled
;; code file.
(forward-line 1)
(forward-char (- mid body-start))
;; Try to preserve location of point within the source code in
;; tangled code file.
(let ((offset (- mid body-start)))
(when (> end (+ offset (point)))
(forward-char offset)))
(setq target-char (point)))
(org-src-switch-to-buffer target-buffer t)
(goto-char target-char)

3
lisp/org/ob-vala.el
View file

@ -39,8 +39,7 @@
;;; Code:
(require 'ob)
(declare-function org-trim "org" (s &optional keep-lead))
(require 'org-macs)
;; File extension.
(add-to-list 'org-babel-tangle-lang-exts '("vala" . "vala"))

2
lisp/org/ob.el
View file

@ -24,11 +24,11 @@
;;; Code:
(require 'org-macs)
(require 'org-compat)
(require 'org-keys)
(require 'ob-eval)
(require 'ob-core)
(require 'ob-comint)
(require 'ob-exp)
(require 'ob-keys)
(require 'ob-table)
(require 'ob-lob)
(require 'ob-ref)

38
lisp/org/org-bbdb.el → lisp/org/ol-bbdb.el
View file

@ -1,4 +1,4 @@
;;; org-bbdb.el --- Support for links to BBDB entries -*- lexical-binding: t; -*-
;;; ol-bbdb.el --- Links to BBDB entries -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2019 Free Software Foundation, Inc.
@ -93,23 +93,22 @@
;;
;;; Code:
(require 'org)
(require 'cl-lib)
(require 'org-compat)
(require 'org-macs)
(require 'ol)
;; Declare external functions and variables
;; Declare functions and variables
(declare-function bbdb "ext:bbdb-com" (string elidep))
(declare-function bbdb-company "ext:bbdb-com" (string elidep))
(declare-function bbdb-current-record "ext:bbdb-com"
(&optional planning-on-modifying))
(declare-function bbdb-current-record "ext:bbdb-com" (&optional planning-on-modifying))
(declare-function bbdb-name "ext:bbdb-com" (string elidep))
(declare-function bbdb-completing-read-record "ext:bbdb-com"
(prompt &optional omit-records))
(declare-function bbdb-completing-read-record "ext:bbdb-com" (prompt &optional omit-records))
(declare-function bbdb-record-field "ext:bbdb" (record field))
(declare-function bbdb-record-getprop "ext:bbdb" (record property))
(declare-function bbdb-record-name "ext:bbdb" (record))
(declare-function bbdb-records "ext:bbdb"
(&optional dont-check-disk already-in-db-buffer))
(declare-function bbdb-records "ext:bbdb" (&optional dont-check-disk already-in-db-buffer))
(declare-function bbdb-split "ext:bbdb" (string separators))
(declare-function bbdb-string-trim "ext:bbdb" (string))
(declare-function bbdb-record-get-field "ext:bbdb" (record field))
@ -121,10 +120,13 @@
;; `bbdb-record-xfield' replaces it in recent BBDB v3.x+
(declare-function bbdb-record-xfield "ext:bbdb" (record label))
(declare-function calendar-absolute-from-gregorian "calendar" (date))
(declare-function calendar-gregorian-from-absolute "calendar" (date))
(declare-function calendar-leap-year-p "calendar" (year))
(declare-function diary-ordinal-suffix "diary-lib" (n))
(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el
(with-no-warnings (defvar date)) ;unprefixed, from calendar.el
;; Customization
@ -160,13 +162,13 @@ used."
'(("birthday" .
(lambda (name years suffix)
(concat "Birthday: [[bbdb:" name "][" name " ("
(format "%s" years) ; handles numbers as well as strings
suffix ")]]")))
(format "%s" years) ; handles numbers as well as strings
suffix ")]]")))
("wedding" .
(lambda (name years suffix)
(concat "[[bbdb:" name "][" name "'s "
(format "%s" years)
suffix " wedding anniversary]]"))))
(format "%s" years)
suffix " wedding anniversary]]"))))
"How different types of anniversaries should be formatted.
An alist of elements (STRING . FORMAT) where STRING is the name of an
anniversary class and format is either:
@ -230,7 +232,7 @@ date year)."
(bbdb-record-getprop rec 'company)
(car (bbdb-record-field rec 'organization))))
(link (concat "bbdb:" name)))
(org-store-link-props :type "bbdb" :name name :company company
(org-link-store-props :type "bbdb" :name name :company company
:link link :description name)
link)))
@ -300,7 +302,7 @@ italicized, in all other cases it is left unchanged."
Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted
it will be considered unknown."
(pcase (org-split-string time-str "-")
(`(,a ,b nil) (list (string-to-number a) (string-to-number b) nil))
(`(,a ,b) (list (string-to-number a) (string-to-number b) nil))
(`(,a ,b ,c) (list (string-to-number b)
(string-to-number c)
(string-to-number a)))))
@ -532,10 +534,10 @@ END:VEVENT\n"
(concat (capitalize categ) " " (nth 1 rec))
categ)))))
(provide 'org-bbdb)
(provide 'ol-bbdb)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; org-bbdb.el ends here
;;; ol-bbdb.el ends here

31
lisp/org/org-bibtex.el → lisp/org/ol-bibtex.el
View file

@ -1,4 +1,4 @@
;;; org-bibtex.el --- Org links to BibTeX entries -*- lexical-binding: t; -*-
;;; ol-bibtex.el --- Links to BibTeX entries -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2007-2019 Free Software Foundation, Inc.
;;
@ -107,21 +107,37 @@
;;; Code:
(require 'org)
(require 'bibtex)
(require 'cl-lib)
(require 'org-compat)
(require 'org-macs)
(require 'ol)
(defvar org-agenda-overriding-header)
(defvar org-agenda-search-view-always-boolean)
(defvar org-bibtex-description nil) ; dynamically scoped from org.el
(defvar org-id-locations)
(defvar org-property-end-re)
(defvar org-special-properties)
(defvar org-window-config-before-follow-link)
(declare-function bibtex-beginning-of-entry "bibtex" ())
(declare-function bibtex-generate-autokey "bibtex" ())
(declare-function bibtex-parse-entry "bibtex" (&optional content))
(declare-function bibtex-url "bibtex" (&optional pos no-browse))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-entry-properties "org" (&optional pom which))
(declare-function org-get-tags "org" (&optional pos local))
(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-open-file "org" (path &optional in-emacs line search))
(declare-function org-set-property "org" (property value))
(declare-function org-toggle-tag "org" (tag &optional onoff))
;;; Bibtex data
(defvar org-bibtex-types
@ -354,9 +370,8 @@ and `org-exclude-tags-from-inheritance'."
(append org-bibtex-tags
org-bibtex-no-export-tags))
tag))
(if org-bibtex-inherit-tags
(org-get-tags-at)
(org-get-local-tags-at)))))))
(if org-bibtex-inherit-tags (org-get-tags)
(org-get-tags nil t)))))))
(when type
(let ((entry (format
"@%s{%s,\n%s\n}\n" type id
@ -489,7 +504,7 @@ With optional argument OPTIONAL, also prompt for optional fields."
(save-excursion
(bibtex-beginning-of-entry)
(bibtex-parse-entry)))))
(org-store-link-props
(org-link-store-props
:key (cdr (assoc "=key=" entry))
:author (or (cdr (assoc "author" entry)) "[no author]")
:editor (or (cdr (assoc "editor" entry)) "[no editor]")
@ -743,6 +758,6 @@ This function relies `org-search-view' to locate results."
string (or org-bibtex-prefix "")
org-bibtex-type-property-name))))
(provide 'org-bibtex)
(provide 'ol-bibtex)
;;; org-bibtex.el ends here
;;; ol-bibtex.el ends here

21
lisp/org/org-docview.el → lisp/org/ol-docview.el
View file

@ -1,4 +1,4 @@
;;; org-docview.el --- Support for links to doc-view-mode buffers -*- lexical-binding: t; -*-
;;; ol-docview.el --- Links to Docview mode buffers -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2019 Free Software Foundation, Inc.
@ -43,11 +43,12 @@
;;; Code:
(require 'org)
(require 'doc-view)
(require 'ol)
(declare-function doc-view-goto-page "doc-view" (page))
(declare-function image-mode-window-get "image-mode" (prop &optional winprops))
(declare-function org-open-file "org" (path &optional in-emacs line search))
(org-link-set-parameters "docview"
:follow #'org-docview-open
@ -56,11 +57,11 @@
(defun org-docview-export (link description format)
"Export a docview link from Org files."
(let* ((path (if (string-match "\\(.+\\)::.+" link) (match-string 1 link)
link))
(desc (or description link)))
(let ((path (if (string-match "\\(.+\\)::.+" link) (match-string 1 link)
link))
(desc (or description link)))
(when (stringp path)
(setq path (org-link-escape (expand-file-name path)))
(setq path (expand-file-name path))
(cond
((eq format 'html) (format "<a href=\"%s\">%s</a>" path desc))
((eq format 'latex) (format "\\href{%s}{%s}" path desc))
@ -84,7 +85,7 @@
(let* ((path buffer-file-name)
(page (image-mode-window-get 'page))
(link (concat "docview:" path "::" (number-to-string page))))
(org-store-link-props
(org-link-store-props
:type "docview"
:link link
:description path))))
@ -93,11 +94,11 @@
"Use the existing file name completion for file.
Links to get the file name, then ask the user for the page number
and append it."
(concat (replace-regexp-in-string "^file:" "docview:" (org-file-complete-link))
(concat (replace-regexp-in-string "^file:" "docview:" (org-link-complete-file))
"::"
(read-from-minibuffer "Page:" "1")))
(provide 'org-docview)
(provide 'ol-docview)
;;; org-docview.el ends here
;;; ol-docview.el ends here

16
lisp/org/org-eshell.el → lisp/org/ol-eshell.el
View file

@ -1,4 +1,4 @@
;;; org-eshell.el - Support for Links to Working Directories in Eshell -*- lexical-binding: t; -*-
;;; ol-eshell.el - Links to Working Directories in Eshell -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2019 Free Software Foundation, Inc.
@ -23,16 +23,18 @@
;;; Code:
(require 'org)
(require 'eshell)
(require 'esh-mode)
(require 'ol)
(declare-function eshell/pwd "em-dirs.el" (&rest args))
(org-link-set-parameters "eshell"
:follow #'org-eshell-open
:store #'org-eshell-store-link)
(defun org-eshell-open (link)
"Switch to am eshell buffer and execute a command line.
"Switch to an eshell buffer and execute a command line.
The link can be just a command line (executed in the default
eshell buffer) or a command line prefixed by a buffer name
followed by a colon."
@ -55,12 +57,12 @@
"Store a link that, when opened, switches back to the current eshell buffer
and the current working directory."
(when (eq major-mode 'eshell-mode)
(let* ((command (concat "cd " dired-directory))
(let* ((command (concat "cd " (eshell/pwd)))
(link (concat (buffer-name) ":" command)))
(org-store-link-props
(org-link-store-props
:link (concat "eshell:" link)
:description command))))
(provide 'org-eshell)
(provide 'ol-eshell)
;;; org-eshell.el ends here
;;; ol-eshell.el ends here

33
lisp/org/org-eww.el → lisp/org/ol-eww.el
View file

@ -1,4 +1,4 @@
;;; org-eww.el --- Store url and kill from Eww mode for Org -*- lexical-binding: t -*-
;;; ol-eww.el --- Store URL and kill from Eww mode -*- lexical-binding: t -*-
;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
@ -44,7 +44,7 @@
;;; Code:
(require 'org)
(require 'ol)
(require 'cl-lib)
(defvar eww-current-title)
@ -55,12 +55,12 @@
(declare-function eww-current-url "eww")
;; Store Org-link in eww-mode buffer
;; Store Org link in Eww mode buffer
(org-link-set-parameters "eww" :follow #'eww :store #'org-eww-store-link)
(defun org-eww-store-link ()
"Store a link to the url of an EWW buffer."
(when (eq major-mode 'eww-mode)
(org-store-link-props
(org-link-store-props
:type "eww"
:link (if (< emacs-major-version 25)
eww-current-url
@ -72,7 +72,7 @@
(eww-current-url))))))
;; Some auxiliary functions concerning links in eww buffers
;; Some auxiliary functions concerning links in Eww buffers
(defun org-eww-goto-next-url-property-change ()
"Move to the start of next link if exists.
Otherwise point is not moved. Return point."
@ -93,11 +93,12 @@ Otherwise point is not moved. Return point."
(defun org-eww-copy-for-org-mode ()
"Copy current buffer content or active region with `org-mode' style links.
This will encode `link-title' and `link-location' with
`org-make-link-string', and insert the transformed test into the kill ring,
so that it can be yanked into an Org mode buffer with links working correctly.
`org-link-make-string' and insert the transformed text into the
kill ring, so that it can be yanked into an Org mode buffer with
links working correctly.
Further lines starting with a star get quoted with a comma to keep
the structure of the Org file."
Further lines starting with a star get quoted with a comma to
keep the structure of the Org file."
(interactive)
(let* ((regionp (org-region-active-p))
(transform-start (point-min))
@ -140,13 +141,13 @@ the structure of the Org file."
;; concat `org-mode' style url to `return-content'.
(setq return-content
(concat return-content
(if (stringp link-location)
;; hint: link-location is different for form-elements.
(org-make-link-string link-location link-title)
(if (org-string-nw-p link-location)
;; Hint: link-location is different
;; for form-elements.
(org-link-make-string link-location link-title)
link-title))))
(goto-char temp-position) ; reset point before jump next anchor
(setq out-bound t) ; for break out `while' loop
))
(setq out-bound t))) ; for break out `while' loop
;; Add the rest until end of the region to be copied.
(when (< (point) transform-end)
(setq return-content
@ -170,6 +171,6 @@ the structure of the Org file."
(add-hook 'eww-mode-hook #'org-eww-extend-eww-keymap)
(provide 'org-eww)
(provide 'ol-eww)
;;; org-eww.el ends here
;;; ol-eww.el ends here

40
lisp/org/org-gnus.el → lisp/org/ol-gnus.el
View file

@ -1,4 +1,4 @@
;;; org-gnus.el --- Support for Links to Gnus Groups and Messages -*- lexical-binding: t; -*-
;;; ol-gnus.el --- Links to Gnus Groups and Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2019 Free Software Foundation, Inc.
@ -35,7 +35,7 @@
(require 'gnus-util)
(require 'nnheader)
(require 'nnir)
(require 'org)
(require 'ol)
;;; Declare external functions and variables
@ -104,6 +104,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(defun org-gnus-article-link (group newsgroups message-id x-no-archive)
"Create a link to a Gnus article.
The article is specified by its MESSAGE-ID. Additional
parameters are the Gnus GROUP, the NEWSGROUPS the article was
posted to and the X-NO-ARCHIVE header value of that article.
@ -115,12 +116,12 @@ Otherwise create a link to the article inside Gnus.
If `org-store-link' was called with a prefix arg the meaning of
`org-gnus-prefer-web-links' is reversed."
(if (and (org-xor current-prefix-arg org-gnus-prefer-web-links)
newsgroups ;; Make web links only for nntp groups
(not x-no-archive)) ;; and if X-No-Archive isn't set.
(format (if (string-match "gmane\\." newsgroups)
newsgroups ;make web links only for nntp groups
(not x-no-archive)) ;and if X-No-Archive isn't set
(format (if (string-match-p "gmane\\." newsgroups)
"http://mid.gmane.org/%s"
"http://groups.google.com/groups/search?as_umsgid=%s")
(org-fixup-message-id-for-http message-id))
(url-encode-url message-id))
(concat "gnus:" group "#" message-id)))
(defun org-gnus-store-link ()
@ -129,9 +130,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(`gnus-group-mode
(let ((group (gnus-group-group-name)))
(when group
(org-store-link-props :type "gnus" :group group)
(org-link-store-props :type "gnus" :group group)
(let ((description (org-gnus-group-link group)))
(org-add-link-props :link description :description description)
(org-link-add-props :link description :description description)
description))))
((or `gnus-summary-mode `gnus-article-mode)
(let* ((group
@ -169,12 +170,12 @@ If `org-store-link' was called with a prefix arg the meaning of
(setq to (or to (gnus-fetch-original-field "To")))
(setq newsgroups (gnus-fetch-original-field "Newsgroups"))
(setq x-no-archive (gnus-fetch-original-field "x-no-archive")))
(org-store-link-props :type "gnus" :from from :date date :subject subject
(org-link-store-props :type "gnus" :from from :date date :subject subject
:message-id message-id :group group :to to)
(let ((link (org-gnus-article-link
group newsgroups message-id x-no-archive))
(description (org-email-link-description)))
(org-add-link-props :link link :description description)
(description (org-link-email-description)))
(org-link-add-props :link link :description description)
link)))
(`message-mode
(setq org-store-link-plist nil) ;reset
@ -197,11 +198,11 @@ If `org-store-link' was called with a prefix arg the meaning of
(subject (mail-fetch-field "Subject"))
newsgroup xarchive) ;those are always nil for gcc
(unless gcc (error "Can not create link: No Gcc header found"))
(org-store-link-props :type "gnus" :from from :subject subject
(org-link-store-props :type "gnus" :from from :subject subject
:message-id id :group gcc :to to)
(let ((link (org-gnus-article-link gcc newsgroup id xarchive))
(description (org-email-link-description)))
(org-add-link-props :link link :description description)
(description (org-link-email-description)))
(org-link-add-props :link link :description description)
link)))))))
(defun org-gnus-open-nntp (path)
@ -242,7 +243,11 @@ If `org-store-link' was called with a prefix arg the meaning of
(_
(let ((articles 1)
group-opened)
(while (not group-opened)
(while (and (not group-opened)
;; Stop on integer overflows. Note: We
;; can drop this once we require at least
;; Emacs 27, which supports bignums.
(> articles 0))
(setq group-opened (gnus-group-read-group articles t group))
(setq articles (if (< articles 16)
(1+ articles)
@ -260,7 +265,6 @@ If `org-store-link' was called with a prefix arg the meaning of
(org-gnus-no-server (gnus-no-server))
(t (gnus))))
(provide 'org-gnus)
(provide 'ol-gnus)
;;; org-gnus.el ends here
;;; ol-gnus.el ends here

14
lisp/org/org-info.el → lisp/org/ol-info.el
View file

@ -1,4 +1,4 @@
;;; org-info.el --- Support for Links to Info Nodes -*- lexical-binding: t; -*-
;;; ol-info.el --- Links to Info Nodes -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2019 Free Software Foundation, Inc.
@ -30,7 +30,7 @@
;;; Code:
(require 'org)
(require 'ol)
;; Declare external functions and variables
@ -54,7 +54,7 @@
"#" Info-current-node))
(desc (concat (file-name-nondirectory Info-current-file)
"#" Info-current-node)))
(org-store-link-props :type "info" :file Info-current-file
(org-link-store-props :type "info" :file Info-current-file
:node Info-current-node
:link link :desc desc)
link)))
@ -66,7 +66,7 @@
(defun org-info-follow-link (name)
"Follow an Info file and node link specified by NAME."
(if (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" name)
(if (or (string-match "\\(.*\\)\\(?:#\\|::\\)\\(.*\\)" name)
(string-match "\\(.*\\)" name))
(let ((filename (match-string 1 name))
(nodename-or-index (or (match-string 2 name) "Top")))
@ -129,7 +129,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 "[#:]:?"))
(let* ((parts (split-string path "#\\|::"))
(manual (car parts))
(node (or (nth 1 parts) "Top")))
(pcase format
@ -143,6 +143,6 @@ See `org-link-parameters' for details about PATH, DESC and FORMAT."
(format "@ref{%s,%s,,%s,}" node title manual)))
(_ nil))))
(provide 'org-info)
(provide 'ol-info)
;;; org-info.el ends here
;;; ol-info.el ends here

27
lisp/org/org-irc.el → lisp/org/ol-irc.el
View file

@ -1,4 +1,4 @@
;;; org-irc.el --- Store Links to IRC Sessions -*- lexical-binding: t; -*-
;;; ol-irc.el --- Links to IRC Sessions -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
;;
@ -48,7 +48,7 @@
;;; Code:
(require 'org)
(require 'ol)
(declare-function erc-buffer-filter "erc" (predicate &optional proc))
(declare-function erc-channel-p "erc" (channel))
@ -73,7 +73,10 @@
;; Generic functions/config (extend these for other clients)
(org-link-set-parameters "irc" :follow #'org-irc-visit :store #'org-irc-store-link)
(org-link-set-parameters "irc"
:follow #'org-irc-visit
:store #'org-irc-store-link
:export #'org-irc-export)
(defun org-irc-visit (link)
"Parse LINK and dispatch to the correct function based on the client found."
@ -152,7 +155,7 @@ the session itself."
(parsed-line (org-irc-erc-get-line-from-log erc-line)))
(if (erc-logging-enabled nil)
(progn
(org-store-link-props
(org-link-store-props
:type "file"
:description (concat "'" (org-irc-ellipsify-description
(cadr parsed-line) 20)
@ -165,7 +168,7 @@ the session itself."
(link (org-irc-parse-link link-text)))
(if link-text
(progn
(org-store-link-props
(org-link-store-props
:type "irc"
:link (concat "irc:/" link-text)
:description (concat "irc session `" link-text "'")
@ -247,10 +250,20 @@ default."
;; no server match, make new connection
(erc-select :server server :port port))))
(provide 'org-irc)
(defun org-irc-export (link description format)
"Export an IRC link.
See `org-link-parameters' for details about LINK, DESCRIPTION and
FORMAT."
(let ((desc (or description link)))
(pcase format
(`html (format "<a href=\"irc:%s\">%s</a>" link desc))
(`md (format "[%s](irc:%s)" desc link))
(_ nil))))
(provide 'ol-irc)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; org-irc.el ends here
;;; ol-irc.el ends here

16
lisp/org/org-mhe.el → lisp/org/ol-mhe.el
View file

@ -1,4 +1,4 @@
;;; org-mhe.el --- Support for Links to MH-E Messages -*- lexical-binding: t; -*-
;;; ol-mhe.el --- Links to MH-E Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2019 Free Software Foundation, Inc.
@ -31,7 +31,7 @@
;;; Code:
(require 'org-macs)
(require 'org)
(require 'ol)
;; Customization variables
@ -88,12 +88,12 @@ supported by MH-E."
(subject (org-mhe-get-header "Subject:"))
(date (org-mhe-get-header "Date:"))
link desc)
(org-store-link-props :type "mh" :from from :to to :date date
(org-link-store-props :type "mh" :from from :to to :date date
:subject subject :message-id message-id)
(setq desc (org-email-link-description))
(setq desc (org-link-email-description))
(setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#"
(org-unbracket-string "<" ">" message-id)))
(org-add-link-props :link link :description desc)
(org-link-add-props :link link :description desc)
link))))
(defun org-mhe-open (path)
@ -199,7 +199,7 @@ folders."
(mh-search-choose)
(if (eq mh-searcher 'pick)
(progn
(setq article (org-add-angle-brackets article))
(setq article (org-link-add-angle-brackets article))
(mh-search folder (list "--message-id" article))
(when (and org-mhe-search-all-folders
(not (org-mhe-get-message-real-folder)))
@ -214,6 +214,6 @@ folders."
(kill-buffer)
(error "Message not found"))))
(provide 'org-mhe)
(provide 'ol-mhe)
;;; org-mhe.el ends here
;;; ol-mhe.el ends here

16
lisp/org/org-rmail.el → lisp/org/ol-rmail.el
View file

@ -1,4 +1,4 @@
;;; org-rmail.el --- Support for Links to Rmail Messages -*- lexical-binding: t; -*-
;;; ol-rmail.el --- Links to Rmail Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2019 Free Software Foundation, Inc.
@ -30,7 +30,7 @@
;;; Code:
(require 'org)
(require 'ol)
;; Declare external functions and variables
(declare-function rmail-show-message "rmail" (&optional n no-summary))
@ -65,13 +65,13 @@
(subject (mail-fetch-field "subject"))
(date (mail-fetch-field "date"))
desc link)
(org-store-link-props
(org-link-store-props
:type "rmail" :from from :to to :date date
:subject subject :message-id message-id)
(setq message-id (org-unbracket-string "<" ">" message-id))
(setq desc (org-email-link-description))
(setq desc (org-link-email-description))
(setq link (concat "rmail:" folder "#" message-id))
(org-add-link-props :link link :description desc)
(org-link-add-props :link link :description desc)
(rmail-show-message rmail-current-message)
link)))))
@ -89,7 +89,7 @@
(require 'rmail)
(cond ((null article) (setq article ""))
((stringp article)
(setq article (org-add-angle-brackets article)))
(setq article (org-link-add-angle-brackets article)))
(t (user-error "Wrong RMAIL link format")))
(let (message-number)
(save-excursion
@ -110,6 +110,6 @@
message-number)
(error "Message not found"))))
(provide 'org-rmail)
(provide 'ol-rmail)
;;; org-rmail.el ends here
;;; ol-rmail.el ends here

47
lisp/org/org-w3m.el → lisp/org/ol-w3m.el
View file

@ -1,4 +1,4 @@
;;; org-w3m.el --- Support from Copy and Paste From w3m -*- lexical-binding: t; -*-
;;; ol-w3m.el --- Copy and Paste From W3M -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
@ -41,7 +41,7 @@
;;; Code:
(require 'org)
(require 'ol)
(defvar w3m-current-url)
(defvar w3m-current-title)
@ -50,7 +50,7 @@
(defun org-w3m-store-link ()
"Store a link to a w3m buffer."
(when (eq major-mode 'w3m-mode)
(org-store-link-props
(org-link-store-props
:type "w3m"
:link w3m-current-url
:url (url-view-url t)
@ -59,7 +59,7 @@
(defun org-w3m-copy-for-org-mode ()
"Copy current buffer content or active region with Org style links.
This will encode `link-title' and `link-location' with
`org-make-link-string', and insert the transformed test into the kill ring,
`org-link-make-string', and insert the transformed test into the kill ring,
so that it can be yanked into an Org buffer with links working correctly."
(interactive)
(let* ((regionp (org-region-active-p))
@ -72,40 +72,41 @@ so that it can be yanked into an Org buffer with links working correctly."
(setq transform-start (region-beginning))
(setq transform-end (region-end))
;; Deactivate mark if current mark is activate.
(if (fboundp 'deactivate-mark) (deactivate-mark)))
(when (fboundp 'deactivate-mark) (deactivate-mark)))
(message "Transforming links...")
(save-excursion
(goto-char transform-start)
(while (and (not out-bound) ; still inside region to copy
(while (and (not out-bound) ; still inside region to copy
(not (org-w3m-no-next-link-p))) ; no next link current buffer
;; store current point before jump next anchor
(setq temp-position (point))
;; move to next anchor when current point is not at anchor
(or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start))
(if (<= (point) transform-end) ; if point is inside transform bound
(if (<= (point) transform-end) ; if point is inside transform bound
(progn
;; get content between two links.
(if (> (point) temp-position)
(setq return-content (concat return-content
(buffer-substring
temp-position (point)))))
(when (> (point) temp-position)
(setq return-content (concat return-content
(buffer-substring
temp-position (point)))))
;; get link location at current point.
(setq link-location (get-text-property (point) 'w3m-href-anchor))
;; get link title at current point.
(setq link-title (buffer-substring (point)
(org-w3m-get-anchor-end)))
;; concat Org style url to `return-content'.
(setq return-content (concat return-content
(org-make-link-string
link-location link-title))))
(goto-char temp-position) ; reset point before jump next anchor
(setq out-bound t) ; for break out `while' loop
))
(setq return-content
(concat return-content
(if (org-string-nw-p link-location)
(org-link-make-string link-location link-title)
link-title))))
(goto-char temp-position) ; reset point before jump next anchor
(setq out-bound t))) ; for break out `while' loop
;; add the rest until end of the region to be copied
(if (< (point) transform-end)
(setq return-content
(concat return-content
(buffer-substring (point) transform-end))))
(when (< (point) transform-end)
(setq return-content
(concat return-content
(buffer-substring (point) transform-end))))
(org-kill-new return-content)
(message "Transforming links...done, use C-y to insert text into Org file")
(message "Copy with link transformation complete."))))
@ -178,6 +179,6 @@ Return t if there is no previous link; otherwise, return nil."
(define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
(define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
(provide 'org-w3m)
(provide 'ol-w3m)
;;; org-w3m.el ends here
;;; ol-w3m.el ends here

1907
lisp/org/ol.el Normal file
View file

File diff suppressed because it is too large Load diff

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

File diff suppressed because it is too large Load diff

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

@ -29,6 +29,7 @@
;;; Code:
(require 'org)
(require 'cl-lib)
(declare-function org-element-type "org-element" (element))
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
@ -126,22 +127,6 @@ Hook functions are called with point on the subtree in the
original file. At this stage, the subtree has been added to the
archive location, but not yet deleted from the original file.")
(defun org-get-local-archive-location ()
"Get the archive location applicable at point."
(let ((re "^[ \t]*#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
prop)
(save-excursion
(save-restriction
(widen)
(setq prop (org-entry-get nil "ARCHIVE" 'inherit))
(cond
((and prop (string-match "\\S-" prop))
prop)
((or (re-search-backward re nil t)
(re-search-forward re nil t))
(match-string 1))
(t org-archive-location))))))
;;;###autoload
(defun org-add-archive-files (files)
"Splice the archive files into the list of files.
@ -159,47 +144,36 @@ archive file is."
files))))
(defun org-all-archive-files ()
"Get a list of all archive files used in the current buffer."
(let ((case-fold-search t)
files)
(org-with-wide-buffer
(goto-char (point-min))
(while (re-search-forward
"^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)"
nil t)
(when (save-match-data
(if (eq (match-string 1) ":") (org-at-property-p)
(eq (org-element-type (org-element-at-point)) 'keyword)))
(let ((file (org-extract-archive-file
(match-string-no-properties 2))))
(when (and (org-string-nw-p file) (file-exists-p file))
(push file files))))))
(setq files (nreverse files))
(let ((file (org-extract-archive-file)))
(when (and (org-string-nw-p file) (file-exists-p file))
(push file files)))
files))
"List of all archive files used in the current buffer."
(let* ((case-fold-search t)
(files `(,(car (org-archive--compute-location org-archive-location)))))
(org-with-point-at 1
(while (re-search-forward "^[ \t]*:ARCHIVE:" nil t)
(when (org-at-property-p)
(pcase (org-archive--compute-location (match-string 3))
(`(,file . ,_)
(when (org-string-nw-p file)
(cl-pushnew file files :test #'file-equal-p))))))
(cl-remove-if-not #'file-exists-p (nreverse files)))))
(defun org-extract-archive-file (&optional location)
"Extract and expand the file name from archive LOCATION.
if LOCATION is not given, the value of `org-archive-location' is used."
(setq location (or location org-archive-location))
(if (string-match "\\(.*\\)::\\(.*\\)" location)
(if (= (match-beginning 1) (match-end 1))
(buffer-file-name (buffer-base-buffer))
(expand-file-name
(format (match-string 1 location)
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))))
(defun org-extract-archive-heading (&optional location)
"Extract the heading from archive LOCATION.
if LOCATION is not given, the value of `org-archive-location' is used."
(setq location (or location org-archive-location))
(if (string-match "\\(.*\\)::\\(.*\\)" location)
(format (match-string 2 location)
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))
(defun org-archive--compute-location (location)
"Extract and expand the location from archive LOCATION.
Return a pair (FILE . HEADING) where FILE is the file name and
HEADING the heading of the archive location, as strings. Raise
an error if LOCATION is not a valid archive location."
(unless (string-match "::" location)
(error "Invalid archive location: %S" location))
(let ((current-file (buffer-file-name (buffer-base-buffer)))
(file-fmt (substring location 0 (match-beginning 0)))
(heading-fmt (substring location (match-end 0))))
(cons
;; File part.
(if (org-string-nw-p file-fmt)
(expand-file-name
(format file-fmt (file-name-nondirectory current-file)))
current-file)
;; Heading part.
(format heading-fmt (file-name-nondirectory current-file)))))
;;;###autoload
(defun org-archive-subtree (&optional find-done)
@ -231,7 +205,7 @@ direct children of this heading."
((equal find-done '(4)) (org-archive-all-done))
((equal find-done '(16)) (org-archive-all-old))
(t
;; Save all relevant TODO keyword-relatex variables
;; Save all relevant TODO keyword-related variables.
(let* ((tr-org-todo-keywords-1 org-todo-keywords-1)
(tr-org-todo-kwd-alist org-todo-kwd-alist)
(tr-org-done-keywords org-done-keywords)
@ -244,10 +218,11 @@ direct children of this heading."
(file (abbreviate-file-name
(or (buffer-file-name (buffer-base-buffer))
(error "No file associated to buffer"))))
(location (org-get-local-archive-location))
(afile (or (org-extract-archive-file location)
(error "Invalid `org-archive-location'")))
(heading (org-extract-archive-heading location))
(location (org-archive--compute-location
(or (org-entry-get nil "ARCHIVE" 'inherit)
org-archive-location)))
(afile (car location))
(heading (cdr location))
(infile-p (equal file (abbreviate-file-name (or afile ""))))
(newfile-p (and (org-string-nw-p afile)
(not (file-exists-p afile))))
@ -271,9 +246,15 @@ direct children of this heading."
(org-back-to-heading t)
;; Get context information that will be lost by moving the
;; tree. See `org-archive-save-context-info'.
(let* ((all-tags (org-get-tags-at))
(local-tags (org-get-tags))
(inherited-tags (org-delete-all local-tags all-tags))
(let* ((all-tags (org-get-tags))
(local-tags
(cl-remove-if (lambda (tag)
(get-text-property 0 'inherited tag))
all-tags))
(inherited-tags
(cl-remove-if-not (lambda (tag)
(get-text-property 0 'inherited tag))
all-tags))
(context
`((category . ,(org-get-category nil 'force-refresh))
(file . ,file)
@ -315,12 +296,12 @@ direct children of this heading."
org-odd-levels-only
tr-org-odd-levels-only)))
(goto-char (point-min))
(outline-show-all)
(org-show-all '(headings blocks))
(if (and heading (not (and datetree-date (not datetree-subheading-p))))
(progn
(if (re-search-forward
(concat "^" (regexp-quote heading)
"[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")
"\\([ \t]+:\\(" org-tag-re ":\\)+\\)?[ \t]*$")
nil t)
(goto-char (match-end 0))
;; Heading not found, just insert it at the end
@ -345,8 +326,7 @@ direct children of this heading."
(if org-archive-reversed-order
(progn
(goto-char (point-min))
(unless (org-at-heading-p) (outline-next-heading))
(insert "\n") (backward-char 1))
(unless (org-at-heading-p) (outline-next-heading)))
(goto-char (point-max))
;; Subtree narrowing can let the buffer end on
;; a headline. `org-paste-subtree' then deletes it.
@ -361,7 +341,7 @@ direct children of this heading."
(or (and (eq org-archive-subtree-add-inherited-tags 'infile)
infile-p)
(eq org-archive-subtree-add-inherited-tags t))
(org-set-tags-to all-tags))
(org-set-tags all-tags))
;; Mark the entry as done
(when (and org-archive-mark-done
(let ((case-fold-search nil))
@ -390,6 +370,12 @@ direct children of this heading."
(when (featurep 'org-inlinetask)
(org-inlinetask-remove-END-maybe))
(setq org-markers-to-move nil)
(when org-provide-todo-statistics
(save-excursion
;; Go to parent, even if no children exist.
(org-up-heading-safe)
;; Update cookie of parent.
(org-update-statistics-cookies nil)))
(message "Subtree archived %s"
(if (eq this-buffer buffer)
(concat "under heading: " heading)
@ -416,7 +402,7 @@ Archiving time is retained in the ARCHIVE_TIME node property."
'(progn (setq org-map-continue-from
(progn (org-back-to-heading)
(if (looking-at (concat "^.*:" org-archive-tag ":.*$"))
(org-end-of-subtree t)
(org-end-of-subtree t)
(point))))
(when (org-at-heading-p)
(org-archive-to-archive-sibling)))
@ -464,8 +450,11 @@ Archiving time is retained in the ARCHIVE_TIME node property."
(format-time-string
(substring (cdr org-time-stamp-formats) 1 -1)))
(outline-up-heading 1 t)
(outline-hide-subtree)
(org-flag-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)
(if (looking-at "^[ \t]*$")

119
lisp/org/org-attach-git.el Normal file
View file

@ -0,0 +1,119 @@
;;; org-attach-git.el --- Automatic git commit extension to org-attach -*- lexical-binding: t; -*-
;; Copyright (C) 2019 Free Software Foundation, Inc.
;; Original Author: John Wiegley <johnw@newartisans.com>
;; Restructurer: Gustav Wikström <gustav@whil.se>
;; Keywords: org data git
;; 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:
;; An extension to org-attach. If `org-attach-id-dir' is initialized
;; as a Git repository, then org-attach-git will automatically commit
;; changes when it sees them. Requires git-annex.
;;; Code:
(require 'org-attach)
(require 'vc-git)
(defcustom org-attach-git-annex-cutoff (* 32 1024)
"If non-nil, files larger than this will be annexed instead of stored."
:group 'org-attach
:version "24.4"
:package-version '(Org . "8.0")
:type '(choice
(const :tag "None" nil)
(integer :tag "Bytes")))
(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."
:group 'org-attach
:package-version '(Org . "9.0")
:version "26.1"
:type '(choice
(const :tag "confirm with `y-or-n-p'" ask)
(const :tag "always get from annex if necessary" t)
(const :tag "never get from annex" nil)))
(defun org-attach-git-use-annex ()
"Return non-nil if git annex can be used."
(let ((git-dir (vc-git-root (expand-file-name org-attach-id-dir))))
(and org-attach-git-annex-cutoff
(or (file-exists-p (expand-file-name "annex" git-dir))
(file-exists-p (expand-file-name ".git/annex" git-dir))))))
(defun org-attach-git-annex-get-maybe (path)
"Call git annex get PATH (via shell) if using git annex.
Signals an error if the file content is not available and it was not retrieved."
(let* ((default-directory (expand-file-name org-attach-id-dir))
(path-relative (file-relative-name path)))
(when (and (org-attach-git-use-annex)
(not
(string-equal
"found"
(shell-command-to-string
(format "git annex find --format=found --in=here %s"
(shell-quote-argument path-relative))))))
(let ((should-get
(if (eq org-attach-git-annex-auto-get 'ask)
(y-or-n-p (format "Run git annex get %s? " path-relative))
org-attach-git-annex-auto-get)))
(unless should-get
(error "File %s stored in git annex but unavailable" path))
(message "Running git annex get \"%s\"." path-relative)
(call-process "git" nil nil nil "annex" "get" path-relative)))))
(defun org-attach-git-commit (&optional _)
"Commit changes to git if `org-attach-id-dir' is properly initialized.
This checks for the existence of a \".git\" directory in that directory.
Takes an unused optional argument for the sake of being compatible
with hook `org-attach-after-change-hook'."
(let* ((dir (expand-file-name org-attach-id-dir))
(git-dir (vc-git-root dir))
(use-annex (org-attach-git-use-annex))
(changes 0))
(when (and git-dir (executable-find "git"))
(with-temp-buffer
(cd dir)
(dolist (new-or-modified
(split-string
(shell-command-to-string
"git ls-files -zmo --exclude-standard") "\0" t))
(if (and use-annex
(>= (file-attribute-size (file-attributes new-or-modified))
org-attach-git-annex-cutoff))
(call-process "git" nil nil nil "annex" "add" new-or-modified)
(call-process "git" nil nil nil "add" new-or-modified))
(cl-incf changes))
(dolist (deleted
(split-string
(shell-command-to-string "git ls-files -z --deleted") "\0" t))
(call-process "git" nil nil nil "rm" deleted)
(cl-incf changes))
(when (> changes 0)
(shell-command "git commit -m 'Synchronized attachments'"))))))
(add-hook 'org-attach-after-change-hook 'org-attach-git-commit)
(add-hook 'org-attach-open-hook 'org-attach-git-annex-get-maybe)
(provide 'org-attach-git)
;;; org-attach-git.el ends here

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

@ -1,9 +1,9 @@
;;; org-attach.el --- Manage file attachments to Org tasks -*- lexical-binding: t; -*-
;;; org-attach.el --- Manage file attachments to Org outlines -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
;; Keywords: org data task
;; Keywords: org data attachment
;; This file is part of GNU Emacs.
;;
@ -24,54 +24,44 @@
;; See the Org manual for information on how to use it.
;;
;; Attachments are managed in a special directory called "data", which
;; lives in the same directory as the org file itself. If this data
;; directory is initialized as a Git repository, then org-attach will
;; automatically commit changes when it sees them.
;;
;; Attachment directories are identified using a UUID generated for the
;; task which has the attachments. These are added as property to the
;; task when necessary, and should not be deleted or changed by the
;; user, ever. UUIDs are generated by a mechanism defined in the variable
;; `org-id-method'.
;; Attachments are managed either by using a custom property DIR or by
;; using property ID from org-id. When DIR is defined, a location in
;; the filesystem is directly attached to the outline node. When
;; org-id is used, attachments are stored in a folder named after the
;; ID, in a location defined by `org-attach-id-dir'. DIR has
;; precedence over ID when both parameters are defined for the current
;; outline node (also when inherited parameters are taken into
;; account).
;;; Code:
(require 'cl-lib)
(require 'org)
(require 'ol)
(require 'org-id)
(require 'vc-git)
(declare-function dired-dwim-target-directory "dired-aux")
(defgroup org-attach nil
"Options concerning entry attachments in Org mode."
"Options concerning attachments in Org mode."
:tag "Org Attach"
:group 'org)
(defcustom org-attach-directory "data/"
(defcustom org-attach-id-dir "data/"
"The directory where attachments are stored.
If this is a relative path, it will be interpreted relative to the directory
where the Org file lives."
:group 'org-attach
:type 'directory)
:type 'directory
:safe #'stringp)
(defcustom org-attach-commit t
"If non-nil commit attachments with git.
This is only done if the Org file is in a git repository."
(defcustom org-attach-dir-relative nil
"Non-nil means directories in DIR property are added as relative links.
Defaults to absolute location."
:group 'org-attach
:type 'boolean
:version "26.1"
:package-version '(Org . "9.0"))
(defcustom org-attach-git-annex-cutoff (* 32 1024)
"If non-nil, files larger than this will be annexed instead of stored."
:group 'org-attach
:version "24.4"
:package-version '(Org . "8.0")
:type '(choice
(const :tag "None" nil)
(integer :tag "Bytes")))
:package-version '(Org . "9.3")
:safe #'booleanp)
(defcustom org-attach-auto-tag "ATTACH"
"Tag that will be triggered automatically when an entry has an attachment."
@ -80,15 +70,27 @@ This is only done if the Org file is in a git repository."
(const :tag "None" nil)
(string :tag "Tag")))
(defcustom org-attach-file-list-property "Attachments"
"The property used to keep a list of attachment belonging to this entry.
This is not really needed, so you may set this to nil if you don't want it.
Also, for entries where children inherit the directory, the list of
attachments is not kept in this property."
(defcustom org-attach-preferred-new-method 'id
"Preferred way to attach to nodes without existing ID and DIR property.
This choice is used when adding attachments to nodes without ID
and DIR properties.
Allowed values are:
id Create and use an ID parameter
dir Create and use a DIR parameter
ask Ask the user for input of which method to choose
nil Prefer to not create a new parameter
nil means that ID or DIR has to be created explicitly
before attaching files."
:group 'org-attach
:package-version '(org . "9.3")
:type '(choice
(const :tag "None" nil)
(string :tag "Tag")))
(const :tag "ID parameter" id)
(const :tag "DIR parameter" dir)
(const :tag "Ask user" ask)
(const :tag "Don't create" nil)))
(defcustom org-attach-method 'cp
"The preferred method to attach a file.
@ -112,13 +114,23 @@ lns create a symbol link. Note that this is not supported
:group 'org-attach
:type 'boolean)
(defcustom org-attach-allow-inheritance t
"Non-nil means allow attachment directories be inherited."
:group 'org-attach
:type 'boolean)
(defcustom org-attach-use-inheritance 'selective
"Attachment inheritance for the outline.
(defvar org-attach-inherited nil
"Indicates if the last access to the attachment directory was inherited.")
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
the first parent heading it finds with an attachment.
Selective means to respect the inheritance setting in
`org-use-property-inheritance'."
:group 'org-attach
:type '(choice
(const :tag "Don't use inheritance" nil)
(const :tag "Inherit parent node attachments" t)
(const :tag "Respect org-use-property-inheritance" selective))
:type 'boolean)
(defcustom org-attach-store-link-p nil
"Non-nil means store a link to a file when attaching it."
@ -140,28 +152,108 @@ When set to `query', ask the user instead."
(const :tag "Always delete attachments" t)
(const :tag "Query the user" query)))
(defcustom org-attach-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."
(defun org-attach-id-uuid-folder-format (id)
"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)))
(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)))
(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."
:group 'org-attach
:package-version '(Org . "9.0")
:version "26.1"
:type '(choice
(const :tag "confirm with `y-or-n-p'" ask)
(const :tag "always get from annex if necessary" t)
(const :tag "never get from annex" nil)))
:package-version '(Org . "9.3")
:type '(repeat (function :tag "Function with ID as input")))
(defvar org-attach-after-change-hook nil
"Hook to be called when files have been added or removed to the attachment folder.")
(defvar org-attach-open-hook nil
"Hook that is invoked by `org-attach-open'.
Created mostly to be compatible with org-attach-git after removing
git-funtionality from this file.")
(defcustom org-attach-commands
'(((?a ?\C-a) org-attach-attach
"Select a file and attach it to the task, using `org-attach-method'.")
((?c ?\C-c) org-attach-attach-cp
"Attach a file using copy method.")
((?m ?\C-m) org-attach-attach-mv
"Attach a file using move method.")
((?l ?\C-l) org-attach-attach-ln
"Attach a file using link method.")
((?y ?\C-y) org-attach-attach-lns
"Attach a file using symbolic-link method.")
((?u ?\C-u) org-attach-url
"Attach a file from URL (downloading it).")
((?b) org-attach-buffer
"Select a buffer and attach its contents to the task.")
((?n ?\C-n) org-attach-new
"Create a new attachment, as an Emacs buffer.")
((?z ?\C-z) org-attach-sync
"Synchronize the current node with its attachment\n directory, in case \
you added attachments yourself.\n")
((?o ?\C-o) org-attach-open
"Open current node's attachments.")
((?O) org-attach-open-in-emacs
"Like \"o\", but force opening in Emacs.")
((?f ?\C-f) org-attach-reveal
"Open current node's attachment directory. Create if missing.")
((?F) org-attach-reveal-in-emacs
"Like \"f\", but force using Dired in Emacs.\n")
((?d ?\C-d) org-attach-delete-one
"Delete one attachment, you will be prompted for a file name.")
((?D) org-attach-delete-all
"Delete all of a node's attachments. A safer way is\n to open the \
directory in dired and delete from there.\n")
((?s ?\C-s) org-attach-set-directory
"Set a specific attachment directory for this entry. Sets DIR property.")
((?S ?\C-S) org-attach-unset-directory
"Unset the attachment directory for this entry. Removes DIR property.")
((?q) (lambda () (interactive) (message "Abort")) "Abort."))
"The list of commands for the attachment dispatcher.
Each entry in this list is a list of three elements:
- A list of keys (characters) to select the command (the fist
character in the list is shown in the attachment dispatcher's
splash buffer and minubuffer prompt).
- A command that is called interactively when one of these keys
is pressed.
- A docstring for this command in the attachment dispatcher's
splash buffer."
:group 'org-attach
:package-version '(Org . "9.3")
:type '(repeat (list (repeat :tag "Keys" character)
(function :tag "Command")
(string :tag "Docstring"))))
;;;###autoload
(defun org-attach ()
"The dispatcher for attachment commands.
Shows a list of commands and prompts for another key to execute a command."
(interactive)
(let (c marker)
(let ((dir (org-attach-dir nil 'no-fs-check))
c marker)
(when (eq major-mode 'org-agenda-mode)
(setq marker (or (get-text-property (point) 'org-hd-marker)
(get-text-property (point) 'org-marker)))
(unless marker
(error "No task in current line")))
(error "No item in current line")))
(save-excursion
(when marker
(set-buffer (marker-buffer marker))
@ -171,200 +263,189 @@ Shows a list of commands and prompts for another key to execute a command."
(save-window-excursion
(unless org-attach-expert
(with-output-to-temp-buffer "*Org Attach*"
(princ "Select an Attachment Command:
a Select a file and attach it to the task, using `org-attach-method'.
c/m/l/y Attach a file using copy/move/link/symbolic-link method.
u Attach a file from URL (downloading it).
n Create a new attachment, as an Emacs buffer.
z Synchronize the current task with its attachment
directory, in case you added attachments yourself.
o Open current task's attachments.
O Like \"o\", but force opening in Emacs.
f Open current task's attachment directory.
F Like \"f\", but force using dired in Emacs.
d Delete one attachment, you will be prompted for a file name.
D Delete all of a task's attachments. A safer way is
to open the directory in dired and delete from there.
s Set a specific attachment directory for this entry or reset to default.
i Make children of the current entry inherit its attachment directory.")))
(princ
(concat "Attachment folder:\n"
(or dir
"Can't find an existing attachment-folder")
(unless (and dir (file-directory-p dir))
"\n(Not yet created)")
"\n\n"
(format "Select an Attachment Command:\n\n%s"
(mapconcat
(lambda (entry)
(pcase entry
(`((,key . ,_) ,_ ,docstring)
(format "%c %s"
key
(replace-regexp-in-string "\n\\([\t ]*\\)"
" "
docstring
nil nil 1)))
(_
(user-error
"Invalid `org-attach-commands' item: %S"
entry))))
org-attach-commands
"\n"))))))
(org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
(message "Select command: [acmlzoOfFdD]")
(message "Select command: [%s]"
(concat (mapcar #'caar org-attach-commands)))
(setq c (read-char-exclusive))
(and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))
(cond
((memq c '(?a ?\C-a)) (call-interactively 'org-attach-attach))
((memq c '(?c ?\C-c))
(let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach)))
((memq c '(?m ?\C-m))
(let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach)))
((memq c '(?l ?\C-l))
(let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
((memq c '(?y ?\C-y))
(let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
((memq c '(?u ?\C-u))
(let ((org-attach-method 'url)) (call-interactively 'org-attach-url)))
((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new))
((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
((eq c ?O) (call-interactively 'org-attach-open-in-emacs))
((memq c '(?f ?\C-f)) (call-interactively 'org-attach-reveal))
((memq c '(?F)) (call-interactively 'org-attach-reveal-in-emacs))
((memq c '(?d ?\C-d)) (call-interactively
'org-attach-delete-one))
((eq c ?D) (call-interactively 'org-attach-delete-all))
((eq c ?q) (message "Abort"))
((memq c '(?s ?\C-s)) (call-interactively
'org-attach-set-directory))
((memq c '(?i ?\C-i)) (call-interactively
'org-attach-set-inherit))
(t (error "No such attachment command %c" c))))))
(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)
(error "No such attachment command: %c" c))))))
(defun org-attach-dir (&optional create-if-not-exists-p)
"Return the directory associated with the current entry.
This first checks for a local property ATTACH_DIR, and then for an inherited
property ATTACH_DIR_INHERIT. If neither exists, the default mechanism
using the entry ID will be invoked to access the unique directory for the
current entry.
If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil,
the directory and (if necessary) the corresponding ID will be created."
(let (attach-dir uuid)
(setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT"))
(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.
`org-attach-use-inheritance' determines whether inherited
properties also will be considered.
If an ID property is found the default mechanism using that ID
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'
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.
If no attachment directory can be derived, return nil."
(let (attach-dir id)
(cond
((setq attach-dir (org-entry-get nil "ATTACH_DIR"))
(create-if-not-exists-p
(setq attach-dir (org-attach-dir-get-create)))
((setq attach-dir (org-entry-get nil "DIR" org-attach-use-inheritance))
(org-attach-check-absolute-path attach-dir))
((and org-attach-allow-inheritance
(org-entry-get nil "ATTACH_DIR_INHERIT" t))
(setq attach-dir
(org-with-wide-buffer
(if (marker-position org-entry-property-inherited-from)
(goto-char org-entry-property-inherited-from)
(org-back-to-heading t))
(let (org-attach-allow-inheritance)
(org-attach-dir create-if-not-exists-p))))
(org-attach-check-absolute-path attach-dir)
(setq org-attach-inherited t))
(t ; use the ID
;; Deprecated and removed from documentation, but still
;; works. FIXME: Remove after major nr change.
((setq attach-dir (org-entry-get nil "ATTACH_DIR" org-attach-use-inheritance))
(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 uuid (org-id-get (point) create-if-not-exists-p))
(when (or uuid create-if-not-exists-p)
(unless uuid (error "ID retrieval/creation failed"))
(setq attach-dir (expand-file-name
(format "%s/%s"
(substring uuid 0 2)
(substring uuid 2))
(expand-file-name org-attach-directory))))))
(when attach-dir
(if (and create-if-not-exists-p
(not (file-directory-p attach-dir)))
(make-directory attach-dir t))
(and (file-exists-p attach-dir)
attach-dir))))
(setq attach-dir (org-attach-dir-from-id id 'try-all))))
(if no-fs-check
attach-dir
(when (and attach-dir (file-directory-p attach-dir))
attach-dir))))
(defun org-attach-dir-get-create ()
"Return existing or new directory associated with the current outline node.
`org-attach-preferred-new-method' decides how to attach new
directory if neither ID nor DIR property exist.
If the attachment by some reason cannot be created an error will be raised."
(interactive)
(let ((attach-dir (org-attach-dir nil 'no-fs-check)))
(unless attach-dir
(let (answer)
(when (eq org-attach-preferred-new-method 'ask)
(message "Create new ID [1] property or DIR [2] property for attachments?")
(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))))
((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")))))
(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)
"Returns 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)))
(defun org-attach-check-absolute-path (dir)
"Check if we have enough information to root the attachment directory.
When DIR is given, check also if it is already absolute. Otherwise,
assume that it will be relative, and check if `org-attach-directory' is
assume that it will be relative, and check if `org-attach-id-dir' is
absolute, or if at least the current buffer has a file name.
Throw an error if we cannot root the directory."
(or (and dir (file-name-absolute-p dir))
(file-name-absolute-p org-attach-directory)
(file-name-absolute-p org-attach-id-dir)
(buffer-file-name (buffer-base-buffer))
(error "Need absolute `org-attach-directory' to attach in buffers without filename")))
(error "Need absolute `org-attach-id-dir' to attach in buffers without filename")))
(defun org-attach-set-directory (&optional arg)
"Set the ATTACH_DIR node property and ask to move files there.
(defun org-attach-set-directory ()
"Set the DIR node property and ask to move files there.
The property defines the directory that is used for attachments
of the entry. When called with `\\[universal-argument]', reset \
the directory to
the default ID based one."
(interactive "P")
of the entry. Creates relative links if `org-attach-dir-relative'
is non-nil.
Return the directory."
(interactive)
(let ((old (org-attach-dir))
(new
(progn
(if arg (org-entry-delete nil "ATTACH_DIR")
(let ((dir (read-directory-name
"Attachment directory: "
(org-entry-get nil
"ATTACH_DIR"
(and org-attach-allow-inheritance t)))))
(org-entry-put nil "ATTACH_DIR" dir)))
(org-attach-dir t))))
(new
(let* ((attach-dir (read-directory-name
"Attachment directory: "
(org-entry-get nil "DIR")))
(current-dir (file-name-directory (or default-directory
buffer-file-name)))
(attach-dir-relative (file-relative-name attach-dir current-dir)))
(org-entry-put nil "DIR" (if org-attach-dir-relative
attach-dir-relative
attach-dir))
attach-dir)))
(unless (or (string= old new)
(not old))
(when (yes-or-no-p "Copy over attachments from old directory? ")
(copy-directory old new t t t))
(when (yes-or-no-p (concat "Delete " old))
(delete-directory old t)))
new))
(defun org-attach-unset-directory ()
"Removes DIR node property.
If attachment folder is changed due to removal of DIR-property
ask to move attachments to new location and ask to delete old
attachment-folder.
Change of attachment-folder due to unset might be if an ID
property is set on the node, or if a separate inherited
DIR-property exists (that is different than the unset one)."
(interactive)
(let ((old (org-attach-dir))
(new
(progn
(org-entry-delete nil "DIR")
;; ATTACH-DIR is deprecated and removed from documentation,
;; but still works. Remove code for it after major nr change.
(org-entry-delete nil "ATTACH_DIR")
(org-attach-dir))))
(unless (or (string= old new)
(not old))
(when (and new (yes-or-no-p "Copy over attachments from old directory? "))
(copy-directory old new t nil t))
(when (yes-or-no-p (concat "Delete " old))
(delete-directory old t)))))
(defun org-attach-set-inherit ()
"Set the ATTACH_DIR_INHERIT property of the current entry.
The property defines the directory that is used for attachments
of the entry and any children that do not explicitly define (by setting
the ATTACH_DIR property) their own attachment directory."
(interactive)
(org-entry-put nil "ATTACH_DIR_INHERIT" "t")
(message "Children will inherit attachment directory"))
(defun org-attach-use-annex ()
"Return non-nil if git annex can be used."
(let ((git-dir (vc-git-root (expand-file-name org-attach-directory))))
(and org-attach-git-annex-cutoff
(or (file-exists-p (expand-file-name "annex" git-dir))
(file-exists-p (expand-file-name ".git/annex" git-dir))))))
(defun org-attach-annex-get-maybe (path)
"Call git annex get PATH (via shell) if using git annex.
Signals an error if the file content is not available and it was not retrieved."
(let ((path-relative (file-relative-name path)))
(when (and (org-attach-use-annex)
(not
(string-equal
"found"
(shell-command-to-string
(format "git annex find --format=found --in=here %s"
(shell-quote-argument path-relative))))))
(let ((should-get
(if (eq org-attach-annex-auto-get 'ask)
(y-or-n-p (format "Run git annex get %s? " path-relative))
org-attach-annex-auto-get)))
(if should-get
(progn (message "Running git annex get \"%s\"." path-relative)
(call-process "git" nil nil nil "annex" "get" path-relative))
(error "File %s stored in git annex but it is not available, and was not retrieved"
path))))))
(defun org-attach-commit ()
"Commit changes to git if `org-attach-directory' is properly initialized.
This checks for the existence of a \".git\" directory in that directory."
(let* ((dir (expand-file-name org-attach-directory))
(git-dir (vc-git-root dir))
(use-annex (org-attach-use-annex))
(changes 0))
(when (and git-dir (executable-find "git"))
(with-temp-buffer
(cd dir)
(dolist (new-or-modified
(split-string
(shell-command-to-string
"git ls-files -zmo --exclude-standard") "\0" t))
(if (and use-annex
(>= (file-attribute-size (file-attributes new-or-modified))
org-attach-git-annex-cutoff))
(call-process "git" nil nil nil "annex" "add" new-or-modified)
(call-process "git" nil nil nil "add" new-or-modified))
(cl-incf changes))
(dolist (deleted
(split-string
(shell-command-to-string "git ls-files -z --deleted") "\0" t))
(call-process "git" nil nil nil "rm" deleted)
(cl-incf changes))
(when (> changes 0)
(shell-command "git commit -m 'Synchronized attachments'"))))))
(defun org-attach-tag (&optional off)
"Turn the autotag on or (if OFF is set) off."
(when org-attach-auto-tag
@ -386,10 +467,25 @@ Only do this when `org-attach-store-link-p' is non-nil."
(defun org-attach-url (url)
(interactive "MURL of the file to attach: \n")
(org-attach-attach url))
(let ((org-attach-method 'url))
(org-attach-attach url)))
(defun org-attach-buffer (buffer-name)
"Attach BUFFER-NAME's contents to current outline node.
BUFFER-NAME is a string. Signals a `file-already-exists' error
if it would overwrite an existing filename."
(interactive "bBuffer whose contents should be attached: ")
(let* ((attach-dir (org-attach-dir 'get-create))
(output (expand-file-name buffer-name attach-dir)))
(when (file-exists-p output)
(signal 'file-already-exists (list "File exists" output)))
(run-hook-with-args 'org-attach-after-change-hook attach-dir)
(org-attach-tag)
(with-temp-file output
(insert-buffer-substring buffer-name))))
(defun org-attach-attach (file &optional visit-dir method)
"Move/copy/link FILE into the attachment directory of the current task.
"Move/copy/link FILE into the attachment directory of the current outline node.
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'."
@ -404,10 +500,7 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
nil))
(setq method (or method org-attach-method))
(let ((basename (file-name-nondirectory file)))
(when (and org-attach-file-list-property (not org-attach-inherited))
(org-entry-add-to-multivalued-property
(point) org-attach-file-list-property basename))
(let* ((attach-dir (org-attach-dir t))
(let* ((attach-dir (org-attach-dir 'get-create))
(fname (expand-file-name basename attach-dir)))
(cond
((eq method 'mv) (rename-file file fname))
@ -415,8 +508,7 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
((eq method 'ln) (add-name-to-file file fname))
((eq method 'lns) (make-symbolic-link file fname))
((eq method 'url) (url-copy-file file fname)))
(when org-attach-commit
(org-attach-commit))
(run-hook-with-args 'org-attach-after-change-hook attach-dir)
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
(org-attach-store-link fname))
@ -424,7 +516,7 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
(org-attach-store-link file)))
(if visit-dir
(dired attach-dir)
(message "File %S is now a task attachment." basename)))))
(message "File %S is now an attachment." basename)))))
(defun org-attach-attach-cp ()
"Attach a file by copying it."
@ -449,13 +541,10 @@ On some systems, this apparently does copy the file instead."
(let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
(defun org-attach-new (file)
"Create a new attachment FILE for the current task.
"Create a new attachment FILE for the current outline node.
The attachment is created as an Emacs buffer."
(interactive "sCreate attachment named: ")
(when (and org-attach-file-list-property (not org-attach-inherited))
(org-entry-add-to-multivalued-property
(point) org-attach-file-list-property file))
(let ((attach-dir (org-attach-dir t)))
(let ((attach-dir (org-attach-dir 'get-create)))
(org-attach-tag)
(find-file (expand-file-name file attach-dir))
(message "New attachment %s" file)))
@ -463,7 +552,7 @@ The attachment is created as an Emacs buffer."
(defun org-attach-delete-one (&optional file)
"Delete a single attachment."
(interactive)
(let* ((attach-dir (org-attach-dir t))
(let* ((attach-dir (org-attach-dir))
(files (org-attach-file-list attach-dir))
(file (or file
(completing-read
@ -475,44 +564,32 @@ The attachment is created as an Emacs buffer."
(unless (file-exists-p file)
(error "No such attachment: %s" file))
(delete-file file)
(when org-attach-commit
(org-attach-commit))))
(run-hook-with-args 'org-attach-after-change-hook attach-dir)))
(defun org-attach-delete-all (&optional force)
"Delete all attachments from the current task.
"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."
(interactive "P")
(when (and org-attach-file-list-property (not org-attach-inherited))
(org-entry-delete (point) org-attach-file-list-property))
(let ((attach-dir (org-attach-dir)))
(when
(and attach-dir
(or force
(y-or-n-p "Are you sure you want to remove all attachments of this entry? ")))
(shell-command (format "rm -fr %s" attach-dir))
(when (and attach-dir
(or force
(yes-or-no-p "Really remove all attachments of this entry? ")))
(delete-directory attach-dir (yes-or-no-p "Recursive?") t)
(message "Attachment directory removed")
(when org-attach-commit
(org-attach-commit))
(run-hook-with-args 'org-attach-after-change-hook attach-dir)
(org-attach-untag))))
(defun org-attach-sync ()
"Synchronize the current tasks with its attachments.
"Synchronize the current outline node with its attachments.
This can be used after files have been added externally."
(interactive)
(when org-attach-commit
(org-attach-commit))
(when (and org-attach-file-list-property (not org-attach-inherited))
(org-entry-delete (point) org-attach-file-list-property))
(let ((attach-dir (org-attach-dir)))
(when attach-dir
(run-hook-with-args 'org-attach-after-change-hook attach-dir)
(let ((files (org-attach-file-list attach-dir)))
(org-attach-tag (not files))
(when org-attach-file-list-property
(dolist (file files)
(unless (string-match "^\\.\\.?\\'" file)
(org-entry-add-to-multivalued-property
(point) org-attach-file-list-property file))))))))
(org-attach-tag (not files))))
(unless attach-dir (org-attach-tag t))))
(defun org-attach-file-list (dir)
"Return a list of files in the attachment directory.
@ -521,35 +598,38 @@ This ignores files ending in \"~\"."
(mapcar (lambda (x) (if (string-match "^\\.\\.?\\'" x) nil x))
(directory-files dir nil "[^~]\\'"))))
(defun org-attach-reveal (&optional if-exists)
"Show the attachment directory of the current task.
This will attempt to use an external program to show the directory."
(interactive "P")
(let ((attach-dir (org-attach-dir (not if-exists))))
(and attach-dir (org-open-file attach-dir))))
(defun org-attach-reveal ()
"Show the attachment directory of the current outline node.
This will attempt to use an external program to show the
directory. Will create an attachment and folder if it doesn't
exist yet. Respects `org-attach-preferred-new-method'."
(interactive)
(org-open-file (org-attach-dir-get-create)))
(defun org-attach-reveal-in-emacs ()
"Show the attachment directory of the current task 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)
(let ((attach-dir (org-attach-dir t)))
(dired attach-dir)))
(dired (org-attach-dir-get-create)))
(defun org-attach-open (&optional in-emacs)
"Open an attachment of the current task.
"Open an attachment of the current outline node.
If there are more than one attachment, you will be prompted for the file name.
This command will open the file using the settings in `org-file-apps'
and in the system-specific variants of this variable.
If IN-EMACS is non-nil, force opening in Emacs."
(interactive "P")
(let* ((attach-dir (org-attach-dir t))
(files (org-attach-file-list attach-dir))
(file (if (= (length files) 1)
(car files)
(completing-read "Open attachment: "
(mapcar #'list files) nil t)))
(path (expand-file-name file attach-dir)))
(org-attach-annex-get-maybe path)
(org-open-file path in-emacs)))
(let ((attach-dir (org-attach-dir)))
(if attach-dir
(let* ((file (pcase (org-attach-file-list attach-dir)
(`(,file) file)
(files (completing-read "Open attachment: "
(mapcar #'list files) nil t))))
(path (expand-file-name file attach-dir)))
(run-hook-with-args 'org-attach-open-hook path)
(org-open-file path in-emacs))
(error "No attachment directory exist"))))
(defun org-attach-open-in-emacs ()
"Open attachment, force opening in Emacs.
@ -568,14 +648,114 @@ Basically, this adds the path to the attachment directory, and a \"file:\"
prefix."
(concat "file:" (org-attach-expand file)))
(org-link-set-parameters "attachment"
:follow #'org-attach-open-link
:export #'org-attach-export-link
:complete #'org-attach-complete-link)
(defun org-attach-open-link (link &optional in-emacs)
"Attachment link type LINK is expanded with the attached directory and opened.
With optional prefix argument IN-EMACS, Emacs will visit the file.
With a double \\[universal-argument] \\[universal-argument] \
prefix arg, Org tries to avoid opening in Emacs
and to use an external application to visit the file."
(interactive "P")
(let (line search)
(cond
((string-match "::\\([0-9]+\\)\\'" link)
(setq line (string-to-number (match-string 1 link))
link (substring link 0 (match-beginning 0))))
((string-match "::\\(.+\\)\\'" link)
(setq search (match-string 1 link)
link (substring link 0 (match-beginning 0)))))
(if (string-match "[*?{]" (file-name-nondirectory link))
(dired (org-attach-expand link))
(org-open-file (org-attach-expand link) in-emacs line search))))
(defun org-attach-complete-link ()
"Advise the user with the available files in the attachment directory."
(let ((attach-dir (org-attach-dir)))
(if attach-dir
(let* ((attached-dir (expand-file-name attach-dir))
(file (read-file-name "File: " attached-dir))
(pwd (file-name-as-directory attached-dir))
(pwd-relative (file-name-as-directory
(abbreviate-file-name attached-dir))))
(cond
((string-match (concat "^" (regexp-quote pwd-relative) "\\(.+\\)") file)
(concat "attachment:" (match-string 1 file)))
((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
(expand-file-name file))
(concat "attachment:" (match-string 1 (expand-file-name file))))
(t (concat "attachment:" file))))
(error "No attachment directory exist"))))
(defun org-attach-export-link (link description format)
"Translate attachment LINK from Org mode format to exported FORMAT.
Also includes the DESCRIPTION of the link in the export."
(save-excursion
(let (path desc)
(cond
((string-match "::\\([0-9]+\\)\\'" link)
(setq link (substring link 0 (match-beginning 0))))
((string-match "::\\(.+\\)\\'" link)
(setq link (substring link 0 (match-beginning 0)))))
(setq path (file-relative-name (org-attach-expand link))
desc (or description link))
(pcase format
(`html (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
(`latex (format "\\href{%s}{%s}" path desc))
(`texinfo (format "@uref{%s,%s}" path desc))
(`ascii (format "%s (%s)" desc path))
(`md (format "[%s](%s)" desc path))
(_ path)))))
(defun org-attach-archive-delete-maybe ()
"Maybe delete subtree attachments when archiving.
This function is called by `org-archive-hook'. The option
`org-attach-archive-delete' controls its behavior."
(when (if (eq org-attach-archive-delete 'query)
(yes-or-no-p "Delete all attachments? ")
org-attach-archive-delete)
(org-attach-delete-all t)))
(when org-attach-archive-delete
(org-attach-delete-all (not (eq org-attach-archive-delete 'query)))))
;; Attach from dired.
;; Add the following lines to the config file to get a binding for
;; dired-mode.
;; (add-hook
;; 'dired-mode-hook
;; (lambda ()
;; (define-key dired-mode-map (kbd "C-c C-x a") #'org-attach-dired-to-subtree))))
;;;###autoload
(defun org-attach-dired-to-subtree (files)
"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.
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"))
(let ((start-win (selected-window))
(other-win
(get-window-with-predicate
(lambda (window)
(with-current-buffer (window-buffer window)
(eq major-mode 'org-mode))))))
(unless other-win
(user-error
"Can't attach to subtree. No window displaying an Org buffer"))
(select-window other-win)
(dolist (file files)
(org-attach-attach file))
(select-window start-win)
(when (eq 'mv org-attach-method)
(revert-buffer))))
(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe)

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

File diff suppressed because it is too large Load diff

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

File diff suppressed because it is too large Load diff

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

@ -41,6 +41,9 @@
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-restriction "org-element" (element))
(declare-function org-element-type "org-element" (element))
(declare-function org-dynamic-block-define "org" (type func))
(declare-function org-link-display-format "ol" (s))
(declare-function org-link-open-from-string "ol" (s &optional arg))
(defvar org-agenda-columns-add-appointments-to-effort-sum)
(defvar org-agenda-columns-compute-summary-properties)
@ -67,7 +70,8 @@ or nil if the normal value should be used."
(defcustom org-columns-summary-types nil
"Alist between operators and summarize functions.
Each association follows the pattern (LABEL . SUMMARIZE) where
Each association follows the pattern (LABEL . SUMMARIZE),
or (LABEL SUMMARIZE COLLECT) where
LABEL is a string used in #+COLUMNS definition describing the
summary type. It can contain any character but \"}\". It is
@ -78,6 +82,13 @@ Each association follows the pattern (LABEL . SUMMARIZE) where
The second one is a format string or nil. It has to return
a string summarizing the list of values.
COLLECT is a function called with one argument, a property
name. It is called in the context of a headline and must
return the collected property, or the empty string. You can
use this to only collect a property if a related conditional
properties is set, e.g., to return VACATION_DAYS only if
CONFIRMED is true.
Note that the return value can become one value for an higher
order summary, so the function is expected to handle its own
output.
@ -88,7 +99,11 @@ in `org-columns-summary-types-default', which see."
:version "26.1"
:package-version '(Org . "9.0")
:type '(alist :key-type (string :tag " Label")
:value-type (function :tag "Summarize")))
:value-type
(choice (function :tag "Summarize")
(list :tag "Collect and summarize"
(function :tag "Summarize")
(function :tag "Collect")))))
@ -221,21 +236,27 @@ See `org-columns-summary-types' for details.")
"--"
["Quit" org-columns-quit t]))
(defun org-columns--displayed-value (spec value)
(defun org-columns--displayed-value (spec value &optional no-star)
"Return displayed value for specification SPEC in current entry.
SPEC is a column format specification as stored in
`org-columns-current-fmt-compiled'. VALUE is the real value to
display, as a string."
display, as a string.
When NO-STAR is non-nil, do not add asterisks before displayed
value for ITEM property."
(or (and (functionp org-columns-modify-value-for-display-function)
(funcall org-columns-modify-value-for-display-function
(nth 1 spec) ;column name
value))
(pcase spec
(`("ITEM" . ,_)
(concat (make-string (1- (org-current-level))
(if org-hide-leading-stars ?\s ?*))
"* "
(org-columns-compact-links value)))
(let ((stars
(and (not no-star)
(concat (make-string (1- (org-current-level))
(if org-hide-leading-stars ?\s ?*))
"* "))))
(concat stars (org-link-display-format value))))
(`(,_ ,_ ,_ ,_ nil) value)
;; If PRINTF is set, assume we are displaying a number and
;; obey to the format string.
@ -268,7 +289,11 @@ possible to override it with optional argument COMPILED-FMT."
(get-text-property (point) 'duration))
'face 'org-warning))
"")))
(list spec v (org-columns--displayed-value spec v))))))
;; A non-nil COMPILED-FMT means we're calling from Org
;; Agenda mode, where we do not want leading stars for
;; ITEM. Hence the optional argument for
;; `org-columns--displayed-value'.
(list spec v (org-columns--displayed-value spec v compiled-fmt))))))
(or compiled-fmt org-columns-current-fmt-compiled))))
(defun org-columns--set-widths (cache)
@ -301,13 +326,29 @@ integers greater than 0."
(defun org-columns--summarize (operator)
"Return summary function associated to string OPERATOR."
(if (not operator) nil
(cdr (or (assoc operator org-columns-summary-types)
(assoc operator org-columns-summary-types-default)
(error "Unknown %S operator" operator)))))
(pcase (or (assoc operator org-columns-summary-types)
(assoc operator org-columns-summary-types-default))
(`nil (error "Unknown %S operator" operator))
(`(,_ . ,(and (pred functionp) summarize)) summarize)
(`(,_ ,summarize ,_) summarize)
(_ (error "Invalid definition for operator %S" operator))))
(defun org-columns--collect (operator)
"Return collect function associated to string OPERATOR.
Return nil if no collect function is associated to OPERATOR."
(pcase (or (assoc operator org-columns-summary-types)
(assoc operator org-columns-summary-types-default))
(`nil (error "Unknown %S operator" operator))
(`(,_ . ,(pred functionp)) nil) ;default value
(`(,_ ,_ ,collect) collect)
(_ (error "Invalid definition for operator %S" operator))))
(defun org-columns--overlay-text (value fmt width property original)
"Return text."
"Return decorated VALUE string for columns overlay display.
FMT is a format string. WIDTH is the width of the column, as an
integer. PROPERTY is the property being displayed, as a string.
ORIGINAL is the real string, i.e., before it is modified by
`org-columns--displayed-value'."
(format fmt
(let ((v (org-columns-add-ellipses value width)))
(pcase property
@ -387,14 +428,14 @@ DATELINE is non-nil when the face used should be
(line-beginning-position 2))))
(overlay-put ov 'keymap org-columns-map)
(push ov org-columns-overlays))
(org-with-silent-modifications
(let ((inhibit-read-only t))
(put-text-property
(line-end-position 0)
(line-beginning-position 2)
'read-only
(substitute-command-keys
"Type \\<org-columns-map>`\\[org-columns-edit-value]' \
(with-silent-modifications
(let ((inhibit-read-only t))
(put-text-property
(line-end-position 0)
(line-beginning-position 2)
'read-only
(substitute-command-keys
"Type \\<org-columns-map>`\\[org-columns-edit-value]' \
to edit property")))))))
(defun org-columns-add-ellipses (string width)
@ -424,6 +465,7 @@ for the duration of the command.")
"Overlay the newline before the current line with the table title."
(interactive)
(let ((title "")
(linum-offset (org-line-number-display-width 'columns))
(i 0))
(dolist (column org-columns-current-fmt-compiled)
(pcase column
@ -435,7 +477,7 @@ for the duration of the command.")
(setq-local org-previous-header-line-format header-line-format)
(setq org-columns-full-header-line-format
(concat
(org-add-props " " nil 'display '(space :align-to 0))
(org-add-props " " nil 'display `(space :align-to ,linum-offset))
(org-add-props (substring title 0 -1) nil 'face 'org-column-title)))
(setq org-columns-previous-hscroll -1)
(add-hook 'post-command-hook 'org-columns-hscroll-title nil 'local)))
@ -443,13 +485,15 @@ for the duration of the command.")
(defun org-columns-hscroll-title ()
"Set the `header-line-format' so that it scrolls along with the table."
(sit-for .0001) ; need to force a redisplay to update window-hscroll
(when (not (= (window-hscroll) org-columns-previous-hscroll))
(setq header-line-format
(concat (substring org-columns-full-header-line-format 0 1)
(substring org-columns-full-header-line-format
(1+ (window-hscroll))))
org-columns-previous-hscroll (window-hscroll))
(force-mode-line-update)))
(let ((hscroll (window-hscroll)))
(when (/= org-columns-previous-hscroll hscroll)
(setq header-line-format
(concat (substring org-columns-full-header-line-format 0 1)
(substring org-columns-full-header-line-format
(min (length org-columns-full-header-line-format)
(1+ hscroll))))
org-columns-previous-hscroll hscroll)
(force-mode-line-update))))
(defvar org-colview-initial-truncate-line-value nil
"Remember the value of `truncate-lines' across colview.")
@ -466,24 +510,16 @@ for the duration of the command.")
(set-marker org-columns-begin-marker nil)
(when (markerp org-columns-top-level-marker)
(set-marker org-columns-top-level-marker nil))
(org-with-silent-modifications
(mapc #'delete-overlay org-columns-overlays)
(setq org-columns-overlays nil)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
(with-silent-modifications
(mapc #'delete-overlay org-columns-overlays)
(setq org-columns-overlays nil)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
(when org-columns-flyspell-was-active
(flyspell-mode 1))
(when (local-variable-p 'org-colview-initial-truncate-line-value)
(setq truncate-lines org-colview-initial-truncate-line-value))))
(defun org-columns-compact-links (s)
"Replace [[link][desc]] with [desc] or [link]."
(while (string-match org-bracket-link-regexp s)
(setq s (replace-match
(concat "[" (match-string (if (match-end 3) 3 1) s) "]")
t t s)))
s)
(defun org-columns-show-value ()
"Show the full value of the property."
(interactive)
@ -495,10 +531,10 @@ for the duration of the command.")
(defun org-columns-quit ()
"Remove the column overlays and in this way exit column editing."
(interactive)
(org-with-silent-modifications
(org-columns-remove-overlays)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
(with-silent-modifications
(org-columns-remove-overlays)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
(if (not (eq major-mode 'org-agenda-mode))
(setq org-columns-current-fmt nil)
(setq org-agenda-columns-active nil)
@ -526,9 +562,17 @@ for the duration of the command.")
(org-columns-next-allowed-value)
(org-columns-edit-value "TAGS")))
(defvar org-agenda-overriding-columns-format nil
(defvar org-overriding-columns-format nil
"When set, overrides any other format definition for the agenda.
Don't set this, this is meant for dynamic scoping.")
Don't set this, this is meant for dynamic scoping. Set
`org-columns-default-format' and `org-columns-default-format-for-agenda'
instead. You should use this variable only in the local settings
section for a custom agenda view.")
(defvar-local org-local-columns-format nil
"When set, overrides any other format definition for the agenda.
This can be set as a buffer local value to avoid interfering with
dynamic scoping for `org-overriding-columns-format'.")
(defun org-columns-edit-value (&optional key)
"Edit the value of the property at point in column view.
@ -544,7 +588,7 @@ Where possible, use the standard interface for changing this line."
(action
(pcase key
("CLOCKSUM"
(error "This special column cannot be edited"))
(user-error "This special column cannot be edited"))
("ITEM"
(lambda () (org-with-point-at pom (org-edit-headline))))
("TODO"
@ -561,7 +605,7 @@ Where possible, use the standard interface for changing this line."
(if (eq org-fast-tag-selection-single-key 'expert)
t
org-fast-tag-selection-single-key)))
(call-interactively #'org-set-tags)))))
(call-interactively #'org-set-tags-command)))))
("DEADLINE"
(lambda ()
(org-with-point-at pom (call-interactively #'org-deadline))))
@ -589,7 +633,7 @@ Where possible, use the standard interface for changing this line."
(org-columns--call action)
;; The following let preserves the current format, and makes
;; sure that in only a single file things need to be updated.
(let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
(let* ((org-overriding-columns-format org-columns-current-fmt)
(buffer (marker-buffer pom))
(org-agenda-contributing-files
(list (with-current-buffer buffer
@ -597,8 +641,8 @@ Where possible, use the standard interface for changing this line."
(org-agenda-columns)))
(t
(let ((inhibit-read-only t))
(org-with-silent-modifications
(remove-text-properties (max (point-min) (1- bol)) eol '(read-only t)))
(with-silent-modifications
(remove-text-properties (max (point-min) (1- bol)) eol '(read-only t)))
(org-columns--call action))
;; Some properties can modify headline (e.g., "TODO"), and
;; possible shuffle overlays. Make sure they are still all at
@ -683,7 +727,7 @@ an integer, select that value."
(org-columns--call action)
;; The following let preserves the current format, and makes
;; sure that in only a single file things need to be updated.
(let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
(let* ((org-overriding-columns-format org-columns-current-fmt)
(buffer (marker-buffer pom))
(org-agenda-contributing-files
(list (with-current-buffer buffer
@ -719,13 +763,13 @@ 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 (encode-time x)))
(mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x)))
(list time-before time time-after)))))
(defun org-columns-open-link (&optional arg)
(interactive "P")
(let ((value (get-char-property (point) 'org-columns-value)))
(org-open-link-from-string value arg)))
(org-link-open-from-string value arg)))
;;;###autoload
(defun org-columns-get-format-and-top-level ()
@ -783,17 +827,17 @@ view for the whole buffer unconditionally.
When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(interactive "P")
(org-columns-remove-overlays)
(when global (goto-char (point-min)))
(if (markerp org-columns-begin-marker)
(move-marker org-columns-begin-marker (point))
(setq org-columns-begin-marker (point-marker)))
(org-columns-goto-top-level)
;; Initialize `org-columns-current-fmt' and
;; `org-columns-current-fmt-compiled'.
(let ((org-columns--time (float-time)))
(org-columns-get-format columns-fmt-string)
(unless org-columns-inhibit-recalculation (org-columns-compute-all))
(save-excursion
(save-excursion
(when global (goto-char (point-min)))
(if (markerp org-columns-begin-marker)
(move-marker org-columns-begin-marker (point))
(setq org-columns-begin-marker (point-marker)))
(org-columns-goto-top-level)
;; Initialize `org-columns-current-fmt' and
;; `org-columns-current-fmt-compiled'.
(let ((org-columns--time (float-time)))
(org-columns-get-format columns-fmt-string)
(unless org-columns-inhibit-recalculation (org-columns-compute-all))
(save-restriction
(when (and (not global) (org-at-heading-p))
(narrow-to-region (point) (org-end-of-subtree t t)))
@ -1011,8 +1055,8 @@ the current buffer."
(defun org-columns-uncompile-format (compiled)
"Turn the compiled columns format back into a string representation.
COMPILED is an alist, as returned by
`org-columns-compile-format', which see."
COMPILED is an alist, as returned by `org-columns-compile-format'."
(mapconcat
(lambda (spec)
(pcase spec
@ -1085,16 +1129,7 @@ as a canonical duration, i.e., using units defined in
"Apply FUN to time values TIMES.
Return the result as a duration."
(org-duration-from-minutes
(apply fun
(mapcar (lambda (time)
;; Unlike to `org-duration-to-minutes' standard
;; behavior, we want to consider plain numbers as
;; hours. As a consequence, we treat them
;; differently.
(if (string-match-p "\\`[0-9]+\\(?:\\.[0-9]*\\)?\\'" time)
(* 60 (string-to-number time))
(org-duration-to-minutes time)))
times))
(apply fun (mapcar #'org-duration-to-minutes times))
(org-duration-h:mm-only-p times)))
(defun org-columns--compute-spec (spec &optional update)
@ -1111,7 +1146,9 @@ properties drawers."
(last-level lmax)
(property (car spec))
(printf (nth 4 spec))
(summarize (org-columns--summarize (nth 3 spec))))
(operator (nth 3 spec))
(collect (and operator (org-columns--collect operator)))
(summarize (and operator (org-columns--summarize operator))))
(org-with-wide-buffer
;; Find the region to compute.
(goto-char org-columns-top-level-marker)
@ -1123,7 +1160,8 @@ properties drawers."
(setq last-level level))
(setq level (org-reduced-level (org-outline-level)))
(let* ((pos (match-beginning 0))
(value (org-entry-get nil property))
(value (if collect (funcall collect property)
(org-entry-get (point) property)))
(value-set (org-string-nw-p value)))
(cond
((< level last-level)
@ -1142,9 +1180,9 @@ properties drawers."
(old (assoc spec summaries-alist)))
(if old (setcdr old summary)
(push (cons spec summary) summaries-alist)
(org-with-silent-modifications
(add-text-properties
pos (1+ pos) (list 'org-summaries summaries-alist)))))
(with-silent-modifications
(add-text-properties
pos (1+ pos) (list 'org-summaries summaries-alist)))))
;; When PROPERTY exists in current node, even if empty,
;; but its value doesn't match the one computed, use
;; the latter instead.
@ -1180,9 +1218,9 @@ column specification."
(defun org-columns-compute-all ()
"Compute all columns that have operators defined."
(org-with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(let ((org-columns--time (float-time (current-time)))
(with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(let ((org-columns--time (float-time))
seen)
(dolist (spec org-columns-current-fmt-compiled)
(let ((property (car spec)))
@ -1212,7 +1250,7 @@ When PRINTF is non-nil, use it to format the result."
"Summarize CHECK-BOXES with a check-box cookie."
(format "[%d/%d]"
(cl-count-if (lambda (b) (or (equal b "[X]")
(string-match-p "\\[\\([1-9]\\)/\\1\\]" b)))
(string-match-p "\\[\\([1-9]\\)/\\1\\]" b)))
check-boxes)
(length check-boxes)))
@ -1261,17 +1299,17 @@ When PRINTF is non-nil, use it to format the result."
times))
(defun org-columns--summary-min-age (ages _)
"Compute the minimum time among AGES."
"Compute the minimum age among AGES."
(org-columns--format-age
(apply #'min (mapcar #'org-columns--age-to-minutes ages))))
(defun org-columns--summary-max-age (ages _)
"Compute the maximum time among AGES."
"Compute the maximum age among AGES."
(org-columns--format-age
(apply #'max (mapcar #'org-columns--age-to-minutes ages))))
(defun org-columns--summary-mean-age (ages _)
"Compute the minimum time among AGES."
"Compute the mean age among AGES."
(org-columns--format-age
(/ (apply #'+ (mapcar #'org-columns--age-to-minutes ages))
(float (length ages)))))
@ -1298,14 +1336,15 @@ and variances (respectively) of the individual estimates."
;;; Dynamic block for Column view
(defun org-columns--capture-view (maxlevel skip-empty format local)
(defun org-columns--capture-view (maxlevel match skip-empty exclude-tags format local)
"Get the column view of the current buffer.
MAXLEVEL sets the level limit. SKIP-EMPTY tells whether to skip
empty rows, an empty row being one where all the column view
specifiers but ITEM are empty. FORMAT is a format string for
columns, or nil. When LOCAL is non-nil, only capture headings in
current subtree.
specifiers but ITEM are empty. EXCLUDE-TAGS is a list of tags
that will be excluded from the resulting view. FORMAT is a
format string for columns, or nil. When LOCAL is non-nil, only
capture headings in current subtree.
This function returns a list containing the title row and all
other rows. Each row is a list of fields, as strings, or
@ -1328,12 +1367,17 @@ other rows. Each row is a list of fields, as strings, or
'org-columns-value
'org-columns-value-modified)))
row)))
(unless (and skip-empty
(let ((r (delete-dups (remove "" row))))
(or (null r) (and has-item (= (length r) 1)))))
(unless (or
(and skip-empty
(let ((r (delete-dups (remove "" row))))
(or (null r) (and has-item (= (length r) 1)))))
(and exclude-tags
(cl-some (lambda (tag) (member tag exclude-tags))
(org-get-tags))))
(push (cons (org-reduced-level (org-current-level)) (nreverse row))
table)))))
(and maxlevel (format "LEVEL<=%d" maxlevel))
(or (and maxlevel (format "LEVEL<=%d" maxlevel))
(and match match))
(and local 'tree)
'archive 'comment)
(org-columns-quit)
@ -1357,24 +1401,54 @@ an inline src-block."
;;;###autoload
(defun org-dblock-write:columnview (params)
"Write the column view table.
PARAMS is a property list of parameters:
:id the :ID: property of the entry where the columns view
should be built. When the symbol `local', call locally.
When `global' call column view with the cursor at the beginning
of the buffer (usually this means that the whole buffer switches
to column view). When \"file:path/to/file.org\", invoke column
view at the start of that file. Otherwise, the ID is located
using `org-id-find'.
:hlines When t, insert a hline before each item. When a number, insert
a hline before each level <= that number.
:indent When non-nil, indent each ITEM field according to its level.
:vlines When t, make each column a colgroup to enforce vertical lines.
:maxlevel When set to a number, don't capture headlines below this level.
:skip-empty-rows
When t, skip rows where all specifiers other than ITEM are empty.
:width apply widths specified in columns format using <N> specifiers.
:format When non-nil, specify the column view format to use."
`:id' (mandatory)
The ID property of the entry where the columns view should be
built. When the symbol `local', call locally. When `global'
call column view with the cursor at the beginning of the
buffer (usually this means that the whole buffer switches to
column view). When \"file:path/to/file.org\", invoke column
view at the start of that file. Otherwise, the ID is located
using `org-id-find'.
`:exclude-tags'
List of tags to exclude from column view table.
`:format'
When non-nil, specify the column view format to use.
`:hlines'
When non-nil, insert a hline before each item. When
a number, insert a hline before each level inferior or equal
to that number.
`:indent'
When non-nil, indent each ITEM field according to its level.
`:match'
When set to a string, use this as a tags/property match filter.
`:maxlevel'
When set to a number, don't capture headlines below this level.
`:skip-empty-rows'
When non-nil, skip rows where all specifiers other than ITEM
are empty.
`:vlines'
When non-nil, make each column a column group to enforce
vertical lines."
(let ((table
(let ((id (plist-get params :id))
view-file view-pos)
@ -1397,7 +1471,9 @@ PARAMS is a property list of parameters:
(org-with-wide-buffer
(when view-pos (goto-char view-pos))
(org-columns--capture-view (plist-get params :maxlevel)
(plist-get params :match)
(plist-get params :skip-empty-rows)
(plist-get params :exclude-tags)
(plist-get params :format)
view-pos))))))
(when table
@ -1429,14 +1505,6 @@ PARAMS is a property list of parameters:
(concat "\\_" (make-string (* 2 (1- level)) ?\s) item)
item))))
(push (cdr row) new-table))))
(when (plist-get params :width)
(setq table
(append table
(list
(mapcar (lambda (spec)
(let ((w (nth 2 spec)))
(if w (format "<%d>" (max 3 w)) "")))
org-columns-current-fmt-compiled)))))
(when (plist-get params :vlines)
(setq table
(let ((size (length org-columns-current-fmt-compiled)))
@ -1482,6 +1550,7 @@ PARAMS is a property list of parameters:
(id)))))
(org-update-dblock))
(org-dynamic-block-define "columnview" #'org-columns-insert-dblock)
;;; Column view in the agenda
@ -1497,7 +1566,9 @@ PARAMS is a property list of parameters:
(let* ((org-columns--time (float-time))
(fmt
(cond
((bound-and-true-p org-agenda-overriding-columns-format))
((bound-and-true-p org-overriding-columns-format))
((bound-and-true-p org-local-columns-format))
((bound-and-true-p org-columns-default-format-for-agenda))
((let ((m (org-get-at-bol 'org-hd-marker)))
(and m
(or (org-entry-get m "COLUMNS" t)
@ -1616,8 +1687,8 @@ This will add overlays to the date lines, to show the summary for each day."
(let ((b (find-buffer-visiting file)))
(with-current-buffer (or (buffer-base-buffer b) b)
(org-with-wide-buffer
(org-with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(goto-char (point-min))
(org-columns-get-format-and-top-level)
(dolist (spec fmt)

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

@ -25,34 +25,114 @@
;;; Commentary:
;; This file contains code needed for compatibility with older
;; versions of GNU Emacs.
;; versions of GNU Emacs and integration with other packages.
;;; Code:
(require 'cl-lib)
(require 'org-macs)
(declare-function org-agenda-diary-entry "org-agenda")
(declare-function org-agenda-maybe-redo "org-agenda" ())
(declare-function org-agenda-remove-restriction-lock "org-agenda" (&optional noupdate))
(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" ())
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-element-type "org-element" (element))
(declare-function org-element-property "org-element" (property element))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-link-set-parameters "org" (type &rest rest))
(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-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-reduced-level "org" (l))
(declare-function org-show-context "org" (&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))
(defvar calendar-mode-map)
(defvar org-complex-heading-regexp)
(defvar org-agenda-diary-file)
(defvar org-agenda-overriding-restriction)
(defvar org-agenda-restriction-lock-overlay)
(defvar org-table-any-border-regexp)
(defvar org-table-dataline-regexp)
(defvar org-table-tab-recognizes-table.el)
(defvar org-table1-hline-regexp)
;;; Emacs < 27.1 compatibility
(unless (fboundp 'proper-list-p)
;; `proper-list-p' was added in Emacs 27.1. The function below is
;; taken from Emacs subr.el 200195e824b^.
(defun proper-list-p (object)
"Return OBJECT's length if it is a proper list, nil otherwise.
A proper list is neither circular nor dotted (i.e., its last cdr
is nil)."
(and (listp object) (ignore-errors (length object)))))
(if (fboundp 'xor)
;; `xor' was added in Emacs 27.1.
(defalias 'org-xor #'xor)
(defsubst org-xor (a b)
"Exclusive `or'."
(if a (not b) b)))
(unless (fboundp 'pcomplete-uniquify-list)
;; The misspelled variant was made obsolete in Emacs 27.1
(defalias 'pcomplete-uniquify-list 'pcomplete-uniqify-list))
(if (fboundp 'time-convert)
(progn
(defsubst org-time-convert-to-integer (time)
(time-convert time 'integer))
(defsubst org-time-convert-to-list (time)
(time-convert time 'list)))
(defun org-time-convert-to-integer (time)
(floor (float-time time)))
(defun org-time-convert-to-list (time)
(seconds-to-time (float-time time))))
;;; Emacs < 26.1 compatibility
(if (fboundp 'line-number-display-width)
(defalias 'org-line-number-display-width 'line-number-display-width)
(defun org-line-number-display-width (&rest _) 0))
(if (fboundp 'buffer-hash)
(defalias 'org-buffer-hash 'buffer-hash)
(defun org-buffer-hash () (md5 (current-buffer))))
(unless (fboundp 'file-attribute-modification-time)
(defsubst file-attribute-modification-time (attributes)
"The modification time in ATTRIBUTES returned by `file-attributes'.
This is the time of the last change to the file's contents, and
is a list of integers (HIGH LOW USEC PSEC) in the same style
as (current-time)."
(nth 5 attributes)))
(unless (fboundp 'file-attribute-size)
(defsubst file-attribute-size (attributes)
"The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
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-all 'show-all)
(defalias 'outline-show-branches 'show-branches)
(defalias 'outline-show-children 'show-children)
(defalias 'outline-show-entry 'show-entry)
@ -72,11 +152,49 @@
(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 &rest _)
"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).
;;;; XEmacs compatibility, now removed.
(define-obsolete-function-alias 'org-activate-mark 'activate-mark)
(define-obsolete-function-alias 'org-activate-mark 'activate-mark "Org 9.0")
(define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0")
(define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0")
(define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0")
@ -91,6 +209,7 @@
(define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "Org 9.0")
(define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0")
(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0")
(define-obsolete-function-alias 'org-file-remote-p 'file-remote-p "Org 9.2")
(defmacro org-re (s)
"Replace posix classes in regular expression S."
@ -177,6 +296,24 @@ Counting starts at 1."
'org-activate-links "Org 9.0")
(define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0")
(define-obsolete-function-alias 'org-activate-angle-links 'ignore "Org 9.0")
(define-obsolete-function-alias 'org-remove-double-quotes 'org-strip-quotes "Org 9.0")
(define-obsolete-function-alias 'org-get-indentation
'current-indentation "Org 9.2")
(define-obsolete-function-alias 'org-capture-member 'org-capture-get "Org 9.2")
(define-obsolete-function-alias 'org-remove-from-invisibility-spec
'remove-from-invisibility-spec "Org 9.2")
(define-obsolete-variable-alias 'org-effort-durations 'org-duration-units
"Org 9.2")
(define-obsolete-function-alias 'org-toggle-latex-fragment 'org-latex-preview
"Org 9.3")
(define-obsolete-function-alias 'org-remove-latex-fragment-image-overlays
'org-clear-latex-preview "Org 9.3")
(define-obsolete-variable-alias 'org-attach-directory
'org-attach-id-dir "Org 9.3")
(defun org-in-fixed-width-region-p ()
"Non-nil if point in a fixed-width region."
@ -228,9 +365,10 @@ See `org-link-parameters' for documentation on the other parameters."
(make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "Org 9.0")
;;;; Functions unused in Org core.
(defun org-table-recognize-table.el ()
"If there is a table.el table nearby, recognize it and move into it."
(when (and org-table-tab-recognizes-table.el (org-at-table.el-p))
(when (org-at-table.el-p)
(beginning-of-line)
(unless (or (looking-at org-table-dataline-regexp)
(not (looking-at org-table1-hline-regexp)))
@ -246,19 +384,33 @@ See `org-link-parameters' for documentation on the other parameters."
(message "recognizing table.el table...done")))
(error "This should not happen"))))
;; Not used by Org core since commit 6d1e3082, Feb 2010.
;; Not used since commit 6d1e3082, Feb 2010.
(make-obsolete 'org-table-recognize-table.el
"please notify the org mailing list if you use this function."
"please notify Org mailing list if you use this function."
"Org 9.0")
(defmacro org-preserve-lc (&rest body)
(declare (debug (body))
(obsolete "please notify Org mailing list if you use this function."
"Org 9.2"))
(org-with-gensyms (line col)
`(let ((,line (org-current-line))
(,col (current-column)))
(unwind-protect
(progn ,@body)
(org-goto-line ,line)
(org-move-to-column ,col)))))
(defun org-version-check (version &rest _)
"Non-nil if VERSION is lower (older) than `emacs-version'."
(declare (obsolete "use `version<' or `fboundp' instead."
"Org 9.2"))
(version< version emacs-version))
(defun org-remove-angle-brackets (s)
(org-unbracket-string "<" ">" s))
(make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "Org 9.0")
(defun org-remove-double-quotes (s)
(org-unbracket-string "\"" "\"" s))
(make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0")
(defcustom org-publish-sitemap-file-entry-format "%t"
"Format string for site-map file entry.
You could use brackets to delimit on what part the link will be.
@ -344,16 +496,137 @@ use of this function is for the stuck project list."
(define-obsolete-variable-alias 'org-texinfo-def-table-markup
'org-texinfo-table-default-markup "Org 9.1")
;;; The function was made obsolete by commit 65399674d5 of 2013-02-22.
;;; This make-obsolete call was added 2016-09-01.
(define-obsolete-variable-alias 'org-agenda-overriding-columns-format
'org-overriding-columns-format "Org 9.2.2")
(define-obsolete-variable-alias 'org-doi-server-url
'org-link-doi-server-url "Org 9.3")
(define-obsolete-variable-alias 'org-email-link-description-format
'org-link-email-description-format "Org 9.3")
(define-obsolete-variable-alias 'org-make-link-description-function
'org-link-make-description-function "Org 9.3")
(define-obsolete-variable-alias 'org-from-is-user-regexp
'org-link-from-user-regexp "Org 9.3")
(define-obsolete-variable-alias 'org-descriptive-links
'org-link-descriptive "Org 9.3")
(define-obsolete-variable-alias 'org-context-in-file-links
'org-link-context-for-files "Org 9.3")
(define-obsolete-variable-alias 'org-keep-stored-link-after-insertion
'org-link-keep-stored-after-insertion "Org 9.3")
(define-obsolete-variable-alias 'org-display-internal-link-with-indirect-buffer
'org-link-use-indirect-buffer-for-internals "Org 9.3")
(define-obsolete-variable-alias 'org-confirm-shell-link-function
'org-link-shell-confirm-function "Org 9.3")
(define-obsolete-variable-alias 'org-confirm-shell-link-not-regexp
'org-link-shell-skip-confirm-regexp "Org 9.3")
(define-obsolete-variable-alias 'org-confirm-elisp-link-function
'org-link-elisp-confirm-function "Org 9.3")
(define-obsolete-variable-alias 'org-confirm-elisp-link-not-regexp
'org-link-elisp-skip-confirm-regexp "Org 9.3")
(define-obsolete-function-alias 'org-file-complete-link
'org-link-complete-file "Org 9.3")
(define-obsolete-function-alias 'org-email-link-description
'org-link-email-description "Org 9.3")
(define-obsolete-function-alias 'org-make-link-string
'org-link-make-string "Org 9.3")
(define-obsolete-function-alias 'org-store-link-props
'org-link-store-props "Org 9.3")
(define-obsolete-function-alias 'org-add-link-props
'org-link-add-props "Org 9.3")
(define-obsolete-function-alias 'org-make-org-heading-search-string
'org-link-heading-search-string "Org 9.3")
(define-obsolete-function-alias 'org-make-link-regexps
'org-link-make-regexps "Org 9.3")
(define-obsolete-variable-alias 'org-angle-link-re
'org-link-angle-re "Org 9.3")
(define-obsolete-variable-alias 'org-plain-link-re
'org-link-plain-re "Org 9.3")
(define-obsolete-variable-alias 'org-bracket-link-regexp
'org-link-bracket-re "Org 9.3")
(define-obsolete-variable-alias 'org-bracket-link-analytic-regexp
'org-link-bracket-re "Org 9.3")
(define-obsolete-variable-alias 'org-any-link-re
'org-link-any-re "Org 9.3")
(define-obsolete-function-alias 'org-open-link-from-string
'org-link-open-from-string "Org 9.3")
(define-obsolete-function-alias 'org-add-angle-brackets
'org-link-add-angle-brackets "Org 9.3")
;; The function was made obsolete by commit 65399674d5 of 2013-02-22.
;; This make-obsolete call was added 2016-09-01.
(make-obsolete 'org-capture-import-remember-templates
"use the `org-capture-templates' variable instead."
"Org 9.0")
(defun org-show-block-all ()
"Unfold all blocks in the current buffer."
(interactive)
(remove-overlays nil nil 'invisible 'org-hide-block))
(make-obsolete 'org-show-block-all
"use `org-show-all' instead."
"Org 9.2")
(define-obsolete-function-alias 'org-get-tags-at 'org-get-tags "Org 9.2")
(defun org-get-local-tags ()
"Get a list of tags defined in the current headline."
(declare (obsolete "use `org-get-tags' instead." "Org 9.2"))
(org-get-tags nil 'local))
(defun org-get-local-tags-at (&optional pos)
"Get a list of tags defined in the current headline."
(declare (obsolete "use `org-get-tags' instead." "Org 9.2"))
(org-get-tags pos 'local))
(defun org-get-tags-string ()
"Get the TAGS string in the current headline."
(declare (obsolete "use `org-make-tag-string' instead." "Org 9.2"))
(org-make-tag-string (org-get-tags nil t)))
(define-obsolete-function-alias 'org-set-tags-to 'org-set-tags "Org 9.2")
(defun org-align-all-tags ()
"Align the tags in all headings."
(declare (obsolete "use `org-align-tags' instead." "Org 9.2"))
(org-align-tags t))
(defmacro org-with-silent-modifications (&rest body)
(declare (obsolete "use `with-silent-modifications' instead." "Org 9.2")
(debug (body)))
`(with-silent-modifications ,@body))
(define-obsolete-function-alias 'org-babel-strip-quotes
'org-strip-quotes "Org 9.2")
;;;; Obsolete link types
(eval-after-load 'org
(eval-after-load 'ol
'(progn
(org-link-set-parameters "file+emacs") ;since Org 9.0
(org-link-set-parameters "file+sys"))) ;since Org 9.0
@ -362,38 +635,6 @@ use of this function is for the stuck project list."
;;; Miscellaneous functions
;; `xor' was added in Emacs 27.1.
(defalias 'org-xor
(if (fboundp 'xor)
#'xor
(lambda (a b)
"Exclusive or."
(if a (not b) b))))
(defun org-version-check (version feature level)
(let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
(v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
(rmaj (or (nth 0 v1) 99))
(rmin (or (nth 1 v1) 99))
(rbld (or (nth 2 v1) 99))
(maj (or (nth 0 v2) 0))
(min (or (nth 1 v2) 0))
(bld (or (nth 2 v2) 0)))
(if (or (< maj rmaj)
(and (= maj rmaj)
(< min rmin))
(and (= maj rmaj)
(= min rmin)
(< bld rbld)))
(if (eq level :predicate)
;; just return if we have the version
nil
(let ((msg (format "Emacs %s or greater is recommended for %s"
version feature)))
(display-warning 'org msg level)
t))
t)))
(defun org-get-x-clipboard (value)
"Get the value of the X or Windows clipboard."
(cond ((and (eq window-system 'x)
@ -407,38 +648,13 @@ use of this function is for the stuck project list."
((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
(w32-get-clipboard-data))))
(defun org-add-props (string plist &rest props)
"Add text properties to entire string, from beginning to end.
PLIST may be a list of properties, PROPS are individual properties and values
that will be added to PLIST. Returns the string that was modified."
(add-text-properties
0 (length string) (if props (append plist props) plist) string)
string)
(put 'org-add-props 'lisp-indent-function 2)
(defun org-fit-window-to-buffer (&optional window max-height min-height
shrink-only)
"Fit WINDOW to the buffer, but only if it is not a side-by-side window.
WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are
passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call
`shrink-window-if-larger-than-buffer' instead, the height limit is
ignored in this case."
(cond ((if (fboundp 'window-full-width-p)
(not (window-full-width-p window))
;; do nothing if another window would suffer
(> (frame-width) (window-width window))))
((and (fboundp 'fit-window-to-buffer) (not shrink-only))
(fit-window-to-buffer window max-height min-height))
((fboundp 'shrink-window-if-larger-than-buffer)
(shrink-window-if-larger-than-buffer window)))
(or window (selected-window)))
;; `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
(defvar org-ignore-region nil
@ -455,20 +671,13 @@ Unlike to `use-region-p', this function also checks
(> (point) (region-beginning)))
(exchange-point-and-mark)))
;;; Invisibility compatibility
(defun org-remove-from-invisibility-spec (arg)
"Remove elements from `buffer-invisibility-spec'."
(if (fboundp 'remove-from-invisibility-spec)
(remove-from-invisibility-spec arg)
(if (consp buffer-invisibility-spec)
(setq buffer-invisibility-spec
(delete arg buffer-invisibility-spec)))))
(defun org-in-invisibility-spec-p (arg)
"Is ARG a member of `buffer-invisibility-spec'?"
(if (consp buffer-invisibility-spec)
(member arg buffer-invisibility-spec)))
(when (consp buffer-invisibility-spec)
(member arg buffer-invisibility-spec)))
(defun org-move-to-column (column &optional force _buffer)
"Move to column COLUMN.
@ -487,8 +696,8 @@ Pass COLUMN and FORCE to `move-to-column'."
(let ((start 0) (n 1))
(while (string-match "\n" s start)
(setq start (match-end 0) n (1+ n)))
(if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
(setq n (1- n)))
(when (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
(setq n (1- n)))
n))
(defun org-kill-new (string &rest args)
@ -511,16 +720,6 @@ Pass COLUMN and FORCE to `move-to-column'."
"Return the local name component of FILE."
(or (file-remote-p file 'localname) file))))
(defmacro org-no-popups (&rest body)
"Suppress popup windows.
Let-bind some variables to nil around BODY to achieve the desired
effect, which variables to use depends on the Emacs version."
(if (org-version-check "24.2.50" "" :predicate)
`(let (pop-up-frames display-buffer-alist)
,@body)
`(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
,@body)))
;;;###autoload
(defmacro org-check-version ()
"Try very hard to provide sensible version strings."
@ -539,13 +738,10 @@ effect, which variables to use depends on the Emacs version."
(defun org-release () "N/A")
(defun org-git-version () "N/A !!check installation!!"))))))
(defmacro org-with-silent-modifications (&rest body)
(if (fboundp 'with-silent-modifications)
`(with-silent-modifications ,@body)
`(org-unmodified ,@body)))
(def-edebug-spec org-with-silent-modifications (body))
;; Functions for Emacs < 24.4 compatibility
;;; 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
@ -566,6 +762,341 @@ attention to case differences."
(eq t (compare-strings suffix nil nil
string start-pos nil ignore-case))))))
;;; Integration with and fixes for other packages
(defgroup org-imenu-and-speedbar nil
"Options concerning imenu and speedbar in Org mode."
:tag "Org Imenu and Speedbar"
:group 'org-structure)
(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
(defvar-local org-imenu-markers nil
"All markers currently used by Imenu.")
(defun org-imenu-get-tree ()
"Produce the index for Imenu."
(dolist (x org-imenu-markers) (move-marker x nil))
(setq org-imenu-markers nil)
(org-with-wide-buffer
(goto-char (point-max))
(let* ((re (concat "^" (org-get-limited-outline-regexp)))
(subs (make-vector (1+ org-imenu-depth) nil))
(last-level 0))
(while (re-search-backward re nil t)
(let ((level (org-reduced-level (funcall outline-level)))
(headline (org-no-properties
(org-link-display-format (org-get-heading t t t t)))))
(when (and (<= level org-imenu-depth) (org-string-nw-p headline))
(let* ((m (point-marker))
(item (propertize headline 'org-imenu-marker m 'org-imenu t)))
(push m org-imenu-markers)
(if (>= level last-level)
(push (cons item m) (aref subs level))
(push (cons item
(cl-mapcan #'identity (cl-subseq subs (1+ level))))
(aref subs level))
(cl-loop for i from (1+ level) to org-imenu-depth
do (aset subs i nil)))
(setq last-level level)))))
(aref subs 1))))
(eval-after-load "imenu"
'(progn
(add-hook 'imenu-after-jump-hook
(lambda ()
(when (derived-mode-p 'org-mode)
(org-show-context 'org-goto))))
(add-hook 'org-mode-hook
(lambda ()
(setq imenu-create-index-function 'org-imenu-get-tree)))))
;;;; Speedbar
(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1)
"Overlay marking the agenda restriction line in speedbar.")
(overlay-put org-speedbar-restriction-lock-overlay
'face 'org-agenda-restriction-lock)
(overlay-put org-speedbar-restriction-lock-overlay
'help-echo "Agendas are currently limited to this item.")
(delete-overlay org-speedbar-restriction-lock-overlay)
(defun org-speedbar-set-agenda-restriction ()
"Restrict future agenda commands to the location at point in speedbar.
If there is already a restriction lock at the location, remove it.
To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
(interactive)
(require 'org-agenda)
(let (p m tp np dir txt)
(cond
((setq p (text-property-any (point-at-bol) (point-at-eol)
'org-imenu t))
(setq m (get-text-property p 'org-imenu-marker))
(with-current-buffer (marker-buffer m)
(goto-char m)
(if (and org-agenda-overriding-restriction
(member org-agenda-restriction-lock-overlay
(overlays-at (point))))
(org-agenda-remove-restriction-lock 'noupdate)
(org-agenda-set-restriction-lock 'subtree))))
((setq p (text-property-any (point-at-bol) (point-at-eol)
'speedbar-function 'speedbar-find-file))
(setq tp (previous-single-property-change
(1+ p) 'speedbar-function)
np (next-single-property-change
tp 'speedbar-function)
dir (speedbar-line-directory)
txt (buffer-substring-no-properties (or tp (point-min))
(or np (point-max))))
(with-current-buffer (find-file-noselect
(let ((default-directory dir))
(expand-file-name txt)))
(unless (derived-mode-p 'org-mode)
(user-error "Cannot restrict to non-Org mode file"))
(org-agenda-set-restriction-lock 'file)))
(t (user-error "Don't know how to restrict Org mode agenda")))
(move-overlay org-speedbar-restriction-lock-overlay
(point-at-bol) (point-at-eol))
(setq current-prefix-arg nil)
(org-agenda-maybe-redo)))
(defvar speedbar-file-key-map)
(declare-function speedbar-add-supported-extension "speedbar" (extension))
(eval-after-load "speedbar"
'(progn
(speedbar-add-supported-extension ".org")
(define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
(define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
(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))))))
;;;; Add Log
(defun org-add-log-current-headline ()
"Return current headline or nil.
This function ignores inlinetasks. It is meant to be used as
`add-log-current-defun-function' value."
(org-with-limited-levels (org-get-heading t t t t)))
;;;; Flyspell
(defun org--flyspell-object-check-p (element)
"Non-nil when Flyspell can check object at point.
ELEMENT is the element at point."
(let ((object (save-excursion
(when (looking-at-p "\\>") (backward-char))
(org-element-context element))))
(cl-case (org-element-type object)
;; Prevent checks in links due to keybinding conflict with
;; Flyspell.
((code entity export-snippet inline-babel-call
inline-src-block line-break latex-fragment link macro
statistics-cookie target timestamp verbatim)
nil)
(footnote-reference
;; Only in inline footnotes, within the definition.
(and (eq (org-element-property :type object) 'inline)
(< (save-excursion
(goto-char (org-element-property :begin object))
(search-forward ":" nil t 2))
(point))))
(otherwise t))))
(defun org-mode-flyspell-verify ()
"Function used for `flyspell-generic-check-word-predicate'."
(if (org-at-heading-p)
;; At a headline or an inlinetask, check title only. This is
;; faster than relying on `org-element-at-point'.
(and (save-excursion (beginning-of-line)
(and (let ((case-fold-search t))
(not (looking-at-p "\\*+ END[ \t]*$")))
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))))
(match-beginning 4)
(>= (point) (match-beginning 4))
(or (not (match-beginning 5))
(< (point) (match-beginning 5))))
(let* ((element (org-element-at-point))
(post-affiliated (org-element-property :post-affiliated element)))
(cond
;; Ignore checks in all affiliated keywords but captions.
((< (point) post-affiliated)
(and (save-excursion
(beginning-of-line)
(let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
(> (point) (match-end 0))
(org--flyspell-object-check-p element)))
;; Ignore checks in LOGBOOK (or equivalent) drawer.
((let ((log (org-log-into-drawer)))
(and log
(let ((drawer (org-element-lineage element '(drawer))))
(and drawer
(eq (compare-strings
log nil nil
(org-element-property :drawer-name drawer) nil nil t)
t)))))
nil)
(t
(cl-case (org-element-type element)
((comment quote-section) t)
(comment-block
;; Allow checks between block markers, not on them.
(and (> (line-beginning-position) post-affiliated)
(save-excursion
(end-of-line)
(skip-chars-forward " \r\t\n")
(< (point) (org-element-property :end element)))))
;; Arbitrary list of keywords where checks are meaningful.
;; Make sure point is on the value part of the element.
(keyword
(and (member (org-element-property :key element)
'("DESCRIPTION" "TITLE"))
(save-excursion
(search-backward ":" (line-beginning-position) t))))
;; Check is globally allowed in paragraphs verse blocks and
;; table rows (after affiliated keywords) but some objects
;; must not be affected.
((paragraph table-row verse-block)
(let ((cbeg (org-element-property :contents-begin element))
(cend (org-element-property :contents-end element)))
(and cbeg (>= (point) cbeg) (< (point) cend)
(org--flyspell-object-check-p element))))))))))
(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
(defun org-remove-flyspell-overlays-in (beg end)
"Remove flyspell overlays in region."
(and (bound-and-true-p flyspell-mode)
(fboundp 'flyspell-delete-region-overlays)
(flyspell-delete-region-overlays beg end)))
(defvar flyspell-delayed-commands)
(eval-after-load "flyspell"
'(add-to-list 'flyspell-delayed-commands 'org-self-insert-command))
;;;; Bookmark
(defun org-bookmark-jump-unhide ()
"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)))
;; Make `bookmark-jump' shows the jump location if it was hidden.
(eval-after-load "bookmark"
'(if (boundp 'bookmark-after-jump-hook)
;; We can use the hook
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
;; Hook not available, use advice
(defadvice bookmark-jump (after org-make-visible activate)
"Make the position visible."
(org-bookmark-jump-unhide))))
;;;; Calendar
(defcustom org-calendar-to-agenda-key 'default
"Key to be installed in `calendar-mode-map' for switching to the agenda.
The command `org-calendar-goto-agenda' will be bound to this key.
When set to `default', bind the function to `c', but only if it is
available in the Calendar keymap. This is the default choice because
`c' can then be used to switch back and forth between agenda and calendar.
When nil, `org-calendar-goto-agenda' is not bound to any key."
:group 'org-agenda
:type '(choice
(const :tag "Bind to `c' if available" default)
(key-sequence :tag "Other binding")
(const :tag "No binding" nil))
:safe (lambda (v) (or (symbolp v) (stringp v)))
:package-version '(Org . "9.2"))
(defcustom org-calendar-insert-diary-entry-key [?i]
"The key to be installed in `calendar-mode-map' for adding diary entries.
This option is irrelevant until `org-agenda-diary-file' has been configured
to point to an Org file. When that is the case, the command
`org-agenda-diary-entry' will be bound to the key given here, by default
`i'. In the calendar, `i' normally adds entries to `diary-file'. So
if you want to continue doing this, you need to change this to a different
key."
:group 'org-agenda
:type 'sexp)
(defun org--setup-calendar-bindings ()
"Bind Org functions in Calendar keymap."
(pcase org-calendar-to-agenda-key
(`nil nil)
((and key (pred stringp))
(local-set-key (kbd key) #'org-calendar-goto-agenda))
((guard (not (lookup-key calendar-mode-map "c")))
(local-set-key "c" #'org-calendar-goto-agenda))
(_ nil))
(unless (eq org-agenda-diary-file 'diary-file)
(local-set-key org-calendar-insert-diary-entry-key
#'org-agenda-diary-entry)))
(eval-after-load "calendar"
'(add-hook 'calendar-mode-hook #'org--setup-calendar-bindings))
;;;; 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)))
;;;; 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))))
;;;; Simple
(defun org-mark-jump-unhide ()
"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)))
(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)))
(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)))
;;;; Session
;; Make "session.el" ignore our circular variable.
(defvar session-globals-exclude)
(eval-after-load "session"
'(add-to-list 'session-globals-exclude 'org-mark-ring))
(provide 'org-compat)
;;; org-compat.el ends here

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

@ -190,7 +190,7 @@ See `org-crypt-disable-auto-save'."
(error (insert contents) (error (nth 1 err)))))
(when folded
(goto-char start-heading)
(outline-hide-subtree))
(org-flag-subtree t))
nil)))))
(defun org-decrypt-entry ()

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

@ -51,7 +51,6 @@
(require 'cl-lib)
(require 'org-macs)
(declare-function org-trim "org" (s &optional keep-lead))
;;; Public variables

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

@ -58,10 +58,55 @@
;;; Code:
(require 'org)
(require 'avl-tree)
(require 'cl-lib)
(require 'ol)
(require 'org)
(require 'org-compat)
(require 'org-entities)
(require 'org-footnote)
(require 'org-list)
(require 'org-macs)
(require 'org-table)
(declare-function org-at-heading-p "org" (&optional _))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-escape-code-in-string "org-src" (s))
(declare-function org-find-visible "org" ())
(declare-function org-macro-escape-arguments "org-macro" (&rest args))
(declare-function org-macro-extract-arguments "org-macro" (s))
(declare-function org-reduced-level "org" (l))
(declare-function org-unescape-code-in-string "org-src" (s))
(declare-function outline-next-heading "outline" ())
(declare-function outline-previous-heading "outline" ())
(defvar org-archive-tag)
(defvar org-clock-line-re)
(defvar org-closed-string)
(defvar org-comment-string)
(defvar org-complex-heading-regexp)
(defvar org-dblock-start-re)
(defvar org-deadline-string)
(defvar org-done-keywords)
(defvar org-drawer-regexp)
(defvar org-edit-src-content-indentation)
(defvar org-emph-re)
(defvar org-emphasis-regexp-components)
(defvar org-keyword-time-not-clock-regexp)
(defvar org-match-substring-regexp)
(defvar org-odd-levels-only)
(defvar org-outline-regexp-bol)
(defvar org-planning-line-re)
(defvar org-property-drawer-re)
(defvar org-property-format)
(defvar org-property-re)
(defvar org-scheduled-string)
(defvar org-src-preserve-indentation)
(defvar org-tags-column)
(defvar org-time-stamp-formats)
(defvar org-todo-regexp)
(defvar org-ts-regexp-both)
(defvar org-verbatim-re)
;;; Definitions And Rules
@ -91,7 +136,7 @@ specially in `org-element--object-lex'.")
(setq org-element-paragraph-separate
(concat "^\\(?:"
;; Headlines, inlinetasks.
org-outline-regexp "\\|"
"\\*+ " "\\|"
;; Footnote definitions.
"\\[fn:[-_[:word:]]+\\]" "\\|"
;; Diary sexps.
@ -117,7 +162,7 @@ specially in `org-element--object-lex'.")
;; LaTeX environments.
"\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|"
;; Clock lines.
(regexp-quote org-clock-string) "\\|"
"CLOCK:" "\\|"
;; Lists.
(let ((term (pcase org-plain-list-ordered-item-terminator
(?\) ")") (?. "\\.") (_ "[.)]")))
@ -307,8 +352,9 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
(strike-through ,@standard-set)
(subscript ,@standard-set)
(superscript ,@standard-set)
;; Ignore inline babel call and inline src block as formulas are
;; possible. Also ignore line breaks and statistics cookies.
;; Ignore inline babel call and inline source block as formulas
;; are possible. Also ignore line breaks and statistics
;; cookies.
(table-cell bold code entity export-snippet footnote-reference italic
latex-fragment link macro radio-target strike-through
subscript superscript target timestamp underline verbatim)
@ -491,6 +537,7 @@ objects, or a strings.
The function takes care of setting `:parent' property for CHILD.
Return parent element."
(declare (indent 1))
(if (not children) parent
;; Link every child to PARENT. If PARENT is nil, it is a secondary
;; string: parent is the list itself.
@ -677,7 +724,7 @@ Assume point is at the beginning of the block."
(defun org-element-center-block-interpreter (_ contents)
"Interpret a center-block element as Org syntax.
CONTENTS is the contents of the element."
(format "#+BEGIN_CENTER\n%s#+END_CENTER" contents))
(format "#+begin_center\n%s#+end_center" contents))
;;;; Drawer
@ -787,7 +834,7 @@ Assume point is at beginning of dynamic block."
(defun org-element-dynamic-block-interpreter (dynamic-block contents)
"Interpret DYNAMIC-BLOCK element as Org syntax.
CONTENTS is the contents of the element."
(format "#+BEGIN: %s%s\n%s#+END:"
(format "#+begin: %s%s\n%s#+end:"
(org-element-property :block-name dynamic-block)
(let ((args (org-element-property :arguments dynamic-block)))
(if args (concat " " args) ""))
@ -812,7 +859,8 @@ their value.
Return a list whose CAR is `footnote-definition' and CDR is
a plist containing `:label', `:begin' `:end', `:contents-begin',
`:contents-end', `:post-blank' and `:post-affiliated' keywords.
`:contents-end', `:pre-blank',`:post-blank' and
`:post-affiliated' keywords.
Assume point is at the beginning of the footnote definition."
(save-excursion
@ -838,12 +886,16 @@ Assume point is at the beginning of the footnote definition."
((eq ?* (char-after (match-beginning 0))) (match-beginning 0))
(t (skip-chars-forward " \r\t\n" limit)
(if (= limit (point)) limit (line-beginning-position))))))
(pre-blank 0)
(contents-begin
(progn (search-forward "]")
(skip-chars-forward " \r\t\n" end)
(cond ((= (point) end) nil)
((= (line-beginning-position) post-affiliated) (point))
(t (line-beginning-position)))))
(t
(setq pre-blank
(count-lines (line-beginning-position) begin))
(line-beginning-position)))))
(contents-end
(progn (goto-char end)
(skip-chars-backward " \r\t\n")
@ -855,6 +907,7 @@ Assume point is at the beginning of the footnote definition."
:end end
:contents-begin contents-begin
:contents-end (and contents-begin contents-end)
:pre-blank pre-blank
:post-blank (count-lines contents-end end)
:post-affiliated post-affiliated)
(cdr affiliated))))))
@ -862,9 +915,18 @@ Assume point is at the beginning of the footnote definition."
(defun org-element-footnote-definition-interpreter (footnote-definition contents)
"Interpret FOOTNOTE-DEFINITION element as Org syntax.
CONTENTS is the contents of the footnote-definition."
(concat (format "[fn:%s]" (org-element-property :label footnote-definition))
" "
contents))
(let ((pre-blank
(min (or (org-element-property :pre-blank footnote-definition)
;; 0 is specific to paragraphs at the beginning of
;; the footnote definition, so we use 1 as
;; a fall-back value, which is more universal.
1)
;; Footnote ends after more than two consecutive empty
;; lines: limit ourselves to 2 newline characters.
2)))
(concat (format "[fn:%s]" (org-element-property :label footnote-definition))
(if (= pre-blank 0) (concat " " (org-trim contents))
(concat (make-string pre-blank ?\n) contents)))))
;;;; Headline
@ -911,7 +973,7 @@ Return value is a plist."
Return a list whose CAR is `headline' and CDR is a plist
containing `:raw-value', `:title', `:begin', `:end',
`:pre-blank', `:contents-begin' and `:contents-end', `:level',
`:priority', `:tags', `:todo-keyword',`:todo-type', `:scheduled',
`:priority', `:tags', `:todo-keyword', `:todo-type', `:scheduled',
`:deadline', `:closed', `:archivedp', `:commentedp'
`:footnote-section-p', `:post-blank' and `:post-affiliated'
keywords.
@ -931,10 +993,10 @@ Assume point is at beginning of the headline."
(level (prog1 (org-reduced-level (skip-chars-forward "*"))
(skip-chars-forward " \t")))
(todo (and org-todo-regexp
(let (case-fold-search) (looking-at org-todo-regexp))
(let (case-fold-search) (looking-at (concat org-todo-regexp " ")))
(progn (goto-char (match-end 0))
(skip-chars-forward " \t")
(match-string 0))))
(match-string 1))))
(todo-type
(and todo (if (member todo org-done-keywords) 'done 'todo)))
(priority (and (looking-at "\\[#.\\][ \t]*")
@ -1172,18 +1234,18 @@ CONTENTS is the contents of inlinetask."
(concat
(make-string
(max (- (+ org-tags-column (length task) (length tags))) 1)
? )
?\s)
tags))
(t
(concat
(make-string (max (- org-tags-column (length task)) 1) ? )
(make-string (max (- org-tags-column (length task)) 1) ?\s)
tags))))
;; Prefer degenerate inlinetasks when there are no
;; contents.
(when contents
(concat "\n"
contents
(make-string level ?*) " END")))))
(make-string level ?*) " end")))))
;;;; Item
@ -1195,8 +1257,8 @@ STRUCT is the structure of the plain list.
Return a list whose CAR is `item' and CDR is a plist containing
`:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
`:checkbox', `:counter', `:tag', `:structure', `:post-blank' and
`:post-affiliated' keywords.
`:checkbox', `:counter', `:tag', `:structure', `:pre-blank',
`:post-blank' and `:post-affiliated' keywords.
When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
any, will not be parsed as a secondary string, but as a plain
@ -1223,20 +1285,25 @@ Assume point is at the beginning of the item."
(string-to-number (match-string 0 c)))))))
(end (progn (goto-char (nth 6 (assq (point) struct)))
(if (bolp) (point) (line-beginning-position 2))))
(pre-blank 0)
(contents-begin
(progn (goto-char
;; Ignore tags in un-ordered lists: they are just
;; a part of item's body.
(if (and (match-beginning 4)
(save-match-data (string-match "[.)]" bullet)))
(match-beginning 4)
(match-end 0)))
(skip-chars-forward " \r\t\n" end)
(cond ((= (point) end) nil)
;; If first line isn't empty, contents really
;; start at the text after item's meta-data.
((= (line-beginning-position) begin) (point))
(t (line-beginning-position)))))
(progn
(goto-char
;; Ignore tags in un-ordered lists: they are just
;; a part of item's body.
(if (and (match-beginning 4)
(save-match-data (string-match "[.)]" bullet)))
(match-beginning 4)
(match-end 0)))
(skip-chars-forward " \r\t\n" end)
(cond ((= (point) end) nil)
;; If first line isn't empty, contents really
;; start at the text after item's meta-data.
((= (line-beginning-position) begin) (point))
(t
(setq pre-blank
(count-lines (line-beginning-position) begin))
(line-beginning-position)))))
(contents-end (and contents-begin
(progn (goto-char end)
(skip-chars-backward " \r\t\n")
@ -1251,6 +1318,7 @@ Assume point is at the beginning of the item."
:checkbox checkbox
:counter counter
:structure struct
:pre-blank pre-blank
:post-blank (count-lines (or contents-end begin) end)
:post-affiliated begin))))
(org-element-put-property
@ -1266,35 +1334,43 @@ Assume point is at the beginning of the item."
(defun org-element-item-interpreter (item contents)
"Interpret ITEM element as Org syntax.
CONTENTS is the contents of the element."
(let* ((bullet (let ((bullet (org-element-property :bullet item)))
(org-list-bullet-string
(cond ((not (string-match "[0-9a-zA-Z]" bullet)) "- ")
((eq org-plain-list-ordered-item-terminator ?\)) "1)")
(t "1.")))))
(checkbox (org-element-property :checkbox item))
(counter (org-element-property :counter item))
(tag (let ((tag (org-element-property :tag item)))
(and tag (org-element-interpret-data tag))))
;; Compute indentation.
(ind (make-string (length bullet) 32))
(item-starts-with-par-p
(eq (org-element-type (car (org-element-contents item)))
'paragraph)))
;; Indent contents.
(let ((tag (pcase (org-element-property :tag item)
(`nil nil)
(tag (format "%s :: " (org-element-interpret-data tag)))))
(bullet
(org-list-bullet-string
(cond
((not (string-match-p "[0-9a-zA-Z]"
(org-element-property :bullet item))) "- ")
((eq org-plain-list-ordered-item-terminator ?\)) "1)")
(t "1.")))))
(concat
bullet
(and counter (format "[@%d] " counter))
(pcase checkbox
(pcase (org-element-property :counter item)
(`nil nil)
(counter (format "[@%d] " counter)))
(pcase (org-element-property :checkbox item)
(`on "[X] ")
(`off "[ ] ")
(`trans "[-] ")
(_ nil))
(and tag (format "%s :: " tag))
tag
(when contents
(let ((contents (replace-regexp-in-string
"\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
(if item-starts-with-par-p (org-trim contents)
(concat "\n" contents)))))))
(let* ((ind (make-string (if tag 5 (length bullet)) ?\s))
(pre-blank
(min (or (org-element-property :pre-blank item)
;; 0 is specific to paragraphs at the
;; beginning of the item, so we use 1 as
;; a fall-back value, which is more universal.
1)
;; Lists ends after more than two consecutive
;; empty lines: limit ourselves to 2 newline
;; characters.
2))
(contents (replace-regexp-in-string
"\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
(if (= pre-blank 0) (org-trim contents)
(concat (make-string pre-blank ?\n) contents)))))))
;;;; Plain List
@ -1516,7 +1592,7 @@ Assume point is at the beginning of the block."
(defun org-element-quote-block-interpreter (_ contents)
"Interpret quote-block element as Org syntax.
CONTENTS is the contents of the element."
(format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents))
(format "#+begin_quote\n%s#+end_quote" contents))
;;;; Section
@ -1602,7 +1678,7 @@ Assume point is at the beginning of the block."
"Interpret SPECIAL-BLOCK element as Org syntax.
CONTENTS is the contents of the element."
(let ((block-type (org-element-property :type special-block)))
(format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type)))
(format "#+begin_%s\n%s#+end_%s" block-type contents block-type)))
@ -1670,7 +1746,7 @@ containing `:call', `:inside-header', `:arguments',
(defun org-element-babel-call-interpreter (babel-call _)
"Interpret BABEL-CALL element as Org syntax."
(concat "#+CALL: "
(concat "#+call: "
(org-element-property :call babel-call)
(let ((h (org-element-property :inside-header babel-call)))
(and h (format "[%s]" h)))
@ -1692,7 +1768,7 @@ Return a list whose CAR is `clock' and CDR is a plist containing
(save-excursion
(let* ((case-fold-search nil)
(begin (point))
(value (progn (search-forward org-clock-string (line-end-position) t)
(value (progn (search-forward "CLOCK:" (line-end-position) t)
(skip-chars-forward " \t")
(org-element-timestamp-parser)))
(duration (and (search-forward " => " (line-end-position) t)
@ -1717,7 +1793,7 @@ Return a list whose CAR is `clock' and CDR is a plist containing
(defun org-element-clock-interpreter (clock _)
"Interpret CLOCK element as Org syntax."
(concat org-clock-string " "
(concat "CLOCK: "
(org-element-timestamp-interpreter
(org-element-property :value clock) nil)
(let ((duration (org-element-property :duration clock)))
@ -1824,7 +1900,7 @@ Assume point is at comment block beginning."
(defun org-element-comment-block-interpreter (comment-block _)
"Interpret COMMENT-BLOCK element as Org syntax."
(format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
(format "#+begin_comment\n%s#+end_comment"
(org-element-normalize-string
(org-remove-indentation
(org-element-property :value comment-block)))))
@ -1951,15 +2027,22 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
(defun org-element-example-block-interpreter (example-block _)
"Interpret EXAMPLE-BLOCK element as Org syntax."
(let ((switches (org-element-property :switches example-block))
(value (org-element-property :value example-block)))
(concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
(org-element-normalize-string
(org-escape-code-in-string
(if (or org-src-preserve-indentation
(org-element-property :preserve-indent example-block))
value
(org-remove-indentation value))))
"#+END_EXAMPLE")))
(value
(let ((val (org-element-property :value example-block)))
(cond
((or org-src-preserve-indentation
(org-element-property :preserve-indent example-block))
val)
((= 0 org-edit-src-content-indentation)
(org-remove-indentation val))
(t
(let ((ind (make-string org-edit-src-content-indentation ?\s)))
(replace-regexp-in-string "^[ \t]*\\S-"
(concat ind "\\&")
(org-remove-indentation val))))))))
(concat "#+begin_example" (and switches (concat " " switches)) "\n"
(org-element-normalize-string (org-escape-code-in-string value))
"#+end_example")))
;;;; Export Block
@ -2012,7 +2095,7 @@ Assume point is at export-block beginning."
(defun org-element-export-block-interpreter (export-block _)
"Interpret EXPORT-BLOCK element as Org syntax."
(format "#+BEGIN_EXPORT %s\n%s#+END_EXPORT"
(format "#+begin_export %s\n%s#+end_export"
(org-element-property :type export-block)
(org-element-property :value export-block)))
@ -2035,26 +2118,22 @@ Assume point is at the beginning of the fixed-width area."
(save-excursion
(let* ((begin (car affiliated))
(post-affiliated (point))
value
(end-area
(progn
(while (and (< (point) limit)
(looking-at "[ \t]*:\\( \\|$\\)"))
;; Accumulate text without starting colons.
(setq value
(concat value
(buffer-substring-no-properties
(match-end 0) (point-at-eol))
"\n"))
(forward-line))
(point)))
(if (bolp) (line-end-position 0) (point))))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
(list 'fixed-width
(nconc
(list :begin begin
:end end
:value value
:value (replace-regexp-in-string
"^[ \t]*: ?" ""
(buffer-substring-no-properties post-affiliated
end-area))
:post-blank (count-lines end-area end)
:post-affiliated post-affiliated)
(cdr affiliated))))))
@ -2062,10 +2141,7 @@ Assume point is at the beginning of the fixed-width area."
(defun org-element-fixed-width-interpreter (fixed-width _)
"Interpret FIXED-WIDTH element as Org syntax."
(let ((value (org-element-property :value fixed-width)))
(and value
(replace-regexp-in-string
"^" ": "
(if (string-match "\n\\'" value) (substring value 0 -1) value)))))
(and value (replace-regexp-in-string "^" ": " value))))
;;;; Horizontal Rule
@ -2139,7 +2215,7 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
(defun org-element-keyword-interpreter (keyword _)
"Interpret KEYWORD element as Org syntax."
(format "#+%s: %s"
(org-element-property :key keyword)
(downcase (org-element-property :key keyword))
(org-element-property :value keyword)))
@ -2369,7 +2445,7 @@ containing `:closed', `:deadline', `:scheduled', `:begin',
;;;; Src Block
(defun org-element-src-block-parser (limit affiliated)
"Parse a src block.
"Parse a source block.
LIMIT bounds the search. AFFILIATED is a list of which CAR is
the buffer position at the beginning of the first affiliated
@ -2425,7 +2501,7 @@ Assume point is at the beginning of the block."
(string-match "-l +\"\\([^\"\n]+\\)\"" switches)
(match-string 1 switches)))
;; Should labels be retained in (or stripped from)
;; src blocks?
;; source blocks?
(retain-labels
(or (not switches)
(not (string-match "-r\\>" switches))
@ -2480,14 +2556,14 @@ Assume point is at the beginning of the block."
(org-remove-indentation val))
(t
(let ((ind (make-string org-edit-src-content-indentation ?\s)))
(replace-regexp-in-string
"^" ind (org-remove-indentation val))))))))
(concat (format "#+BEGIN_SRC%s\n"
(concat (and lang (concat " " lang))
(and switches (concat " " switches))
(and params (concat " " params))))
(org-element-normalize-string (org-escape-code-in-string value))
"#+END_SRC")))
(replace-regexp-in-string "^[ \t]*\\S-"
(concat ind "\\&")
(org-remove-indentation val))))))))
(format "#+begin_src%s\n%s#+end_src"
(concat (and lang (concat " " lang))
(and switches (concat " " switches))
(and params (concat " " params)))
(org-element-normalize-string (org-escape-code-in-string value)))))
;;;; Table
@ -2635,7 +2711,7 @@ Assume point is at beginning of the block."
(defun org-element-verse-block-interpreter (_ contents)
"Interpret verse-block element as Org syntax.
CONTENTS is verse block contents."
(format "#+BEGIN_VERSE\n%s#+END_VERSE" contents))
(format "#+begin_verse\n%s#+end_verse" contents))
@ -2803,7 +2879,7 @@ Assume point is at the beginning of the snippet."
When at a footnote reference, return a list whose car is
`footnote-reference' and cdr a plist with `:label', `:type',
`:begin', `:end', `:content-begin', `:contents-end' and
`:begin', `:end', `:contents-begin', `:contents-end' and
`:post-blank' as keywords. Otherwise, return nil."
(when (looking-at org-footnote-re)
(let ((closing (with-syntax-table org-element--pair-square-table
@ -2899,7 +2975,7 @@ When at an inline source block, return a list whose car is
`:language', `:value', `:parameters' and `:post-blank' as
keywords. Otherwise, return nil.
Assume point is at the beginning of the inline src block."
Assume point is at the beginning of the inline source block."
(save-excursion
(catch :no-object
(when (let ((case-fold-search nil))
@ -3066,13 +3142,13 @@ Assume point is at the beginning of the link."
(setq contents-begin (match-beginning 1))
(setq contents-end (match-end 1)))
;; Type 2: Standard link, i.e. [[https://orgmode.org][homepage]]
((looking-at org-bracket-link-regexp)
((looking-at org-link-bracket-re)
(setq format 'bracket)
(setq contents-begin (match-beginning 3))
(setq contents-end (match-end 3))
(setq contents-begin (match-beginning 2))
(setq contents-end (match-end 2))
(setq link-end (match-end 0))
;; RAW-LINK is the original link. Expand any
;; abbreviation in it.
;; RAW-LINK is the original link. Decode any encoding.
;; Expand any abbreviation in it.
;;
;; Also treat any newline character and associated
;; indentation as a single space character. This is not
@ -3083,9 +3159,10 @@ Assume point is at the beginning of the link."
;; [[shell:ls *.org]], which defeats Org's focus on
;; simplicity.
(setq raw-link (org-link-expand-abbrev
(replace-regexp-in-string
"[ \t]*\n[ \t]*" " "
(match-string-no-properties 1))))
(org-link-unescape
(replace-regexp-in-string
"[ \t]*\n[ \t]*" " "
(match-string-no-properties 1)))))
;; Determine TYPE of link and set PATH accordingly. According
;; to RFC 3986, remove whitespaces from URI in external links.
;; In internal ones, treat indentation as a single space.
@ -3115,7 +3192,7 @@ Assume point is at the beginning of the link."
(setq type "fuzzy")
(setq path raw-link))))
;; Type 3: Plain link, e.g., https://orgmode.org
((looking-at org-plain-link-re)
((looking-at org-link-plain-re)
(setq format 'plain)
(setq raw-link (match-string-no-properties 0))
(setq type (match-string-no-properties 1))
@ -3124,7 +3201,7 @@ Assume point is at the beginning of the link."
;; Type 4: Angular link, e.g., <https://orgmode.org>. Unlike to
;; bracket links, follow RFC 3986 and remove any extra
;; whitespace in URI.
((looking-at org-angle-link-re)
((looking-at org-link-angle-re)
(setq format 'angle)
(setq type (match-string-no-properties 1))
(setq link-end (match-end 0))
@ -3218,15 +3295,18 @@ a plist with `:key', `:args', `:begin', `:end', `:value' and
Assume point is at the macro."
(save-excursion
(when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
(when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\([^\000]*?\\))\\)?}}}")
(let ((begin (point))
(key (downcase (match-string-no-properties 1)))
(value (match-string-no-properties 0))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point))
(args (let ((args (match-string-no-properties 3)))
(and args (org-macro-extract-arguments args)))))
(args (pcase (match-string-no-properties 3)
(`nil nil)
(a (org-macro-extract-arguments
(replace-regexp-in-string
"[ \t\r\n]+" " " (org-trim a)))))))
(list 'macro
(list :key key
:value value
@ -3237,7 +3317,11 @@ Assume point is at the macro."
(defun org-element-macro-interpreter (macro _)
"Interpret MACRO object as Org syntax."
(org-element-property :value macro))
(format "{{{%s%s}}}"
(org-element-property :key macro)
(pcase (org-element-property :args macro)
(`nil "")
(args (format "(%s)" (apply #'org-macro-escape-arguments args))))))
;;;; Radio-target
@ -3815,7 +3899,8 @@ element it has to parse."
((org-at-heading-p)
(org-element-inlinetask-parser limit raw-secondary-p))
;; From there, elements can have affiliated keywords.
(t (let ((affiliated (org-element--collect-affiliated-keywords limit)))
(t (let ((affiliated (org-element--collect-affiliated-keywords
limit (memq granularity '(nil object)))))
(cond
;; Jumping over affiliated keywords put point off-limits.
;; Parse them as regular keywords.
@ -3874,7 +3959,18 @@ element it has to parse."
((looking-at "%%(")
(org-element-diary-sexp-parser limit affiliated))
;; Table.
((looking-at "[ \t]*\\(|\\|\\+\\(-+\\+\\)+[ \t]*$\\)")
((or (looking-at "[ \t]*|")
;; There is no strict definition of a table.el
;; table. Try to prevent false positive while being
;; quick.
(let ((rule-regexp "[ \t]*\\+\\(-+\\+\\)+[ \t]*$")
(next (line-beginning-position 2)))
(and (looking-at rule-regexp)
(save-excursion
(forward-line)
(re-search-forward "^[ \t]*\\($\\|[^|]\\)" limit t)
(and (> (line-beginning-position) next)
(org-match-line rule-regexp))))))
(org-element-table-parser limit affiliated))
;; List.
((looking-at (org-item-re))
@ -3890,7 +3986,7 @@ element it has to parse."
;; that element, and, in the meantime, collect information they give
;; into appropriate properties. Hence the following function.
(defun org-element--collect-affiliated-keywords (limit)
(defun org-element--collect-affiliated-keywords (limit parse)
"Collect affiliated keywords from point down to LIMIT.
Return a list whose CAR is the position at the first of them and
@ -3899,13 +3995,16 @@ beginning of the first line after them.
As a special case, if element doesn't start at the beginning of
the line (e.g., a paragraph starting an item), CAR is current
position of point and CDR is nil."
position of point and CDR is nil.
When PARSE is non-nil, values from keywords belonging to
`org-element-parsed-keywords' are parsed as secondary strings."
(if (not (bolp)) (list (point))
(let ((case-fold-search t)
(origin (point))
;; RESTRICT is the list of objects allowed in parsed
;; keywords value.
(restrict (org-element-restriction 'keyword))
;; keywords value. If PARSE is nil, no object is allowed.
(restrict (and parse (org-element-restriction 'keyword)))
output)
(while (and (< (point) limit) (looking-at org-element--affiliated-re))
(let* ((raw-kwd (upcase (match-string 1)))
@ -3914,35 +4013,35 @@ position of point and CDR is nil."
(kwd (or (cdr (assoc raw-kwd
org-element-keyword-translation-alist))
raw-kwd))
;; PARSED? is non-nil when keyword should have its
;; value parsed.
(parsed? (member kwd org-element-parsed-keywords))
;; Find main value for any keyword.
(value
(save-match-data
(org-trim
(buffer-substring-no-properties
(match-end 0) (line-end-position)))))
;; PARSEDP is non-nil when keyword should have its
;; value parsed.
(parsedp (member kwd org-element-parsed-keywords))
;; If KWD is a dual keyword, find its secondary
;; value. Maybe parse it.
(dualp (member kwd org-element-dual-keywords))
(let ((beg (match-end 0))
(end (save-excursion
(end-of-line)
(skip-chars-backward " \t")
(point))))
(if parsed?
(org-element--parse-objects beg end nil restrict)
(org-trim (buffer-substring-no-properties beg end)))))
;; If KWD is a dual keyword, find its secondary value.
;; Maybe parse it.
(dual? (member kwd org-element-dual-keywords))
(dual-value
(and dualp
(and dual?
(let ((sec (match-string-no-properties 2)))
(if (or (not sec) (not parsedp)) sec
(cond
((and sec parsed?)
(save-match-data
(org-element--parse-objects
(match-beginning 2) (match-end 2) nil restrict))))))
(match-beginning 2) (match-end 2) nil restrict)))
(sec sec)))))
;; Attribute a property name to KWD.
(kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
;; Now set final shape for VALUE.
(when parsedp
(setq value
(org-element--parse-objects
(match-end 0)
(progn (end-of-line) (skip-chars-backward " \t") (point))
nil restrict)))
(when dualp
(when dual?
(setq value (and (or value dual-value) (cons value dual-value))))
(when (or (member kwd org-element-multiple-keywords)
;; Attributes can always appear on multiple lines.
@ -4046,7 +4145,10 @@ If STRING is the empty string or nil, return nil."
(ignore-errors
(if (symbolp v) (makunbound v)
(set (make-local-variable (car v)) (cdr v)))))
(insert string)
;; Transferring local variables may put the temporary buffer
;; into a read-only state. Make sure we can insert STRING.
(let ((inhibit-read-only t)) (insert string))
;; Prevent "Buffer *temp* modified; kill anyway?".
(restore-buffer-modified-p nil)
(org-element--parse-objects
(point-min) (point-max) nil restriction parent))))))
@ -4532,8 +4634,9 @@ to interpret. Return Org syntax as a string."
(and (eq type 'paragraph)
(memq (org-element-type parent)
'(footnote-definition item))
(eq data
(car (org-element-contents parent)))))))
(eq data (car (org-element-contents parent)))
(eq (org-element-property :pre-blank parent)
0)))))
""))))))
(if (memq type '(org-data plain-text nil)) results
;; Build white spaces. If no `:post-blank' property
@ -4555,7 +4658,7 @@ If there is no affiliated keyword, return the empty string."
(let (dual)
(when (member key org-element-dual-keywords)
(setq dual (cdr value) value (car value)))
(concat "#+" key
(concat "#+" (downcase key)
(and dual
(format "[%s]" (org-element-interpret-data dual)))
": "
@ -4950,7 +5053,6 @@ A and B are either integers or lists of integers, as returned by
(defsubst org-element--cache-root ()
"Return root value in cache.
This function assumes `org-element--cache' is a valid AVL tree."
;; FIXME: Why use internal functions of avl-tree?
(avl-tree--node-left (avl-tree--dummyroot org-element--cache)))
@ -4979,7 +5081,6 @@ the cache."
(aref (car org-element--cache-sync-requests) 0)))
(node (org-element--cache-root))
lower upper)
;; FIXME: Why use internal functions of avl-tree?
(while node
(let* ((element (avl-tree--node-data node))
(begin (org-element-property :begin element)))
@ -5055,7 +5156,7 @@ Assume ELEMENT belongs to cache and that a cache is active."
(setq org-element--cache-sync-timer
(run-with-idle-timer
(let ((idle (current-idle-time)))
(if idle (time-add idle org-element-cache-sync-break)
(if idle (org-time-add idle org-element-cache-sync-break)
org-element-cache-sync-idle-time))
nil
#'org-element--cache-sync
@ -5066,7 +5167,7 @@ Assume ELEMENT belongs to cache and that a cache is active."
TIME-LIMIT is a time value or nil."
(and time-limit
(or (input-pending-p)
(time-less-p time-limit nil))))
(org-time-less-p time-limit nil))))
(defsubst org-element--cache-shift-positions (element offset &optional props)
"Shift ELEMENT properties relative to buffer positions by OFFSET.
@ -5120,7 +5221,8 @@ updated before current modification are actually submitted."
(and next (aref next 0))
threshold
(and (not threshold)
(time-add nil org-element-cache-sync-duration))
(org-time-add nil
org-element-cache-sync-duration))
future-change)
;; Request processed. Merge current and next offsets and
;; transfer ending position.
@ -5460,7 +5562,7 @@ the process stopped before finding the expected result."
(defconst org-element--cache-sensitive-re
(concat
org-outline-regexp-bol "\\|"
"^\\*+ " "\\|"
"\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|"
"^[ \t]*\\(?:"
"#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|"
@ -5869,24 +5971,24 @@ Providing it allows for quicker computation."
;; Otherwise, return NEXT.
(t (throw 'exit next)))))))))))))
(defun org-element-lineage (blob &optional types with-self)
(defun org-element-lineage (datum &optional types with-self)
"List all ancestors of a given element or object.
BLOB is an object or element.
DATUM is an object or element.
When optional argument TYPES is a list of symbols, return the
first element or object in the lineage whose type belongs to that
list.
Return ancestors from the closest to the farthest. When optional
argument TYPES is a list of symbols, return the first element or
object in the lineage whose type belongs to that list instead.
When optional argument WITH-SELF is non-nil, lineage includes
BLOB itself as the first element, and TYPES, if provided, also
DATUM itself as the first element, and TYPES, if provided, also
apply to it.
When BLOB is obtained through `org-element-context' or
When DATUM is obtained through `org-element-context' or
`org-element-at-point', only ancestors from its section can be
found. There is no such limitation when BLOB belongs to a full
found. There is no such limitation when DATUM belongs to a full
parse tree."
(let ((up (if with-self blob (org-element-property :parent blob)))
(let ((up (if with-self datum (org-element-property :parent datum)))
ancestors)
(while (and up (not (memq (org-element-type up) types)))
(unless types (push up ancestors))
@ -5914,16 +6016,16 @@ end of ELEM-A."
;; ELEM-A position in such a situation. Note that the case of
;; a footnote definition is impossible: it cannot contain two
;; paragraphs in a row because it cannot contain a blank line.
(if (and specialp
(or (not (eq (org-element-type elem-B) 'paragraph))
(/= (org-element-property :begin elem-B)
(org-element-property :contents-begin elem-B))))
(error "Cannot swap elements"))
(when (and specialp
(or (not (eq (org-element-type elem-B) 'paragraph))
(/= (org-element-property :begin elem-B)
(org-element-property :contents-begin elem-B))))
(error "Cannot swap elements"))
;; In a special situation, ELEM-A will have no indentation. We'll
;; give it ELEM-B's (which will in, in turn, have no indentation).
(let* ((ind-B (when specialp
(goto-char (org-element-property :begin elem-B))
(org-get-indentation)))
(current-indentation)))
(beg-A (org-element-property :begin elem-A))
(end-A (save-excursion
(goto-char (org-element-property :end elem-A))

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

@ -543,11 +543,11 @@ This first checks the user list, then the built-in list."
(dolist (e org-entities)
(pcase e
(`(,name ,latex ,mathp ,html ,ascii ,latin ,utf8)
(if (equal ascii "|") (setq ascii "\\vert"))
(if (equal latin "|") (setq latin "\\vert"))
(if (equal utf8 "|") (setq utf8 "\\vert"))
(if (equal ascii "=>") (setq ascii "= >"))
(if (equal latin "=>") (setq latin "= >"))
(when (equal ascii "|") (setq ascii "\\vert"))
(when (equal latin "|") (setq latin "\\vert"))
(when (equal utf8 "|") (setq utf8 "\\vert"))
(when (equal ascii "=>") (setq ascii "= >"))
(when (equal latin "=>") (setq latin "= >"))
(insert "|" name
"|" (format "=%s=" latex)
"|" (format (if mathp "$%s$" "$\\mbox{%s}$") latex)

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

@ -311,7 +311,7 @@ determines if it is a foreground or a background color."
(if (not value)
(setq org-tags-special-faces-re nil)
(setq org-tags-special-faces-re
(concat ":\\(" (mapconcat 'car value "\\|") "\\):"))))
(concat ":" (regexp-opt (mapcar #'car value) t) ":"))))
(defface org-checkbox '((t :inherit bold))
"Face for checkboxes."
@ -395,8 +395,7 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
(defface org-block '((t :inherit shadow))
"Face text in #+begin ... #+end blocks.
For source-blocks `org-src-block-faces' takes precedence.
See also `org-fontify-quote-and-verse-blocks'."
For source-blocks `org-src-block-faces' takes precedence."
:group 'org-faces
:version "26.1")
@ -414,11 +413,13 @@ See also `org-fontify-quote-and-verse-blocks'."
:version "22.1")
(defface org-quote '((t (:inherit org-block)))
"Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks."
"Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.
Active when `org-fontify-quote-and-verse-blocks' is set."
:group 'org-faces)
(defface org-verse '((t (:inherit org-block)))
"Face for #+BEGIN_VERSE ... #+END_VERSE blocks."
"Face for #+BEGIN_VERSE ... #+END_VERSE blocks.
Active when `org-fontify-quote-and-verse-blocks' is set."
:group 'org-faces)
(defcustom org-fontify-quote-and-verse-blocks nil
@ -511,13 +512,18 @@ which days belong to the weekend."
(((class color) (min-colors 8) (background light)) (:foreground "red"))
(((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
(t (:bold t)))
"Face for items scheduled previously, and not yet done."
"Face for items scheduled previously, and not yet done.
See also `org-agenda-deadline-faces'."
:group 'org-faces)
(defface org-upcoming-distant-deadline '((t :inherit org-default))
"Face for items scheduled previously, not done, and have a distant deadline.
See also `org-agenda-deadline-faces'.")
(defcustom org-agenda-deadline-faces
'((1.0 . org-warning)
(0.5 . org-upcoming-deadline)
(0.0 . default))
(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\").
@ -553,10 +559,6 @@ month and 365.24 days for a year)."
"Face for tag(s) in the mode-line when filtering the agenda."
:group 'org-faces)
(defface org-agenda-filter-regexp '((t :inherit mode-line))
"Face for regexp(s) in the mode-line when filtering the agenda."
:group 'org-faces)
(defface org-agenda-filter-category '((t :inherit mode-line))
"Face for categories in the mode-line when filtering the agenda."
:group 'org-faces)
@ -565,6 +567,10 @@ month and 365.24 days for a year)."
"Face for effort in the mode-line when filtering the agenda."
:group 'org-faces)
(defface org-agenda-filter-regexp '((t :inherit mode-line))
"Face for regexp(s) in the mode-line when filtering the agenda."
:group 'org-faces)
(defface org-time-grid ;Copied from `font-lock-variable-name-face'
'((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
(((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))

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

@ -407,14 +407,13 @@ it can be a list structured like an entry in `org-feed-alist'."
;; Write the new status
;; We do this only now, in case something goes wrong above, so
;; that would would end up with a status that does not reflect
;; which items truely have been handled
;; which items truly have been handled
(org-feed-write-status inbox-pos drawer status)
;; Normalize the visibility of the inbox tree
(goto-char inbox-pos)
(outline-hide-subtree)
(org-flag-subtree t)
(org-show-children)
(org-cycle-hide-drawers 'children)
;; Hooks and messages
(when org-feed-save-after-adding (save-buffer))
@ -567,7 +566,7 @@ If that property is already present, nothing changes."
(if (looking-at
(concat "^\\([ \t]*\\)%" name "[ \t]*$"))
(org-feed-make-indented-block
v (org-get-indentation))
v (current-indentation))
v))))))))
(when replacement
(insert

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

@ -47,18 +47,16 @@
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-fill-paragraph "org" (&optional justify region))
(declare-function org-in-block-p "org" (names))
(declare-function org-in-regexp "org" (re &optional nlines visually))
(declare-function org-in-verbatim-emphasis "org" ())
(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-trim "org" (s &optional keep-lead))
(declare-function outline-next-heading "outline")
(defvar electric-indent-mode)
(defvar org-blank-before-new-entry) ; defined in org.el
(defvar org-bracket-link-regexp) ; defined in org.el
(defvar org-link-bracket-re) ; defined in org.el
(defvar org-complex-heading-regexp) ; defined in org.el
(defvar org-odd-levels-only) ; defined in org.el
(defvar org-outline-regexp) ; defined in org.el
@ -116,7 +114,8 @@ you will need to run the following command after the change:
(org-element-cache-reset 'all)))
:type '(choice
(string :tag "Collect footnotes under heading")
(const :tag "Define footnotes locally" nil)))
(const :tag "Define footnotes locally" nil))
:safe #'string-or-null-p)
(defcustom org-footnote-define-inline nil
"Non-nil means define footnotes inline, at reference location.
@ -124,7 +123,8 @@ When nil, footnotes will be defined in a special section near
the end of the document. When t, the [fn:label:definition] notation
will be used to define the footnote at the reference position."
:group 'org-footnote
:type 'boolean)
:type 'boolean
:safe #'booleanp)
(defcustom org-footnote-auto-label t
"Non-nil means define automatically new labels for footnotes.
@ -141,7 +141,8 @@ random Automatically generate a unique, random label."
(const :tag "Prompt for label" nil)
(const :tag "Create automatic [fn:N]" t)
(const :tag "Offer automatic [fn:N] for editing" confirm)
(const :tag "Create a random label" random)))
(const :tag "Create a random label" random))
:safe #'symbolp)
(defcustom org-footnote-auto-adjust nil
"Non-nil means automatically adjust footnotes after insert/delete.
@ -159,7 +160,8 @@ The main values of this variable can be set with in-buffer options:
(const :tag "No adjustment" nil)
(const :tag "Renumber" renumber)
(const :tag "Sort" sort)
(const :tag "Renumber and Sort" t)))
(const :tag "Renumber and Sort" t))
:safe #'symbolp)
(defcustom org-footnote-fill-after-inline-note-extraction nil
"Non-nil means fill paragraphs after extracting footnotes.
@ -167,7 +169,8 @@ When extracting inline footnotes, the lengths of lines can change a lot.
When this option is set, paragraphs from which an inline footnote has been
extracted will be filled again."
:group 'org-footnote
:type 'boolean)
:type 'boolean
:safe #'booleanp)
;;;; Predicates
@ -186,76 +189,53 @@ extracted will be filled again."
(org-in-block-p org-footnote-forbidden-blocks)))))
(defun org-footnote-at-reference-p ()
"Is the cursor at a footnote reference?
"Non-nil if point is at a footnote reference.
If so, return a list containing its label, beginning and ending
positions, and the definition, when inlined."
(when (and (org-footnote-in-valid-context-p)
(or (looking-at org-footnote-re)
(org-in-regexp org-footnote-re)
(save-excursion (re-search-backward org-footnote-re nil t)))
(/= (match-beginning 0) (line-beginning-position)))
(let* ((beg (match-beginning 0))
(label (match-string-no-properties 1))
;; Inline footnotes don't end at (match-end 0) as
;; `org-footnote-re' stops just after the second colon.
;; Find the real ending with `scan-sexps', so Org doesn't
;; get fooled by unrelated closing square brackets.
(end (ignore-errors (scan-sexps beg 1))))
;; Point is really at a reference if it's located before true
;; ending of the footnote.
(when (and end
(< (point) end)
;; Verify match isn't a part of a link.
(not (save-excursion
(goto-char beg)
(let ((linkp
(save-match-data
(org-in-regexp org-bracket-link-regexp))))
(and linkp (< (point) (cdr linkp))))))
;; Verify point doesn't belong to a LaTeX macro.
(not (org-inside-latex-macro-p)))
(list label beg end
;; Definition: ensure this is an inline footnote first.
(and (match-end 2)
(org-trim
(buffer-substring-no-properties
(match-end 0) (1- end)))))))))
positions, and the definition, when inline."
(let ((reference (org-element-context)))
(when (eq 'footnote-reference (org-element-type reference))
(let ((end (save-excursion
(goto-char (org-element-property :end reference))
(skip-chars-backward " \t")
(point))))
(when (< (point) end)
(list (org-element-property :label reference)
(org-element-property :begin reference)
end
(and (eq 'inline (org-element-property :type reference))
(buffer-substring-no-properties
(org-element-property :contents-begin reference)
(org-element-property :contents-end
reference)))))))))
(defun org-footnote-at-definition-p ()
"Is point within a footnote definition?
"Non-nil if point is within a footnote definition.
This matches only pure definitions like [1] or [fn:name] at the
This matches only pure definitions like [fn:name] at the
beginning of a line. It does not match references like
\[fn:name:definition], where the footnote text is included and
defined locally.
The return value will be nil if not at a footnote definition, and
The return value is nil if not at a footnote definition, and
a list with label, start, end and definition of the footnote
otherwise."
(when (save-excursion (beginning-of-line) (org-footnote-in-valid-context-p))
(save-excursion
(end-of-line)
;; Footnotes definitions are separated by new headlines, another
;; footnote definition or 2 blank lines.
(let ((lim (save-excursion
(re-search-backward
(concat org-outline-regexp-bol
"\\|^\\([ \t]*\n\\)\\{2,\\}") nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
(let ((label (match-string-no-properties 1))
(beg (match-beginning 0))
(beg-def (match-end 0))
(end (if (progn
(end-of-line)
(re-search-forward
(concat org-outline-regexp-bol "\\|"
org-footnote-definition-re "\\|"
"^\\([ \t]*\n\\)\\{2,\\}") nil 'move))
(match-beginning 0)
(point))))
(list label beg end
(org-trim (buffer-substring-no-properties beg-def end)))))))))
(pcase (org-element-lineage (org-element-at-point) '(footnote-definition) t)
(`nil nil)
(definition
(let* ((label (org-element-property :label definition))
(begin (org-element-property :post-affiliated definition))
(end (save-excursion
(goto-char (org-element-property :end definition))
(skip-chars-backward " \r\t\n")
(line-beginning-position 2)))
(contents-begin (org-element-property :contents-begin definition))
(contents-end (org-element-property :contents-end definition))
(contents
(if (not contents-begin) ""
(org-trim
(buffer-substring-no-properties contents-begin
contents-end)))))
(list label begin end contents)))))
;;;; Internal functions
@ -313,23 +293,23 @@ otherwise."
(defun org-footnote--clear-footnote-section ()
"Remove all footnote sections in buffer and create a new one.
New section is created at the end of the buffer, before any file
local variable definition. Leave point within the new section."
New section is created at the end of the buffer. Leave point
within the new section."
(when org-footnote-section
(goto-char (point-min))
(let ((regexp
(format "^\\*+ +%s[ \t]*$"
(regexp-quote org-footnote-section))))
(let ((regexp (format "^\\*+ +%s[ \t]*$"
(regexp-quote org-footnote-section))))
(while (re-search-forward regexp nil t)
(delete-region
(match-beginning 0)
(progn (org-end-of-subtree t t)
(if (not (eobp)) (point)
(org-footnote--goto-local-insertion-point)
(skip-chars-forward " \t\n")
(if (eobp) (point) (line-beginning-position)))))))
(org-end-of-subtree t t))))
(goto-char (point-max))
(org-footnote--goto-local-insertion-point)
;; Clean-up blank lines at the end of the buffer.
(skip-chars-backward " \r\t\n")
(unless (bobp)
(forward-line)
(when (eolp) (insert "\n")))
(delete-region (point) (point-max))
(when (and (cdr (assq 'heading org-blank-before-new-entry))
(zerop (save-excursion (org-back-over-empty-lines))))
(insert "\n"))
@ -448,14 +428,8 @@ while collecting them."
"Find insertion point for footnote, just before next outline heading.
Assume insertion point is within currently accessible part of the buffer."
(org-with-limited-levels (outline-next-heading))
;; Skip file local variables. See `modify-file-local-variable'.
(when (eobp)
(let ((case-fold-search t))
(re-search-backward "^[ \t]*# +Local Variables:"
(max (- (point-max) 3000) (point-min))
t)))
(skip-chars-backward " \t\n")
(forward-line)
(unless (bobp) (forward-line))
(unless (bolp) (insert "\n")))
@ -470,16 +444,15 @@ the buffer position bounding the search.
Return value is a list like those provided by `org-footnote-at-reference-p'.
If no footnote is found, return nil."
(save-excursion
(let* ((label-fmt (if label (format "\\[fn:%s[]:]" label) org-footnote-re)))
(catch 'exit
(while t
(unless (funcall (if backward #'re-search-backward #'re-search-forward)
label-fmt limit t)
(throw 'exit nil))
(let ((label-regexp (if label (format "\\[fn:%s[]:]" label) org-footnote-re)))
(catch :exit
(save-excursion
(while (funcall (if backward #'re-search-backward #'re-search-forward)
label-regexp limit t)
(unless backward (backward-char))
(let ((ref (org-footnote-at-reference-p)))
(when ref (throw 'exit ref))))))))
(pcase (org-footnote-at-reference-p)
(`nil nil)
(reference (throw :exit reference))))))))
(defun org-footnote-next-reference-or-definition (limit)
"Move point to next footnote reference or definition.
@ -488,8 +461,10 @@ LIMIT is the buffer position bounding the search.
Return value is a list like those provided by
`org-footnote-at-reference-p' or `org-footnote-at-definition-p'.
If no footnote is found, return nil."
(let* (ref (origin (point)))
If no footnote is found, return nil.
This function is meant to be used for fontification only."
(let ((origin (point)))
(catch 'exit
(while t
(unless (re-search-forward org-footnote-re limit t)
@ -499,15 +474,56 @@ If no footnote is found, return nil."
;; the closing square bracket.
(backward-char)
(cond
((setq ref (org-footnote-at-reference-p))
(throw 'exit ref))
((and (/= (match-beginning 0) (line-beginning-position))
(let* ((beg (match-beginning 0))
(label (match-string-no-properties 1))
;; Inline footnotes don't end at (match-end 0)
;; as `org-footnote-re' stops just after the
;; second colon. Find the real ending with
;; `scan-sexps', so Org doesn't get fooled by
;; unrelated closing square brackets.
(end (ignore-errors (scan-sexps beg 1))))
(and end
;; Verify match isn't a part of a link.
(not (save-excursion
(goto-char beg)
(let ((linkp
(save-match-data
(org-in-regexp org-link-bracket-re))))
(and linkp (< (point) (cdr linkp))))))
;; Verify point doesn't belong to a LaTeX macro.
(not (org-inside-latex-macro-p))
(throw 'exit
(list label beg end
;; Definition: ensure this is an
;; inline footnote first.
(and (match-end 2)
(org-trim
(buffer-substring-no-properties
(match-end 0) (1- end))))))))))
;; Definition: also grab the last square bracket, matched in
;; `org-footnote-re' for non-inline footnotes.
((save-match-data (org-footnote-at-definition-p))
(let ((end (match-end 0)))
(throw 'exit
(list nil (match-beginning 0)
(if (eq (char-before end) ?\]) end (1+ end)))))))))))
((and (save-excursion
(beginning-of-line)
(save-match-data (org-footnote-in-valid-context-p)))
(save-excursion
(end-of-line)
;; Footnotes definitions are separated by new
;; headlines, another footnote definition or 2 blank
;; lines.
(let ((end (match-end 0))
(lim (save-excursion
(re-search-backward
(concat org-outline-regexp-bol
"\\|^\\([ \t]*\n\\)\\{2,\\}")
nil t))))
(and (re-search-backward org-footnote-definition-re lim t)
(throw 'exit
(list nil
(match-beginning 0)
(if (eq (char-before end) ?\]) end
(1+ end)))))))))
(t nil))))))
(defun org-footnote-goto-definition (label &optional location)
"Move point to the definition of the footnote LABEL.
@ -528,7 +544,7 @@ value if point was successfully moved."
(user-error "Definition is outside narrowed part of buffer")))
(org-mark-ring-push)
(goto-char def-start)
(looking-at (format "\\[fn:%s[]:] ?" (regexp-quote label)))
(looking-at (format "\\[fn:%s[]:]" (regexp-quote label)))
(goto-char (match-end 0))
(org-show-context 'link-search)
(when (derived-mode-p 'org-mode)
@ -540,21 +556,23 @@ value if point was successfully moved."
(defun org-footnote-goto-previous-reference (label)
"Find the first closest (to point) reference of footnote with label LABEL."
(interactive "sLabel: ")
(org-mark-ring-push)
(let ((label (org-footnote-normalize-label label))
ref)
(save-excursion
(setq ref (or (org-footnote-get-next-reference label t)
(org-footnote-get-next-reference label)
(save-restriction
(widen)
(or
(org-footnote-get-next-reference label t)
(org-footnote-get-next-reference label))))))
(if (not ref)
(error "Cannot find reference of footnote %s" label)
(goto-char (nth 1 ref))
(org-show-context 'link-search))))
(let* ((label (org-footnote-normalize-label label))
(reference
(save-excursion
(or (org-footnote-get-next-reference label t)
(org-footnote-get-next-reference label)
(and (buffer-narrowed-p)
(org-with-wide-buffer
(or (org-footnote-get-next-reference label t)
(org-footnote-get-next-reference label)))))))
(start (nth 1 reference)))
(cond ((not reference)
(user-error "Cannot find reference of footnote %S" label))
((or (> start (point-max)) (< start (point-min)))
(user-error "Reference is outside narrowed part of buffer")))
(org-mark-ring-push)
(goto-char start)
(org-show-context 'link-search)))
;;;; Getters
@ -676,21 +694,22 @@ Return buffer position at the beginning of the definition. This
function doesn't move point."
(let ((label (org-footnote-normalize-label label))
electric-indent-mode) ; Prevent wrong indentation.
(org-with-wide-buffer
(cond
((not org-footnote-section) (org-footnote--goto-local-insertion-point))
((save-excursion
(goto-char (point-min))
(re-search-forward
(concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$")
nil t))
(goto-char (match-end 0))
(forward-line)
(unless (bolp) (insert "\n")))
(t (org-footnote--clear-footnote-section)))
(when (zerop (org-back-over-empty-lines)) (insert "\n"))
(insert "[fn:" label "] \n")
(line-beginning-position 0))))
(org-preserve-local-variables
(org-with-wide-buffer
(cond
((not org-footnote-section) (org-footnote--goto-local-insertion-point))
((save-excursion
(goto-char (point-min))
(re-search-forward
(concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$")
nil t))
(goto-char (match-end 0))
(forward-line)
(unless (bolp) (insert "\n")))
(t (org-footnote--clear-footnote-section)))
(when (zerop (org-back-over-empty-lines)) (insert "\n"))
(insert "[fn:" label "] \n")
(line-beginning-position 0)))))
(defun org-footnote-delete-references (label)
"Delete every reference to footnote LABEL.
@ -733,31 +752,32 @@ and all references of a footnote label.
If LABEL is non-nil, delete that footnote instead."
(catch 'done
(let* ((nref 0) (ndef 0) x
;; 1. Determine LABEL of footnote at point.
(label (cond
;; LABEL is provided as argument.
(label)
;; Footnote reference at point. If the footnote is
;; anonymous, delete it and exit instead.
((setq x (org-footnote-at-reference-p))
(or (car x)
(progn
(delete-region (nth 1 x) (nth 2 x))
(message "Anonymous footnote removed")
(throw 'done t))))
;; Footnote definition at point.
((setq x (org-footnote-at-definition-p))
(car x))
(t (error "Don't know which footnote to remove")))))
;; 2. Now that LABEL is non-nil, find every reference and every
;; definition, and delete them.
(setq nref (org-footnote-delete-references label)
ndef (org-footnote-delete-definitions label))
;; 3. Verify consistency of footnotes and notify user.
(org-footnote-auto-adjust-maybe)
(message "%d definition(s) of and %d reference(s) of footnote %s removed"
ndef nref label))))
(org-preserve-local-variables
(let* ((nref 0) (ndef 0) x
;; 1. Determine LABEL of footnote at point.
(label (cond
;; LABEL is provided as argument.
(label)
;; Footnote reference at point. If the footnote is
;; anonymous, delete it and exit instead.
((setq x (org-footnote-at-reference-p))
(or (car x)
(progn
(delete-region (nth 1 x) (nth 2 x))
(message "Anonymous footnote removed")
(throw 'done t))))
;; Footnote definition at point.
((setq x (org-footnote-at-definition-p))
(car x))
(t (error "Don't know which footnote to remove")))))
;; 2. Now that LABEL is non-nil, find every reference and every
;; definition, and delete them.
(setq nref (org-footnote-delete-references label)
ndef (org-footnote-delete-definitions label))
;; 3. Verify consistency of footnotes and notify user.
(org-footnote-auto-adjust-maybe)
(message "%d definition(s) of and %d reference(s) of footnote %s removed"
ndef nref label)))))
;;;; Sorting, Renumbering, Normalizing
@ -765,28 +785,25 @@ If LABEL is non-nil, delete that footnote instead."
(defun org-footnote-renumber-fn:N ()
"Order numbered footnotes into a sequence in the document."
(interactive)
(let ((references (org-footnote--collect-references)))
(unwind-protect
(let* ((c 0)
(references (cl-remove-if-not
(lambda (r) (string-match-p "\\`[0-9]+\\'" (car r)))
references))
(alist (mapcar (lambda (l) (cons l (number-to-string (cl-incf c))))
(delete-dups (mapcar #'car references)))))
(org-with-wide-buffer
;; Re-number references.
(dolist (ref references)
(goto-char (nth 1 ref))
(org-footnote--set-label (cdr (assoc (nth 0 ref) alist))))
;; Re-number definitions.
(goto-char (point-min))
(while (re-search-forward "^\\[fn:\\([0-9]+\\)\\]" nil t)
(replace-match (or (cdr (assoc (match-string 1) alist))
;; Un-referenced definitions get
;; higher numbers.
(number-to-string (cl-incf c)))
nil nil nil 1))))
(dolist (r references) (set-marker (nth 1 r) nil)))))
(let* ((c 0)
(references (cl-remove-if-not
(lambda (r) (string-match-p "\\`[0-9]+\\'" (car r)))
(org-footnote--collect-references)))
(alist (mapcar (lambda (l) (cons l (number-to-string (cl-incf c))))
(delete-dups (mapcar #'car references)))))
(org-with-wide-buffer
;; Re-number references.
(dolist (ref references)
(goto-char (nth 1 ref))
(org-footnote--set-label (cdr (assoc (nth 0 ref) alist))))
;; Re-number definitions.
(goto-char (point-min))
(while (re-search-forward "^\\[fn:\\([0-9]+\\)\\]" nil t)
(replace-match (or (cdr (assoc (match-string 1) alist))
;; Un-referenced definitions get higher
;; numbers.
(number-to-string (cl-incf c)))
nil nil nil 1)))))
(defun org-footnote-sort ()
"Rearrange footnote definitions in the current buffer.
@ -795,129 +812,121 @@ references. Also relocate definitions at the end of their
relative section or within a single footnote section, according
to `org-footnote-section'. Inline definitions are ignored."
(let ((references (org-footnote--collect-references)))
(unwind-protect
(let ((definitions (org-footnote--collect-definitions 'delete)))
(org-with-wide-buffer
(org-footnote--clear-footnote-section)
;; Insert footnote definitions at the appropriate location,
;; separated by a blank line. Each definition is inserted
;; only once throughout the buffer.
(let (inserted)
(dolist (cell references)
(let ((label (car cell))
(nested (not (nth 2 cell)))
(inline (nth 3 cell)))
(unless (or (member label inserted) inline)
(push label inserted)
(unless (or org-footnote-section nested)
;; If `org-footnote-section' is non-nil, or
;; reference is nested, point is already at the
;; correct position. Otherwise, move at the
;; appropriate location within the section
;; containing the reference.
(goto-char (nth 1 cell))
(org-footnote--goto-local-insertion-point))
(insert "\n"
(or (cdr (assoc label definitions))
(format "[fn:%s] DEFINITION NOT FOUND." label))
"\n"))))
;; Insert un-referenced footnote definitions at the end.
(let ((unreferenced
(cl-remove-if (lambda (d) (member (car d) inserted))
definitions)))
(dolist (d unreferenced) (insert "\n" (cdr d) "\n"))))))
;; Clear dangling markers in the buffer.
(dolist (r references) (set-marker (nth 1 r) nil)))))
(org-preserve-local-variables
(let ((definitions (org-footnote--collect-definitions 'delete)))
(org-with-wide-buffer
(org-footnote--clear-footnote-section)
;; Insert footnote definitions at the appropriate location,
;; separated by a blank line. Each definition is inserted
;; only once throughout the buffer.
(let (inserted)
(dolist (cell references)
(let ((label (car cell))
(nested (not (nth 2 cell)))
(inline (nth 3 cell)))
(unless (or (member label inserted) inline)
(push label inserted)
(unless (or org-footnote-section nested)
;; If `org-footnote-section' is non-nil, or
;; reference is nested, point is already at the
;; correct position. Otherwise, move at the
;; appropriate location within the section
;; containing the reference.
(goto-char (nth 1 cell))
(org-footnote--goto-local-insertion-point))
(insert "\n"
(or (cdr (assoc label definitions))
(format "[fn:%s] DEFINITION NOT FOUND." label))
"\n"))))
;; Insert un-referenced footnote definitions at the end.
(pcase-dolist (`(,label . ,definition) definitions)
(unless (member label inserted)
(insert "\n" definition "\n")))))))))
(defun org-footnote-normalize ()
"Turn every footnote in buffer into a numbered one."
(interactive)
(let ((references (org-footnote--collect-references 'anonymous)))
(unwind-protect
(let ((n 0)
(translations nil)
(definitions nil))
(org-with-wide-buffer
;; Update label for reference. We need to do this before
;; clearing definitions in order to rename nested footnotes
;; before they are deleted.
(dolist (cell references)
(let* ((label (car cell))
(anonymous (not label))
(new
(cond
;; In order to differentiate anonymous
;; references from regular ones, set their
;; labels to integers, not strings.
(anonymous (setcar cell (cl-incf n)))
((cdr (assoc label translations)))
(t (let ((l (number-to-string (cl-incf n))))
(push (cons label l) translations)
l)))))
(goto-char (nth 1 cell)) ; Move to reference's start.
(org-footnote--set-label
(if anonymous (number-to-string new) new))
(let ((size (nth 3 cell)))
;; Transform inline footnotes into regular references
;; and retain their definition for later insertion as
;; a regular footnote definition.
(when size
(let ((def (concat
(format "[fn:%s] " new)
(org-trim
(substring
(delete-and-extract-region
(point) (+ (point) size 1))
1)))))
(push (cons (if anonymous new label) def) definitions)
(when org-footnote-fill-after-inline-note-extraction
(org-fill-paragraph)))))))
;; Collect definitions. Update labels according to ALIST.
(let ((definitions
(nconc definitions
(org-footnote--collect-definitions 'delete)))
(inserted))
(org-footnote--clear-footnote-section)
(dolist (cell references)
(let* ((label (car cell))
(anonymous (integerp label))
(pos (nth 1 cell)))
;; Move to appropriate location, if required. When
;; there is a footnote section or reference is
;; nested, point is already at the expected location.
(unless (or org-footnote-section (not (nth 2 cell)))
(goto-char pos)
(org-footnote--goto-local-insertion-point))
;; Insert new definition once label is updated.
(unless (member label inserted)
(push label inserted)
(let ((stored (cdr (assoc label definitions)))
;; Anonymous footnotes' label is already
;; up-to-date.
(new (if anonymous label
(cdr (assoc label translations)))))
(insert "\n"
(cond
((not stored)
(format "[fn:%s] DEFINITION NOT FOUND." new))
(anonymous stored)
(t
(replace-regexp-in-string
"\\`\\[fn:\\(.*?\\)\\]" new stored nil nil 1)))
"\n")))))
;; Insert un-referenced footnote definitions at the end.
(let ((unreferenced
(cl-remove-if (lambda (d) (member (car d) inserted))
definitions)))
(dolist (d unreferenced)
(insert "\n"
(replace-regexp-in-string
org-footnote-definition-re
(format "[fn:%d]" (cl-incf n))
(cdr d))
"\n"))))))
;; Clear dangling markers.
(dolist (r references) (set-marker (nth 1 r) nil)))))
(org-preserve-local-variables
(let ((n 0)
(translations nil)
(definitions nil)
(references (org-footnote--collect-references 'anonymous)))
(org-with-wide-buffer
;; Update label for reference. We need to do this before
;; clearing definitions in order to rename nested footnotes
;; before they are deleted.
(dolist (cell references)
(let* ((label (car cell))
(anonymous (not label))
(new
(cond
;; In order to differentiate anonymous references
;; from regular ones, set their labels to integers,
;; not strings.
(anonymous (setcar cell (cl-incf n)))
((cdr (assoc label translations)))
(t (let ((l (number-to-string (cl-incf n))))
(push (cons label l) translations)
l)))))
(goto-char (nth 1 cell)) ; Move to reference's start.
(org-footnote--set-label
(if anonymous (number-to-string new) new))
(let ((size (nth 3 cell)))
;; Transform inline footnotes into regular references and
;; retain their definition for later insertion as
;; a regular footnote definition.
(when size
(let ((def (concat
(format "[fn:%s] " new)
(org-trim
(substring
(delete-and-extract-region
(point) (+ (point) size 1))
1)))))
(push (cons (if anonymous new label) def) definitions)
(when org-footnote-fill-after-inline-note-extraction
(org-fill-paragraph)))))))
;; Collect definitions. Update labels according to ALIST.
(let ((definitions
(nconc definitions
(org-footnote--collect-definitions 'delete)))
(inserted))
(org-footnote--clear-footnote-section)
(dolist (cell references)
(let* ((label (car cell))
(anonymous (integerp label))
(pos (nth 1 cell)))
;; Move to appropriate location, if required. When there
;; is a footnote section or reference is nested, point is
;; already at the expected location.
(unless (or org-footnote-section (not (nth 2 cell)))
(goto-char pos)
(org-footnote--goto-local-insertion-point))
;; Insert new definition once label is updated.
(unless (member label inserted)
(push label inserted)
(let ((stored (cdr (assoc label definitions)))
;; Anonymous footnotes' label is already
;; up-to-date.
(new (if anonymous label
(cdr (assoc label translations)))))
(insert "\n"
(cond
((not stored)
(format "[fn:%s] DEFINITION NOT FOUND." new))
(anonymous stored)
(t
(replace-regexp-in-string
"\\`\\[fn:\\(.*?\\)\\]" new stored nil nil 1)))
"\n")))))
;; Insert un-referenced footnote definitions at the end.
(pcase-dolist (`(,label . ,definition) definitions)
(unless (member label inserted)
(insert "\n"
(replace-regexp-in-string org-footnote-definition-re
(format "[fn:%d]" (cl-incf n))
definition)
"\n"))))))))
(defun org-footnote-auto-adjust-maybe ()
"Renumber and/or sort footnotes according to user settings."

312
lisp/org/org-goto.el Normal file
View file

@ -0,0 +1,312 @@
;;; org-goto.el --- Fast navigation in an Org buffer -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'org-macs)
(require 'org-compat)
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-beginning-of-line "org" (&optional n))
(declare-function org-defkey "org" (keymap key def))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-overview "org" ())
(declare-function org-refile-check-position "org" (refile-pointer))
(declare-function org-refile-get-location "org" (&optional prompt default-buffer new-nodes))
(declare-function org-show-context "org" (&optional key))
(declare-function org-show-set-visibility "org" (detail))
(defvar org-complex-heading-regexp)
(defvar org-startup-align-all-tables)
(defvar org-startup-folded)
(defvar org-startup-truncated)
(defvar org-special-ctrl-a/e)
(defvar org-refile-target-verify-function)
(defvar org-refile-use-outline-path)
(defvar org-refile-targets)
(defvar org-goto-exit-command nil)
(defvar org-goto-map nil)
(defvar org-goto-marker nil)
(defvar org-goto-selected-point nil)
(defvar org-goto-start-pos nil)
(defvar org-goto-window-configuration nil)
(defconst org-goto-local-auto-isearch-map (make-sparse-keymap))
(set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map)
(defconst org-goto-help
"Browse buffer copy, to find location or copy text.%s
RET=jump to location C-g=quit and return to previous location
\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
;;; Customization
(defgroup org-goto nil
"Options concerning Org Goto navigation interface."
:tag "Org Goto"
:group 'org)
(defcustom org-goto-interface 'outline
"The default interface to be used for `org-goto'.
Allowed values are:
`outline'
The interface shows an outline of the relevant file and the
correct heading is found by moving through the outline or by
searching with incremental search.
`outline-path-completion'
Headlines in the current buffer are offered via completion.
This is the interface also used by the refile command."
:group 'org-goto
:type '(choice
(const :tag "Outline" outline)
(const :tag "Outline-path-completion" outline-path-completion)))
(defcustom org-goto-max-level 5
"Maximum target level when running `org-goto' with refile interface."
:group 'org-goto
:type 'integer)
(defcustom org-goto-auto-isearch t
"Non-nil means typing characters in `org-goto' starts incremental search.
When nil, you can use these keybindings to navigate the buffer:
q Quit the Org Goto interface
n Go to the next visible heading
p Go to the previous visible heading
f Go one heading forward on same level
b Go one heading backward on same level
u Go one heading up"
:group 'org-goto
:type 'boolean)
;;; Internal functions
(defun org-goto--set-map ()
"Set the keymap `org-goto'."
(setq org-goto-map
(let ((map (make-sparse-keymap)))
(let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command
mouse-drag-region universal-argument org-occur)))
(dolist (cmd cmds)
(substitute-key-definition cmd cmd map global-map)))
(suppress-keymap map)
(org-defkey map "\C-m" 'org-goto-ret)
(org-defkey map [(return)] 'org-goto-ret)
(org-defkey map [(left)] 'org-goto-left)
(org-defkey map [(right)] 'org-goto-right)
(org-defkey map [(control ?g)] 'org-goto-quit)
(org-defkey map "\C-i" 'org-cycle)
(org-defkey map [(tab)] 'org-cycle)
(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)
(org-defkey map "n" 'outline-next-visible-heading)
(org-defkey map "p" 'outline-previous-visible-heading)
(org-defkey map "f" 'outline-forward-same-level)
(org-defkey map "b" 'outline-backward-same-level)
(org-defkey map "u" 'outline-up-heading))
(org-defkey map "/" 'org-occur)
(org-defkey map "\C-c\C-n" 'outline-next-visible-heading)
(org-defkey map "\C-c\C-p" 'outline-previous-visible-heading)
(org-defkey map "\C-c\C-f" 'outline-forward-same-level)
(org-defkey map "\C-c\C-b" 'outline-backward-same-level)
(org-defkey map "\C-c\C-u" 'outline-up-heading)
map)))
;; `isearch-other-control-char' was removed in Emacs 24.4.
(if (fboundp 'isearch-other-control-char)
(progn
(define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char)
(define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char))
(define-key org-goto-local-auto-isearch-map "\C-i" nil)
(define-key org-goto-local-auto-isearch-map "\C-m" nil)
(define-key org-goto-local-auto-isearch-map [return] nil))
(defun org-goto--local-search-headings (string bound noerror)
"Search and make sure that any matches are in headlines."
(catch 'return
(while (if isearch-forward
(search-forward string bound noerror)
(search-backward string bound noerror))
(when (save-match-data
(and (save-excursion
(beginning-of-line)
(looking-at org-complex-heading-regexp))
(or (not (match-beginning 5))
(< (point) (match-beginning 5)))))
(throw 'return (point))))))
(defun org-goto-local-auto-isearch ()
"Start isearch."
(interactive)
(let ((keys (this-command-keys)))
(when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char)
(isearch-mode t)
(isearch-process-search-char (string-to-char keys))
(org-font-lock-ensure))))
(defun org-goto-ret (&optional _arg)
"Finish `org-goto' by going to the new location."
(interactive "P")
(setq org-goto-selected-point (point))
(setq org-goto-exit-command 'return)
(throw 'exit nil))
(defun org-goto-left ()
"Finish `org-goto' by going to the new location."
(interactive)
(if (org-at-heading-p)
(progn
(beginning-of-line 1)
(setq org-goto-selected-point (point)
org-goto-exit-command 'left)
(throw 'exit nil))
(user-error "Not on a heading")))
(defun org-goto-right ()
"Finish `org-goto' by going to the new location."
(interactive)
(if (org-at-heading-p)
(progn
(setq org-goto-selected-point (point)
org-goto-exit-command 'right)
(throw 'exit nil))
(user-error "Not on a heading")))
(defun org-goto-quit ()
"Finish `org-goto' without cursor motion."
(interactive)
(setq org-goto-selected-point nil)
(setq org-goto-exit-command 'quit)
(throw 'exit nil))
;;; Public API
;;;###autoload
(defun org-goto-location (&optional _buf help)
"Let the user select a location in current buffer.
This function uses a recursive edit. It returns the selected
position or nil."
(org-no-popups
(let ((isearch-mode-map org-goto-local-auto-isearch-map)
(isearch-hide-immediately nil)
(isearch-search-fun-function
(lambda () #'org-goto--local-search-headings))
(help (or help org-goto-help)))
(save-excursion
(save-window-excursion
(delete-other-windows)
(and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
(pop-to-buffer-same-window
(condition-case nil
(make-indirect-buffer (current-buffer) "*org-goto*")
(error (make-indirect-buffer (current-buffer) "*org-goto*"))))
(let (temp-buffer-show-function temp-buffer-show-hook)
(with-output-to-temp-buffer "*Org Help*"
(princ (format help (if org-goto-auto-isearch
" 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*"))
(setq buffer-read-only nil)
(let ((org-startup-truncated t)
(org-startup-folded nil)
(org-startup-align-all-tables nil))
(org-mode)
(org-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)))
(goto-char (point-min)))
(let (org-special-ctrl-a/e) (org-beginning-of-line))
(message "Select location and press RET")
(use-local-map org-goto-map)
(recursive-edit)))
(kill-buffer "*org-goto*")
(cons org-goto-selected-point org-goto-exit-command))))
;;;###autoload
(defun org-goto (&optional alternative-interface)
"Look up a different location in the current file, keeping current visibility.
When you want look-up or go to a different location in a
document, the fastest way is often to fold the entire buffer and
then dive into the tree. This method has the disadvantage, that
the previous location will be folded, which may not be what you
want.
This command works around this by showing a copy of the current
buffer in an indirect buffer, in overview mode. You can dive
into the tree in that copy, use org-occur and incremental search
to find a location. When pressing RET or `Q', the command
returns to the original buffer in which the visibility is still
unchanged. After RET it will also jump to the location selected
in the indirect buffer and expose the headline hierarchy above.
With a prefix argument, use the alternative interface: e.g., if
`org-goto-interface' is `outline' use `outline-path-completion'."
(interactive "P")
(org-goto--set-map)
(let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
(org-refile-use-outline-path t)
(org-refile-target-verify-function nil)
(interface
(if (not alternative-interface)
org-goto-interface
(if (eq org-goto-interface 'outline)
'outline-path-completion
'outline)))
(org-goto-start-pos (point))
(selected-point
(if (eq interface 'outline) (car (org-goto-location))
(let ((pa (org-refile-get-location "Goto")))
(org-refile-check-position pa)
(nth 3 pa)))))
(if selected-point
(progn
(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)))
(message "Quit"))))
(provide 'org-goto)
;;; org-goto.el ends here

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

@ -89,6 +89,21 @@ It will be green even if it was done after the deadline."
:group 'org-habit
:type 'boolean)
(defcustom org-habit-scheduled-past-days nil
"Value to use instead of `org-scheduled-past-days', for habits only.
If nil, `org-scheduled-past-days' is used.
Setting this to say 10000 is a way to make habits always show up
as a reminder, even if you set `org-scheduled-past-days' to a
small value because you regard scheduled items as a way of
\"turning on\" TODO items on a particular date, rather than as a
means of creating calendar-based reminders."
:group 'org-habit
:type '(choice integer (const nil))
:package-version '(Org . "9.3")
:safe (lambda (v) (or (integerp v) (null v))))
(defface org-habit-clear-face
'((((background light)) (:background "#8270f9"))
(((background dark)) (:background "blue")))
@ -373,31 +388,30 @@ current time."
(throw :exit s))))))))))
donep)))
markedp face)
(if donep
(let ((done-time (time-add
starting
(days-to-time
(- start (time-to-days starting))))))
(aset graph index org-habit-completed-glyph)
(setq markedp t)
(put-text-property
index (1+ index) 'help-echo
(format-time-string (org-time-stamp-format) done-time) graph)
(while (and done-dates
(= start (car done-dates)))
(setq last-done-date (car done-dates)
done-dates (cdr done-dates))))
(if todayp
(aset graph index org-habit-today-glyph)))
(cond
(donep
(aset graph index org-habit-completed-glyph)
(setq markedp t)
(while (and done-dates (= start (car done-dates)))
(setq last-done-date (car done-dates))
(setq done-dates (cdr done-dates))))
(todayp
(aset graph index org-habit-today-glyph)))
(setq face (if (or in-the-past-p todayp)
(car faces)
(cdr faces)))
(if (and in-the-past-p
(not (eq face 'org-habit-overdue-face))
(not markedp))
(setq face (cdr faces)))
(put-text-property index (1+ index) 'face face graph))
(when (and in-the-past-p
(not (eq face 'org-habit-overdue-face))
(not markedp))
(setq face (cdr faces)))
(put-text-property index (1+ index) 'face face graph)
(put-text-property index (1+ index)
'help-echo
(concat (format-time-string
(org-time-stamp-format)
(time-add starting (days-to-time (- start (time-to-days starting)))))
(if donep " DONE" ""))
graph))
(setq start (1+ start)
index (1+ index)))
graph))
@ -406,7 +420,8 @@ current time."
"Insert consistency graph for any habitual tasks."
(let ((inhibit-read-only t)
(buffer-invisibility-spec '(org-link))
(moment (time-since (* 3600 org-extend-today-until))))
(moment (org-time-subtract nil
(* 3600 org-extend-today-until))))
(save-excursion
(goto-char (if line (point-at-bol) (point-min)))
(while (not (eobp))
@ -421,7 +436,7 @@ current time."
habit
(time-subtract moment (days-to-time org-habit-preceding-days))
moment
(time-add moment (days-to-time org-habit-following-days))))))
(time-add moment (days-to-time org-habit-following-days))))))
(forward-line)))))
(defun org-habit-toggle-habits ()
@ -434,7 +449,18 @@ current time."
(message "Habits turned %s"
(if org-habit-show-habits "on" "off")))
(org-defkey org-agenda-mode-map "K" 'org-habit-toggle-habits)
(defun org-habit-toggle-display-in-agenda (arg)
"Toggle display of habits in agenda.
With ARG toggle display of all vs. undone scheduled habits.
See `org-habit-show-all-today'."
(interactive "P")
(if (not arg)
(org-habit-toggle-habits)
(org-agenda-check-type t 'agenda)
(setq org-habit-show-all-today (not org-habit-show-all-today))
(when org-habit-show-habits (org-agenda-redo))))
(org-defkey org-agenda-mode-map "K" 'org-habit-toggle-display-in-agenda)
(provide 'org-habit)

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

@ -71,8 +71,11 @@
;;; Code:
(require 'org)
(require 'ol)
(declare-function message-make-fqdn "message" ())
(declare-function org-goto-location "org-goto" (&optional _buf help))
(declare-function org-link-set-parameters "ol" (type &rest rest))
;;; Customization
@ -139,11 +142,15 @@ org Org's own internal method, using an encoding of the current time to
uuid Create random (version 4) UUIDs. If the program defined in
`org-id-uuid-program' is available it is used to create the ID.
Otherwise an internal functions is used."
Otherwise an internal functions is used.
ts Create ID's based on ISO8601 timestamps (without separators
and without timezone, local time). Precision down to seconds."
:group 'org-id
:type '(choice
(const :tag "Org's internal method" org)
(const :tag "external: uuidgen" uuid)))
(const :tag "external: uuidgen" uuid)
(const :tag "ISO8601 timestamp" ts)))
(defcustom org-id-prefix nil
"The prefix for IDs.
@ -160,7 +167,7 @@ to have no space characters in them."
"Non-nil means add the domain name to new IDs.
This ensures global uniqueness of IDs, and is also suggested by
the relevant RFCs. This is relevant only if `org-id-method' is
`org'. When uuidgen is used, the domain will never be added.
`org' or `ts'. When uuidgen is used, the domain will never be added.
The default is to not use this because we have no really good way to get
the true domain, and Org entries will normally not be shared with enough
@ -188,6 +195,22 @@ This variable is only relevant when `org-id-track-globally' is set."
:group 'org-id
:type 'file)
(defcustom org-id-locations-file-relative nil
"Determines if org-id-locations should be stored as relative links.
Non-nil means that links to locations are stored as links
relative to the location of where `org-id-locations-file' is
stored.
Nil means to store absolute paths to files.
This customization is useful when folders are shared across
systems but mounted at different roots. Relative path to
`org-id-locations-file' still has to be maintained across
systems."
:group 'org-id
:type 'boolean
:package-version '(Org . "9.3"))
(defvar org-id-locations nil
"List of files with IDs in those files.")
@ -275,9 +298,9 @@ If necessary, the ID is created."
;;;###autoload
(defun org-id-get-with-outline-drilling ()
"Use an outline-cycling interface to retrieve the ID of an entry.
This only finds entries in the current buffer, using `org-get-location'.
This only finds entries in the current buffer, using `org-goto-location'.
It returns the ID of the entry. If necessary, the ID is created."
(let* ((spos (org-get-location (current-buffer) org-goto-help))
(let* ((spos (org-goto-location))
(pom (and spos (move-marker (make-marker) (car spos)))))
(prog1 (org-id-get pom 'create)
(move-marker pom nil))))
@ -349,6 +372,13 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
(require 'message)
(concat "@" (message-make-fqdn))))))
(setq unique (concat etime postfix))))
((eq org-id-method 'ts)
(let ((ts (format-time-string "%Y%m%dT%H%M%S.%6N"))
(postfix (if org-id-include-domain
(progn
(require 'message)
(concat "@" (message-make-fqdn))))))
(setq unique (concat ts postfix))))
(t (error "Invalid `org-id-method'")))
(concat prefix unique)))
@ -356,7 +386,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
"Return string with random (version 4) UUID."
(let ((rnd (md5 (format "%s%s%s%s%s%s%s"
(random)
(time-convert nil 'list)
(org-time-convert-to-list nil)
(user-uid)
(emacs-pid)
(user-full-name)
@ -418,7 +448,7 @@ using `org-id-decode'."
;; FIXME: If TIME represents N seconds after the epoch, then
;; this encoding assumes 0 <= N < 110075314176 = (* (expt 36 4) 65536),
;; i.e., that TIME is from 1970-01-01 00:00:00 to 5458-02-23 20:09:36 UTC.
(setq time (time-convert time 'list))
(setq time (org-time-convert-to-list nil))
(concat (org-id-int-to-b36 (nth 0 time) 4)
(org-id-int-to-b36 (nth 1 time) 4)
(org-id-int-to-b36 (nth 2 time) 4)))
@ -446,81 +476,56 @@ and TIME is a Lisp time value (HI LO USEC)."
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'.
When FILES is given, scan these files instead."
When FILES is given, scan also these files."
(interactive)
(if (not org-id-track-globally)
(error "Please turn on `org-id-track-globally' if you want to track IDs")
(let* ((org-id-search-archives
(or org-id-search-archives
(and (symbolp org-id-extra-files)
(symbol-value org-id-extra-files)
(member 'agenda-archives org-id-extra-files))))
(files
(or files
(append
;; Agenda files and all associated archives
(org-agenda-files t org-id-search-archives)
;; Explicit extra files
(if (symbolp org-id-extra-files)
(symbol-value org-id-extra-files)
org-id-extra-files)
;; Files associated with live Org buffers
(delq nil
(mapcar (lambda (b)
(with-current-buffer b
(and (derived-mode-p 'org-mode) (buffer-file-name))))
(buffer-list)))
;; All files known to have IDs
org-id-files)))
org-agenda-new-buffers
file nfiles tfile ids reg found id seen (ndup 0))
(when (member 'agenda-archives files)
(setq files (delq 'agenda-archives (copy-sequence files))))
(setq nfiles (length files))
(while (setq file (pop files))
(unless silent
(message "Finding ID locations (%d/%d files): %s"
(- nfiles (length files)) nfiles file))
(setq tfile (file-truename file))
(when (and (file-exists-p file) (not (member tfile seen)))
(push tfile seen)
(setq ids nil)
(with-current-buffer (org-get-agenda-file-buffer file)
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$"
nil t)
(setq id (match-string-no-properties 1))
(if (member id found)
(progn
(message "Duplicate ID \"%s\", also in file %s"
id (or (car (delq
nil
(mapcar
(lambda (x)
(if (member id (cdr x))
(car x)))
reg)))
(buffer-file-name)))
(when (= ndup 0)
(ding)
(sit-for 2))
(setq ndup (1+ ndup)))
(push id found)
(push id ids)))
(push (cons (abbreviate-file-name file) ids) reg))))))
(org-release-buffers org-agenda-new-buffers)
(setq org-agenda-new-buffers nil)
(setq org-id-locations reg)
(let* ((files (delete-dups
(mapcar #'file-truename
(append
;; Agenda files and all associated archives
(org-agenda-files t org-id-search-archives)
;; Explicit extra files
(unless (symbolp org-id-extra-files)
org-id-extra-files)
;; All files known to have IDs
org-id-files
;; function input
files))))
(nfiles (length files))
ids seen-ids (ndup 0) (i 0) file-id-alist)
(with-temp-buffer
(delay-mode-hooks
(org-mode)
(dolist (file files)
(unless silent
(setq i (1+ i))
(message "Finding ID locations (%d/%d files): %s"
i nfiles file))
(when (file-exists-p file)
(insert-file-contents file nil nil nil 'replace)
(setq ids (org-map-entries
(lambda ()
(org-entry-get (point) "ID"))
"ID<>\"\""))
(dolist (id ids)
(if (member id seen-ids)
(progn
(message "Duplicate ID \"%s\"" id)
(setq ndup (1+ ndup)))
(push id seen-ids)))
(when ids
(setq file-id-alist (cons (cons (abbreviate-file-name file) ids)
file-id-alist)))))))
(setq org-id-locations file-id-alist)
(setq org-id-files (mapcar 'car org-id-locations))
(org-id-locations-save) ;; this function can also handle the alist form
(org-id-locations-save)
;; now convert to a hash
(setq org-id-locations (org-id-alist-to-hash org-id-locations))
(if (> ndup 0)
(message "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)
(message "%d unique files scanned for IDs" (length org-id-files)))
(when (> ndup 0)
(warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup))
(message "%d files scanned, %d files contains IDs and in total %d IDs found."
nfiles (length org-id-files) (hash-table-count org-id-locations))
org-id-locations)))
(defun org-id-locations-save ()
@ -529,6 +534,16 @@ When FILES is given, scan these files instead."
(let ((out (if (hash-table-p org-id-locations)
(org-id-hash-to-alist org-id-locations)
org-id-locations)))
(when (and org-id-locations-file-relative out)
(setq out (mapcar
(lambda (item)
(if (file-name-absolute-p (car item))
(cons (file-relative-name
(car item) (file-name-directory
org-id-locations-file))
(cdr item))
item))
out)))
(with-temp-file org-id-locations-file
(let ((print-level nil)
(print-length nil))
@ -542,7 +557,12 @@ When FILES is given, scan these files instead."
(condition-case nil
(progn
(insert-file-contents org-id-locations-file)
(setq org-id-locations (read (current-buffer))))
(setq org-id-locations (read (current-buffer)))
(let ((loc (file-name-directory org-id-locations-file)))
(mapc (lambda (item)
(unless (file-name-absolute-p (car item))
(setf (car item) (expand-file-name (car item) loc))))
org-id-locations)))
(error
(message "Could not read org-id-values from %s. Setting it to nil."
org-id-locations-file))))
@ -552,10 +572,12 @@ When FILES is given, scan these files instead."
(defun org-id-add-location (id file)
"Add the ID with location FILE to the database of ID locations."
;; Only if global tracking is on, and when the buffer has a file
(when (and org-id-track-globally id file)
(unless org-id-locations (org-id-locations-load))
(puthash id (abbreviate-file-name file) org-id-locations)
(add-to-list 'org-id-files (abbreviate-file-name file))))
(let ((afile (abbreviate-file-name file)))
(when (and org-id-track-globally id file)
(unless org-id-locations (org-id-locations-load))
(puthash id afile org-id-locations)
(unless (member afile org-id-files)
(add-to-list 'org-id-files afile)))))
(unless noninteractive
(add-hook 'kill-emacs-hook 'org-id-locations-save))
@ -565,7 +587,7 @@ When FILES is given, scan these files instead."
(let (res x)
(maphash
(lambda (k v)
(if (setq x (member v res))
(if (setq x (assoc v res))
(setcdr x (cons k (cdr x)))
(push (list v k) res)))
hash)
@ -649,7 +671,7 @@ optional argument MARKERP, return the position as a new marker."
(match-string 4)
(match-string 0)))
link))))
(org-store-link-props :link link :description desc :type "id")
(org-link-store-props :link link :description desc :type "id")
link)))
(defun org-id-open (id)

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

@ -150,15 +150,16 @@ useful to make it ever so slightly different."
;; Text line prefixes.
(aset org-indent--text-line-prefixes
n
(concat (org-add-props (make-string (+ n indentation) ?\s)
nil 'face 'org-indent)
(and (> n 0)
(char-to-string org-indent-boundary-char)))))))
(org-add-props
(concat (make-string (+ n indentation) ?\s)
(and (> n 0)
(char-to-string org-indent-boundary-char)))
nil 'face 'org-indent)))))
(defsubst org-indent-remove-properties (beg end)
"Remove indentations between BEG and END."
(org-with-silent-modifications
(remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
(with-silent-modifications
(remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
;;;###autoload
(define-minor-mode org-indent-mode
@ -332,39 +333,39 @@ stopped."
(let* ((case-fold-search t)
(limited-re (org-get-limited-outline-regexp))
(level (or (org-current-level) 0))
(time-limit (and delay (time-add nil delay))))
(time-limit (and delay (org-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).
(org-with-silent-modifications
(while (and (<= (point) end) (not (eobp)))
(cond
;; When in asynchronous mode, check if interrupt is
;; required.
((and delay (input-pending-p)) (throw 'interrupt (point)))
;; 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 (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)
nil #'org-indent-initialize-agent))
(throw 'interrupt (point)))
;; Headline or inline task.
((looking-at org-outline-regexp)
(let* ((nstars (- (match-end 0) (match-beginning 0) 1))
(type (or (looking-at-p limited-re) 'inlinetask)))
(org-indent-set-line-properties nstars 0 type)
;; At an headline, define new value for LEVEL.
(unless (eq type 'inlinetask) (setq level nstars))))
;; List item: `wrap-prefix' is set where body starts.
((org-at-item-p)
(org-indent-set-line-properties
level (org-list-item-body-column (point))))
;; Regular line.
(t
(org-indent-set-line-properties level (org-get-indentation))))))))))
(with-silent-modifications
(while (and (<= (point) end) (not (eobp)))
(cond
;; When in asynchronous mode, check if interrupt is
;; required.
((and delay (input-pending-p)) (throw 'interrupt (point)))
;; 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))
(setq org-indent-agent-resume-timer
(run-with-idle-timer
(time-add (current-idle-time) org-indent-agent-resume-delay)
nil #'org-indent-initialize-agent))
(throw 'interrupt (point)))
;; Headline or inline task.
((looking-at org-outline-regexp)
(let* ((nstars (- (match-end 0) (match-beginning 0) 1))
(type (or (looking-at-p limited-re) 'inlinetask)))
(org-indent-set-line-properties nstars 0 type)
;; At an headline, define new value for LEVEL.
(unless (eq type 'inlinetask) (setq level nstars))))
;; List item: `wrap-prefix' is set where body starts.
((org-at-item-p)
(org-indent-set-line-properties
level (org-list-item-body-column (point))))
;; Regular line.
(t
(org-indent-set-line-properties level (current-indentation))))))))))
(defun org-indent-notify-modified-headline (beg end)
"Set `org-indent-modified-headline-flag' depending on context.

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

@ -40,9 +40,9 @@
;; parent into children.
;;
;; Special fontification of inline tasks, so that they can be
;; immediately recognized. From the stars of the headline, only the
;; first and the last two will be visible, the others will be hidden
;; using the `org-hide' face.
;; immediately recognized. From the stars of the headline, only last
;; two will be visible, the others will be hidden using the `org-hide'
;; face.
;;
;; An inline task is identified solely by a minimum outline level,
;; given by the variable `org-inlinetask-min-level', default 15.
@ -54,14 +54,14 @@
;;
;; As an example, here are two valid inline tasks:
;;
;; **************** TODO a small task
;; **************** TODO A small task
;;
;; and
;;
;; **************** TODO another small task
;; **************** TODO Another small task
;; DEADLINE: <2009-03-30 Mon>
;; :PROPERTIES:
;; :SOMETHING: or other
;; :SOMETHING: another thing
;; :END:
;; And here is some extra text
;; **************** END
@ -123,7 +123,8 @@ default, or nil if no state should be assigned."
(defun org-inlinetask-insert-task (&optional no-state)
"Insert an inline task.
If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'."
If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'.
If there is a region wrap it inside the inline task."
(interactive "P")
;; Error when inside an inline task, except if point was at its very
;; beginning, in which case the new inline task will be inserted
@ -135,13 +136,19 @@ If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'."
(let* ((indent (if org-odd-levels-only
(1- (* 2 org-inlinetask-min-level))
org-inlinetask-min-level))
(indent-string (concat (make-string indent ?*) " ")))
(indent-string (concat (make-string indent ?*) " "))
(rbeg (if (org-region-active-p) (region-beginning) (point)))
(rend (if (org-region-active-p) (region-end) (point))))
(goto-char rend)
(insert "\n" indent-string "END\n")
(goto-char rbeg)
(unless (bolp) (insert "\n"))
(insert indent-string
(if (or no-state (not org-inlinetask-default-state))
"\n"
(concat org-inlinetask-default-state " \n"))
indent-string "END\n"))
(end-of-line -1))
""
(concat org-inlinetask-default-state " "))
(if (= rend rbeg) "" "\n"))
(unless (= rend rbeg) (end-of-line 0))))
(define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)
(defun org-inlinetask-outline-regexp ()
@ -152,24 +159,24 @@ The number of levels is controlled by `org-inlinetask-min-level'."
org-inlinetask-min-level)))
(format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars)))
(defun org-inlinetask-end-p ()
"Return a non-nil value if point is on inline task's END part."
(let ((case-fold-search t))
(org-match-line (concat (org-inlinetask-outline-regexp) "END[ \t]*$"))))
(defun org-inlinetask-at-task-p ()
"Return true if point is at beginning of an inline task."
(save-excursion
(beginning-of-line)
(and (looking-at (concat (org-inlinetask-outline-regexp) "\\(.*\\)"))
(not (string-match "^end[ \t]*$" (downcase (match-string 2)))))))
"Return non-nil if point is at beginning of an inline task."
(and (org-match-line (concat (org-inlinetask-outline-regexp) "\\(.*\\)"))
(not (org-inlinetask-end-p))))
(defun org-inlinetask-in-task-p ()
"Return true if point is inside an inline task."
(save-excursion
(beginning-of-line)
(let* ((case-fold-search t)
(stars-re (org-inlinetask-outline-regexp))
(task-beg-re (concat stars-re "\\(?:.*\\)"))
(task-end-re (concat stars-re "END[ \t]*$")))
(or (looking-at-p task-beg-re)
(let ((case-fold-search t))
(or (looking-at-p (concat (org-inlinetask-outline-regexp) "\\(?:.*\\)"))
(and (re-search-forward "^\\*+[ \t]+" nil t)
(progn (beginning-of-line) (looking-at-p task-end-re)))))))
(org-inlinetask-end-p))))))
(defun org-inlinetask-goto-beginning ()
"Go to the beginning of the inline task at point."
@ -177,7 +184,7 @@ The number of levels is controlled by `org-inlinetask-min-level'."
(let ((case-fold-search t)
(inlinetask-re (org-inlinetask-outline-regexp)))
(re-search-backward inlinetask-re nil t)
(when (looking-at-p (concat inlinetask-re "END[ \t]*$"))
(when (org-inlinetask-end-p)
(re-search-backward inlinetask-re nil t))))
(defun org-inlinetask-goto-end ()
@ -185,16 +192,15 @@ The number of levels is controlled by `org-inlinetask-min-level'."
Return point."
(save-match-data
(beginning-of-line)
(let* ((case-fold-search t)
(inlinetask-re (org-inlinetask-outline-regexp))
(task-end-re (concat inlinetask-re "END[ \t]*$")))
(let ((case-fold-search t)
(inlinetask-re (org-inlinetask-outline-regexp)))
(cond
((looking-at-p task-end-re)
((org-inlinetask-end-p)
(forward-line))
((looking-at-p inlinetask-re)
(forward-line)
(cond
((looking-at-p task-end-re) (forward-line))
((org-inlinetask-end-p) (forward-line))
((looking-at-p inlinetask-re))
((org-inlinetask-in-task-p)
(re-search-forward inlinetask-re nil t)
@ -262,17 +268,6 @@ If the task has an end part, also demote it."
(goto-char beg)
(org-fixup-indentation diff)))))))
(defun org-inlinetask-get-current-indentation ()
"Get the indentation of the last non-while line above this one."
(save-excursion
(beginning-of-line 1)
(skip-chars-backward " \t\n")
(beginning-of-line 1)
(or (org-at-item-p)
(looking-at "[ \t]*"))
(goto-char (match-end 0))
(current-column)))
(defvar org-indent-indentation-per-level) ; defined in org-indent.el
(defface org-inlinetask '((t :inherit shadow))
@ -317,9 +312,8 @@ If the task has an end part, also demote it."
((= end start))
;; Inlinetask was folded: expand it.
((eq (get-char-property (1+ start) 'invisible) 'outline)
(outline-flag-region start end nil)
(org-cycle-hide-drawers 'children))
(t (outline-flag-region start end t)))))
(org-flag-region start end nil 'outline))
(t (org-flag-region start end t 'outline)))))
(defun org-inlinetask-hide-tasks (state)
"Hide inline tasks in buffer when STATE is `contents' or `children'.

924
lisp/org/org-keys.el Normal file
View file

@ -0,0 +1,924 @@
;;; org-keys.el --- Key bindings for Org mode -*- lexical-binding: t; -*-
;; Copyright (C) 2018 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; 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 adds bindings for Org mode buffers. It also
;; implements both Speed keys and Babel speed keys. See manual for
;; details.
;;; Code:
(defvar org-outline-regexp)
(declare-function org-add-note "org" ())
(declare-function org-agenda "org" (&optional arg org-keys restriction))
(declare-function org-agenda-file-to-front "org" (&optional to-end))
(declare-function org-agenda-remove-restriction-lock "org" (&optional noupdate))
(declare-function org-agenda-set-restriction-lock "org" (&optional type))
(declare-function org-archive-subtree "org" (&optional find-done))
(declare-function org-archive-subtree-default "org" ())
(declare-function org-archive-subtree-default-with-confirmation "org" ())
(declare-function org-archive-to-archive-sibling "org" ())
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-attach "org" ())
(declare-function org-backward-element "org" ())
(declare-function org-backward-heading-same-level "org" (arg &optional invisible-ok))
(declare-function org-backward-paragraph "org" ())
(declare-function org-backward-sentence "org" (&optional arg))
(declare-function org-beginning-of-line "org" (&optional n))
(declare-function org-clock-cancel "org" ())
(declare-function org-clock-display "org" (&optional arg))
(declare-function org-clock-goto "org" (&optional select))
(declare-function org-clock-in "org" (&optional select start-time))
(declare-function org-clock-in-last "org" (&optional arg))
(declare-function org-clock-out "org" (&optional switch-to-state fail-quietly at-time))
(declare-function org-clone-subtree-with-time-shift "org" (n &optional shift))
(declare-function org-columns "org" (&optional global columns-fmt-string))
(declare-function org-comment-dwim "org" (arg))
(declare-function org-copy "org" ())
(declare-function org-copy-special "org" ())
(declare-function org-copy-visible "org" (beg end))
(declare-function org-ctrl-c-ctrl-c "org" (&optional arg))
(declare-function org-ctrl-c-minus "org" ())
(declare-function org-ctrl-c-ret "org" ())
(declare-function org-ctrl-c-star "org" ())
(declare-function org-ctrl-c-tab "org" (&optional arg))
(declare-function org-cut-special "org" ())
(declare-function org-cut-subtree "org" (&optional n))
(declare-function org-cycle "org" (&optional arg))
(declare-function org-cycle-agenda-files "org" ())
(declare-function org-date-from-calendar "org" ())
(declare-function org-dynamic-block-insert-dblock "org" (&optional arg))
(declare-function org-dblock-update "org" (&optional arg))
(declare-function org-deadline "org" (arg1 &optional time))
(declare-function org-decrease-number-at-point "org" (&optional inc))
(declare-function org-delete-backward-char "org" (n))
(declare-function org-delete-char "org" (n))
(declare-function org-delete-indentation "org" (&optional arg))
(declare-function org-demote-subtree "org" ())
(declare-function org-display-outline-path "org" (&optional file current separator just-return-string))
(declare-function org-down-element "org" ())
(declare-function org-edit-special "org" (&optional arg))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-type "org-element" (element))
(declare-function org-emphasize "org" (&optional char))
(declare-function org-end-of-line "org" (&optional n))
(declare-function org-entry-put "org" (pom property value))
(declare-function org-eval-in-calendar "org" (form &optional keepdate))
(declare-function org-evaluate-time-range "org" (&optional to-buffer))
(declare-function org-export-dispatch "org" (&optional arg))
(declare-function org-feed-goto-inbox "org" (feed))
(declare-function org-feed-update-all "org" ())
(declare-function org-fill-paragraph "org" (&optional justify region))
(declare-function org-find-file-at-mouse "org" (ev))
(declare-function org-footnote-action "org" (&optional special))
(declare-function org-force-cycle-archived "org" ())
(declare-function org-force-self-insert "org" (n))
(declare-function org-forward-element "org" ())
(declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok))
(declare-function org-forward-paragraph "org" ())
(declare-function org-forward-sentence "org" (&optional arg))
(declare-function org-goto "org" (&optional alternative-interface))
(declare-function org-goto-calendar "org" (&optional arg))
(declare-function org-inc-effort "org" ())
(declare-function org-increase-number-at-point "org" (&optional inc))
(declare-function org-info-find-node "org" (&optional nodename))
(declare-function org-insert-all-links "org" (arg &optional pre post))
(declare-function org-insert-drawer "org" (&optional arg drawer))
(declare-function org-insert-heading-respect-content "org" (&optional invisible-ok))
(declare-function org-insert-last-stored-link "org" (arg))
(declare-function org-insert-link "org" (&optional complete-file link-location default-description))
(declare-function org-insert-structure-template "org" (type))
(declare-function org-insert-todo-heading "org" (arg &optional force-heading))
(declare-function org-insert-todo-heading-respect-content "org" (&optional force-state))
(declare-function org-kill-line "org" (&optional arg))
(declare-function org-kill-note-or-show-branches "org" ())
(declare-function org-list-make-subtree "org" ())
(declare-function org-mark-element "org" ())
(declare-function org-mark-ring-goto "org" (&optional n))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-mark-subtree "org" (&optional up))
(declare-function org-match-sparse-tree "org" (&optional todo-only match))
(declare-function org-meta-return "org" (&optional arg))
(declare-function org-metadown "org" (&optional _arg))
(declare-function org-metaleft "org" (&optional _))
(declare-function org-metaright "org" (&optional _arg))
(declare-function org-metaup "org" (&optional _arg))
(declare-function org-narrow-to-block "org" ())
(declare-function org-narrow-to-element "org" ())
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-next-block "org" (arg &optional backward block-regexp))
(declare-function org-next-link "org" (&optional search-backward))
(declare-function org-next-visible-heading "org" (arg))
(declare-function org-open-at-mouse "org" (ev))
(declare-function org-open-at-point "org" (&optional arg reference-buffer))
(declare-function org-open-line "org" (n))
(declare-function org-paste-special "org" (arg))
(declare-function org-plot/gnuplot "org-plot" (&optional params))
(declare-function org-previous-block "org" (arg &optional block-regexp))
(declare-function org-previous-link "org" ())
(declare-function org-previous-visible-heading "org" (arg))
(declare-function org-priority "org" (&optional action show))
(declare-function org-promote-subtree "org" ())
(declare-function org-redisplay-inline-images "org" ())
(declare-function org-refile "org" (&optional arg1 default-buffer rfloc msg))
(declare-function org-reftex-citation "org" ())
(declare-function org-reload "org" (&optional arg1))
(declare-function org-remove-file "org" (&optional file))
(declare-function org-resolve-clocks "org" (&optional only-dangling-p prompt-fn last-valid))
(declare-function org-return "org" (&optional indent))
(declare-function org-return-indent "org" ())
(declare-function org-reveal "org" (&optional siblings))
(declare-function org-schedule "org" (arg &optional time))
(declare-function org-self-insert-command "org" (N))
(declare-function org-set-effort "org" (&optional increment value))
(declare-function org-set-property "org" (property value))
(declare-function org-set-property-and-value "org" (use-last))
(declare-function org-set-tags-command "org" (&optional arg))
(declare-function org-shiftcontroldown "org" (&optional n))
(declare-function org-shiftcontrolleft "org" ())
(declare-function org-shiftcontrolright "org" ())
(declare-function org-shiftcontrolup "org" (&optional n))
(declare-function org-shiftdown "org" (&optional arg))
(declare-function org-shiftleft "org" (&optional arg))
(declare-function org-shiftmetadown "org" (&optional _arg))
(declare-function org-shiftmetaleft "org" ())
(declare-function org-shiftmetaright "org" ())
(declare-function org-shiftmetaup "org" (&optional arg))
(declare-function org-shiftright "org" (&optional arg))
(declare-function org-shifttab "org" (&optional arg))
(declare-function org-shiftup "org" (&optional arg))
(declare-function org-show-all "org" (&optional types))
(declare-function org-show-children "org" (&optional level))
(declare-function org-show-subtree "org" ())
(declare-function org-sort "org" (&optional with-case))
(declare-function org-sparse-tree "org" (&optional arg type))
(declare-function org-table-blank-field "org" ())
(declare-function org-table-copy-down "org" (n))
(declare-function org-table-create-or-convert-from-region "org" (arg))
(declare-function org-table-create-with-table\.el "org-table" ())
(declare-function org-table-edit-field "org" (arg))
(declare-function org-table-eval-formula "org" (&optional arg equation suppress-align suppress-const suppress-store suppress-analysis))
(declare-function org-table-field-info "org" (arg))
(declare-function org-table-rotate-recalc-marks "org" (&optional newchar))
(declare-function org-table-sum "org" (&optional beg end nlast))
(declare-function org-table-toggle-coordinate-overlays "org" ())
(declare-function org-table-toggle-formula-debugger "org" ())
(declare-function org-time-stamp "org" (arg &optional inactive))
(declare-function org-time-stamp-inactive "org" (&optional arg))
(declare-function org-timer "org" (&optional restart no-insert))
(declare-function org-timer-item "org" (&optional arg))
(declare-function org-timer-pause-or-continue "org" (&optional stop))
(declare-function org-timer-set-timer "org" (&optional opt))
(declare-function org-timer-start "org" (&optional offset))
(declare-function org-timer-stop "org" ())
(declare-function org-todo "org" (&optional arg1))
(declare-function org-toggle-archive-tag "org" (&optional find-done))
(declare-function org-toggle-checkbox "org" (&optional toggle-presence))
(declare-function org-toggle-comment "org" ())
(declare-function org-toggle-fixed-width "org" ())
(declare-function org-toggle-inline-images "org" (&optional include-linked))
(declare-function org-latex-preview "org" (&optional arg))
(declare-function org-toggle-narrow-to-subtree "org" ())
(declare-function org-toggle-ordered-property "org" ())
(declare-function org-toggle-pretty-entities "org" ())
(declare-function org-toggle-tags-groups "org" ())
(declare-function org-toggle-time-stamp-overlays "org" ())
(declare-function org-transpose-element "org" ())
(declare-function org-transpose-words "org" ())
(declare-function org-tree-to-indirect-buffer "org" (&optional arg))
(declare-function org-up-element "org" ())
(declare-function org-update-statistics-cookies "org" (all))
(declare-function org-yank "org" (&optional arg))
(declare-function orgtbl-ascii-plot "org-table" (&optional ask))
;;; Variables
(defvar org-mode-map (make-sparse-keymap)
"Keymap fo Org mode.")
(defcustom org-replace-disputed-keys nil
"Non-nil means use alternative key bindings for some keys.
Org mode uses S-<cursor> keys for changing timestamps and priorities.
These keys are also used by other packages like Shift Select mode,
CUA mode or Windmove. If you want to use Org mode together with
one of these other modes, or more generally if you would like to
move some Org mode commands to other keys, set this variable and
configure the keys with the variable `org-disputed-keys'.
This option is only relevant at load-time of Org mode, and must be set
*before* org.el is loaded. Changing it requires a restart of Emacs to
become effective."
:group 'org-startup
:type 'boolean
:safe #'booleanp)
(defcustom org-use-extra-keys nil
"Non-nil means use extra key sequence definitions for certain commands.
This happens automatically if `window-system' is nil. This
variable lets you do the same manually. You must set it before
loading Org."
:group 'org-startup
:type 'boolean
:safe #'booleanp)
(defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)
(defcustom org-disputed-keys
'(([(shift up)] . [(meta p)])
([(shift down)] . [(meta n)])
([(shift left)] . [(meta -)])
([(shift right)] . [(meta +)])
([(control shift right)] . [(meta shift +)])
([(control shift left)] . [(meta shift -)]))
"Keys for which Org mode and other modes compete.
This is an alist, cars are the default keys, second element specifies
the alternative to use when `org-replace-disputed-keys' is t.
Keys can be specified in any syntax supported by `define-key'.
The value of this option takes effect only at Org mode startup,
therefore you'll have to restart Emacs to apply it after changing."
:group 'org-startup
:type 'alist)
(defcustom org-mouse-1-follows-link
(if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t)
"Non-nil means mouse-1 on a link will follow the link.
A longer mouse click will still set point. Needs to be set
before org.el is loaded."
:group 'org-link-follow
:version "26.1"
:package-version '(Org . "8.3")
:type '(choice
(const :tag "A double click follows the link" double)
(const :tag "Unconditionally follow the link with mouse-1" t)
(integer :tag "mouse-1 click does not follow the link if longer than N ms" 450))
:safe t)
(defcustom org-tab-follows-link nil
"Non-nil means on links TAB will follow the link.
Needs to be set before Org is loaded.
This really should not be used, it does not make sense, and the
implementation is bad."
:group 'org-link-follow
:type 'boolean)
(defcustom org-follow-link-hook nil
"Hook that is run after a link has been followed."
:group 'org-link-follow
:type 'hook)
(defcustom org-return-follows-link nil
"Non-nil means on links RET will follow the link.
In tables, the special behavior of RET has precedence."
:group 'org-link-follow
:type 'boolean
:safe t)
;;; Functions
;;;; Base functions
(defun org-key (key)
"Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
Or return the original if not disputed."
(when org-replace-disputed-keys
(let* ((nkey (key-description key))
(x (cl-find-if (lambda (x) (equal (key-description (car x)) nkey))
org-disputed-keys)))
(setq key (if x (cdr x) key))))
key)
(defun org-defkey (keymap key def)
"Define a key, possibly translated, as returned by `org-key'."
(define-key keymap (org-key key) def))
(defun org-remap (map &rest commands)
"In MAP, remap the functions given in COMMANDS.
COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(let (new old)
(while commands
(setq old (pop commands) new (pop commands))
(org-defkey map (vector 'remap old) new))))
;;; Mouse map
(defvar org-mouse-map (make-sparse-keymap))
(org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse)
(org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse)
(when org-mouse-1-follows-link
(org-defkey org-mouse-map [follow-link] 'mouse-face))
(when org-tab-follows-link
(org-defkey org-mouse-map (kbd "<tab>") #'org-open-at-point)
(org-defkey org-mouse-map (kbd "TAB") #'org-open-at-point))
;;; Read date map
(defvar org-read-date-minibuffer-local-map
(let* ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(org-defkey map (kbd ".")
(lambda () (interactive)
;; Are we at the beginning of the prompt?
(if (looking-back "^[^:]+: "
(let ((inhibit-field-text-motion t))
(line-beginning-position)))
(org-eval-in-calendar '(calendar-goto-today))
(insert "."))))
(org-defkey map (kbd "C-.")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-goto-today))))
(org-defkey map (kbd "M-S-<left>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-backward-month 1))))
(org-defkey map (kbd "ESC S-<left>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-backward-month 1))))
(org-defkey map (kbd "M-S-<right>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-forward-month 1))))
(org-defkey map (kbd "ESC S-<right>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-forward-month 1))))
(org-defkey map (kbd "M-S-<up>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-backward-year 1))))
(org-defkey map (kbd "ESC S-<up>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-backward-year 1))))
(org-defkey map (kbd "M-S-<down>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-forward-year 1))))
(org-defkey map (kbd "ESC S-<down>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-forward-year 1))))
(org-defkey map (kbd "S-<up>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-backward-week 1))))
(org-defkey map (kbd "S-<down>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-forward-week 1))))
(org-defkey map (kbd "S-<left>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-backward-day 1))))
(org-defkey map (kbd "S-<right>")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-forward-day 1))))
(org-defkey map (kbd "!")
(lambda () (interactive)
(org-eval-in-calendar '(diary-view-entries))
(message "")))
(org-defkey map (kbd ">")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-scroll-left 1))))
(org-defkey map (kbd "<")
(lambda () (interactive)
(org-eval-in-calendar '(calendar-scroll-right 1))))
(org-defkey map (kbd "C-v")
(lambda () (interactive)
(org-eval-in-calendar
'(calendar-scroll-left-three-months 1))))
(org-defkey map (kbd "M-v")
(lambda () (interactive)
(org-eval-in-calendar
'(calendar-scroll-right-three-months 1))))
map)
"Keymap for minibuffer commands when using `org-read-date'.")
;;; Global bindings
;;;; Outline functions
(define-key org-mode-map [menu-bar headings] 'undefined)
(define-key org-mode-map [menu-bar hide] 'undefined)
(define-key org-mode-map [menu-bar show] 'undefined)
(define-key org-mode-map [remap outline-mark-subtree] #'org-mark-subtree)
(define-key org-mode-map [remap outline-show-subtree] #'org-show-subtree)
(define-key org-mode-map [remap outline-forward-same-level]
#'org-forward-heading-same-level)
(define-key org-mode-map [remap outline-backward-same-level]
#'org-backward-heading-same-level)
(define-key org-mode-map [remap outline-show-branches]
#'org-kill-note-or-show-branches)
(define-key org-mode-map [remap outline-promote] #'org-promote-subtree)
(define-key org-mode-map [remap outline-demote] #'org-demote-subtree)
(define-key org-mode-map [remap outline-insert-heading] #'org-ctrl-c-ret)
(define-key org-mode-map [remap outline-next-visible-heading]
#'org-next-visible-heading)
(define-key org-mode-map [remap outline-previous-visible-heading]
#'org-previous-visible-heading)
(define-key org-mode-map [remap show-children] #'org-show-children)
;;;; Make `C-c C-x' a prefix key
(org-defkey org-mode-map (kbd "C-c C-x") (make-sparse-keymap))
;;;; TAB key with modifiers
(org-defkey org-mode-map (kbd "C-i") #'org-cycle)
(org-defkey org-mode-map (kbd "<tab>") #'org-cycle)
(org-defkey org-mode-map (kbd "C-<tab>") #'org-force-cycle-archived)
;; Override text-mode binding to expose `complete-symbol' for
;; pcomplete functionality.
(org-defkey org-mode-map (kbd "M-<tab>") nil)
(org-defkey org-mode-map (kbd "M-TAB") nil)
(org-defkey org-mode-map (kbd "ESC <tab>") nil)
(org-defkey org-mode-map (kbd "ESC TAB") nil)
(org-defkey org-mode-map (kbd "<S-iso-leftab>") #'org-shifttab)
(org-defkey org-mode-map (kbd "S-<tab>") #'org-shifttab)
(org-defkey org-mode-map (kbd "S-TAB") #'org-shifttab)
(define-key org-mode-map (kbd "<backtab>") #'org-shifttab)
;;;; RET/<return> key with modifiers
(org-defkey org-mode-map (kbd "S-<return>") #'org-table-copy-down)
(org-defkey org-mode-map (kbd "S-RET") #'org-table-copy-down)
(org-defkey org-mode-map (kbd "M-S-<return>") #'org-insert-todo-heading)
(org-defkey org-mode-map (kbd "M-S-RET") #'org-insert-todo-heading)
(org-defkey org-mode-map (kbd "ESC S-<return>") #'org-insert-todo-heading)
(org-defkey org-mode-map (kbd "ESC S-RET") #'org-insert-todo-heading)
(org-defkey org-mode-map (kbd "M-<return>") #'org-meta-return)
(org-defkey org-mode-map (kbd "M-RET") #'org-meta-return)
(org-defkey org-mode-map (kbd "ESC <return>") #'org-meta-return)
(org-defkey org-mode-map (kbd "ESC RET") #'org-meta-return)
;;;; Cursor keys with modifiers
(org-defkey org-mode-map (kbd "M-<left>") #'org-metaleft)
(org-defkey org-mode-map (kbd "M-<right>") #'org-metaright)
(org-defkey org-mode-map (kbd "ESC <right>") #'org-metaright)
(org-defkey org-mode-map (kbd "M-<up>") #'org-metaup)
(org-defkey org-mode-map (kbd "ESC <up>") #'org-metaup)
(org-defkey org-mode-map (kbd "M-<down>") #'org-metadown)
(org-defkey org-mode-map (kbd "ESC <down>") #'org-metadown)
(org-defkey org-mode-map (kbd "C-M-S-<right>") #'org-increase-number-at-point)
(org-defkey org-mode-map (kbd "C-M-S-<left>") #'org-decrease-number-at-point)
(org-defkey org-mode-map (kbd "M-S-<left>") #'org-shiftmetaleft)
(org-defkey org-mode-map (kbd "ESC S-<left>") #'org-shiftmetaleft)
(org-defkey org-mode-map (kbd "M-S-<right>") #'org-shiftmetaright)
(org-defkey org-mode-map (kbd "ESC S-<right>") #'org-shiftmetaright)
(org-defkey org-mode-map (kbd "M-S-<up>") #'org-shiftmetaup)
(org-defkey org-mode-map (kbd "ESC S-<up>") #'org-shiftmetaup)
(org-defkey org-mode-map (kbd "M-S-<down>") #'org-shiftmetadown)
(org-defkey org-mode-map (kbd "ESC S-<down>") #'org-shiftmetadown)
(org-defkey org-mode-map (kbd "S-<up>") #'org-shiftup)
(org-defkey org-mode-map (kbd "S-<down>") #'org-shiftdown)
(org-defkey org-mode-map (kbd "S-<left>") #'org-shiftleft)
(org-defkey org-mode-map (kbd "S-<right>") #'org-shiftright)
(org-defkey org-mode-map (kbd "C-S-<right>") #'org-shiftcontrolright)
(org-defkey org-mode-map (kbd "C-S-<left>") #'org-shiftcontrolleft)
(org-defkey org-mode-map (kbd "C-S-<up>") #'org-shiftcontrolup)
(org-defkey org-mode-map (kbd "C-S-<down>") #'org-shiftcontroldown)
;;;; Extra keys for TTY access.
;; We only set them when really needed because otherwise the
;; menus don't show the simple keys
(when (or org-use-extra-keys (not window-system))
(org-defkey org-mode-map (kbd "C-c C-x c") #'org-table-copy-down)
(org-defkey org-mode-map (kbd "C-c C-x m") #'org-meta-return)
(org-defkey org-mode-map (kbd "C-c C-x M") #'org-insert-todo-heading)
(org-defkey org-mode-map (kbd "C-c C-x RET") #'org-meta-return)
(org-defkey org-mode-map (kbd "ESC RET") #'org-meta-return)
(org-defkey org-mode-map (kbd "ESC <left>") #'org-metaleft)
(org-defkey org-mode-map (kbd "C-c C-x l") #'org-metaleft)
(org-defkey org-mode-map (kbd "ESC <right>") #'org-metaright)
(org-defkey org-mode-map (kbd "C-c C-x r") #'org-metaright)
(org-defkey org-mode-map (kbd "C-c C-x u") #'org-metaup)
(org-defkey org-mode-map (kbd "C-c C-x d") #'org-metadown)
(org-defkey org-mode-map (kbd "C-c C-x L") #'org-shiftmetaleft)
(org-defkey org-mode-map (kbd "C-c C-x R") #'org-shiftmetaright)
(org-defkey org-mode-map (kbd "C-c C-x U") #'org-shiftmetaup)
(org-defkey org-mode-map (kbd "C-c C-x D") #'org-shiftmetadown)
(org-defkey org-mode-map (kbd "C-c <up>") #'org-shiftup)
(org-defkey org-mode-map (kbd "C-c <down>") #'org-shiftdown)
(org-defkey org-mode-map (kbd "C-c <left>") #'org-shiftleft)
(org-defkey org-mode-map (kbd "C-c <right>") #'org-shiftright)
(org-defkey org-mode-map (kbd "C-c C-x <right>") #'org-shiftcontrolright)
(org-defkey org-mode-map (kbd "C-c C-x <left>") #'org-shiftcontrolleft))
;;;; Narrowing bindings
(org-defkey org-mode-map (kbd "C-x n s") #'org-narrow-to-subtree)
(org-defkey org-mode-map (kbd "C-x n b") #'org-narrow-to-block)
(org-defkey org-mode-map (kbd "C-x n e") #'org-narrow-to-element)
;;;; Remap usual Emacs bindings
(org-remap org-mode-map
'self-insert-command 'org-self-insert-command
'delete-char 'org-delete-char
'delete-backward-char 'org-delete-backward-char
'kill-line 'org-kill-line
'open-line 'org-open-line
'yank 'org-yank
'comment-dwim 'org-comment-dwim
'move-beginning-of-line 'org-beginning-of-line
'move-end-of-line 'org-end-of-line
'forward-paragraph 'org-forward-paragraph
'backward-paragraph 'org-backward-paragraph
'backward-sentence 'org-backward-sentence
'forward-sentence 'org-forward-sentence
'fill-paragraph 'org-fill-paragraph
'delete-indentation 'org-delete-indentation
'transpose-words 'org-transpose-words)
;;;; All the other keys
(org-defkey org-mode-map (kbd "|") #'org-force-self-insert)
(org-defkey org-mode-map (kbd "C-c C-r") #'org-reveal)
(org-defkey org-mode-map (kbd "C-M-t") #'org-transpose-element)
(org-defkey org-mode-map (kbd "M-}") #'org-forward-element)
(org-defkey org-mode-map (kbd "ESC }") #'org-forward-element)
(org-defkey org-mode-map (kbd "M-{") #'org-backward-element)
(org-defkey org-mode-map (kbd "ESC {") #'org-backward-element)
(org-defkey org-mode-map (kbd "C-c C-^") #'org-up-element)
(org-defkey org-mode-map (kbd "C-c C-_") #'org-down-element)
(org-defkey org-mode-map (kbd "C-c C-f") #'org-forward-heading-same-level)
(org-defkey org-mode-map (kbd "C-c C-b") #'org-backward-heading-same-level)
(org-defkey org-mode-map (kbd "C-c M-f") #'org-next-block)
(org-defkey org-mode-map (kbd "C-c M-b") #'org-previous-block)
(org-defkey org-mode-map (kbd "C-c $") #'org-archive-subtree)
(org-defkey org-mode-map (kbd "C-c C-x C-s") #'org-archive-subtree)
(org-defkey org-mode-map (kbd "C-c C-x C-a") #'org-archive-subtree-default)
(org-defkey org-mode-map (kbd "C-c C-x d") #'org-insert-drawer)
(org-defkey org-mode-map (kbd "C-c C-x a") #'org-toggle-archive-tag)
(org-defkey org-mode-map (kbd "C-c C-x A") #'org-archive-to-archive-sibling)
(org-defkey org-mode-map (kbd "C-c C-x b") #'org-tree-to-indirect-buffer)
(org-defkey org-mode-map (kbd "C-c C-x q") #'org-toggle-tags-groups)
(org-defkey org-mode-map (kbd "C-c C-j") #'org-goto)
(org-defkey org-mode-map (kbd "C-c C-t") #'org-todo)
(org-defkey org-mode-map (kbd "C-c C-q") #'org-set-tags-command)
(org-defkey org-mode-map (kbd "C-c C-s") #'org-schedule)
(org-defkey org-mode-map (kbd "C-c C-d") #'org-deadline)
(org-defkey org-mode-map (kbd "C-c ;") #'org-toggle-comment)
(org-defkey org-mode-map (kbd "C-c C-w") #'org-refile)
(org-defkey org-mode-map (kbd "C-c M-w") #'org-copy)
(org-defkey org-mode-map (kbd "C-c /") #'org-sparse-tree) ;minor-mode reserved
(org-defkey org-mode-map (kbd "C-c \\") #'org-match-sparse-tree) ;minor-mode r.
(org-defkey org-mode-map (kbd "C-c RET") #'org-ctrl-c-ret)
(org-defkey org-mode-map (kbd "C-c C-x c") #'org-clone-subtree-with-time-shift)
(org-defkey org-mode-map (kbd "C-c C-x v") #'org-copy-visible)
(org-defkey org-mode-map (kbd "C-<return>") #'org-insert-heading-respect-content)
(org-defkey org-mode-map (kbd "C-S-<return>") #'org-insert-todo-heading-respect-content)
(org-defkey org-mode-map (kbd "C-c C-x C-n") #'org-next-link)
(org-defkey org-mode-map (kbd "C-c C-x C-p") #'org-previous-link)
(org-defkey org-mode-map (kbd "C-c C-l") #'org-insert-link)
(org-defkey org-mode-map (kbd "C-c M-l") #'org-insert-last-stored-link)
(org-defkey org-mode-map (kbd "C-c C-M-l") #'org-insert-all-links)
(org-defkey org-mode-map (kbd "C-c C-o") #'org-open-at-point)
(org-defkey org-mode-map (kbd "C-c %") #'org-mark-ring-push)
(org-defkey org-mode-map (kbd "C-c &") #'org-mark-ring-goto)
(org-defkey org-mode-map (kbd "C-c C-z") #'org-add-note) ;alternative binding
(org-defkey org-mode-map (kbd "C-c .") #'org-time-stamp) ;minor-mode reserved
(org-defkey org-mode-map (kbd "C-c !") #'org-time-stamp-inactive) ;minor-mode r.
(org-defkey org-mode-map (kbd "C-c ,") #'org-priority) ;minor-mode reserved
(org-defkey org-mode-map (kbd "C-c C-y") #'org-evaluate-time-range)
(org-defkey org-mode-map (kbd "C-c >") #'org-goto-calendar)
(org-defkey org-mode-map (kbd "C-c <") #'org-date-from-calendar)
(org-defkey org-mode-map (kbd "C-,") #'org-cycle-agenda-files)
(org-defkey org-mode-map (kbd "C-'") #'org-cycle-agenda-files)
(org-defkey org-mode-map (kbd "C-c [") #'org-agenda-file-to-front)
(org-defkey org-mode-map (kbd "C-c ]") #'org-remove-file)
(org-defkey org-mode-map (kbd "C-c C-x <") #'org-agenda-set-restriction-lock)
(org-defkey org-mode-map (kbd "C-c C-x >") #'org-agenda-remove-restriction-lock)
(org-defkey org-mode-map (kbd "C-c -") #'org-ctrl-c-minus)
(org-defkey org-mode-map (kbd "C-c *") #'org-ctrl-c-star)
(org-defkey org-mode-map (kbd "C-c TAB") #'org-ctrl-c-tab)
(org-defkey org-mode-map (kbd "C-c ^") #'org-sort)
(org-defkey org-mode-map (kbd "C-c C-c") #'org-ctrl-c-ctrl-c)
(org-defkey org-mode-map (kbd "C-c C-k") #'org-kill-note-or-show-branches)
(org-defkey org-mode-map (kbd "C-c #") #'org-update-statistics-cookies)
(org-defkey org-mode-map (kbd "RET") #'org-return)
(org-defkey org-mode-map (kbd "C-j") #'org-return-indent)
(org-defkey org-mode-map (kbd "C-c ?") #'org-table-field-info)
(org-defkey org-mode-map (kbd "C-c SPC") #'org-table-blank-field)
(org-defkey org-mode-map (kbd "C-c +") #'org-table-sum)
(org-defkey org-mode-map (kbd "C-c =") #'org-table-eval-formula)
(org-defkey org-mode-map (kbd "C-c '") #'org-edit-special)
(org-defkey org-mode-map (kbd "C-c `") #'org-table-edit-field)
(org-defkey org-mode-map (kbd "C-c \" a") #'orgtbl-ascii-plot)
(org-defkey org-mode-map (kbd "C-c \" g") #'org-plot/gnuplot)
(org-defkey org-mode-map (kbd "C-c |") #'org-table-create-or-convert-from-region)
(org-defkey org-mode-map (kbd "C-#") #'org-table-rotate-recalc-marks)
(org-defkey org-mode-map (kbd "C-c ~") #'org-table-create-with-table.el)
(org-defkey org-mode-map (kbd "C-c C-a") #'org-attach)
(org-defkey org-mode-map (kbd "C-c }") #'org-table-toggle-coordinate-overlays)
(org-defkey org-mode-map (kbd "C-c {") #'org-table-toggle-formula-debugger)
(org-defkey org-mode-map (kbd "C-c C-e") #'org-export-dispatch)
(org-defkey org-mode-map (kbd "C-c :") #'org-toggle-fixed-width)
(org-defkey org-mode-map (kbd "C-c C-x C-f") #'org-emphasize)
(org-defkey org-mode-map (kbd "C-c C-x f") #'org-footnote-action)
(org-defkey org-mode-map (kbd "C-c @") #'org-mark-subtree)
(org-defkey org-mode-map (kbd "M-h") #'org-mark-element)
(org-defkey org-mode-map (kbd "ESC h") #'org-mark-element)
(org-defkey org-mode-map (kbd "C-c C-*") #'org-list-make-subtree)
(org-defkey org-mode-map (kbd "C-c C-x C-w") #'org-cut-special)
(org-defkey org-mode-map (kbd "C-c C-x M-w") #'org-copy-special)
(org-defkey org-mode-map (kbd "C-c C-x C-y") #'org-paste-special)
(org-defkey org-mode-map (kbd "C-c C-x C-t") #'org-toggle-time-stamp-overlays)
(org-defkey org-mode-map (kbd "C-c C-x C-i") #'org-clock-in)
(org-defkey org-mode-map (kbd "C-c C-x C-x") #'org-clock-in-last)
(org-defkey org-mode-map (kbd "C-c C-x C-z") #'org-resolve-clocks)
(org-defkey org-mode-map (kbd "C-c C-x C-o") #'org-clock-out)
(org-defkey org-mode-map (kbd "C-c C-x C-j") #'org-clock-goto)
(org-defkey org-mode-map (kbd "C-c C-x C-q") #'org-clock-cancel)
(org-defkey org-mode-map (kbd "C-c C-x C-d") #'org-clock-display)
(org-defkey org-mode-map (kbd "C-c C-x x") #'org-dynamic-block-insert-dblock)
(org-defkey org-mode-map (kbd "C-c C-x C-u") #'org-dblock-update)
(org-defkey org-mode-map (kbd "C-c C-x C-l") #'org-latex-preview)
(org-defkey org-mode-map (kbd "C-c C-x C-v") #'org-toggle-inline-images)
(org-defkey org-mode-map (kbd "C-c C-x C-M-v") #'org-redisplay-inline-images)
(org-defkey org-mode-map (kbd "C-c C-x \\") #'org-toggle-pretty-entities)
(org-defkey org-mode-map (kbd "C-c C-x C-b") #'org-toggle-checkbox)
(org-defkey org-mode-map (kbd "C-c C-x p") #'org-set-property)
(org-defkey org-mode-map (kbd "C-c C-x P") #'org-set-property-and-value)
(org-defkey org-mode-map (kbd "C-c C-x e") #'org-set-effort)
(org-defkey org-mode-map (kbd "C-c C-x E") #'org-inc-effort)
(org-defkey org-mode-map (kbd "C-c C-x o") #'org-toggle-ordered-property)
(org-defkey org-mode-map (kbd "C-c C-,") #'org-insert-structure-template)
(org-defkey org-mode-map (kbd "C-c C-x .") #'org-timer)
(org-defkey org-mode-map (kbd "C-c C-x -") #'org-timer-item)
(org-defkey org-mode-map (kbd "C-c C-x 0") #'org-timer-start)
(org-defkey org-mode-map (kbd "C-c C-x _") #'org-timer-stop)
(org-defkey org-mode-map (kbd "C-c C-x ;") #'org-timer-set-timer)
(org-defkey org-mode-map (kbd "C-c C-x ,") #'org-timer-pause-or-continue)
(org-defkey org-mode-map (kbd "C-c C-x C-c") #'org-columns)
(org-defkey org-mode-map (kbd "C-c C-x !") #'org-reload)
(org-defkey org-mode-map (kbd "C-c C-x g") #'org-feed-update-all)
(org-defkey org-mode-map (kbd "C-c C-x G") #'org-feed-goto-inbox)
(org-defkey org-mode-map (kbd "C-c C-x [") #'org-reftex-citation)
(org-defkey org-mode-map (kbd "C-c C-x I") #'org-info-find-node)
;;; Speed keys
(defcustom org-use-speed-commands nil
"Non-nil means activate single letter commands at beginning of a headline.
This may also be a function to test for appropriate locations where speed
commands should be active.
For example, to activate speed commands when the point is on any
star at the beginning of the headline, you can do this:
(setq org-use-speed-commands
(lambda () (and (looking-at org-outline-regexp) (looking-back \"^\\**\"))))"
:group 'org-structure
:type '(choice
(const :tag "Never" nil)
(const :tag "At beginning of headline stars" t)
(function)))
(defcustom org-speed-commands-user nil
"Alist of additional speed commands.
This list will be checked before `org-speed-commands-default'
when the variable `org-use-speed-commands' is non-nil
and when the cursor is at the beginning of a headline.
The car of each entry is a string with a single letter, which must
be assigned to `self-insert-command' in the global map.
The cdr is either a command to be called interactively, a function
to be called, or a form to be evaluated.
An entry that is just a list with a single string will be interpreted
as a descriptive headline that will be added when listing the speed
commands in the Help buffer using the `?' speed command."
:group 'org-structure
:type '(repeat :value ("k" . ignore)
(choice :value ("k" . ignore)
(list :tag "Descriptive Headline" (string :tag "Headline"))
(cons :tag "Letter and Command"
(string :tag "Command letter")
(choice
(function)
(sexp))))))
(defcustom org-speed-command-hook
'(org-speed-command-activate org-babel-speed-command-activate)
"Hook for activating speed commands at strategic locations.
Hook functions are called in sequence until a valid handler is
found.
Each hook takes a single argument, a user-pressed command key
which is also a `self-insert-command' from the global map.
Within the hook, examine the cursor position and the command key
and return nil or a valid handler as appropriate. Handler could
be one of an interactive command, a function, or a form.
Set `org-use-speed-commands' to non-nil value to enable this
hook. The default setting is `org-speed-command-activate'."
:group 'org-structure
:version "24.1"
:type 'hook)
(defconst org-speed-commands-default
'(("Outline Navigation")
("n" . (org-speed-move-safe 'org-next-visible-heading))
("p" . (org-speed-move-safe 'org-previous-visible-heading))
("f" . (org-speed-move-safe 'org-forward-heading-same-level))
("b" . (org-speed-move-safe 'org-backward-heading-same-level))
("F" . org-next-block)
("B" . org-previous-block)
("u" . (org-speed-move-safe 'outline-up-heading))
("j" . org-goto)
("g" . (org-refile t))
("Outline Visibility")
("c" . org-cycle)
("C" . org-shifttab)
(" " . org-display-outline-path)
("s" . org-toggle-narrow-to-subtree)
("k" . org-cut-subtree)
("=" . org-columns)
("Outline Structure Editing")
("U" . org-metaup)
("D" . org-metadown)
("r" . org-metaright)
("l" . org-metaleft)
("R" . org-shiftmetaright)
("L" . org-shiftmetaleft)
("i" . (progn (forward-char 1) (call-interactively
'org-insert-heading-respect-content)))
("^" . org-sort)
("w" . org-refile)
("a" . org-archive-subtree-default-with-confirmation)
("@" . org-mark-subtree)
("#" . org-toggle-comment)
("Clock Commands")
("I" . org-clock-in)
("O" . org-clock-out)
("Meta Data Editing")
("t" . org-todo)
("," . (org-priority))
("0" . (org-priority ?\ ))
("1" . (org-priority ?A))
("2" . (org-priority ?B))
("3" . (org-priority ?C))
(":" . org-set-tags-command)
("e" . org-set-effort)
("E" . org-inc-effort)
("W" . (lambda(m) (interactive "sMinutes before warning: ")
(org-entry-put (point) "APPT_WARNTIME" m)))
("Agenda Views etc")
("v" . org-agenda)
("/" . org-sparse-tree)
("Misc")
("o" . org-open-at-point)
("?" . org-speed-command-help)
("<" . (org-agenda-set-restriction-lock 'subtree))
(">" . (org-agenda-remove-restriction-lock)))
"The default speed commands.")
(defun org-print-speed-command (e)
(if (> (length (car e)) 1)
(progn
(princ "\n")
(princ (car e))
(princ "\n")
(princ (make-string (length (car e)) ?-))
(princ "\n"))
(princ (car e))
(princ " ")
(if (symbolp (cdr e))
(princ (symbol-name (cdr e)))
(prin1 (cdr e)))
(princ "\n")))
(defun org-speed-command-help ()
"Show the available speed commands."
(interactive)
(unless org-use-speed-commands
(user-error "Speed commands are not activated, customize `org-use-speed-commands'"))
(with-output-to-temp-buffer "*Help*"
(princ "User-defined Speed commands\n===========================\n")
(mapc #'org-print-speed-command org-speed-commands-user)
(princ "\n")
(princ "Built-in Speed commands\n=======================\n")
(mapc #'org-print-speed-command org-speed-commands-default))
(with-current-buffer "*Help*"
(setq truncate-lines t)))
(defun org-speed-move-safe (cmd)
"Execute CMD, but make sure that the cursor always ends up in a headline.
If not, return to the original position and throw an error."
(interactive)
(let ((pos (point)))
(call-interactively cmd)
(unless (and (bolp) (org-at-heading-p))
(goto-char pos)
(error "Boundary reached while executing %s" cmd))))
(defun org-speed-command-activate (keys)
"Hook for activating single-letter speed commands.
`org-speed-commands-default' specifies a minimal command set.
Use `org-speed-commands-user' for further customization."
(when (or (and (bolp) (looking-at org-outline-regexp))
(and (functionp org-use-speed-commands)
(funcall org-use-speed-commands)))
(cdr (assoc keys (append org-speed-commands-user
org-speed-commands-default)))))
;;; Babel speed keys
(defvar org-babel-key-prefix "\C-c\C-v"
"The key prefix for Babel interactive key-bindings.
See `org-babel-key-bindings' for the list of interactive Babel
functions which are assigned key bindings, and see
`org-babel-map' for the actual babel keymap.")
(defvar org-babel-map (make-sparse-keymap)
"The keymap for interactive Babel functions.")
(defvar org-babel-key-bindings
'(("p" . org-babel-previous-src-block)
("\C-p" . org-babel-previous-src-block)
("n" . org-babel-next-src-block)
("\C-n" . org-babel-next-src-block)
("e" . org-babel-execute-maybe)
("\C-e" . org-babel-execute-maybe)
("o" . org-babel-open-src-block-result)
("\C-o" . org-babel-open-src-block-result)
("\C-v" . org-babel-expand-src-block)
("v" . org-babel-expand-src-block)
("u" . org-babel-goto-src-block-head)
("\C-u" . org-babel-goto-src-block-head)
("g" . org-babel-goto-named-src-block)
("r" . org-babel-goto-named-result)
("\C-r" . org-babel-goto-named-result)
("\C-b" . org-babel-execute-buffer)
("b" . org-babel-execute-buffer)
("\C-s" . org-babel-execute-subtree)
("s" . org-babel-execute-subtree)
("\C-d" . org-babel-demarcate-block)
("d" . org-babel-demarcate-block)
("\C-t" . org-babel-tangle)
("t" . org-babel-tangle)
("\C-f" . org-babel-tangle-file)
("f" . org-babel-tangle-file)
("\C-c" . org-babel-check-src-block)
("c" . org-babel-check-src-block)
("\C-j" . org-babel-insert-header-arg)
("j" . org-babel-insert-header-arg)
("\C-l" . org-babel-load-in-session)
("l" . org-babel-load-in-session)
("\C-i" . org-babel-lob-ingest)
("i" . org-babel-lob-ingest)
("\C-I" . org-babel-view-src-block-info)
("I" . org-babel-view-src-block-info)
("\C-z" . org-babel-switch-to-session)
("z" . org-babel-switch-to-session-with-code)
("\C-a" . org-babel-sha1-hash)
("a" . org-babel-sha1-hash)
("h" . org-babel-describe-bindings)
("\C-x" . org-babel-do-key-sequence-in-edit-buffer)
("x" . org-babel-do-key-sequence-in-edit-buffer)
("k" . org-babel-remove-result-one-or-many)
("\C-\M-h" . org-babel-mark-block))
"Alist of key bindings and interactive Babel functions.
This list associates interactive Babel functions
with keys. Each element of this list will add an entry to the
`org-babel-map' using the letter key which is the `car' of the
a-list placed behind the generic `org-babel-key-prefix'.")
(define-key org-mode-map org-babel-key-prefix org-babel-map)
(pcase-dolist (`(,key . ,def) org-babel-key-bindings)
(define-key org-babel-map key def))
(defun org-babel-speed-command-activate (keys)
"Hook for activating single-letter code block commands."
(when (and (bolp)
(let ((case-fold-search t)) (looking-at "[ \t]*#\\+begin_src"))
(eq 'src-block (org-element-type (org-element-at-point))))
(cdr (assoc keys org-babel-key-bindings))))
;;;###autoload
(defun org-babel-describe-bindings ()
"Describe all keybindings behind `org-babel-key-prefix'."
(interactive)
(describe-bindings org-babel-key-prefix))
(provide 'org-keys)
;;; org-keys.el ends here

76
lisp/org/org-lint.el
View file

@ -69,13 +69,13 @@
;; - duplicate footnote definitions
;; - orphaned affiliated keywords
;; - obsolete affiliated keywords
;; - missing language in src blocks
;; - missing language in source blocks
;; - missing back-end in export blocks
;; - invalid Babel call blocks
;; - NAME values with a colon
;; - deprecated export block syntax
;; - deprecated Babel header properties
;; - wrong header arguments in src blocks
;; - wrong header arguments in source blocks
;; - misuse of CATEGORY keyword
;; - "coderef" links with unknown destination
;; - "custom-id" links with unknown destination
@ -100,16 +100,16 @@
;; - indented diary-sexps
;; - obsolete QUOTE section
;; - obsolete "file+application" link
;; - blank headlines with tags
;; - spurious colons in tags
;;; Code:
(require 'cl-lib)
(require 'org-element)
(require 'ob)
(require 'ol)
(require 'org-macro)
(require 'ox)
(require 'ob)
;;; Checkers
@ -162,7 +162,7 @@
:trust 'low)
(make-org-lint-checker
:name 'missing-language-in-src-block
:description "Report missing language in src blocks"
:description "Report missing language in source blocks"
:categories '(babel))
(make-org-lint-checker
:name 'missing-backend-in-export-block
@ -288,10 +288,14 @@
:description "Report obsolete \"file+application\" link"
:categories '(link obsolete))
(make-org-lint-checker
:name 'empty-headline-with-tags
:description "Report ambiguous empty headlines with tags"
:categories '(headline)
:trust 'low))
:name 'percent-encoding-link-escape
:description "Report obsolete escape syntax in links"
:categories '(link obsolete)
:trust 'low)
(make-org-lint-checker
:name 'spurious-colons
:description "Report spurious colons in tags"
:categories '(tags)))
"List of all available checkers.")
(defun org-lint--collect-duplicates
@ -560,8 +564,8 @@ Use :header-args: instead"
(defun org-lint-link-to-local-file (ast)
(org-element-map ast 'link
(lambda (l)
(when (equal (org-element-property :type l) "file")
(let ((file (org-link-unescape (org-element-property :path l))))
(when (equal "file" (org-element-property :type l))
(let ((file (org-element-property :path l)))
(and (not (file-remote-p file))
(not (file-exists-p file))
(list (org-element-property :begin l)
@ -576,12 +580,13 @@ Use :header-args: instead"
(lambda (k)
(when (equal (org-element-property :key k) "SETUPFILE")
(let ((file (org-unbracket-string
"\"" "\""
(org-element-property :value k))))
(and (not (file-remote-p file))
"\"" "\""
(org-element-property :value k))))
(and (not (org-file-url-p file))
(not (file-remote-p file))
(not (file-exists-p file))
(list (org-element-property :begin k)
(format "Non-existent setup file \"%s\"" file))))))))
(format "Non-existent setup file %S" file))))))))
(defun org-lint-wrong-include-link-parameter (ast)
(org-element-map ast 'keyword
@ -591,7 +596,7 @@ Use :header-args: instead"
(path
(and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value)
(save-match-data
(org-unbracket-string "\"" "\"" (match-string 1 value))))))
(org-strip-quotes (match-string 1 value))))))
(if (not path)
(list (org-element-property :post-affiliated k)
"Missing location argument in INCLUDE keyword")
@ -608,14 +613,13 @@ Use :header-args: instead"
"Non-existent file argument in INCLUDE keyword")
(let* ((visiting (if file (find-buffer-visiting file)
(current-buffer)))
(buffer (or visiting (find-file-noselect file))))
(buffer (or visiting (find-file-noselect file)))
(org-link-search-must-match-exact-headline t))
(unwind-protect
(with-current-buffer buffer
(when (and search
(not
(ignore-errors
(let ((org-link-search-inhibit-query t))
(org-link-search search nil t)))))
(not (ignore-errors
(org-link-search search nil t))))
(list (org-element-property :post-affiliated k)
(format
"Invalid search part \"%s\" in INCLUDE keyword"
@ -886,6 +890,23 @@ Use \"export %s\" instead"
(list (org-element-property :begin l)
(format "Deprecated \"file+%s\" link type" app)))))))
(defun org-lint-percent-encoding-link-escape (ast)
(org-element-map ast 'link
(lambda (l)
(when (eq 'bracket (org-element-property :format l))
(let* ((uri (org-element-property :path l))
(start 0)
(obsolete-flag
(catch :obsolete
(while (string-match "%\\(..\\)?" uri start)
(setq start (match-end 0))
(unless (member (match-string 1 uri) '("25" "5B" "5D" "20"))
(throw :obsolete nil)))
(string-match-p "%" uri))))
(when obsolete-flag
(list (org-element-property :begin l)
"Link escaped with obsolete percent-encoding syntax")))))))
(defun org-lint-wrong-header-argument (ast)
(let* ((reports)
(verify
@ -1037,14 +1058,13 @@ Use \"export %s\" instead"
reports))))))))))))
reports))
(defun org-lint-empty-headline-with-tags (ast)
(defun org-lint-spurious-colons (ast)
(org-element-map ast '(headline inlinetask)
(lambda (h)
(let ((title (org-element-property :raw-value h)))
(and (string-match-p "\\`:[[:alnum:]_@#%:]+:\\'" title)
(list (org-element-property :begin h)
(format "Headline containing only tags is ambiguous: %S"
title)))))))
(when (member "" (org-element-property :tags h))
(list (org-element-property :begin h)
"Tags contain a spurious colon")))))
;;; Reports UI

313
lisp/org/org-list.el
View file

@ -91,6 +91,7 @@
(defvar org-drawer-regexp)
(defvar org-element-all-objects)
(defvar org-inhibit-startup)
(defvar org-loop-over-headlines-in-active-region)
(defvar org-odd-levels-only)
(defvar org-outline-regexp-bol)
(defvar org-scheduled-string)
@ -101,43 +102,31 @@
(declare-function org-at-heading-p "org" (&optional invisible-ok))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-combine-plists "org" (&rest plists))
(declare-function org-current-level "org" ())
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-interpret-data "org-element" (data))
(declare-function
org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-element-macro-interpreter "org-element" (macro ##))
(declare-function
org-element-map "org-element"
(data types fun &optional info first-match no-recursion with-affiliated))
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
(declare-function org-element-normalize-string "org-element" (s))
(declare-function org-element-parse-buffer "org-element"
(&optional granularity visible-only))
(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-put-property "org-element"
(element property value))
(declare-function org-element-put-property "org-element" (element property value))
(declare-function org-element-set-element "org-element" (old new))
(declare-function org-element-type "org-element" (element))
(declare-function org-element-update-syntax "org-element" ())
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-export-create-backend "ox" (&rest rest) t)
(declare-function org-export-data-with-backend "ox" (data backend info))
(declare-function org-export-get-backend "ox" (name))
(declare-function org-export-get-environment "ox"
(&optional backend subtreep ext-plist))
(declare-function org-export-get-next-element "ox"
(blob info &optional n))
(declare-function org-export-with-backend "ox"
(backend data &optional contents info))
(declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist))
(declare-function org-export-get-next-element "ox" (blob info &optional n))
(declare-function org-export-with-backend "ox" (backend data &optional contents info))
(declare-function org-fix-tags-on-the-fly "org" ())
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-get-todo-state "org" ())
(declare-function org-in-block-p "org" (names))
(declare-function org-in-regexp "org" (re &optional nlines visually))
(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
(declare-function org-inlinetask-goto-end "org-inlinetask" ())
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
@ -147,16 +136,12 @@
(declare-function org-outline-level "org" ())
(declare-function org-previous-line-empty-p "org" ())
(declare-function org-reduced-level "org" (L))
(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-set-tags "org" (tags))
(declare-function org-show-subtree "org" ())
(declare-function org-sort-remove-invisible "org" (S))
(declare-function org-time-string-to-seconds "org" (s))
(declare-function org-timer-hms-to-secs "org-timer" (hms))
(declare-function org-timer-item "org-timer" (&optional arg))
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function org-uniquify "org" (list))
(declare-function org-invisible-p "org" (&optional pos))
(declare-function outline-flag-region "outline" (from to flag))
(declare-function outline-next-heading "outline" ())
(declare-function outline-previous-heading "outline" ())
@ -343,13 +328,6 @@ with the word \"recursive\" in the value."
:group 'org-plain-lists
:type 'boolean)
(defcustom org-list-description-max-indent 20
"Maximum indentation for the second line of a description list.
When the indentation would be larger than this, it will become
5 characters instead."
:group 'org-plain-lists
:type 'integer)
(defcustom org-list-indent-offset 0
"Additional indentation for sub-items in a list.
By setting this to a small number, usually 1 or 2, one can more
@ -358,45 +336,10 @@ clearly distinguish sub-items in a list."
:version "24.1"
:type 'integer)
(defcustom org-list-radio-list-templates
'((latex-mode "% BEGIN RECEIVE ORGLST %n
% END RECEIVE ORGLST %n
\\begin{comment}
#+ORGLST: SEND %n org-list-to-latex
-
\\end{comment}\n")
(texinfo-mode "@c BEGIN RECEIVE ORGLST %n
@c END RECEIVE ORGLST %n
@ignore
#+ORGLST: SEND %n org-list-to-texinfo
-
@end ignore\n")
(html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
<!-- END RECEIVE ORGLST %n -->
<!--
#+ORGLST: SEND %n org-list-to-html
-
-->\n"))
"Templates for radio lists in different major modes.
All occurrences of %n in a template will be replaced with the name of the
list, obtained by prompting the user."
:group 'org-plain-lists
:type '(repeat
(list (symbol :tag "Major mode")
(string :tag "Format"))))
(defvar org-list-forbidden-blocks '("example" "verse" "src" "export")
"Names of blocks where lists are not allowed.
Names must be in lower case.")
(defvar org-list-export-context '(block inlinetask)
"Context types where lists will be interpreted during export.
Valid types are `drawer', `inlinetask' and `block'. More
specifically, type `block' is determined by the variable
`org-list-forbidden-blocks'.")
;;; Predicates and regexps
@ -462,7 +405,7 @@ group 4: description tag")
(ind-ref (if (or (looking-at "^[ \t]*$")
(and inlinetask-re (looking-at inlinetask-re)))
10000
(org-get-indentation))))
(current-indentation))))
(cond
((eq (nth 2 context) 'invalid) nil)
((looking-at item-re) (point))
@ -484,7 +427,7 @@ group 4: description tag")
;; Look for an item, less indented that reference line.
(catch 'exit
(while t
(let ((ind (org-get-indentation)))
(let ((ind (current-indentation)))
(cond
;; This is exactly what we want.
((and (looking-at item-re) (< ind ind-ref))
@ -654,7 +597,7 @@ Assume point is at an item."
(item-re (org-item-re))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(beg-cell (cons (point) (org-get-indentation)))
(beg-cell (cons (point) (current-indentation)))
itm-lst itm-lst-2 end-lst end-lst-2 struct
(assoc-at-point
(function
@ -682,7 +625,7 @@ Assume point is at an item."
(save-excursion
(catch 'exit
(while t
(let ((ind (org-get-indentation)))
(let ((ind (current-indentation)))
(cond
((<= (point) lim-up)
;; At upward limit: if we ended at an item, store it,
@ -742,7 +685,7 @@ Assume point is at an item."
;; position of items in END-LST-2.
(catch 'exit
(while t
(let ((ind (org-get-indentation)))
(let ((ind (current-indentation)))
(cond
((>= (point) lim-down)
;; At downward limit: this is de facto the end of the
@ -861,6 +804,17 @@ This function modifies STRUCT."
(t (cons pos (cdar ind-to-ori))))))
(cdr struct)))))
(defun org-list--delete-metadata ()
"Delete metadata from the heading at point.
Metadata are tags, planning information and properties drawers."
(save-match-data
(org-with-wide-buffer
(org-set-tags nil)
(delete-region (line-beginning-position 2)
(save-excursion
(org-end-of-meta-data)
(org-skip-whitespace)
(if (eobp) (point) (line-beginning-position)))))))
;;; Accessors
@ -1281,10 +1235,18 @@ function ends.
This function modifies STRUCT."
(let ((case-fold-search t))
;; 1. Get information about list: position of point with regards
;; to item start (BEFOREP), blank lines number separating items
;; (BLANK-NB), if we're allowed to (SPLIT-LINE-P).
(let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin))))
;; 1. Get information about list: ITEM containing POS, position of
;; point with regards to item start (BEFOREP), blank lines
;; number separating items (BLANK-NB), if we're allowed to
;; (SPLIT-LINE-P).
(let* ((item (goto-char (catch :exit
(let ((inner-item 0))
(pcase-dolist (`(,i . ,_) struct)
(cond
((= i pos) (throw :exit i))
((< i pos) (setq inner-item i))
(t (throw :exit inner-item))))
inner-item))))
(item-end (org-list-get-item-end item struct))
(item-end-no-blank (org-list-get-item-end-before-blank item struct))
(beforep
@ -1497,8 +1459,8 @@ This function returns, destructively, the new list structure."
(org-M-RET-may-split-line nil)
;; Store inner overlays (to preserve visibility).
(overlays (cl-remove-if (lambda (o) (or (< (overlay-start o) item)
(> (overlay-end o) item)))
(overlays-in item item-end))))
(> (overlay-end o) item)))
(overlays-in item item-end))))
(cond
((eq dest 'delete) (org-list-delete-item item struct))
((eq dest 'kill)
@ -1590,23 +1552,6 @@ STRUCT may be modified if `org-list-demote-modify-bullet' matches
bullets between START and END."
(let* (acc
(set-assoc (lambda (cell) (push cell acc) cell))
(change-bullet-maybe
(function
(lambda (item)
(let ((new-bul-p
(cdr (assoc
;; Normalize ordered bullets.
(let ((bul (org-trim
(org-list-get-bullet item struct))))
(cond ((string-match "[A-Z]\\." bul) "A.")
((string-match "[A-Z])" bul) "A)")
((string-match "[a-z]\\." bul) "a.")
((string-match "[a-z])" bul) "a)")
((string-match "[0-9]\\." bul) "1.")
((string-match "[0-9])" bul) "1)")
(t bul)))
org-list-demote-modify-bullet))))
(when new-bul-p (org-list-set-bullet item struct new-bul-p))))))
(ind
(lambda (cell)
(let* ((item (car cell))
@ -1622,11 +1567,24 @@ bullets between START and END."
;; Item is in zone...
(let ((prev (org-list-get-prev-item item struct prevs)))
;; Check if bullet needs to be changed.
(funcall change-bullet-maybe item)
(pcase (assoc (let ((b (org-list-get-bullet item struct))
(case-fold-search nil))
(cond ((string-match "[A-Z]\\." b) "A.")
((string-match "[A-Z])" b) "A)")
((string-match "[a-z]\\." b) "a.")
((string-match "[a-z])" b) "a)")
((string-match "[0-9]\\." b) "1.")
((string-match "[0-9])" b) "1)")
(t (org-trim b))))
org-list-demote-modify-bullet)
(`(,_ . ,bullet)
(org-list-set-bullet
item struct (org-list-bullet-string bullet)))
(_ nil))
(cond
;; First item indented but not parent: error
((and (not prev) (< parent start))
(error "Cannot indent the first item of a list"))
((and (not prev) (or (not parent) (< parent start)))
(user-error "Cannot indent the first item of a list"))
;; First item and parent indented: keep same
;; parent.
((not prev) (funcall set-assoc cell))
@ -1899,7 +1857,7 @@ Initial position of cursor is restored after the changes."
(org-inlinetask-goto-beginning))
;; Shift only non-empty lines.
((looking-at-p "^[ \t]*\\S-")
(indent-line-to (+ (org-get-indentation) delta))))
(indent-line-to (+ (current-indentation) delta))))
(forward-line -1)))))
(modify-item
(function
@ -1908,7 +1866,7 @@ Initial position of cursor is restored after the changes."
(lambda (item)
(goto-char item)
(let* ((new-ind (org-list-get-ind item struct))
(old-ind (org-get-indentation))
(old-ind (current-indentation))
(new-bul (org-list-bullet-string
(org-list-get-bullet item struct)))
(old-bul (org-list-get-bullet item old-struct))
@ -1983,7 +1941,7 @@ Initial position of cursor is restored after the changes."
;; Ignore empty lines. Also ignore blocks and
;; drawers contents.
(unless (looking-at-p "[ \t]*$")
(setq min-ind (min (org-get-indentation) min-ind))
(setq min-ind (min (current-indentation) min-ind))
(cond
((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
(re-search-forward
@ -2037,7 +1995,9 @@ doesn't correspond anymore to the real list in buffer."
;; 5. Eventually fix checkboxes.
(org-list-struct-fix-box struct parents prevs))
;; 6. Apply structure modifications to buffer.
(org-list-struct-apply-struct struct old-struct)))
(org-list-struct-apply-struct struct old-struct))
;; 7. Return the updated structure
struct)
@ -2078,8 +2038,8 @@ Possible values are: `folded', `children' or `subtree'. See
((eq view 'folded)
(let ((item-end (org-list-get-item-end-before-blank item struct)))
;; Hide from eol
(outline-flag-region (save-excursion (goto-char item) (point-at-eol))
item-end t)))
(org-flag-region (save-excursion (goto-char item) (line-end-position))
item-end t 'outline)))
((eq view 'children)
;; First show everything.
(org-list-set-item-visibility item struct 'subtree)
@ -2092,31 +2052,19 @@ Possible values are: `folded', `children' or `subtree'. See
((eq view 'subtree)
;; Show everything
(let ((item-end (org-list-get-item-end item struct)))
(outline-flag-region item item-end nil)))))
(org-flag-region item item-end nil 'outline)))))
(defun org-list-item-body-column (item)
"Return column at which body of ITEM should start."
(save-excursion
(goto-char item)
(if (save-excursion
(end-of-line)
(re-search-backward
"[ \t]::\\([ \t]\\|$\\)" (line-beginning-position) t))
;; Descriptive list item. Body starts after item's tag, if
;; possible.
(let ((start (1+ (- (match-beginning 1) (line-beginning-position))))
(ind (org-get-indentation)))
(if (> start (+ ind org-list-description-max-indent))
(+ ind 5)
start))
;; Regular item. Body starts after bullet.
(looking-at "[ \t]*\\(\\S-+\\)")
(+ (progn (goto-char (match-end 1)) (current-column))
(if (and org-list-two-spaces-after-bullet-regexp
(string-match-p org-list-two-spaces-after-bullet-regexp
(match-string 1)))
2
1)))))
(looking-at "[ \t]*\\(\\S-+\\)")
(+ (progn (goto-char (match-end 1)) (current-column))
(if (and org-list-two-spaces-after-bullet-regexp
(string-match-p org-list-two-spaces-after-bullet-regexp
(match-string 1)))
2
1))))
@ -2280,7 +2228,7 @@ item is invisible."
(string-match "[.)]" (match-string 1))))
(match-beginning 4)
(match-end 0)))
(if desc (backward-char 1))
(when desc (backward-char 1))
t)))))
(defun org-list-repair ()
@ -2707,11 +2655,12 @@ Return t if successful."
(error "Cannot outdent an item without its children"))
;; Normal shifting
(t
(let* ((new-parents
(let* ((old-struct (copy-tree struct))
(new-parents
(if (< arg 0)
(org-list-struct-outdent beg end struct parents)
(org-list-struct-indent beg end struct parents prevs))))
(org-list-write-struct struct new-parents))
(org-list-write-struct struct new-parents old-struct))
(org-update-checkbox-count-maybe))))))
t)
@ -2840,7 +2789,8 @@ Sorting can be alphabetically, numerically, by date/time as given
by a time stamp, by a property or by priority.
Comparing entries ignores case by default. However, with an
optional argument WITH-CASE, the sorting considers case as well.
optional argument WITH-CASE, the sorting considers case as well,
if the current locale allows for it.
The command prompts for the sorting type unless it has been given
to the function through the SORTING-TYPE argument, which needs to
@ -2886,7 +2836,7 @@ function is being called interactively."
(error "Missing key extractor"))))
(sort-func
(cond
((= dcst ?a) #'string<)
((= dcst ?a) #'org-string-collate-lessp)
((= dcst ?f)
(or compare-func
(and interactive?
@ -2977,7 +2927,7 @@ With a prefix argument ARG, change the region in a single item."
(save-excursion
(catch 'exit
(while (< (point) end)
(let ((i (org-get-indentation)))
(let ((i (current-indentation)))
(cond
;; Skip blank lines and inline tasks.
((looking-at "^[ \t]*$"))
@ -2993,7 +2943,7 @@ With a prefix argument ARG, change the region in a single item."
(while (< (point) end)
(unless (or (looking-at "^[ \t]*$")
(looking-at org-outline-regexp-bol))
(indent-line-to (+ (org-get-indentation) delta)))
(indent-line-to (+ (current-indentation) delta)))
(forward-line))))))
(skip-blanks
(lambda (pos)
@ -3027,6 +2977,9 @@ With a prefix argument ARG, change the region in a single item."
(forward-line)))
;; Case 2. Start at an heading: convert to items.
((org-at-heading-p)
;; Remove metadata
(let (org-loop-over-headlines-in-active-region)
(org-list--delete-metadata))
(let* ((bul (org-list-bullet-string "-"))
(bul-len (length bul))
;; Indentation of the first heading. It should be
@ -3047,6 +3000,9 @@ With a prefix argument ARG, change the region in a single item."
;; one, set it as reference, in order to preserve
;; subtrees.
(when (< level ref-level) (setq ref-level level))
;; Remove metadata
(let (org-loop-over-headlines-in-active-region)
(org-list--delete-metadata))
;; Remove stars and TODO keyword.
(let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
(delete-region (point) (or (match-beginning 3)
@ -3079,7 +3035,7 @@ With a prefix argument ARG, change the region in a single item."
;; set them as item's body.
(arg (let* ((bul (org-list-bullet-string "-"))
(bul-len (length bul))
(ref-ind (org-get-indentation)))
(ref-ind (current-indentation)))
(skip-chars-forward " \t")
(insert bul)
(forward-line)
@ -3195,80 +3151,14 @@ Point is left at list's end."
(defun org-list-make-subtree ()
"Convert the plain list at point into a subtree."
(interactive)
(if (not (ignore-errors (goto-char (org-in-item-p))))
(error "Not in a list")
(let ((list (save-excursion (org-list-to-lisp t))))
(insert (org-list-to-subtree list)))))
(defun org-list-insert-radio-list ()
"Insert a radio list template appropriate for this major mode."
(interactive)
(let* ((e (cl-assoc-if #'derived-mode-p org-list-radio-list-templates))
(txt (nth 1 e))
name pos)
(unless e (error "No radio list setup defined for %s" major-mode))
(setq name (read-string "List name: "))
(while (string-match "%n" txt)
(setq txt (replace-match name t t txt)))
(or (bolp) (insert "\n"))
(setq pos (point))
(insert txt)
(goto-char pos)))
(defun org-list-send-list (&optional maybe)
"Send a transformed version of this list to the receiver position.
With argument MAYBE, fail quietly if no transformation is defined
for this list."
(interactive)
(catch 'exit
(unless (org-at-item-p) (error "Not at a list item"))
(save-excursion
(let ((case-fold-search t))
(re-search-backward "^[ \t]*#\\+ORGLST:" nil t)
(unless (looking-at
"[ \t]*#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\([^ \t\n]+\\)")
(if maybe (throw 'exit nil)
(error "Don't know how to transform this list")))))
(let* ((name (regexp-quote (match-string 1)))
(transform (intern (match-string 2)))
(bottom-point
(save-excursion
(re-search-forward
"\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t)
(match-beginning 0)))
(top-point
(progn
(re-search-backward "#\\+ORGLST" nil t)
(re-search-forward (org-item-beginning-re) bottom-point t)
(match-beginning 0)))
(plain-list (save-excursion
(goto-char top-point)
(org-list-to-lisp))))
(unless (fboundp transform)
(error "No such transformation function %s" transform))
(let ((txt (funcall transform plain-list)))
;; Find the insertion(s) place(s).
(save-excursion
(goto-char (point-min))
(let ((receiver-count 0)
(begin-re (format "BEGIN +RECEIVE +ORGLST +%s\\([ \t]\\|$\\)"
name))
(end-re (format "END +RECEIVE +ORGLST +%s\\([ \t]\\|$\\)"
name)))
(while (re-search-forward begin-re nil t)
(cl-incf receiver-count)
(let ((beg (line-beginning-position 2)))
(unless (re-search-forward end-re nil t)
(user-error "Cannot find end of receiver location at %d" beg))
(beginning-of-line)
(delete-region beg (point))
(insert txt "\n")))
(cond
((> receiver-count 1)
(message "List converted and installed at receiver locations"))
((= receiver-count 1)
(message "List converted and installed at receiver location"))
(t (user-error "No valid receiver location found")))))))))
(let ((item (org-in-item-p)))
(unless item (error "Not in a list"))
(goto-char item)
(let ((level (pcase (org-current-level)
(`nil 1)
(l (1+ (org-reduced-level l)))))
(list (save-excursion (org-list-to-lisp t))))
(insert (org-list-to-subtree list level) "\n"))))
(defun org-list-to-generic (list params)
"Convert a LIST parsed through `org-list-to-lisp' to a custom format.
@ -3577,21 +3467,22 @@ with overruling parameters for `org-list-to-generic'."
:cbtrans "[-] ")))
(org-list-to-generic list (org-combine-plists defaults params))))
(defun org-list-to-subtree (list &optional params)
(defun org-list-to-subtree (list &optional start-level params)
"Convert LIST into an Org subtree.
LIST is as returned by `org-list-to-lisp'. PARAMS is a property
list with overruling parameters for `org-list-to-generic'."
LIST is as returned by `org-list-to-lisp'. Subtree starts at
START-LEVEL or level 1 if nil. PARAMS is a property list with
overruling parameters for `org-list-to-generic'."
(let* ((blank (pcase (cdr (assq 'heading org-blank-before-new-entry))
(`t t)
(`auto (save-excursion
(org-with-limited-levels (outline-previous-heading))
(org-previous-line-empty-p)))))
(level (org-reduced-level (or (org-current-level) 0)))
(level (or start-level 1))
(make-stars
(lambda (_type depth &optional _count)
;; Return the string for the heading, depending on DEPTH
;; of current sub-list.
(let ((oddeven-level (+ level depth)))
(let ((oddeven-level (+ level (1- depth))))
(concat (make-string (if org-odd-levels-only
(1- (* 2 oddeven-level))
oddeven-level)

280
lisp/org/org-macro.el
View file

@ -52,18 +52,24 @@
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-copy "org-element" (datum))
(declare-function org-element-macro-parser "org-element" ())
(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-restriction "org-element" (element))
(declare-function org-element-type "org-element" (element))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-file-contents "org" (file &optional noerror nocache))
(declare-function org-file-url-p "org" (file))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-link-search "ol" (s &optional avoid-pos stealth))
(declare-function org-mode "org" ())
(declare-function org-trim "org" (s &optional keep-lead))
(declare-function vc-backend "vc-hooks" (f))
(declare-function vc-call "vc-hooks" (fun file &rest args) t)
(declare-function vc-exec-after "vc-dispatcher" (code))
(defvar org-link-search-must-match-exact-headline)
;;; Variables
(defvar-local org-macro-templates nil
@ -77,95 +83,100 @@ directly, use instead:
;;; Functions
(defun org-macro--collect-macros ()
(defun org-macro--set-template (name value templates)
"Set template for the macro NAME.
VALUE is the template of the macro. The new value override the
previous one, unless VALUE is nil. TEMPLATES is the list of
templates. Return the updated list."
(when value
(let ((old-definition (assoc name templates)))
(if old-definition
(setcdr old-definition value)
(push (cons name value) templates))))
templates)
(defun org-macro--collect-macros (&optional files templates)
"Collect macro definitions in current buffer and setup files.
Return an alist containing all macro templates found."
(letrec ((collect-macros
(lambda (files templates)
;; Return an alist of macro templates. FILES is a list
;; of setup files names read so far, used to avoid
;; circular dependencies. TEMPLATES is the alist
;; collected so far.
(let ((case-fold-search t))
(org-with-wide-buffer
(goto-char (point-min))
(while (re-search-forward
"^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t)
(let ((element (org-element-at-point)))
(when (eq (org-element-type element) 'keyword)
(let ((val (org-element-property :value element)))
(if (equal (org-element-property :key element) "MACRO")
;; Install macro in TEMPLATES.
(when (string-match
"^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val)
(let* ((name (match-string 1 val))
(template (or (match-string 2 val) ""))
(old-cell (assoc name templates)))
(if old-cell (setcdr old-cell template)
(push (cons name template) templates))))
;; Enter setup file.
(let* ((uri (org-unbracket-string "\"" "\"" (org-trim val)))
(uri-is-url (org-file-url-p uri))
(uri (if uri-is-url
uri
(expand-file-name uri))))
;; Avoid circular dependencies.
(unless (member uri files)
(with-temp-buffer
(unless uri-is-url
(setq default-directory
(file-name-directory uri)))
(org-mode)
(insert (org-file-contents uri 'noerror))
(setq templates
(funcall collect-macros (cons uri files)
templates)))))))))))
templates))))
(funcall collect-macros nil nil)))
Return an alist containing all macro templates found.
FILES is a list of setup files names read so far, used to avoid
circular dependencies. TEMPLATES is the alist collected so far.
The two arguments are used in recursive calls."
(let ((case-fold-search t))
(org-with-point-at 1
(while (re-search-forward "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t)
(let ((element (org-element-at-point)))
(when (eq (org-element-type element) 'keyword)
(let ((val (org-element-property :value element)))
(if (equal "MACRO" (org-element-property :key element))
;; Install macro in TEMPLATES.
(when (string-match "^\\(\\S-+\\)[ \t]*" val)
(let ((name (match-string 1 val))
(value (substring val (match-end 0))))
(setq templates
(org-macro--set-template name value templates))))
;; Enter setup file.
(let* ((uri (org-strip-quotes val))
(uri-is-url (org-file-url-p uri))
(uri (if uri-is-url
uri
(expand-file-name uri))))
;; Avoid circular dependencies.
(unless (member uri files)
(with-temp-buffer
(unless uri-is-url
(setq default-directory (file-name-directory uri)))
(org-mode)
(insert (org-file-contents uri 'noerror))
(setq templates
(org-macro--collect-macros
(cons uri files) templates)))))))))))
(let ((macros `(("author" . ,(org-macro--find-keyword-value "AUTHOR"))
("email" . ,(org-macro--find-keyword-value "EMAIL"))
("title" . ,(org-macro--find-keyword-value "TITLE" t))
("date" . ,(org-macro--find-date)))))
(pcase-dolist (`(,name . ,value) macros)
(setq templates (org-macro--set-template name value templates))))
templates))
(defun org-macro-initialize-templates ()
"Collect macro templates defined in current buffer.
Templates are stored in buffer-local variable
`org-macro-templates'. In addition to buffer-defined macros, the
function installs the following ones: \"property\",
\"time\". and, if the buffer is associated to a file,
\"input-file\" and \"modification-time\"."
(let* ((templates nil)
(update-templates
(lambda (cell)
(let ((old-template (assoc (car cell) templates)))
(if old-template (setcdr old-template (cdr cell))
(push cell templates))))))
;; Install "property", "time" macros.
(mapc update-templates
(list (cons "property"
"(eval (save-excursion
(let ((l \"$2\"))
(when (org-string-nw-p l)
(condition-case _
(let ((org-link-search-must-match-exact-headline t))
(org-link-search l nil t))
(error
(error \"Macro property failed: cannot find location %s\"
l)))))
(org-entry-get nil \"$1\" 'selective)))")
(cons "time" "(eval (format-time-string \"$1\"))")))
;; Install "input-file", "modification-time" macros.
(let ((visited-file (buffer-file-name (buffer-base-buffer))))
(when (and visited-file (file-exists-p visited-file))
(mapc update-templates
(list (cons "input-file" (file-name-nondirectory visited-file))
(cons "modification-time"
(format "(eval (format-time-string \"$1\" (or (and (org-string-nw-p \"$2\") (org-macro--vc-modified-time %s)) '%s)))"
(prin1-to-string visited-file)
(prin1-to-string
(file-attribute-modification-time
(file-attributes visited-file)))))))))
;; Initialize and install "n" macro.
(org-macro--counter-initialize)
(funcall update-templates
(cons "n" "(eval (org-macro--counter-increment \"$1\" \"$2\"))"))
(setq org-macro-templates (nconc (org-macro--collect-macros) templates))))
`org-macro-templates'.
In addition to buffer-defined macros, the function installs the
following ones: \"n\", \"author\", \"email\", \"keyword\",
\"time\", \"property\", and, if the buffer is associated to
a file, \"input-file\" and \"modification-time\"."
(require 'org-element)
(org-macro--counter-initialize) ;for "n" macro
(setq org-macro-templates
(nconc
;; Install user-defined macros.
(org-macro--collect-macros)
;; Install file-specific macros.
(let ((visited-file (buffer-file-name (buffer-base-buffer))))
(and visited-file
(file-exists-p visited-file)
(list
`("input-file" . ,(file-name-nondirectory visited-file))
`("modification-time" .
,(format "(eval
\(format-time-string $1
(or (and (org-string-nw-p $2)
(org-macro--vc-modified-time %s))
'%s)))"
(prin1-to-string visited-file)
(prin1-to-string
(file-attribute-modification-time
(file-attributes visited-file))))))))
;; Install generic macros.
(list
'("n" . "(eval (org-macro--counter-increment $1 $2))")
'("keyword" . "(eval (org-macro--find-keyword-value $1))")
'("time" . "(eval (format-time-string $1))")
'("property" . "(eval (org-macro--get-property $1 $2))")))))
(defun org-macro-expand (macro templates)
"Return expanded MACRO, as a string.
@ -177,31 +188,35 @@ default value. Return nil if no template was found."
;; Macro names are case-insensitive.
(cdr (assoc-string (org-element-property :key macro) templates t))))
(when template
(let ((value (replace-regexp-in-string
"\\$[0-9]+"
(lambda (arg)
(or (nth (1- (string-to-number (substring arg 1)))
(org-element-property :args macro))
;; No argument: remove place-holder.
""))
template nil 'literal)))
;; VALUE starts with "(eval": it is a s-exp, `eval' it.
(when (string-match "\\`(eval\\>" value)
(setq value (eval (read value))))
;; Return string.
(let* ((eval? (string-match-p "\\`(eval\\>" template))
(value
(replace-regexp-in-string
"\\$[0-9]+"
(lambda (m)
(let ((arg (or (nth (1- (string-to-number (substring m 1)))
(org-element-property :args macro))
;; No argument: remove place-holder.
"")))
;; `eval' implies arguments are strings.
(if eval? (format "%S" arg) arg)))
template nil 'literal)))
(when eval?
(setq value (eval (condition-case nil (read value)
(error (debug))))))
;; Force return value to be a string.
(format "%s" (or value ""))))))
(defun org-macro-replace-all (templates &optional finalize keywords)
(defun org-macro-replace-all (templates &optional keywords)
"Replace all macros in current buffer by their expansion.
TEMPLATES is an alist of templates used for expansion. See
`org-macro-templates' for a buffer-local default value.
If optional arg FINALIZE is non-nil, raise an error if a macro is
found in the buffer with no definition in TEMPLATES.
Optional argument KEYWORDS, when non-nil is a list of keywords,
as strings, where macro expansion is allowed."
as strings, where macro expansion is allowed.
Return an error if a macro in the buffer cannot be associated to
a definition in TEMPLATES."
(org-with-wide-buffer
(goto-char (point-min))
(let ((properties-regexp (format "\\`EXPORT_%s\\+?\\'"
@ -225,7 +240,8 @@ as strings, where macro expansion is allowed."
(goto-char (match-beginning 0))
(org-element-macro-parser))))))
(when macro
(let* ((value (org-macro-expand macro templates))
(let* ((key (org-element-property :key macro))
(value (org-macro-expand macro templates))
(begin (org-element-property :begin macro))
(signature (list begin
macro
@ -234,8 +250,7 @@ as strings, where macro expansion is allowed."
;; macro with the same arguments is expanded at the
;; same position twice.
(cond ((member signature record)
(error "Circular macro expansion: %s"
(org-element-property :key macro)))
(error "Circular macro expansion: %s" key))
(value
(push signature record)
(delete-region
@ -247,7 +262,11 @@ as strings, where macro expansion is allowed."
;; Leave point before replacement in case of
;; recursive expansions.
(save-excursion (insert value)))
(finalize
;; Special "results" macro: if it is not defined,
;; simply leave it as-is. It will be expanded in
;; a second phase.
((equal key "results"))
(t
(error "Undefined Org macro: %s; aborting"
(org-element-property :key macro))))))))))))
@ -295,6 +314,53 @@ Return a list of arguments, as strings. This is the opposite of
;;; Helper functions and variables for internal macros
(defun org-macro--get-property (property location)
"Find PROPERTY's value at LOCATION.
PROPERTY is a string. LOCATION is a search string, as expected
by `org-link-search', or the empty string."
(save-excursion
(when (org-string-nw-p location)
(condition-case _
(let ((org-link-search-must-match-exact-headline t))
(org-link-search location nil t))
(error
(error "Macro property failed: cannot find location %s" location))))
(org-entry-get nil property 'selective)))
(defun org-macro--find-keyword-value (name &optional collect)
"Find value for keyword NAME in current buffer.
Return value associated to the keywords named after NAME, as
a string, or nil. When optional argument COLLECT is non-nil,
concatenate values, separated with a space, from various keywords
in the buffer."
(org-with-point-at 1
(let ((regexp (format "^[ \t]*#\\+%s:" (regexp-quote name)))
(case-fold-search t)
(result nil))
(catch :exit
(while (re-search-forward regexp nil t)
(let ((element (org-element-at-point)))
(when (eq 'keyword (org-element-type element))
(let ((value (org-element-property :value element)))
(if (not collect) (throw :exit value)
(setq result (concat result " " value)))))))
(and result (org-trim result))))))
(defun org-macro--find-date ()
"Find value for DATE in current buffer.
Return value as a string."
(let* ((value (org-macro--find-keyword-value "DATE"))
(date (org-element-parse-secondary-string
value (org-element-restriction 'keyword))))
(if (and (consp date)
(not (cdr date))
(eq 'timestamp (org-element-type (car date))))
(format "(eval (if (org-string-nw-p $1) %s %S))"
(format "(org-timestamp-format '%S $1)"
(org-element-copy (car date)))
value)
value)))
(defun org-macro--vc-modified-time (file)
(save-window-excursion
(when (vc-backend file)
@ -313,7 +379,7 @@ Return a list of arguments, as strings. This is the opposite of
(buffer-substring
(point) (line-end-position)))))
(when (cl-some #'identity time)
(setq date (encode-time time))))))))
(setq date (apply #'encode-time time))))))))
(let ((proc (get-buffer-process buf)))
(while (and proc (accept-process-output proc .5 nil t)))))
(kill-buffer buf))

1238
lisp/org/org-macs.el
View file

File diff suppressed because it is too large Load diff

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

@ -24,18 +24,17 @@
;;
;;; Commentary:
;;
;; This file contains the code to interact with Richard Moreland's
;; iPhone application MobileOrg, as well as with the Android version
;; by Matthew Jones. This code is documented in Appendix B of the Org
;; manual. The code is not specific for the iPhone and Android - any
;; external viewer/flagging/editing application that uses the same
;; conventions could be used.
;; This file contains the code to interact with a mobile application,
;; such as Richard Moreland's iPhone application MobileOrg, or the
;; Android version by Matthew Jones. This code is documented in
;; Appendix B of the Org manual. The code is not specific for the
;; iPhone and Android - any external viewer/flagging/editing
;; application that uses the same conventions could be used.
(require 'cl-lib)
(require 'org)
(require 'org-agenda)
(require 'cl-lib)
(defvar org-agenda-keep-restricted-file-list)
(require 'ol)
;;; Code:
@ -45,15 +44,17 @@
:group 'org)
(defcustom org-mobile-files '(org-agenda-files)
"Files to be staged for MobileOrg.
"Files to be staged for the mobile application.
This is basically a list of files and directories. Files will be staged
directly. Directories will be search for files with the extension `.org'.
directly. Directories will be search for files with the extension \".org\".
In addition to this, the list may also contain the following symbols:
org-agenda-files
`org-agenda-files'
This means include the complete, unrestricted list of files given in
the variable `org-agenda-files'.
org-agenda-text-search-extra-files
`org-agenda-text-search-extra-files'
Include the files given in the variable
`org-agenda-text-search-extra-files'."
:group 'org-mobile
@ -84,12 +85,14 @@ org-agenda-text-search-extra-files
(defcustom org-mobile-use-encryption nil
"Non-nil means keep only encrypted files on the WebDAV server.
Encryption uses AES-256, with a password given in
`org-mobile-encryption-password'.
When nil, plain files are kept on the server.
Turning on encryption requires setting the same password in the MobileOrg
application. Before turning this on, check of MobileOrg does already
support it - at the time of this writing it did not yet."
`org-mobile-encryption-password'. When nil, plain files are kept
on the server.
Turning on encryption requires setting the same password in the
mobile application. Before turning this on, check if the mobile
application does support it."
:group 'org-mobile
:version "24.1"
:type 'boolean)
@ -104,9 +107,10 @@ You might want to put this file into a directory where only you have access."
(defcustom org-mobile-encryption-password ""
"Password for encrypting files uploaded to the server.
This is a single password which is used for AES-256 encryption. The same
password must also be set in the MobileOrg application. All Org files,
including mobileorg.org will be encrypted using this password.
password must also be set in the mobile application. All Org files,
including \"mobileorg.org\" will be encrypted using this password.
SECURITY CONSIDERATIONS:
@ -129,12 +133,12 @@ session."
(or (org-string-nw-p org-mobile-encryption-password)
(org-string-nw-p org-mobile-encryption-password-session)
(setq org-mobile-encryption-password-session
(read-passwd "Password for MobileOrg: " t))))
(read-passwd "Password for mobile application: " t))))
(defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org"
"The file where captured notes and flags will be appended to.
During the execution of `org-mobile-pull', the file
`org-mobile-capture-file' will be emptied it's contents have
`org-mobile-capture-file' is emptied as soon as its contents have
been appended to the file given here. This file should be in
`org-directory', and not in the staging area or on the web server."
:group 'org-mobile
@ -142,23 +146,25 @@ been appended to the file given here. This file should be in
(defconst org-mobile-capture-file "mobileorg.org"
"The capture file where the mobile stores captured notes and flags.
This should not be changed, because MobileOrg assumes this name.")
This must not be changed, because the mobile application assumes this name.")
(defcustom org-mobile-index-file "index.org"
"The index file with links to all Org files that should be loaded by MobileOrg.
Relative to `org-mobile-directory'. The Address field in the MobileOrg setup
should point to this file."
"Index file with links to all Org files.
It should be loaded by the mobile application. The file name is
relative to `org-mobile-directory'. The \"Address\" field in the
mobile application setup should point to this file."
:group 'org-mobile
:type 'file)
(defcustom org-mobile-agendas 'all
"The agendas that should be pushed to MobileOrg.
"The agendas that should be pushed to the mobile application.
Allowed values:
default the weekly agenda and the global TODO list
custom all custom agendas defined by the user
all the custom agendas and the default ones
list a list of selection key(s) as string."
`default' the weekly agenda and the global TODO list
`custom' all custom agendas defined by the user
`all' the custom agendas and the default ones
`list' a list of selection key(s) as string."
:group 'org-mobile
:version "24.1"
:type '(choice
@ -229,7 +235,9 @@ using `rsync' or `scp'.")
(defconst org-mobile-action-alist '(("edit" . org-mobile-edit))
"Alist with flags and actions for mobile sync.
When flagging an entry, MobileOrg will create entries that look like
When flagging an entry, the mobile application creates entries
that look like
* F(action:data) [[id:entry-id][entry title]]
@ -311,6 +319,11 @@ create all custom agenda views, for upload to the mobile phone."
(let ((org-agenda-buffer-name "*SUMO*")
(org-agenda-tag-filter org-agenda-tag-filter)
(org-agenda-redo-command org-agenda-redo-command))
;; Offer to save agenda-related buffers before pushing, preventing
;; "Non-existent agenda file" prompt for lock files (see #19448).
(let ((agenda-buffers (org-buffer-list 'agenda)))
(save-some-buffers nil
(lambda () (memq (current-buffer) agenda-buffers))))
(save-excursion
(save-restriction
(save-window-excursion
@ -656,8 +669,7 @@ The table of checksums is written to the file mobile-checksums."
(org-mobile-escape-olp (nth 4 (org-heading-components))))))
(defun org-mobile-escape-olp (s)
(let ((table '(?: ?/)))
(org-link-escape s table)))
(org-link-encode s '(?: ?/)))
(defun org-mobile-create-sumo-agenda ()
"Create a file that contains all custom agenda views."
@ -869,7 +881,7 @@ If BEG and END are given, only do this in that region."
(funcall cmd data old new)
(unless (member data '("delete" "archive" "archive-sibling"
"addheading"))
(when (member "FLAGGED" (org-get-tags))
(when (member "FLAGGED" (org-get-tags nil t))
(add-to-list 'org-mobile-last-flagged-files
(buffer-file-name)))))
(error (setq org-mobile-error msg)))
@ -951,7 +963,7 @@ is currently a noop.")
(if (not (string-match "\\`olp:\\(.*?\\)$" link))
nil
(let ((file (match-string 1 link)))
(setq file (org-link-unescape file))
(setq file (org-link-decode file))
(setq file (expand-file-name file org-directory))
(save-excursion
(find-file file)
@ -961,9 +973,9 @@ is currently a noop.")
(point-marker))))
(let ((file (match-string 1 link))
(path (match-string 2 link)))
(setq file (org-link-unescape file))
(setq file (org-link-decode file))
(setq file (expand-file-name file org-directory))
(setq path (mapcar 'org-link-unescape
(setq path (mapcar #'org-link-decode
(org-split-string path "/")))
(org-find-olp (cons file path))))))
@ -994,7 +1006,7 @@ be returned that indicates what went wrong."
old current))))
((eq what 'tags)
(setq current (org-get-tags)
(setq current (org-get-tags nil t)
new1 (and new (org-split-string new ":+"))
old1 (and old (org-split-string old ":+")))
(cond
@ -1002,7 +1014,7 @@ be returned that indicates what went wrong."
((or (org-mobile-tags-same-p current old1)
(eq org-mobile-force-mobile-change t)
(memq 'tags org-mobile-force-mobile-change))
(org-set-tags-to new1) t)
(org-set-tags new1) t)
(t (error "Tags before change were expected as \"%s\", but are \"%s\""
(or old "") (or current "")))))
@ -1031,8 +1043,10 @@ be returned that indicates what went wrong."
(goto-char (match-beginning 4))
(insert new)
(delete-region (point) (+ (point) (length current)))
(org-set-tags nil 'align))
(t (error "Heading changed in MobileOrg and on the computer")))))))
(org-align-tags))
(t
(error
"Heading changed in the mobile device and on the computer")))))))
((eq what 'addheading)
(if (org-at-heading-p) ; if false we are in top-level of file
@ -1085,7 +1099,8 @@ be returned that indicates what went wrong."
(outline-next-heading)
(point))))
t)
(t (error "Body was changed in MobileOrg and on the computer")))))))
(t (error
"Body was changed in the mobile device and on the computer")))))))
(defun org-mobile-tags-same-p (list1 list2)
"Are the two tag lists the same?"

22
lisp/org/org-mouse.el
View file

@ -422,7 +422,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(defun org-mouse-tag-menu () ;todo
"Create the tags menu."
(append
(let ((tags (org-get-tags)))
(let ((tags (org-get-tags nil t)))
(org-mouse-keyword-menu
(sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
`(lambda (tag)
@ -434,22 +434,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
`(lambda (tag) (member tag (quote ,tags)))
))
'("--"
["Align Tags Here" (org-set-tags nil t) t]
["Align Tags in Buffer" (org-set-tags t t) t]
["Set Tags ..." (org-set-tags) t])))
["Align Tags Here" (org-align-tags) t]
["Align Tags in Buffer" (org-align-tags t) t]
["Set Tags ..." (org-set-tags-command) t])))
(defun org-mouse-set-tags (tags)
(save-excursion
;; remove existing tags first
(beginning-of-line)
(when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)")
(replace-match ""))
;; set new tags if any
(when tags
(end-of-line)
(insert " :" (mapconcat 'identity tags ":") ":")
(org-set-tags nil t))))
(org-set-tags tags))
(defun org-mouse-insert-checkbox ()
(interactive)
@ -498,7 +488,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
`("Main Menu"
["Show Overview" org-mouse-show-overview t]
["Show Headlines" org-mouse-show-headlines t]
["Show All" outline-show-all t]
["Show All" org-show-all t]
["Remove Highlights" org-remove-occur-highlights
:visible org-occur-highlights]
"--"

469
lisp/org/org-num.el Normal file
View file

@ -0,0 +1,469 @@
;;; org-num.el --- Dynamic Headlines Numbering -*- lexical-binding: t; -*-
;; Copyright (C) 2018-2019 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, wp
;; 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 provides dynamic numbering for Org headlines. Use
;;
;; <M-x org-num-mode>
;;
;; to toggle it.
;;
;; You can select what is numbered according to level, tags, COMMENT
;; keyword, or UNNUMBERED property. You can also skip footnotes
;; sections. See `org-num-max-level', `org-num-skip-tags',
;; `org-num-skip-commented', `org-num-skip-unnumbered', and
;; `org-num-skip-footnotes' for details.
;;
;; You can also control how the numbering is displayed by setting
;;`org-num-face' and `org-num-format-function'.
;;
;; Internally, the library handles an ordered list, per buffer
;; position, of overlays in `org-num--overlays'. These overlays are
;; marked with the `org-num' property set to a non-nil value.
;;
;; Overlays store the level of the headline in the `level' property,
;; and the face used for the numbering in `numbering-face'.
;;
;; The `skip' property is set to t when the corresponding headline has
;; some characteristic -- e.g., a node property, or a tag -- that
;; prevents it from being numbered.
;;
;; An overlay with `org-num' property set to `invalid' is called an
;; invalid overlay. Modified overlays automatically become invalid
;; and set `org-num--invalid-flag' to a non-nil value. After
;; a change, `org-num--invalid-flag' indicates numbering needs to be
;; updated and invalid overlays indicate where the buffer needs to be
;; parsed. So does `org-num--missing-overlay' variable. See
;; `org-num--verify' function for details.
;;
;; Numbering display is done through the `after-string' property.
;;; Code:
(require 'cl-lib)
(require 'org-macs)
(defvar org-comment-string)
(defvar org-complex-heading-regexp)
(defvar org-cycle-level-faces)
(defvar org-footnote-section)
(defvar org-level-faces)
(defvar org-n-level-faces)
(defvar org-odd-levels-only)
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-reduced-level "org" (l))
;;; Customization
(defcustom org-num-face nil
"Face to use for numbering.
When nil, use the same face as the headline. This value is
ignored if `org-num-format-function' specifies a face for its
output."
:group 'org-appearance
:package-version '(Org . "9.3")
:type '(choice (const :tag "Like the headline" nil)
(face :tag "Use face"))
:safe (lambda (val) (or (null val) (facep val))))
(defcustom org-num-format-function 'org-num-default-format
"Function used to display numbering.
It is called with one argument, a list of numbers, and should
return a string, or nil. When nil, no numbering is displayed.
Any `face' text property on the returned string overrides
`org-num-face'."
:group 'org-appearance
:package-version '(Org . "9.3")
:type 'function
:safe nil)
(defcustom org-num-max-level nil
"Level below which headlines are not numbered.
When set to nil, all headlines are numbered."
:group 'org-appearance
:package-version '(Org . "9.3")
:type '(choice (const :tag "Number everything" nil)
(integer :tag "Stop numbering at level"))
:safe (lambda (val) (or (null val) (wholenump val))))
(defcustom org-num-skip-commented nil
"Non-nil means commented sub-trees are not numbered."
:group 'org-appearance
:package-version '(Org . "9.3")
:type 'boolean
:safe #'booleanp)
(defcustom org-num-skip-footnotes nil
"Non-nil means footnotes sections are not numbered."
:group 'org-appearance
:package-version '(Org . "9.3")
:type 'boolean
:safe #'booleanp)
(defcustom org-num-skip-tags nil
"List of tags preventing the numbering of sub-trees.
For example, add \"ARCHIVE\" to this list to avoid numbering
archived sub-trees.
Tag in this list prevent numbering the whole sub-tree,
irrespective to `org-use-tags-inheritance', or other means to
control tag inheritance."
:group 'org-appearance
:package-version '(Org . "9.3")
:type '(repeat (string :tag "Tag"))
:safe (lambda (val) (and (listp val) (cl-every #'stringp val))))
(defcustom org-num-skip-unnumbered nil
"Non-nil means numbering obeys to UNNUMBERED property."
:group 'org-appearance
:package-version '(Org . "9.3")
:type 'boolean
:safe #'booleanp)
;;; Internal Variables
(defconst org-num--comment-re (format "\\`%s\\(?: \\|$\\)" org-comment-string)
"Regexp matching a COMMENT keyword at headline beginning.")
(defvar-local org-num--overlays nil
"Ordered list of overlays used for numbering outlines.")
(defvar-local org-num--skip-level nil
"Level below which headlines from current tree are not numbered.
When nil, all headlines are numbered. It is used to handle
inheritance of no-numbering attributes.")
(defvar-local org-num--numbering nil
"Current headline numbering.
A numbering is a list of integers, in reverse order. So numbering
for headline \"1.2.3\" is (3 2 1).")
(defvar-local org-num--missing-overlay nil
"Buffer position signaling a headline without an overlay.")
(defvar-local org-num--invalid-flag nil
"Non-nil means an overlay became invalid since last update.")
;;; Internal Functions
(defsubst org-num--headline-regexp ()
"Return regexp matching a numbered headline."
(if (null org-num-max-level) (org-with-limited-levels org-outline-regexp-bol)
(format "^\\*\\{1,%d\\} "
(if org-odd-levels-only (1- (* 2 org-num-max-level))
org-num-max-level))))
(defsubst org-num--overlay-p (o)
"Non-nil if overlay O is a numbering overlay."
(overlay-get o 'org-num))
(defsubst org-num--valid-overlay-p (o)
"Non-nil if overlay O is still active in the buffer."
(not (eq 'invalid (overlay-get o 'org-num))))
(defsubst org-num--invalidate-overlay (o)
"Mark overlay O as invalid.
Update `org-num--invalid-flag' accordingly."
(overlay-put o 'org-num 'invalid)
(setq org-num--invalid-flag t))
(defun org-num--clear ()
"Remove all numbering overlays in current buffer."
(mapc #'delete-overlay org-num--overlays)
(setq org-num--overlays nil))
(defun org-num--make-overlay (numbering level skip)
"Return overlay for numbering headline at point.
NUMBERING is the numbering to use, as a list of integers, or nil
if nothing should be displayed. LEVEL is the level of the
headline. SKIP is its skip value.
Assume point is at a headline."
(let ((after-edit-functions
(list (lambda (o &rest _) (org-num--invalidate-overlay o))))
(o (save-excursion
(beginning-of-line)
(skip-chars-forward "*")
(make-overlay (line-beginning-position) (1+ (point))))))
(overlay-put o 'org-num t)
(overlay-put o 'skip skip)
(overlay-put o 'level level)
(overlay-put o 'numbering-face
(or org-num-face
;; Compute face that would be used at the
;; headline. We cannot extract it from the
;; buffer: at the time the overlay is created,
;; Font Lock has not proceeded yet.
(nth (if org-cycle-level-faces
(% (1- level) org-n-level-faces)
(1- (min level org-n-level-faces)))
org-level-faces)))
(overlay-put o 'modification-hooks after-edit-functions)
(overlay-put o 'insert-in-front-hooks after-edit-functions)
(org-num--refresh-display o numbering)
o))
(defun org-num--refresh-display (overlay numbering)
"Refresh OVERLAY's display.
NUMBERING specifies the new numbering, as a list of integers, or
nil if nothing should be displayed. Assume OVERLAY is valid."
(let ((display (and numbering
(funcall org-num-format-function (reverse numbering)))))
(when (and display (not (get-text-property 0 'face display)))
(org-add-props display `(face ,(overlay-get overlay 'numbering-face))))
(overlay-put overlay 'after-string display)))
(defun org-num--skip-value ()
"Return skip value for headline at point.
Value is t when headline should not be numbered, and nil
otherwise."
(org-match-line org-complex-heading-regexp)
(let ((title (match-string 4))
(tags (and org-num-skip-tags
(match-end 5)
(org-split-string (match-string 5) ":"))))
(or (and org-num-skip-footnotes
org-footnote-section
(equal title org-footnote-section))
(and org-num-skip-commented
(let ((case-fold-search nil))
(string-match org-num--comment-re title))
t)
(and org-num-skip-tags
(cl-some (lambda (tag) (member tag org-num-skip-tags))
tags)
t)
(and org-num-skip-unnumbered
(org-entry-get (point) "UNNUMBERED")
t))))
(defun org-num--current-numbering (level skip)
"Return numbering for current headline.
LEVEL is headline's level, and SKIP its skip value. Return nil
if headline should be skipped."
(cond
;; Skipped by inheritance.
((and org-num--skip-level (> level org-num--skip-level)) nil)
;; Skipped by a non-nil skip value; set `org-num--skip-level'
;; to skip the whole sub-tree later on.
(skip (setq org-num--skip-level level) nil)
(t
(setq org-num--skip-level nil)
;; Compute next numbering, and update `org-num--numbering'.
(let ((last-level (length org-num--numbering)))
(setq org-num--numbering
(cond
;; First headline : nil => (1), or (1 0)...
((null org-num--numbering) (cons 1 (make-list (1- level) 0)))
;; Sibling: (1 1) => (2 1).
((= level last-level)
(cons (1+ (car org-num--numbering)) (cdr org-num--numbering)))
;; Parent: (1 1 1) => (2 1), or (2).
((< level last-level)
(let ((suffix (nthcdr (- last-level level) org-num--numbering)))
(cons (1+ (car suffix)) (cdr suffix))))
;; Child: (1 1) => (1 1 1), or (1 0 1 1)...
(t
(append (cons 1 (make-list (- level last-level 1) 0))
org-num--numbering))))))))
(defun org-num--number-region (start end)
"Add numbering overlays between START and END positions.
When START or END are nil, use buffer boundaries. Narrowing, if
any, is ignored. Return the list of created overlays, newest
first."
(org-with-point-at (or start 1)
;; Do not match headline starting at START.
(when start (end-of-line))
(let ((regexp (org-num--headline-regexp))
(new nil))
(while (re-search-forward regexp end t)
(let* ((level (org-reduced-level
(- (match-end 0) (match-beginning 0) 1)))
(skip (org-num--skip-value))
(numbering (org-num--current-numbering level skip)))
;; Apply numbering to current headline. Store overlay for
;; the return value.
(push (org-num--make-overlay numbering level skip)
new)))
new)))
(defun org-num--update ()
"Update buffer's numbering.
This function removes invalid overlays and refreshes numbering
for the valid ones in the numbering overlays list. It also adds
missing overlays to that list."
(setq org-num--skip-level nil)
(setq org-num--numbering nil)
(let ((new-overlays nil)
(overlay nil))
(while (setq overlay (pop org-num--overlays))
(cond
;; Valid overlay.
;;
;; First handle possible missing overlays OVERLAY. If missing
;; overlay marker is pointing before next overlay and after the
;; last known overlay, make sure to parse the buffer between
;; these two overlays.
((org-num--valid-overlay-p overlay)
(let ((next (overlay-start overlay))
(last (and new-overlays (overlay-start (car new-overlays)))))
(cond
((null org-num--missing-overlay))
((> org-num--missing-overlay next))
((or (null last) (> org-num--missing-overlay last))
(setq org-num--missing-overlay nil)
(setq new-overlays (nconc (org-num--number-region last next)
new-overlays)))
;; If it is already after the last known overlay, reset it:
;; some previous invalid overlay already triggered the
;; necessary parsing.
(t
(setq org-num--missing-overlay nil))))
;; Update OVERLAY's numbering.
(let* ((level (overlay-get overlay 'level))
(skip (overlay-get overlay 'skip))
(numbering (org-num--current-numbering level skip)))
(org-num--refresh-display overlay numbering)
(push overlay new-overlays)))
;; Invalid overlay. It indicates that the buffer needs to be
;; parsed again between the two surrounding valid overlays or
;; buffer boundaries.
(t
;; Delete all consecutive invalid overlays: we re-create all
;; overlays between last valid overlay and the next one.
(delete-overlay overlay)
(while (and org-num--overlays
(not (org-num--valid-overlay-p (car org-num--overlays))))
(delete-overlay (pop org-num--overlays)))
;; Create and register new overlays.
(let ((last (and new-overlays (overlay-start (car new-overlays))))
(next (and org-num--overlays
(overlay-start (car org-num--overlays)))))
(setq new-overlays (nconc (org-num--number-region last next)
new-overlays))))))
;; If invalid position hasn't been handled yet, it must be located
;; between last valid overlay and end of the buffer. Parse that
;; area before returning.
(when org-num--missing-overlay
(let ((last (and new-overlays (overlay-start (car new-overlays)))))
(setq new-overlays (nconc (org-num--number-region last nil)
new-overlays))))
;; Numbering is now up-to-date. Reset invalid flag. Also return
;; `org-num--overlays' in a sorted fashion.
(setq org-num--invalid-flag nil)
(setq org-num--overlays (nreverse new-overlays))))
(defun org-num--verify (beg end _)
"Check numbering integrity; update it if necessary.
This function is meant to be used in `after-change-functions'.
See this variable for the meaning of BEG and END."
(setq org-num--missing-overlay nil)
(save-match-data
(org-with-point-at beg
(let ((regexp (org-num--headline-regexp)))
;; At this point, directly altered overlays between BEG and
;; END are marked as invalid and will trigger a full update.
;; However, there are still two cases to handle.
;;
;; First, some valid overlays may need to be invalidated, due
;; to an indirect change. That happens when the skip value --
;; see `org-num--skip-value' -- of the heading BEG belongs to
;; is altered, or when deleting the newline character right
;; before the next headline.
(save-excursion
;; Bail out if we're before first headline or within
;; a headline too deep to be numbered.
(when (and (org-with-limited-levels
(ignore-errors (org-back-to-heading t)))
(looking-at regexp))
(pcase (get-char-property-and-overlay (point) 'org-num)
(`(nil)
;; At a headline, without a numbering overlay: change
;; just created one. Mark it for parsing.
(setq org-num--missing-overlay (point)))
(`(t . ,o)
;; Check if skip value changed. Invalidate overlay
;; accordingly.
(unless (eq (org-num--skip-value) (overlay-get o 'skip))
(org-num--invalidate-overlay o)))
(_ nil))))
;; Deleting the newline character before a numbering overlay
;; doesn't invalidate it, even though it could land in the
;; middle of a line. Be sure to catch this case.
(when (and (= beg end) (not (bolp)))
(pcase (get-char-property-and-overlay (point) 'org-num)
(`(t . ,o) (org-num--invalidate-overlay o))
(_ nil)))
;; Second, if nothing is marked as invalid, and therefore if
;; no full update is due so far, changes may still have
;; created new headlines, at BEG -- which is actually handled
;; by the previous phase --, or, in case of a multi-line
;; insertion, at END, or in-between.
(unless (or org-num--invalid-flag
org-num--missing-overlay
(<= end (line-end-position))) ;single line change
(forward-line)
(when (or (re-search-forward regexp end 'move)
;; Check if change created a headline after END.
(progn (skip-chars-backward "*") (looking-at regexp)))
(setq org-num--missing-overlay (line-beginning-position))))))
;; Update numbering only if a headline was altered or created.
(when (or org-num--missing-overlay org-num--invalid-flag)
(org-num--update))))
;;; Public Functions
;;;###autoload
(defun org-num-default-format (numbering)
"Default numbering display function.
NUMBERING is a list of numbers."
(concat (mapconcat #'number-to-string numbering ".") " "))
;;;###autoload
(define-minor-mode org-num-mode
"Dynamic numbering of headlines in an Org buffer."
:lighter " o#"
(cond
(org-num-mode
(unless (derived-mode-p 'org-mode)
(user-error "Cannot activate headline numbering outside Org mode"))
(setq org-num--numbering nil)
(setq org-num--overlays (nreverse (org-num--number-region nil nil)))
(add-hook 'after-change-functions #'org-num--verify nil t)
(add-hook 'change-major-mode-hook #'org-num--clear nil t))
(t
(org-num--clear)
(remove-hook 'after-change-functions #'org-num--verify t)
(remove-hook 'change-major-mode-hook #'org-num--clear t))))
(provide 'org-num)
;;; org-num.el ends here

257
lisp/org/org-pcomplete.el
View file

@ -31,70 +31,126 @@
(require 'org-compat)
(require 'pcomplete)
(declare-function org-make-org-heading-search-string "org" (&optional string))
(declare-function org-get-buffer-tags "org" ())
(declare-function org-get-tags "org" ())
(declare-function org-buffer-property-keys "org"
(&optional specials defaults columns ignore-malformed))
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-buffer-property-keys "org" (&optional specials defaults columns))
(declare-function org-element-at-point "org-element" ())
(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))
(declare-function org-entry-properties "org" (&optional pom which))
(declare-function org-export-backend-options "ox" (cl-x) t)
(declare-function org-get-buffer-tags "org" ())
(declare-function org-get-export-keywords "org" ())
(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-link-heading-search-string "ol" (&optional string))
(declare-function org-tag-alist-to-string "org" (alist &optional skip-key))
;;;; Customization variables
(defvar org-drawer-regexp)
(defvar org-property-re)
(defvar org-current-tag-alist)
(defvar org-default-priority)
(defvar org-drawer-regexp)
(defvar org-element-affiliated-keywords)
(defvar org-entities)
(defvar org-export-default-language)
(defvar org-export-exclude-tags)
(defvar org-export-select-tags)
(defvar org-file-tags)
(defvar org-highest-priority)
(defvar org-link-abbrev-alist)
(defvar org-link-abbrev-alist-local)
(defvar org-lowest-priority)
(defvar org-options-keywords)
(defvar org-outline-regexp)
(defvar org-property-re)
(defvar org-startup-options)
(defvar org-tag-re)
(defvar org-time-stamp-formats)
(defvar org-todo-keywords-1)
(defvar org-todo-line-regexp)
;;; Internal Functions
(defun org-thing-at-point ()
"Examine the thing at point and let the caller know what it is.
The return value is a string naming the thing at point."
(let ((beg1 (save-excursion
(skip-chars-backward "-[:alnum:]_@")
(point)))
(beg (save-excursion
(skip-chars-backward "-a-zA-Z0-9_:$")
(point)))
(line-to-here (buffer-substring (point-at-bol) (point))))
(let ((line-to-here (org-current-line-string t))
(case-fold-search t))
(cond
((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here)
;; Parameters on a clock table opening line.
((org-match-line "[ \t]*#\\+BEGIN: clocktable[ \t]")
(cons "block-option" "clocktable"))
((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here)
;; Flags and parameters on a source block opening line.
((org-match-line "[ \t]*#\\+BEGIN_SRC[ \t]")
(cons "block-option" "src"))
((save-excursion
(re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*"
(line-beginning-position) t))
;; Value for a known keyword.
((org-match-line "[ \t]*#\\+\\(\\S-+\\):")
(cons "file-option" (match-string-no-properties 1)))
((string-match "\\`[ \t]*#\\+[a-zA-Z_]*\\'" line-to-here)
;; Keyword name.
((and (org-match-line "[ \t]*#\\+[a-zA-Z_]*$")
(looking-at-p "[ \t]*$"))
(cons "file-option" nil))
((equal (char-before beg) ?\[)
;; Link abbreviation.
((save-excursion
(skip-chars-backward "-A-Za-z0-9_")
(and (eq ?\[ (char-before))
(eq ?\[ (char-before (1- (point))))))
(cons "link" nil))
((equal (char-before beg) ?\\)
;; Entities. Some of them accept numbers, but only at their end.
;; So, we first skip numbers, then letters.
((eq ?\\ (save-excursion
(skip-chars-backward "0-9")
(skip-chars-backward "a-zA-Z")
(char-before)))
(cons "tex" nil))
((string-match "\\`\\*+[ \t]+\\'"
(buffer-substring (point-at-bol) beg))
(cons "todo" nil))
((equal (char-before beg) ?*)
(cons "searchhead" nil))
((and (equal (char-before beg1) ?:)
(equal (char-after (point-at-bol)) ?*))
;; Tags on a headline.
((and (org-match-line
(format "\\*+ \\(?:.+? \\)?\\(:\\)\\(\\(?::\\|%s\\)+\\)?[ \t]*$"
org-tag-re))
(or (org-point-in-group (point) 2)
(= (point) (match-end 1))))
(cons "tag" nil))
((and (equal (char-before beg1) ?:)
(not (equal (char-after (point-at-bol)) ?*))
(save-excursion
(move-beginning-of-line 1)
(skip-chars-backward " \t\n")
;; org-drawer-regexp matches a whole line but while
;; looking-back, we just ignore trailing whitespaces
(or (looking-back (substring org-drawer-regexp 0 -1)
(line-beginning-position))
(looking-back org-property-re
(line-beginning-position)))))
(cons "prop" nil))
((and (equal (char-before beg1) ?:)
(not (equal (char-after (point-at-bol)) ?*)))
(cons "drawer" nil))
;; TODO keywords on an empty headline.
((and (string-match "^\\*+ +\\S-*$" line-to-here)
(looking-at-p "[ \t]*$"))
(cons "todo" nil))
;; Heading after a star for search strings or links.
((save-excursion
(skip-chars-backward "^*" (line-beginning-position))
(and (eq ?* (char-before))
(eq (char-before (1- (point))) '?\[)
(eq (char-before (- (point) 2)) '?\[)))
(cons "searchhead" nil))
;; Property or drawer name, depending on point. If point is at
;; a valid location for a node property, offer completion on all
;; node properties in the buffer. Otherwise, offer completion on
;; all drawer names, including "PROPERTIES".
((and (string-match "^[ \t]*:\\S-*$" line-to-here)
(looking-at-p "[ \t]*$"))
(let ((origin (line-beginning-position)))
(if (org-before-first-heading-p) (cons "drawer" nil)
(save-excursion
(org-end-of-meta-data)
(if (or (= origin (point))
(not (org-match-line "[ \t]*:PROPERTIES:[ \t]*$")))
(cons "drawer" nil)
(while (org-match-line org-property-re)
(forward-line))
(if (= origin (point)) (cons "prop" nil)
(cons "drawer" nil)))))))
(t nil))))
(defun org-pcomplete-case-double (list)
"Return list with both upcase and downcase version of all strings in LIST."
(let (e res)
(while (setq e (pop list))
(setq res (cons (downcase e) (cons (upcase e) res))))
(nreverse res)))
;;; Completion API
(defun org-command-at-point ()
"Return the qualified name of the Org completion entity at point.
When completing for #+STARTUP, for example, this function returns
@ -133,9 +189,9 @@ When completing for #+STARTUP, for example, this function returns
(car (org-thing-at-point)))
pcomplete-default-completion-function))))
(defvar org-options-keywords) ; From org.el
(defvar org-element-affiliated-keywords) ; From org-element.el
(declare-function org-get-export-keywords "org" ())
;;; Completion functions
(defun pcomplete/org-mode/file-option ()
"Complete against all valid file options."
(require 'org-element)
@ -167,7 +223,6 @@ When completing for #+STARTUP, for example, this function returns
"Complete arguments for the #+AUTHOR file option."
(pcomplete-here (list user-full-name)))
(defvar org-time-stamp-formats)
(defun pcomplete/org-mode/file-option/date ()
"Complete arguments for the #+DATE file option."
(pcomplete-here (list (format-time-string (car org-time-stamp-formats)))))
@ -176,7 +231,6 @@ When completing for #+STARTUP, for example, this function returns
"Complete arguments for the #+EMAIL file option."
(pcomplete-here (list user-mail-address)))
(defvar org-export-exclude-tags)
(defun pcomplete/org-mode/file-option/exclude_tags ()
"Complete arguments for the #+EXCLUDE_TAGS file option."
(require 'ox)
@ -184,12 +238,10 @@ When completing for #+STARTUP, for example, this function returns
(and org-export-exclude-tags
(list (mapconcat 'identity org-export-exclude-tags " ")))))
(defvar org-file-tags)
(defun pcomplete/org-mode/file-option/filetags ()
"Complete arguments for the #+FILETAGS file option."
(pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " "))))
(defvar org-export-default-language)
(defun pcomplete/org-mode/file-option/language ()
"Complete arguments for the #+LANGUAGE file option."
(require 'ox)
@ -197,9 +249,6 @@ When completing for #+STARTUP, for example, this function returns
(pcomplete-uniquify-list
(list org-export-default-language "en"))))
(defvar org-default-priority)
(defvar org-highest-priority)
(defvar org-lowest-priority)
(defun pcomplete/org-mode/file-option/priorities ()
"Complete arguments for the #+PRIORITIES file option."
(pcomplete-here (list (format "%c %c %c"
@ -207,7 +256,6 @@ When completing for #+STARTUP, for example, this function returns
org-lowest-priority
org-default-priority))))
(defvar org-export-select-tags)
(defun pcomplete/org-mode/file-option/select_tags ()
"Complete arguments for the #+SELECT_TAGS file option."
(require 'ox)
@ -215,7 +263,6 @@ When completing for #+STARTUP, for example, this function returns
(and org-export-select-tags
(list (mapconcat 'identity org-export-select-tags " ")))))
(defvar org-startup-options)
(defun pcomplete/org-mode/file-option/startup ()
"Complete arguments for the #+STARTUP file option."
(while (pcomplete-here
@ -244,7 +291,6 @@ When completing for #+STARTUP, for example, this function returns
(buffer-name (buffer-base-buffer)))))))
(declare-function org-export-backend-options "ox" (cl-x) t)
(defun pcomplete/org-mode/file-option/options ()
"Complete arguments for the #+OPTIONS file option."
(while (pcomplete-here
@ -275,20 +321,18 @@ When completing for #+STARTUP, for example, this function returns
"Complete arguments for the #+BIND file option, which are variable names."
(let (vars)
(mapatoms
(lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars)))))
(lambda (a) (when (boundp a) (setq vars (cons (symbol-name a) vars)))))
(pcomplete-here vars)))
(defvar org-link-abbrev-alist-local)
(defvar org-link-abbrev-alist)
(defun pcomplete/org-mode/link ()
"Complete against defined #+LINK patterns."
(pcomplete-here
(pcomplete-uniquify-list
(copy-sequence
(append (mapcar 'car org-link-abbrev-alist-local)
(mapcar 'car org-link-abbrev-alist))))))
(mapcar (lambda (e) (concat (car e) ":"))
(append org-link-abbrev-alist-local
org-link-abbrev-alist))))))
(defvar org-entities)
(defun pcomplete/org-mode/tex ()
"Complete against TeX-style HTML entity names."
(require 'org-entities)
@ -296,27 +340,24 @@ When completing for #+STARTUP, for example, this function returns
(pcomplete-uniquify-list (remove nil (mapcar 'car-safe org-entities)))
(substring pcomplete-stub 1))))
(defvar org-todo-keywords-1)
(defun pcomplete/org-mode/todo ()
"Complete against known TODO keywords."
(pcomplete-here (pcomplete-uniquify-list (copy-sequence org-todo-keywords-1))))
(defvar org-todo-line-regexp)
(defun pcomplete/org-mode/searchhead ()
"Complete against all headings.
This needs more work, to handle headings with lots of spaces in them."
(while
(pcomplete-here
(save-excursion
(goto-char (point-min))
(let (tbl)
(let ((case-fold-search nil))
(while (re-search-forward org-todo-line-regexp nil t)
(push (org-make-org-heading-search-string
(match-string-no-properties 3))
tbl)))
(pcomplete-uniquify-list tbl)))
(substring pcomplete-stub 1))))
(while (pcomplete-here
(save-excursion
(goto-char (point-min))
(let (tbl)
(while (re-search-forward org-outline-regexp nil t)
(push (org-link-heading-search-string (org-get-heading t t t t))
tbl))
(pcomplete-uniquify-list tbl)))
;; When completing a bracketed link, i.e., "[[*", argument
;; starts at the star, so remove this character.
(substring pcomplete-stub 1))))
(defun pcomplete/org-mode/tag ()
"Complete a tag name. Omit tags already set."
@ -328,28 +369,47 @@ This needs more work, to handle headings with lots of spaces in them."
(mapcar (lambda (x) (org-string-nw-p (car x)))
org-current-tag-alist))
(mapcar #'car (org-get-buffer-tags))))))
(dolist (tag (org-get-tags))
(dolist (tag (org-get-tags nil t))
(setq lst (delete tag lst)))
lst))
(and (string-match ".*:" pcomplete-stub)
(substring pcomplete-stub (match-end 0))))))
(substring pcomplete-stub (match-end 0)))
t)))
(defun pcomplete/org-mode/drawer ()
"Complete a drawer name, including \"PROPERTIES\"."
(pcomplete-here
(org-pcomplete-case-double
(mapcar (lambda (x) (concat x ":"))
(let ((names (list "PROPERTIES")))
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-drawer-regexp nil t)
(let ((drawer (org-element-at-point)))
(when (memq (org-element-type drawer)
'(drawer property-drawer))
(push (org-element-property :drawer-name drawer) names)
(goto-char (org-element-property :end drawer))))))
(pcomplete-uniquify-list names))))
(substring pcomplete-stub 1))) ;remove initial colon
(defun pcomplete/org-mode/prop ()
"Complete a property name. Omit properties already set."
(pcomplete-here
(mapcar (lambda (x)
(concat x ": "))
(let ((lst (pcomplete-uniquify-list
(copy-sequence
(org-buffer-property-keys nil t t t)))))
(dolist (prop (org-entry-properties))
(setq lst (delete (car prop) lst)))
lst))
(org-pcomplete-case-double
(mapcar (lambda (x)
(concat x ": "))
(let ((lst (pcomplete-uniquify-list
(copy-sequence (org-buffer-property-keys nil t t)))))
(dolist (prop (org-entry-properties))
(setq lst (delete (car prop) lst)))
lst)))
(substring pcomplete-stub 1)))
(defun pcomplete/org-mode/block-option/src ()
"Complete the arguments of a begin_src block.
Complete a language in the first field, the header arguments and switches."
"Complete the arguments of a source block.
Complete a language in the first field, the header arguments and
switches."
(pcomplete-here
(mapcar
(lambda(x) (symbol-name (nth 3 x)))
@ -369,17 +429,12 @@ Complete a language in the first field, the header arguments and switches."
":tstart" ":tend" ":block" ":step"
":stepskip0" ":fileskip0"
":emphasize" ":link" ":narrow" ":indent"
":tcolumns" ":level" ":compact" ":timestamp"
":formula" ":formatter" ":wstart" ":mstart"))))
":hidefiles" ":tcolumns" ":level" ":compact"
":timestamp" ":formula" ":formatter"
":wstart" ":mstart"))))
(defun org-pcomplete-case-double (list)
"Return list with both upcase and downcase version of all strings in LIST."
(let (e res)
(while (setq e (pop list))
(setq res (cons (downcase e) (cons (upcase e) res))))
(nreverse res)))
;;;; Finish up
;;; Finish up
(provide 'org-pcomplete)

2
lisp/org/org-plot.el
View file

@ -131,7 +131,7 @@ Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
"Export the data in TABLE to DATA-FILE for gnuplot.
This means in a format appropriate for grid plotting by gnuplot.
PARAMS specifies which columns of TABLE should be plotted as independent
and dependant variables."
and dependent variables."
(interactive)
(let* ((ind (- (plist-get params :ind) 1))
(deps (if (plist-member params :deps)

95
lisp/org/org-protocol.el
View file

@ -116,12 +116,14 @@
;;; Code:
(require 'org)
(require 'ol)
(declare-function org-publish-get-project-from-filename "ox-publish"
(filename &optional up))
(declare-function server-edit "server" (&optional arg))
(defvar org-capture-link-is-already-stored)
(defvar org-capture-templates)
(defgroup org-protocol nil
"Intercept calls from emacsclient to trigger custom actions.
@ -297,11 +299,9 @@ SEPARATOR is specified or SEPARATOR is nil, assume \"/+\". The
results of that splitting are returned as a list."
(let* ((sep (or separator "/+\\|\\?"))
(split-parts (split-string data sep)))
(if unhexify
(if (fboundp unhexify)
(mapcar unhexify split-parts)
(mapcar 'org-link-unescape split-parts))
split-parts)))
(cond ((not unhexify) split-parts)
((fboundp unhexify) (mapcar unhexify split-parts))
(t (mapcar #'org-link-decode split-parts)))))
(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
"Transform PARAM-LIST into a flat list for greedy handlers.
@ -381,11 +381,8 @@ If INFO is already a property list, return it unchanged."
result)
(while data
(setq result
(append
result
(list
(pop data)
(org-link-unescape (pop data))))))
(append result
(list (pop data) (org-link-decode (pop data))))))
result)
(let ((data (org-protocol-split-data info t org-protocol-data-separator)))
(if default-order
@ -444,9 +441,9 @@ form URL/TITLE can also be used."
(when (boundp 'org-stored-links)
(push (list uri title) org-stored-links))
(kill-new uri)
(message "`%s' to insert new org-link, `%s' to insert `%s'"
(substitute-command-keys "`\\[org-insert-link]'")
(substitute-command-keys "`\\[yank]'")
(message "`%s' to insert new Org link, `%s' to insert %S"
(substitute-command-keys "\\[org-insert-link]")
(substitute-command-keys "\\[yank]")
uri))
nil)
@ -471,51 +468,53 @@ You may specify the template with a template= query parameter, like this:
javascript:location.href = \\='org-protocol://capture?template=b\\='+ ...
Now template ?b will be used."
(if (and (boundp 'org-stored-links)
(org-protocol-do-capture info))
(message "Item captured."))
nil)
(defun org-protocol-convert-query-to-plist (query)
"Convert QUERY key=value pairs in the URL to a property list."
(if query
(apply 'append (mapcar (lambda (x)
(let ((c (split-string x "=")))
(list (intern (concat ":" (car c))) (cadr c))))
(split-string query "&")))))
(defun org-protocol-do-capture (info)
"Perform the actual capture based on INFO."
(let* ((temp-parts (org-protocol-parse-parameters info))
(parts
(cond
((and (listp info) (symbolp (car info))) info)
((= (length (car temp-parts)) 1) ;; First parameter is exactly one character long
(org-protocol-assign-parameters temp-parts '(:template :url :title :body)))
(t
(org-protocol-assign-parameters temp-parts '(:url :title :body)))))
(let* ((parts
(pcase (org-protocol-parse-parameters info)
;; New style links are parsed as a plist.
((let `(,(pred keywordp) . ,_) info) info)
;; Old style links, with or without template key, are
;; parsed as a list of strings.
(p
(let ((k (if (= 1 (length (car p)))
'(:template :url :title :body)
'(:url :title :body))))
(org-protocol-assign-parameters p k)))))
(template (or (plist-get parts :template)
org-protocol-default-template-key))
(url (and (plist-get parts :url) (org-protocol-sanitize-uri (plist-get parts :url))))
(type (and url (if (string-match "^\\([a-z]+\\):" url)
(match-string 1 url))))
(url (and (plist-get parts :url)
(org-protocol-sanitize-uri (plist-get parts :url))))
(type (and url
(string-match "^\\([a-z]+\\):" url)
(match-string 1 url)))
(title (or (plist-get parts :title) ""))
(region (or (plist-get parts :body) ""))
(orglink (if url
(org-make-link-string
url (if (string-match "[^[:space:]]" title) title url))
title))
(org-capture-link-is-already-stored t)) ;; avoid call to org-store-link
(setq org-stored-links
(cons (list url title) org-stored-links))
(org-store-link-props :type type
(orglink
(if (null url) title
(org-link-make-string url (or (org-string-nw-p title) url))))
;; Avoid call to `org-store-link'.
(org-capture-link-is-already-stored t))
;; Only store link if there's a URL to insert later on.
(when url (push (list url title) org-stored-links))
(org-link-store-props :type type
:link url
:description title
:annotation orglink
:initial region
:query parts)
(raise-frame)
(funcall 'org-capture nil template)))
(org-capture nil template)
(message "Item captured.")
;; Make sure we do not return a string, as `server-visit-files',
;; through `server-edit', would interpret it as a file name.
nil))
(defun org-protocol-convert-query-to-plist (query)
"Convert QUERY key=value pairs in the URL to a property list."
(when query
(apply 'append (mapcar (lambda (x)
(let ((c (split-string x "=")))
(list (intern (concat ":" (car c))) (cadr c))))
(split-string query "&")))))
(defun org-protocol-open-source (fname)
"Process an org-protocol://open-source?url= style URL with FNAME.

249
lisp/org/org-src.el
View file

@ -32,13 +32,11 @@
;;; Code:
(require 'cl-lib)
(require 'ob-comint)
(require 'org-macs)
(require 'org-compat)
(require 'ob-keys)
(require 'ob-comint)
(require 'org-keys)
(declare-function org-base-buffer "org" (buffer))
(declare-function org-do-remove-indentation "org" (&optional n))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-class "org-element" (datum &optional parent))
(declare-function org-element-context "org-element" (&optional element))
@ -48,9 +46,6 @@
(declare-function org-element-type "org-element" (element))
(declare-function org-footnote-goto-definition "org-footnote"
(label &optional location))
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-switch-to-buffer-other-window "org" (&rest args))
(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-inhibit-startup)
@ -128,7 +123,8 @@ editing it with `\\[org-edit-src-code]'.
It has no effect if `org-src-preserve-indentation' is non-nil."
:group 'org-edit-structure
:type 'integer)
:type 'integer
:safe #'wholenump)
(defcustom org-edit-src-persistent-message t
"Non-nil means show persistent exit help message while editing src examples.
@ -152,17 +148,23 @@ the existing edit buffer."
"How the source code edit buffer should be displayed.
Possible values for this option are:
current-window Show edit buffer in the current window, keeping all other
windows.
other-window Use `switch-to-buffer-other-window' to display edit buffer.
reorganize-frame Show only two windows on the current frame, the current
window and the edit buffer. When exiting the edit buffer,
return to one window.
other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
Also, when exiting the edit buffer, kill that frame."
current-window Show edit buffer in the current window, keeping all other
windows.
split-window-below Show edit buffer below the current window, keeping all
other windows.
split-window-right Show edit buffer to the right of the current window,
keeping all other windows.
other-window Use `switch-to-buffer-other-window' to display edit buffer.
reorganize-frame Show only two windows on the current frame, the current
window and the edit buffer. When exiting the edit buffer,
return to one window.
other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
Also, when exiting the edit buffer, kill that frame."
:group 'org-edit-structure
:type '(choice
(const current-window)
(const split-window-below)
(const split-window-right)
(const other-frame)
(const other-window)
(const reorganize-frame)))
@ -179,17 +181,29 @@ or similar things which you want to have when editing a source code file,
but which mess up the display of a snippet in Org exported files.")
(defcustom org-src-lang-modes
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++)
("screen" . shell-script) ("shell" . sh) ("bash" . sh))
'(("C" . c)
("C++" . c++)
("asymptote" . asy)
("bash" . sh)
("beamer" . latex)
("calc" . fundamental)
("cpp" . c++)
("ditaa" . artist)
("dot" . fundamental)
("elisp" . emacs-lisp)
("ocaml" . tuareg)
("screen" . shell-script)
("shell" . sh)
("sqlite" . sql))
"Alist mapping languages to their major mode.
The key is the language name, the value is the string that should
be inserted as the name of the major mode. For many languages this is
simple, but for language where this is not the case, this variable
provides a way to simplify things on the user side.
For example, there is no ocaml-mode in Emacs, but the mode to use is
`tuareg-mode'."
The key is the language name. The value is the mode name, as
a string or a symbol, without the \"-mode\" suffix.
For many languages this is simple, but for language where this is
not the case, this variable provides a way to simplify things on
the user side. For example, there is no `ocaml-mode' in Emacs,
but the mode to use is `tuareg-mode'."
:group 'org-edit-structure
:type '(repeat
(cons
@ -229,23 +243,52 @@ issued in the language major mode buffer."
;;; Internal functions and variables
(defvar org-src--allow-write-back t)
(defvar org-src--auto-save-timer nil)
(defvar org-src--babel-info nil)
(defvar org-src--beg-marker nil)
(defvar org-src--block-indentation nil)
(defvar org-src--end-marker nil)
(defvar org-src--from-org-mode nil)
(defvar org-src--overlay nil)
(defvar org-src--preserve-indentation nil)
(defvar org-src--remote nil)
(defvar org-src--saved-temp-window-config nil)
(defvar org-src--source-type nil
(defvar org-src--auto-save-timer nil
"Idle Timer auto-saving remote editing buffers.")
(defvar-local org-src--allow-write-back t)
(put 'org-src--allow-write-back 'permanent-local t)
(defvar-local org-src--babel-info nil)
(put 'org-src--babel-info 'permanent-local t)
(defvar-local org-src--beg-marker nil)
(put 'org-src--beg-marker 'permanent-local t)
(defvar-local org-src--block-indentation nil)
(put 'org-src--block-indentation 'permanent-local t)
(defvar-local org-src--content-indentation nil)
(put 'org-src--content-indentation 'permanent-local t)
(defvar-local org-src--end-marker nil)
(put 'org-src--end-marker 'permanent-local t)
(defvar-local org-src--from-org-mode nil)
(put 'org-src--from-org-mode 'permanent-local t)
(defvar-local org-src--overlay nil)
(put 'org-src--overlay 'permanent-local t)
(defvar-local org-src--preserve-indentation nil)
(put 'org-src--preserve-indentation 'permanent-local t)
(defvar-local org-src--remote nil)
(put 'org-src--remote 'permanent-local t)
(defvar-local org-src--source-type nil
"Type of element being edited, as a symbol.")
(defvar org-src--tab-width nil
(put 'org-src--source-type 'permanent-local t)
(defvar-local org-src--tab-width nil
"Contains `tab-width' value from Org source buffer.
However, if `indent-tabs-mode' is nil in that buffer, its value
is 0.")
(put 'org-src--tab-width 'permanent-local t)
(defvar-local org-src-source-file-name nil
"File name associated to Org source buffer, or nil.")
(put 'org-src-source-file-name 'permanent-local t)
(defun org-src--construct-edit-buffer-name (org-buffer-name lang)
"Construct the buffer name for a source editing buffer."
@ -264,21 +307,6 @@ Return nil if there is no such buffer."
(eq (marker-buffer end) (marker-buffer org-src--end-marker))
(throw 'exit b))))))
(defun org-src--source-buffer ()
"Return source buffer edited by current buffer."
(unless (org-src-edit-buffer-p) (error "Not in a source buffer"))
(or (marker-buffer org-src--beg-marker)
(error "No source buffer available for current editing session")))
(defun org-src--get-lang-mode (lang)
"Return major mode that should be used for LANG.
LANG is a string, and the returned major mode is a symbol."
(intern
(concat
(let ((l (or (cdr (assoc lang org-src-lang-modes)) lang)))
(if (symbolp l) (symbol-name l) l))
"-mode")))
(defun org-src--coordinates (pos beg end)
"Return coordinates of POS relatively to BEG and END.
POS, BEG and END are buffer positions. Return value is either
@ -397,7 +425,7 @@ Assume point is in the corresponding edit buffer."
(if org-src--preserve-indentation 0
(+ (or org-src--block-indentation 0)
(if (memq org-src--source-type '(example-block src-block))
org-edit-src-content-indentation
org-src--content-indentation
0))))
(use-tabs? (and (> org-src--tab-width 0) t))
(source-tab-width org-src--tab-width)
@ -405,8 +433,8 @@ Assume point is in the corresponding edit buffer."
(write-back org-src--allow-write-back))
(with-temp-buffer
;; Reproduce indentation parameters from source buffer.
(setq-local indent-tabs-mode use-tabs?)
(when (> source-tab-width 0) (setq-local tab-width source-tab-width))
(setq indent-tabs-mode use-tabs?)
(when (> source-tab-width 0) (setq tab-width source-tab-width))
;; Apply WRITE-BACK function on edit buffer contents.
(insert (org-no-properties contents))
(goto-char (point-min))
@ -441,7 +469,6 @@ When REMOTE is non-nil, do not try to preserve point or mark when
moving from the edit area to the source.
Leave point in edit buffer."
(setq org-src--saved-temp-window-config (current-window-configuration))
(let* ((area (org-src--contents-area datum))
(beg (copy-marker (nth 0 area)))
(end (copy-marker (nth 1 area) t))
@ -457,11 +484,12 @@ Leave point in edit buffer."
(with-current-buffer old-edit-buffer (org-src--remove-overlay))
(kill-buffer old-edit-buffer))
(let* ((org-mode-p (derived-mode-p 'org-mode))
(source-file-name (buffer-file-name (buffer-base-buffer)))
(source-tab-width (if indent-tabs-mode tab-width 0))
(type (org-element-type datum))
(ind (org-with-wide-buffer
(goto-char (org-element-property :begin datum))
(org-get-indentation)))
(block-ind (org-with-point-at (org-element-property :begin datum)
(current-indentation)))
(content-ind org-edit-src-content-indentation)
(preserve-ind
(and (memq type '(example-block src-block))
(or (org-element-property :preserve-indent datum)
@ -498,16 +526,18 @@ Leave point in edit buffer."
;; Transmit buffer-local variables for exit function. It must
;; be done after initializing major mode, as this operation
;; may reset them otherwise.
(setq-local org-src--tab-width source-tab-width)
(setq-local org-src--from-org-mode org-mode-p)
(setq-local org-src--beg-marker beg)
(setq-local org-src--end-marker end)
(setq-local org-src--remote remote)
(setq-local org-src--source-type type)
(setq-local org-src--block-indentation ind)
(setq-local org-src--preserve-indentation preserve-ind)
(setq-local org-src--overlay overlay)
(setq-local org-src--allow-write-back write-back)
(setq org-src--tab-width source-tab-width)
(setq org-src--from-org-mode org-mode-p)
(setq org-src--beg-marker beg)
(setq org-src--end-marker end)
(setq org-src--remote remote)
(setq org-src--source-type type)
(setq org-src--block-indentation block-ind)
(setq org-src--content-indentation content-ind)
(setq org-src--preserve-indentation preserve-ind)
(setq org-src--overlay overlay)
(setq org-src--allow-write-back write-back)
(setq org-src-source-file-name source-file-name)
;; Start minor mode.
(org-src-mode)
;; Move mark and point in edit buffer to the corresponding
@ -536,7 +566,7 @@ Leave point in edit buffer."
"Fontify code block.
This function is called by emacs automatic fontification, as long
as `org-src-fontify-natively' is non-nil."
(let ((lang-mode (org-src--get-lang-mode lang)))
(let ((lang-mode (org-src-get-lang-mode lang)))
(when (fboundp lang-mode)
(let ((string (buffer-substring-no-properties start end))
(modified (buffer-modified-p))
@ -631,13 +661,12 @@ This minor mode is turned on in two situations:
See also `org-src-mode-hook'."
nil " OrgSrc" nil
(when org-edit-src-persistent-message
(setq-local
header-line-format
(substitute-command-keys
(if org-src--allow-write-back
"Edit, then exit with `\\[org-edit-src-exit]' or abort with \
(setq header-line-format
(substitute-command-keys
(if org-src--allow-write-back
"Edit, then exit with `\\[org-edit-src-exit]' or abort with \
`\\[org-edit-src-abort]'"
"Exit with `\\[org-edit-src-exit]' or abort with \
"Exit with `\\[org-edit-src-exit]' or abort with \
`\\[org-edit-src-abort]'"))))
;; Possibly activate various auto-save features (for the edit buffer
;; or the source buffer).
@ -646,7 +675,8 @@ See also `org-src-mode-hook'."
(concat (make-temp-name "org-src-")
(format-time-string "-%Y-%d-%m")
".txt")))
(unless (or org-src--auto-save-timer (zerop org-edit-src-auto-save-idle-delay))
(unless (or org-src--auto-save-timer
(= 0 org-edit-src-auto-save-idle-delay))
(setq org-src--auto-save-timer
(run-with-idle-timer
org-edit-src-auto-save-idle-delay t
@ -663,15 +693,13 @@ See also `org-src-mode-hook'."
(setq org-src--auto-save-timer nil)))))))))
(defun org-src-mode-configure-edit-buffer ()
"Configure the src edit buffer."
(when (bound-and-true-p org-src--from-org-mode)
(add-hook 'kill-buffer-hook #'org-src--remove-overlay nil 'local)
(if (bound-and-true-p org-src--allow-write-back)
(progn
(setq buffer-offer-save t)
(setq buffer-file-name
(concat (buffer-file-name (marker-buffer org-src--beg-marker))
"[" (buffer-name) "]"))
(setq-local write-contents-functions '(org-edit-src-save)))
(setq write-contents-functions '(org-edit-src-save)))
(setq buffer-read-only t))))
(add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer)
@ -732,6 +760,15 @@ Org-babel commands."
(org-src-do-at-code-block
(call-interactively (lookup-key org-babel-map key)))))
(defun org-src-get-lang-mode (lang)
"Return major mode that should be used for LANG.
LANG is a string, and the returned major mode is a symbol."
(intern
(concat
(let ((l (or (cdr (assoc lang org-src-lang-modes)) lang)))
(if (symbolp l) (symbol-name l) l))
"-mode")))
(defun org-src-edit-buffer-p (&optional buffer)
"Non-nil when current buffer is a source editing buffer.
If BUFFER is non-nil, test it instead."
@ -740,11 +777,34 @@ If BUFFER is non-nil, test it instead."
(local-variable-p 'org-src--beg-marker buffer)
(local-variable-p 'org-src--end-marker buffer))))
(defun org-src-source-buffer ()
"Return source buffer edited in current buffer.
Raise an error when current buffer is not a source editing buffer."
(unless (org-src-edit-buffer-p) (error "Not in a source buffer"))
(or (marker-buffer org-src--beg-marker)
(error "No source buffer available for current editing session")))
(defun org-src-source-type ()
"Return type of element edited in current buffer.
Raise an error when current buffer is not a source editing buffer."
(unless (org-src-edit-buffer-p) (error "Not in a source buffer"))
org-src--source-type)
(defun org-src-switch-to-buffer (buffer context)
(pcase org-src-window-setup
(`current-window (pop-to-buffer-same-window buffer))
(`other-window
(switch-to-buffer-other-window buffer))
(`split-window-below
(if (eq context 'exit)
(delete-window)
(select-window (split-window-vertically)))
(pop-to-buffer-same-window buffer))
(`split-window-right
(if (eq context 'exit)
(delete-window)
(select-window (split-window-horizontally)))
(pop-to-buffer-same-window buffer))
(`other-frame
(pcase context
(`exit
@ -900,7 +960,7 @@ the LaTeX environment in the Org mode buffer."
(org-src--edit-element
element
(org-src--construct-edit-buffer-name (buffer-name) "LaTeX environment")
(org-src--get-lang-mode "latex")
(org-src-get-lang-mode "latex")
t)
t))
@ -925,7 +985,7 @@ Throw an error when not at an export block."
;; Missing export-block type. Fallback
;; to default mode.
"fundamental")))
(mode (org-src--get-lang-mode type)))
(mode (org-src-get-lang-mode type)))
(unless (functionp mode) (error "No such language mode: %s" mode))
(org-src--edit-element
element
@ -958,7 +1018,7 @@ name of the sub-editing buffer."
(let* ((lang
(if (eq type 'src-block) (org-element-property :language element)
"example"))
(lang-f (and (eq type 'src-block) (org-src--get-lang-mode lang)))
(lang-f (and (eq type 'src-block) (org-src-get-lang-mode lang)))
(babel-info (and (eq type 'src-block)
(org-babel-get-src-block-info 'light)))
deactivate-mark)
@ -977,7 +1037,7 @@ name of the sub-editing buffer."
(or (org-element-property :label-fmt element)
org-coderef-label-format))
(when (eq type 'src-block)
(setq-local org-src--babel-info babel-info)
(setq org-src--babel-info babel-info)
(let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
(when (fboundp edit-prep-func)
(funcall edit-prep-func babel-info))))
@ -991,7 +1051,7 @@ name of the sub-editing buffer."
(org-src--on-datum-p context))
(user-error "Not on inline source code"))
(let* ((lang (org-element-property :language context))
(lang-f (org-src--get-lang-mode lang))
(lang-f (org-src-get-lang-mode lang))
(babel-info (org-babel-get-src-block-info 'light))
deactivate-mark)
(unless (functionp lang-f) (error "No such language mode: %s" lang-f))
@ -1000,7 +1060,7 @@ name of the sub-editing buffer."
(org-src--construct-edit-buffer-name (buffer-name) lang)
lang-f
(lambda ()
;; Inline src blocks are limited to one line.
;; Inline source blocks are limited to one line.
(while (re-search-forward "\n[ \t]*" nil t) (replace-match " "))
;; Trim contents.
(goto-char (point-min))
@ -1010,8 +1070,8 @@ name of the sub-editing buffer."
(skip-chars-backward " \t")
(delete-region (point) (point-max))))
;; Finalize buffer.
(setq-local org-src--babel-info babel-info)
(setq-local org-src--preserve-indentation t)
(setq org-src--babel-info babel-info)
(setq org-src--preserve-indentation t)
(let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
(when (fboundp edit-prep-func) (funcall edit-prep-func babel-info)))
;; Return success.
@ -1066,7 +1126,7 @@ Throw an error if there is no such buffer."
(beg org-src--beg-marker)
(end org-src--end-marker)
(overlay org-src--overlay))
(with-current-buffer (org-src--source-buffer)
(with-current-buffer (org-src-source-buffer)
(undo-boundary)
(goto-char beg)
;; Temporarily disable read-only features of OVERLAY in order to
@ -1122,10 +1182,7 @@ Throw an error if there is no such buffer."
(write-back (org-src--goto-coordinates coordinates beg end))))
;; Clean up left-over markers and restore window configuration.
(set-marker beg nil)
(set-marker end nil)
(when org-src--saved-temp-window-config
(set-window-configuration org-src--saved-temp-window-config)
(setq org-src--saved-temp-window-config nil))))
(set-marker end nil)))
(provide 'org-src)

3861
lisp/org/org-table.el
View file

File diff suppressed because it is too large Load diff

188
lisp/org/org-tempo.el Normal file
View file

@ -0,0 +1,188 @@
;;; org-tempo.el --- Template expansion for Org structures -*- lexical-binding: t; -*-
;; Copyright (C) 2017-2019 Free Software Foundation, Inc.
;;
;; Author: Rasmus Pank Roulund <emacs at pank dot eu>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;;; Commentary:
;;
;; Org Tempo reimplements completions of structure template before
;; point like `org-try-structure-completion' in Org v9.1 and earlier.
;; For example, strings like "<e" at the beginning of the line will be
;; expanded to an example block.
;;
;; All blocks defined in `org-structure-template-alist' are added as
;; Org Tempo shortcuts, in addition to keywords defined in
;; `org-tempo-keywords-alist'.
;;
;; `tempo' can also be used to define more sophisticated keywords
;; completions. See the section "Additional keywords" below for
;; examples.
;;
;;; Code:
(require 'tempo)
(require 'cl-lib)
(require 'org)
(defvar org-structure-template-alist)
(defgroup org-tempo nil
"Template expansion of Org structures."
:tag "Org structure"
:group 'org)
(defvar org-tempo-tags nil
"Tempo tags for Org mode.")
(defcustom org-tempo-keywords-alist
'(("L" . "latex")
("H" . "html")
("A" . "ascii")
("i" . "index"))
"Keyword completion elements.
This is an alist of KEY characters and corresponding KEYWORDS,
just like `org-structure-template-alist'. The tempo snippet
\"<KEY\" will be expanded using the KEYWORD value. For example
\"<L\" at the beginning of a line is expanded to \"#+latex:\".
Do not use \"I\" as a KEY, as it it reserved for expanding
\"#+include\"."
:group 'org-tempo
:type '(repeat (cons (string :tag "Key")
(string :tag "Keyword")))
:package-version '(Org . "9.2"))
;;; Org Tempo functions and setup.
(defun org-tempo-setup ()
"Setup tempo tags and match finder for the current buffer."
(org-tempo--update-maybe)
(tempo-use-tag-list 'org-tempo-tags)
(setq-local tempo-match-finder "^ *\\(<[[:word:]]+\\)\\="))
(defun org-tempo--keys ()
"Return a list of all Org Tempo expansion strings, like \"<s\"."
(mapcar (lambda (pair) (format "<%s" (car pair)))
(append org-structure-template-alist
org-tempo-keywords-alist)))
(defun org-tempo--update-maybe ()
"Check and add new Org Tempo templates if necessary.
In particular, if new entries were added to
`org-structure-template-alist' or `org-tempo-keywords-alist', new
Tempo templates will be added."
(unless (cl-every (lambda (key) (assoc key org-tempo-tags))
(org-tempo--keys))
(org-tempo-add-templates)))
(defun org-tempo-add-templates ()
"Update all Org Tempo templates.
Go through `org-structure-template-alist' and
`org-tempo-keywords-alist' and update tempo templates."
(mapc 'org--check-org-structure-template-alist '(org-structure-template-alist
org-tempo-keywords-alist))
(let ((keys (org-tempo--keys)))
;; Check for duplicated snippet keys and warn if any are found.
(when (> (length keys) (length (delete-dups keys)))
(warn
"Duplicated keys in `org-structure-template-alist' and `org-tempo-keywords-alist'"))
;; Remove any keys already defined in case they have been updated.
(setq org-tempo-tags
(cl-remove-if (lambda (tag) (member (car tag) keys)) org-tempo-tags))
(mapc #'org-tempo-add-block org-structure-template-alist)
(mapc #'org-tempo-add-keyword org-tempo-keywords-alist)))
(defun org-tempo-add-block (entry)
"Add block entry from `org-structure-template-alist'."
(let* ((key (format "<%s" (car entry)))
(name (cdr entry))
(special (member name '("src" "export"))))
(tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
`(,(format "#+begin_%s%s" name (if special " " ""))
,(when special 'p) '> n '> ,(unless special 'p) n
,(format "#+end_%s" (car (split-string name " ")))
>)
key
(format "Insert a %s block" name)
'org-tempo-tags)))
(defun org-tempo-add-keyword (entry)
"Add keyword entry from `org-tempo-keywords-alist'."
(let* ((key (format "<%s" (car entry)))
(name (cdr entry)))
(tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
`(,(format "#+%s: " name) p '>)
key
(format "Insert a %s keyword" name)
'org-tempo-tags)))
(defun org-tempo-complete-tag (&rest _)
"Look for a tag and expand it silently.
Unlike to `tempo-complete-tag', do not give a signal if a partial
completion or no match at all is found. Return nil if expansion
didn't succeed."
(org-tempo--update-maybe)
;; `tempo-complete-tag' returns its SILENT argument when there is no
;; completion available at all.
(not (eq 'fail (tempo-complete-tag 'fail))))
;;; Additional keywords
(defun org-tempo--include-file ()
"Add #+include: and a file name."
(let ((inhibit-quit t))
(unless (with-local-quit
(prog1 t
(insert
(format "#+include: %S "
(file-relative-name
(read-file-name "Include file: "))))))
(insert "<I")
(setq quit-flag nil))))
(tempo-define-template "org-include"
'((org-tempo--include-file)
p >)
"<I"
"Include keyword"
'org-tempo-tags)
;;; Setup of Org Tempo
;;
;; Org Tempo is set up with each new Org buffer and potentially in the
;; current Org buffer.
(add-hook 'org-mode-hook 'org-tempo-setup)
(add-hook 'org-tab-before-tab-emulation-hook 'org-tempo-complete-tag)
;; Enable Org Tempo in all open Org buffers.
(dolist (b (org-buffer-list 'files))
(with-current-buffer b (org-tempo-setup)))
(provide 'org-tempo)
;;; org-tempo.el ends here

35
lisp/org/org-timer.el
View file

@ -139,7 +139,7 @@ the region 0:00:00."
(format "Restart timer with offset [%s]: " def)))
(unless (string-match "\\S-" s) (setq s def))
(setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s)))))
(setq org-timer-start-time (time-since delta)))
(setq org-timer-start-time (org-time-since delta)))
(setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on)
(message "Timer start time set to %s, current value is %s"
@ -147,6 +147,7 @@ the region 0:00:00."
(org-timer-secs-to-hms (or delta 0)))
(run-hooks 'org-timer-start-hook)))))
;;;###autoload
(defun org-timer-pause-or-continue (&optional stop)
"Pause or continue the relative or countdown timer.
With prefix arg STOP, stop it entirely."
@ -162,9 +163,9 @@ With prefix arg STOP, stop it entirely."
(setq org-timer-countdown-timer
(org-timer--run-countdown-timer
new-secs org-timer-countdown-timer-title))
(setq org-timer-start-time (time-add nil new-secs)))
(setq org-timer-start-time (org-time-add nil new-secs)))
(setq org-timer-start-time
(time-since (- pause-secs start-secs))))
(org-time-since (- pause-secs start-secs))))
(setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on)
(run-hooks 'org-timer-continue-hook)
@ -179,6 +180,7 @@ With prefix arg STOP, stop it entirely."
(org-timer-set-mode-line 'paused)
(message "Timer paused at %s" (org-timer-value-string)))))
;;;###autoload
(defun org-timer-stop ()
"Stop the relative or countdown timer."
(interactive)
@ -217,15 +219,12 @@ it in the buffer."
(insert (org-timer-value-string)))))
(defun org-timer-value-string ()
"Set the timer string."
"Return current timer string."
(format org-timer-format
(org-timer-secs-to-hms
(abs (floor (org-timer-seconds))))))
(defun org-timer-seconds ()
(let ((s (float-time (time-subtract org-timer-pause-time
org-timer-start-time))))
(if org-timer-countdown-timer (- s) s)))
(let ((time (- (float-time org-timer-pause-time)
(float-time org-timer-start-time))))
(abs (floor (if org-timer-countdown-timer (- time) time)))))))
;;;###autoload
(defun org-timer-change-times-in-region (beg end delta)
@ -385,7 +384,10 @@ VALUE can be `on', `off', or `paused'."
"No timer set"
(format-seconds
"%m minute(s) %s seconds left before next time out"
(time-subtract (timer--time org-timer-countdown-timer) nil)))))
;; Note: Once our minimal require is Emacs 27, we can drop this
;; org-time-convert-to-integer call.
(org-time-convert-to-integer
(org-time-subtract (timer--time org-timer-countdown-timer) nil))))))
;;;###autoload
(defun org-timer-set-timer (&optional opt)
@ -417,7 +419,9 @@ using three `C-u' prefix arguments."
(if (numberp org-timer-default-timer)
(number-to-string org-timer-default-timer)
org-timer-default-timer))
(effort-minutes (ignore-errors (floor (org-get-at-eol 'effort-minutes 1))))
(effort-minutes (let ((effort (org-entry-get nil org-effort-property)))
(when (org-string-nw-p effort)
(floor (org-duration-to-minutes effort)))))
(minutes (or (and (numberp opt) (number-to-string opt))
(and (not (equal opt '(64)))
effort-minutes
@ -444,7 +448,7 @@ using three `C-u' prefix arguments."
(org-timer--run-countdown-timer
secs org-timer-countdown-timer-title))
(run-hooks 'org-timer-set-hook)
(setq org-timer-start-time (time-add nil secs))
(setq org-timer-start-time (org-time-add nil secs))
(setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on))))))
@ -462,7 +466,8 @@ time is up."
(run-hooks 'org-timer-done-hook)))))
(defun org-timer--get-timer-title ()
"Construct timer title from heading or file name of Org buffer."
"Construct timer title.
Try to use an Org header, otherwise use the buffer name."
(cond
((derived-mode-p 'org-agenda-mode)
(let* ((marker (or (get-text-property (point) 'org-marker)
@ -478,7 +483,7 @@ time is up."
((derived-mode-p 'org-mode)
(or (ignore-errors (org-get-heading))
(buffer-name (buffer-base-buffer))))
(t (error "Not in an Org buffer"))))
(t (buffer-name (buffer-base-buffer)))))
(provide 'org-timer)

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

@ -5,13 +5,13 @@
(defun org-release ()
"The release version of Org.
Inserted by installing Org mode or when a release is made."
(let ((org-release "9.1.9"))
(let ((org-release "9.3"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
(let ((org-git-version "release_9.1.9-65-g5e4542"))
(let ((org-git-version "release_9.3"))
org-git-version))
(provide 'org-version)

10376
lisp/org/org.el
View file

File diff suppressed because it is too large Load diff

61
lisp/org/ox-ascii.el
View file

@ -632,7 +632,7 @@ Return value is a symbol among `left', `center', `right' and
(or justification 'left)))
(defun org-ascii--build-title
(element info text-width &optional underline notags toc)
(element info text-width &optional underline notags toc)
"Format ELEMENT title and return it.
ELEMENT is either an `headline' or `inlinetask' element. INFO is
@ -651,13 +651,12 @@ possible. It doesn't apply to `inlinetask' elements."
(let* ((headlinep (eq (org-element-type element) 'headline))
(numbers
;; Numbering is specific to headlines.
(and headlinep (org-export-numbered-headline-p element info)
;; All tests passed: build numbering string.
(concat
(mapconcat
'number-to-string
(org-export-get-headline-number element info) ".")
" ")))
(and headlinep
(org-export-numbered-headline-p element info)
(let ((numbering (org-export-get-headline-number element info)))
(if toc (format "%d. " (org-last numbering))
(concat (mapconcat #'number-to-string numbering ".")
" ")))))
(text
(org-trim
(org-export-data
@ -672,8 +671,7 @@ possible. It doesn't apply to `inlinetask' elements."
(plist-get info :with-tags)
(let ((tag-list (org-export-get-tags element info)))
(and tag-list
(format ":%s:"
(mapconcat 'identity tag-list ":"))))))
(org-make-tag-string tag-list)))))
(priority
(and (plist-get info :with-priority)
(let ((char (org-element-property :priority element)))
@ -733,7 +731,7 @@ caption keyword."
(org-export-data caption info))
(org-ascii--current-text-width element info) info)))))
(defun org-ascii--build-toc (info &optional n keyword local)
(defun org-ascii--build-toc (info &optional n keyword scope)
"Return a table of contents.
INFO is a plist used as a communication channel.
@ -744,10 +742,10 @@ depth of the table.
Optional argument KEYWORD specifies the TOC keyword, if any, from
which the table of contents generation has been initiated.
When optional argument LOCAL is non-nil, build a table of
contents according to the current headline."
When optional argument SCOPE is non-nil, build a table of
contents according to the specified scope."
(concat
(unless local
(unless scope
(let ((title (org-ascii--translate "Table of Contents" info)))
(concat title "\n"
(make-string
@ -769,7 +767,7 @@ contents according to the current headline."
(or (not (plist-get info :with-tags))
(eq (plist-get info :with-tags) 'not-in-toc))
'toc))))
(org-export-collect-headlines info n (and local keyword)) "\n"))))
(org-export-collect-headlines info n scope) "\n"))))
(defun org-ascii--list-listings (keyword info)
"Return a list of listings.
@ -960,7 +958,7 @@ channel."
(t
(concat
(org-ascii--fill-string
(format "[%s] %s" anchor (org-element-property :raw-link link))
(format "[%s] <%s>" anchor (org-element-property :raw-link link))
width info)
"\n\n")))))
links ""))
@ -1518,8 +1516,13 @@ information."
((string-match-p "\\<headlines\\>" value)
(let ((depth (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value))))
(localp (string-match-p "\\<local\\>" value)))
(org-ascii--build-toc info depth keyword localp)))
(scope
(cond
((string-match ":target +\\(\".+?\"\\|\\S-+\\)" value) ;link
(org-export-resolve-link
(org-strip-quotes (match-string 1 value)) info))
((string-match-p "\\<local\\>" value) keyword)))) ;local
(org-ascii--build-toc info depth keyword scope)))
((string-match-p "\\<tables\\>" value)
(org-ascii--list-tables keyword info))
((string-match-p "\\<listings\\>" value)
@ -1602,11 +1605,13 @@ INFO is a plist holding contextual information."
;; Don't know what to do. Signal it.
(_ "???"))))
(t
(let ((raw-link (org-element-property :raw-link link)))
(if (not (org-string-nw-p desc)) (format "[%s]" raw-link)
(let ((raw-link (concat (org-element-property :type link)
":"
(org-element-property :path link))))
(if (not (org-string-nw-p desc)) (format "<%s>" raw-link)
(concat (format "[%s]" desc)
(and (not (plist-get info :ascii-links-to-notes))
(format " (%s)" raw-link)))))))))
(format " (<%s>)" raw-link)))))))))
;;;; Node Properties
@ -2066,6 +2071,20 @@ a communication channel."
;;; End-user functions
;;;###autoload
(defun org-ascii-convert-region-to-ascii ()
"Assume region has Org syntax, and convert it to plain ASCII."
(interactive)
(let ((org-ascii-charset 'ascii))
(org-export-replace-region-by 'ascii)))
;;;###autoload
(defun org-ascii-convert-region-to-utf8 ()
"Assume region has Org syntax, and convert it to UTF-8."
(interactive)
(let ((org-ascii-charset 'utf-8))
(org-export-replace-region-by 'ascii)))
;;;###autoload
(defun org-ascii-export-as-ascii
(&optional async subtreep visible-only body-only ext-plist)

90
lisp/org/ox-beamer.el
View file

@ -424,9 +424,8 @@ used as a communication channel."
(let* ((beamer-opt (org-element-property :BEAMER_OPT headline))
(options
;; Collect nonempty options from default value and
;; headline's properties. Also add a label for
;; links.
(cl-remove-if-not 'org-string-nw-p
;; headline's properties.
(cl-remove-if-not #'org-string-nw-p
(append
(org-split-string
(plist-get info :beamer-frame-default-options) ",")
@ -436,29 +435,31 @@ used as a communication channel."
;; them.
(and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt)
(match-string 1 beamer-opt))
","))
;; Provide an automatic label for the frame
;; unless the user specified one. Also refrain
;; from labeling `allowframebreaks' frames; this
;; is not allowed by beamer.
(unless (and beamer-opt
(or (string-match "\\(^\\|,\\)label=" beamer-opt)
(string-match "allowframebreaks" beamer-opt)))
(list
(let ((label (org-beamer--get-label headline info)))
;; Labels containing colons need to be
;; wrapped within braces.
(format (if (string-match-p ":" label)
"label={%s}"
"label=%s")
label))))))))
",")))))
(fragile
;; Add "fragile" option if necessary.
(and fragilep
(not (member "fragile" options))
(list "fragile")))
(label
;; Provide an automatic label for the frame unless
;; the user specified one. Also refrain from
;; labeling `allowframebreaks' frames; this is not
;; allowed by Beamer.
(and (not (member "allowframebreaks" options))
(not (cl-some (lambda (s) (string-match-p "^label=" s))
options))
(list
(let ((label (org-beamer--get-label headline info)))
;; Labels containing colons need to be
;; wrapped within braces.
(format (if (string-match-p ":" label)
"label={%s}"
"label=%s")
label))))))
;; Change options list into a string.
(org-beamer--normalize-argument
(mapconcat
'identity
(if (or (not fragilep) (member "fragile" options)) options
(cons "fragile" options))
",")
(mapconcat #'identity (append label fragile options) ",")
'option))
;; Title.
(let ((env (org-element-property :BEAMER_ENV headline)))
@ -644,13 +645,22 @@ as a communication channel."
contents))
;; Case 4: HEADLINE is a note.
((member environment '("note" "noteNH"))
(format "\\note{%s}"
(concat (and (equal environment "note")
(concat
(org-export-data
(org-element-property :title headline) info)
"\n"))
(org-trim contents))))
(concat "\\note"
;; Overlay specification.
(let ((overlay (org-element-property :BEAMER_ACT headline)))
(when overlay
(org-beamer--normalize-argument
overlay
(if (string-match "\\`\\[.*\\]\\'" overlay)
'defaction 'action))))
(format "{%s}"
(concat (and (equal environment "note")
(concat
(org-export-data
(org-element-property :title headline)
info)
"\n"))
(org-trim contents)))))
;; Case 5: HEADLINE is a frame.
((= level frame-level)
(org-beamer--format-frame headline contents info))
@ -914,9 +924,9 @@ value."
(org-back-to-heading t)
;; Filter out Beamer-related tags and install environment tag.
(let ((tags (cl-remove-if (lambda (x) (string-match "^B_" x))
(org-get-tags)))
(org-get-tags nil t)))
(env-tag (and (org-string-nw-p value) (concat "B_" value))))
(org-set-tags-to (if env-tag (cons env-tag tags) tags))
(org-set-tags (if env-tag (cons env-tag tags) tags))
(when env-tag (org-toggle-tag env-tag 'on)))))
((equal property "BEAMER_col")
(org-toggle-tag "BMCOL" (if (org-string-nw-p value) 'on 'off)))))
@ -1075,12 +1085,12 @@ aid, but the tag does not have any semantic meaning."
(org-tag-persistent-alist nil)
(org-use-fast-tag-selection t)
(org-fast-tag-selection-single-key t))
(org-set-tags)
(let ((tags (or (ignore-errors (org-get-tags-string)) "")))
(org-set-tags-command)
(let ((tags (org-get-tags nil t)))
(cond
;; For a column, automatically ask for its width.
((eq org-last-tag-selection-key ?|)
(if (string-match ":BMCOL:" tags)
(if (member "BMCOL" tags)
(org-set-property "BEAMER_col" (read-string "Column width: "))
(org-delete-property "BEAMER_col")))
;; For an "againframe" section, automatically ask for reference
@ -1096,8 +1106,12 @@ aid, but the tag does not have any semantic meaning."
(read-string "Frame reference (*Title, #custom-id, id:...): "))
(org-set-property "BEAMER_act"
(read-string "Overlay specification: "))))
((string-match (concat ":B_\\(" (mapconcat 'car envs "\\|") "\\):") tags)
(org-entry-put nil "BEAMER_env" (match-string 1 tags)))
((let* ((tags-re (concat "B_" (regexp-opt (mapcar #'car envs) t)))
(env (cl-some (lambda (tag)
(and (string-match tags-re tag)
(match-string 1 tag)))
tags)))
(and env (progn (org-entry-put nil "BEAMER_env" env) t))))
(t (org-entry-delete nil "BEAMER_env"))))))
;;;###autoload

457
lisp/org/ox-html.el
View file

@ -152,6 +152,7 @@
(:html-metadata-timestamp-format nil nil org-html-metadata-timestamp-format)
(:html-postamble-format nil nil org-html-postamble-format)
(:html-preamble-format nil nil org-html-preamble-format)
(:html-self-link-headlines nil nil org-html-self-link-headlines)
(:html-table-align-individual-fields
nil nil org-html-table-align-individual-fields)
(:html-table-caption-above nil nil org-html-table-caption-above)
@ -171,6 +172,7 @@
(:html-table-row-open-tag nil nil org-html-table-row-open-tag)
(:html-table-row-close-tag nil nil org-html-table-row-close-tag)
(:html-xml-declaration nil nil org-html-xml-declaration)
(:html-wrap-src-lines nil nil org-html-wrap-src-lines)
(:html-klipsify-src nil nil org-html-klipsify-src)
(:html-klipse-css nil nil org-html-klipse-css)
(:html-klipse-js nil nil org-html-klipse-js)
@ -215,7 +217,7 @@
(defconst org-html-html5-elements
'("article" "aside" "audio" "canvas" "details" "figcaption"
"figure" "footer" "header" "menu" "meter" "nav" "output"
"progress" "section" "video")
"progress" "section" "summary" "video")
"New elements in html5.
For blocks that should contain headlines, use the HTML_CONTAINER
@ -430,6 +432,19 @@ for the JavaScript code in this tag.
.footdef { margin-bottom: 1em; }
.figure { padding: 1em; }
.figure p { text-align: center; }
.equation-container {
display: table;
text-align: center;
width: 100%;
}
.equation {
vertical-align: middle;
}
.equation-label {
display: table-cell;
text-align: right;
vertical-align: middle;
}
.inlinetask {
padding: 10px;
border: 2px solid gray;
@ -789,6 +804,13 @@ but without \"name\" attribute."
:package-version '(Org . "8.0")
:type 'boolean)
(defcustom org-html-self-link-headlines nil
"When non-nil, the headlines contain a hyperlink to themselves."
:group 'org-export-html
:package-version '(Org . "9.3")
:type 'boolean
:safe #'booleanp)
;;;; Inlinetasks
(defcustom org-html-format-inlinetask-function
@ -863,6 +885,7 @@ link to the image."
(defcustom org-html-inline-image-rules
'(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
("attachment" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'"))
"Rules characterizing image files that can be inlined into HTML.
@ -910,6 +933,15 @@ in all modes you want. Then, use the command
:group 'org-export-html
:type 'string)
(defcustom org-html-wrap-src-lines nil
"If non-nil, wrap individual lines of source blocks in \"code\" elements.
In this case, add line number in attribute \"data-ox-html-linenr\" when line
numbers are enabled."
:group 'org-export-html
:package-version '(Org . "9.3")
:type 'boolean
:safe t)
;;;; Table
(defcustom org-html-table-default-attributes
@ -1693,7 +1725,7 @@ object unless a different class is specified with an attribute."
(defun org-html--textarea-block (element)
"Transcode ELEMENT into a textarea block.
ELEMENT is either a src block or an example block."
ELEMENT is either a source or an example block."
(let* ((code (car (org-export-unravel-code element)))
(attr (org-export-read-attribute :attr_html element)))
(format "<p>\n<textarea cols=\"%s\" rows=\"%s\">\n%s</textarea>\n</p>"
@ -1736,8 +1768,8 @@ If you then set `org-html-htmlize-output-type' to `css', calls
to the function `org-html-htmlize-region-for-paste' will
produce code that uses these same face definitions."
(interactive)
(or (require 'htmlize nil t)
(error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
(unless (require 'htmlize nil t)
(error "htmlize library missing. Aborting"))
(and (get-buffer "*html*") (kill-buffer "*html*"))
(with-temp-buffer
(let ((fl (face-list))
@ -1751,12 +1783,12 @@ produce code that uses these same face definitions."
(htmlize-region (point-min) (point-max))))
(pop-to-buffer-same-window "*html*")
(goto-char (point-min))
(if (re-search-forward "<style" nil t)
(delete-region (point-min) (match-beginning 0)))
(if (re-search-forward "</style>" nil t)
(delete-region (1+ (match-end 0)) (point-max)))
(when (re-search-forward "<style" nil t)
(delete-region (point-min) (match-beginning 0)))
(when (re-search-forward "</style>" nil t)
(delete-region (1+ (match-end 0)) (point-max)))
(beginning-of-line 1)
(if (looking-at " +") (replace-match ""))
(when (looking-at " +") (replace-match ""))
(goto-char (point-min)))
(defun org-html--make-string (n string)
@ -1771,33 +1803,38 @@ Replaces invalid characters with \"_\"."
(defun org-html-footnote-section (info)
"Format the footnote section.
INFO is a plist used as a communication channel."
(let* ((fn-alist (org-export-collect-footnote-definitions info))
(fn-alist
(cl-loop for (n _type raw) in fn-alist collect
(cons n (if (eq (org-element-type raw) 'org-data)
(org-trim (org-export-data raw info))
(format "<div class=\"footpara\">%s</div>"
(org-trim (org-export-data raw info))))))))
(when fn-alist
(pcase (org-export-collect-footnote-definitions info)
(`nil nil)
(definitions
(format
(plist-get info :html-footnotes-section)
(org-html--translate "Footnotes" info)
(format
"\n%s\n"
(mapconcat
(lambda (fn)
(let ((n (car fn)) (def (cdr fn)))
(format
"<div class=\"footdef\">%s %s</div>\n"
(format
(plist-get info :html-footnote-format)
(org-html--anchor
(format "fn.%d" n)
n
(format " class=\"footnum\" href=\"#fnr.%d\"" n)
info))
def)))
fn-alist
(lambda (definition)
(pcase definition
(`(,n ,_ ,def)
;; `org-export-collect-footnote-definitions' can return
;; two kinds of footnote definitions: inline and blocks.
;; Since this should not make any difference in the HTML
;; output, we wrap the inline definitions within
;; a "footpara" class paragraph.
(let ((inline? (not (org-element-map def org-element-all-elements
#'identity nil t)))
(anchor (org-html--anchor
(format "fn.%d" n)
n
(format " class=\"footnum\" href=\"#fnr.%d\"" n)
info))
(contents (org-trim (org-export-data def info))))
(format "<div class=\"footdef\">%s %s</div>\n"
(format (plist-get info :html-footnote-format) anchor)
(format "<div class=\"footpara\">%s</div>"
(if (not inline?) contents
(format "<p class=\"footpara\">%s</p>"
contents))))))))
definitions
"\n"))))))
@ -1957,44 +1994,42 @@ communication channel."
(creator (cdr (assq ?c spec)))
(validation-link (cdr (assq ?v spec))))
(concat
(when (and (plist-get info :with-date)
(org-string-nw-p date))
(format "<p class=\"date\">%s: %s</p>\n"
(org-html--translate "Date" info)
date))
(when (and (plist-get info :with-author)
(org-string-nw-p author))
(format "<p class=\"author\">%s: %s</p>\n"
(org-html--translate "Author" info)
author))
(when (and (plist-get info :with-email)
(org-string-nw-p email))
(format "<p class=\"email\">%s: %s</p>\n"
(org-html--translate "Email" info)
email))
(when (plist-get info :time-stamp-file)
(format
"<p class=\"date\">%s: %s</p>\n"
(org-html--translate "Created" info)
(format-time-string
(plist-get info :html-metadata-timestamp-format))))
(when (plist-get info :with-creator)
(format "<p class=\"creator\">%s</p>\n" creator))
(format "<p class=\"validation\">%s</p>\n"
validation-link))))
(t (format-spec
(or (cadr (assoc-string
(plist-get info :language)
(eval (intern
(format "org-html-%s-format" type)))
t))
(cadr
(assoc-string
"en"
(eval
(intern (format "org-html-%s-format" type)))
t)))
spec))))))
(and (plist-get info :with-date)
(org-string-nw-p date)
(format "<p class=\"date\">%s: %s</p>\n"
(org-html--translate "Date" info)
date))
(and (plist-get info :with-author)
(org-string-nw-p author)
(format "<p class=\"author\">%s: %s</p>\n"
(org-html--translate "Author" info)
author))
(and (plist-get info :with-email)
(org-string-nw-p email)
(format "<p class=\"email\">%s: %s</p>\n"
(org-html--translate "Email" info)
email))
(and (plist-get info :time-stamp-file)
(format
"<p class=\"date\">%s: %s</p>\n"
(org-html--translate "Created" info)
(format-time-string
(plist-get info :html-metadata-timestamp-format))))
(and (plist-get info :with-creator)
(org-string-nw-p creator)
(format "<p class=\"creator\">%s</p>\n" creator))
(and (org-string-nw-p validation-link)
(format "<p class=\"validation\">%s</p>\n"
validation-link)))))
(t
(let ((formats (plist-get info (if (eq type 'preamble)
:html-preamble-format
:html-postamble-format)))
(language (plist-get info :language)))
(format-spec
(cadr (or (assoc-string language formats t)
(assoc-string "en" formats t)))
spec)))))))
(let ((div (assq type (plist-get info :html-divs))))
(when (org-string-nw-p section-contents)
(concat
@ -2089,12 +2124,12 @@ holding export options."
;; Postamble.
(org-html--build-pre/postamble 'postamble info)
;; Possibly use the Klipse library live code blocks.
(if (plist-get info :html-klipsify-src)
(concat "<script>" (plist-get info :html-klipse-selection-script)
"</script><script src=\""
org-html-klipse-js
"\"></script><link rel=\"stylesheet\" type=\"text/css\" href=\""
org-html-klipse-css "\"/>"))
(when (plist-get info :html-klipsify-src)
(concat "<script>" (plist-get info :html-klipse-selection-script)
"</script><script src=\""
org-html-klipse-js
"\"></script><link rel=\"stylesheet\" type=\"text/css\" href=\""
org-html-klipse-css "\"/>"))
;; Closing document.
"</body>\n</html>"))
@ -2160,12 +2195,10 @@ is the language used for CODE, as a string, or nil."
;; Plain text explicitly set.
((not org-html-htmlize-output-type) (org-html-encode-plain-text code))
;; No htmlize library or an inferior version of htmlize.
((not (and (or (require 'htmlize nil t)
(error "Please install htmlize from \
https://github.com/hniksic/emacs-htmlize"))
(fboundp 'htmlize-region-for-paste)))
((not (progn (require 'htmlize nil t)
(fboundp 'htmlize-region-for-paste)))
;; Emit a warning.
(message "Cannot fontify src block (htmlize.el >= 1.34 required)")
(message "Cannot fontify source block (htmlize.el >= 1.34 required)")
(org-html-encode-plain-text code))
(t
;; Map language
@ -2208,14 +2241,15 @@ https://github.com/hniksic/emacs-htmlize"))
(if (and beg end) (substring code beg end) code)))))))))
(defun org-html-do-format-code
(code &optional lang refs retain-labels num-start)
(code &optional lang refs retain-labels num-start wrap-lines)
"Format CODE string as source code.
Optional arguments LANG, REFS, RETAIN-LABELS and NUM-START are,
respectively, the language of the source code, as a string, an
Optional arguments LANG, REFS, RETAIN-LABELS, NUM-START, WRAP-LINES
are, respectively, the language of the source code, as a string, an
alist between line numbers and references (as returned by
`org-export-unravel-code'), a boolean specifying if labels should
appear in the source code, and the number associated to the first
line of code."
appear in the source code, the number associated to the first
line of code, and a boolean specifying if lines of code should be
wrapped in code elements."
(let* ((code-lines (split-string code "\n"))
(code-length (length code-lines))
(num-fmt
@ -2233,7 +2267,13 @@ line of code."
(format "<span class=\"linenr\">%s</span>"
(format num-fmt line-num)))
;; Transcoded src line.
loc
(if wrap-lines
(format "<code%s>%s</code>"
(if num-start
(format " data-ox-html-linenr=\"%s\"" line-num)
"")
loc)
loc)
;; Add label, if needed.
(when (and ref retain-labels) (format " (%s)" ref))))
;; Mark transcoded line as an anchor, if needed.
@ -2244,18 +2284,20 @@ line of code."
(defun org-html-format-code (element info)
"Format contents of ELEMENT as source code.
ELEMENT is either an example block or a src block. INFO is
a plist used as a communication channel."
ELEMENT is either an example or a source block. INFO is a plist
used as a communication channel."
(let* ((lang (org-element-property :language element))
;; Extract code and references.
(code-info (org-export-unravel-code element))
(code (car code-info))
(refs (cdr code-info))
;; Does the src block contain labels?
;; Does the source block contain labels?
(retain-labels (org-element-property :retain-labels element))
;; Does it have line numbers?
(num-start (org-export-get-loc element info)))
(org-html-do-format-code code lang refs retain-labels num-start)))
(num-start (org-export-get-loc element info))
;; Should lines be wrapped in code elements?
(wrap-lines (plist-get info :html-wrap-src-lines)))
(org-html-do-format-code code lang refs retain-labels num-start wrap-lines)))
;;; Tables of Contents
@ -2580,18 +2622,12 @@ holding contextual information."
(full-text (funcall (plist-get info :html-format-headline-function)
todo todo-type priority text tags info))
(contents (or contents ""))
(ids (delq nil
(list (org-element-property :CUSTOM_ID headline)
(org-export-get-reference headline info)
(org-element-property :ID headline))))
(preferred-id (car ids))
(extra-ids
(mapconcat
(lambda (id)
(org-html--anchor
(if (org-uuidgen-p id) (concat "ID-" id) id)
nil nil info))
(cdr ids) "")))
(id (or (org-element-property :CUSTOM_ID headline)
(org-export-get-reference headline info)))
(formatted-text
(if (plist-get info :html-self-link-headlines)
(format "<a href=\"#%s\">%s</a>" id full-text)
full-text)))
(if (org-export-low-level-p headline info)
;; This is a deep sub-tree: export it as a list item.
(let* ((html-type (if numberedp "ol" "ul")))
@ -2600,15 +2636,16 @@ holding contextual information."
(apply #'format "<%s class=\"org-%s\">\n"
(make-list 2 html-type)))
(org-html-format-list-item
contents (if numberedp 'ordered 'unordered)
nil info nil
(concat (org-html--anchor preferred-id nil nil info)
extra-ids
full-text)) "\n"
contents (if numberedp 'ordered 'unordered)
nil info nil
(concat (org-html--anchor id nil nil info) formatted-text)) "\n"
(and (org-export-last-sibling-p headline info)
(format "</%s>\n" html-type))))
;; Standard headline. Export it as a section.
(let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline))
(let ((extra-class
(org-element-property :HTML_CONTAINER_CLASS headline))
(headline-class
(org-element-property :HTML_HEADLINE_CLASS headline))
(first-content (car (org-element-contents headline))))
(format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n"
(org-html--container headline info)
@ -2617,17 +2654,18 @@ holding contextual information."
(concat (format "outline-%d" level)
(and extra-class " ")
extra-class)
(format "\n<h%d id=\"%s\">%s%s</h%d>\n"
(format "\n<h%d id=\"%s\"%s>%s</h%d>\n"
level
preferred-id
extra-ids
id
(if (not headline-class) ""
(format " class=\"%s\"" headline-class))
(concat
(and numberedp
(format
"<span class=\"section-number-%d\">%s</span> "
level
(mapconcat #'number-to-string numbers ".")))
full-text)
formatted-text)
level)
;; When there is no section, pretend there is an
;; empty one to get the correct <div
@ -2795,8 +2833,13 @@ CONTENTS is nil. INFO is a plist holding contextual information."
((string-match "\\<headlines\\>" value)
(let ((depth (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value))))
(localp (string-match-p "\\<local\\>" value)))
(org-html-toc depth info (and localp keyword))))
(scope
(cond
((string-match ":target +\\(\".+?\"\\|\\S-+\\)" value) ;link
(org-export-resolve-link
(org-strip-quotes (match-string 1 value)) info))
((string-match-p "\\<local\\>" value) keyword)))) ;local
(org-html-toc depth info scope)))
((string= "listings" value) (org-html-list-of-listings info))
((string= "tables" value) (org-html-list-of-tables info))))))))
@ -2837,26 +2880,73 @@ INFO is a plist containing export properties."
"Creating LaTeX Image..." nil processing-type)
(buffer-string))))
(defun org-html--wrap-latex-environment (contents _ &optional caption label)
"Wrap CONTENTS string within appropriate environment for equations.
When optional arguments CAPTION and LABEL are given, use them for
caption and \"id\" attribute."
(format "\n<div%s class=\"equation-container\">\n%s%s\n</div>"
;; ID.
(if (org-string-nw-p label) (format " id=\"%s\"" label) "")
;; Contents.
(format "<span class=\"equation\">\n%s\n</span>" contents)
;; Caption.
(if (not (org-string-nw-p caption)) ""
(format "\n<span class=\"equation-label\">\n%s\n</span>"
caption))))
(defun org-html--math-environment-p (element &optional _)
"Non-nil when ELEMENT is a LaTeX math environment.
Math environments match the regular expression defined in
`org-latex-math-environments-re'. This function is meant to be
used as a predicate for `org-export-get-ordinal' or a value to
`org-html-standalone-image-predicate'."
(string-match-p org-latex-math-environments-re
(org-element-property :value element)))
(defun org-html--unlabel-latex-environment (latex-frag)
"Change environment in LATEX-FRAG string to an unnumbered one.
For instance, change an 'equation' environment to 'equation*'."
(replace-regexp-in-string
"\\`[ \t]*\\\\begin{\\([^*]+?\\)}"
"\\1*"
(replace-regexp-in-string "^[ \t]*\\\\end{\\([^*]+?\\)}[ \r\t\n]*\\'"
"\\1*"
latex-frag nil nil 1)
nil nil 1))
(defun org-html-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((processing-type (plist-get info :with-latex))
(latex-frag (org-remove-indentation
(org-element-property :value latex-environment)))
(attributes (org-export-read-attribute :attr_html latex-environment)))
(attributes (org-export-read-attribute :attr_html latex-environment))
(label (and (org-element-property :name latex-environment)
(org-export-get-reference latex-environment info)))
(caption (number-to-string
(org-export-get-ordinal
latex-environment info nil
#'org-html--math-environment-p))))
(cond
((memq processing-type '(t mathjax))
(org-html-format-latex latex-frag 'mathjax info))
(org-html-format-latex
(if (org-string-nw-p label)
(replace-regexp-in-string "\\`.*"
(format "\\&\n\\\\label{%s}" label)
latex-frag)
latex-frag)
'mathjax info))
((assq processing-type org-preview-latex-process-alist)
(let ((formula-link
(org-html-format-latex latex-frag processing-type info)))
(when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
;; Do not provide a caption or a name to be consistent with
;; `mathjax' handling.
(org-html--wrap-image
(org-html--format-image
(match-string 1 formula-link) attributes info) info))))
(t latex-frag))))
(org-html-format-latex
(org-html--unlabel-latex-environment latex-frag)
processing-type info)))
(when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
(org-html--wrap-latex-environment
(org-html--format-image
(match-string 1 formula-link) attributes info)
info caption label))))
(t (org-html--wrap-latex-environment latex-frag info caption label)))))
;;;; Latex Fragment
@ -2972,7 +3062,7 @@ INFO is a plist holding contextual information. See
(path
(cond
((member type '("http" "https" "ftp" "mailto" "news"))
(url-encode-url (org-link-unescape (concat type ":" raw-path))))
(url-encode-url (concat type ":" raw-path)))
((string= type "file")
;; During publishing, turn absolute file names belonging
;; to base directory into relative file names. Otherwise,
@ -2994,30 +3084,31 @@ INFO is a plist holding contextual information. See
;; relative to a custom-id, a headline title, a name or
;; a target.
(let ((option (org-element-property :search-option link)))
(cond ((not option) raw-path)
;; Since HTML back-end use custom-id value as-is,
;; resolving is them is trivial.
((eq (string-to-char option) ?#) (concat raw-path option))
(t
(concat raw-path
"#"
(org-publish-resolve-external-link
option
(org-element-property :path link)))))))
(if (not option) raw-path
(let ((path (org-element-property :path link)))
(concat raw-path
"#"
(org-publish-resolve-external-link option path t))))))
(t raw-path)))
;; Extract attributes from parent's paragraph. HACK: Only do
;; this for the first link in parent (inner image link for
;; inline images). This is needed as long as attributes
;; cannot be set on a per link basis.
(attributes-plist
(let* ((parent (org-export-get-parent-element link))
(link (let ((container (org-export-get-parent link)))
(if (and (eq (org-element-type container) 'link)
(org-html-inline-image-p link info))
container
link))))
(and (eq (org-element-map parent 'link 'identity info t) link)
(org-export-read-attribute :attr_html parent))))
(org-combine-plists
;; Extract attributes from parent's paragraph. HACK: Only
;; do this for the first link in parent (inner image link
;; for inline images). This is needed as long as
;; attributes cannot be set on a per link basis.
(let* ((parent (org-export-get-parent-element link))
(link (let ((container (org-export-get-parent link)))
(if (and (eq 'link (org-element-type container))
(org-html-inline-image-p link info))
container
link))))
(and (eq link (org-element-map parent 'link #'identity info t))
(org-export-read-attribute :attr_html parent)))
;; Also add attributes from link itself. Currently, those
;; need to be added programmatically before `org-html-link'
;; is invoked, for example, by backends building upon HTML
;; export.
(org-export-read-attribute :attr_html link)))
(attributes
(let ((attr (org-html--make-attribute-string attributes-plist)))
(if (org-string-nw-p attr) (concat " " attr) ""))))
@ -3081,23 +3172,37 @@ INFO is a plist holding contextual information. See
(format "<a href=\"#%s\"%s>%s</a>" href attributes desc)))
;; Fuzzy link points to a target or an element.
(_
(let* ((ref (org-export-get-reference destination info))
(org-html-standalone-image-predicate
#'org-html--has-caption-p)
(number (cond
(desc nil)
((org-html-standalone-image-p destination info)
(org-export-get-ordinal
(org-element-map destination 'link
#'identity info t)
info 'link 'org-html-standalone-image-p))
(t (org-export-get-ordinal
destination info nil 'org-html--has-caption-p))))
(desc (cond (desc)
((not number) "No description for this link")
((numberp number) (number-to-string number))
(t (mapconcat #'number-to-string number ".")))))
(format "<a href=\"#%s\"%s>%s</a>" ref attributes desc))))))
(if (and destination
(memq (plist-get info :with-latex) '(mathjax t))
(eq 'latex-environment (org-element-type destination))
(eq 'math (org-latex--environment-type destination)))
;; Caption and labels are introduced within LaTeX
;; environment. Use "eqref" macro to refer to those in
;; the document.
(format "\\eqref{%s}"
(org-export-get-reference destination info))
(let* ((ref (org-export-get-reference destination info))
(org-html-standalone-image-predicate
#'org-html--has-caption-p)
(counter-predicate
(if (eq 'latex-environment (org-element-type destination))
#'org-html--math-environment-p
#'org-html--has-caption-p))
(number
(cond
(desc nil)
((org-html-standalone-image-p destination info)
(org-export-get-ordinal
(org-element-map destination 'link #'identity info t)
info 'link 'org-html-standalone-image-p))
(t (org-export-get-ordinal
destination info nil counter-predicate))))
(desc
(cond (desc)
((not number) "No description for this link")
((numberp number) (number-to-string number))
(t (mapconcat #'number-to-string number ".")))))
(format "<a href=\"#%s\"%s>%s</a>" ref attributes desc)))))))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
@ -3111,18 +3216,18 @@ INFO is a plist holding contextual information. See
(format (org-export-get-coderef-format path desc)
(org-export-resolve-coderef path info)))))
;; External link with a description part.
((and path desc) (format "<a href=\"%s\"%s>%s</a>"
(org-html-encode-plain-text path)
attributes
desc))
((and path desc)
(format "<a href=\"%s\"%s>%s</a>"
(org-html-encode-plain-text path)
attributes
desc))
;; External link without a description part.
(path (let ((path (org-html-encode-plain-text path)))
(format "<a href=\"%s\"%s>%s</a>"
path
attributes
(org-link-unescape path))))
(path
(let ((path (org-html-encode-plain-text path)))
(format "<a href=\"%s\"%s>%s</a>" path attributes path)))
;; No path, only description. Try to do something useful.
(t (format "<i>%s</i>" desc)))))
(t
(format "<i>%s</i>" desc)))))
;;;; Node Property
@ -3665,8 +3770,8 @@ contextual information."
(with-temp-buffer
(insert contents)
(set-auto-mode t)
(if (plist-get info :html-indent)
(indent-region (point-min) (point-max)))
(when (plist-get info :html-indent)
(indent-region (point-min) (point-max)))
(buffer-substring-no-properties (point-min) (point-max))))

123
lisp/org/ox-icalendar.el
View file

@ -33,7 +33,7 @@
(require 'cl-lib)
(require 'ox-ascii)
(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
(declare-function org-bbdb-anniv-export-ical "ol-bbdb" nil)
@ -87,37 +87,66 @@ keyword."
This is a list with possibly several symbols in it. Valid symbols are:
`event-if-todo' Deadlines in TODO entries become calendar events.
`event-if-not-todo' Deadlines in non-TODO entries become calendar events.
`todo-due' Use deadlines in TODO entries as due-dates."
`event-if-todo'
Deadlines in TODO entries become calendar events.
`event-if-todo-not-done'
Deadlines in TODO entries with not-DONE state become events.
`event-if-not-todo'
Deadlines in non-TODO entries become calendar events.
`todo-due'
Use deadlines in TODO entries as due-dates."
:group 'org-export-icalendar
:type '(set :greedy t
(const :tag "Deadlines in non-TODO entries become events"
event-if-not-todo)
(const :tag "Deadline in TODO entries become events"
event-if-todo)
(const :tag "Deadlines in TODO entries become due-dates"
todo-due)))
:type
'(set :greedy t
(const :tag "DEADLINE in non-TODO entries become events"
event-if-not-todo)
(const :tag "DEADLINE in TODO entries become events"
event-if-todo)
(const :tag "DEADLINE in TODO entries with not-DONE state become events"
event-if-todo-not-done)
(const :tag "DEADLINE in TODO entries become due-dates"
todo-due)))
(defcustom org-icalendar-use-scheduled '(todo-start)
"Contexts where iCalendar export should use a scheduling time stamp.
This is a list with possibly several symbols in it. Valid symbols are:
`event-if-todo' Scheduling time stamps in TODO entries become an event.
`event-if-not-todo' Scheduling time stamps in non-TODO entries become an event.
`todo-start' Scheduling time stamps in TODO entries become start date.
Some calendar applications show TODO entries only after
that date."
`event-if-todo'
Scheduling time stamps in TODO entries become an event.
`event-if-todo-not-done'
Scheduling time stamps in TODO entries with not-DONE state
become events.
`event-if-not-todo'
Scheduling time stamps in non-TODO entries become an event.
`todo-start'
Scheduling time stamps in TODO entries become start date. Some
calendar applications show TODO entries only after that date."
:group 'org-export-icalendar
:type '(set :greedy t
(const :tag
"SCHEDULED timestamps in non-TODO entries become events"
event-if-not-todo)
(const :tag "SCHEDULED timestamps in TODO entries become events"
event-if-todo)
(const :tag "SCHEDULED in TODO entries become start date"
todo-start)))
:type
'(set :greedy t
(const :tag "SCHEDULED timestamps in non-TODO entries become events"
event-if-not-todo)
(const :tag "SCHEDULED timestamps in TODO entries become events"
event-if-todo)
(const :tag "SCHEDULED in TODO entries with not-DONE state become events"
event-if-todo-not-done)
(const :tag "SCHEDULED in TODO entries become start date"
todo-start)))
(defcustom org-icalendar-categories '(local-tags category)
"Items that should be entered into the \"categories\" field.
@ -317,7 +346,7 @@ A headline is blocked when either
done first or is a child of a blocked grandparent entry."
(or
;; Check if any child is not done.
(org-element-map headline 'headline
(org-element-map (org-element-contents headline) 'headline
(lambda (hl) (eq (org-element-property :todo-type hl) 'todo))
info 'first-match)
;; Check :ORDERED: node property.
@ -540,6 +569,10 @@ inlinetask within the section."
(org-export-get-node-property
:LOCATION entry
(org-property-inherit-p "LOCATION"))))
(class (org-icalendar-cleanup-string
(org-export-get-node-property
:CLASS entry
(org-property-inherit-p "CLASS"))))
;; Build description of the entry from associated section
;; (headline) or contents (inlinetask).
(desc
@ -562,20 +595,28 @@ inlinetask within the section."
;; Events: Delegate to `org-icalendar--vevent' to generate
;; "VEVENT" component from scheduled, deadline, or any
;; timestamp in the entry.
(let ((deadline (org-element-property :deadline entry)))
(let ((deadline (org-element-property :deadline entry))
(use-deadline (plist-get info :icalendar-use-deadline)))
(and deadline
(memq (if todo-type 'event-if-todo 'event-if-not-todo)
org-icalendar-use-deadline)
(pcase todo-type
(`todo (or (memq 'event-if-todo-not-done use-deadline)
(memq 'event-if-todo use-deadline)))
(`done (memq 'event-if-todo use-deadline))
(_ (memq 'event-if-not-todo use-deadline)))
(org-icalendar--vevent
entry deadline (concat "DL-" uid)
(concat "DL: " summary) loc desc cat tz)))
(let ((scheduled (org-element-property :scheduled entry)))
(concat "DL: " summary) loc desc cat tz class)))
(let ((scheduled (org-element-property :scheduled entry))
(use-scheduled (plist-get info :icalendar-use-scheduled)))
(and scheduled
(memq (if todo-type 'event-if-todo 'event-if-not-todo)
org-icalendar-use-scheduled)
(pcase todo-type
(`todo (or (memq 'event-if-todo-not-done use-scheduled)
(memq 'event-if-todo use-scheduled)))
(`done (memq 'event-if-todo use-scheduled))
(_ (memq 'event-if-not-todo use-scheduled)))
(org-icalendar--vevent
entry scheduled (concat "SC-" uid)
(concat "S: " summary) loc desc cat tz)))
(concat "S: " summary) loc desc cat tz class)))
;; When collecting plain timestamps from a headline and its
;; title, skip inlinetasks since collection will happen once
;; ENTRY is one of them.
@ -593,7 +634,7 @@ inlinetask within the section."
((t) t)))
(let ((uid (format "TS%d-%s" (cl-incf counter) uid)))
(org-icalendar--vevent
entry ts uid summary loc desc cat tz))))
entry ts uid summary loc desc cat tz class))))
info nil (and (eq type 'headline) 'inlinetask))
""))
;; Task: First check if it is appropriate to export it. If
@ -607,7 +648,7 @@ inlinetask within the section."
(not (org-icalendar-blocked-headline-p
entry info))))
((t) (eq todo-type 'todo))))
(org-icalendar--vtodo entry uid summary loc desc cat tz))
(org-icalendar--vtodo entry uid summary loc desc cat tz class))
;; Diary-sexp: Collect every diary-sexp element within ENTRY
;; and its title, and transcode them. If ENTRY is
;; a headline, skip inlinetasks: they will be handled
@ -638,7 +679,7 @@ inlinetask within the section."
contents))))
(defun org-icalendar--vevent
(entry timestamp uid summary location description categories timezone)
(entry timestamp uid summary location description categories timezone class)
"Create a VEVENT component.
ENTRY is either a headline or an inlinetask element. TIMESTAMP
@ -648,7 +689,9 @@ summary or subject for the event. LOCATION defines the intended
venue for the event. DESCRIPTION provides the complete
description of the event. CATEGORIES defines the categories the
event belongs to. TIMEZONE specifies a time zone for this event
only.
only. CLASS contains the visibility attribute. Three of them
(\"PUBLIC\", \"CONFIDENTIAL\", and \"PRIVATE\") are predefined, others
should be treated as \"PRIVATE\" if they are unknown to the iCalendar server.
Return VEVENT component as a string."
(org-icalendar-fold-string
@ -669,6 +712,7 @@ Return VEVENT component as a string."
(org-element-property :repeater-value timestamp)))
"SUMMARY:" summary "\n"
(and (org-string-nw-p location) (format "LOCATION:%s\n" location))
(and (org-string-nw-p class) (format "CLASS:%s\n" class))
(and (org-string-nw-p description)
(format "DESCRIPTION:%s\n" description))
"CATEGORIES:" categories "\n"
@ -677,7 +721,7 @@ Return VEVENT component as a string."
"END:VEVENT"))))
(defun org-icalendar--vtodo
(entry uid summary location description categories timezone)
(entry uid summary location description categories timezone class)
"Create a VTODO component.
ENTRY is either a headline or an inlinetask element. UID is the
@ -712,6 +756,7 @@ Return VTODO component as a string."
"\n"))
"SUMMARY:" summary "\n"
(and (org-string-nw-p location) (format "LOCATION:%s\n" location))
(and (org-string-nw-p class) (format "CLASS:%s\n" class))
(and (org-string-nw-p description)
(format "DESCRIPTION:%s\n" description))
"CATEGORIES:" categories "\n"
@ -963,7 +1008,7 @@ FILES is a list of files to build the calendar from."
files "")
;; BBDB anniversaries.
(when (and org-icalendar-include-bbdb-anniversaries
(require 'org-bbdb nil t))
(require 'ol-bbdb nil t))
(with-output-to-string (org-bbdb-anniv-export-ical)))))))
(run-hook-with-args 'org-icalendar-after-save-hook
org-icalendar-combined-agenda-file))

545
lisp/org/ox-latex.el
View file

@ -127,6 +127,7 @@
(:latex-format-headline-function nil nil org-latex-format-headline-function)
(:latex-format-inlinetask-function nil nil org-latex-format-inlinetask-function)
(:latex-hyperref-template nil nil org-latex-hyperref-template t)
(:latex-image-default-scale nil nil org-latex-image-default-scale)
(:latex-image-default-height nil nil org-latex-image-default-height)
(:latex-image-default-option nil nil org-latex-image-default-option)
(:latex-image-default-width nil nil org-latex-image-default-width)
@ -159,7 +160,6 @@
(defconst org-latex-babel-language-alist
'(("af" . "afrikaans")
("bg" . "bulgarian")
("bt-br" . "brazilian")
("ca" . "catalan")
("cs" . "czech")
("cy" . "welsh")
@ -179,7 +179,7 @@
("et" . "estonian")
("eu" . "basque")
("fi" . "finnish")
("fr" . "frenchb")
("fr" . "french")
("fr-ca" . "canadien")
("gl" . "galician")
("hr" . "croatian")
@ -195,6 +195,7 @@
("no" . "norsk")
("pl" . "polish")
("pt" . "portuguese")
("pt-br" . "brazilian")
("ro" . "romanian")
("ru" . "russian")
("sa" . "sanskrit")
@ -211,13 +212,12 @@
(defconst org-latex-polyglossia-language-alist
'(("am" "amharic")
("ast" "asturian")
("ar" "arabic")
("bo" "tibetan")
("bn" "bengali")
("ast" "asturian")
("bg" "bulgarian")
("bn" "bengali")
("bo" "tibetan")
("br" "breton")
("bt-br" "brazilian")
("ca" "catalan")
("cop" "coptic")
("cs" "czech")
@ -226,6 +226,7 @@
("de" "german" "german")
("de-at" "german" "austrian")
("de-de" "german" "german")
("dsb" "lsorbian")
("dv" "divehi")
("el" "greek")
("en" "english" "usmax")
@ -247,40 +248,40 @@
("he" "hebrew")
("hi" "hindi")
("hr" "croatian")
("hsb" "usorbian")
("hu" "magyar")
("hy" "armenian")
("id" "bahasai")
("ia" "interlingua")
("id" "bahasai")
("is" "icelandic")
("it" "italian")
("kn" "kannada")
("la" "latin" "modern")
("la-modern" "latin" "modern")
("la-classic" "latin" "classic")
("la-medieval" "latin" "medieval")
("la-modern" "latin" "modern")
("lo" "lao")
("lt" "lithuanian")
("lv" "latvian")
("mr" "maranthi")
("ml" "malayalam")
("nl" "dutch")
("mr" "maranthi")
("nb" "norsk")
("nn" "nynorsk")
("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")
("hsb" "usorbian")
("dsb" "lsorbian")
("se" "samin")
("sk" "slovak")
("sl" "slovenian")
("se" "samin")
("sq" "albanian")
("sr" "serbian")
("sv" "swedish")
@ -295,8 +296,6 @@
("vi" "vietnamese"))
"Alist between language code and corresponding Polyglossia option")
(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr")
("qbordermatrix" . "\\cr")
("kbordermatrix" . "\\\\"))
@ -708,6 +707,16 @@ This value will not be used if a height is provided."
:package-version '(Org . "8.0")
:type 'string)
(defcustom org-latex-image-default-scale ""
"Default scale for images.
This value will not be used if a width or a scale is provided,
or if the image is wrapped within a \"wrapfigure\" environment.
Scale overrides width and height."
:group 'org-export-latex
:package-version '(Org . "9.3")
:type 'string
:safe #'stringp)
(defcustom org-latex-image-default-height ""
"Default height for images.
This value will not be used if a width is provided, or if the
@ -810,8 +819,9 @@ attributes."
:type 'boolean
:safe #'booleanp)
(defcustom org-latex-table-scientific-notation "%s\\,(%s)"
(defcustom org-latex-table-scientific-notation nil
"Format string to display numbers in scientific notation.
The format should have \"%s\" twice, for mantissa and exponent
\(i.e., \"%s\\\\times10^{%s}\").
@ -1026,7 +1036,7 @@ value. For example,
(setq org-latex-minted-options
\\='((\"bgcolor\" \"bg\") (\"frame\" \"lines\")))
will result in src blocks being exported with
will result in source blocks being exported with
\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
@ -1047,12 +1057,13 @@ block-specific options, you may use the following syntax:
(defcustom org-latex-custom-lang-environments nil
"Alist mapping languages to language-specific LaTeX environments.
It is used during export of src blocks by the listings and minted
latex packages. The environment may be a simple string, composed of
only letters and numbers. In this case, the string is directly the
name of the latex environment to use. The environment may also be
a format string. In this case the format string will be directly
exported. This format string may contain these elements:
It is used during export of source blocks by the listings and
minted LaTeX packages. The environment may be a simple string,
composed of only letters and numbers. In this case, the string
is directly the name of the LaTeX environment to use. The
environment may also be a format string. In this case the format
string will be directly exported. This format string may contain
these elements:
%s for the formatted source
%c for the caption
@ -1074,7 +1085,7 @@ would have the effect that if Org encounters a Python source block
during LaTeX export it will produce
\\begin{pythoncode}
<src block body>
<source block body>
\\end{pythoncode}
and if Org encounters an Ocaml source block during LaTeX export it
@ -1082,7 +1093,7 @@ will produce
\\begin{listing}
\\begin{minted}[<attr_latex options>]{ocaml}
<src block body>
<source block body>
\\end{minted}
\\caption{<caption>}
\\label{<label>}
@ -1221,7 +1232,7 @@ logfiles to remove, set `org-latex-logfiles-extensions'."
("Undefined control sequence" . "[undefined control sequence]"))
"Alist of regular expressions and associated messages for the user.
The regular expressions are used to find possible warnings in the
log of a latex-run. These warnings will be reported after
log of a LaTeX-run. These warnings will be reported after
calling `org-latex-compile'."
:group 'org-export-latex
:version "26.1"
@ -1265,17 +1276,19 @@ Eventually, if FULL is non-nil, wrap label within \"\\label{}\"."
(and (or user-label force)
(if (and user-label (plist-get info :latex-prefer-user-labels))
user-label
(concat (cl-case type
(headline "sec:")
(table "tab:")
(latex-environment
(concat (pcase type
(`headline "sec:")
(`table "tab:")
(`latex-environment
(and (string-match-p
org-latex-math-environments-re
(org-element-property :value datum))
"eq:"))
(paragraph
(`latex-matrices "eq:")
(`paragraph
(and (org-element-property :caption datum)
"fig:")))
"fig:"))
(_ nil))
(org-export-get-reference datum info))))))
(cond ((not full) label)
(label (format "\\label{%s}%s"
@ -1325,7 +1338,7 @@ For non-floats, see `org-latex--wrap-label'."
(t (symbol-name type*)))
""))
(if short (format "[%s]" (org-export-data short info)) "")
label
(org-trim label)
(org-export-data main info))))))
(defun org-latex-guess-inputenc (header)
@ -1438,26 +1451,21 @@ Return the new header."
(defun org-latex--remove-packages (pkg-alist info)
"Remove packages based on the current LaTeX compiler.
If the fourth argument of an element is set in pkg-alist, and it
is not a member of the LaTeX compiler of the document, the packages
is removed. See also `org-latex-compiler'.
PKG-ALIST is a list of packages, as in `org-latex-packages-alist'
and `org-latex-default-packages-alist'. If the fourth argument
of a package is neither nil nor a member of the LaTeX compiler
associated to the document, the package is removed.
Return modified pkg-alist."
Return new list of packages."
(let ((compiler (or (plist-get info :latex-compiler) "")))
(if (member-ignore-case compiler org-latex-compilers)
(delq nil
(mapcar
(lambda (pkg)
(unless (and
(listp pkg)
(let ((third (nth 3 pkg)))
(and third
(not (member-ignore-case
compiler
(if (listp third) third (list third)))))))
pkg))
pkg-alist))
pkg-alist)))
(if (not (member-ignore-case compiler org-latex-compilers)) pkg-alist
(cl-remove-if-not
(lambda (package)
(pcase package
(`(,_ ,_ ,_ nil) t)
(`(,_ ,_ ,_ ,compilers) (member-ignore-case compiler compilers))
(_ t)))
pkg-alist))))
(defun org-latex--find-verb-separator (s)
"Return a character not used in string S.
@ -1851,7 +1859,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
CONTENTS is nil. INFO is a plist holding contextual information."
(org-latex--wrap-label
fixed-width
(format "\\begin{verbatim}\n%s\\end{verbatim}"
(format "\\begin{verbatim}\n%s\n\\end{verbatim}"
(org-remove-indentation
(org-element-property :value fixed-width)))
info))
@ -1877,9 +1885,12 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(org-export-get-footnote-definition footnote-reference info)
info t)))
;; Use \footnotemark if reference is within another footnote
;; reference, footnote definition or table cell.
((org-element-lineage footnote-reference
'(footnote-reference footnote-definition table-cell))
;; reference, footnote definition, table cell or item's tag.
((or (org-element-lineage footnote-reference
'(footnote-reference footnote-definition
table-cell))
(eq 'item (org-element-type
(org-export-get-parent-element footnote-reference))))
"\\footnotemark")
;; Otherwise, define it with \footnote command.
(t
@ -1890,11 +1901,11 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;; reference to def.
(cond ((not label) "")
((org-element-map (plist-get info :parse-tree) 'footnote-reference
(lambda (f)
(and (not (eq f footnote-reference))
(equal (org-element-property :label f) label)
(org-trim (org-latex--label def info t t))))
info t))
(lambda (f)
(and (not (eq f footnote-reference))
(equal (org-element-property :label f) label)
(org-trim (org-latex--label def info t t))))
info t))
(t "")))
;; Retrieve all footnote references within the footnote and
;; add their definition after it, since LaTeX doesn't support
@ -2131,8 +2142,9 @@ See `org-latex-format-inlinetask-function' for details."
(when priority (format "\\framebox{\\#%c} " priority))
title
(when tags
(format "\\hfill{}\\textsc{:%s:}"
(mapconcat #'org-latex--protect-text tags ":"))))))
(format "\\hfill{}\\textsc{%s}"
(org-make-tag-string
(mapcar #'org-latex--protect-text tags)))))))
(concat "\\begin{center}\n"
"\\fbox{\n"
"\\begin{minipage}[c]{.6\\textwidth}\n"
@ -2183,12 +2195,22 @@ contextual information."
(off "$\\square$")
(trans "$\\boxminus$")))
(tag (let ((tag (org-element-property :tag item)))
(and tag (org-export-data tag info)))))
(and tag (org-export-data tag info))))
;; If there are footnotes references in tag, be sure to add
;; their definition at the end of the item. This workaround
;; is necessary since "\footnote{}" command is not supported
;; in tags.
(tag-footnotes
(or (and tag (org-latex--delayed-footnotes-definitions
(org-element-property :tag item) info))
"")))
(concat counter
"\\item"
(cond
((and checkbox tag) (format "[{%s %s}] " checkbox tag))
((or checkbox tag) (format "[{%s}] " (or checkbox tag)))
((and checkbox tag)
(format "[{%s %s}] %s" checkbox tag tag-footnotes))
((or checkbox tag)
(format "[{%s}] %s" (or checkbox tag) tag-footnotes))
;; Without a tag or a check-box, if CONTENTS starts with
;; an opening square bracket, add "\relax" to "\item",
;; unless the brackets comes from an initial export
@ -2203,14 +2225,7 @@ contextual information."
'latex)))))))
"\\relax ")
(t " "))
(and contents (org-trim contents))
;; If there are footnotes references in tag, be sure to
;; add their definition at the end of the item. This
;; workaround is necessary since "\footnote{}" command is
;; not supported in tags.
(and tag
(org-latex--delayed-footnotes-definitions
(org-element-property :tag item) info)))))
(and contents (org-trim contents)))))
;;;; Keyword
@ -2370,13 +2385,18 @@ used as a communication channel."
(if (plist-member attr :center) (plist-get attr :center)
(plist-get info :latex-images-centered)))
(comment-include (if (plist-get attr :comment-include) "%" ""))
;; It is possible to specify width and height in the
;; ATTR_LATEX line, and also via default variables.
(width (cond ((plist-get attr :width))
;; It is possible to specify scale or width and height in
;; the ATTR_LATEX line, and also via default variables.
(scale (cond ((eq float 'wrap) "")
((plist-get attr :scale))
(t (plist-get info :latex-image-default-scale))))
(width (cond ((org-string-nw-p scale) "")
((plist-get attr :width))
((plist-get attr :height) "")
((eq float 'wrap) "0.48\\textwidth")
(t (plist-get info :latex-image-default-width))))
(height (cond ((plist-get attr :height))
(height (cond ((org-string-nw-p scale) "")
((plist-get attr :height))
((or (plist-get attr :width)
(memq float '(figure wrap))) "")
(t (plist-get info :latex-image-default-height))))
@ -2398,18 +2418,21 @@ used as a communication channel."
(format "\\begin{tikzpicture}[%s]\n%s\n\\end{tikzpicture}"
options
image-code)))
(when (or (org-string-nw-p width) (org-string-nw-p height))
(setq image-code (format "\\resizebox{%s}{%s}{%s}"
(if (org-string-nw-p width) width "!")
(if (org-string-nw-p height) height "!")
image-code))))
(setq image-code
(cond ((org-string-nw-p scale)
(format "\\scalebox{%s}{%s}" scale image-code))
((or (org-string-nw-p width) (org-string-nw-p height))
(format "\\resizebox{%s}{%s}{%s}"
(if (org-string-nw-p width) width "!")
(if (org-string-nw-p height) height "!")
image-code)))))
;; For other images:
;; - add width and height to options.
;; - add scale, or width and height to options.
;; - include the image with \includegraphics.
(when (org-string-nw-p width)
(setq options (concat options ",width=" width)))
(when (org-string-nw-p height)
(setq options (concat options ",height=" height)))
(if (org-string-nw-p scale)
(setq options (concat options ",scale=" scale))
(when (org-string-nw-p width) (setq options (concat options ",width=" width)))
(when (org-string-nw-p height) (setq options (concat options ",height=" height))))
(let ((search-option (org-element-property :search-option link)))
(when (and search-option
(equal filetype "pdf")
@ -2496,8 +2519,10 @@ INFO is a plist holding contextual information. See
(path (org-latex--protect-text
(cond ((member type '("http" "https" "ftp" "mailto" "doi"))
(concat type ":" raw-path))
((string= type "file") (org-export-file-uri raw-path))
(t raw-path)))))
((string= type "file")
(org-export-file-uri raw-path))
(t
raw-path)))))
(cond
;; Link type is handled by a special function.
((org-export-custom-protocol-maybe link desc 'latex))
@ -2514,9 +2539,10 @@ INFO is a plist holding contextual information. See
;; Links pointing to a headline: Find destination and build
;; appropriate referencing command.
((member type '("custom-id" "fuzzy" "id"))
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
(let ((destination
(if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info 'latex-matrices)
(org-export-resolve-id-link link info))))
(cl-case (org-element-type destination)
;; Id link points to an external file.
(plain-text
@ -2709,12 +2735,18 @@ it."
'latex-matrices)))
(let* ((caption (and (not (string= mode "inline-math"))
(org-element-property :caption table)))
(name (and (not (string= mode "inline-math"))
(org-element-property :name table)))
(matrices
(list 'latex-matrices
(list :caption caption
;; Inherit name from the first table.
(list :name name
;; FIXME: what syntax for captions?
;;
;; :caption caption
:markup
(cond ((string= mode "inline-math") 'inline)
(caption 'equation)
((or caption name) 'equation)
(t 'math)))))
(previous table)
(next (org-export-get-next-element table info)))
@ -2729,6 +2761,8 @@ it."
:attr_latex next :mode)
(plist-get info :latex-default-table-mode))
mode))
(org-element-put-property table :name nil)
(org-element-put-property table :caption nil)
(org-element-extract-element previous)
(org-element-adopt-elements matrices previous)
(setq previous next))
@ -2738,20 +2772,29 @@ it."
(org-element-put-property
matrices :post-blank (org-element-property :post-blank previous))
(org-element-put-property previous :post-blank 0)
(org-element-put-property table :name nil)
(org-element-put-property table :caption nil)
(org-element-extract-element previous)
(org-element-adopt-elements matrices previous))))))
info)
data)
(defun org-latex-matrices (matrices contents _info)
(defun org-latex-matrices (matrices contents info)
"Transcode a MATRICES element from Org to LaTeX.
CONTENTS is a string. INFO is a plist used as a communication
channel."
(format (cl-case (org-element-property :markup matrices)
(inline "\\(%s\\)")
(equation "\\begin{equation}\n%s\\end{equation}")
(t "\\[\n%s\\]"))
contents))
(pcase (org-element-property :markup matrices)
(`inline (format "\\(%s\\)" contents))
(`equation
(let ((caption (org-latex--caption/label-string matrices info))
(caption-above? (org-latex--caption-above-p matrices info)))
(concat "\\begin{equation}\n"
(and caption-above? caption)
contents
(and (not caption-above?) caption)
"\\end{equation}")))
(_
(format "\\[\n%s\\]" contents))))
;;;; Pseudo Object: LaTeX Math Block
@ -2764,24 +2807,21 @@ channel."
DATA is a parse tree or a secondary string. INFO is a plist
containing export options. Modify DATA by side-effect and return it."
(let ((valid-object-p
;; Non-nil when OBJ can be added to the latex math block B.
(lambda (obj b)
(pcase (org-element-type obj)
(`entity (org-element-property :latex-math-p obj))
;; Non-nil when OBJECT can be added to a latex math block.
(lambda (object)
(pcase (org-element-type object)
(`entity (org-element-property :latex-math-p object))
(`latex-fragment
(let ((value (org-element-property :value obj)))
(let ((value (org-element-property :value object)))
(or (string-prefix-p "\\(" value)
(string-match-p "\\`\\$[^$]" value))))
((and type (or `subscript `superscript))
(not (memq type (mapcar #'org-element-type
(org-element-contents b)))))))))
(org-element-map data '(entity latex-fragment subscript superscript)
(string-match-p "\\`\\$[^$]" value))))))))
(org-element-map data '(entity latex-fragment)
(lambda (object)
;; Skip objects already wrapped.
(when (and (not (eq (org-element-type
(org-element-property :parent object))
'latex-math-block))
(funcall valid-object-p object nil))
(funcall valid-object-p object))
(let ((math-block (list 'latex-math-block nil))
(next-elements (org-export-get-next-element object info t))
(last object))
@ -2793,20 +2833,17 @@ containing export options. Modify DATA by side-effect and return it."
;; MATH-BLOCK swallows consecutive math objects.
(catch 'exit
(dolist (next next-elements)
(unless (funcall valid-object-p next math-block)
(throw 'exit nil))
(unless (funcall valid-object-p next) (throw 'exit nil))
(org-element-extract-element next)
(org-element-adopt-elements math-block next)
;; Eschew the case: \beta$x$ -> \(\betax\).
(unless (memq (org-element-type next)
'(subscript superscript))
(org-element-put-property last :post-blank 1))
(org-element-put-property last :post-blank 1)
(setq last next)
(when (> (or (org-element-property :post-blank next) 0) 0)
(throw 'exit nil)))))
(org-element-put-property
math-block :post-blank (org-element-property :post-blank last)))))
info nil '(subscript superscript latex-math-block) t)
info nil '(latex-math-block) t)
;; Return updated DATA.
data))
@ -2883,7 +2920,7 @@ contextual information."
(listings (plist-get info :latex-listings)))
(cond
;; Case 1. No source fontification.
((not listings)
((or (not lang) (not listings))
(let* ((caption-str (org-latex--caption/label-string src-block info))
(float-env
(cond ((string= "multicolumn" float)
@ -2920,21 +2957,23 @@ contextual information."
;; Case 3. Use minted package.
((eq listings 'minted)
(let* ((caption-str (org-latex--caption/label-string src-block info))
(placement (or (org-unbracket-string "[" "]" (plist-get attributes :placement))
(plist-get info :latex-default-figure-position)))
(float-env
(cond
((string= "multicolumn" float)
(format "\\begin{listing*}[%s]\n%s%%s\n%s\\end{listing*}"
(plist-get info :latex-default-figure-position)
placement
(if caption-above-p caption-str "")
(if caption-above-p "" caption-str)))
(caption
(format "\\begin{listing}[%s]\n%s%%s\n%s\\end{listing}"
(plist-get info :latex-default-figure-position)
placement
(if caption-above-p caption-str "")
(if caption-above-p "" caption-str)))
((string= "t" float)
(concat (format "\\begin{listing}[%s]\n"
(plist-get info :latex-default-figure-position))
placement)
"%s\n\\end{listing}"))
(t "%s")))
(options (plist-get info :latex-minted-options))
@ -3061,56 +3100,18 @@ holding contextual information."
;;;; Subscript
(defun org-latex--script-size (object info)
"Transcode a subscript or superscript object.
OBJECT is an Org object. INFO is a plist used as a communication
channel."
(let ((output ""))
(org-element-map (org-element-contents object)
(cons 'plain-text org-element-all-objects)
(lambda (obj)
(cl-case (org-element-type obj)
((entity latex-fragment)
(let ((data (org-trim (org-export-data obj info))))
(string-match
"\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'"
data)
(setq output
(concat output
(match-string 1 data)
(let ((blank (org-element-property :post-blank obj)))
(and blank (> blank 0) "\\ "))))))
(plain-text
(setq output
(format "%s\\text{%s}" output (org-export-data obj info))))
(otherwise
(setq output
(concat output
(org-export-data obj info)
(let ((blank (org-element-property :post-blank obj)))
(and blank (> blank 0) "\\ ")))))))
info nil org-element-recursive-objects)
;; Result. Do not wrap into curly brackets if OUTPUT is a single
;; character.
(concat (if (eq (org-element-type object) 'subscript) "_" "^")
(and (> (length output) 1) "{")
output
(and (> (length output) 1) "}"))))
(defun org-latex-subscript (subscript _contents info)
(defun org-latex-subscript (_subscript contents _info)
"Transcode a SUBSCRIPT object from Org to LaTeX.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
(org-latex--script-size subscript info))
CONTENTS is the contents of the object."
(format "\\textsubscript{%s}" contents))
;;;; Superscript
(defun org-latex-superscript (superscript _contents info)
(defun org-latex-superscript (_superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to LaTeX.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
(org-latex--script-size superscript info))
CONTENTS is the contents of the object."
(format "\\textsuperscript{%s}" contents))
;;;; Table
@ -3180,6 +3181,56 @@ centered."
info)
(apply 'concat (nreverse align)))))
(defun org-latex--decorate-table (table attributes caption above? info)
"Decorate TABLE string with caption and float environment.
ATTRIBUTES is the plist containing is LaTeX attributes. CAPTION
is its caption, as a string or nil. It is located above the
table if ABOVE? is non-nil. INFO is the plist containing current
export parameters.
Return new environment, as a string."
(let* ((float-environment
(let ((float (plist-get attributes :float)))
(cond ((and (not float) (plist-member attributes :float)) nil)
((member float '("sidewaystable" "sideways")) "sidewaystable")
((equal float "multicolumn") "table*")
((or float (org-string-nw-p caption)) "table")
(t nil))))
(placement
(or (plist-get attributes :placement)
(format "[%s]" (plist-get info :latex-default-figure-position))))
(center? (if (plist-member attributes :center)
(plist-get attributes :center)
(plist-get info :latex-tables-centered)))
(fontsize (let ((font (plist-get attributes :font)))
(and font (concat font "\n")))))
(concat (cond
(float-environment
(concat (format "\\begin{%s}%s\n" float-environment placement)
(if above? caption "")
(when center? "\\centering\n")
fontsize))
(caption
(concat (and center? "\\begin{center}\n" )
(if above? caption "")
(cond ((and fontsize center?) fontsize)
(fontsize (concat "{" fontsize))
(t nil))))
(center? (concat "\\begin{center}\n" fontsize))
(fontsize (concat "{" fontsize)))
table
(cond
(float-environment
(concat (if above? "" (concat "\n" caption))
(format "\n\\end{%s}" float-environment)))
(caption
(concat (if above? "" (concat "\n" caption))
(and center? "\n\\end{center}")
(and fontsize (not center?) "}")))
(center? "\n\\end{center}")
(fontsize "}")))))
(defun org-latex--org-table (table contents info)
"Return appropriate LaTeX code for an Org table.
@ -3189,109 +3240,44 @@ channel.
This function assumes TABLE has `org' as its `:type' property and
`table' as its `:mode' attribute."
(let* ((caption (org-latex--caption/label-string table info))
(attr (org-export-read-attribute :attr_latex table))
;; Determine alignment string.
(let* ((attr (org-export-read-attribute :attr_latex table))
(alignment (org-latex--align-string table info))
;; Determine environment for the table: longtable, tabular...
(table-env (or (plist-get attr :environment)
(plist-get info :latex-default-table-environment)))
;; If table is a float, determine environment: table, table*
;; or sidewaystable.
(float-env (unless (member table-env '("longtable" "longtabu"))
(let ((float (plist-get attr :float)))
(cond
((and (not float) (plist-member attr :float)) nil)
((or (string= float "sidewaystable")
(string= float "sideways")) "sidewaystable")
((string= float "multicolumn") "table*")
((or float
(org-element-property :caption table)
(org-string-nw-p (plist-get attr :caption)))
"table")))))
;; Extract others display options.
(fontsize (let ((font (plist-get attr :font)))
(and font (concat font "\n"))))
;; "tabular" environment doesn't allow to define a width.
(width (and (not (equal table-env "tabular")) (plist-get attr :width)))
(spreadp (plist-get attr :spread))
(placement
(or (plist-get attr :placement)
(format "[%s]" (plist-get info :latex-default-figure-position))))
(centerp (if (plist-member attr :center) (plist-get attr :center)
(plist-get info :latex-tables-centered)))
(caption-above-p (org-latex--caption-above-p table info)))
;; Prepare the final format string for the table.
(width
(let ((w (plist-get attr :width)))
(cond ((not w) "")
((member table-env '("tabular" "longtable")) "")
((member table-env '("tabu" "longtabu"))
(format (if (plist-get attr :spread) " spread %s "
" to %s ")
w))
(t (format "{%s}" w)))))
(caption (org-latex--caption/label-string table info))
(above? (org-latex--caption-above-p table info)))
(cond
;; Longtable.
((equal "longtable" table-env)
(concat (and fontsize (concat "{" fontsize))
(format "\\begin{longtable}{%s}\n" alignment)
(and caption-above-p
(org-string-nw-p caption)
(concat caption "\\\\\n"))
contents
(and (not caption-above-p)
(org-string-nw-p caption)
(concat caption "\\\\\n"))
"\\end{longtable}\n"
(and fontsize "}")))
;; Longtabu
((equal "longtabu" table-env)
(concat (and fontsize (concat "{" fontsize))
(format "\\begin{longtabu}%s{%s}\n"
(if width
(format " %s %s "
(if spreadp "spread" "to") width) "")
alignment)
(and caption-above-p
(org-string-nw-p caption)
(concat caption "\\\\\n"))
contents
(and (not caption-above-p)
(org-string-nw-p caption)
(concat caption "\\\\\n"))
"\\end{longtabu}\n"
(and fontsize "}")))
;; Others.
(t (concat (cond
(float-env
(concat (format "\\begin{%s}%s\n" float-env placement)
(if caption-above-p caption "")
(when centerp "\\centering\n")
fontsize))
((and (not float-env) caption)
(concat
(and centerp "\\begin{center}\n" )
(if caption-above-p caption "")
(cond ((and fontsize centerp) fontsize)
(fontsize (concat "{" fontsize)))))
(centerp (concat "\\begin{center}\n" fontsize))
(fontsize (concat "{" fontsize)))
(cond ((equal "tabu" table-env)
(format "\\begin{tabu}%s{%s}\n%s\\end{tabu}"
(if width (format
(if spreadp " spread %s " " to %s ")
width) "")
alignment
contents))
(t (format "\\begin{%s}%s{%s}\n%s\\end{%s}"
table-env
(if width (format "{%s}" width) "")
alignment
contents
table-env)))
(cond
(float-env
(concat (if caption-above-p "" (concat "\n" caption))
(format "\n\\end{%s}" float-env)))
((and (not float-env) caption)
(concat
(if caption-above-p "" (concat "\n" caption))
(and centerp "\n\\end{center}")
(and fontsize (not centerp) "}")))
(centerp "\n\\end{center}")
(fontsize "}")))))))
((member table-env '("longtable" "longtabu"))
(let ((fontsize (let ((font (plist-get attr :font)))
(and font (concat font "\n")))))
(concat (and fontsize (concat "{" fontsize))
(format "\\begin{%s}%s{%s}\n" table-env width alignment)
(and above?
(org-string-nw-p caption)
(concat caption "\\\\\n"))
contents
(and (not above?)
(org-string-nw-p caption)
(concat caption "\\\\\n"))
(format "\\end{%s}" table-env)
(and fontsize "}"))))
(t
(let ((output (format "\\begin{%s}%s{%s}\n%s\\end{%s}"
table-env
width
alignment
contents
table-env)))
(org-latex--decorate-table output attr caption above? info))))))
(defun org-latex--table.el-table (table info)
"Return appropriate LaTeX code for a table.el table.
@ -3305,18 +3291,20 @@ property."
;; Ensure "*org-export-table*" buffer is empty.
(with-current-buffer (get-buffer-create "*org-export-table*")
(erase-buffer))
(let ((output (with-temp-buffer
(insert (org-element-property :value table))
(goto-char 1)
(re-search-forward "^[ \t]*|[^|]" nil t)
(table-generate-source 'latex "*org-export-table*")
(with-current-buffer "*org-export-table*"
(org-trim (buffer-string))))))
(let ((output
(replace-regexp-in-string
"^%.*\n" "" ;remove comments
(with-temp-buffer
(save-excursion (insert (org-element-property :value table)))
(re-search-forward "^[ \t]*|[^|]" nil t)
(table-generate-source 'latex "*org-export-table*")
(with-current-buffer "*org-export-table*"
(org-trim (buffer-string))))
t t)))
(kill-buffer (get-buffer "*org-export-table*"))
;; Remove left out comments.
(while (string-match "^%.*\n" output)
(setq output (replace-match "" t t output)))
(let ((attr (org-export-read-attribute :attr_latex table)))
(let ((attr (org-export-read-attribute :attr_latex table))
(caption (org-latex--caption/label-string table info))
(above? (org-latex--caption-above-p table info)))
(when (plist-get attr :rmlines)
;; When the "rmlines" attribute is provided, remove all hlines
;; but the one separating heading from the table body.
@ -3325,10 +3313,7 @@ property."
(setq pos (string-match "^\\\\hline\n?" output pos)))
(cl-incf n)
(unless (= n 2) (setq output (replace-match "" nil nil output))))))
(let ((centerp (if (plist-member attr :center) (plist-get attr :center)
(plist-get info :latex-tables-centered))))
(if (not centerp) output
(format "\\begin{center}\n%s\n\\end{center}" output))))))
(org-latex--decorate-table output attr caption above? info))))
(defun org-latex--math-table (table info)
"Return appropriate LaTeX code for a matrix.

2
lisp/org/ox-man.el
View file

@ -424,7 +424,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
CONTENTS is nil. INFO is a plist holding contextual information."
(org-man--wrap-label
fixed-width
(format "\\fC\n%s\\fP"
(format "\\fC\n%s\n\\fP"
(org-remove-indentation
(org-element-property :value fixed-width)))))

46
lisp/org/ox-md.el
View file

@ -175,7 +175,7 @@ channel."
value)))
;;;; Example Block, Src Block and export Block
;;;; Example Block, Src Block and Export Block
(defun org-md-example-block (example-block _contents info)
"Transcode EXAMPLE-BLOCK element into Markdown format.
@ -211,8 +211,7 @@ a communication channel."
(tags (and (plist-get info :with-tags)
(let ((tag-list (org-export-get-tags headline info)))
(and tag-list
(format " :%s:"
(mapconcat 'identity tag-list ":"))))))
(concat " " (org-make-tag-string tag-list))))))
(priority
(and (plist-get info :with-priority)
(let ((char (org-element-property :priority headline)))
@ -364,9 +363,14 @@ channel."
((string-match-p "\\<headlines\\>" value)
(let ((depth (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value))))
(local? (string-match-p "\\<local\\>" value)))
(scope
(cond
((string-match ":target +\\(\".+?\"\\|\\S-+\\)" value) ;link
(org-export-resolve-link
(org-strip-quotes (match-string 1 value)) info))
((string-match-p "\\<local\\>" value) keyword)))) ;local
(org-remove-indentation
(org-md--build-toc info depth keyword local?)))))))
(org-md--build-toc info depth keyword scope)))))))
(_ (org-export-with-backend 'html keyword contents info))))
@ -449,7 +453,7 @@ a communication channel."
(t (let* ((raw-path (org-element-property :path link))
(path
(cond
((member type '("http" "https" "ftp" "mailto" "irc"))
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
((string= type "file")
(org-export-file-uri (funcall link-org-files-as-md raw-path)))
@ -551,7 +555,7 @@ a communication channel."
;;;; Template
(defun org-md--build-toc (info &optional n keyword local)
(defun org-md--build-toc (info &optional n _keyword scope)
"Return a table of contents.
INFO is a plist used as a communication channel.
@ -559,13 +563,10 @@ INFO is a plist used as a communication channel.
Optional argument N, when non-nil, is an integer specifying the
depth of the table.
Optional argument KEYWORD specifies the TOC keyword, if any, from
which the table of contents generation has been initiated.
When optional argument LOCAL is non-nil, build a table of
contents according to the current headline."
When optional argument SCOPE is non-nil, build a table of
contents according to the specified element."
(concat
(unless local
(unless scope
(let ((style (plist-get info :md-headline-style))
(title (org-html--translate "Table of Contents" info)))
(org-md--headline-title style 1 title nil)))
@ -575,10 +576,13 @@ contents according to the current headline."
(make-string
(* 4 (1- (org-export-get-relative-level headline info)))
?\s))
(number (format "%d."
(org-last
(org-export-get-headline-number headline info))))
(bullet (concat number (make-string (- 4 (length number)) ?\s)))
(bullet
(if (not (org-export-numbered-headline-p headline info)) "- "
(let ((prefix
(format "%d." (org-last (org-export-get-headline-number
headline info)))))
(concat prefix (make-string (max 1 (- 4 (length prefix)))
?\s)))))
(title
(format "[%s](#%s)"
(org-export-data-with-backend
@ -589,12 +593,10 @@ contents according to the current headline."
(org-export-get-reference headline info))))
(tags (and (plist-get info :with-tags)
(not (eq 'not-in-toc (plist-get info :with-tags)))
(let ((tags (org-export-get-tags headline info)))
(and tags
(format ":%s:"
(mapconcat #'identity tags ":")))))))
(org-make-tag-string
(org-export-get-tags headline info)))))
(concat indentation bullet title tags)))
(org-export-collect-headlines info n (and local keyword)) "\n")
(org-export-collect-headlines info n scope) "\n")
"\n"))
(defun org-md--footnote-formatted (footnote info)

68
lisp/org/ox-odt.el
View file

@ -27,8 +27,9 @@
(require 'cl-lib)
(require 'format-spec)
(require 'ox)
(require 'org-compat)
(require 'org-macs)
(require 'ox)
(require 'table nil 'noerror)
;;; Define Back-End
@ -147,8 +148,7 @@
Use this to infer values of `org-odt-styles-dir' and
`org-odt-schema-dir'.")
(defvar org-odt-data-dir
(expand-file-name "../../etc/" org-odt-lib-dir)
(defvar org-odt-data-dir (expand-file-name "../../etc/" org-odt-lib-dir)
"Data directory for ODT exporter.
Use this to infer values of `org-odt-styles-dir' and
`org-odt-schema-dir'.")
@ -161,25 +161,17 @@ Use this to infer values of `org-odt-styles-dir' and
"Regular expressions for special string conversion.")
(defconst org-odt-schema-dir-list
(list
(and org-odt-data-dir
(expand-file-name "./schema/" org-odt-data-dir)) ; bail out
(eval-when-compile
(and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
(expand-file-name "./schema/" org-odt-data-dir))))
(list (expand-file-name "./schema/" org-odt-data-dir))
"List of directories to search for OpenDocument schema files.
Use this list to set the default value of
`org-odt-schema-dir'. The entries in this list are
populated heuristically based on the values of `org-odt-lib-dir'
and `org-odt-data-dir'.")
Use this list to set the default value of `org-odt-schema-dir'.
The entries in this list are populated heuristically based on the
values of `org-odt-lib-dir' and `org-odt-data-dir'.")
(defconst org-odt-styles-dir-list
(list
(and org-odt-data-dir
(expand-file-name "./styles/" org-odt-data-dir)) ; bail out
(eval-when-compile
(and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
(expand-file-name "./styles/" org-odt-data-dir)))
(expand-file-name "./styles/" org-odt-data-dir)
(expand-file-name "../etc/styles/" org-odt-lib-dir) ; git
(expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa
(expand-file-name "./org/" data-directory) ; system
@ -822,7 +814,7 @@ form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS).
TABLE-STYLE-NAME is the style associated with the table through
\"#+ATTR_ODT: :style TABLE-STYLE-NAME\" line.
TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic
TABLE-TEMPLATE-NAME is a set of - up to 9 - automatic
TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined
below) that is included in `org-odt-content-template-file'.
@ -1357,17 +1349,18 @@ original parsed data. INFO is a plist holding export options."
;; Update styles file.
;; Copy styles.xml. Also dump htmlfontify styles, if there is any.
;; Write styles file.
(let* ((styles-file (plist-get info :odt-styles-file))
(styles-file (and (org-string-nw-p styles-file)
(read (org-trim styles-file))))
;; Non-availability of styles.xml is not a critical
;; error. For now, throw an error.
(styles-file (or styles-file
(plist-get info :odt-styles-file)
(expand-file-name "OrgOdtStyles.xml"
org-odt-styles-dir)
(error "org-odt: Missing styles file?"))))
(let* ((styles-file
(pcase (plist-get info :odt-styles-file)
(`nil (expand-file-name "OrgOdtStyles.xml" org-odt-styles-dir))
((and s (pred (string-match-p "\\`(.*)\\'")))
(condition-case nil
(read s)
(error (user-error "Invalid styles file specification: %S" s))))
(filename (org-strip-quotes filename)))))
(cond
;; Non-availability of styles.xml is not a critical error. For
;; now, throw an error.
((null styles-file) (error "Missing styles file"))
((listp styles-file)
(let ((archive (nth 0 styles-file))
(members (nth 1 styles-file)))
@ -1377,7 +1370,7 @@ original parsed data. INFO is a plist holding export options."
(let* ((image-type (file-name-extension member))
(media-type (format "image/%s" image-type)))
(org-odt-create-manifest-file-entry media-type member))))))
((and (stringp styles-file) (file-exists-p styles-file))
((file-exists-p styles-file)
(let ((styles-file-type (file-name-extension styles-file)))
(cond
((string= styles-file-type "xml")
@ -1421,7 +1414,7 @@ original parsed data. INFO is a plist holding export options."
;; the resulting odt file.
(setq-local backup-inhibited t)
;; Outline numbering is retained only upto LEVEL.
;; Outline numbering is retained only up to LEVEL.
;; To disable outline numbering pass a LEVEL of 0.
(goto-char (point-min))
@ -1967,10 +1960,12 @@ contextual information."
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((plain-list (org-export-get-parent item))
(count (org-element-property :counter item))
(type (org-element-property :type plain-list)))
(unless (memq type '(ordered unordered descriptive-1 descriptive-2))
(error "Unknown list type: %S" type))
(format "\n<text:list-item>\n%s\n%s"
(format "\n<text:list-item%s>\n%s\n%s"
(if count (format " text:start-value=\"%s\"" count) "")
contents
(if (org-element-map item 'table #'identity info 'first-match)
"</text:list-header>"
@ -1996,8 +1991,13 @@ information."
(let ((depth (or (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value)))
(plist-get info :headline-levels)))
(localp (string-match-p "\\<local\\>" value)))
(org-odt-toc depth info (and localp keyword))))
(scope
(cond
((string-match ":target +\\(\".+?\"\\|\\S-+\\)" value) ;link
(org-export-resolve-link
(org-strip-quotes (match-string 1 value)) info))
((string-match-p "\\<local\\>" value) keyword)))) ;local
(org-odt-toc depth info scope)))
((string-match-p "tables\\|figures\\|listings" value)
;; FIXME
(ignore))))))))
@ -3144,7 +3144,7 @@ and prefix with \"OrgSrc\". For example,
(code-info (org-export-unravel-code element))
(code (car code-info))
(refs (cdr code-info))
;; Does the src block contain labels?
;; Does the source block contain labels?
(retain-labels (org-element-property :retain-labels element))
;; Does it have line numbers?
(num-start (org-export-get-loc element info)))
@ -3241,7 +3241,7 @@ styles congruent with the ODF-1.2 specification."
(when style-spec
;; LibreOffice - particularly the Writer - honors neither table
;; templates nor custom table-cell styles. Inorder to retain
;; inter-operability with LibreOffice, only automatic styles are
;; interoperability with LibreOffice, only automatic styles are
;; used for styling of table-cells. The current implementation is
;; congruent with ODF-1.2 specification and hence is
;; future-compatible.

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

@ -96,7 +96,7 @@ setting of `org-html-htmlize-output-type' is `css'."
(table-cell . org-org-identity)
(table-row . org-org-identity)
(target . org-org-identity)
(timestamp . org-org-identity)
(timestamp . org-org-timestamp)
(underline . org-org-identity)
(verbatim . org-org-identity)
(verse-block . org-org-identity))
@ -206,6 +206,10 @@ as a communication channel."
(format "#+CREATOR: %s\n" (plist-get info :creator)))
contents))
(defun org-org-timestamp (timestamp _contents _info)
"Transcode a TIMESTAMP object to custom format or back into Org syntax."
(org-timestamp-translate timestamp))
(defun org-org-section (section contents info)
"Transcode SECTION element back into Org syntax.
CONTENTS is the contents of the section. INFO is a plist used as
@ -270,7 +274,7 @@ non-nil."
;;;###autoload
(defun org-org-export-to-org
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to an org file.
"Export current buffer to an Org file.
If narrowing is active in the current buffer, only export its
narrowed part.
@ -303,7 +307,7 @@ Return output file name."
;;;###autoload
(defun org-org-publish-to-org (plist filename pub-dir)
"Publish an org file to org.
"Publish an Org file to Org.
FILENAME is the filename of the Org file to be published. PLIST
is the property list for the given project. PUB-DIR is the
@ -324,8 +328,7 @@ Return output file name."
newbuf)
(with-current-buffer work-buffer
(org-font-lock-ensure)
(outline-show-all)
(org-show-block-all)
(org-show-all)
(setq newbuf (htmlize-buffer)))
(with-current-buffer newbuf
(when org-org-htmlized-css-url

91
lisp/org/ox-publish.el
View file

@ -867,8 +867,7 @@ PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'."
(org-no-properties
(org-element-interpret-data parsed-title))
(file-name-nondirectory (file-name-sans-extension file)))))
(org-publish-cache-set-file-property file :title title)
title))))
(org-publish-cache-set-file-property file :title title)))))
(defun org-publish-find-date (file project)
"Find the date of FILE in PROJECT.
@ -877,20 +876,23 @@ If FILE is an Org file and provides a DATE keyword use it. In
any other case use the file system's modification time. Return
time in `current-time' format."
(let ((file (org-publish--expand-file-name file project)))
(if (file-directory-p file) (file-attribute-modification-time
(file-attributes file))
(let ((date (org-publish-find-property file :date project)))
;; DATE is a secondary string. If it contains a time-stamp,
;; convert it to internal format. Otherwise, use FILE
;; modification time.
(cond ((let ((ts (and (consp date) (assq 'timestamp date))))
(and ts
(let ((value (org-element-interpret-data ts)))
(and (org-string-nw-p value)
(org-time-string-to-time value))))))
((file-exists-p file) (file-attribute-modification-time
(file-attributes file)))
(t (error "No such file: \"%s\"" file)))))))
(or (org-publish-cache-get-file-property file :date nil t)
(org-publish-cache-set-file-property
file :date
(if (file-directory-p file)
(file-attribute-modification-time (file-attributes file))
(let ((date (org-publish-find-property file :date project)))
;; DATE is a secondary string. If it contains
;; a time-stamp, convert it to internal format.
;; Otherwise, use FILE modification time.
(cond ((let ((ts (and (consp date) (assq 'timestamp date))))
(and ts
(let ((value (org-element-interpret-data ts)))
(and (org-string-nw-p value)
(org-time-string-to-time value))))))
((file-exists-p file)
(file-attribute-modification-time (file-attributes file)))
(t (error "No such file: \"%s\"" file)))))))))
(defun org-publish-sitemap-default-entry (entry style project)
"Default format for site map ENTRY, as a string.
@ -1145,7 +1147,7 @@ This function is meant to be used as a final output filter. See
;; Return output unchanged.
output)
(defun org-publish-resolve-external-link (search file)
(defun org-publish-resolve-external-link (search file &optional prefer-custom)
"Return reference for element matching string SEARCH in FILE.
Return value is an internal reference, as a string.
@ -1153,23 +1155,39 @@ Return value is an internal reference, as a string.
This function allows resolving external links with a search
option, e.g.,
[[file.org::*heading][description]]
[[file.org::#custom-id][description]]
[[file.org::fuzzy][description]]
[[file:file.org::*heading][description]]
[[file:file.org::#custom-id][description]]
[[file:file.org::fuzzy][description]]
When PREFER-CUSTOM is non-nil, and SEARCH targets a headline in
FILE, return its custom ID, if any.
It only makes sense to use this if export back-end builds
references with `org-export-get-reference'."
(if (not org-publish-cache)
(progn
(message "Reference %S in file %S cannot be resolved without publishing"
search
file)
"MissingReference")
(cond
((and prefer-custom
(if (string-prefix-p "#" search)
(substring search 1)
(with-current-buffer (find-file-noselect file)
(org-with-point-at 1
(let ((org-link-search-must-match-exact-headline t))
(condition-case err
(org-link-search search nil t)
(error
(signal 'org-link-broken (cdr err)))))
(and (org-at-heading-p)
(org-string-nw-p (org-entry-get (point) "CUSTOM_ID"))))))))
((not org-publish-cache)
(progn
(message "Reference %S in file %S cannot be resolved without publishing"
search
file)
"MissingReference"))
(t
(let* ((filename (file-truename file))
(crossrefs
(org-publish-cache-get-file-property filename :crossrefs nil t))
(cells
(org-export-string-to-search-cell (org-link-unescape search))))
(cells (org-export-string-to-search-cell search)))
(or
;; Look for reference associated to search cells triggered by
;; LINK. It can match when targeted file has been published
@ -1182,7 +1200,7 @@ references with `org-export-get-reference'."
(let ((new (org-export-new-reference crossrefs)))
(dolist (cell cells) (push (cons cell new) crossrefs))
(org-publish-cache-set-file-property filename :crossrefs crossrefs)
(org-export-format-reference new))))))
(org-export-format-reference new)))))))
(defun org-publish-file-relative-name (filename info)
"Convert FILENAME to be relative to current project's base directory.
@ -1283,8 +1301,8 @@ the file including them will be republished as well."
(let* ((value (org-element-property :value element))
(filename
(and (string-match "\\`\\(\".+?\"\\|\\S-+\\)" value)
(let ((m (org-unbracket-string
"\"" "\"" (match-string 1 value))))
(let ((m (org-strip-quotes
(match-string 1 value))))
;; Ignore search suffix.
(if (string-match "::.*?\\'" m)
(substring m 0 (match-beginning 0))
@ -1296,8 +1314,9 @@ the file including them will be republished as well."
(unless visiting (kill-buffer buf)))))
(or (null pstamp)
(let ((ctime (org-publish-cache-ctime-of-src filename)))
(or (< pstamp ctime)
(cl-some (lambda (ct) (< ctime ct)) included-files-ctime))))))
(or (time-less-p pstamp ctime)
(cl-some (lambda (ct) (time-less-p ctime ct))
included-files-ctime))))))
(defun org-publish-cache-set-file-property
(filename property value &optional project-name)
@ -1305,7 +1324,7 @@ the file including them will be republished as well."
Use cache file of PROJECT-NAME. If the entry does not exist, it
will be created. Return VALUE."
;; Evtl. load the requested cache file:
(if project-name (org-publish-initialize-cache project-name))
(when project-name (org-publish-initialize-cache project-name))
(let ((pl (org-publish-cache-get filename)))
(if pl (progn (plist-put pl property value) value)
(org-publish-cache-get-file-property
@ -1347,8 +1366,8 @@ does not exist."
(let ((attr (file-attributes
(expand-file-name (or (file-symlink-p file) file)
(file-name-directory file)))))
(if (not attr) (error "No such file: \"%s\"" file)
(time-convert (file-attribute-modification-time attr) 'integer))))
(if attr (file-attribute-modification-time attr)
(error "No such file: %S" file))))
(provide 'ox-publish)

282
lisp/org/ox-texinfo.el
View file

@ -147,10 +147,12 @@ If nil it will default to `buffer-file-coding-system'."
(defcustom org-texinfo-classes
'(("info"
"@documentencoding AUTO\n@documentlanguage AUTO"
("@chapter %s" "@unnumbered %s" "@appendix %s")
("@section %s" "@unnumberedsec %s" "@appendixsec %s")
("@subsection %s" "@unnumberedsubsec %s" "@appendixsubsec %s")
("@subsubsection %s" "@unnumberedsubsubsec %s" "@appendixsubsubsec %s")))
("@chapter %s" "@unnumbered %s" "@chapheading %s" "@appendix %s")
("@section %s" "@unnumberedsec %s" "@heading %s" "@appendixsec %s")
("@subsection %s" "@unnumberedsubsec %s" "@subheading %s"
"@appendixsubsec %s")
("@subsubsection %s" "@unnumberedsubsubsec %s" "@subsubheading %s"
"@appendixsubsubsec %s")))
"Alist of Texinfo classes and associated header and structure.
If #+TEXINFO_CLASS is set in the buffer, use its value and the
associated information. Here is the structure of a class
@ -158,8 +160,8 @@ definition:
(class-name
header-string
(numbered-1 unnumbered-1 appendix-1)
(numbered-2 unnumbered-2 appendix-2)
(numbered-1 unnumbered-1 unnumbered-no-toc-1 appendix-1)
(numbered-2 unnumbered-2 unnumbered-no-toc-2 appendix-2)
...)
@ -193,17 +195,18 @@ following the header string. For each sectioning level, a number
of strings is specified. A %s formatter is mandatory in each
section string and will be replaced by the title of the section."
:group 'org-export-texinfo
:version "26.1"
:package-version '(Org . "9.1")
:version "27.1"
:package-version '(Org . "9.2")
:type '(repeat
(list (string :tag "Texinfo class")
(string :tag "Texinfo header")
(repeat :tag "Levels" :inline t
(choice
(list :tag "Heading"
(string :tag " numbered")
(string :tag "unnumbered")
(string :tag " appendix")))))))
(string :tag " numbered")
(string :tag " unnumbered")
(string :tag "unnumbered-no-toc")
(string :tag " appendix")))))))
;;;; Headline
@ -264,7 +267,7 @@ be placed after the end of the title."
:group 'org-export-texinfo
:type 'boolean)
(defcustom org-texinfo-table-scientific-notation "%s\\,(%s)"
(defcustom org-texinfo-table-scientific-notation nil
"Format string to display numbers in scientific notation.
The format should have \"%s\" twice, for mantissa and exponent
@ -463,22 +466,40 @@ INFO is a plist used as a communication channel. See
(defun org-texinfo--get-node (datum info)
"Return node or anchor associated to DATUM.
DATUM is an element or object. INFO is a plist used as
a communication channel. The function guarantees the node or
anchor name is unique."
DATUM is a headline, a radio-target or a target. INFO is a plist
used as a communication channel. The function guarantees the
node or anchor name is unique."
(let ((cache (plist-get info :texinfo-node-cache)))
(or (cdr (assq datum cache))
(let* ((salt 0)
(basename
(org-texinfo--sanitize-node
(if (eq (org-element-type datum) 'headline)
(org-texinfo--sanitize-title
(org-export-get-alt-title datum info) info)
(org-export-get-reference datum info))))
(pcase (org-element-type datum)
(`headline
(org-texinfo--sanitize-title
(org-export-get-alt-title datum info) info))
(`radio-target
(org-export-data (org-element-contents datum) info))
(`target
(org-element-property :value datum))
(_
(or (org-element-property :name datum)
(org-export-get-reference datum info))))))
(name basename))
;; Org exports deeper elements before their parents. If two
;; node names collide -- e.g., they have the same title --
;; within the same hierarchy, the second one would get the
;; shorter node name. This is counter-intuitive.
;; Consequently, we ensure that every parent headline get
;; its node beforehand. As a recursive operation, this
;; achieves the desired effect.
(let ((parent (org-element-lineage datum '(headline))))
(when (and parent (not (assq parent cache)))
(org-texinfo--get-node parent info)
(setq cache (plist-get info :texinfo-node-cache))))
;; Ensure NAME is unique and not reserved node name "Top".
(while (or (equal name "Top") (rassoc name cache))
(setq name (concat basename (format " %d" (cl-incf salt)))))
(setq name (concat basename (format " (%d)" (cl-incf salt)))))
(plist-put info :texinfo-node-cache (cons (cons datum name) cache))
name))))
@ -500,18 +521,7 @@ periods, commas and colons."
TITLE is a string or a secondary string. INFO is the current
export state, as a plist."
(org-export-data-with-backend
title
(org-export-create-backend
:parent 'texinfo
:transcoders '((footnote-reference . ignore)
(link . (lambda (l c i)
(or c
(org-export-data
(org-element-property :raw-link l)
i))))
(radio-target . (lambda (_r c _i) c))
(target . ignore)))
info))
title (org-export-toc-entry-backend 'texinfo) info))
(defun org-texinfo--sanitize-content (text)
"Escape special characters in string TEXT.
@ -526,29 +536,13 @@ float, as a string. CAPTION and SHORT are, respectively, the
caption and shortcaption used for the float, as secondary
strings (e.g., returned by `org-export-get-caption')."
(let* ((backend
(org-export-create-backend
:parent 'texinfo
:transcoders '((link . (lambda (l c i)
(or c
(org-export-data
(org-element-property :raw-link l)
i))))
(radio-target . (lambda (_r c _i) c))
(target . ignore))))
(org-export-toc-entry-backend 'texinfo
(cons 'footnote-reference
(lambda (f c i) (org-export-with-backend 'texinfo f c i)))))
(short-backend
(org-export-create-backend
:parent 'texinfo
:transcoders
'((footnote-reference . ignore)
(inline-src-block . ignore)
(link . (lambda (l c i)
(or c
(org-export-data
(org-element-property :raw-link l)
i))))
(radio-target . (lambda (_r c _i) c))
(target . ignore)
(verbatim . ignore))))
(org-export-toc-entry-backend 'texinfo
'(inline-src-block . ignore)
'(verbatim . ignore)))
(short-str
(if (and short caption)
(format "@shortcaption{%s}\n"
@ -582,7 +576,7 @@ holding export options."
(concat
"\\input texinfo @c -*- texinfo -*-\n"
"@c %**start of header\n"
(let ((file (or (plist-get info :texinfo-filename)
(let ((file (or (org-strip-quotes (plist-get info :texinfo-filename))
(let ((f (plist-get info :output-file)))
(and f (concat (file-name-sans-extension f) ".info"))))))
(and file (format "@setfilename %s\n" file)))
@ -712,7 +706,7 @@ contextual information."
"Transcode a CENTER-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist used
as a communication channel."
contents)
(replace-regexp-in-string "\\(^\\).*?\\S-" "@center " contents nil nil 1))
;;;; Clock
@ -831,7 +825,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-texinfo-fixed-width (fixed-width _contents _info)
"Transcode a FIXED-WIDTH element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
(format "@example\n%s@end example"
(format "@example\n%s\n@end example"
(org-remove-indentation
(org-texinfo--sanitize-content
(org-element-property :value fixed-width)))))
@ -849,84 +843,81 @@ plist holding contextual information."
;;;; Headline
(defun org-texinfo--structuring-command (headline info)
"Return Texinfo structuring command string for HEADLINE element.
Return nil if HEADLINE is to be ignored, `plain-list' if it
should be exported as a plain-list item. INFO is a plist holding
contextual information."
(cond
((org-element-property :footnote-section-p headline) nil)
((org-not-nil (org-export-get-node-property :COPYING headline t)) nil)
((org-export-low-level-p headline info) 'plain-list)
(t
(let ((class (plist-get info :texinfo-class)))
(pcase (assoc class (plist-get info :texinfo-classes))
(`(,_ ,_ . ,sections)
(pcase (nth (1- (org-export-get-relative-level headline info))
sections)
(`(,numbered ,unnumbered ,appendix)
(cond
((org-not-nil (org-export-get-node-property :APPENDIX headline t))
appendix)
((org-not-nil (org-export-get-node-property :INDEX headline t))
unnumbered)
((org-export-numbered-headline-p headline info) numbered)
(t unnumbered)))
(`nil 'plain-list)
(_ (user-error "Invalid Texinfo class specification: %S" class))))
(_ (user-error "Invalid Texinfo class specification: %S" class)))))))
(defun org-texinfo-headline (headline contents info)
"Transcode a HEADLINE element from Org to Texinfo.
CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
(let ((section-fmt (org-texinfo--structuring-command headline info)))
(when section-fmt
(let* ((todo
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword headline)))
(and todo (org-export-data todo info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(tags (and (plist-get info :with-tags)
(org-export-get-tags headline info)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority headline)))
(text (org-texinfo--sanitize-title
(org-element-property :title headline) info))
(full-text
(funcall (plist-get info :texinfo-format-headline-function)
todo todo-type priority text tags))
(contents
(concat "\n"
(if (org-string-nw-p contents)
(concat "\n" contents)
"")
(let ((index (org-element-property :INDEX headline)))
(and (member index '("cp" "fn" "ky" "pg" "tp" "vr"))
(format "\n@printindex %s\n" index))))))
(cond
((eq section-fmt 'plain-list)
(let ((numbered? (org-export-numbered-headline-p headline info)))
(concat (and (org-export-first-sibling-p headline info)
(format "@%s\n" (if numbered? 'enumerate 'itemize)))
"@item\n" full-text "\n"
contents
(if (org-export-last-sibling-p headline info)
(format "@end %s" (if numbered? 'enumerate 'itemize))
"\n"))))
(t
(concat (format "@node %s\n" (org-texinfo--get-node headline info))
(format section-fmt full-text)
contents)))))))
(cond
((org-element-property :footnote-section-p headline) nil)
((org-not-nil (org-export-get-node-property :COPYING headline t)) nil)
(t
(let* ((index (let ((i (org-export-get-node-property :INDEX headline t)))
(and (member i '("cp" "fn" "ky" "pg" "tp" "vr")) i)))
(numbered? (org-export-numbered-headline-p headline info))
(notoc? (org-export-excluded-from-toc-p headline info))
(command
(and
(not (org-export-low-level-p headline info))
(let ((class (plist-get info :texinfo-class)))
(pcase (assoc class (plist-get info :texinfo-classes))
(`(,_ ,_ . ,sections)
(pcase (nth (1- (org-export-get-relative-level headline info))
sections)
(`(,numbered ,unnumbered ,unnumbered-no-toc ,appendix)
(cond
((org-not-nil
(org-export-get-node-property :APPENDIX headline t))
appendix)
(numbered? numbered)
(index unnumbered)
(notoc? unnumbered-no-toc)
(t unnumbered)))
(`nil nil)
(_ (user-error "Invalid Texinfo class specification: %S"
class))))
(_ (user-error "Unknown Texinfo class: %S" class))))))
(todo
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword headline)))
(and todo (org-export-data todo info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(tags (and (plist-get info :with-tags)
(org-export-get-tags headline info)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority headline)))
(text (org-texinfo--sanitize-title
(org-element-property :title headline) info))
(full-text
(funcall (plist-get info :texinfo-format-headline-function)
todo todo-type priority text tags))
(contents
(concat "\n"
(if (org-string-nw-p contents) (concat "\n" contents) "")
(and index (format "\n@printindex %s\n" index)))))
(if (not command)
(concat (and (org-export-first-sibling-p headline info)
(format "@%s\n" (if numbered? 'enumerate 'itemize)))
"@item\n" full-text "\n"
contents
(if (org-export-last-sibling-p headline info)
(format "@end %s" (if numbered? 'enumerate 'itemize))
"\n"))
(concat
;; Even if HEADLINE is using @subheading and al., leave an
;; anchor so cross-references in the Org document still work.
(format (if notoc? "@anchor{%s}\n" "@node %s\n")
(org-texinfo--get-node headline info))
(format command full-text)
contents))))))
(defun org-texinfo-format-headline-default-function
(todo _todo-type priority text tags)
"Default format function for a headline.
See `org-texinfo-format-headline-function' for details."
(concat (when todo (format "@strong{%s} " todo))
(when priority (format "@emph{#%s} " priority))
(concat (and todo (format "@strong{%s} " todo))
(and priority (format "@emph{#%s} " priority))
text
(when tags (format " :%s:" (mapconcat 'identity tags ":")))))
(and tags (concat " " (org-make-tag-string tags)))))
;;;; Inline Src Block
@ -964,7 +955,7 @@ See `org-texinfo-format-inlinetask-function' for details."
(concat (when todo (format "@strong{%s} " todo))
(when priority (format "#%c " priority))
title
(when tags (format ":%s:" (mapconcat #'identity tags ":"))))))
(when tags (org-make-tag-string tags)))))
(format "@center %s\n\n%s\n" full-title contents)))
;;;; Italic
@ -1262,13 +1253,23 @@ contextual information."
(if (string-prefix-p "@" i) i (concat "@" i))))
(table-type (plist-get attr :table-type))
(type (org-element-property :type plain-list))
(enum
(cond ((not (eq type 'ordered)) nil)
((plist-member attr :enum) (plist-get attr :enum))
(t
;; Texinfo only supports initial counters, i.e., it
;; cannot change the numbering mid-list.
(let ((first-item (car (org-element-contents plain-list))))
(org-element-property :counter first-item)))))
(list-type (cond
((eq type 'ordered) "enumerate")
((eq type 'unordered) "itemize")
((member table-type '("ftable" "vtable")) table-type)
(t "table"))))
(format "@%s\n%s@end %s"
(if (eq type 'descriptive) (concat list-type " " indic) list-type)
(cond ((eq type 'descriptive) (concat list-type " " indic))
(enum (format "%s %s" list-type enum))
(t list-type))
contents
list-type)))
@ -1298,8 +1299,13 @@ contextual information."
(when (plist-get info :preserve-breaks)
(setq output (replace-regexp-in-string
"\\(\\\\\\\\\\)?[ \t]*\n" " @*\n" output)))
;; Return value.
output))
;; Reverse sentence ending. A sentence can end with a capital
;; letter. Use non-breaking space if it shouldn't.
(let ((case-fold-search nil))
(replace-regexp-in-string
"[A-Z]\\([.?!]\\)\\(?:[])]\\|'\\{1,2\\}\\)?\\(?: \\|$\\)"
"@\\1"
output nil nil 1))))
;;;; Planning
@ -1349,11 +1355,12 @@ holding contextual information."
"Transcode a QUOTE-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let* ((title (org-element-property :name quote-block))
(start-quote (concat "@quotation"
(if title
(format " %s" title)))))
(format "%s\n%s@end quotation" start-quote contents)))
(let ((tag (org-export-read-attribute :attr_texinfo quote-block :tag))
(author (org-export-read-attribute :attr_texinfo quote-block :author)))
(format "@quotation%s\n%s%s\n@end quotation"
(if tag (concat " " tag) "")
contents
(if author (concat "\n@author " author) ""))))
;;;; Radio Target
@ -1372,9 +1379,12 @@ contextual information."
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
(let ((parent (org-export-get-parent-headline section)))
(when parent ;ignore very first section
(when parent ;first section is handled in `org-texinfo-template'
(org-trim
(concat contents "\n" (org-texinfo-make-menu parent info))))))
(concat contents
"\n"
(and (not (org-export-excluded-from-toc-p parent info))
(org-texinfo-make-menu parent info)))))))
;;;; Special Block

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