Release Org 9.4

-----BEGIN PGP SIGNATURE-----
 
 iQEzBAABCgAdFiEEG+FaXQip1ZWVgUdrFDesAvc/kaIFAl9fdTEACgkQFDesAvc/
 kaJd9ggAvgnPJx4+HP+KBW43yRD1Uk0yOwivBE+5IdXNGvBglcbhuUCgIc2UWG1n
 KAI4QSV6CCHdfEK0fZmR7AtW/luBAPeUN4VpcyLO5fTaedMFWUr/j83uiQxZCTk9
 nkv3u8XgZ4dRAt+BJArZyMSjMafmcIv9NFJ0/lfMct5WcR6GLChMzLc3++dHD/CH
 9seJhWYdwU8U/rAq9Qh/o6Yo8Vhsn0TDQ8ZDY+zl4WQK/lygxielYTWHywUftEs/
 9CTwA3kTI9vDFp/znM4h580bEGxK7qfhgGmD9+nvK3btESvyMkVXey6jtyvN5A0M
 Jdd0XHTVoD1D/OGVN7QQiomdZc+BUA==
 =BPk7
 -----END PGP SIGNATURE-----

Merge tag 'release_9.4' into emacs-sync
This commit is contained in:
Kyle Meyer 2020-11-28 01:58:06 -05:00
commit d77f08be8a
169 changed files with 9840 additions and 6698 deletions

86
CONTRIBUTE Normal file
View File

@ -0,0 +1,86 @@
-*- mode: org; fill-column:70 -*-
The text below explains the rules for participating in Org mode
development.
* Main contribution rules
1. The master git repository is hosted publicly at [[https://orgmode.org][orgmode.org]].
Anyone can get a clone of the current repository state using the
command
: git clone https://code.orgmode.org/bzg/org-mode.git
Having a clone is sufficient to start hacking and to produce
patches that can easily and consistently be applied to the main
repository.
2. People who are interested in participating to the Org mode
development can do so by sending patches to this address:
: emacs-orgmode@gnu.org
3. An interested developer can also request push access to the central
repository by creating an account on code.orgmode.org and by
sending her/his user info to the maintainer.
After you have been added as a user with push privileges, clone the
repository through ssh using
: git clone git@code.orgmode.org:bzg/org-mode.git
By requesting push access, you acknowledge that you have read and
agreed with the following rules:
- Org mode is part of GNU Emacs. Therefore, we need to be very
conscious about changes moving into the Org mode core. These can
originate only from people who have signed the appropriate papers
with the Free Software Foundation. The files to which this
applies are:
- all *.el files in the lisp directory of the repository
- org.texi, orgcard.tex in the doc directory
- the corresponding ChangeLog files
- Before making any significant changes, please explain and discuss
them on the mailing list [[mailto:emacs-orgmode@gnu.org][emacs-orgmode@gnu.org]].
This does obviously not apply to people who are maintaining their
own contributions to Org mode. Please, just use the new mechanism
to make sure all changes end up in the right place.
We value a nice tone in our discussions: please check and respect
the [[https://www.gnu.org/philosophy/kind-communication.en.html][GNU Kind Communications Guidelines]].
- Org mode no longer uses ChangeLog entries to document changes.
Instead, special commit messages are used, as described in the
`CONTRIBUTE' file in the main Emacs repository.
- Among other things, Org mode is widely appreciated because of its
simplicity, cleanness and consistency. We should try hard to
preserve this and ask everyone to keep this in mind when
proposing changes.
* The contrib/ directory
The git repository contains a =contrib/= directory. This directory is
the playing field for any developer, also people who have not (yet)
signed the papers with the FSF. You are free to add files to this
directory, implementing extensions, new link types etc.
Also non-Lisp extensions like scripts to process Org files in different
ways are welcome in this directory. You should provide documentation
with your extensions, at least in the form of commentary in the file,
better on worg. Please discuss your extensions on
[[mailto:emacs-orgmode@gnu.org][emacs-orgmode@gnu.org]].
After files have been tested in =contrib/= and found to be generally
useful, we may decide to clarify copyright questions and then move the
file into the Org mode core. This means they will be moved up to the
root directory and will also eventually be added to GNU Emacs git
repository. The final decision about this rests with the maintainer.
* Org maintenance
Org maintenance is explained on Worg: see [[https://orgmode.org/worg/org-maintenance.html][org-maintenance]].

57
README
View File

@ -1,47 +1,40 @@
-*- mode: org; fill-column:70 -*-
This is a distribution of Org, a plain text notes and project planning This is a distribution of Org, a plain text notes and project planning
tool for Emacs. tool for Emacs.
The homepage of Org is at: Check the [[https://orgmode.org][homepage of Org]] and the [[https://orgmode.org/org.html#Installation][installations instructions]].
https://orgmode.org
The installations instructions are at: * Contents of this distribution
https://orgmode.org/org.html#Installation
This distribution contains: - README :: This file.
README - COPYING :: The GNU General Public License.
This file.
COPYING - Makefile :: The makefile to compile and install Org. For installation
The GNU General Public License. instructions, see the manual or [[https://orgmode.org/worg/dev/org-build-system.html][the more detailed procedure on Worg]].
- mk/ :: Files needed for building Org.
Makefile - lisp/ :: Directory with all the Emacs Lisp files that make up Org.
The makefile to compile and install Org. For installation
instructions, see the manual or the more detailed procedure
on Worg: https://orgmode.org/worg/dev/org-build-system.html
mk/ - doc/ :: The documentation files. org.texi is the source of the
Files needed for building Org. documentation, org.html and org.pdf are formatted versions of it.
lisp/ - contrib/ :: A directory with third-party additions for Org. Some
Directory with all the Emacs Lisp files that make up Org. really cool stuff is in there.
doc/ - etc/ :: Files needed for the ODT exporter.
The documentation files. org.texi is the source of the
documentation, org.html and org.pdf are formatted versions of it.
contrib/ - testing/ :: Testing suite for Org.
A directory with third-party additions for Org. Some really cool
stuff is in there.
etc/ - request-assign-future.txt :: The form that contributors have to sign
Files needed for the ODT exporter. and get processed with the FSF before contributed changes can be
integrated into the Org core. All files in this distribution except
the contrib/ directory have copyright assigned to the FSF.
testing/ * License
Testing suite for Org.
request-assign-future.txt Org-mode is published under [[https://www.gnu.org/licenses/gpl-3.0.html][the GNU GPLv3 license]] or any later
The form that contributors have to sign and get processed with version, the same as GNU Emacs. See the COPYING file in this
the FSF before contributed changes can be integrated into the Org directory.
core. All files in this distribution except the contrib/ directory
have copyright assigned to the FSF.

View File

@ -1,84 +0,0 @@
-*- mode: org; fill-column:65 -*-
This is the GIT repository for the development of Org mode, an
Emacs mode for organizing your life.
The text below explains the rules for participating in Org mode
development.
* Main rules
1. The master git repository is hosted publicly at orgmode.org.
Anyone can get a clone of the current repository state using
the command
git clone https://code.orgmode.org/bzg/org-mode.git
Having a clone is sufficient to start hacking and to produce
patches that can easily and consistently be applied to the
main repository.
2. People who are interested in participating to the Org mode
development can do so by sending patches to this address:
[[mailto:emacs-orgmode@gnu.org][emacs-orgmode@gnu.org]]
3. An interested developer can also request push access to the
central repository by creating an account on code.orgmode.org
and by sending her/his user info to the maintainer.
After you have been added as a user with push privileges,
clone the repository through ssh using
git clone git@code.orgmode.org:bzg/org-mode.git
By requesting push access, you acknowledge that you have read
and agreed with the following rules:
- Org mode is part of GNU Emacs. Therefore, we need to be
very conscious about changes moving into the Org mode core.
These can originate only from people who have signed the
appropriate papers with the Free Software Foundation. The
files to which this applies are:
- all *.el files in the lisp directory of the repository
- org.texi, orgcard.tex in the doc directory
- the corresponding ChangeLog files
- Before making any significant changes, please explain and
discuss them on the mailing list emacs-orgmode@gnu.org.
This does obviously not apply to people who are maintaining
their own contributions to Org mode. Please, just use the
new mechanism to make sure all changes end up in the right
place.
- Org mode no longer uses ChangeLog entries to document
changes. Instead, special commit messages are used, as
described in the `CONTRIBUTE' file in the main Emacs
repository.
- Among other things, Org mode is widely appreciated because
of its simplicity, cleanness and consistency. We should try
hard to preserve this and ask everyone to keep this in mind
when developing changes.
* The contrib/ directory
The git repository contains a =contrib/= directory. This directory
is the playing field for any developer, also people who have not
(yet) signed the papers with the FSF. You are free to add files
to this directory, implementing extensions, new link types etc.
Also non-Lisp extensions like scripts to process Org files in
different ways are welcome in this directory. You should provide
documentation with your extensions, at least in the form of
commentary in the file, better on worg. Please discuss your
extensions on [[mailto:emacs-orgmode@gnu.org][emacs-orgmode@gnu.org]].
After files have been tested in =contrib/= and found to be
generally useful, we may decide to clarify copyright questions
and then move the file into the Org mode core. This means they
will be moved up to the root directory and will also eventually
be added to GNU Emacs git repository. The final decision about
this rests with the maintainer.

View File

@ -1,55 +0,0 @@
This is the Emacs Org project, an Emacs library for organizing your life.
The homepage of Org is at https://orgmode.org
This distribution contains:
README_git
This file.
README
The README file for the main distribution (zip and tar files).
README_ELPA
The README file for the ELPA packages.
README_contribute
Information about the git repository and how to contribute
to Org-mode development.
README_maintainer
Information for the maintainer.
COPYING
The GNU General Public License.
Makefile
The makefile to compile and install Org. For installation
instructions, see the manual or the more detailed procedure
on Worg: https://orgmode.org/worg/dev/org-build-system.html
mk/
Files needed for building Org.
lisp/
Directory with all the Emacs Lisp files that make up Org.
doc/
The documentation files. org.texi is the source of the
documentation, org.html and org.pdf are formatted versions of it.
etc/
Files needed for the ODT exporter.
contrib/
A directory with third-party additions for Org. Some really cool
stuff is in there.
testing/
Testing suite for Org.
request-assign-future.txt
The form that contributors have to sign and get processed with the
FSF before contributed changes can be integrated into the Org
core. All files in this distribution except the contrib/ directory
have copyright assigned to the FSF.

View File

@ -1,203 +0,0 @@
# -*- mode:org -*-
#+TITLE: Org maintainer tasks
#+STARTUP: noindent
#+OPTIONS: ^:nil
This document describes the tasks the Org-mode maintainer has to do
and how they are performed.
* Git workflow
The git repository has two branches:
- master :: for current development.
- maint :: for bug fixes against latest major or minor release.
Bug fixes always go on =maint= then are merged on =master=.
New features always go on =master=.
* Releasing
** Major release
The release number for main releases look like this: =9.1=
Main releases are made whenever Org is in a state where the feature
set is consistent and we feel that the features that are implemented
is something we want to support in the future.
A major release turns the current state of the master branch into a
release.
When doing a /major release/, make sure all changes from the maint
branch are merged into the the master branch, then merge the master
branch back into maint to synchronize the two.
** Minor release
The release number for minor releases look like this: =9.1.7=
Minor releases are small amends to main releases. Usually they fix
critical bugs discovered in a main release. Minor bugs are usually
not fixed -- they will be addressed in the next main release.
Only the fix to the bug is bundled into a release, without the main
development work going on in the master branch. Since the bug fix
will also be needed in the master branch, usually the fix is made in
maint then merged in master.
** Tagging the release
When doing a major and a minor release, after all necessary merging is
done, tag the _maint_ branch for the release with:
git tag -a release_9.1.7 -m "Adding release tag"
and push tags with
git push --tags
We also encourage you to sign release tags like this:
git tag -s release_9.1.7 -m "Adding release tag"
** Uploading the release files from the orgmode.org server
Log on the orgmode.org server as the emacs user and cd to
~/git/org-mode
From there do
make release
make upload
to create the =.tar.gz= and =.zip= files, the documentation, and to upload
everything at the right place.
* Available Org's builds on the server
There are two cron tasks on the server: one that builds the ELPA
packages and one that builds =org-latest.tar.gz= and =org-latest.zip=.
ELPA packages are built from the *maint* branch. One ELPA package
contains Org's core, another one called "org-plus-contrib" contains
Org and contributed libraries.
=org-latest*= snapshots are built from the *master* branch.
* Synchronization Org and upstream Emacs
Below it is described how Org is kept in sync with the upstream Emacs.
** Backporting changes from upstream Emacs
Sometimes Emacs maintainers make changes to Org files. The process of
propagating the changes back to the Org repository is called
/backporting/ for historical reasons.
To find changes that need to be backported from the Emacs repository,
the following =git= command, courtesy of [[http://permalink.gmane.org/gmane.emacs.devel/215861][Kyle Meyer]], can be used:
#+begin_src shell
git log $rev..origin/emacs-25 -- lisp/org doc/misc/org.texi \
etc/refcards/orgcard.tex etc/ORG-NEWS etc/org \
etc/schema/od-manifest-schema-v1.2-os.rnc \
etc/schema/od-schema-v1.2-os.rnc
#+end_src
here, =$rev= is the last commit from the =emacs-25= branch that was
backported. The should also be done for the =master= branch.
There is also a [[http://git.savannah.gnu.org/cgit/emacs.git/atom/lisp/org/][feed]] to keep track of new changes in the =lisp/org=
folder in the Emacs repository.
** Updating the Org version in upstream Emacs
New releases of Org should be added to the [[https://git.savannah.gnu.org/cgit/emacs.git][Emacs repository]].
Typically, Org can be synchronized by copying over files from the
=emacs-sync= branch of the Org repository to the =master= branch of Emacs
repository. The =emacs-sync= branch has a few extra changes compared
with the =maint= branch. If the Emacs maintainers are planning a new
release of Emacs soon, it is possible that another branch should be
used.
If the new release of Org contains many changes, it may be useful to
use a separate branch before merging, e.g. =scratch/org-mode-merge=.
This branch can then be merged with the =master= branch, when everything
has been tested.
Please see [[http://git.savannah.gnu.org/cgit/emacs.git/tree/CONTRIBUTE][CONTRIBUTE]] in the Emacs repository for guidelines on
contributing to the Emacs repository.
*** Where to files go
The following list shows where files in Org repository are copied to
in the Emacs repository, folder by folder.
**** =org-mode/doc=
- =org.texi= :: Copy to =emacs/doc/misc=. It may be necessary to replace,
~@include org-version.inc~ with ~@set VERSION 9.0.9~ or similar.
- =orgcard.tex= :: Copy to =emacs/etc/refcards=. Make sure that
~\def\orgversionnumber~ and ~\def\versionyear~ are up to date.
**** =org-mode/etc=
- =styles/*= :: Copy to =emacs/etc/org=.
- =schema/*.rnc= :: Copy to =emacs/etc/schema=.
- =schema/schemas.xml= :: Any new entries in this file should be added
to =emacs/etc/schema/schemas.xml=.
- =ORG-NEWS= :: Copy to =emacs/etc=
**** =org-mode/lisp=
- Copy =*.el= files to =emacs/lisp/org=, except =org-loaddefs.el=!
- You should create =org-version.el= in =emacs/lisp/org=. The file is
created when you =make= Org.
**** TODO =org-mode/testing=
*** Update =emacs/etc/NEWS=
Whenever a new (major) version of Org is synchronized to the Emacs
repository, it should be mentioned in the NEWS file.
* Updating the list of hooks/commands/options on Worg
Load the =mk/eldo.el= file then =M-x eldo-make-doc RET=.
This will produce an org file with the documentation.
Import this file into =worg/doc.org=, leaving the header untouched
(except for the release number).
Then commit and push the change on the =worg.git= repository.
* Copyright assignments
The maintainer needs to keep track of copyright assignments. Even
better, find a volunteer to do this.
The assignment form is included in the repository as a file that you
can send to contributors: =request-assign-future.txt=
The list of all contributors from who we have the papers is kept on
Worg at https://orgmode.org/worg/org-contribute.html, so that
committers can check if a patch can go into the core.
The assignment process does not always go smoothly, and it has
happened several times that it gets stuck or forgotten at the FSF.
The contact at the FSF for this is: mailto:copyright-clerk@fsf.org
Emails from the paper submitter have been ignored in the past, but an
email from me (Carsten) as the maintainer of Org mode has usually
fixed such cases within a few days.

View File

@ -21,6 +21,16 @@
"org-mode blocks for PHP." "org-mode blocks for PHP."
:group 'org) :group 'org)
(defcustom org-babel-php-command "php"
"The command to execute babel body code."
:group 'ob-php
:type 'string)
(defcustom org-babel-php-command-options nil
"The php command options to use when execute code."
:group 'ob-php
:type 'string)
(defcustom ob-php:inf-php-buffer "*php*" (defcustom ob-php:inf-php-buffer "*php*"
"Default PHP inferior buffer." "Default PHP inferior buffer."
:group 'ob-php :group 'ob-php
@ -29,10 +39,9 @@
;;;###autoload ;;;###autoload
(defun org-babel-execute:php (body params) (defun org-babel-execute:php (body params)
"Orgmode Babel PHP evaluate function for `BODY' with `PARAMS'." "Orgmode Babel PHP evaluate function for `BODY' with `PARAMS'."
(let* ((cmd "php") (let* ((cmd (concat org-babel-php-command " " org-babel-php-command-options))
(body (concat "<?php\n" body "\n?>"))) (body (concat "<?php\n" body "\n?>")))
(org-babel-eval cmd body) (org-babel-eval cmd body)))
))
;;;###autoload ;;;###autoload
(eval-after-load "org" (eval-after-load "org"

View File

@ -52,7 +52,7 @@ Otherwise prompt the user for the right bookmark to use."
:follow #'org-bookmark-open :follow #'org-bookmark-open
:store #'org-bookmark-store-link) :store #'org-bookmark-store-link)
(defun org-bookmark-open (bookmark) (defun org-bookmark-open (bookmark _)
"Visit the bookmark BOOKMARK." "Visit the bookmark BOOKMARK."
(bookmark-jump bookmark)) (bookmark-jump bookmark))

View File

@ -82,12 +82,8 @@
:follow #'org-elisp-symbol-open :follow #'org-elisp-symbol-open
:store #'org-elisp-symbol-store-link) :store #'org-elisp-symbol-store-link)
(defun org-elisp-symbol-open (path) (defun org-elisp-symbol-open (symbol arg)
"Visit the emacs-lisp elisp-symbol at PATH." (org-link-open-as-file symbol arg))
(let* ((search (when (string-match "::\\(.+\\)\\'" path)
(match-string 1 path)))
(path (substring path 0 (match-beginning 0))))
(org-open-file path t nil search)))
(defun org-elisp-symbol-store-link () (defun org-elisp-symbol-store-link ()
"Store a link to an emacs-lisp elisp-symbol." "Store a link to an emacs-lisp elisp-symbol."

View File

@ -73,7 +73,7 @@
;; bare git link ;; bare git link
(org-link-set-parameters "gitbare" :follow #'org-gitbare-open) (org-link-set-parameters "gitbare" :follow #'org-gitbare-open)
(defun org-gitbare-open (str) (defun org-gitbare-open (str _)
(let* ((strlist (org-git-split-string str)) (let* ((strlist (org-git-split-string str))
(gitdir (nth 0 strlist)) (gitdir (nth 0 strlist))
(object (nth 1 strlist))) (object (nth 1 strlist)))
@ -96,7 +96,7 @@
;; user friendly link ;; user friendly link
(org-link-set-parameters "git" :follow #'org-git-open :store #'org-git-store-link) (org-link-set-parameters "git" :follow #'org-git-open :store #'org-git-store-link)
(defun org-git-open (str) (defun org-git-open (str _)
(let* ((strlist (org-git-split-string str)) (let* ((strlist (org-git-split-string str))
(filepath (nth 0 strlist)) (filepath (nth 0 strlist))
(commit (nth 1 strlist)) (commit (nth 1 strlist))

View File

@ -35,10 +35,19 @@
:group 'org-link :group 'org-link
:type '(choice (const man) (const woman))) :type '(choice (const man) (const woman)))
(defun org-man-open (path) (defun org-man-open (path _)
"Visit the manpage on PATH. "Visit the manpage on PATH.
PATH should be a topic that can be thrown at the man command." PATH should be a topic that can be thrown at the man command.
(funcall org-man-command path)) If PATH contains extra ::STRING which will use `occur' to search
matched strings in man buffer."
(string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path)
(let* ((command (match-string 1 path))
(search (match-string 2 path)))
(funcall org-man-command command)
(when search
(with-current-buffer (concat "*Man " command "*")
(goto-char (point-min))
(search-forward search)))))
(defun org-man-store-link () (defun org-man-store-link ()
"Store a link to a README file." "Store a link to a README file."
@ -68,6 +77,7 @@ PATH should be a topic that can be thrown at the man command."
((eq format 'latex) (format "\\href{%s}{%s}" path desc)) ((eq format 'latex) (format "\\href{%s}{%s}" path desc))
((eq format 'texinfo) (format "@uref{%s,%s}" path desc)) ((eq format 'texinfo) (format "@uref{%s,%s}" path desc))
((eq format 'ascii) (format "%s (%s)" desc path)) ((eq format 'ascii) (format "%s (%s)" desc path))
((eq format 'md) (format "[%s](%s)" desc path))
(t path)))) (t path))))
(provide 'ol-man) (provide 'ol-man)

View File

@ -191,7 +191,7 @@ with \"t\" key."
(let ((folder-or-path (mew-summary-folder-name))) (let ((folder-or-path (mew-summary-folder-name)))
(mew-folder-path-to-folder folder-or-path t)))))) (mew-folder-path-to-folder folder-or-path t))))))
(defun org-mew-open (path) (defun org-mew-open (path _)
"Follow the Mew message link specified by PATH." "Follow the Mew message link specified by PATH."
(let (folder message-id) (let (folder message-id)
(cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's

View File

@ -86,7 +86,7 @@ Should accept a notmuch search string as the sole argument."
(org-link-add-props :link link :description desc) (org-link-add-props :link link :description desc)
link))) link)))
(defun org-notmuch-open (path) (defun org-notmuch-open (path _)
"Follow a notmuch message link specified by PATH." "Follow a notmuch message link specified by PATH."
(funcall org-notmuch-open-function path)) (funcall org-notmuch-open-function path))
@ -113,7 +113,7 @@ Can link to more than one message, if so all matching messages are shown."
:description desc) :description desc)
link))) link)))
(defun org-notmuch-search-open (path) (defun org-notmuch-search-open (path _)
"Follow a notmuch message link specified by PATH." "Follow a notmuch message link specified by PATH."
(message "%s" path) (message "%s" path)
(org-notmuch-search-follow-link path)) (org-notmuch-search-follow-link path))
@ -139,7 +139,7 @@ Can link to more than one message, if so all matching messages are shown."
:description desc) :description desc)
link))) link)))
(defun org-notmuch-tree-open (path) (defun org-notmuch-tree-open (path _)
"Follow a notmuch message link specified by PATH." "Follow a notmuch message link specified by PATH."
(message "%s" path) (message "%s" path)
(org-notmuch-tree-follow-link path)) (org-notmuch-tree-follow-link path))

View File

@ -95,7 +95,7 @@
(org-add-link-props :link link :description desc) (org-add-link-props :link link :description desc)
link)))) link))))
(defun org-vm-open (path) (defun org-vm-open (path _)
"Follow a VM message link specified by PATH." "Follow a VM message link specified by PATH."
(let (folder article) (let (folder article)
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
@ -127,7 +127,7 @@
(when article (when article
(org-vm-select-message (org-link-add-angle-brackets article))))) (org-vm-select-message (org-link-add-angle-brackets article)))))
(defun org-vm-imap-open (path) (defun org-vm-imap-open (path _)
"Follow a VM link to an IMAP folder." "Follow a VM link to an IMAP folder."
(require 'vm-imap) (require 'vm-imap)
(when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path) (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path)

View File

@ -255,7 +255,7 @@ ENTITY is a message entity."
(concat "@" (or (cdr server) (car server)))) (concat "@" (or (cdr server) (car server))))
(if article (concat "#" article) ""))))) (if article (concat "#" article) "")))))
(defun org-wl-open (path) (defun org-wl-open (path &rest _)
"Follow the WL message link specified by PATH. "Follow the WL message link specified by PATH.
When called with one prefix, open message in namazu search folder When called with one prefix, open message in namazu search folder
with `org-wl-namazu-default-index' as search index. When called with `org-wl-namazu-default-index' as search index. When called

View File

@ -210,7 +210,7 @@ This does two different kinds of triggers:
(pos (plist-get change-plist :position)) (pos (plist-get change-plist :position))
(from (plist-get change-plist :from)) (from (plist-get change-plist :from))
(to (plist-get change-plist :to)) (to (plist-get change-plist :to))
(org-log-done nil) ; IMPROTANT!: no logging during automatic trigger! (org-log-done nil) ; IMPORTANT!: no logging during automatic trigger!
trigger triggers tr p1 p2 kwd id) trigger triggers tr p1 p2 kwd id)
(catch 'return (catch 'return
(unless (eq type 'todo-state-change) (unless (eq type 'todo-state-change)
@ -367,7 +367,7 @@ this ID property, that entry is also checked."
(pos (plist-get change-plist :position)) (pos (plist-get change-plist :position))
(from (plist-get change-plist :from)) (from (plist-get change-plist :from))
(to (plist-get change-plist :to)) (to (plist-get change-plist :to))
(org-log-done nil) ; IMPROTANT!: no logging during automatic trigger (org-log-done nil) ; IMPORTANT!: no logging during automatic trigger
blocker blockers bl p1 p2 blocker blockers bl p1 p2
(proceed-p (proceed-p
(catch 'return (catch 'return

View File

@ -1,12 +1,12 @@
;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding: t; -*- ;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2017 Kyle Meyer <kyle@kyleam.com> ;; Copyright (C) 2015-2020 Kyle Meyer <kyle@kyleam.com>
;; Author: Kyle Meyer <kyle@kyleam.com> ;; Author: Kyle Meyer <kyle@kyleam.com>
;; URL: https://gitlab.com/kyleam/org-link-edit ;; URL: https://git.kyleam.com/org-link-edit/about
;; Keywords: convenience ;; Keywords: convenience
;; Version: 1.1.1 ;; Version: 1.2.1
;; Package-Requires: ((cl-lib "0.5") (org "8.2.10")) ;; Package-Requires: ((cl-lib "0.5") (org "9.3"))
;; This program is free software; you can redistribute it and/or modify ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -19,7 +19,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary: ;;; Commentary:
@ -67,12 +67,7 @@
(require 'cl-lib) (require 'cl-lib)
(defun org-link-edit--on-link-p (&optional element) (defun org-link-edit--on-link-p (&optional element)
(let ((el (or element (org-element-context)))) (org-element-lineage (or element (org-element-context)) '(link) t))
;; Don't use `org-element-lineage' because it isn't available
;; until Org version 8.3.
(while (and el (not (memq (car el) '(link))))
(setq el (org-element-property :parent el)))
(eq (car el) 'link)))
(defun org-link-edit--link-data () (defun org-link-edit--link-data ()
"Return list with information about the link at point. "Return list with information about the link at point.
@ -90,13 +85,13 @@ The list includes
;; Use match-{beginning,end} because match-end is consistently ;; Use match-{beginning,end} because match-end is consistently
;; positioned after ]], while the :end property is positioned ;; positioned after ]], while the :end property is positioned
;; at the next word on the line, if one is present. ;; at the next word on the line, if one is present.
((looking-at org-bracket-link-regexp) ((looking-at org-link-bracket-re)
(list (match-beginning 0) (list (match-beginning 0)
(match-end 0) (match-end 0)
(save-match-data (save-match-data
(org-link-unescape (match-string-no-properties 1))) (org-link-unescape (match-string-no-properties 1)))
(or (match-string-no-properties 2) ""))) (or (match-string-no-properties 2) "")))
((looking-at org-plain-link-re) ((looking-at org-link-plain-re)
(list (match-beginning 0) (list (match-beginning 0)
(match-end 0) (match-end 0)
(match-string-no-properties 0) (match-string-no-properties 0)
@ -170,7 +165,7 @@ If N is negative, slurp leading blobs instead of trailing blobs."
(setq desc (concat desc slurped) (setq desc (concat desc slurped)
end (+ end (length slurped))) end (+ end (length slurped)))
(delete-region beg (point)) (delete-region beg (point))
(insert (org-make-link-string link desc)) (insert (org-link-make-string link desc))
(goto-char beg) (goto-char beg)
slurped))))) slurped)))))
@ -212,7 +207,7 @@ If N is negative, slurp trailing blobs instead of leading blobs."
(setq desc (concat slurped desc) (setq desc (concat slurped desc)
beg (- beg (length slurped))) beg (- beg (length slurped)))
(delete-region (point) end) (delete-region (point) end)
(insert (org-make-link-string link desc)) (insert (org-link-make-string link desc))
(goto-char beg) (goto-char beg)
slurped))))) slurped)))))
@ -282,7 +277,7 @@ If N is negative, barf leading blobs instead of trailing blobs."
(unless new-desc (user-error "Not enough blobs in description")) (unless new-desc (user-error "Not enough blobs in description"))
(goto-char beg) (goto-char beg)
(delete-region beg end) (delete-region beg end)
(insert (org-make-link-string link new-desc)) (insert (org-link-make-string link new-desc))
(when (string= new-desc "") (when (string= new-desc "")
(setq barfed (concat " " barfed))) (setq barfed (concat " " barfed)))
(insert barfed) (insert barfed)
@ -321,7 +316,7 @@ If N is negative, barf trailing blobs instead of leading blobs."
(unless new-desc (user-error "Not enough blobs in description")) (unless new-desc (user-error "Not enough blobs in description"))
(goto-char beg) (goto-char beg)
(delete-region beg end) (delete-region beg end)
(insert (org-make-link-string link new-desc)) (insert (org-link-make-string link new-desc))
(when (string= new-desc "") (when (string= new-desc "")
(setq barfed (concat barfed " "))) (setq barfed (concat barfed " ")))
(goto-char beg) (goto-char beg)
@ -331,12 +326,12 @@ If N is negative, barf trailing blobs instead of leading blobs."
(defun org-link-edit--next-link-data (&optional previous) (defun org-link-edit--next-link-data (&optional previous)
(save-excursion (save-excursion
(if (funcall (if previous #'re-search-backward #'re-search-forward) (if (funcall (if previous #'re-search-backward #'re-search-forward)
org-any-link-re nil t) org-link-any-re nil t)
(org-link-edit--link-data) (org-link-edit--link-data)
(user-error "No %s link found" (if previous "previous" "next"))))) (user-error "No %s link found" (if previous "previous" "next")))))
;;;###autoload ;;;###autoload
(defun org-link-edit-transport-next-link (&optional previous beg end) (defun org-link-edit-transport-next-link (&optional previous beg end overwrite)
"Move the next link to point. "Move the next link to point.
If the region is active, use the selected text as the link's If the region is active, use the selected text as the link's
@ -346,11 +341,16 @@ With prefix argument PREVIOUS, move the previous link instead of
the next link. the next link.
Non-interactively, use the text between BEG and END as the Non-interactively, use the text between BEG and END as the
description, moving the next (or previous) link relative BEG and description, moving the next (or previous) link relative to BEG
END." and END. By default, refuse to overwrite an existing
(interactive (cons current-prefix-arg description. If OVERWRITE is `ask', prompt for confirmation
(and (use-region-p) before overwriting; for any other non-nil value, overwrite
(list (region-beginning) (region-end))))) without asking."
(interactive `(,current-prefix-arg
,@(if (use-region-p)
(list (region-beginning) (region-end))
(list nil nil))
ask))
(let ((pt (point)) (let ((pt (point))
(desc-bounds (cond (desc-bounds (cond
((and beg end) ((and beg end)
@ -374,10 +374,14 @@ END."
(goto-char (or (car desc-bounds) pt)) (goto-char (or (car desc-bounds) pt))
(cl-multiple-value-bind (link-beg link-end link orig-desc) (cl-multiple-value-bind (link-beg link-end link orig-desc)
(org-link-edit--next-link-data previous) (org-link-edit--next-link-data previous)
(unless (or (not desc-bounds) (= (length orig-desc) 0)) (unless (or (not desc-bounds)
(= (length orig-desc) 0)
(if (eq overwrite 'ask)
(y-or-n-p "Overwrite existing description?")
overwrite))
(user-error "Link already has a description")) (user-error "Link already has a description"))
(delete-region link-beg link-end) (delete-region link-beg link-end)
(insert (org-make-link-string (insert (org-link-make-string
link link
(if desc-bounds (if desc-bounds
(delete-and-extract-region (car desc-bounds) (delete-and-extract-region (car desc-bounds)

View File

@ -494,7 +494,7 @@ The links are of the form <link>::split::<name>."
;; Handle links from together.app ;; Handle links from together.app
(org-link-set-parameters "x-together-item" :follow #'org-mac-together-item-open) (org-link-set-parameters "x-together-item" :follow #'org-mac-together-item-open)
(defun org-mac-together-item-open (uid) (defun org-mac-together-item-open (uid _)
"Open UID, which is a reference to an item in Together." "Open UID, which is a reference to an item in Together."
(shell-command (concat "open -a Together \"x-together-item:" uid "\""))) (shell-command (concat "open -a Together \"x-together-item:" uid "\"")))
@ -553,7 +553,7 @@ The links are of the form <link>::split::<name>."
;; Handle links from AddressBook.app ;; Handle links from AddressBook.app
(org-link-set-parameters "addressbook" :follow #'org-mac-addressbook-item-open) (org-link-set-parameters "addressbook" :follow #'org-mac-addressbook-item-open)
(defun org-mac-addressbook-item-open (uid) (defun org-mac-addressbook-item-open (uid _)
"Open UID, which is a reference to an item in the addressbook." "Open UID, which is a reference to an item in the addressbook."
(shell-command (concat "open \"addressbook:" uid "\""))) (shell-command (concat "open \"addressbook:" uid "\"")))
@ -588,7 +588,7 @@ The links are of the form <link>::split::<name>."
(org-link-set-parameters "skim" :follow #'org-mac-skim-open) (org-link-set-parameters "skim" :follow #'org-mac-skim-open)
(defun org-mac-skim-open (uri) (defun org-mac-skim-open (uri _)
"Visit page of pdf in Skim" "Visit page of pdf in Skim"
(let* ((page (when (string-match "::\\(.+\\)\\'" uri) (let* ((page (when (string-match "::\\(.+\\)\\'" uri)
(match-string 1 uri))) (match-string 1 uri)))
@ -647,7 +647,7 @@ The links are of the form <link>::split::<name>."
(org-link-set-parameters "acrobat" :follow #'org-mac-acrobat-open) (org-link-set-parameters "acrobat" :follow #'org-mac-acrobat-open)
(defun org-mac-acrobat-open (uri) (defun org-mac-acrobat-open (uri _)
"Visit page of pdf in Acrobat" "Visit page of pdf in Acrobat"
(let* ((page (when (string-match "::\\(.+\\)\\'" uri) (let* ((page (when (string-match "::\\(.+\\)\\'" uri)
(match-string 1 uri))) (match-string 1 uri)))
@ -697,7 +697,7 @@ The links are of the form <link>::split::<name>."
(org-link-set-parameters "mac-outlook" :follow #'org-mac-outlook-message-open) (org-link-set-parameters "mac-outlook" :follow #'org-mac-outlook-message-open)
(defun org-mac-outlook-message-open (msgid) (defun org-mac-outlook-message-open (msgid _)
"Open a message in Outlook" "Open a message in Outlook"
(do-applescript (do-applescript
(concat (concat
@ -809,7 +809,7 @@ after heading."
(org-link-set-parameters "mac-evernote" :follow #'org-mac-evernote-note-open) (org-link-set-parameters "mac-evernote" :follow #'org-mac-evernote-note-open)
(defun org-mac-evernote-note-open (noteid) (defun org-mac-evernote-note-open (noteid _)
"Open a note in Evernote" "Open a note in Evernote"
(do-applescript (do-applescript
(concat (concat
@ -860,7 +860,7 @@ note(s) in Evernote.app and make a link out of it/them."
(org-link-set-parameters "x-devonthink-item" :follow #'org-devonthink-item-open) (org-link-set-parameters "x-devonthink-item" :follow #'org-devonthink-item-open)
(defun org-devonthink-item-open (uid) (defun org-devonthink-item-open (uid _)
"Open UID, which is a reference to an item in DEVONthink Pro Office." "Open UID, which is a reference to an item in DEVONthink Pro Office."
(shell-command (concat "open \"x-devonthink-item:" uid "\""))) (shell-command (concat "open \"x-devonthink-item:" uid "\"")))
@ -908,7 +908,7 @@ selected items in DEVONthink Pro Office and make link(s) out of it/them."
(org-link-set-parameters "message" :follow #'org-mac-message-open) (org-link-set-parameters "message" :follow #'org-mac-message-open)
(defun org-mac-message-open (message-id) (defun org-mac-message-open (message-id _)
"Visit the message with MESSAGE-ID. "Visit the message with MESSAGE-ID.
This will use the command `open' with the message URL." This will use the command `open' with the message URL."
(start-process (concat "open message:" message-id) nil (start-process (concat "open message:" message-id) nil

View File

@ -139,7 +139,7 @@ the buffer just like 'message-send-and-exit' does."
(cons (list link desc) org-stored-links))) (cons (list link desc) org-stored-links)))
(message-bury (current-buffer))) (message-bury (current-buffer)))
(defun org-mairix-open (search) (defun org-mairix-open (search _)
"Function to open mairix link. "Function to open mairix link.
We first need to split it into its individual parts, and then We first need to split it into its individual parts, and then

View File

@ -57,7 +57,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'org-element) (require 'org-element)
(declare-function appt-delete-window "appt" ()) (declare-function appt-delete-window "appt" ())
@ -74,6 +74,11 @@
:type 'boolean :type 'boolean
:group 'org-notify) :group 'org-notify)
(defcustom org-notify-max-notifications-per-run 3
"Maximum number of notifications per run of `org-notify-process'."
:type 'integer
:group 'org-notify)
(defconst org-notify-actions (defconst org-notify-actions
'("show" "show" "done" "done" "hour" "one hour later" "day" "one day later" '("show" "show" "done" "done" "hour" "one hour later" "day" "one day later"
"week" "one week later") "week" "one week later")
@ -155,36 +160,40 @@ PERIOD."
(message "Warning: notification for \"%s\" behind schedule!" heading)) (message "Warning: notification for \"%s\" behind schedule!" heading))
t) t)
(defun org-notify-process () (cl-defun org-notify-process ()
"Process the todo-list, and possibly notify user about upcoming or "Process the todo-list, and possibly notify user about upcoming or
forgotten tasks." forgotten tasks."
(cl-macrolet ((prm (k) `(plist-get prms ,k)) (td (k) `(plist-get todo ,k))) (let ((notification-cnt 0))
(dolist (todo (org-notify-todo-list)) (cl-macrolet ((prm (k) `(plist-get prms ,k)) (td (k) `(plist-get todo ,k)))
(let* ((deadline (td :deadline)) (heading (td :heading)) (dolist (todo (org-notify-todo-list))
(uid (td :uid)) (last-run-sym (let* ((deadline (td :deadline)) (heading (td :heading))
(intern (concat ":last-run-" uid)))) (uid (td :uid)) (last-run-sym
(dolist (prms (plist-get org-notify-map (td :notify))) (intern (concat ":last-run-" uid))))
(when (< deadline (org-notify-string->seconds (prm :time))) (cl-dolist (prms (plist-get org-notify-map (td :notify)))
(let ((period (org-notify-string->seconds (prm :period))) (when (< deadline (org-notify-string->seconds (prm :time)))
(last-run (prm last-run-sym)) (now (float-time)) (let ((period (org-notify-string->seconds (prm :period)))
(actions (prm :actions)) diff plist) (last-run (prm last-run-sym)) (now (float-time))
(when (or (not last-run) (actions (prm :actions)) diff plist)
(and period (< period (setq diff (- now last-run))) (when (or (not last-run)
(org-notify-maybe-too-late diff period heading))) (and period (< period (setq diff (- now last-run)))
(setq prms (plist-put prms last-run-sym now) (org-notify-maybe-too-late diff period heading)))
plist (append todo prms)) (setq prms (plist-put prms last-run-sym now)
(if (if (plist-member prms :audible) plist (append todo prms))
(prm :audible) (if (if (plist-member prms :audible)
org-notify-audible) (prm :audible)
(ding)) org-notify-audible)
(unless (listp actions) (ding))
(setq actions (list actions))) (unless (listp actions)
(dolist (action actions) (setq actions (list actions)))
(funcall (if (fboundp action) action (cl-incf notification-cnt)
(intern (concat "org-notify-action" (dolist (action actions)
(symbol-name action)))) (funcall (if (fboundp action) action
plist)))) (intern (concat "org-notify-action"
(return))))))) (symbol-name action))))
plist))
(when (>= notification-cnt org-notify-max-notifications-per-run)
(cl-return-from org-notify-process)))
(cl-return)))))))))
(defun org-notify-add (name &rest params) (defun org-notify-add (name &rest params)
"Add a new notification type. "Add a new notification type.

View File

@ -154,7 +154,8 @@ to `org-bibtex-citation-p' predicate."
;;; Follow cite: links ;;; Follow cite: links
(defun org-bibtex-file nil "Org-mode file of bibtex entries.") (defvar org-bibtex-file nil
"Org file of BibTeX entries.")
(defun org-bibtex-goto-citation (&optional citation) (defun org-bibtex-goto-citation (&optional citation)
"Visit a citation given its ID." "Visit a citation given its ID."
@ -162,10 +163,8 @@ to `org-bibtex-citation-p' predicate."
(let ((citation (or citation (completing-read "Citation: " (obe-citations))))) (let ((citation (or citation (completing-read "Citation: " (obe-citations)))))
(find-file (or org-bibtex-file (find-file (or org-bibtex-file
(error "`org-bibtex-file' has not been configured"))) (error "`org-bibtex-file' has not been configured")))
(goto-char (point-min)) (let ((position (org-find-property "CUSTOM_ID" citation)))
(when (re-search-forward (format " :CUSTOM_ID: %s" citation) nil t) (and position (progn (goto-char position) t)))))
(outline-previous-visible-heading 1)
t)))
(let ((jump-fn (car (cl-remove-if-not #'fboundp '(ebib org-bibtex-goto-citation))))) (let ((jump-fn (car (cl-remove-if-not #'fboundp '(ebib org-bibtex-goto-citation)))))
(org-add-link-type "cite" jump-fn)) (org-add-link-type "cite" jump-fn))

View File

@ -60,7 +60,10 @@
(template . org-confluence-template) (template . org-confluence-template)
(timestamp . org-confluence-timestamp) (timestamp . org-confluence-timestamp)
(underline . org-confluence-underline) (underline . org-confluence-underline)
(verbatim . org-confluence-verbatim))) (verbatim . org-confluence-verbatim))
:menu-entry
'(?f "Export to Confluence"
((?f "As Confluence buffer" org-confluence-export-as-confluence))))
(defcustom org-confluence-lang-alist (defcustom org-confluence-lang-alist
'(("sh" . "bash")) '(("sh" . "bash"))

View File

@ -1248,7 +1248,7 @@ INFO is a plist holding contextual information. See
((string= type "file") (org-export-file-uri raw-path)) ((string= type "file") (org-export-file-uri raw-path))
(t raw-path)))) (t raw-path))))
(cond (cond
((org-export-custom-protocol-maybe link desc 'groff)) ((org-export-custom-protocol-maybe link desc 'groff info))
;; Image file. ;; Image file.
(imagep (org-groff-link--inline-image link info)) (imagep (org-groff-link--inline-image link info))
;; import groff files ;; import groff files

View File

@ -483,10 +483,6 @@ e.g. \"title-subject:t\"."
(defvar org-koma-letter-special-contents nil (defvar org-koma-letter-special-contents nil
"Holds special content temporarily.") "Holds special content temporarily.")
(make-obsolete-variable 'org-koma-letter-use-title
'org-export-with-title
"25.1" 'set)
;;; Define Back-End ;;; Define Back-End

View File

@ -137,7 +137,7 @@
;; :END: ;; :END:
;; ;;
;;;; * TODO ;;;; * TODO
;; - Look at org-file-properties, org-global-properties and ;; - Look at org-keyword-properties, org-global-properties and
;; org-global-properties-fixed ;; org-global-properties-fixed
;; - What about property inheritance and org-property-inherit-p? ;; - What about property inheritance and org-property-inherit-p?
;; - Use TYPE_TODO as an way to assign resources ;; - Use TYPE_TODO as an way to assign resources

View File

@ -114,8 +114,8 @@ the entire show and hide functionalities into a single command,
:END: :END:
Headlines define the structure of an outline tree. The headlines in Headlines define the structure of an outline tree. The headlines in
Org start with one or more stars, on the left margin[fn:1]. For Org start on the left margin[fn:1] with one or more stars followed by
example: a space. For example:
#+begin_example #+begin_example
,* Top level headline ,* Top level headline

File diff suppressed because it is too large Load Diff

View File

@ -10,6 +10,543 @@ See the end of the file for license conditions.
Please send Org bug reports to mailto:emacs-orgmode@gnu.org. Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
* Version 9.5 (not yet released)
* Version 9.4
** Incompatible changes
*** Possibly broken internal file links: please check and fix
A bug has been affecting internal links to headlines, like
: [[*Headline][A link to a headline]]
Storing a link to a headline may have been broken in your setup and
those links may appear as
: [[*TODO Headline][A link to a headline]]
Following the link above will result in an error: the TODO keyword
should not be part of internal file links.
You can use the following command to fix links in an Org buffer:
#+begin_src emacs-lisp
(defun org-fix-links ()
"Fix ill-formatted internal links.
E.g. replace [[*TODO Headline][headline]] by [[*Headline][headline]].
Go through the buffer and ask for the replacement."
(interactive)
(visible-mode 1)
(save-excursion
(goto-char (point-min))
(let ((regexp (format "\\[\\[\\*%s\\s-+"
(regexp-opt org-todo-keywords-1 t))))
(while (re-search-forward regexp nil t)
(when (and (save-excursion
(goto-char (match-beginning 0))
(looking-at-p org-link-bracket-re))
(y-or-n-p "Fix link (remove TODO keyword)? "))
(replace-match "[[*")))))
(visible-mode -1))
#+end_src
*** Calling conventions changes when opening or exporting custom links
This changes affects export back-ends, and libraries providing new
link types.
Function used in ~:follow~ link parameter is required to accept a
second argument. Likewise, function used in ~:export~ parameter needs
to accept a fourth argument. See ~org-link-set-parameters~ for
details.
Eventually, the function ~org-export-custom-protocol-maybe~ is now
called with a fourth argument. Even though the 3-arguments definition
is still supported, at least for now, we encourage back-end developers
to switch to the new signature.
*** Python session return values must be top-level expression statements
Python blocks with ~:session :results value~ header arguments now only
return a value if the last line is a top-level expression statement.
Also, when a None value is returned, "None" will be printed under
"#+RESULTS:", as it already did with ~:results value~ for non-session
blocks.
*** In HTML export, change on how outline-container-* is set
When the headline has a =CUSTOM_ID=, use this custom id to build the
div id. For example, if you have =:CUSTOM_ID: my-headline= then the
resulting <div> will be ~<div id="outline-container-my-headline">~.
You may want to check whether your HTML files are rendered differently
after this change.
*** New keybinding =<C-c C-TAB>= for ~org-force-cycle-archived~
~org-force-cycle-archived~ used to be associated with =<C-TAB>= but
this keybinding is used in Emacs for navigating tabs in Emacs. The
new keybinding is =<C-c C-TAB>=.
** New default settings for some options
These options now default to =t=:
- ~org-loop-over-headlines-in-active-region~
- ~org-fontify-done-headline~
- ~org-src-tab-acts-natively~
You may want to read the docstrings of these options to understand the
consequences of this change.
Also, ~org-startup-folded~ now defaults to ~showeverything~.
** New features
*** Looping agenda commands over headlines
~org-agenda-loop-over-headlines-in-active-region~ allows you to loop
agenda commands over the active region.
When set to =t= (the default), loop over all headlines. When set to
='start-level=, loop over headlines with the same level as the first
headline in the region. When set to a string, loop over lines
matching this regular expression.
*** New minor mode ~org-table-header-line-mode~
Turn on the display of the first data row of the table at point in the
window header line when this first row is not visible anymore in the
buffer.
You can activate this minor mode by default by setting the option
~org-table-header-line-p~ to =t=. You can also change the face for
the header line by customizing the ~org-table-header~ face.
*** New minor mode ~org-list-checkbox-radio-mode~
When this minor mode is on, checkboxes behave as radio buttons: if a
checkbox is turned on, other checkboxes at the same level are turned
off.
If you want to occasionally toggle a checkbox as a radio button
without turning this minor mode on, you can use =<C-c C-x C-r>= to
call ~org-toggle-radio-button~.
You can also add =#+ATTR_ORG: :radio t= right before the list to tell
Org to use radio buttons for this list only.
*** New allowed value for ~org-adapt-indentation~
~org-adapt-indentation~ now accepts a new value, ='headline-data=.
When set to this value, Org will only adapt indentation of headline
data lines, such as planning/clock lines and property/logbook drawers.
Also, with this setting, =org-indent-mode= will keep these data lines
correctly aligned with the headline above.
*** Numeric priorities are now allowed (up to 65)
You can now set ~org-priority-highest/lowest/default~ to integers to
use numeric priorities globally or set, for example
#+PRIORITIES: 1 10 5
to define a buffer-local range and default for priorities. Priority
commands should work as usual. You cannot use numbers superior to 64
for numeric priorities, as it would clash with priorities like [#A]
where the "A" is internally converted to its numeric value of 65.
*** Property drawers allowed before first headline
Property drawers are now allowed before the first headline.
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.
*** Refinement in window behavior on exiting Org source buffer
After editing a source block, Org will restore the window layout when
~org-src-window-setup~ is set to a value that modifies the layout.
*** Display remote inline images
Org now knows how to display remote images inline.
Whether the images are actually displayed is controlled by the new
option ~org-display-remote-inline-images~.
*** New option to resolve open clock at a provided time
~org-resolve-clocks~ now has a `t' option, which works just like the
`k' option, but the user specifies a time of day, not a number of
minutes.
*** New step value =semimonth= accepted for clock tables
*** Allow text rescaling in column view
You can now use =C-x C-+= in column view: the columns face size will
increase or decrease, together with the column header size.
*** New startup option =#+startup: num=
When this startup option is set, display headings as numerated.
Use =#+startup: nonum= to turn this off.
*** New tool for custom links
Org provides a new tool ~org-link-open-as-file~, useful when defining
new link types similar to "file"-type links. See docstring for
details.
*** New optional numeric argument for ~org-return~
In situations where ~org-return~ calls ~newline~, multiple newlines
can now be inserted with this prefix argument.
*** New source code block header argument =:file-mode=
Source code block header argument =:file-mode= can set file
permissions if =:file= argument is provided.
*** =RET= and =C-j= now obey ~electric-indent-mode~
Since Emacs 24.4, ~electric-indent-mode~ is enabled by default. In
most major modes, this causes =RET= to reindent the current line and
indent the new line, and =C-j= to insert a newline without indenting.
Org mode now obeys this minor mode: when ~electric-indent-mode~ is
enabled, and point is neither in a table nor on a timestamp or a link:
- =RET= (bound to ~org-return~) reindents the current line and indents
the new line;
- =C-j= (bound to the new command ~org-return-and-maybe-indent~)
merely inserts a newline.
To get the previous behaviour back, disable ~electric-indent-mode~
explicitly:
#+begin_src emacs-lisp
(add-hook 'org-mode-hook (lambda () (electric-indent-local-mode -1)))
#+end_src
*** =ob-C.el= allows the inclusion of non-system header files
In C and C++ blocks, ~:includes~ arguments that do not start with a
~<~ character will now be formatted as double-quoted ~#include~
statements.
*** =ob-clojure.el= supports inf-clojure.el and ClojureScript evaluation
You can now set ~(setq org-babel-clojure-backend 'inf-clojure)~ and
evaluate Clojure source blocks using [[https://github.com/clojure-emacs/inf-clojure][inf-clojure]]. With a header
argument like =:alias "alias"= the Clojure REPL will boot with
=clojure -Aalias=. Otherwise Clojure will boot with =lein=, =boot= or
=tools.deps=, depending on whether the current directory contains a
=project.clj=, =build.boot= or =deps.edn=, falling back on
~inf-clojure-generic-cmd~ in case no such file is present.
Also, when using [[https://github.com/clojure-emacs/cider][cider]], you can now use =#+begin_src clojurescript= to
execute ClojureScript code from Org files. Note that this works only
if your Org file is associated with a cider session that knows how to
run ClojureScript code. A bare =lein repl= session outside of a
directory configured for ClojureScript will /not/ work.
*** =ob-java.el= supports Java command line arguments
Babel Java blocks recognize header argument =:cmdargs= and pass its
value in call to =java=.
*** =ob-screen.el= now accepts =:screenrc= header argument
Screen blocks now recognize the =:screenrc= header argument and pass
its value to the screen command via the "-c" option. The default
remains =/dev/null= (i.e. a clean screen session)
*** =ob-plantuml=: now supports using PlantUML executable to generate diagrams
Set =org-plantuml-exec-mode= to ='plantuml= in order to use the
executable instead of JAR. When using an executable it is also
possible to configure executable location as well as arguments via:
=org-plantuml-executable-path= and =org-plantuml-executable-args=.
** New commands
*** ~org-table-header-line-mode~
Turn on a minor mode to display the first data row of the table at
point in the header-line when the beginning of the table is invisible.
*** ~org-agenda-ctrl-c-ctrl-c~
Hitting =<C-c C-c>= in an agenda view now calls ~org-agenda-set-tags~.
*** ~org-hide-entry~
This command is the counterpart of ~org-show-entry~.
*** ~org-columns-toggle-or-columns-quit~
=<C-c C-c>= bound to ~org-columns-toggle-or-columns-quit~ replaces the
recent ~org-columns-set-tags-or-toggle~. Tag setting is still
possible via column view value edit or with =<C-c C-q>=.
*** ~org-datetree-find-month-create~
Find or create a month entry for a date.
** New options and settings
*** New option ~org-html-prefer-user-labels~
When non-nil, use =NAME= affiliated keyword, or raw target values, to
generate anchor's ID. Otherwise, consistently use internal naming
scheme.
=CUSTOM_ID= values are still always used, when available.
*** New option for using tabs in ~org-agenda-window-setup~
Choosing ~other-tab~ for ~org-agenda-window-setup~ will open the
agenda view in a new tab. This will work with versions of Emacs since
27.1 when ~tab-bar-mode~ was introduced.
*** New option ~org-table-header-line-p~
Setting this option to =t= will activate ~org-table-header-line-mode~
in org-mode buffers.
*** New option ~org-startup-numerated~
When this option is =t=, Org files will start using ~(org-num-mode 1)~
and headings will be visually numerated.
You can turn this on/off on a per-file basis with =#+startup: num= or
=#+startup: nonum=.
*** New option ~org-clock-auto-clockout-timer~
When this option is set to a number and the user configuration
contains =(org-clock-auto-clockout-insinuate)=, Org will clock out the
currently clocked in task after that number of seconds of idle time.
This is useful when you often forget to clock out before being idle
and don't want to have to manually set the clocking time to take into
account.
*** New option to group captured datetime entries by month
A new `:tree-type month' option was added to org-capture-templates to
group new datetime entries by month.
*** New option to show source buffers using "plain" display-buffer
There is a new option ~plain~ to ~org-src-window-setup~ to show source
buffers using ~display-buffer~. This allows users to control how
source buffers are displayed by modifying ~display-buffer-alist~ or
~display-buffer-base-action~.
*** New option ~org-archive-subtree-save-file-p~
Archiving a subtree used to always save the target archive buffer.
Commit [[https://code.orgmode.org/bzg/org-mode/commit/b186d1d7][b186d1d7]] changed this behavior by always not saving the target
buffer, because batch archiving from agenda could take too much time.
This new option ~org-archive-subtree-save-file-p~ defaults to the
value =from-org= so that archiving a subtree will save the target
buffer when done from an org-mode buffer, but not from the agenda.
You can also set this option to =t= or to =from-agenda=.
*** New option ~org-show-notification-timeout~
This option will add a timeout to notifications.
*** New option ~org-latex-to-html-convert-command~
This new option allows you to convert a LaTeX fragment directly into
HTML.
*** New option ~org-babel-shell-results-defaults-to-output~
By default, source code blocks are executed in "functional mode": it
means that the results of executing them are the value of their last
statement (see [[https://orgmode.org/manual/Results-of-Evaluation.html][the documentation]].)
The value of a shell script's execution is its exit code. But most
users expect the results of executing a shell script to be its output,
not its exit code.
So we introduced this option, that you can set to =nil= if you want
to stick using ~:results value~ as the implicit header.
In all Babel libraries, the absence of a ~:results~ header should
produce the same result than setting ~:results value~, unless there is
an option to explicitly create an exception.
See [[https://orgmode.org/list/CA+A2iZaziAfMeGpBqL6qGrzrWEVvLvC0DUw++T4gCF3NGuW-DQ@mail.gmail.com/][this thread]] for more context.
*** New option in ~org-attach-store-link-p~
~org-attach-store-link-p~ has a new option to store a file link to the
attachment.
*** New option ~org-fontify-todo-headline~
This feature is the same as ~org-fontify-done-headline~, but for TODO
headlines instead. This allows you to distinguish TODO headlines from
normal headlines. The face can be customized via ~org-headline-todo~.
*** New default value for ~org-file-apps~
The new value uses Emacs as the application for opening directory.
*** New hook ~org-agenda-filter-hook~
Functions in this hook are run after ~org-agenda-filter~ is called.
** Removed or renamed functions and variables
*** Deprecated ~org-flag-drawer~ function
Use ~org-hide-drawer-toggle~ instead.
*** Deprecated ~org-hide-block-toggle-maybe~ function
Use ~org-hide-block-toggle~ instead.
*** Deprecated ~org-hide-block-toggle-all~ function
This function was not used in the code base, and has no clear use
either. It has been marked for future removal. Please contact the
mailing list if you use this function.
*** Deprecated ~org-return-indent~ function
In Elisp code, use ~(org-return t)~ instead. Interactively, =C-j= is
now bound to ~org-return-and-maybe-indent~, which indents the new line
when ~electric-indent-mode~ is disabled.
*** Removed ~org-maybe-keyword-time-regexp~
The variable was not used in the code base.
*** Removed ~org-export-special-keywords~
The variable was not used in the code base.
*** Renamed ~org-at-property-block-p~
The new name is ~org-at-property-drawer-p~, which is less confusing.
*** Renamed ~org-columns-set-tags-or-toggle~
See [[*~org-columns-toggle-or-columns-quit~]].
*** Renamed priority options
From ~org-lowest-priority~ to ~org-priority-lowest~.
From ~org-default-priority~ to ~org-priority-default~.
From ~org-highest-priority~ to ~org-priority-highest~.
From ~org-enable-priority-commands~ to ~org-priority-enable-commands~.
From ~org-show-priority~ to ~org-priority-show~.
** Miscellaneous
*** =ob-screen.el= now respects screen =:session= name
Screen babel session are now named based on the =:session= header
argument (defaults to ~default~).
Previously all session names had ~org-babel-session-~ prepended.
*** Forward/backward paragraph functions in line with the rest of Emacs
~org-forward-paragraph~ and ~org-backward-paragraph~, bound to
~<C-UP>~ and ~<C-DOWN>~ functions mimic more closely behaviour of
~forward-paragraph~ and ~backward-paragraph~ functions when
available.
They also accept an optional argument for multiple calls.
See their docstring for details.
*** ~org-table-to-lisp~ no longer checks if point is at a table
The caller is now responsible for the check. It can use, e.g.,
~org-at-table-p~.
The function is also much more efficient than it used to be, even on
very large tables.
*** New function ~org-collect-keywords~
*** Drawers' folding use an API similar to block's
Tooling for folding drawers interactively or programmatically is now
on par with block folding. In particular, ~org-hide-drawer-toggle~,
a new function, is the central place for drawer folding.
*** Duration can be read and written in compact form
~org-duration-to-minutes~ understands =1d3h5min= as a duration,
whereas ~org-duration-from-minutes~ can output this compact form if
the duration format contains the symbol ~compact~.
*** C-n, C-p, SPC and DEL in agenda commands dispatch window
You can now use =<C-n>=, =<C-p>=, =<SPC>= and =<DEL>= key to scroll up
and down the agenda and attach dispatch window.
*** =<C-c C-c>= in agenda calls ~org-agenda-set-tags~
Both =<C-c C-q>= and =<C-c C-c>= set the tags of the headline in the
Org buffer. Both keybindings are now available from the agenda too.
*** Allow to use an empty HTML extension
Using =(setq org-html-extension "")= or setting the HTML extension in
any fashion will produce the expected output, with no trailing period
to the resulting HTML file.
*** Handle repeated tasks with =.+= type and hours step
A task using a =.+= repeater and hours step is repeated starting from
now. E.g.,
#+begin_example
,,** TODO Wash my hands
DEADLINE: <2019-04-05 08:00 Sun .+1h>
Marking this DONE shifts the date to exactly one hour from now.
#+end_example
*** The format of equation reference in HTML export can now be specified
By default, HTML (via MathJax) and LaTeX export equation references
using different commands. LaTeX must use ~\ref{%s}~ because it is used
for all labels; however, HTML (via MathJax) uses ~\eqref{%s}~ for
equations producing inconsistent output. New option
~org-html-equation-reference-format~ sets the command used in HTML
export.
*** =ob-haskell.el= supports compilation with =:compile= header argument
By default, Haskell blocks are interpreted. By adding =:compile yes=
to a Haskell source block, it will be compiled, executed and the
results will be displayed.
*** Support for ~org-edit-special~ with LaTeX fragments
Calling ~org-edit-special~ on an inline LaTeX fragment calls a new
function, ~org-edit-latex-fragment~. This functions in a comparable
manner to editing inline source blocks, bringing up a minibuffer set
to LaTeX mode. The math-mode deliminators are read only.
*** ~org-capture-current-plist~ is now accessible during ~org-capture-mode-hook~
*** New =org-refile.el= file
Org refile variables and functions have been moved to a new file.
*** The end of a 7 years old bug
This bug [[https://lists.gnu.org/archive/html/emacs-orgmode/2013-08/msg00072.html][originally reported]] by Matt Lundin and investigated by Andrew
Hyatt has been fixed. Thanks to both of them.
* Version 9.3 * Version 9.3
** Incompatible changes ** Incompatible changes
@ -137,7 +674,7 @@ Export ignore done tasks with a deadline when
Likewise, scheduled done tasks are also ignored when Likewise, scheduled done tasks are also ignored when
~org-icalendar-use-scheduled~ contains the same symbol. ~org-icalendar-use-scheduled~ contains the same symbol.
*** Add split-window-right option for src block edit window placement *** Add ~split-window-right~ option for src block edit window placement
Given the increasing popularity of wide screen monitors, splitting Given the increasing popularity of wide screen monitors, splitting
horizontally may make more sense than splitting vertically. An horizontally may make more sense than splitting vertically. An
@ -360,7 +897,6 @@ the headline to use for making the table of contents.
,* Another section ,* Another section
,#+TOC: headlines 1 :target "#TargetSection" ,#+TOC: headlines 1 :target "#TargetSection"
#+end_example #+end_example
** New functions ** New functions
*** ~org-dynamic-block-insert-dblock~ *** ~org-dynamic-block-insert-dblock~
@ -490,7 +1026,7 @@ and ~org-list-radio-lists-templates~) are removed from the code base.
Note that only radio /lists/ have been removed, not radio tables. 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 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. 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 If you want to use Org folding outside of Org buffers, you can have a
look at the outshine package in the MELPA repository. look at the outshine package in the MELPA repository.
@ -1282,9 +1818,9 @@ removed from Gnus circa September 2010.
*** ~org-agenda-repeating-timestamp-show-all~ is removed. *** ~org-agenda-repeating-timestamp-show-all~ is removed.
For an equivalent to a ~nil~ value, set For an equivalent to a =nil= value, set
~org-agenda-show-future-repeats~ to nil and ~org-agenda-show-future-repeats~ to nil and
~org-agenda-prefer-last-repeat~ to ~t~. ~org-agenda-prefer-last-repeat~ to =t=.
*** ~org-gnus-nnimap-query-article-no-from-file~ is removed. *** ~org-gnus-nnimap-query-article-no-from-file~ is removed.
@ -1302,7 +1838,7 @@ equivalent to the removed format string.
*** ~org-enable-table-editor~ is removed. *** ~org-enable-table-editor~ is removed.
Setting it to a ~nil~ value broke some other features (e.g., speed Setting it to a =nil= value broke some other features (e.g., speed
keys). keys).
*** ~org-export-use-babel~ cannot be set to ~inline-only~ *** ~org-export-use-babel~ cannot be set to ~inline-only~
@ -1383,16 +1919,20 @@ is now obsolete.
Now ~=...=~ markup uses ~@samp{}~ instead of ~@verb{}~. You can use Now ~=...=~ markup uses ~@samp{}~ instead of ~@verb{}~. You can use
~@verb{}~ again by customizing the variable. ~@verb{}~ again by customizing the variable.
*** Texinfo exports example blocks as ~@example~ *** Texinfo exports example blocks as ~@example~
*** Texinfo exports inline source blocks as ~@code{}~ *** Texinfo exports inline source blocks as ~@code{}~
*** Texinfo default table markup is ~@asis~ *** Texinfo default table markup is ~@asis~
It used to be ~@samp~ but ~@asis~ is neutral and, therefore, more It used to be ~@samp~ but ~@asis~ is neutral and, therefore, more
suitable as a default value. suitable as a default value.
*** Texinfo default process includes ~--no-split~ option *** Texinfo default process includes ~--no-split~ option
*** New entities : ~\dollar~ and ~\USD~ *** New entities : ~\dollar~ and ~\USD~
*** Support for date style URLs in =org-protocol://open-source= *** Support for date style URLs in =org-protocol://open-source=
URLs like =https://cool-blog.com/2017/05/20/cool-post/= are
covered by rewrite rules. URLs like =https://cool-blog.com/2017/05/20/cool-post/= are covered by
rewrite rules.
*** Add (C) =COMMENT= support to ~org-structure-template-alist~ *** Add (C) =COMMENT= support to ~org-structure-template-alist~
@ -2222,7 +2762,7 @@ without changing the headline.
*** Hierarchies of tags *** 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" This is the generalization of what was previously called "Tag groups"
in the manual. That term is now changed to "Tag hierarchy". in the manual. That term is now changed to "Tag hierarchy".
@ -4111,7 +4651,7 @@ See https://orgmode.org/elpa/
You can temporarily activate continuous clocking with =C-u C-u You can temporarily activate continuous clocking with =C-u C-u
C-u M-x= [[doc::org-clock-in][org-clock-in]] =RET= (three universal prefix arguments) C-u M-x= [[doc::org-clock-in][org-clock-in]] =RET= (three universal prefix arguments)
and =C-u C-u M-x= [[org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix and =C-u C-u M-x= [[doc::org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix
arguments). arguments).
@ -5157,7 +5697,7 @@ that Calc formulas can operate on them.
Thanks to Nicolas Goaziou for coding these changes. Thanks to Nicolas Goaziou for coding these changes.
**** A property value of "nil" now means to unset a property **** A property value of =nil= now means to unset a property
This can be useful in particular with property inheritance, if This can be useful in particular with property inheritance, if
some upper level has the property, and some grandchild of it some upper level has the property, and some grandchild of it

View File

@ -232,7 +232,13 @@ its header arguments."
(list (list
;; includes ;; includes
(mapconcat (mapconcat
(lambda (inc) (format "#include %s" inc)) (lambda (inc)
;; :includes '(<foo> <bar>) gives us a list of
;; symbols; convert those to strings.
(when (symbolp inc) (setq inc (symbol-name inc)))
(if (string-prefix-p "<" inc)
(format "#include %s" inc)
(format "#include \"%s\"" inc)))
includes "\n") includes "\n")
;; defines ;; defines
(mapconcat (mapconcat

View File

@ -3,6 +3,7 @@
;; Copyright (C) 2011-2020 Free Software Foundation, Inc. ;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
;; Author: Oleh Krehel ;; Author: Oleh Krehel
;; Maintainer: Joseph Novakovich <josephnovakovich@gmail.com>
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org ;; Homepage: https://orgmode.org

View File

@ -193,7 +193,8 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-comint-in-buffer session (org-babel-comint-in-buffer session
(mapc (lambda (var) (mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input nil t) (end-of-line 1) (insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)) var-lines)) (org-babel-comint-wait-for-output session))
var-lines))
session)) session))
(defun org-babel-load-session:R (session body params) (defun org-babel-load-session:R (session body params)
@ -459,11 +460,11 @@ last statement in BODY, as elisp."
"R-specific processing of return value. "R-specific processing of return value.
Insert hline if column names in output have been requested." Insert hline if column names in output have been requested."
(if column-names-p (if column-names-p
(cons (car result) (cons 'hline (cdr result))) (condition-case nil
(cons (car result) (cons 'hline (cdr result)))
(error "Could not parse R result"))
result)) result))
(provide 'ob-R) (provide 'ob-R)
;;; ob-R.el ends here ;;; ob-R.el ends here

View File

@ -5,7 +5,6 @@
;; Author: William Waites ;; Author: William Waites
;; Keywords: literate programming, music ;; Keywords: literate programming, music
;; Homepage: http://www.tardis.ed.ac.uk/wwaites ;; Homepage: http://www.tardis.ed.ac.uk/wwaites
;; Version: 0.01
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -87,4 +86,5 @@
(error "ABC does not support sessions")) (error "ABC does not support sessions"))
(provide 'ob-abc) (provide 'ob-abc)
;;; ob-abc.el ends here ;;; ob-abc.el ends here

View File

@ -134,6 +134,4 @@ Otherwise, it is either `real', if some elements are floats, or
(provide 'ob-asymptote) (provide 'ob-asymptote)
;;; ob-asymptote.el ends here ;;; ob-asymptote.el ends here

View File

@ -106,6 +106,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-awk) (provide 'ob-awk)
;;; ob-awk.el ends here ;;; ob-awk.el ends here

View File

@ -105,6 +105,4 @@
(provide 'ob-calc) (provide 'ob-calc)
;;; ob-calc.el ends here ;;; ob-calc.el ends here

View File

@ -30,77 +30,65 @@
;; - clojure (at least 1.2.0) ;; - clojure (at least 1.2.0)
;; - clojure-mode ;; - clojure-mode
;; - either cider or SLIME ;; - inf-clojure, cider or SLIME
;; For Cider, see https://github.com/clojure-emacs/cider ;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode
;; For cider, see https://github.com/clojure-emacs/cider
;; For inf-clojure, see https://github.com/clojure-emacs/cider
;; For SLIME, the best way to install these components is by following ;; For SLIME, the best way to install these components is by following
;; the directions as set out by Phil Hagelberg (Technomancy) on the ;; the directions as set out by Phil Hagelberg (Technomancy) on the
;; web page: http://technomancy.us/126 ;; web page: http://technomancy.us/126
;;; Code: ;;; Code:
(require 'cl-lib)
(require 'ob) (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-connection "ext:cider-client" (&optional type))
(declare-function cider-current-ns "ext:cider-client" ()) (declare-function cider-current-ns "ext:cider-client" ())
(declare-function cider-repls "ext:cider-connection" (&optional type ensure)) (declare-function inf-clojure "ext:inf-clojure" (cmd))
(declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2)) (declare-function inf-clojure-cmd "ext:inf-clojure" (project-type))
(declare-function inf-clojure-eval-string "ext:inf-clojure" (code))
(declare-function inf-clojure-project-type "ext:inf-clojure" ())
(declare-function nrepl-dict-get "ext:nrepl-client" (dict key)) (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 ns line column additional-params tooling))
(declare-function nrepl-sync-request:eval "ext:nrepl-client" (input connection &optional ns tooling)) (declare-function nrepl-sync-request:eval "ext:nrepl-client" (input connection &optional ns tooling))
(declare-function sesman-start-session "ext:sesman" (system))
(declare-function slime-eval "ext:slime" (sexp &optional package)) (declare-function slime-eval "ext:slime" (sexp &optional package))
(defvar nrepl-sync-request-timeout)
(defvar cider-buffer-ns) (defvar cider-buffer-ns)
(defvar sesman-system)
(defvar cider-version)
(defvar org-babel-tangle-lang-exts) (defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
(add-to-list 'org-babel-tangle-lang-exts '("clojurescript" . "cljs"))
(defvar org-babel-default-header-args:clojure '()) (defvar org-babel-default-header-args:clojure '())
(defvar org-babel-header-args:clojure '((ns . :any) (defvar org-babel-header-args:clojure '((ns . :any) (package . :any)))
(package . :any))) (defvar org-babel-default-header-args:clojurescript '())
(defvar org-babel-header-args:clojurescript '((package . :any)))
(defcustom org-babel-clojure-sync-nrepl-timeout 10 (defcustom org-babel-clojure-backend nil
"Timeout value, in seconds, of a Clojure sync call.
If the value is nil, timeout is disabled."
:group 'org-babel
:type 'integer
:version "26.1"
:package-version '(Org . "9.1")
:safe #'wholenump)
(defcustom org-babel-clojure-backend
(cond ((featurep 'cider) 'cider)
(t 'slime))
"Backend used to evaluate Clojure code blocks." "Backend used to evaluate Clojure code blocks."
:group 'org-babel :group 'org-babel
:type '(choice :type '(choice
(const :tag "inf-clojure" inf-clojure)
(const :tag "cider" cider) (const :tag "cider" cider)
(const :tag "SLIME" slime))) (const :tag "slime" slime)
(const :tag "Not configured yet" nil)))
(defcustom org-babel-clojure-default-ns "user" (defcustom org-babel-clojure-default-ns "user"
"Default Clojure namespace for source block when finding ns failed." "Default Clojure namespace for source block when finding ns failed."
:type 'string :type 'string
:group 'org-babel) :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) (defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body." "Expand BODY according to PARAMS, return the expanded body."
(let* ((vars (org-babel--get-vars params)) (let* ((vars (org-babel--get-vars params))
(ns (or (cdr (assq :ns params)) (ns (or (cdr (assq :ns params))
(org-babel-clojure-cider-current-ns))) (if (eq org-babel-clojure-backend 'cider)
(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)))
(result-params (cdr (assq :result-params params))) (result-params (cdr (assq :result-params params)))
(print-level nil) (print-level nil)
(print-length nil) (print-length nil)
@ -124,161 +112,141 @@ If the value is nil, timeout is disabled."
(format "(clojure.pprint/pprint (do %s))" body) (format "(clojure.pprint/pprint (do %s))" body)
body))) body)))
(defun org-babel-execute:clojure (body params) (defvar ob-clojure-inf-clojure-filter-out)
"Execute a block of Clojure code with Babel. (defvar ob-clojure-inf-clojure-tmp-output)
The underlying process performed by the code block can be output (defun ob-clojure-inf-clojure-output (s)
using the :show-process parameter." "Store a trimmed version of S in a variable and return S."
(let* ((expanded (org-babel-expand-body:clojure body params)) (let ((s0 (org-trim
(response (list 'dict)) (replace-regexp-in-string
result) ob-clojure-inf-clojure-filter-out "" s))))
(cl-case org-babel-clojure-backend (push s0 ob-clojure-inf-clojure-tmp-output))
(cider s)
(require 'cider)
(let ((result-params (cdr (assq :result-params params)))
(show (cdr (assq :show-process params))))
(if (member show '(nil "no"))
;; Run code without showing the process.
(progn
(setq response
(let ((nrepl-sync-request-timeout
org-babel-clojure-sync-nrepl-timeout))
(nrepl-sync-request:eval expanded
(cider-current-connection))))
(setq result
(concat
(nrepl-dict-get response
(if (or (member "output" result-params)
(member "pp" result-params))
"out"
"value"))
(nrepl-dict-get response "ex")
(nrepl-dict-get response "root-ex")
(nrepl-dict-get response "err"))))
;; Show the process in an output buffer/window.
(let ((process-buffer (switch-to-buffer-other-window
"*Clojure Show Process Sub Buffer*"))
status)
;; Run the Clojure code in nREPL.
(nrepl-request:eval
expanded
(lambda (resp)
(when (member "out" resp)
;; Print the output of the nREPL in the output buffer.
(princ (nrepl-dict-get resp "out") process-buffer))
(when (member "ex" resp)
;; In case there is an exception, then add it to the
;; output buffer as well.
(princ (nrepl-dict-get resp "ex") process-buffer)
(princ (nrepl-dict-get resp "root-ex") process-buffer))
(when (member "err" resp)
;; In case there is an error, then add it to the
;; output buffer as well.
(princ (nrepl-dict-get resp "err") process-buffer))
(nrepl--merge response resp)
;; Update the status of the nREPL output session.
(setq status (nrepl-dict-get response "status")))
(cider-current-connection))
;; Wait until the nREPL code finished to be processed. (defmacro ob-clojure-with-temp-expanded (expanded params &rest body)
(while (not (member "done" status)) "Run BODY on EXPANDED code block with PARAMS."
(nrepl-dict-put response "status" (remove "need-input" status)) (declare (debug (body)) (indent 2))
(accept-process-output nil 0.01) `(with-temp-buffer
(redisplay)) (insert ,expanded)
(goto-char (point-min))
(while (not (looking-at "\\s-*\\'"))
(let* ((beg (point))
(end (progn (forward-sexp) (point)))
(exp (org-babel-expand-body:clojure
(buffer-substring beg end) ,params)))
(sit-for .1)
,@body))))
;; Delete the show buffer & window when the processing is (defsubst ob-clojure-string-or-list (l)
;; finalized. "Convert list L into a string or a list of list."
(mapc #'delete-window (if (and (listp l) (= (length l) 1))
(get-buffer-window-list process-buffer nil t)) (car l)
(kill-buffer process-buffer) (mapcar #'list l)))
;; Put the output or the value in the result section of (defvar inf-clojure-buffer)
;; the code block. (defvar comint-prompt-regexp)
(setq result (defvar inf-clojure-comint-prompt-regexp)
(concat (defun ob-clojure-eval-with-inf-clojure (expanded params)
(nrepl-dict-get response "Evaluate EXPANDED code block with PARAMS using inf-clojure."
(if (or (member "output" result-params) (condition-case nil (require 'inf-clojure)
(member "pp" result-params)) (user-error "inf-clojure not available"))
"out" ;; Maybe initiate the inf-clojure session
"value")) (unless (and inf-clojure-buffer
(buffer-live-p (get-buffer inf-clojure-buffer)))
(save-window-excursion
(let* ((alias (cdr (assq :alias params)))
(cmd0 (inf-clojure-cmd (inf-clojure-project-type)))
(cmd (if alias (replace-regexp-in-string
"clojure" (format "clojure -A%s" alias)
cmd0)
cmd0)))
(setq comint-prompt-regexp inf-clojure-comint-prompt-regexp)
(funcall-interactively #'inf-clojure cmd)
(goto-char (point-max))))
(sit-for 1))
;; Now evaluate the code
(setq ob-clojure-inf-clojure-filter-out
(concat "^nil\\|nil$\\|\\s-*"
(or (cdr (assq :ns params))
org-babel-clojure-default-ns)
"=>\\s-*"))
(add-hook 'comint-preoutput-filter-functions
#'ob-clojure-inf-clojure-output)
(setq ob-clojure-inf-clojure-tmp-output nil)
(ob-clojure-with-temp-expanded expanded nil
(inf-clojure-eval-string exp))
(sit-for .5)
(remove-hook 'comint-preoutput-filter-functions
#'ob-clojure-inf-clojure-output)
;; And return the result
(ob-clojure-string-or-list
(delete nil
(mapcar
(lambda (s)
(unless (or (equal "" s)
(string-match-p "^Clojure" s))
s))
(reverse ob-clojure-inf-clojure-tmp-output)))))
(defun ob-clojure-eval-with-cider (expanded params)
"Evaluate EXPANDED code block with PARAMS using cider."
(condition-case nil (require 'cider)
(user-error "cider not available"))
(let ((connection (cider-current-connection (cdr (assq :target params))))
(result-params (cdr (assq :result-params params)))
result0)
(unless connection (sesman-start-session 'CIDER))
(if (not connection)
;; Display in the result instead of using `user-error'
(setq result0 "Please reevaluate when nREPL is connected")
(ob-clojure-with-temp-expanded expanded params
(let ((response (nrepl-sync-request:eval exp connection)))
(push (or (nrepl-dict-get response "root-ex")
(nrepl-dict-get response "ex") (nrepl-dict-get response "ex")
(nrepl-dict-get response "root-ex") (nrepl-dict-get
(nrepl-dict-get response "err"))))))) response (if (or (member "output" result-params)
(slime (member "pp" result-params))
(require 'slime) "out"
(with-temp-buffer "value")))
(insert expanded) result0)))
(setq result (ob-clojure-string-or-list
(slime-eval (reverse (delete "" (mapcar (lambda (r)
`(swank:eval-and-grab-output (replace-regexp-in-string "nil" "" r))
,(buffer-substring-no-properties (point-min) (point-max))) result0)))))))
(cdr (assq :package params)))))))
(org-babel-result-cond (cdr (assq :result-params params)) (defun ob-clojure-eval-with-slime (expanded params)
"Evaluate EXPANDED code block with PARAMS using slime."
(condition-case nil (require 'slime)
(user-error "slime not available"))
(with-temp-buffer
(insert expanded)
(slime-eval
`(swank:eval-and-grab-output
,(buffer-substring-no-properties (point-min) (point-max)))
(cdr (assq :package params)))))
(defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code with Babel."
(unless org-babel-clojure-backend
(user-error "You need to customize org-babel-clojure-backend"))
(let* ((expanded (org-babel-expand-body:clojure body params))
(result-params (cdr (assq :result-params params)))
result)
(setq result
(cond
((eq org-babel-clojure-backend 'inf-clojure)
(ob-clojure-eval-with-inf-clojure expanded params))
((eq org-babel-clojure-backend 'cider)
(ob-clojure-eval-with-cider expanded params))
((eq org-babel-clojure-backend 'slime)
(ob-clojure-eval-with-slime expanded params))))
(org-babel-result-cond result-params
result result
(condition-case nil (org-babel-script-escape result) (condition-case nil (org-babel-script-escape result)
(error result))))) (error result)))))
(defun org-babel-clojure-initiate-session (&optional session _params) (defun org-babel-execute:clojurescript (body params)
"Initiate a session named SESSION according to PARAMS." "Evaluate BODY with PARAMS as ClojureScript code."
(when (and session (not (string= session "none"))) (org-babel-execute:clojure body (cons '(:target . "cljs") params)))
(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) (provide 'ob-clojure)

View File

@ -151,6 +151,4 @@ FILE exists at end of evaluation."
(provide 'ob-comint) (provide 'ob-comint)
;;; ob-comint.el ends here ;;; ob-comint.el ends here

View File

@ -76,3 +76,5 @@ create one. Return the initialized session."
(get-buffer org-babel-coq-buffer)) (get-buffer org-babel-coq-buffer))
(provide 'ob-coq) (provide 'ob-coq)
;;; ob-coq.el ends here

View File

@ -60,6 +60,7 @@
(declare-function org-element-type "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-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-escape-code-in-region "org-src" (beg end)) (declare-function org-escape-code-in-region "org-src" (beg end))
(declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-indent-line "org" ()) (declare-function org-indent-line "org" ())
(declare-function org-list-get-list-end "org-list" (item struct prevs)) (declare-function org-list-get-list-end "org-list" (item struct prevs))
@ -68,7 +69,6 @@
(declare-function org-list-to-generic "org-list" (LIST PARAMS)) (declare-function org-list-to-generic "org-list" (LIST PARAMS))
(declare-function org-list-to-lisp "org-list" (&optional delete)) (declare-function org-list-to-lisp "org-list" (&optional delete))
(declare-function org-macro-escape-arguments "org-macro" (&rest args)) (declare-function org-macro-escape-arguments "org-macro" (&rest args))
(declare-function org-make-options-regexp "org" (kwds &optional extra))
(declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-narrow-to-subtree "org" ()) (declare-function org-narrow-to-subtree "org" ())
(declare-function org-next-block "org" (arg &optional backward block-regexp)) (declare-function org-next-block "org" (arg &optional backward block-regexp))
@ -79,6 +79,7 @@
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-src-get-lang-mode "org-src" (lang)) (declare-function org-src-get-lang-mode "org-src" (lang))
(declare-function org-table-align "org-table" ()) (declare-function org-table-align "org-table" ())
(declare-function org-table-convert-region "org-table" (beg0 end0 &optional separator))
(declare-function org-table-end "org-table" (&optional table-type)) (declare-function org-table-end "org-table" (&optional table-type))
(declare-function org-table-import "org-table" (file arg)) (declare-function org-table-import "org-table" (file arg))
(declare-function org-table-to-lisp "org-table" (&optional txt)) (declare-function org-table-to-lisp "org-table" (&optional txt))
@ -165,7 +166,6 @@ This string must include a \"%s\" which will be replaced by the results."
"Non-nil means show the time the code block was evaluated in the result hash." "Non-nil means show the time the code block was evaluated in the result hash."
:group 'org-babel :group 'org-babel
:type 'boolean :type 'boolean
:version "26.1"
:package-version '(Org . "9.0") :package-version '(Org . "9.0")
:safe #'booleanp) :safe #'booleanp)
@ -402,6 +402,7 @@ then run `org-babel-switch-to-session'."
(file . :any) (file . :any)
(file-desc . :any) (file-desc . :any)
(file-ext . :any) (file-ext . :any)
(file-mode . ((#o755 #o555 #o444 :any)))
(hlines . ((no yes))) (hlines . ((no yes)))
(mkdirp . ((yes no))) (mkdirp . ((yes no)))
(no-expand) (no-expand)
@ -489,11 +490,21 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'."
"Regexp matching a NAME keyword.") "Regexp matching a NAME keyword.")
(defconst org-babel-result-regexp (defconst org-babel-result-regexp
(format "^[ \t]*#\\+%s\\(?:\\[\\(?:%s \\)?\\([[:alnum:]]+\\)\\]\\)?:[ \t]*" (rx (seq bol
org-babel-results-keyword (zero-or-more (any "\t "))
;; <%Y-%m-%d %H:%M:%S> "#+results"
"<\\(?:[0-9]\\{4\\}-[0-1][0-9]-[0-3][0-9] \ (opt "["
[0-2][0-9]\\(?::[0-5][0-9]\\)\\{2\\}\\)>") ;; Time stamp part.
(opt "("
(= 4 digit) (= 2 "-" (= 2 digit))
" "
(= 2 digit) (= 2 ":" (= 2 digit))
") ")
;; SHA1 hash.
(group (one-or-more hex-digit))
"]")
":"
(zero-or-more (any "\t "))))
"Regular expression used to match result lines. "Regular expression used to match result lines.
If the results are associated with a hash key then the hash will If the results are associated with a hash key then the hash will
be saved in match group 1.") be saved in match group 1.")
@ -724,7 +735,11 @@ block."
(with-temp-file file (with-temp-file file
(insert (org-babel-format-result (insert (org-babel-format-result
result result
(cdr (assq :sep params)))))) (cdr (assq :sep params)))))
;; Set file permissions if header argument
;; `:file-mode' is provided.
(when (assq :file-mode params)
(set-file-modes file (cdr (assq :file-mode params)))))
(setq result file)) (setq result file))
;; Possibly perform post process provided its ;; Possibly perform post process provided its
;; appropriate. Dynamically bind "*this*" to the ;; appropriate. Dynamically bind "*this*" to the
@ -1304,10 +1319,9 @@ CONTEXT specifies the context of evaluation. It can be `:eval',
"Return the current in-buffer hash." "Return the current in-buffer hash."
(let ((result (org-babel-where-is-src-block-result nil info))) (let ((result (org-babel-where-is-src-block-result nil info)))
(when result (when result
(org-with-wide-buffer (org-with-point-at result
(goto-char result) (let ((case-fold-search t)) (looking-at org-babel-result-regexp))
(looking-at org-babel-result-regexp) (match-string-no-properties 1)))))
(match-string-no-properties 1)))))
(defun org-babel-hide-hash () (defun org-babel-hide-hash ()
"Hide the hash in the current results line. "Hide the hash in the current results line.
@ -1315,7 +1329,8 @@ Only the initial `org-babel-hash-show' characters of the hash
will remain visible." will remain visible."
(add-to-invisibility-spec '(org-babel-hide-hash . t)) (add-to-invisibility-spec '(org-babel-hide-hash . t))
(save-excursion (save-excursion
(when (and (re-search-forward org-babel-result-regexp nil t) (when (and (let ((case-fold-search t))
(re-search-forward org-babel-result-regexp nil t))
(match-string 1)) (match-string 1))
(let* ((start (match-beginning 1)) (let* ((start (match-beginning 1))
(hide-start (+ org-babel-hash-show start)) (hide-start (+ org-babel-hash-show start))
@ -1333,11 +1348,12 @@ Only the initial `org-babel-hash-show' characters of each hash
will remain visible. This function should be called as part of will remain visible. This function should be called as part of
the `org-mode-hook'." the `org-mode-hook'."
(save-excursion (save-excursion
(while (and (not org-babel-hash-show-time) (let ((case-fold-search t))
(re-search-forward org-babel-result-regexp nil t)) (while (and (not org-babel-hash-show-time)
(goto-char (match-beginning 0)) (re-search-forward org-babel-result-regexp nil t))
(org-babel-hide-hash) (goto-char (match-beginning 0))
(goto-char (match-end 0))))) (org-babel-hide-hash)
(goto-char (match-end 0))))))
(add-hook 'org-mode-hook 'org-babel-hide-all-hashes) (add-hook 'org-mode-hook 'org-babel-hide-all-hashes)
(defun org-babel-hash-at-point (&optional point) (defun org-babel-hash-at-point (&optional point)
@ -1366,9 +1382,10 @@ portions of results lines."
(interactive) (interactive)
(org-babel-show-result-all) (org-babel-show-result-all)
(save-excursion (save-excursion
(while (re-search-forward org-babel-result-regexp nil t) (let ((case-fold-search t))
(save-excursion (goto-char (match-beginning 0)) (while (re-search-forward org-babel-result-regexp nil t)
(org-babel-hide-result-toggle-maybe))))) (save-excursion (goto-char (match-beginning 0))
(org-babel-hide-result-toggle-maybe))))))
(defun org-babel-show-result-all () (defun org-babel-show-result-all ()
"Unfold all results in the current buffer." "Unfold all results in the current buffer."
@ -1380,52 +1397,50 @@ portions of results lines."
"Toggle visibility of result at point." "Toggle visibility of result at point."
(interactive) (interactive)
(let ((case-fold-search t)) (let ((case-fold-search t))
(if (save-excursion (and (org-match-line org-babel-result-regexp)
(beginning-of-line 1) (progn (org-babel-hide-result-toggle) t))))
(looking-at org-babel-result-regexp))
(progn (org-babel-hide-result-toggle)
t) ;; to signal that we took action
nil))) ;; to signal that we did not
(defun org-babel-hide-result-toggle (&optional force) (defun org-babel-hide-result-toggle (&optional force)
"Toggle the visibility of the current result." "Toggle the visibility of the current result."
(interactive) (interactive)
(save-excursion (save-excursion
(beginning-of-line) (beginning-of-line)
(if (re-search-forward org-babel-result-regexp nil t) (let ((case-fold-search t))
(let ((start (progn (beginning-of-line 2) (- (point) 1))) (unless (re-search-forward org-babel-result-regexp nil t)
(end (progn (error "Not looking at a result line")))
(while (looking-at org-babel-multi-line-header-regexp) (let ((start (progn (beginning-of-line 2) (1- (point))))
(forward-line 1)) (end (progn
(goto-char (- (org-babel-result-end) 1)) (point))) (while (looking-at org-babel-multi-line-header-regexp)
ov) (forward-line 1))
(if (memq t (mapcar (lambda (overlay) (goto-char (1- (org-babel-result-end)))
(eq (overlay-get overlay 'invisible) (point)))
'org-babel-hide-result)) ov)
(overlays-at start))) (if (memq t (mapcar (lambda (overlay)
(when (or (not force) (eq force 'off)) (eq (overlay-get overlay 'invisible)
(mapc (lambda (ov) 'org-babel-hide-result))
(when (member ov org-babel-hide-result-overlays) (overlays-at start)))
(setq org-babel-hide-result-overlays (when (or (not force) (eq force 'off))
(delq ov org-babel-hide-result-overlays))) (mapc (lambda (ov)
(when (eq (overlay-get ov 'invisible) (when (member ov org-babel-hide-result-overlays)
'org-babel-hide-result) (setq org-babel-hide-result-overlays
(delete-overlay ov))) (delq ov org-babel-hide-result-overlays)))
(overlays-at start))) (when (eq (overlay-get ov 'invisible)
(setq ov (make-overlay start end)) 'org-babel-hide-result)
(overlay-put ov 'invisible 'org-babel-hide-result) (delete-overlay ov)))
;; make the block accessible to isearch (overlays-at start)))
(overlay-put (setq ov (make-overlay start end))
ov 'isearch-open-invisible (overlay-put ov 'invisible 'org-babel-hide-result)
(lambda (ov) ;; make the block accessible to isearch
(when (member ov org-babel-hide-result-overlays) (overlay-put
(setq org-babel-hide-result-overlays ov 'isearch-open-invisible
(delq ov org-babel-hide-result-overlays))) (lambda (ov)
(when (eq (overlay-get ov 'invisible) (when (member ov org-babel-hide-result-overlays)
'org-babel-hide-result) (setq org-babel-hide-result-overlays
(delete-overlay ov)))) (delq ov org-babel-hide-result-overlays)))
(push ov org-babel-hide-result-overlays))) (when (eq (overlay-get ov 'invisible)
(error "Not looking at a result line")))) 'org-babel-hide-result)
(delete-overlay ov))))
(push ov org-babel-hide-result-overlays)))))
;; org-tab-after-check-for-cycling-hook ;; org-tab-after-check-for-cycling-hook
(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) (add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
@ -1657,7 +1672,8 @@ Note: this function removes any hlines in TABLE."
(mapcar (lambda (row) (mapcar (lambda (row)
(if (listp row) (if (listp row)
(cons (or (pop rownames) "") row) (cons (or (pop rownames) "") row)
row)) table) row))
table)
table)) table))
(defun org-babel-pick-name (names selector) (defun org-babel-pick-name (names selector)
@ -1882,9 +1898,9 @@ region is not active then the point is demarcated."
(block (and start (match-string 0))) (block (and start (match-string 0)))
(headers (and start (match-string 4))) (headers (and start (match-string 4)))
(stars (concat (make-string (or (org-current-level) 1) ?*) " ")) (stars (concat (make-string (or (org-current-level) 1) ?*) " "))
(lower-case-p (and block (upper-case-p (and block
(let (case-fold-search) (let (case-fold-search)
(string-match-p "#\\+begin_src" block))))) (string-match-p "#\\+BEGIN_SRC" block)))))
(if info (if info
(mapc (mapc
(lambda (place) (lambda (place)
@ -1898,9 +1914,9 @@ region is not active then the point is demarcated."
(delete-region (point-at-bol) (point-at-eol))) (delete-region (point-at-bol) (point-at-eol)))
(insert (concat (insert (concat
(if (looking-at "^") "" "\n") (if (looking-at "^") "" "\n")
indent (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n") indent (if upper-case-p "#+END_SRC\n" "#+end_src\n")
(if arg stars indent) "\n" (if arg stars indent) "\n"
indent (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ") indent (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
lang lang
(if (> (length headers) 1) (if (> (length headers) 1)
(concat " " headers) headers) (concat " " headers) headers)
@ -1921,14 +1937,16 @@ region is not active then the point is demarcated."
(if (org-region-active-p) (mark) (point)) (point)))) (if (org-region-active-p) (mark) (point)) (point))))
(insert (concat (if (looking-at "^") "" "\n") (insert (concat (if (looking-at "^") "" "\n")
(if arg (concat stars "\n") "") (if arg (concat stars "\n") "")
(funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ") (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
lang "\n" lang "\n" body
body
(if (or (= (length body) 0) (if (or (= (length body) 0)
(string-suffix-p "\r" body) (string-suffix-p "\r" body)
(string-suffix-p "\n" body)) "" "\n") (string-suffix-p "\n" body))
(funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n"))) ""
(goto-char start) (move-end-of-line 1))))) "\n")
(if upper-case-p "#+END_SRC\n" "#+end_src\n")))
(goto-char start)
(move-end-of-line 1)))))
(defun org-babel--insert-results-keyword (name hash) (defun org-babel--insert-results-keyword (name hash)
"Insert RESULTS keyword with NAME value at point. "Insert RESULTS keyword with NAME value at point.
@ -1941,7 +1959,7 @@ the results hash, or nil. Leave point before the keyword."
(cond ((not hash) nil) (cond ((not hash) nil)
(org-babel-hash-show-time (org-babel-hash-show-time
(format "[%s %s]" (format "[%s %s]"
(format-time-string "<%F %T>") (format-time-string "(%F %T)")
hash)) hash))
(t (format "[%s]" hash))) (t (format "[%s]" hash)))
":" ":"
@ -1967,7 +1985,7 @@ point, along with related contents. Do nothing if HASH is nil.
Return a non-nil value if results were cleared. In this case, Return a non-nil value if results were cleared. In this case,
leave point where new results should be inserted." leave point where new results should be inserted."
(when hash (when hash
(looking-at org-babel-result-regexp) (let ((case-fold-search t)) (looking-at org-babel-result-regexp))
(unless (string= (match-string 1) hash) (unless (string= (match-string 1) hash)
(let* ((e (org-element-at-point)) (let* ((e (org-element-at-point))
(post (copy-marker (org-element-property :post-affiliated e)))) (post (copy-marker (org-element-property :post-affiliated e))))
@ -2374,13 +2392,58 @@ INFO may provide the values of these header arguments (in the
(org-babel-chomp result "\n")))) (org-babel-chomp result "\n"))))
(t (goto-char beg) (insert result))) (t (goto-char beg) (insert result)))
(setq end (copy-marker (point) t)) (setq end (copy-marker (point) t))
;; possibly wrap result ;; Possibly wrap result.
(cond (cond
((assq :wrap (nth 2 info)) ((assq :wrap (nth 2 info))
(let ((name (or (cdr (assq :wrap (nth 2 info))) "results"))) (let* ((full (or (cdr (assq :wrap (nth 2 info))) "results"))
(funcall wrap (concat "#+begin_" name) (split (split-string full))
(concat "#+end_" (car (split-string name))) (type (car split))
nil nil (concat "{{{results(@@" name ":") "@@)}}}"))) (opening-line (concat "#+begin_" full))
(closing-line (concat "#+end_" type)))
(cond
;; Escape contents from "export" wrap. Wrap
;; inline results within an export snippet with
;; appropriate value.
((eq t (compare-strings type nil nil "export" nil nil t))
(let ((backend (pcase split
(`(,_) "none")
(`(,_ ,b . ,_) b))))
(funcall wrap
opening-line closing-line
nil nil
(format "{{{results(@@%s:"
backend) "@@)}}}")))
;; Escape contents from "example" wrap. Mark
;; inline results as verbatim.
((eq t (compare-strings type nil nil "example" nil nil t))
(funcall wrap
opening-line closing-line
nil nil
"{{{results(=" "=)}}}"))
;; Escape contents from "src" wrap. Mark
;; inline results as inline source code.
((eq t (compare-strings type nil nil "src" nil nil t))
(let ((inline-open
(pcase split
(`(,_)
"{{{results(src_none{")
(`(,_ ,language)
(format "{{{results(src_%s{" language))
(`(,_ ,language . ,rest)
(let ((r (mapconcat #'identity rest " ")))
(format "{{{results(src_%s[%s]{"
language r))))))
(funcall wrap
opening-line closing-line
nil nil
inline-open "})}}}")))
;; Do not escape contents in non-verbatim
;; blocks. Return plain inline results.
(t
(funcall wrap
opening-line closing-line
t nil
"{{{results(" ")}}}")))))
((member "html" result-params) ((member "html" result-params)
(funcall wrap "#+begin_export html" "#+end_export" nil nil (funcall wrap "#+begin_export html" "#+end_export" nil nil
"{{{results(@@html:" "@@)}}}")) "{{{results(@@html:" "@@)}}}"))
@ -2436,11 +2499,12 @@ INFO may provide the values of these header arguments (in the
(defun org-babel-remove-result (&optional info keep-keyword) (defun org-babel-remove-result (&optional info keep-keyword)
"Remove the result of the current source block." "Remove the result of the current source block."
(interactive) (interactive)
(let ((location (org-babel-where-is-src-block-result nil info))) (let ((location (org-babel-where-is-src-block-result nil info))
(case-fold-search t))
(when location (when location
(save-excursion (save-excursion
(goto-char location) (goto-char location)
(when (looking-at (concat org-babel-result-regexp ".*$")) (when (looking-at org-babel-result-regexp)
(delete-region (delete-region
(if keep-keyword (line-beginning-position 2) (if keep-keyword (line-beginning-position 2)
(save-excursion (save-excursion
@ -2713,118 +2777,110 @@ would set the value of argument \"a\" equal to \"9\". Note that
these arguments are not evaluated in the current source-code these arguments are not evaluated in the current source-code
block but are passed literally to the \"example-block\"." block but are passed literally to the \"example-block\"."
(let* ((parent-buffer (or parent-buffer (current-buffer))) (let* ((parent-buffer (or parent-buffer (current-buffer)))
(info (or info (org-babel-get-src-block-info 'light))) (info (or info (org-babel-get-src-block-info 'light)))
(lang (nth 0 info)) (lang (nth 0 info))
(body (nth 1 info)) (body (nth 1 info))
(ob-nww-start org-babel-noweb-wrap-start) (comment (string= "noweb" (cdr (assq :comments (nth 2 info)))))
(ob-nww-end org-babel-noweb-wrap-end) (noweb-re (format "^\\(.*?\\)\\(%s\\)"
(new-body "") (with-current-buffer parent-buffer
(nb-add (lambda (text) (setq new-body (concat new-body text)))) (org-babel-noweb-wrap))))
index source-name evaluate prefix) (cache nil)
(with-temp-buffer (c-wrap
(setq-local org-babel-noweb-wrap-start ob-nww-start) (lambda (s)
(setq-local org-babel-noweb-wrap-end ob-nww-end) ;; Comment string S, according to LANG mode. Return new
(insert body) (goto-char (point-min)) ;; string.
(setq index (point)) (unless org-babel-tangle-uncomment-comments
(while (and (re-search-forward (org-babel-noweb-wrap) nil t)) (with-temp-buffer
(save-match-data (setf source-name (match-string 1))) (funcall (org-src-get-lang-mode lang))
(save-match-data (setq evaluate (string-match "(.*)" source-name))) (comment-region (point)
(save-match-data (progn (insert s) (point)))
(setq prefix (org-trim (buffer-string))))))
(buffer-substring (match-beginning 0) (expand-body
(save-excursion (lambda (i)
(beginning-of-line 1) (point))))) ;; Expand body of code represented by block info I.
;; add interval to new-body (removing noweb reference) (let ((b (if (org-babel-noweb-p (nth 2 i) :eval)
(goto-char (match-beginning 0)) (org-babel-expand-noweb-references i)
(funcall nb-add (buffer-substring index (point))) (nth 1 i))))
(goto-char (match-end 0)) (if (not comment) b
(setq index (point)) (let ((cs (org-babel-tangle-comment-links i)))
(funcall (concat (funcall c-wrap (car cs)) "\n"
nb-add b "\n"
(with-current-buffer parent-buffer (funcall c-wrap (cadr cs))))))))
(save-restriction (expand-references
(widen) (lambda (ref cache)
(mapconcat ;; Interpose PREFIX between every line. (pcase (gethash ref cache)
#'identity (`(,last . ,previous)
(split-string ;; Ignore separator for last block.
(if evaluate (let ((strings (list (funcall expand-body last))))
(let ((raw (org-babel-ref-resolve source-name))) (dolist (i previous)
(if (stringp raw) raw (format "%S" raw))) (let ((parameters (nth 2 i)))
(or ;; Since we're operating in reverse order, first
;; Retrieve from the Library of Babel. ;; push separator, then body.
(nth 2 (assoc-string source-name org-babel-library-of-babel)) (push (or (cdr (assq :noweb-sep parameters)) "\n")
;; Return the contents of headlines literally. strings)
(save-excursion (push (funcall expand-body i) strings)))
(when (org-babel-ref-goto-headline-id source-name) (mapconcat #'identity strings "")))
(org-babel-ref-headline-body))) ;; Raise an error about missing reference, or return the
;; Find the expansion of reference in this buffer. ;; empty string.
(save-excursion ((guard (or org-babel-noweb-error-all-langs
(goto-char (point-min)) (member lang org-babel-noweb-error-langs)))
(let* ((name-regexp (error "Cannot resolve %s (see `org-babel-noweb-error-langs')"
(org-babel-named-src-block-regexp-for-name (org-babel-noweb-wrap ref)))
source-name)) (_ "")))))
(comment (replace-regexp-in-string
(string= "noweb" noweb-re
(cdr (assq :comments (nth 2 info))))) (lambda (m)
(c-wrap (with-current-buffer parent-buffer
(lambda (s) (save-match-data
;; Comment, according to LANG mode, (let* ((prefix (match-string 1 m))
;; string S. Return new string. (id (match-string 3 m))
(unless org-babel-tangle-uncomment-comments (evaluate (string-match-p "(.*)" id))
(with-temp-buffer (expansion
(funcall (org-src-get-lang-mode lang)) (cond
(comment-region (point) (evaluate
(progn (insert s) (point))) ;; Evaluation can potentially modify the buffer
(org-trim (buffer-string)))))) ;; and invalidate the cache: reset it.
(expand-body (setq cache nil)
(lambda (i) (let ((raw (org-babel-ref-resolve id)))
;; Expand body of code blocked (if (stringp raw) raw (format "%S" raw))))
;; represented by block info I. ;; Retrieve from the Library of Babel.
(let ((b (if (org-babel-noweb-p (nth 2 i) :eval) ((nth 2 (assoc-string id org-babel-library-of-babel)))
(org-babel-expand-noweb-references i) ;; Return the contents of headlines literally.
(nth 1 i)))) ((org-babel-ref-goto-headline-id id)
(if (not comment) b (org-babel-ref-headline-body))
(let ((cs (org-babel-tangle-comment-links i))) ;; Look for a source block named SOURCE-NAME. If
(concat (funcall c-wrap (car cs)) "\n" ;; found, assume it is unique; do not look after
b "\n" ;; `:noweb-ref' header argument.
(funcall c-wrap (cadr cs))))))))) ((org-with-point-at 1
(if (and (re-search-forward name-regexp nil t) (let ((r (org-babel-named-src-block-regexp-for-name id)))
(not (org-in-commented-heading-p))) (and (re-search-forward r nil t)
;; Found a source block named SOURCE-NAME. (not (org-in-commented-heading-p))
;; Assume it is unique; do not look after (funcall expand-body
;; `:noweb-ref' header argument. (org-babel-get-src-block-info t))))))
(funcall expand-body ;; All Noweb references were cached in a previous
(org-babel-get-src-block-info 'light)) ;; run. Extract the information from the cache.
;; Though luck. We go into the long process ((hash-table-p cache)
;; of checking each source block and expand (funcall expand-references id cache))
;; those with a matching Noweb reference. ;; Though luck. We go into the long process of
(let ((expansion nil)) ;; checking each source block and expand those
(org-babel-map-src-blocks nil ;; with a matching Noweb reference. Since we're
(unless (org-in-commented-heading-p) ;; going to visit all source blocks in the
(let* ((info ;; document, cache information about them as well.
(org-babel-get-src-block-info 'light)) (t
(parameters (nth 2 info))) (setq cache (make-hash-table :test #'equal))
(when (equal source-name (org-with-wide-buffer
(cdr (assq :noweb-ref parameters))) (org-babel-map-src-blocks nil
(push (funcall expand-body info) expansion) (if (org-in-commented-heading-p)
(push (or (cdr (assq :noweb-sep parameters)) (org-forward-heading-same-level nil t)
"\n") (let* ((info (org-babel-get-src-block-info t))
expansion))))) (ref (cdr (assq :noweb-ref (nth 2 info)))))
(when expansion (push info (gethash ref cache))))))
(mapconcat #'identity (funcall expand-references id cache)))))
(nreverse (cdr expansion)) ;; Interpose PREFIX between every line.
"")))))) (mapconcat #'identity
;; Possibly raise an error if named block doesn't exist. (split-string expansion "[\n\r]")
(if (or org-babel-noweb-error-all-langs (concat "\n" prefix))))))
(member lang org-babel-noweb-error-langs)) body t t 2)))
(error "%s could not be resolved (see \
`org-babel-noweb-error-langs')"
(org-babel-noweb-wrap source-name))
"")))
"[\n\r]")
(concat "\n" prefix))))))
(funcall nb-add (buffer-substring index (point-max))))
new-body))
(defun org-babel--script-escape-inner (str) (defun org-babel--script-escape-inner (str)
(let (in-single in-double backslash out) (let (in-single in-double backslash out)
@ -2938,7 +2994,8 @@ situations in which is it not appropriate."
(defun org-babel--string-to-number (string) (defun org-babel--string-to-number (string)
"If STRING represents a number return its value. "If STRING represents a number return its value.
Otherwise return nil." Otherwise return nil."
(unless (string-match-p "\\s-" (org-trim string)) (unless (or (string-match-p "\\s-" (org-trim string))
(not (string-match-p "^[0-9-e.+ ]+$" string)))
(let ((interned-string (ignore-errors (read string)))) (let ((interned-string (ignore-errors (read string))))
(when (numberp interned-string) (when (numberp interned-string)
interned-string)))) interned-string))))
@ -2946,24 +3003,32 @@ Otherwise return nil."
(defun org-babel-import-elisp-from-file (file-name &optional separator) (defun org-babel-import-elisp-from-file (file-name &optional separator)
"Read the results located at FILE-NAME into an elisp table. "Read the results located at FILE-NAME into an elisp table.
If the table is trivial, then return it as a scalar." If the table is trivial, then return it as a scalar."
(save-window-excursion (let ((result
(let ((result (with-temp-buffer
(with-temp-buffer (condition-case err
(condition-case err (progn
(progn (insert-file-contents file-name)
(org-table-import file-name separator) (delete-file file-name)
(delete-file file-name) (let ((pmax (point-max)))
(delq nil ;; If the file was empty, don't bother trying to
(mapcar (lambda (row) ;; convert the table.
(and (not (eq row 'hline)) (when (> pmax 1)
(mapcar #'org-babel-string-read row))) (org-table-convert-region (point-min) pmax separator)
(org-table-to-lisp)))) (delq nil
(error (message "Error reading results: %s" err) nil))))) (mapcar (lambda (row)
(pcase result (and (not (eq row 'hline))
(`((,scalar)) scalar) (mapcar #'org-babel-string-read row)))
(`((,_ ,_ . ,_)) result) (org-table-to-lisp))))))
(`(,scalar) scalar) (error
(_ result))))) (display-warning 'org-babel
(format "Error reading results: %S" err)
:error)
nil)))))
(pcase result
(`((,scalar)) scalar)
(`((,_ ,_ . ,_)) result)
(`(,scalar) scalar)
(_ result))))
(defun org-babel-string-read (cell) (defun org-babel-string-read (cell)
"Strip nested \"s from around strings." "Strip nested \"s from around strings."
@ -3062,11 +3127,8 @@ of `org-babel-temporary-directory'."
(if (eq t (car (file-attributes file))) (if (eq t (car (file-attributes file)))
(delete-directory file) (delete-directory file)
(delete-file file))) (delete-file file)))
;; We do not want to delete "." and "..".
(directory-files org-babel-temporary-directory 'full (directory-files org-babel-temporary-directory 'full
;; Note: Use `any' for compatibility directory-files-no-dot-files-regexp))
;; with Emacs < 27.
(rx (or (not (any ".")) "..."))))
(delete-directory org-babel-temporary-directory)) (delete-directory org-babel-temporary-directory))
(error (error
(message "Failed to remove temporary Org-babel directory %s" (message "Failed to remove temporary Org-babel directory %s"

View File

@ -43,6 +43,4 @@ CSS does not support sessions."
(provide 'ob-css) (provide 'ob-css)
;;; ob-css.el ends here ;;; ob-css.el ends here

View File

@ -119,6 +119,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-ditaa) (provide 'ob-ditaa)
;;; ob-ditaa.el ends here ;;; ob-ditaa.el ends here

View File

@ -87,6 +87,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-dot) (provide 'ob-dot)
;;; ob-dot.el ends here ;;; ob-dot.el ends here

View File

@ -5,7 +5,6 @@
;; Author: Michael Gauland ;; Author: Michael Gauland
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org ;; Homepage: https://orgmode.org
;; Version: 1.00
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -24,18 +23,18 @@
;;; Commentary: ;;; Commentary:
;;; Org-Babel support for using ebnf2ps to generate encapsulated postscript ;; Org-Babel support for using ebnf2ps to generate encapsulated postscript
;;; railroad diagrams. It recognizes these arguments: ;; railroad diagrams. It recognizes these arguments:
;;; ;;
;;; :file is required; it must include the extension '.eps.' All the rules ;; :file is required; it must include the extension '.eps.' All the rules
;;; in the block will be drawn in the same file. This is done by ;; in the block will be drawn in the same file. This is done by
;;; inserting a '[<file>' comment at the start of the block (see the ;; inserting a '[<file>' comment at the start of the block (see the
;;; documentation for ebnf-eps-buffer for more information). ;; documentation for ebnf-eps-buffer for more information).
;;; ;;
;;; :style specifies a value in ebnf-style-database. This provides the ;; :style specifies a value in ebnf-style-database. This provides the
;;; ability to customize the output. The style can also specify the ;; ability to customize the output. The style can also specify the
;;; grammar syntax (by setting ebnf-syntax); note that only ebnf, ;; grammar syntax (by setting ebnf-syntax); note that only ebnf,
;;; iso-ebnf, and yacc are supported by this file. ;; iso-ebnf, and yacc are supported by this file.
;;; Requirements: ;;; Requirements:
@ -78,4 +77,5 @@ This function is called by `org-babel-execute-src-block'."
result))) result)))
(provide 'ob-ebnf) (provide 'ob-ebnf)
;;; ob-ebnf.el ends here ;;; ob-ebnf.el ends here

View File

@ -61,31 +61,30 @@ by `org-edit-src-code'.")
(defun org-babel-execute:emacs-lisp (body params) (defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with Babel." "Execute a block of emacs-lisp code with Babel."
(save-window-excursion (let* ((lexical (cdr (assq :lexical params)))
(let* ((lexical (cdr (assq :lexical params))) (result-params (cdr (assq :result-params params)))
(result-params (cdr (assq :result-params params))) (body (format (if (member "output" result-params)
(body (format (if (member "output" result-params) "(with-output-to-string %s\n)"
"(with-output-to-string %s\n)" "(progn %s\n)")
"(progn %s\n)") (org-babel-expand-body:emacs-lisp body params)))
(org-babel-expand-body:emacs-lisp body params))) (result (eval (read (if (or (member "code" result-params)
(result (eval (read (if (or (member "code" result-params) (member "pp" result-params))
(member "pp" result-params)) (concat "(pp " body ")")
(concat "(pp " body ")") body))
body)) (org-babel-emacs-lisp-lexical lexical))))
(org-babel-emacs-lisp-lexical lexical)))) (org-babel-result-cond result-params
(org-babel-result-cond result-params (let ((print-level nil)
(let ((print-level nil) (print-length nil))
(print-length nil)) (if (or (member "scalar" result-params)
(if (or (member "scalar" result-params) (member "verbatim" result-params))
(member "verbatim" result-params)) (format "%S" result)
(format "%S" result) (format "%s" result)))
(format "%s" result))) (org-babel-reassemble-table
(org-babel-reassemble-table result
result (org-babel-pick-name (cdr (assq :colname-names params))
(org-babel-pick-name (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(cdr (assq :colnames params))) (org-babel-pick-name (cdr (assq :rowname-names params))
(org-babel-pick-name (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(cdr (assq :rownames params))))))))
(defun org-babel-emacs-lisp-lexical (lexical) (defun org-babel-emacs-lisp-lexical (lexical)
"Interpret :lexical source block argument. "Interpret :lexical source block argument.
@ -108,6 +107,4 @@ corresponding :lexical source block argument."
(provide 'ob-emacs-lisp) (provide 'ob-emacs-lisp)
;;; ob-emacs-lisp.el ends here ;;; ob-emacs-lisp.el ends here

View File

@ -144,6 +144,4 @@ This buffer is named by `org-babel-error-buffer-name'."
(provide 'ob-eval) (provide 'ob-eval)
;;; ob-eval.el ends here ;;; ob-eval.el ends here

View File

@ -33,6 +33,7 @@
(declare-function org-escape-code-in-string "org-src" (s)) (declare-function org-escape-code-in-string "org-src" (s))
(declare-function org-export-copy-buffer "ox" ()) (declare-function org-export-copy-buffer "ox" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-in-archived-heading-p "org" (&optional no-inheritance))
(defvar org-src-preserve-indentation) (defvar org-src-preserve-indentation)
@ -157,7 +158,8 @@ this template."
;; encountered. ;; encountered.
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
(unless (save-match-data (org-in-commented-heading-p)) (unless (save-match-data (or (org-in-commented-heading-p)
(org-in-archived-heading-p)))
(let* ((object? (match-end 1)) (let* ((object? (match-end 1))
(element (save-match-data (element (save-match-data
(if object? (org-element-context) (if object? (org-element-context)
@ -406,7 +408,6 @@ inhibit insertion of results into the buffer."
(let (org-confirm-babel-evaluate) (let (org-confirm-babel-evaluate)
(org-babel-execute-src-block nil info))))))))) (org-babel-execute-src-block nil info)))))))))
(provide 'ob-exp) (provide 'ob-exp)
;;; ob-exp.el ends here ;;; ob-exp.el ends here

View File

@ -76,7 +76,8 @@ This function is called by `org-babel-execute-src-block'."
;; Report errors. ;; Report errors.
(org-babel-eval-error-notify 1 (org-babel-eval-error-notify 1
(buffer-substring (buffer-substring
(+ (match-beginning 0) 1) (point-max))) nil)))) (+ (match-beginning 0) 1) (point-max)))
nil))))
(split-string (org-trim (split-string (org-trim
(org-babel-expand-body:generic body params)) (org-babel-expand-body:generic body params))
"\n" "\n"

View File

@ -101,12 +101,13 @@ its header arguments."
(concat (concat
;; variables ;; variables
(mapconcat 'org-babel-fortran-var-to-fortran vars "\n") (mapconcat 'org-babel-fortran-var-to-fortran vars "\n")
body) params) body)
params)
body) "\n") "\n"))) body) "\n") "\n")))
(defun org-babel-fortran-ensure-main-wrap (body params) (defun org-babel-fortran-ensure-main-wrap (body params)
"Wrap body in a \"program ... end program\" block if none exists." "Wrap body in a \"program ... end program\" block if none exists."
(if (string-match "^[ \t]*program[ \t]*.*" (capitalize body)) (if (string-match "^[ \t]*program\\>" (capitalize body))
(let ((vars (org-babel--get-vars params))) (let ((vars (org-babel--get-vars params)))
(when vars (error "Cannot use :vars if `program' statement is present")) (when vars (error "Cannot use :vars if `program' statement is present"))
body) body)

View File

@ -278,6 +278,4 @@ Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
(provide 'ob-gnuplot) (provide 'ob-gnuplot)
;;; ob-gnuplot.el ends here ;;; ob-gnuplot.el ends here

View File

@ -65,7 +65,6 @@ This function is called by `org-babel-execute-src-block'."
(cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defvar org-babel-groovy-wrapper-method (defvar org-babel-groovy-wrapper-method
"class Runner extends Script { "class Runner extends Script {
def out = new PrintWriter(new ByteArrayOutputStream()) def out = new PrintWriter(new ByteArrayOutputStream())
def run() { %s } def run() { %s }
@ -74,7 +73,6 @@ This function is called by `org-babel-execute-src-block'."
println(new Runner().run()) println(new Runner().run())
") ")
(defun org-babel-groovy-evaluate (defun org-babel-groovy-evaluate
(session body &optional result-type result-params) (session body &optional result-type result-params)
"Evaluate BODY in external Groovy process. "Evaluate BODY in external Groovy process.
@ -111,6 +109,4 @@ supported in Groovy."
(provide 'ob-groovy) (provide 'ob-groovy)
;;; ob-groovy.el ends here ;;; ob-groovy.el ends here

View File

@ -23,20 +23,19 @@
;;; Commentary: ;;; Commentary:
;; Org-Babel support for evaluating haskell source code. This one will ;; Org Babel support for evaluating Haskell source code.
;; be sort of tricky because haskell programs must be compiled before ;; Haskell programs must be compiled before
;; they can be run, but haskell code can also be run through an ;; they can be run, but haskell code can also be run through an
;; interactive interpreter. ;; interactive interpreter.
;; ;;
;; For now lets only allow evaluation using the haskell interpreter. ;; By default we evaluate using the Haskell interpreter.
;; To use the compiler, specify :compile yes in the header.
;;; Requirements: ;;; Requirements:
;; - haskell-mode :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode ;; - haskell-mode: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
;; ;; - inf-haskell: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
;; - inf-haskell :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode ;; - (optionally) lhs2tex: http://people.cs.uu.nl/andres/lhs2tex/
;;
;; - (optionally) lhs2tex :: http://people.cs.uu.nl/andres/lhs2tex/
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
@ -47,6 +46,7 @@
(declare-function run-haskell "ext:inf-haskell" (&optional arg)) (declare-function run-haskell "ext:inf-haskell" (&optional arg))
(declare-function inferior-haskell-load-file (declare-function inferior-haskell-load-file
"ext:inf-haskell" (&optional reload)) "ext:inf-haskell" (&optional reload))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(defvar org-babel-tangle-lang-exts) (defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) (add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs"))
@ -60,8 +60,63 @@
(defvar haskell-prompt-regexp) (defvar haskell-prompt-regexp)
(defun org-babel-execute:haskell (body params) (defcustom org-babel-haskell-compiler "ghc"
"Execute a block of Haskell code." "Command used to compile a Haskell source code file into an executable.
May be either a command in the path, like \"ghc\" or an absolute
path name, like \"/usr/local/bin/ghc\". The command can include
a parameter, such as \"ghc -v\"."
:group 'org-babel
:package-version '(Org "9.4")
:type 'string)
(defconst org-babel-header-args:haskell '(compile . :any)
"Haskell-specific header arguments.")
(defun org-babel-haskell-execute (body params)
"This function should only be called by `org-babel-execute:haskell'"
(let* ((tmp-src-file (org-babel-temp-file "Haskell-src-" ".hs"))
(tmp-bin-file
(org-babel-process-file-name
(org-babel-temp-file "Haskell-bin-" org-babel-exeext)))
(cmdline (cdr (assq :cmdline params)))
(cmdline (if cmdline (concat " " cmdline) ""))
(flags (cdr (assq :flags params)))
(flags (mapconcat #'identity
(if (listp flags)
flags
(list flags))
" "))
(libs (org-babel-read
(or (cdr (assq :libs params))
(org-entry-get nil "libs" t))
nil))
(libs (mapconcat #'identity
(if (listp libs) libs (list libs))
" ")))
(with-temp-file tmp-src-file (insert body))
(org-babel-eval
(format "%s -o %s %s %s %s"
org-babel-haskell-compiler
tmp-bin-file
flags
(org-babel-process-file-name tmp-src-file)
libs)
"")
(let ((results (org-babel-eval (concat tmp-bin-file cmdline) "")))
(when results
(setq results (org-trim (org-remove-indentation results)))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results t)
(let ((tmp-file (org-babel-temp-file "Haskell-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))
(org-babel-pick-name
(cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
(cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))))
(defun org-babel-interpret-haskell (body params)
(require 'inf-haskell) (require 'inf-haskell)
(add-hook 'inferior-haskell-hook (add-hook 'inferior-haskell-hook
(lambda () (lambda ()
@ -87,7 +142,7 @@
(org-babel-reassemble-table (org-babel-reassemble-table
(let ((result (let ((result
(pcase result-type (pcase result-type
(`output (mapconcat #'identity (reverse (cdr results)) "\n")) (`output (mapconcat #'identity (reverse results) "\n"))
(`value (car results))))) (`value (car results)))))
(org-babel-result-cond (cdr (assq :result-params params)) (org-babel-result-cond (cdr (assq :result-params params))
result (org-babel-script-escape result))) result (org-babel-script-escape result)))
@ -96,6 +151,13 @@
(org-babel-pick-name (cdr (assq :rowname-names params)) (org-babel-pick-name (cdr (assq :rowname-names params))
(cdr (assq :rowname-names params)))))) (cdr (assq :rowname-names params))))))
(defun org-babel-execute:haskell (body params)
"Execute a block of Haskell code."
(let ((compile (string= "yes" (cdr (assq :compile params)))))
(if (not compile)
(org-babel-interpret-haskell body params)
(org-babel-haskell-execute body params))))
(defun org-babel-haskell-initiate-session (&optional _session _params) (defun org-babel-haskell-initiate-session (&optional _session _params)
"Initiate a haskell session. "Initiate a haskell session.
If there is not a current inferior-process-buffer in SESSION If there is not a current inferior-process-buffer in SESSION
@ -215,6 +277,4 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(provide 'ob-haskell) (provide 'ob-haskell)
;;; ob-haskell.el ends here ;;; ob-haskell.el ends here

View File

@ -30,6 +30,8 @@
;; probably ~/.hledger.journal (it may not notice your $LEDGER_FILE env var). ;; probably ~/.hledger.journal (it may not notice your $LEDGER_FILE env var).
;; So make ~/.hledger.journal a symbolic link to the real file if necessary. ;; So make ~/.hledger.journal a symbolic link to the real file if necessary.
;; TODO Unit tests are more than welcome, too.
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
@ -64,7 +66,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-hledger) (provide 'ob-hledger)
;;; ob-hledger.el ends here ;;; ob-hledger.el ends here
;; TODO Unit tests are more than welcome, too.

View File

@ -90,7 +90,6 @@ in BODY as elisp."
raw raw
(org-babel-script-escape raw))))))) (org-babel-script-escape raw)))))))
(defun org-babel-prep-session:io (_session _params) (defun org-babel-prep-session:io (_session _params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not (yet) supported for Io")) (error "Sessions are not (yet) supported for Io"))
@ -103,6 +102,4 @@ supported in Io."
(provide 'ob-io) (provide 'ob-io)
;;; ob-io.el ends here ;;; ob-io.el ends here

View File

@ -58,6 +58,7 @@ parameters may be used, like javac -verbose"
(src-file (concat classname ".java")) (src-file (concat classname ".java"))
(cmpflag (or (cdr (assq :cmpflag params)) "")) (cmpflag (or (cdr (assq :cmpflag params)) ""))
(cmdline (or (cdr (assq :cmdline params)) "")) (cmdline (or (cdr (assq :cmdline params)) ""))
(cmdargs (or (cdr (assq :cmdargs params)) ""))
(full-body (org-babel-expand-body:generic body params))) (full-body (org-babel-expand-body:generic body params)))
(with-temp-file src-file (insert full-body)) (with-temp-file src-file (insert full-body))
(org-babel-eval (org-babel-eval
@ -66,7 +67,7 @@ parameters may be used, like javac -verbose"
(unless (or (not packagename) (file-exists-p packagename)) (unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents)) (make-directory packagename 'parents))
(let ((results (org-babel-eval (concat org-babel-java-command (let ((results (org-babel-eval (concat org-babel-java-command
" " cmdline " " classname) ""))) " " cmdline " " classname " " cmdargs) "")))
(org-babel-reassemble-table (org-babel-reassemble-table
(org-babel-result-cond (cdr (assq :result-params params)) (org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results t) (org-babel-read results t)
@ -80,6 +81,4 @@ parameters may be used, like javac -verbose"
(provide 'ob-java) (provide 'ob-java)
;;; ob-java.el ends here ;;; ob-java.el ends here

View File

@ -201,6 +201,4 @@ then create. Return the initialized session."
(provide 'ob-js) (provide 'ob-js)
;;; ob-js.el ends here ;;; ob-js.el ends here

View File

@ -84,7 +84,8 @@
(regexp-quote (format "%S" (car pair))) (regexp-quote (format "%S" (car pair)))
(if (stringp (cdr pair)) (if (stringp (cdr pair))
(cdr pair) (format "%S" (cdr pair))) (cdr pair) (format "%S" (cdr pair)))
body))) (org-babel--get-vars params)) body)))
(org-babel--get-vars params))
(org-trim body)) (org-trim body))
(defun org-babel-execute:latex (body params) (defun org-babel-execute:latex (body params)
@ -224,6 +225,6 @@ This function is called by `org-babel-execute-src-block'."
"Return an error because LaTeX doesn't support sessions." "Return an error because LaTeX doesn't support sessions."
(error "LaTeX does not support sessions")) (error "LaTeX does not support sessions"))
(provide 'ob-latex) (provide 'ob-latex)
;;; ob-latex.el ends here ;;; ob-latex.el ends here

View File

@ -65,6 +65,4 @@ called by `org-babel-execute-src-block'."
(provide 'ob-ledger) (provide 'ob-ledger)
;;; ob-ledger.el ends here ;;; ob-ledger.el ends here

View File

@ -205,7 +205,7 @@ If error in compilation, attempt to mark the error in lilypond org file."
(delete-file org-babel-lilypond-temp-file)) (delete-file org-babel-lilypond-temp-file))
(rename-file org-babel-lilypond-tangled-file (rename-file org-babel-lilypond-tangled-file
org-babel-lilypond-temp-file)) org-babel-lilypond-temp-file))
(switch-to-buffer-other-window "*lilypond*") (org-switch-to-buffer-other-window "*lilypond*")
(erase-buffer) (erase-buffer)
(org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file) (org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file)
(goto-char (point-min)) (goto-char (point-min))
@ -262,7 +262,7 @@ FILE-NAME is full path to lilypond file."
"Mark the erroneous lines in the lilypond org buffer. "Mark the erroneous lines in the lilypond org buffer.
FILE-NAME is full path to lilypond file. FILE-NAME is full path to lilypond file.
LINE is the erroneous line." LINE is the erroneous line."
(switch-to-buffer-other-window (org-switch-to-buffer-other-window
(concat (file-name-nondirectory (concat (file-name-nondirectory
(org-babel-lilypond-switch-extension file-name ".org")))) (org-babel-lilypond-switch-extension file-name ".org"))))
(let ((temp (point))) (let ((temp (point)))
@ -391,7 +391,8 @@ If TEST is non-nil, the shell command is returned and is not run."
(defun org-babel-lilypond-switch-extension (file-name ext) (defun org-babel-lilypond-switch-extension (file-name ext)
"Utility command to swap current FILE-NAME extension with EXT." "Utility command to swap current FILE-NAME extension with EXT."
(concat (file-name-sans-extension (concat (file-name-sans-extension
file-name) ext)) file-name)
ext))
(defun org-babel-lilypond-get-header-args (mode) (defun org-babel-lilypond-get-header-args (mode)
"Default arguments to use when evaluating a lilypond source block. "Default arguments to use when evaluating a lilypond source block.

View File

@ -122,6 +122,4 @@ a property list containing the parameters of the block."
(provide 'ob-lisp) (provide 'ob-lisp)
;;; ob-lisp.el ends here ;;; ob-lisp.el ends here

View File

@ -107,7 +107,8 @@ VARS contains resolved variable references."
(org-babel-comint-in-buffer session (org-babel-comint-in-buffer session
(mapc (lambda (var) (mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input) (end-of-line 1) (insert var) (comint-send-input)
(org-babel-comint-wait-for-output session)) var-lines)) (org-babel-comint-wait-for-output session))
var-lines))
session)) session))
(defun org-babel-load-session:lua (session body params) (defun org-babel-load-session:lua (session body params)
@ -397,6 +398,4 @@ fd:close()"
(provide 'ob-lua) (provide 'ob-lua)
;;; ob-lua.el ends here ;;; ob-lua.el ends here

View File

@ -43,6 +43,4 @@ does not support sessions."
(provide 'ob-makefile) (provide 'ob-makefile)
;;; ob-makefile.el ends here ;;; ob-makefile.el ends here

View File

@ -42,6 +42,4 @@
(provide 'ob-matlab) (provide 'ob-matlab)
;;; ob-matlab.el ends here ;;; ob-matlab.el ends here

View File

@ -27,9 +27,7 @@
;; Org-Babel support for evaluating maxima entries. ;; Org-Babel support for evaluating maxima entries.
;; ;;
;; This differs from most standard languages in that ;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in maxima ;; 1) there is no such thing as a "session" in maxima
;;
;; 2) we are adding the "cmdline" header argument ;; 2) we are adding the "cmdline" header argument
;;; Code: ;;; Code:
@ -125,9 +123,6 @@ of the same value."
(concat "[" (mapconcat #'org-babel-maxima-elisp-to-maxima val ", ") "]") (concat "[" (mapconcat #'org-babel-maxima-elisp-to-maxima val ", ") "]")
(format "%s" val))) (format "%s" val)))
(provide 'ob-maxima) (provide 'ob-maxima)
;;; ob-maxima.el ends here ;;; ob-maxima.el ends here

View File

@ -68,8 +68,7 @@ mscgen supported formats."
(let* ((out-file (or (cdr (assq :file params)) "output.png" )) (let* ((out-file (or (cdr (assq :file params)) "output.png" ))
(filetype (or (cdr (assq :filetype params)) "png" ))) (filetype (or (cdr (assq :filetype params)) "png" )))
(unless (cdr (assq :file params)) (unless (cdr (assq :file params))
(error " (error "ERROR: no output file specified. Add \":file name.png\" to the src header"))
ERROR: no output file specified. Add \":file name.png\" to the src header"))
(org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body)
nil)) ;; signal that output has already been written to file nil)) ;; signal that output has already been written to file
@ -79,6 +78,4 @@ ERROR: no output file specified. Add \":file name.png\" to the src header"))
(provide 'ob-mscgen) (provide 'ob-mscgen)
;;; ob-msc.el ends here ;;; ob-msc.el ends here

View File

@ -166,6 +166,4 @@ Emacs-lisp table, otherwise return the results as a string."
(provide 'ob-ocaml) (provide 'ob-ocaml)
;;; ob-ocaml.el ends here ;;; ob-ocaml.el ends here

View File

@ -136,7 +136,8 @@ specifying a variable of the same value."
(org-babel-comint-in-buffer session (org-babel-comint-in-buffer session
(mapc (lambda (var) (mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input nil t) (end-of-line 1) (insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)) var-lines)) (org-babel-comint-wait-for-output session))
var-lines))
session)) session))
(defun org-babel-matlab-initiate-session (&optional session params) (defun org-babel-matlab-initiate-session (&optional session params)
@ -230,7 +231,8 @@ value of the last statement in BODY, as elisp."
org-babel-octave-eoe-indicator org-babel-octave-eoe-indicator
org-babel-octave-eoe-output) org-babel-octave-eoe-output)
t full-body) t full-body)
(insert full-body) (comint-send-input nil t)))) results) (insert full-body) (comint-send-input nil t))))
results)
(pcase result-type (pcase result-type
(`value (`value
(org-babel-octave-import-elisp-from-file tmp-file)) (org-babel-octave-import-elisp-from-file tmp-file))
@ -259,6 +261,4 @@ This removes initial blank and comment lines and then calls
(provide 'ob-octave) (provide 'ob-octave)
;;; ob-octave.el ends here ;;; ob-octave.el ends here

View File

@ -67,6 +67,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-org) (provide 'ob-org)
;;; ob-org.el ends here ;;; ob-org.el ends here

View File

@ -152,6 +152,4 @@ return the value of the last statement in BODY, as elisp."
(provide 'ob-perl) (provide 'ob-perl)
;;; ob-perl.el ends here ;;; ob-perl.el ends here

View File

@ -182,6 +182,4 @@ then create. Return the initialized session."
(provide 'ob-picolisp) (provide 'ob-picolisp)
;;; ob-picolisp.el ends here ;;; ob-picolisp.el ends here

View File

@ -31,7 +31,7 @@
;;; Requirements: ;;; Requirements:
;; plantuml | http://plantuml.sourceforge.net/ ;; plantuml | http://plantuml.sourceforge.net/
;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file ;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file (when exec mode is `jar')
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
@ -46,6 +46,31 @@
:version "24.1" :version "24.1"
:type 'string) :type 'string)
(defcustom org-plantuml-exec-mode 'jar
"Method to use for PlantUML diagram generation.
`jar' means to use java together with the JAR.
The JAR can be configured via `org-plantuml-jar-path'.
`plantuml' means to use the PlantUML executable.
The executable can be configured via `org-plantuml-executable-path'.
You can also configure extra arguments via `org-plantuml-executable-args'."
:group 'org-babel
:package-version '(Org . "9.4")
:type 'symbol
:options '(jar plantuml))
(defcustom org-plantuml-executable-path "plantuml"
"File name of the PlantUML executable."
:group 'org-babel
:package-version '(Org . "9.4")
:type 'string)
(defcustom org-plantuml-executable-args (list "-headless")
"The arguments passed to plantuml executable when executing PlantUML."
:group 'org-babel
:package-version '(Org . "9.4")
:type '(repeat string))
(defun org-babel-variable-assignments:plantuml (params) (defun org-babel-variable-assignments:plantuml (params)
"Return a list of PlantUML statements assigning the block's variables. "Return a list of PlantUML statements assigning the block's variables.
PARAMS is a property list of source block parameters, which may PARAMS is a property list of source block parameters, which may
@ -83,40 +108,41 @@ This function is called by `org-babel-execute-src-block'."
(cmdline (cdr (assq :cmdline params))) (cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "plantuml-")) (in-file (org-babel-temp-file "plantuml-"))
(java (or (cdr (assq :java params)) "")) (java (or (cdr (assq :java params)) ""))
(executable (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-executable-path)
(t "java")))
(executable-args (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-executable-args)
((string= "" org-plantuml-jar-path)
(error "`org-plantuml-jar-path' is not set"))
((not (file-exists-p org-plantuml-jar-path))
(error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
(t (list java
"-jar"
(shell-quote-argument (expand-file-name org-plantuml-jar-path))))))
(full-body (org-babel-plantuml-make-body body params)) (full-body (org-babel-plantuml-make-body body params))
(cmd (if (string= "" org-plantuml-jar-path) (cmd (mapconcat #'identity
(error "`org-plantuml-jar-path' is not set") (append
(concat "java " java " -jar " (list executable)
(shell-quote-argument executable-args
(expand-file-name org-plantuml-jar-path)) (pcase (file-name-extension out-file)
(if (string= (file-name-extension out-file) "png") ("png" '("-tpng"))
" -tpng" "") ("svg" '("-tsvg"))
(if (string= (file-name-extension out-file) "svg") ("eps" '("-teps"))
" -tsvg" "") ("pdf" '("-tpdf"))
(if (string= (file-name-extension out-file) "eps") ("tex" '("-tlatex"))
" -teps" "") ("vdx" '("-tvdx"))
(if (string= (file-name-extension out-file) "pdf") ("xmi" '("-txmi"))
" -tpdf" "") ("scxml" '("-tscxml"))
(if (string= (file-name-extension out-file) "tex") ("html" '("-thtml"))
" -tlatex" "") ("txt" '("-ttxt"))
(if (string= (file-name-extension out-file) "vdx") ("utxt" '("-utxt")))
" -tvdx" "") (list
(if (string= (file-name-extension out-file) "xmi") "-p"
" -txmi" "") cmdline
(if (string= (file-name-extension out-file) "scxml") "<"
" -tscxml" "") (org-babel-process-file-name in-file)
(if (string= (file-name-extension out-file) "html") ">"
" -thtml" "") (org-babel-process-file-name out-file)))
(if (string= (file-name-extension out-file) "txt") " ")))
" -ttxt" "")
(if (string= (file-name-extension out-file) "utxt")
" -utxt" "")
" -p " cmdline " < "
(org-babel-process-file-name in-file)
" > "
(org-babel-process-file-name out-file)))))
(unless (file-exists-p org-plantuml-jar-path)
(error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
(with-temp-file in-file (insert full-body)) (with-temp-file in-file (insert full-body))
(message "%s" cmd) (org-babel-eval cmd "") (message "%s" cmd) (org-babel-eval cmd "")
nil)) ;; signal that output has already been written to file nil)) ;; signal that output has already been written to file
@ -127,6 +153,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-plantuml) (provide 'ob-plantuml)
;;; ob-plantuml.el ends here ;;; ob-plantuml.el ends here

View File

@ -4,6 +4,7 @@
;; Authors: Eric Schulte ;; Authors: Eric Schulte
;; Dan Davison ;; Dan Davison
;; Maintainer: Jack Kamm <jackkamm@gmail.com>
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org ;; Homepage: https://orgmode.org
@ -29,10 +30,11 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'org-macs) (require 'org-macs)
(require 'python)
(declare-function py-shell "ext:python-mode" (&optional argprompt)) (declare-function py-shell "ext:python-mode" (&rest args))
(declare-function py-toggle-shells "ext:python-mode" (arg)) (declare-function py-toggle-shells "ext:python-mode" (arg))
(declare-function run-python "ext:python" (&optional cmd dedicated show)) (declare-function py-shell-send-string "ext:python-mode" (strg &optional process))
(defvar org-babel-tangle-lang-exts) (defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) (add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
@ -104,7 +106,8 @@ VARS contains resolved variable references."
(org-babel-comint-in-buffer session (org-babel-comint-in-buffer session
(mapc (lambda (var) (mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input) (end-of-line 1) (insert var) (comint-send-input)
(org-babel-comint-wait-for-output session)) var-lines)) (org-babel-comint-wait-for-output session))
var-lines))
session)) session))
(defun org-babel-load-session:python (session body params) (defun org-babel-load-session:python (session body params)
@ -177,42 +180,40 @@ Emacs-lisp table, otherwise return the results as a string."
"Initiate a python session. "Initiate a python session.
If there is not a current inferior-process-buffer in SESSION If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session." then create. Return the initialized session."
(require org-babel-python-mode)
(save-window-excursion (save-window-excursion
(let* ((session (if session (intern session) :default)) (let* ((session (if session (intern session) :default))
(python-buffer (org-babel-python-session-buffer session)) (py-buffer (org-babel-python-session-buffer session))
(cmd (if (member system-type '(cygwin windows-nt ms-dos)) (cmd (if (member system-type '(cygwin windows-nt ms-dos))
(concat org-babel-python-command " -i") (concat org-babel-python-command " -i")
org-babel-python-command))) org-babel-python-command)))
(cond (cond
((and (eq 'python org-babel-python-mode) ((eq 'python org-babel-python-mode) ; python.el
(fboundp 'run-python)) ; python.el (unless py-buffer
(if (not (version< "24.1" emacs-version)) (setq py-buffer (org-babel-python-with-earmuffs session)))
(run-python cmd) (let ((python-shell-buffer-name
(unless python-buffer (org-babel-python-without-earmuffs py-buffer)))
(setq python-buffer (org-babel-python-with-earmuffs session))) (run-python cmd)
(let ((python-shell-buffer-name (sleep-for 0 10)))
(org-babel-python-without-earmuffs python-buffer)))
(run-python cmd))))
((and (eq 'python-mode org-babel-python-mode) ((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el (fboundp 'py-shell)) ; python-mode.el
(require 'python-mode)
;; Make sure that py-which-bufname is initialized, as otherwise ;; Make sure that py-which-bufname is initialized, as otherwise
;; it will be overwritten the first time a Python buffer is ;; it will be overwritten the first time a Python buffer is
;; created. ;; created.
(py-toggle-shells py-default-interpreter) (py-toggle-shells py-default-interpreter)
;; `py-shell' creates a buffer whose name is the value of ;; `py-shell' creates a buffer whose name is the value of
;; `py-which-bufname' with '*'s at the beginning and end ;; `py-which-bufname' with '*'s at the beginning and end
(let* ((bufname (if (and python-buffer (buffer-live-p python-buffer)) (let* ((bufname (if (and py-buffer (buffer-live-p py-buffer))
(replace-regexp-in-string ;; zap surrounding * (replace-regexp-in-string ;; zap surrounding *
"^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) "^\\*\\([^*]+\\)\\*$" "\\1" py-buffer)
(concat "Python-" (symbol-name session)))) (concat "Python-" (symbol-name session))))
(py-which-bufname bufname)) (py-which-bufname bufname))
(py-shell) (setq py-buffer (org-babel-python-with-earmuffs bufname))
(setq python-buffer (org-babel-python-with-earmuffs bufname)))) (py-shell nil nil t org-babel-python-command py-buffer nil nil t nil)))
(t (t
(error "No function available for running an inferior Python"))) (error "No function available for running an inferior Python")))
(setq org-babel-python-buffers (setq org-babel-python-buffers
(cons (cons session python-buffer) (cons (cons session py-buffer)
(assq-delete-all session org-babel-python-buffers))) (assq-delete-all session org-babel-python-buffers)))
session))) session)))
@ -222,8 +223,9 @@ then create. Return the initialized session."
(org-babel-python-session-buffer (org-babel-python-session-buffer
(org-babel-python-initiate-session-by-key session)))) (org-babel-python-initiate-session-by-key session))))
(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'" (defvar org-babel-python-eoe-indicator "org_babel_python_eoe"
"A string to indicate that evaluation has completed.") "A string to indicate that evaluation has completed.")
(defconst org-babel-python-wrapper-method (defconst org-babel-python-wrapper-method
" "
def main(): def main():
@ -238,14 +240,39 @@ def main():
open('%s', 'w').write( pprint.pformat(main()) )") open('%s', 'w').write( pprint.pformat(main()) )")
(defconst org-babel-python--exec-tmpfile (defconst org-babel-python--exec-tmpfile "\
(concat with open('%s') as f:
"__org_babel_python_fname = '%s'; " exec(compile(f.read(), f.name, 'exec'))"
"__org_babel_python_fh = open(__org_babel_python_fname); " "Template for Python session command with output results.
"exec(compile("
"__org_babel_python_fh.read(), __org_babel_python_fname, 'exec'" Has a single %s escape, the tempfile containing the source code
")); " to evaluate.")
"__org_babel_python_fh.close()"))
(defun org-babel-python-format-session-value
(src-file result-file result-params)
"Return Python code to evaluate SRC-FILE and write result to RESULT-FILE."
(format "\
import ast
with open('%s') as f:
__org_babel_python_ast = ast.parse(f.read())
__org_babel_python_final = __org_babel_python_ast.body[-1]
if isinstance(__org_babel_python_final, ast.Expr):
__org_babel_python_ast.body = __org_babel_python_ast.body[:-1]
exec(compile(__org_babel_python_ast, '<string>', 'exec'))
__org_babel_python_final = eval(compile(ast.Expression(
__org_babel_python_final.value), '<string>', 'eval'))
with open('%s', 'w') as f:
if %s:
import pprint
f.write(pprint.pformat(__org_babel_python_final))
else:
f.write(str(__org_babel_python_final))
else:
exec(compile(__org_babel_python_ast, '<string>', 'exec'))
__org_babel_python_final = None"
(org-babel-process-file-name src-file 'noquote)
(org-babel-process-file-name result-file 'noquote)
(if (member "pp" result-params) "True" "False")))
(defun org-babel-python-evaluate (defun org-babel-python-evaluate
(session body &optional result-type result-params preamble) (session body &optional result-type result-params preamble)
@ -256,6 +283,19 @@ open('%s', 'w').write( pprint.pformat(main()) )")
(org-babel-python-evaluate-external-process (org-babel-python-evaluate-external-process
body result-type result-params preamble))) body result-type result-params preamble)))
(defun org-babel-python--shift-right (body &optional count)
(with-temp-buffer
(python-mode)
(insert body)
(goto-char (point-min))
(while (not (eobp))
(unless (python-syntax-context 'string)
(python-indent-shift-right (line-beginning-position)
(line-end-position)
count))
(forward-line 1))
(buffer-string)))
(defun org-babel-python-evaluate-external-process (defun org-babel-python-evaluate-external-process
(body &optional result-type result-params preamble) (body &optional result-type result-params preamble)
"Evaluate BODY in external python process. "Evaluate BODY in external python process.
@ -276,89 +316,70 @@ last statement in BODY, as elisp."
(if (member "pp" result-params) (if (member "pp" result-params)
org-babel-python-pp-wrapper-method org-babel-python-pp-wrapper-method
org-babel-python-wrapper-method) org-babel-python-wrapper-method)
(mapconcat (org-babel-python--shift-right body)
(lambda (line) (format "\t%s" line))
(split-string (org-remove-indentation (org-trim body))
"[\r\n]")
"\n")
(org-babel-process-file-name tmp-file 'noquote)))) (org-babel-process-file-name tmp-file 'noquote))))
(org-babel-eval-read-file tmp-file)))))) (org-babel-eval-read-file tmp-file))))))
(org-babel-result-cond result-params (org-babel-result-cond result-params
raw raw
(org-babel-python-table-or-string (org-trim raw))))) (org-babel-python-table-or-string (org-trim raw)))))
(defun org-babel-python--send-string (session body)
"Pass BODY to the Python process in SESSION.
Return output."
(with-current-buffer session
(let* ((string-buffer "")
(comint-output-filter-functions
(cons (lambda (text) (setq string-buffer
(concat string-buffer text)))
comint-output-filter-functions))
(body (format "\
try:
%s
except:
raise
finally:
print('%s')"
(org-babel-python--shift-right body 4)
org-babel-python-eoe-indicator)))
(if (not (eq 'python-mode org-babel-python-mode))
(let ((python-shell-buffer-name
(org-babel-python-without-earmuffs session)))
(python-shell-send-string body))
(require 'python-mode)
(py-shell-send-string body (get-buffer-process session)))
;; same as `python-shell-comint-end-of-output-p' in emacs-25.1+
(while (not (string-match
org-babel-python-eoe-indicator
string-buffer))
(accept-process-output (get-buffer-process (current-buffer))))
(org-babel-chomp (substring string-buffer 0 (match-beginning 0))))))
(defun org-babel-python-evaluate-session (defun org-babel-python-evaluate-session
(session body &optional result-type result-params) (session body &optional result-type result-params)
"Pass BODY to the Python process in SESSION. "Pass BODY to the Python process in SESSION.
If RESULT-TYPE equals `output' then return standard output as a If RESULT-TYPE equals `output' then return standard output as a
string. If RESULT-TYPE equals `value' then return the value of the string. If RESULT-TYPE equals `value' then return the value of the
last statement in BODY, as elisp." last statement in BODY, as elisp."
(let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5))) (let* ((tmp-src-file (org-babel-temp-file "python-"))
(dump-last-value
(lambda
(tmp-file pp)
(mapc
(lambda (statement) (insert statement) (funcall send-wait))
(if pp
(list
"import pprint"
(format "open('%s', 'w').write(pprint.pformat(_))"
(org-babel-process-file-name tmp-file 'noquote)))
(list (format "open('%s', 'w').write(str(_))"
(org-babel-process-file-name tmp-file
'noquote)))))))
(last-indent 0)
(input-body (lambda (body)
(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 (results
(pcase result-type (progn
(`output (with-temp-file tmp-src-file (insert body))
(let ((body (if (string-match-p ".\n+." body) ; Multiline (pcase result-type
(let ((tmp-src-file (org-babel-temp-file (`output
"python-"))) (let ((body (format org-babel-python--exec-tmpfile
(with-temp-file tmp-src-file (insert body)) (org-babel-process-file-name
(format org-babel-python--exec-tmpfile tmp-src-file 'noquote))))
tmp-src-file)) (org-babel-python--send-string session body)))
body))) (`value
(mapconcat (let* ((tmp-results-file (org-babel-temp-file "python-"))
#'org-trim (body (org-babel-python-format-session-value
(butlast tmp-src-file tmp-results-file result-params)))
(org-babel-comint-with-output (org-babel-python--send-string session body)
(session org-babel-python-eoe-indicator t body) (sleep-for 0 10)
(funcall input-body body) (org-babel-eval-read-file tmp-results-file)))))))
(funcall send-wait) (funcall send-wait) (org-babel-result-cond result-params
(insert org-babel-python-eoe-indicator) results
(funcall send-wait)) (org-babel-python-table-or-string results))))
2) "\n")))
(`value
(let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator nil body)
(let ((comint-process-echoes nil))
(funcall input-body body)
(funcall dump-last-value tmp-file
(member "pp" result-params))
(funcall send-wait) (funcall send-wait)
(insert org-babel-python-eoe-indicator)
(funcall send-wait)))
(org-babel-eval-read-file tmp-file))))))
(unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
(org-babel-result-cond result-params
results
(org-babel-python-table-or-string results)))))
(defun org-babel-python-read-string (string) (defun org-babel-python-read-string (string)
"Strip \\='s from around Python string." "Strip \\='s from around Python string."
@ -369,6 +390,4 @@ last statement in BODY, as elisp."
(provide 'ob-python) (provide 'ob-python)
;;; ob-python.el ends here ;;; ob-python.el ends here

View File

@ -143,7 +143,8 @@ Emacs Lisp representation of the value of the variable."
(org-babel-ref-split-args new-referent)))) (org-babel-ref-split-args new-referent))))
(when (> (length new-header-args) 0) (when (> (length new-header-args) 0)
(setq args (append (org-babel-parse-header-arguments (setq args (append (org-babel-parse-header-arguments
new-header-args) args))) new-header-args)
args)))
(setq ref new-refere))) (setq ref new-refere)))
(when (string-match "^\\(.+\\):\\(.+\\)$" ref) (when (string-match "^\\(.+\\):\\(.+\\)$" ref)
(setq split-file (match-string 1 ref)) (setq split-file (match-string 1 ref))
@ -240,7 +241,6 @@ to \"0:-1\"."
"Split ARG-STRING into top-level arguments of balanced parenthesis." "Split ARG-STRING into top-level arguments of balanced parenthesis."
(mapcar #'org-trim (org-babel-balanced-split arg-string 44))) (mapcar #'org-trim (org-babel-balanced-split arg-string 44)))
(provide 'ob-ref) (provide 'ob-ref)
;;; ob-ref.el ends here ;;; ob-ref.el ends here

View File

@ -103,7 +103,8 @@ This function is called by `org-babel-execute-src-block'."
(mapc (lambda (var) (mapc (lambda (var)
(insert var) (comint-send-input nil t) (insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session) (org-babel-comint-wait-for-output session)
(sit-for .1) (goto-char (point-max))) var-lines)) (sit-for .1) (goto-char (point-max)))
var-lines))
session)) session))
(defun org-babel-load-session:ruby (session body params) (defun org-babel-load-session:ruby (session body params)
@ -263,6 +264,4 @@ return the value of the last statement in BODY, as elisp."
(provide 'ob-ruby) (provide 'ob-ruby)
;;; ob-ruby.el ends here ;;; ob-ruby.el ends here

View File

@ -65,6 +65,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-sass) (provide 'ob-sass)
;;; ob-sass.el ends here ;;; ob-sass.el ends here

View File

@ -43,6 +43,7 @@
(require 'geiser-impl nil t) (require 'geiser-impl nil t)
(defvar geiser-repl--repl) ; Defined in geiser-repl.el (defvar geiser-repl--repl) ; Defined in geiser-repl.el
(defvar geiser-impl--implementation) ; Defined in geiser-impl.el (defvar geiser-impl--implementation) ; Defined in geiser-impl.el
(defvar geiser-scheme-implementation) ; Defined in geiser-impl.el
(defvar geiser-default-implementation) ; Defined in geiser-impl.el (defvar geiser-default-implementation) ; Defined in geiser-impl.el
(defvar geiser-active-implementations) ; Defined in geiser-impl.el (defvar geiser-active-implementations) ; Defined in geiser-impl.el
(defvar geiser-debug-show-debug-p) ; Defined in geiser-debug.el (defvar geiser-debug-show-debug-p) ; Defined in geiser-debug.el
@ -71,7 +72,8 @@
(defun org-babel-expand-body:scheme (body params) (defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body." "Expand BODY according to PARAMS, return the expanded body."
(let ((vars (org-babel--get-vars params)) (let ((vars (org-babel--get-vars params))
(prepends (cdr (assq :prologue params)))) (prepends (cdr (assq :prologue params)))
(postpends (cdr (assq :epilogue params))))
(concat (and prepends (concat prepends "\n")) (concat (and prepends (concat prepends "\n"))
(if (null vars) body (if (null vars) body
(format "(let (%s)\n%s\n)" (format "(let (%s)\n%s\n)"
@ -80,7 +82,8 @@
(format "%S" (print `(,(car var) ',(cdr var))))) (format "%S" (print `(,(car var) ',(cdr var)))))
vars vars
"\n ") "\n ")
body))))) body))
(and postpends (concat "\n" postpends)))))
(defvar org-babel-scheme-repl-map (make-hash-table :test #'equal) (defvar org-babel-scheme-repl-map (make-hash-table :test #'equal)
@ -175,7 +178,8 @@ is true; otherwise returns the last value."
(geiser-debug-show-debug-p nil)) (geiser-debug-show-debug-p nil))
(let ((ret (geiser-eval-region (point-min) (point-max)))) (let ((ret (geiser-eval-region (point-min) (point-max))))
(setq result (if output (setq result (if output
(geiser-eval--retort-output ret) (or (geiser-eval--retort-output ret)
"Geiser Interpreter produced no output")
(geiser-eval--retort-result-str ret ""))))) (geiser-eval--retort-result-str ret "")))))
(when (not repl) (when (not repl)
(save-current-buffer (set-buffer repl-buffer) (save-current-buffer (set-buffer repl-buffer)
@ -208,6 +212,7 @@ This function is called by `org-babel-execute-src-block'."
(let* ((result-type (cdr (assq :result-type params))) (let* ((result-type (cdr (assq :result-type params)))
(impl (or (when (cdr (assq :scheme params)) (impl (or (when (cdr (assq :scheme params))
(intern (cdr (assq :scheme params)))) (intern (cdr (assq :scheme params))))
geiser-scheme-implementation
geiser-default-implementation geiser-default-implementation
(car geiser-active-implementations))) (car geiser-active-implementations)))
(session (org-babel-scheme-make-session-name (session (org-babel-scheme-make-session-name

View File

@ -40,7 +40,8 @@
In case you want to use a different screen than one selected by your $PATH") In case you want to use a different screen than one selected by your $PATH")
(defvar org-babel-default-header-args:screen (defvar org-babel-default-header-args:screen
'((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm")) '((:results . "silent") (:session . "default") (:cmd . "sh")
(:terminal . "xterm") (:screenrc . "/dev/null"))
"Default arguments to use when running screen source blocks.") "Default arguments to use when running screen source blocks.")
(defun org-babel-execute:screen (body params) (defun org-babel-execute:screen (body params)
@ -59,11 +60,11 @@ In case you want to use a different screen than one selected by your $PATH")
(let* ((session (cdr (assq :session params))) (let* ((session (cdr (assq :session params)))
(cmd (cdr (assq :cmd params))) (cmd (cdr (assq :cmd params)))
(terminal (cdr (assq :terminal params))) (terminal (cdr (assq :terminal params)))
(screenrc (cdr (assq :screenrc params)))
(process-name (concat "org-babel: terminal (" session ")"))) (process-name (concat "org-babel: terminal (" session ")")))
(apply 'start-process process-name "*Messages*" (apply 'start-process process-name "*Messages*"
terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location
"-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) "-c" ,screenrc "-mS" ,session ,cmd))
,cmd))
;; XXX: Is there a better way than the following? ;; XXX: Is there a better way than the following?
(while (not (org-babel-screen-session-socketname session)) (while (not (org-babel-screen-session-socketname session))
;; wait until screen session is available before returning ;; wait until screen session is available before returning
@ -97,9 +98,8 @@ In case you want to use a different screen than one selected by your $PATH")
nil nil
(mapcar (mapcar
(lambda (x) (lambda (x)
(when (string-match (and (string-match-p (regexp-quote session) x)
(concat "org-babel-session-" session) x) x))
x))
sockets))))) sockets)))))
(when match-socket (car (split-string match-socket))))) (when match-socket (car (split-string match-socket)))))
@ -108,6 +108,7 @@ In case you want to use a different screen than one selected by your $PATH")
(let ((tmpfile (org-babel-temp-file "screen-"))) (let ((tmpfile (org-babel-temp-file "screen-")))
(with-temp-file tmpfile (with-temp-file tmpfile
(insert body) (insert body)
(insert "\n")
;; org-babel has superfluous spaces ;; org-babel has superfluous spaces
(goto-char (point-min)) (goto-char (point-min))
@ -138,6 +139,4 @@ The terminal should shortly flicker."
(provide 'ob-screen) (provide 'ob-screen)
;;; ob-screen.el ends here ;;; ob-screen.el ends here

View File

@ -4,7 +4,6 @@
;; Author: Bjarte Johansen ;; Author: Bjarte Johansen
;; Keywords: literate programming, reproducible research ;; Keywords: literate programming, reproducible research
;; Version: 0.1.1
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -68,7 +67,8 @@ function is called by `org-babel-execute-src-block'."
(in-file (cdr (assq :in-file params))) (in-file (cdr (assq :in-file params)))
(code-file (let ((file (org-babel-temp-file "sed-"))) (code-file (let ((file (org-babel-temp-file "sed-")))
(with-temp-file file (with-temp-file file
(insert body)) file)) (insert body))
file))
(stdin (let ((stdin (cdr (assq :stdin params)))) (stdin (let ((stdin (cdr (assq :stdin params))))
(when stdin (when stdin
(let ((tmp (org-babel-temp-file "sed-stdin-")) (let ((tmp (org-babel-temp-file "sed-stdin-"))
@ -102,4 +102,5 @@ function is called by `org-babel-execute-src-block'."
(cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(provide 'ob-sed) (provide 'ob-sed)
;;; ob-sed.el ends here ;;; ob-sed.el ends here

View File

@ -71,6 +71,19 @@ outside the Customize interface."
(set-default symbol value) (set-default symbol value)
(org-babel-shell-initialize))) (org-babel-shell-initialize)))
(defcustom org-babel-shell-results-defaults-to-output t
"Let shell execution defaults to \":results output\".
When set to t, use \":results output\" when no :results setting
is set. This is especially useful for inline source blocks.
When set to nil, stick to the convention of using :results value
as the default setting when no :results is set, the \"value\" of
a shell execution being its exit code."
:group 'org-babel
:type 'boolean
:package-version '(Org . "9.4"))
(defun org-babel-execute:shell (body params) (defun org-babel-execute:shell (body params)
"Execute a block of Shell commands with Babel. "Execute a block of Shell commands with Babel.
This function is called by `org-babel-execute-src-block'." This function is called by `org-babel-execute-src-block'."
@ -79,9 +92,17 @@ This function is called by `org-babel-execute-src-block'."
(stdin (let ((stdin (cdr (assq :stdin params)))) (stdin (let ((stdin (cdr (assq :stdin params))))
(when stdin (org-babel-sh-var-to-string (when stdin (org-babel-sh-var-to-string
(org-babel-ref-resolve stdin))))) (org-babel-ref-resolve stdin)))))
(results-params (cdr (assq :result-params params)))
(value-is-exit-status
(or (and
(equal '("replace") results-params)
(not org-babel-shell-results-defaults-to-output))
(member "value" results-params)))
(cmdline (cdr (assq :cmdline params))) (cmdline (cdr (assq :cmdline params)))
(full-body (org-babel-expand-body:generic (full-body (concat
body params (org-babel-variable-assignments:shell params)))) (org-babel-expand-body:generic
body params (org-babel-variable-assignments:shell params))
(when value-is-exit-status "\necho $?"))))
(org-babel-reassemble-table (org-babel-reassemble-table
(org-babel-sh-evaluate session full-body params stdin cmdline) (org-babel-sh-evaluate session full-body params stdin cmdline)
(org-babel-pick-name (org-babel-pick-name
@ -96,7 +117,8 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-comint-in-buffer session (org-babel-comint-in-buffer session
(mapc (lambda (var) (mapc (lambda (var)
(insert var) (comint-send-input nil t) (insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)) var-lines)) (org-babel-comint-wait-for-output session))
var-lines))
session)) session))
(defun org-babel-load-session:shell (session body params) (defun org-babel-load-session:shell (session body params)
@ -129,15 +151,15 @@ This function is called by `org-babel-execute-src-block'."
(varname values &optional sep hline) (varname values &optional sep hline)
"Return a list of statements declaring the values as bash associative array." "Return a list of statements declaring the values as bash associative array."
(format "unset %s\ndeclare -A %s\n%s" (format "unset %s\ndeclare -A %s\n%s"
varname varname varname varname
(mapconcat (mapconcat
(lambda (items) (lambda (items)
(format "%s[%s]=%s" (format "%s[%s]=%s"
varname varname
(org-babel-sh-var-to-sh (car items) sep hline) (org-babel-sh-var-to-sh (car items) sep hline)
(org-babel-sh-var-to-sh (cdr items) sep hline))) (org-babel-sh-var-to-sh (cdr items) sep hline)))
values values
"\n"))) "\n")))
(defun org-babel--variable-assignments:bash (varname values &optional sep hline) (defun org-babel--variable-assignments:bash (varname values &optional sep hline)
"Represent the parameters as useful Bash shell variables." "Represent the parameters as useful Bash shell variables."
@ -208,6 +230,12 @@ If RESULT-TYPE equals `output' then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals `value' then of the statements in BODY, if RESULT-TYPE equals `value' then
return the value of the last statement in BODY." return the value of the last statement in BODY."
(let* ((shebang (cdr (assq :shebang params))) (let* ((shebang (cdr (assq :shebang params)))
(results-params (cdr (assq :result-params params)))
(value-is-exit-status
(or (and
(equal '("replace") results-params)
(not org-babel-shell-results-defaults-to-output))
(member "value" results-params)))
(results (results
(cond (cond
((or stdin cmdline) ; external shell script w/STDIN ((or stdin cmdline) ; external shell script w/STDIN
@ -259,8 +287,9 @@ return the value of the last statement in BODY."
(insert body)) (insert body))
(set-file-modes script-file #o755) (set-file-modes script-file #o755)
(org-babel-eval script-file ""))) (org-babel-eval script-file "")))
(t (t (org-babel-eval shell-file-name (org-trim body))))))
(org-babel-eval shell-file-name (org-trim body)))))) (when value-is-exit-status
(setq results (car (reverse (split-string results "\n" t)))))
(when results (when results
(let ((result-params (cdr (assq :result-params params)))) (let ((result-params (cdr (assq :result-params params))))
(org-babel-result-cond result-params (org-babel-result-cond result-params
@ -277,6 +306,4 @@ return the value of the last statement in BODY."
(provide 'ob-shell) (provide 'ob-shell)
;;; ob-shell.el ends here ;;; ob-shell.el ends here

View File

@ -75,4 +75,5 @@ This function is called by `org-babel-execute-src-block'."
(error results)))))) (error results))))))
(provide 'ob-shen) (provide 'ob-shen)
;;; ob-shen.el ends here ;;; ob-shen.el ends here

View File

@ -55,7 +55,7 @@
;; - dbi ;; - dbi
;; - mssql ;; - mssql
;; - sqsh ;; - sqsh
;; - postgresql ;; - postgresql (postgres)
;; - oracle ;; - oracle
;; - vertica ;; - vertica
;; ;;
@ -73,6 +73,7 @@
(declare-function orgtbl-to-csv "org-table" (table params)) (declare-function orgtbl-to-csv "org-table" (table params))
(declare-function org-table-to-lisp "org-table" (&optional txt)) (declare-function org-table-to-lisp "org-table" (&optional txt))
(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p)) (declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p))
(declare-function sql-set-product "sql" (product))
(defvar sql-connection-alist) (defvar sql-connection-alist)
(defvar org-babel-default-header-args:sql '()) (defvar org-babel-default-header-args:sql '())
@ -92,6 +93,13 @@
(org-babel-sql-expand-vars (org-babel-sql-expand-vars
body (org-babel--get-vars params))) body (org-babel--get-vars params)))
(defun org-babel-edit-prep:sql (info)
"Set `sql-product' in Org edit buffer.
Set `sql-product' in Org edit buffer according to the
corresponding :engine source block header argument."
(let ((product (cdr (assq :engine (nth 2 info)))))
(sql-set-product product)))
(defun org-babel-sql-dbstring-mysql (host port user password database) (defun org-babel-sql-dbstring-mysql (host port user password database)
"Make MySQL cmd line args for database connection. Pass nil to omit that arg." "Make MySQL cmd line args for database connection. Pass nil to omit that arg."
(combine-and-quote-strings (combine-and-quote-strings
@ -211,64 +219,64 @@ This function is called by `org-babel-execute-src-block'."
(out-file (or (cdr (assq :out-file params)) (out-file (or (cdr (assq :out-file params))
(org-babel-temp-file "sql-out-"))) (org-babel-temp-file "sql-out-")))
(header-delim "") (header-delim "")
(command (pcase (intern engine) (command (cl-case (intern engine)
(`dbi (format "dbish --batch %s < %s | sed '%s' > %s" (dbi (format "dbish --batch %s < %s | sed '%s' > %s"
(or cmdline "") (or cmdline "")
(org-babel-process-file-name in-file) (org-babel-process-file-name in-file)
"/^+/d;s/^|//;s/(NULL)/ /g;$d" "/^+/d;s/^|//;s/(NULL)/ /g;$d"
(org-babel-process-file-name out-file))) (org-babel-process-file-name out-file)))
(`monetdb (format "mclient -f tab %s < %s > %s" (monetdb (format "mclient -f tab %s < %s > %s"
(or cmdline "") (or cmdline "")
(org-babel-process-file-name in-file) (org-babel-process-file-name in-file)
(org-babel-process-file-name out-file))) (org-babel-process-file-name out-file)))
(`mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s" (mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s"
(or cmdline "")
(org-babel-sql-dbstring-mssql
dbhost dbuser dbpassword database)
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name in-file))
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name out-file))))
(`mysql (format "mysql %s %s %s < %s > %s"
(org-babel-sql-dbstring-mysql
dbhost dbport dbuser dbpassword database)
(if colnames-p "" "-N")
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
(`postgresql (format
"%spsql --set=\"ON_ERROR_STOP=1\" %s -A -P \
footer=off -F \"\t\" %s -f %s -o %s %s"
(if dbpassword
(format "PGPASSWORD=%s " dbpassword)
"")
(if colnames-p "" "-t")
(org-babel-sql-dbstring-postgresql
dbhost dbport dbuser database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(`sqsh (format "sqsh %s %s -i %s -o %s -m csv"
(or cmdline "") (or cmdline "")
(org-babel-sql-dbstring-sqsh (org-babel-sql-dbstring-mssql
dbhost dbuser dbpassword database) dbhost dbuser dbpassword database)
(org-babel-sql-convert-standard-filename (org-babel-sql-convert-standard-filename
(org-babel-process-file-name in-file)) (org-babel-process-file-name in-file))
(org-babel-sql-convert-standard-filename (org-babel-sql-convert-standard-filename
(org-babel-process-file-name out-file)))) (org-babel-process-file-name out-file))))
(`vertica (format "vsql %s -f %s -o %s %s" (mysql (format "mysql %s %s %s < %s > %s"
(org-babel-sql-dbstring-vertica (org-babel-sql-dbstring-mysql
dbhost dbport dbuser dbpassword database) dbhost dbport dbuser dbpassword database)
(org-babel-process-file-name in-file) (if colnames-p "" "-N")
(org-babel-process-file-name out-file) (or cmdline "")
(or cmdline ""))) (org-babel-process-file-name in-file)
(`oracle (format (org-babel-process-file-name out-file)))
"sqlplus -s %s < %s > %s" ((postgresql postgres) (format
(org-babel-sql-dbstring-oracle "%spsql --set=\"ON_ERROR_STOP=1\" %s -A -P \
dbhost dbport dbuser dbpassword database) footer=off -F \"\t\" %s -f %s -o %s %s"
(org-babel-process-file-name in-file) (if dbpassword
(org-babel-process-file-name out-file))) (format "PGPASSWORD=%s " dbpassword)
(_ (error "No support for the %s SQL engine" engine))))) "")
(if colnames-p "" "-t")
(org-babel-sql-dbstring-postgresql
dbhost dbport dbuser database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(sqsh (format "sqsh %s %s -i %s -o %s -m csv"
(or cmdline "")
(org-babel-sql-dbstring-sqsh
dbhost dbuser dbpassword database)
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name in-file))
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name out-file))))
(vertica (format "vsql %s -f %s -o %s %s"
(org-babel-sql-dbstring-vertica
dbhost dbport dbuser dbpassword database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
(oracle (format
"sqlplus -s %s < %s > %s"
(org-babel-sql-dbstring-oracle
dbhost dbport dbuser dbpassword database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
(t (user-error "No support for the %s SQL engine" engine)))))
(with-temp-file in-file (with-temp-file in-file
(insert (insert
(pcase (intern engine) (pcase (intern engine)
@ -301,7 +309,7 @@ SET COLSEP '|'
(progn (insert-file-contents-literally out-file) (buffer-string))) (progn (insert-file-contents-literally out-file) (buffer-string)))
(with-temp-buffer (with-temp-buffer
(cond (cond
((memq (intern engine) '(dbi mysql postgresql sqsh vertica)) ((memq (intern engine) '(dbi mysql postgresql postgres sqsh vertica))
;; Add header row delimiter after column-names header in first line ;; Add header row delimiter after column-names header in first line
(cond (cond
(colnames-p (colnames-p
@ -365,6 +373,4 @@ SET COLSEP '|'
(provide 'ob-sql) (provide 'ob-sql)
;;; ob-sql.el ends here ;;; ob-sql.el ends here

View File

@ -137,7 +137,8 @@ This function is called by `org-babel-execute-src-block'."
(mapcar (lambda (row) (mapcar (lambda (row)
(if (eq 'hline row) (if (eq 'hline row)
'hline 'hline
(mapcar #'org-babel-string-read row))) result))) (mapcar #'org-babel-string-read row)))
result)))
(defun org-babel-sqlite-offset-colnames (table headers-p) (defun org-babel-sqlite-offset-colnames (table headers-p)
"If HEADERS-P is non-nil then offset the first row as column names." "If HEADERS-P is non-nil then offset the first row as column names."
@ -152,6 +153,4 @@ Prepare SESSION according to the header arguments specified in PARAMS."
(provide 'ob-sqlite) (provide 'ob-sqlite)
;;; ob-sqlite.el ends here ;;; ob-sqlite.el ends here

View File

@ -82,4 +82,5 @@ Otherwise, write the Stan code directly to the named file."
(user-error "Stan does not support sessions")) (user-error "Stan does not support sessions"))
(provide 'ob-stan) (provide 'ob-stan)
;;; ob-stan.el ends here ;;; ob-stan.el ends here

View File

@ -62,7 +62,8 @@ If STRING ends in a newline character, then remove the newline
character and replace it with ellipses." character and replace it with ellipses."
(if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string)) (if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string))
(concat (substring string 0 (match-beginning 0)) (concat (substring string 0 (match-beginning 0))
(when (match-string 1 string) "...")) string)) (when (match-string 1 string) "..."))
string))
(defmacro org-sbe (source-block &rest variables) (defmacro org-sbe (source-block &rest variables)
"Return the results of calling SOURCE-BLOCK with VARIABLES. "Return the results of calling SOURCE-BLOCK with VARIABLES.
@ -147,6 +148,4 @@ as shown in the example below.
(provide 'ob-table) (provide 'ob-table)
;;; ob-table.el ends here ;;; ob-table.el ends here

View File

@ -41,6 +41,7 @@
(declare-function org-element-type "org-element" (element)) (declare-function org-element-type "org-element" (element))
(declare-function org-heading-components "org" ()) (declare-function org-heading-components "org" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-in-archived-heading-p "org" (&optional no-inheritance))
(declare-function outline-previous-heading "outline" ()) (declare-function outline-previous-heading "outline" ())
(defcustom org-babel-tangle-lang-exts (defcustom org-babel-tangle-lang-exts
@ -166,13 +167,14 @@ evaluating BODY."
(def-edebug-spec org-babel-with-temp-filebuffer (form body)) (def-edebug-spec org-babel-with-temp-filebuffer (form body))
;;;###autoload ;;;###autoload
(defun org-babel-tangle-file (file &optional target-file lang) (defun org-babel-tangle-file (file &optional target-file lang-re)
"Extract the bodies of source code blocks in FILE. "Extract the bodies of source code blocks in FILE.
Source code blocks are extracted with `org-babel-tangle'. Source code blocks are extracted with `org-babel-tangle'.
Optional argument TARGET-FILE can be used to specify a default Optional argument TARGET-FILE can be used to specify a default
export file for all source blocks. Optional argument LANG can be export file for all source blocks. Optional argument LANG-RE can
used to limit the exported source code blocks by language. be used to limit the exported source code blocks by languages
Return a list whose CAR is the tangled file name." matching a regular expression. Return a list whose CAR is the
tangled file name."
(interactive "fFile to tangle: \nP") (interactive "fFile to tangle: \nP")
(let ((visited-p (find-buffer-visiting (expand-file-name file))) (let ((visited-p (find-buffer-visiting (expand-file-name file)))
to-be-removed) to-be-removed)
@ -180,7 +182,7 @@ Return a list whose CAR is the tangled file name."
(save-window-excursion (save-window-excursion
(find-file file) (find-file file)
(setq to-be-removed (current-buffer)) (setq to-be-removed (current-buffer))
(mapcar #'expand-file-name (org-babel-tangle nil target-file lang))) (mapcar #'expand-file-name (org-babel-tangle nil target-file lang-re)))
(unless visited-p (unless visited-p
(kill-buffer to-be-removed))))) (kill-buffer to-be-removed)))))
@ -192,7 +194,7 @@ Return a list whose CAR is the tangled file name."
(mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
;;;###autoload ;;;###autoload
(defun org-babel-tangle (&optional arg target-file lang) (defun org-babel-tangle (&optional arg target-file lang-re)
"Write code blocks to source-specific files. "Write code blocks to source-specific files.
Extract the bodies of all source code blocks from the current Extract the bodies of all source code blocks from the current
file into their own source-specific files. file into their own source-specific files.
@ -200,8 +202,9 @@ With one universal prefix argument, only tangle the block at point.
When two universal prefix arguments, only tangle blocks for the When two universal prefix arguments, only tangle blocks for the
tangle file of the block at point. tangle file of the block at point.
Optional argument TARGET-FILE can be used to specify a default Optional argument TARGET-FILE can be used to specify a default
export file for all source blocks. Optional argument LANG can be export file for all source blocks. Optional argument LANG-RE can
used to limit the exported source code blocks by language." be used to limit the exported source code blocks by languages
matching a regular expression."
(interactive "P") (interactive "P")
(run-hooks 'org-babel-pre-tangle-hook) (run-hooks 'org-babel-pre-tangle-hook)
;; Possibly Restrict the buffer to the current code block ;; Possibly Restrict the buffer to the current code block
@ -286,7 +289,7 @@ used to limit the exported source code blocks by language."
specs))) specs)))
(if (equal arg '(4)) (if (equal arg '(4))
(org-babel-tangle-single-block 1 t) (org-babel-tangle-single-block 1 t)
(org-babel-tangle-collect-blocks lang tangle-file))) (org-babel-tangle-collect-blocks lang-re tangle-file)))
(message "Tangled %d code block%s from %s" block-counter (message "Tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s") (if (= block-counter 1) "" "s")
(file-name-nondirectory (file-name-nondirectory
@ -364,13 +367,14 @@ that the appropriate major-mode is set. SPEC has the form:
(org-fill-template (org-fill-template
org-babel-tangle-comment-format-end link-data))))) org-babel-tangle-comment-format-end link-data)))))
(defun org-babel-tangle-collect-blocks (&optional language tangle-file) (defun org-babel-tangle-collect-blocks (&optional lang-re tangle-file)
"Collect source blocks in the current Org file. "Collect source blocks in the current Org file.
Return an association list of source-code block specifications of Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language. the form used by `org-babel-spec-to-string' grouped by language.
Optional argument LANGUAGE can be used to limit the collected Optional argument LANG-RE can be used to limit the collected
source code blocks by language. Optional argument TANGLE-FILE source code blocks by languages matching a regular expression.
can be used to limit the collected code blocks by target file." Optional argument TANGLE-FILE can be used to limit the collected
code blocks by target file."
(let ((counter 0) last-heading-pos blocks) (let ((counter 0) last-heading-pos blocks)
(org-babel-map-src-blocks (buffer-file-name) (org-babel-map-src-blocks (buffer-file-name)
(let ((current-heading-pos (let ((current-heading-pos
@ -379,13 +383,14 @@ can be used to limit the collected code blocks by target file."
(if (eq last-heading-pos current-heading-pos) (cl-incf counter) (if (eq last-heading-pos current-heading-pos) (cl-incf counter)
(setq counter 1) (setq counter 1)
(setq last-heading-pos current-heading-pos))) (setq last-heading-pos current-heading-pos)))
(unless (org-in-commented-heading-p) (unless (or (org-in-commented-heading-p)
(org-in-archived-heading-p))
(let* ((info (org-babel-get-src-block-info 'light)) (let* ((info (org-babel-get-src-block-info 'light))
(src-lang (nth 0 info)) (src-lang (nth 0 info))
(src-tfile (cdr (assq :tangle (nth 2 info))))) (src-tfile (cdr (assq :tangle (nth 2 info)))))
(unless (or (string= src-tfile "no") (unless (or (string= src-tfile "no")
(and tangle-file (not (equal tangle-file src-tfile))) (and tangle-file (not (equal tangle-file src-tfile)))
(and language (not (string= language src-lang)))) (and lang-re (not (string-match-p lang-re src-lang))))
;; Add the spec for this block to blocks under its ;; Add the spec for this block to blocks under its
;; language. ;; language.
(let ((by-lang (assoc src-lang blocks)) (let ((by-lang (assoc src-lang blocks))
@ -513,14 +518,16 @@ which enable the original code blocks to be found."
(goto-char (point-min)) (goto-char (point-min))
(let ((counter 0) new-body end) (let ((counter 0) new-body end)
(while (re-search-forward org-link-bracket-re nil t) (while (re-search-forward org-link-bracket-re nil t)
(when (re-search-forward (if (and (match-string 2)
(concat " " (regexp-quote (match-string 2)) " ends here")) (re-search-forward
(setq end (match-end 0)) (concat " " (regexp-quote (match-string 2)) " ends here") nil t))
(forward-line -1) (progn (setq end (match-end 0))
(save-excursion (forward-line -1)
(when (setq new-body (org-babel-tangle-jump-to-org)) (save-excursion
(org-babel-update-block-body new-body))) (when (setq new-body (org-babel-tangle-jump-to-org))
(setq counter (+ 1 counter))) (org-babel-update-block-body new-body)))
(setq counter (+ 1 counter)))
(setq end (point)))
(goto-char end)) (goto-char end))
(prog1 counter (message "Detangled %d code blocks" counter))))) (prog1 counter (message "Detangled %d code blocks" counter)))))
@ -541,7 +548,8 @@ which enable the original code blocks to be found."
(save-match-data (save-match-data
(re-search-forward (re-search-forward
(concat " " (regexp-quote block-name) (concat " " (regexp-quote block-name)
" ends here") nil t) " ends here")
nil t)
(setq end (line-beginning-position)))))))) (setq end (line-beginning-position))))))))
(unless (and start (< start mid) (< mid end)) (unless (and start (< start mid) (< mid end))
(error "Not in tangled code")) (error "Not in tangled code"))

View File

@ -98,7 +98,7 @@
(require 'org-macs) (require 'org-macs)
(require 'ol) (require 'ol)
;; Declare functions and variables ;;; Declare functions and variables
(declare-function bbdb "ext:bbdb-com" (string elidep)) (declare-function bbdb "ext:bbdb-com" (string elidep))
(declare-function bbdb-company "ext:bbdb-com" (string elidep)) (declare-function bbdb-company "ext:bbdb-com" (string elidep))
@ -126,9 +126,9 @@
(declare-function diary-ordinal-suffix "diary-lib" (n)) (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 ;;; Customization
(defgroup org-bbdb-anniversaries nil (defgroup org-bbdb-anniversaries nil
"Customizations for including anniversaries from BBDB into Agenda." "Customizations for including anniversaries from BBDB into Agenda."
@ -221,7 +221,8 @@ date year)."
:complete #'org-bbdb-complete-link :complete #'org-bbdb-complete-link
:store #'org-bbdb-store-link) :store #'org-bbdb-store-link)
;; Implementation ;;; Implementation
(defun org-bbdb-store-link () (defun org-bbdb-store-link ()
"Store a link to a BBDB database entry." "Store a link to a BBDB database entry."
(when (eq major-mode 'bbdb-mode) (when (eq major-mode 'bbdb-mode)
@ -236,7 +237,7 @@ date year)."
:link link :description name) :link link :description name)
link))) link)))
(defun org-bbdb-export (path desc format) (defun org-bbdb-export (path desc format _)
"Create the export version of a BBDB link specified by PATH or DESC. "Create the export version of a BBDB link specified by PATH or DESC.
If exporting to either HTML or LaTeX FORMAT the link will be If exporting to either HTML or LaTeX FORMAT the link will be
italicized, in all other cases it is left unchanged." italicized, in all other cases it is left unchanged."
@ -249,7 +250,7 @@ italicized, in all other cases it is left unchanged."
(format "<text:span text:style-name=\"Emphasis\">%s</text:span>" desc)) (format "<text:span text:style-name=\"Emphasis\">%s</text:span>" desc))
(t desc))) (t desc)))
(defun org-bbdb-open (name) (defun org-bbdb-open (name _)
"Follow a BBDB link to NAME." "Follow a BBDB link to NAME."
(require 'bbdb-com) (require 'bbdb-com)
(let ((inhibit-redisplay (not debug-on-error))) (let ((inhibit-redisplay (not debug-on-error)))
@ -362,7 +363,9 @@ This is used by Org to re-create the anniversary hash table."
;;;###autoload ;;;###autoload
(defun org-bbdb-anniversaries () (defun org-bbdb-anniversaries ()
"Extract anniversaries from BBDB for display in the agenda." "Extract anniversaries from BBDB for display in the agenda.
When called programmatically, this function expects the `date'
variable to be globally bound."
(require 'bbdb) (require 'bbdb)
(require 'diary-lib) (require 'diary-lib)
(unless (hash-table-p org-bbdb-anniv-hash) (unless (hash-table-p org-bbdb-anniv-hash)
@ -380,7 +383,7 @@ This is used by Org to re-create the anniversary hash table."
(text ()) (text ())
rec recs) rec recs)
;; we don't want to miss people born on Feb. 29th ;; We don't want to miss people born on Feb. 29th
(when (and (= m 3) (= d 1) (when (and (= m 3) (= d 1)
(not (null (gethash (list 2 29) org-bbdb-anniv-hash))) (not (null (gethash (list 2 29) org-bbdb-anniv-hash)))
(not (calendar-leap-year-p y))) (not (calendar-leap-year-p y)))
@ -415,8 +418,9 @@ This is used by Org to re-create the anniversary hash table."
)) ))
text)) text))
;;; Return list of anniversaries for today and the next n-1 (default: n=7) days. ;;; Return the list of anniversaries for today and the next n-1
;;; This is meant to be used in an org file instead of org-bbdb-anniversaries: ;;; (default: n=7) days. This is meant to be used in an org file
;;; instead of org-bbdb-anniversaries:
;;; ;;;
;;; %%(org-bbdb-anniversaries-future) ;;; %%(org-bbdb-anniversaries-future)
;;; ;;;
@ -442,15 +446,14 @@ for the same event depending on if it occurs in the next few days
or far away in the future." or far away in the future."
(let ((delta (- (calendar-absolute-from-gregorian anniv-date) (let ((delta (- (calendar-absolute-from-gregorian anniv-date)
(calendar-absolute-from-gregorian agenda-date)))) (calendar-absolute-from-gregorian agenda-date))))
(cond (cond
((= delta 0) " -- today\\&") ((= delta 0) " -- today\\&")
((= delta 1) " -- tomorrow\\&") ((= delta 1) " -- tomorrow\\&")
((< delta org-bbdb-general-anniversary-description-after) (format " -- in %d days\\&" delta)) ((< delta org-bbdb-general-anniversary-description-after)
(format " -- in %d days\\&" delta))
((pcase-let ((`(,month ,day ,year) anniv-date)) ((pcase-let ((`(,month ,day ,year) anniv-date))
(format " -- %d-%02d-%02d\\&" year month day)))))) (format " -- %d-%02d-%02d\\&" year month day))))))
(defun org-bbdb-anniversaries-future (&optional n) (defun org-bbdb-anniversaries-future (&optional n)
"Return list of anniversaries for today and the next n-1 days (default n=7)." "Return list of anniversaries for today and the next n-1 days (default n=7)."
(let ((n (or n 7))) (let ((n (or n 7)))

View File

@ -134,7 +134,6 @@
(declare-function org-insert-heading "org" (&optional arg invisible-ok top)) (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-map-entries "org" (func &optional match scope &rest skip))
(declare-function org-narrow-to-subtree "org" ()) (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-set-property "org" (property value))
(declare-function org-toggle-tag "org" (tag &optional onoff)) (declare-function org-toggle-tag "org" (tag &optional onoff))
@ -483,12 +482,11 @@ With optional argument OPTIONAL, also prompt for optional fields."
:follow #'org-bibtex-open :follow #'org-bibtex-open
:store #'org-bibtex-store-link) :store #'org-bibtex-store-link)
(defun org-bibtex-open (path) (defun org-bibtex-open (path arg)
"Visit the bibliography entry on PATH." "Visit the bibliography entry on PATH.
(let* ((search (when (string-match "::\\(.+\\)\\'" path) ARG, when non-nil, is a universal prefix argument. See
(match-string 1 path))) `org-open-file' for details."
(path (substring path 0 (match-beginning 0)))) (org-link-open-as-file path arg))
(org-open-file path t nil search)))
(defun org-bibtex-store-link () (defun org-bibtex-store-link ()
"Store a link to a BibTeX entry." "Store a link to a BibTeX entry."
@ -556,7 +554,8 @@ With optional argument OPTIONAL, also prompt for optional fields."
;; We construct a regexp that searches for "@entrytype{" followed by the key ;; We construct a regexp that searches for "@entrytype{" followed by the key
(goto-char (point-min)) (goto-char (point-min))
(and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*" (and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*"
(regexp-quote s) "[ \t\n]*,") nil t) (regexp-quote s) "[ \t\n]*,")
nil t)
(goto-char (match-beginning 0))) (goto-char (match-beginning 0)))
(if (and (match-beginning 0) (equal current-prefix-arg '(16))) (if (and (match-beginning 0) (equal current-prefix-arg '(16)))
;; Use double prefix to indicate that any web link should be browsed ;; Use double prefix to indicate that any web link should be browsed
@ -596,7 +595,8 @@ Headlines are exported using `org-bibtex-headline'."
(with-temp-file filename (with-temp-file filename
(insert (mapconcat #'identity bibtex-entries "\n"))) (insert (mapconcat #'identity bibtex-entries "\n")))
(message "Successfully exported %d BibTeX entries to %s" (message "Successfully exported %d BibTeX entries to %s"
(length bibtex-entries) filename) nil)))) (length bibtex-entries) filename)
nil))))
(when error-point (when error-point
(goto-char error-point) (goto-char error-point)
(message "Bibtex error at %S" (nth 4 (org-heading-components)))))) (message "Bibtex error at %S" (nth 4 (org-heading-components))))))
@ -661,7 +661,8 @@ This uses `bibtex-parse-entry'."
(when (and (> (length str) 1) (when (and (> (length str) 1)
(= (aref str 0) (car pair)) (= (aref str 0) (car pair))
(= (aref str (1- (length str))) (cdr pair))) (= (aref str (1- (length str))) (cdr pair)))
(setf str (substring str 1 (1- (length str)))))) str))) (setf str (substring str 1 (1- (length str))))))
str)))
(push (mapcar (push (mapcar
(lambda (pair) (lambda (pair)
(cons (let ((field (funcall keyword (car pair)))) (cons (let ((field (funcall keyword (car pair))))

View File

@ -68,7 +68,7 @@
((eq format 'ascii) (format "%s (%s)" desc path)) ((eq format 'ascii) (format "%s (%s)" desc path))
(t path))))) (t path)))))
(defun org-docview-open (link) (defun org-docview-open (link _)
(string-match "\\(.*?\\)\\(?:::\\([0-9]+\\)\\)?$" link) (string-match "\\(.*?\\)\\(?:::\\([0-9]+\\)\\)?$" link)
(let ((path (match-string 1 link)) (let ((path (match-string 1 link))
(page (and (match-beginning 2) (page (and (match-beginning 2)
@ -98,7 +98,6 @@ and append it."
"::" "::"
(read-from-minibuffer "Page:" "1"))) (read-from-minibuffer "Page:" "1")))
(provide 'ol-docview) (provide 'ol-docview)
;;; ol-docview.el ends here ;;; ol-docview.el ends here

View File

@ -33,7 +33,7 @@
:follow #'org-eshell-open :follow #'org-eshell-open
:store #'org-eshell-store-link) :store #'org-eshell-store-link)
(defun org-eshell-open (link) (defun org-eshell-open (link _)
"Switch to an 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 The link can be just a command line (executed in the default
eshell buffer) or a command line prefixed by a buffer name eshell buffer) or a command line prefixed by a buffer name

View File

@ -46,17 +46,22 @@
;;; Code: ;;; Code:
(require 'ol) (require 'ol)
(require 'cl-lib) (require 'cl-lib)
(require 'eww)
;; For Emacsen < 25.
(defvar eww-current-title) (defvar eww-current-title)
(defvar eww-current-url) (defvar eww-current-url)
(defvar eww-data)
(defvar eww-mode-map)
(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) (org-link-set-parameters "eww"
:follow #'org-eww-open
:store #'org-eww-store-link)
(defun org-eww-open (url _)
"Open URL with Eww in the current buffer."
(eww url))
(defun org-eww-store-link () (defun org-eww-store-link ()
"Store a link to the url of an EWW buffer." "Store a link to the url of an EWW buffer."
(when (eq major-mode 'eww-mode) (when (eq major-mode 'eww-mode)

View File

@ -34,7 +34,8 @@
(require 'gnus-sum) (require 'gnus-sum)
(require 'gnus-util) (require 'gnus-util)
(require 'nnheader) (require 'nnheader)
(require 'nnir) (or (require 'nnselect nil t) ; Emacs >= 28
(require 'nnir nil t)) ; Emacs < 28
(require 'ol) (require 'ol)
@ -135,9 +136,15 @@ If `org-store-link' was called with a prefix arg the meaning of
(`(nnvirtual . ,_) (`(nnvirtual . ,_)
(save-excursion (save-excursion
(car (nnvirtual-map-article (gnus-summary-article-number))))) (car (nnvirtual-map-article (gnus-summary-article-number)))))
(`(nnir . ,_) (`(,(or `nnselect `nnir) . ,_) ; nnir is for Emacs < 28.
(save-excursion (save-excursion
(nnir-article-group (gnus-summary-article-number)))) (cond
((fboundp 'nnselect-article-group)
(nnselect-article-group (gnus-summary-article-number)))
((fboundp 'nnir-article-group)
(nnir-article-group (gnus-summary-article-number)))
(t
(error "No article-group variant bound")))))
(_ gnus-newsgroup-name))) (_ gnus-newsgroup-name)))
(header (if (eq major-mode 'gnus-article-mode) (header (if (eq major-mode 'gnus-article-mode)
;; When in an article, first move to summary ;; When in an article, first move to summary
@ -210,7 +217,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(format "nntp+%s:%s" (or (cdr server) (car server)) group) (format "nntp+%s:%s" (or (cdr server) (car server)) group)
article))) article)))
(defun org-gnus-open (path) (defun org-gnus-open (path _)
"Follow the Gnus message or folder link specified by PATH." "Follow the Gnus message or folder link specified by PATH."
(unless (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path) (unless (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)
(error "Error in Gnus link %S" path)) (error "Error in Gnus link %S" path))

View File

@ -59,7 +59,7 @@
:link link :desc desc) :link link :desc desc)
link))) link)))
(defun org-info-open (path) (defun org-info-open (path _)
"Follow an Info file and node link specified by PATH." "Follow an Info file and node link specified by PATH."
(org-info-follow-link path)) (org-info-follow-link path))

View File

@ -78,7 +78,7 @@
:store #'org-irc-store-link :store #'org-irc-store-link
:export #'org-irc-export) :export #'org-irc-export)
(defun org-irc-visit (link) (defun org-irc-visit (link _)
"Parse LINK and dispatch to the correct function based on the client found." "Parse LINK and dispatch to the correct function based on the client found."
(let ((link (org-irc-parse-link link))) (let ((link (org-irc-parse-link link)))
(cond (cond

View File

@ -96,7 +96,7 @@ supported by MH-E."
(org-link-add-props :link link :description desc) (org-link-add-props :link link :description desc)
link)))) link))))
(defun org-mhe-open (path) (defun org-mhe-open (path _)
"Follow an MH-E message link specified by PATH." "Follow an MH-E message link specified by PATH."
(let (folder article) (let (folder article)
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))

View File

@ -43,7 +43,9 @@
(defvar rmail-file-name) ; From rmail.el (defvar rmail-file-name) ; From rmail.el
;; Install the link type ;; Install the link type
(org-link-set-parameters "rmail" :follow #'org-rmail-open :store #'org-rmail-store-link) (org-link-set-parameters "rmail"
:follow #'org-rmail-open
:store #'org-rmail-store-link)
;; Implementation ;; Implementation
(defun org-rmail-store-link () (defun org-rmail-store-link ()
@ -75,7 +77,7 @@
(rmail-show-message rmail-current-message) (rmail-show-message rmail-current-message)
link))))) link)))))
(defun org-rmail-open (path) (defun org-rmail-open (path _)
"Follow an Rmail message link to the specified PATH." "Follow an Rmail message link to the specified PATH."
(let (folder article) (let (folder article)
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))

View File

@ -45,6 +45,7 @@
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(declare-function org-at-heading-p "org" (&optional _)) (declare-function org-at-heading-p "org" (&optional _))
(declare-function org-back-to-heading "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-do-occur "org" (regexp &optional cleanup)) (declare-function org-do-occur "org" (regexp &optional cleanup))
(declare-function org-element-at-point "org-element" ()) (declare-function org-element-at-point "org-element" ())
(declare-function org-element-cache-refresh "org-element" (pos)) (declare-function org-element-cache-refresh "org-element" (pos))
@ -57,7 +58,6 @@
(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-find-property "org" (property &optional value)) (declare-function org-find-property "org" (property &optional value))
(declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
(declare-function org-heading-components "org" ())
(declare-function org-id-find-id-file "org-id" (id)) (declare-function org-id-find-id-file "org-id" (id))
(declare-function org-id-store-link "org-id" ()) (declare-function org-id-store-link "org-id" ())
(declare-function org-insert-heading "org" (&optional arg invisible-ok top)) (declare-function org-insert-heading "org" (&optional arg invisible-ok top))
@ -85,42 +85,94 @@
:group 'org) :group 'org)
(defcustom org-link-parameters nil (defcustom org-link-parameters nil
"An alist of properties that defines all the links in Org mode. "Alist of properties that defines all the links in Org mode.
The key in each association is a string of the link type. The key in each association is a string of the link type.
Subsequent optional elements make up a plist of link properties. Subsequent optional elements make up a property list for that
type.
:follow - A function that takes the link path as an argument. All properties are optional. However, the most important ones
are, in this order, `:follow', `:export', and `:store', described
below.
:export - A function that takes the link path, description and `:follow'
export-backend as arguments.
:store - A function responsible for storing the link. See the Function used to follow the link, when the `org-open-at-point'
function `org-store-link-functions'. command runs on it. It is called with two arguments: the path,
as a string, and a universal prefix argument.
:complete - A function that inserts a link with completion. The Here, you may use `org-link-open-as-file' helper function for
function takes one optional prefix argument. types similar to \"file\".
:face - A face for the link, or a function that returns a face. `:export'
The function takes one argument which is the link path. The
default face is `org-link'.
:mouse-face - The mouse-face. The default is `highlight'. Function that accepts four arguments:
- the path, as a string,
- the description as a string, or nil,
- the export back-end,
- the export communication channel, as a plist.
:display - `full' will not fold the link in descriptive When nil, export for that type of link is delegated to the
display. Default is `org-link'. back-end.
:help-echo - A string or function that takes (window object position) `:store'
as arguments and returns a string.
:keymap - A keymap that is active on the link. The default is Function responsible for storing the link. See the function
`org-mouse-map'. `org-store-link-functions' for a description of the expected
arguments.
:htmlize-link - A function for the htmlize-link. Defaults Additional properties provide more specific control over the
to (list :uri \"type:path\") link.
:activate-func - A function to run at the end of font-lock `:activate-func'
activation. The function must accept (link-start link-end path bracketp)
as arguments." Function to run at the end of Font Lock activation. It must
accept four arguments:
- the buffer position at the start of the link,
- the buffer position at its end,
- the path, as a string,
- a boolean, non-nil when the link has brackets.
`:complete'
Function that inserts a link with completion. The function
takes one optional prefix argument.
`:display'
Value for `invisible' text property on the hidden parts of the
link. The most useful value is `full', which will not fold the
link in descriptive display. Default is `org-link'.
`:face'
Face for the link, or a function returning a face. The
function takes one argument, which is the path.
The default face is `org-link'.
`:help-echo'
String or function used as a value for the `help-echo' text
property. The function is called with one argument, the help
string to display, and should return a string.
`:htmlize-link'
Function or plist for the `htmlize-link' text property. The
function takes no argument.
Default is (:uri \"type:path\")
`:keymap'
Active keymap when point is on the link. Default is
`org-mouse-map'.
`:mouse-face'
Face used when hovering over the link. Default is
`highlight'."
:group 'org-link :group 'org-link
:package-version '(Org . "9.1") :package-version '(Org . "9.1")
:type '(alist :tag "Link display parameters" :type '(alist :tag "Link display parameters"
@ -408,7 +460,7 @@ This is for example useful to limit the length of the subject.
Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\""
:group 'org-link-store :group 'org-link-store
:package-version '(Org . 9.3) :package-version '(Org . "9.3")
:type 'string :type 'string
:safe #'stringp) :safe #'stringp)
@ -674,6 +726,44 @@ White spaces are not significant."
(goto-char origin) (goto-char origin)
(user-error "No match for radio target: %s" target)))) (user-error "No match for radio target: %s" target))))
(defun org-link--context-from-region ()
"Return context string from active region, or nil."
(when (org-region-active-p)
(let ((context (buffer-substring (region-beginning) (region-end))))
(when (and (wholenump org-link-context-for-files)
(> org-link-context-for-files 0))
(let ((lines (org-split-string context "\n")))
(setq context
(mapconcat #'identity
(cl-subseq lines 0 org-link-context-for-files)
"\n"))))
context)))
(defun org-link--normalize-string (string &optional context)
"Remove ignored contents from STRING string and return it.
This function removes contiguous white spaces and statistics
cookies. When optional argument CONTEXT is non-nil, it assumes
STRING is a context string, and also removes special search
syntax around the string."
(let ((string
(org-trim
(replace-regexp-in-string
(rx (one-or-more (any " \t")))
" "
(replace-regexp-in-string
;; Statistics cookie regexp.
(rx (seq "[" (0+ digit) (or "%" (seq "/" (0+ digit))) "]"))
" "
string)))))
(when context
(while (cond ((and (string-prefix-p "(" string)
(string-suffix-p ")" string))
(setq string (org-trim (substring string 1 -1))))
((string-match "\\`[#*]+[ \t]*" string)
(setq string (substring string (match-end 0))))
(t nil))))
string))
;;; Public API ;;; Public API
@ -692,6 +782,8 @@ TYPE is a string and KEY is a plist keyword. See
"Set link TYPE properties to PARAMETERS. "Set link TYPE properties to PARAMETERS.
PARAMETERS should be keyword value pairs. See PARAMETERS should be keyword value pairs. See
`org-link-parameters' for supported keys." `org-link-parameters' for supported keys."
(when (member type '("coderef" "custom-id" "fuzzy" "radio"))
(error "Cannot override reserved link type: %S" type))
(let ((data (assoc type org-link-parameters))) (let ((data (assoc type org-link-parameters)))
(if data (setcdr data (org-combine-plists (cdr data) parameters)) (if data (setcdr data (org-combine-plists (cdr data) parameters))
(push (cons type parameters) org-link-parameters) (push (cons type parameters) org-link-parameters)
@ -855,9 +947,7 @@ E.g. \"%C3%B6\" becomes the german o-Umlaut."
(defun org-link-make-string (link &optional description) (defun org-link-make-string (link &optional description)
"Make a bracket link, consisting of LINK and DESCRIPTION. "Make a bracket link, consisting of LINK and DESCRIPTION.
LINK is escaped with backslashes for inclusion in buffer." LINK is escaped with backslashes for inclusion in buffer."
(unless (org-string-nw-p link) (error "Empty link")) (let* ((zero-width-space (string ?\x200B))
(let* ((uri (org-link-escape link))
(zero-width-space (string ?\x200B))
(description (description
(and (org-string-nw-p description) (and (org-string-nw-p description)
;; Description cannot contain two consecutive square ;; Description cannot contain two consecutive square
@ -870,9 +960,10 @@ LINK is escaped with backslashes for inclusion in buffer."
(replace-regexp-in-string "]\\'" (replace-regexp-in-string "]\\'"
(concat "\\&" zero-width-space) (concat "\\&" zero-width-space)
(org-trim description)))))) (org-trim description))))))
(format "[[%s]%s]" (if (not (org-string-nw-p link)) description
uri (format "[[%s]%s]"
(if description (format "[%s]" description) "")))) (org-link-escape link)
(if description (format "[%s]" description) "")))))
(defun org-store-link-functions () (defun org-store-link-functions ()
"List of functions that are called to create and store a link. "List of functions that are called to create and store a link.
@ -919,7 +1010,8 @@ Abbreviations are defined in `org-link-abbrev-alist'."
((string-match "%(\\([^)]+\\))" rpl) ((string-match "%(\\([^)]+\\))" rpl)
(replace-match (replace-match
(save-match-data (save-match-data
(funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl)) (funcall (intern-soft (match-string 1 rpl)) tag))
t t rpl))
((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) ((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
((string-match "%h" rpl) ((string-match "%h" rpl)
(replace-match (url-hexify-string (or tag "")) t t rpl)) (replace-match (url-hexify-string (or tag "")) t t rpl))
@ -927,63 +1019,60 @@ Abbreviations are defined in `org-link-abbrev-alist'."
(defun org-link-open (link &optional arg) (defun org-link-open (link &optional arg)
"Open a link object LINK. "Open a link object LINK.
Optional argument is passed to `org-open-file' when S is
a \"file\" link." ARG is an optional prefix argument. Some link types may handle
it. For example, it determines what application to run when
opening a \"file\" link.
Functions responsible for opening the link are either hard-coded
for internal and \"file\" links, or stored as a parameter in
`org-link-parameters', which see."
(let ((type (org-element-property :type link)) (let ((type (org-element-property :type link))
(path (org-element-property :path link))) (path (org-element-property :path link)))
(cond (pcase type
((equal type "file") ;; Opening a "file" link requires special treatment since we
(if (string-match "[*?{]" (file-name-nondirectory path)) ;; first need to integrate search option, if any.
(dired path) ("file"
;; Look into `org-link-parameters' in order to find (let* ((option (org-element-property :search-option link))
;; a DEDICATED-FUNCTION to open file. The function will be (path (if option (concat path "::" option) path)))
;; applied on raw link instead of parsed link due to the (org-link-open-as-file path
;; limitation in `org-add-link-type' ("open" function called (pcase (org-element-property :application link)
;; with a single argument). If no such function is found, ((guard arg) arg)
;; fallback to `org-open-file'. ("emacs" 'emacs)
(let* ((option (org-element-property :search-option link)) ("sys" 'system)))))
(app (org-element-property :application link)) ;; Internal links.
(dedicated-function ((or "coderef" "custom-id" "fuzzy" "radio")
(org-link-get-parameter (if app (concat type "+" app) type) (unless (run-hook-with-args-until-success 'org-open-link-functions path)
:follow))) (if (not arg) (org-mark-ring-push)
(if dedicated-function (switch-to-buffer-other-window (org-link--buffer-for-internals)))
(funcall dedicated-function (let ((destination
(concat path (org-with-wide-buffer
(and option (concat "::" option)))) (if (equal type "radio")
(apply #'org-open-file (org-link--search-radio-target path)
path (org-link-search
(cond (arg) (pcase type
((equal app "emacs") 'emacs) ("custom-id" (concat "#" path))
((equal app "sys") 'system)) ("coderef" (format "(%s)" path))
(cond ((not option) nil) (_ path))
((string-match-p "\\`[0-9]+\\'" option) ;; Prevent fuzzy links from matching themselves.
(list (string-to-number option))) (and (equal type "fuzzy")
(t (list nil option)))))))) (+ 2 (org-element-property :begin link)))))
((functionp (org-link-get-parameter type :follow)) (point))))
(funcall (org-link-get-parameter type :follow) path)) (unless (and (<= (point-min) destination)
((member type '("coderef" "custom-id" "fuzzy" "radio")) (>= (point-max) destination))
(unless (run-hook-with-args-until-success 'org-open-link-functions path) (widen))
(if (not arg) (org-mark-ring-push) (goto-char destination))))
(switch-to-buffer-other-window (org-link--buffer-for-internals))) (_
(let ((destination ;; Look for a dedicated "follow" function in custom links.
(org-with-wide-buffer (let ((f (org-link-get-parameter type :follow)))
(if (equal type "radio") (when (functionp f)
(org-link--search-radio-target ;; Function defined in `:follow' parameter may use a single
(org-element-property :path link)) ;; argument, as it was mandatory before Org 9.4. This is
(org-link-search ;; deprecated, but support it for now.
(pcase type (condition-case nil
("custom-id" (concat "#" path)) (funcall (org-link-get-parameter type :follow) path arg)
("coderef" (format "(%s)" path)) (wrong-number-of-arguments
(_ path)) (funcall (org-link-get-parameter type :follow) path)))))))))
;; Prevent fuzzy links from matching themselves.
(and (equal type "fuzzy")
(+ 2 (org-element-property :begin link)))))
(point))))
(unless (and (<= (point-min) destination)
(>= (point-max) destination))
(widen))
(goto-char destination))))
(t (browse-url-at-point)))))
(defun org-link-open-from-string (s &optional arg) (defun org-link-open-from-string (s &optional arg)
"Open a link in the string S, as if it was in Org mode. "Open a link in the string S, as if it was in Org mode.
@ -1100,18 +1189,14 @@ of matched result, which is either `dedicated' or `fuzzy'."
(format "%s.*\\(?:%s[ \t]\\)?.*%s" (format "%s.*\\(?:%s[ \t]\\)?.*%s"
org-outline-regexp-bol org-outline-regexp-bol
org-comment-string org-comment-string
(mapconcat #'regexp-quote words ".+"))) (mapconcat #'regexp-quote words ".+"))))
(cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]")
(comment-re (format "\\`%s[ \t]+" org-comment-string)))
(goto-char (point-min)) (goto-char (point-min))
(catch :found (catch :found
(while (re-search-forward title-re nil t) (while (re-search-forward title-re nil t)
(when (equal words (when (equal words
(split-string (split-string
(replace-regexp-in-string (org-link--normalize-string
cookie-re "" (org-get-heading t t t t))))
(replace-regexp-in-string
comment-re "" (org-get-heading t t t)))))
(throw :found t))) (throw :found t)))
nil))) nil)))
(beginning-of-line) (beginning-of-line)
@ -1162,24 +1247,40 @@ of matched result, which is either `dedicated' or `fuzzy'."
type)) type))
(defun org-link-heading-search-string (&optional string) (defun org-link-heading-search-string (&optional string)
"Make search string for the current headline or STRING." "Make search string for the current headline or STRING.
(let ((s (or string
(and (derived-mode-p 'org-mode) Search string starts with an asterisk. COMMENT keyword and
(save-excursion statistics cookies are removed, and contiguous spaces are packed
(org-back-to-heading t) into a single one.
(org-element-property :raw-value
(org-element-at-point)))))) When optional argument STRING is non-nil, assume it a headline,
(lines org-link-context-for-files)) without any asterisk, TODO or COMMENT keyword, and without any
(unless string (setq s (concat "*" s))) ;Add * for headlines priority cookie or tag."
(setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) (concat "*"
(when (and string (integerp lines) (> lines 0)) (org-link--normalize-string
(let ((slines (org-split-string s "\n"))) (or string (org-get-heading t t t t)))))
(when (< lines (length slines))
(setq s (mapconcat (defun org-link-open-as-file (path arg)
#'identity "Pretend PATH is a file name and open it.
(reverse (nthcdr (- (length slines) lines)
(reverse slines))) "\n"))))) According to \"file\"-link syntax, PATH may include additional
(mapconcat #'identity (split-string s) " "))) search options, separated from the file name with \"::\".
This function is meant to be used as a possible tool for
`:follow' property in `org-link-parameters'."
(let* ((option (and (string-match "::\\(.*\\)\\'" path)
(match-string 1 path)))
(file-name (if (not option) path
(substring path 0 (match-beginning 0)))))
(if (string-match "[*?{]" (file-name-nondirectory file-name))
(dired file-name)
(apply #'org-open-file
file-name
arg
(cond ((not option) nil)
((string-match-p "\\`[0-9]+\\'" option)
(list (string-to-number option)))
(t (list nil option)))))))
(defun org-link-display-format (s) (defun org-link-display-format (s)
"Replace links in string S with their description. "Replace links in string S with their description.
@ -1200,15 +1301,15 @@ If there is no description, use the link target."
;;; Built-in link types ;;; Built-in link types
;;;; "doi" link type ;;;; "doi" link type
(defun org-link--open-doi (path) (defun org-link--open-doi (path arg)
"Open a \"doi\" type link. "Open a \"doi\" type link.
PATH is a the path to search for, as a string." PATH is a the path to search for, as a string."
(browse-url (url-encode-url (concat org-link-doi-server-url path)))) (browse-url (url-encode-url (concat org-link-doi-server-url path)) arg))
(org-link-set-parameters "doi" :follow #'org-link--open-doi) (org-link-set-parameters "doi" :follow #'org-link--open-doi)
;;;; "elisp" link type ;;;; "elisp" link type
(defun org-link--open-elisp (path) (defun org-link--open-elisp (path _)
"Open a \"elisp\" type link. "Open a \"elisp\" type link.
PATH is the sexp to evaluate, as a string." PATH is the sexp to evaluate, as a string."
(if (or (and (org-string-nw-p org-link-elisp-skip-confirm-regexp) (if (or (and (org-string-nw-p org-link-elisp-skip-confirm-regexp)
@ -1229,7 +1330,7 @@ PATH is the sexp to evaluate, as a string."
(org-link-set-parameters "file" :complete #'org-link-complete-file) (org-link-set-parameters "file" :complete #'org-link-complete-file)
;;;; "help" link type ;;;; "help" link type
(defun org-link--open-help (path) (defun org-link--open-help (path _)
"Open a \"help\" type link. "Open a \"help\" type link.
PATH is a symbol name, as a string." PATH is a symbol name, as a string."
(pcase (intern path) (pcase (intern path)
@ -1243,10 +1344,11 @@ PATH is a symbol name, as a string."
(dolist (scheme '("ftp" "http" "https" "mailto" "news")) (dolist (scheme '("ftp" "http" "https" "mailto" "news"))
(org-link-set-parameters scheme (org-link-set-parameters scheme
:follow :follow
(lambda (url) (browse-url (concat scheme ":" url))))) (lambda (url arg)
(browse-url (concat scheme ":" url) arg))))
;;;; "shell" link type ;;;; "shell" link type
(defun org-link--open-shell (path) (defun org-link--open-shell (path _)
"Open a \"shell\" type link. "Open a \"shell\" type link.
PATH is the command to execute, as a string." PATH is the command to execute, as a string."
(if (or (and (org-string-nw-p org-link-shell-skip-confirm-regexp) (if (or (and (org-string-nw-p org-link-shell-skip-confirm-regexp)
@ -1364,7 +1466,7 @@ non-nil."
(move-beginning-of-line 2) (move-beginning-of-line 2)
(set-mark (point))))) (set-mark (point)))))
(setq org-store-link-plist nil) (setq org-store-link-plist nil)
(let (link cpltxt desc description search txt custom-id agenda-link) (let (link cpltxt desc description search custom-id agenda-link)
(cond (cond
;; Store a link using an external link type, if any function is ;; Store a link using an external link type, if any function is
;; available. If more than one can generate a link from current ;; available. If more than one can generate a link from current
@ -1529,30 +1631,35 @@ non-nil."
(abbreviate-file-name (abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))))) (buffer-file-name (buffer-base-buffer))))))))
(t (t
;; Just link to current headline ;; Just link to current headline.
(setq cpltxt (concat "file:" (setq cpltxt (concat "file:"
(abbreviate-file-name (abbreviate-file-name
(buffer-file-name (buffer-base-buffer))))) (buffer-file-name (buffer-base-buffer)))))
;; Add a context search string ;; Add a context search string.
(when (org-xor org-link-context-for-files (equal arg '(4))) (when (org-xor org-link-context-for-files (equal arg '(4)))
(let* ((element (org-element-at-point)) (let* ((element (org-element-at-point))
(name (org-element-property :name element))) (name (org-element-property :name element))
(setq txt (cond (context
((org-at-heading-p) nil) (cond
(name) ((let ((region (org-link--context-from-region)))
((org-region-active-p) (and region (org-link--normalize-string region t))))
(buffer-substring (region-beginning) (region-end))))) (name)
(when (or (null txt) (string-match "\\S-" txt)) ((org-before-first-heading-p)
(setq cpltxt (org-link--normalize-string (org-current-line-string) t))
(concat cpltxt "::" (t (org-link-heading-search-string)))))
(condition-case nil (when (org-string-nw-p context)
(org-link-heading-search-string txt) (setq cpltxt (format "%s::%s" cpltxt context))
(error ""))) (setq desc
desc (or name (or name
(nth 4 (ignore-errors (org-heading-components))) ;; Although description is not a search
"NONE"))))) ;; string, use `org-link--normalize-string'
(when (string-match "::\\'" cpltxt) ;; to prettify it (contiguous white spaces)
(setq cpltxt (substring cpltxt 0 -2))) ;; and remove volatile contents (statistics
;; cookies).
(and (not (org-before-first-heading-p))
(org-link--normalize-string
(org-get-heading t t t t)))
"NONE")))))
(setq link cpltxt))))) (setq link cpltxt)))))
((buffer-file-name (buffer-base-buffer)) ((buffer-file-name (buffer-base-buffer))
@ -1560,16 +1667,16 @@ non-nil."
(setq cpltxt (concat "file:" (setq cpltxt (concat "file:"
(abbreviate-file-name (abbreviate-file-name
(buffer-file-name (buffer-base-buffer))))) (buffer-file-name (buffer-base-buffer)))))
;; Add a context string. ;; Add a context search string.
(when (org-xor org-link-context-for-files (equal arg '(4))) (when (org-xor org-link-context-for-files (equal arg '(4)))
(setq txt (if (org-region-active-p) (let ((context (org-link--normalize-string
(buffer-substring (region-beginning) (region-end)) (or (org-link--context-from-region)
(buffer-substring (point-at-bol) (point-at-eol)))) (org-current-line-string))
;; Only use search option if there is some text. t)))
(when (string-match "\\S-" txt) ;; Only use search option if there is some text.
(setq cpltxt (when (org-string-nw-p context)
(concat cpltxt "::" (org-link-heading-search-string txt)) (setq cpltxt (format "%s::%s" cpltxt context))
desc "NONE"))) (setq desc "NONE"))))
(setq link cpltxt)) (setq link cpltxt))
(interactive? (interactive?
@ -1584,15 +1691,19 @@ non-nil."
(cond ((not desc)) (cond ((not desc))
((equal desc "NONE") (setq desc nil)) ((equal desc "NONE") (setq desc nil))
(t (setq desc (org-link-display-format desc)))) (t (setq desc (org-link-display-format desc))))
;; Return the link ;; Store and return the link
(if (not (and interactive? link)) (if (not (and interactive? link))
(or agenda-link (and link (org-link-make-string link desc))) (or agenda-link (and link (org-link-make-string link desc)))
(push (list link desc) org-stored-links) (if (member (list link desc) org-stored-links)
(message "Stored: %s" (or desc link)) (message "This link already exists")
(when custom-id (push (list link desc) org-stored-links)
(setq link (concat "file:" (abbreviate-file-name (message "Stored: %s" (or desc link))
(buffer-file-name)) "::#" custom-id)) (when custom-id
(push (list link desc) org-stored-links)) (setq link (concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))
"::#" custom-id))
(push (list link desc) org-stored-links)))
(car org-stored-links))))) (car org-stored-links)))))
;;;###autoload ;;;###autoload
@ -1732,13 +1843,14 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
;; Check if we are linking to the current file with a search ;; Check if we are linking to the current file with a search
;; option If yes, simplify the link by using only the search ;; option If yes, simplify the link by using only the search
;; option. ;; option.
(when (and buffer-file-name (when (and (buffer-file-name (buffer-base-buffer))
(let ((case-fold-search nil)) (let ((case-fold-search nil))
(string-match "\\`file:\\(.+?\\)::" link))) (string-match "\\`file:\\(.+?\\)::" link)))
(let ((path (match-string-no-properties 1 link)) (let ((path (match-string-no-properties 1 link))
(search (substring-no-properties link (match-end 0)))) (search (substring-no-properties link (match-end 0))))
(save-match-data (save-match-data
(when (equal (file-truename buffer-file-name) (file-truename path)) (when (equal (file-truename (buffer-file-name (buffer-base-buffer)))
(file-truename path))
;; We are linking to this same file, with a search option ;; We are linking to this same file, with a search option
(setq link search))))) (setq link search)))))
@ -1898,7 +2010,10 @@ Also refresh fontification if needed."
(org-link-make-regexps) (org-link-make-regexps)
(provide 'ol) (provide 'ol)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; ol.el ends here ;;; ol.el ends here

File diff suppressed because it is too large Load Diff

View File

@ -91,6 +91,25 @@ When a string, a %s formatter will be replaced by the file name."
(const :tag "When archiving a subtree to the same file" infile) (const :tag "When archiving a subtree to the same file" infile)
(const :tag "Always" t))) (const :tag "Always" t)))
(defcustom org-archive-subtree-save-file-p 'from-org
"Conditionally save the archive file after archiving a subtree.
This variable can be any of the following symbols:
t saves in all cases.
`from-org' prevents saving from an agenda-view.
`from-agenda' saves only when the archive is initiated from an agenda-view.
nil prevents saving in all cases.
Note that, regardless of this value, the archive buffer is never
saved when archiving into a location in the current buffer."
:group 'org-archive
:package-version '(Org . "9.4")
:type '(choice
(const :tag "Save archive buffer" t)
(const :tag "Save when archiving from agenda" from-agenda)
(const :tag "Save when archiving from an Org buffer" from-org)
(const :tag "Do not save")))
(defcustom org-archive-save-context-info '(time file olpath category todo itags) (defcustom org-archive-save-context-info '(time file olpath category todo itags)
"Parts of context info that should be stored as properties when archiving. "Parts of context info that should be stored as properties when archiving.
When a subtree is moved to an archive file, it loses information given by When a subtree is moved to an archive file, it loses information given by
@ -361,6 +380,15 @@ direct children of this heading."
(point) (point)
(concat "ARCHIVE_" (upcase (symbol-name item))) (concat "ARCHIVE_" (upcase (symbol-name item)))
value)))) value))))
;; Save the buffer, if it is not the same buffer and
;; depending on `org-archive-subtree-save-file-p'.
(unless (eq this-buffer buffer)
(when (or (eq org-archive-subtree-save-file-p t)
(eq org-archive-subtree-save-file-p
(if (boundp 'org-archive-from-agenda)
'from-agenda
'from-org)))
(save-buffer)))
(widen)))) (widen))))
;; Here we are back in the original buffer. Everything seems ;; Here we are back in the original buffer. Everything seems
;; to have worked. So now run hooks, cut the tree and finish ;; to have worked. So now run hooks, cut the tree and finish

View File

@ -40,6 +40,8 @@
(require 'org-id) (require 'org-id)
(declare-function dired-dwim-target-directory "dired-aux") (declare-function dired-dwim-target-directory "dired-aux")
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(defgroup org-attach nil (defgroup org-attach nil
"Options concerning attachments in Org mode." "Options concerning attachments in Org mode."
@ -137,7 +139,8 @@ Selective means to respect the inheritance setting in
:type '(choice :type '(choice
(const :tag "Don't store link" nil) (const :tag "Don't store link" nil)
(const :tag "Link to origin location" t) (const :tag "Link to origin location" t)
(const :tag "Link to the attach-dir location" attached))) (const :tag "Attachment link to the attach-dir location" attached)
(const :tag "File link to the attach-dir location" file)))
(defcustom org-attach-archive-delete nil (defcustom org-attach-archive-delete nil
"Non-nil means attachments are deleted upon archiving a subtree. "Non-nil means attachments are deleted upon archiving a subtree.
@ -252,16 +255,16 @@ Shows a list of commands and prompts for another key to execute a command."
(get-text-property (point) 'org-marker))) (get-text-property (point) 'org-marker)))
(unless marker (unless marker
(error "No item in current line"))) (error "No item in current line")))
(save-excursion (org-with-point-at marker
(when marker (org-back-to-heading-or-point-min t)
(set-buffer (marker-buffer marker))
(goto-char marker))
(org-back-to-heading t)
(save-excursion (save-excursion
(save-window-excursion (save-window-excursion
(unless org-attach-expert (unless org-attach-expert
(with-output-to-temp-buffer "*Org Attach*" (org-switch-to-buffer-other-window "*Org Attach*")
(princ (erase-buffer)
(setq cursor-type nil
header-line-format "Use C-v, M-v, C-n or C-p to navigate.")
(insert
(concat "Attachment folder:\n" (concat "Attachment folder:\n"
(or dir (or dir
"Can't find an existing attachment-folder") "Can't find an existing attachment-folder")
@ -284,11 +287,14 @@ Shows a list of commands and prompts for another key to execute a command."
"Invalid `org-attach-commands' item: %S" "Invalid `org-attach-commands' item: %S"
entry)))) entry))))
org-attach-commands org-attach-commands
"\n")))))) "\n")))))
(org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) (org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
(message "Select command: [%s]" (let ((msg (format "Select command: [%s]"
(concat (mapcar #'caar org-attach-commands))) (concat (mapcar #'caar org-attach-commands)))))
(setq c (read-char-exclusive)) (message msg)
(while (and (setq c (read-char-exclusive))
(memq c '(14 16 22 134217846)))
(org-scroll c t)))
(and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*")))) (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))
(let ((command (cl-some (lambda (entry) (let ((command (cl-some (lambda (entry)
(and (memq c (nth 0 entry)) (nth 1 entry))) (and (memq c (nth 0 entry)) (nth 1 entry)))
@ -455,14 +461,6 @@ DIR-property exists (that is different from the unset one)."
"Turn the autotag off." "Turn the autotag off."
(org-attach-tag 'off)) (org-attach-tag 'off))
(defun org-attach-store-link (file)
"Add a link to `org-stored-link' when attaching a file.
Only do this when `org-attach-store-link-p' is non-nil."
(setq org-stored-links
(cons (list (org-attach-expand-link file)
(file-name-nondirectory file))
org-stored-links)))
(defun org-attach-url (url) (defun org-attach-url (url)
(interactive "MURL of the file to attach: \n") (interactive "MURL of the file to attach: \n")
(let ((org-attach-method 'url)) (let ((org-attach-method 'url))
@ -499,19 +497,27 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
(setq method (or method org-attach-method)) (setq method (or method org-attach-method))
(let ((basename (file-name-nondirectory file))) (let ((basename (file-name-nondirectory file)))
(let* ((attach-dir (org-attach-dir 'get-create)) (let* ((attach-dir (org-attach-dir 'get-create))
(fname (expand-file-name basename attach-dir))) (attach-file (expand-file-name basename attach-dir)))
(cond (cond
((eq method 'mv) (rename-file file fname)) ((eq method 'mv) (rename-file file attach-file))
((eq method 'cp) (copy-file file fname)) ((eq method 'cp) (copy-file file attach-file))
((eq method 'ln) (add-name-to-file file fname)) ((eq method 'ln) (add-name-to-file file attach-file))
((eq method 'lns) (make-symbolic-link file fname)) ((eq method 'lns) (make-symbolic-link file attach-file))
((eq method 'url) (url-copy-file file fname))) ((eq method 'url) (url-copy-file file attach-file)))
(run-hook-with-args 'org-attach-after-change-hook attach-dir) (run-hook-with-args 'org-attach-after-change-hook attach-dir)
(org-attach-tag) (org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached) (cond ((eq org-attach-store-link-p 'attached)
(org-attach-store-link fname)) (push (list (concat "attachment:" (file-name-nondirectory attach-file))
(file-name-nondirectory attach-file))
org-stored-links))
((eq org-attach-store-link-p t) ((eq org-attach-store-link-p t)
(org-attach-store-link file))) (push (list (concat "file:" file)
(file-name-nondirectory file))
org-stored-links))
((eq org-attach-store-link-p 'file)
(push (list (concat "file:" attach-file)
(file-name-nondirectory attach-file))
org-stored-links)))
(if visit-dir (if visit-dir
(dired attach-dir) (dired attach-dir)
(message "File %S is now an attachment" basename))))) (message "File %S is now an attachment" basename)))))
@ -645,37 +651,37 @@ See `org-attach-open'."
Basically, this adds the path to the attachment directory." Basically, this adds the path to the attachment directory."
(expand-file-name file (org-attach-dir))) (expand-file-name file (org-attach-dir)))
(defun org-attach-expand-link (file) (defun org-attach-expand-links (_)
"Return a file link pointing to the current entry's attachment file FILE. "Expand links in current buffer.
Basically, this adds the path to the attachment directory, and a \"file:\" It is meant to be added to `org-export-before-parsing-hook'."
prefix." (save-excursion
(concat "file:" (org-attach-expand file))) (while (re-search-forward "attachment:" nil t)
(let ((link (org-element-context)))
(when (and (eq 'link (org-element-type link))
(string-equal "attachment"
(org-element-property :type link)))
(let* ((description (and (org-element-property :contents-begin link)
(buffer-substring-no-properties
(org-element-property :contents-begin link)
(org-element-property :contents-end link))))
(file (org-element-property :path link))
(new-link (org-link-make-string
(concat "file:" (org-attach-expand file))
description)))
(goto-char (org-element-property :end link))
(skip-chars-backward " \t")
(delete-region (org-element-property :begin link) (point))
(insert new-link)))))))
(defun org-attach-follow (file arg)
"Open FILE attachment.
See `org-open-file' for details about ARG."
(org-link-open-as-file (org-attach-expand file) arg))
(org-link-set-parameters "attachment" (org-link-set-parameters "attachment"
:follow #'org-attach-open-link :follow #'org-attach-follow
:export #'org-attach-export-link
:complete #'org-attach-complete-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 () (defun org-attach-complete-link ()
"Advise the user with the available files in the attachment directory." "Advise the user with the available files in the attachment directory."
(let ((attach-dir (org-attach-dir))) (let ((attach-dir (org-attach-dir)))
@ -694,26 +700,6 @@ and to use an external application to visit the file."
(t (concat "attachment:" file)))) (t (concat "attachment:" file))))
(error "No attachment directory exist")))) (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 () (defun org-attach-archive-delete-maybe ()
"Maybe delete subtree attachments when archiving. "Maybe delete subtree attachments when archiving.
This function is called by `org-archive-hook'. The option This function is called by `org-archive-hook'. The option
@ -761,6 +747,7 @@ Idea taken from `gnus-dired-attach'."
(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe) (add-hook 'org-archive-hook 'org-attach-archive-delete-maybe)
(add-hook 'org-export-before-parsing-hook 'org-attach-expand-links)
(provide 'org-attach) (provide 'org-attach)

View File

@ -49,11 +49,13 @@
(require 'cl-lib) (require 'cl-lib)
(require 'org) (require 'org)
(require 'org-refile)
(declare-function org-at-encrypted-entry-p "org-crypt" ()) (declare-function org-at-encrypted-entry-p "org-crypt" ())
(declare-function org-at-table-p "org-table" (&optional table-type)) (declare-function org-at-table-p "org-table" (&optional table-type))
(declare-function org-clock-update-mode-line "org-clock" (&optional refresh)) (declare-function org-clock-update-mode-line "org-clock" (&optional refresh))
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
(declare-function org-datetree-find-month-create (d &optional keep-restriction))
(declare-function org-decrypt-entry "org-crypt" ()) (declare-function org-decrypt-entry "org-crypt" ())
(declare-function org-element-at-point "org-element" ()) (declare-function org-element-at-point "org-element" ())
(declare-function org-element-lineage "org-element" (datum &optional types with-self)) (declare-function org-element-lineage "org-element" (datum &optional types with-self))
@ -68,6 +70,7 @@
(defvar dired-buffers) (defvar dired-buffers)
(defvar org-end-time-was-given) (defvar org-end-time-was-given)
(defvar org-keyword-properties)
(defvar org-remember-default-headline) (defvar org-remember-default-headline)
(defvar org-remember-templates) (defvar org-remember-templates)
(defvar org-store-link-plist) (defvar org-store-link-plist)
@ -329,7 +332,7 @@ be replaced with content and expanded:
%^L Like %^C, but insert as link. %^L Like %^C, but insert as link.
%^{prop}p Prompt the user for a value for property `prop'. %^{prop}p Prompt the user for a value for property `prop'.
%^{prompt} Prompt the user for a string and replace this sequence with it. %^{prompt} Prompt the user for a string and replace this sequence with it.
A default value and a completion table ca be specified like this: A default value and a completion table can be specified like this:
%^{prompt|default|completion2|completion3|...}. %^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here. %? After completing the template, position cursor here.
%\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N %\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N
@ -1006,11 +1009,13 @@ Store them in the capture property list."
(org-capture-put-target-region-and-position) (org-capture-put-target-region-and-position)
(widen) (widen)
;; Make a date/week tree entry, with the current date (or ;; Make a date/week tree entry, with the current date (or
;; yesterday, if we are extending dates for a couple of hours) ;; yesterday, if we are extending dates for a couple of
;; hours)
(funcall (funcall
(if (eq (org-capture-get :tree-type) 'week) (pcase (org-capture-get :tree-type)
#'org-datetree-find-iso-week-create (`week #'org-datetree-find-iso-week-create)
#'org-datetree-find-date-create) (`month #'org-datetree-find-month-create)
(_ #'org-datetree-find-date-create))
(calendar-gregorian-from-absolute (calendar-gregorian-from-absolute
(cond (cond
(org-overriding-default-time (org-overriding-default-time
@ -1031,7 +1036,7 @@ Store them in the capture property list."
(apply #'encode-time 0 0 (apply #'encode-time 0 0
org-extend-today-until org-extend-today-until
(cl-cdddr (decode-time prompt-time)))) (cl-cdddr (decode-time prompt-time))))
((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" ((string-match "\\([^ ]+\\)-[^ ]+[ ]+\\(.*\\)"
org-read-date-final-answer) org-read-date-final-answer)
;; Replace any time range by its start. ;; Replace any time range by its start.
(apply #'encode-time (apply #'encode-time
@ -1068,7 +1073,7 @@ Store them in the capture property list."
(org-capture-put-target-region-and-position) (org-capture-put-target-region-and-position)
(widen) (widen)
(goto-char org-clock-hd-marker)) (goto-char org-clock-hd-marker))
(error "No running clock that could be used as capture target"))) (user-error "No running clock that could be used as capture target")))
(target (error "Invalid capture target specification: %S" target))) (target (error "Invalid capture target specification: %S" target)))
(org-capture-put :buffer (current-buffer) (org-capture-put :buffer (current-buffer)
@ -1125,8 +1130,8 @@ may have been stored before."
(`plain (org-capture-place-plain-text)) (`plain (org-capture-place-plain-text))
(`item (org-capture-place-item)) (`item (org-capture-place-item))
(`checkitem (org-capture-place-item))) (`checkitem (org-capture-place-item)))
(org-capture-mode 1) (setq-local org-capture-current-plist org-capture-plist)
(setq-local org-capture-current-plist org-capture-plist)) (org-capture-mode 1))
(defun org-capture-place-entry () (defun org-capture-place-entry ()
"Place the template as a new Org entry." "Place the template as a new Org entry."
@ -1139,7 +1144,13 @@ may have been stored before."
(when exact-position (goto-char exact-position)) (when exact-position (goto-char exact-position))
(cond (cond
;; Force insertion at point. ;; Force insertion at point.
((org-capture-get :insert-here) nil) (insert-here?
;; FIXME: level should probably set directly within (let ...).
(setq level (org-get-valid-level
(if (or (org-at-heading-p)
(ignore-errors (org-back-to-heading t)))
(org-outline-level)
1))))
;; Insert as a child of the current entry. ;; Insert as a child of the current entry.
((org-capture-get :target-entry-p) ((org-capture-get :target-entry-p)
(setq level (org-get-valid-level (setq level (org-get-valid-level
@ -1163,7 +1174,7 @@ may have been stored before."
(org-capture-empty-lines-after) (org-capture-empty-lines-after)
(unless (org-at-heading-p) (outline-next-heading)) (unless (org-at-heading-p) (outline-next-heading))
(org-capture-mark-kill-region origin (point)) (org-capture-mark-kill-region origin (point))
(org-capture-narrow beg (point)) (org-capture-narrow beg (if (eobp) (point) (1- (point))))
(org-capture--position-cursor beg (point)))))) (org-capture--position-cursor beg (point))))))
(defun org-capture-place-item () (defun org-capture-place-item ()
@ -1744,11 +1755,11 @@ The template may still contain \"%?\" for cursor positioning."
(_ (error "Invalid `org-capture--clipboards' value: %S" (_ (error "Invalid `org-capture--clipboards' value: %S"
org-capture--clipboards))))) org-capture--clipboards)))))
("p" ("p"
;; We remove file properties inherited from ;; We remove keyword properties inherited from
;; target buffer so `org-read-property-value' has ;; target buffer so `org-read-property-value' has
;; a chance to find allowed values in sub-trees ;; a chance to find allowed values in sub-trees
;; from the target buffer. ;; from the target buffer.
(setq-local org-file-properties nil) (setq-local org-keyword-properties nil)
(let* ((origin (set-marker (make-marker) (let* ((origin (set-marker (make-marker)
(org-capture-get :pos) (org-capture-get :pos)
(org-capture-get :buffer))) (org-capture-get :buffer)))
@ -1933,4 +1944,8 @@ Assume sexps have been marked with
(provide 'org-capture) (provide 'org-capture)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; org-capture.el ends here ;;; org-capture.el ends here

View File

@ -44,6 +44,8 @@
(declare-function org-link-make-string "ol" (link &optional description)) (declare-function org-link-make-string "ol" (link &optional description))
(declare-function org-table-goto-line "org-table" (n)) (declare-function org-table-goto-line "org-table" (n))
(declare-function org-dynamic-block-define "org" (type func)) (declare-function org-dynamic-block-define "org" (type func))
(declare-function w32-notification-notify "w32fns.c" (&rest params))
(declare-function w32-notification-close "w32fns.c" (&rest params))
(defvar org-frame-title-format-backup nil) (defvar org-frame-title-format-backup nil)
(defvar org-state) (defvar org-state)
@ -277,6 +279,15 @@ also using the face `org-mode-line-clock-overrun'."
(const :tag "Just mark the time string" nil) (const :tag "Just mark the time string" nil)
(string :tag "Text to prepend"))) (string :tag "Text to prepend")))
(defcustom org-show-notification-timeout 3
"Number of seconds to wait before closing Org notifications.
This is applied to notifications sent with `notifications-notify'
and `w32-notification-notify' only, not other mechanisms possibly
set through `org-show-notification-handler'."
:group 'org-clock
:package-version '(Org . "9.4")
:type 'integer)
(defcustom org-show-notification-handler nil (defcustom org-show-notification-handler nil
"Function or program to send notification with. "Function or program to send notification with.
The function or program will be called with the notification The function or program will be called with the notification
@ -461,6 +472,19 @@ Valid values are: `today', `yesterday', `thisweek', `lastweek',
(const :tag "Select range interactively" interactive)) (const :tag "Select range interactively" interactive))
:safe #'symbolp) :safe #'symbolp)
(defcustom org-clock-auto-clockout-timer nil
"Timer for auto clocking out when Emacs is idle.
When set to a number, auto clock out the currently clocked in
task after this number of seconds of idle time.
This is only effective when `org-clock-auto-clockout-insinuate'
is added to the user configuration."
:group 'org-clock
:package-version '(Org . "9.4")
:type '(choice
(integer :tag "Clock out after Emacs is idle for X seconds")
(const :tag "Never auto clock out" nil)))
(defvar org-clock-in-prepare-hook nil (defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock. "Hook run when preparing the clock.
This hook is run before anything happens to the task that This hook is run before anything happens to the task that
@ -702,7 +726,8 @@ If not, show simply the clocked time like 01:50."
(save-excursion (save-excursion
(let ((end (save-excursion (org-end-of-subtree)))) (let ((end (save-excursion (org-end-of-subtree))))
(when (re-search-forward (concat org-clock-string (when (re-search-forward (concat org-clock-string
".*\\]--\\(\\[[^]]+\\]\\)") end t) ".*\\]--\\(\\[[^]]+\\]\\)")
end t)
(org-time-string-to-time (match-string 1)))))) (org-time-string-to-time (match-string 1))))))
(defun org-clock-update-mode-line (&optional refresh) (defun org-clock-update-mode-line (&optional refresh)
@ -729,7 +754,8 @@ menu\nmouse-2 will jump to task"))
(setq org-mode-line-string (setq org-mode-line-string
(concat (propertize (concat (propertize
org-clock-task-overrun-text org-clock-task-overrun-text
'face 'org-mode-line-clock-overrun) org-mode-line-string))) 'face 'org-mode-line-clock-overrun)
org-mode-line-string)))
(force-mode-line-update)) (force-mode-line-update))
(defun org-clock-get-clocked-time () (defun org-clock-get-clocked-time ()
@ -818,10 +844,20 @@ use libnotify if available, or fall back on a message."
((stringp org-show-notification-handler) ((stringp org-show-notification-handler)
(start-process "emacs-timer-notification" nil (start-process "emacs-timer-notification" nil
org-show-notification-handler notification)) org-show-notification-handler notification))
((fboundp 'w32-notification-notify)
(let ((id (w32-notification-notify
:title "Org mode message"
:body notification
:urgency 'low)))
(run-with-timer
org-show-notification-timeout
nil
(lambda () (w32-notification-close id)))))
((fboundp 'notifications-notify) ((fboundp 'notifications-notify)
(notifications-notify (notifications-notify
:title "Org mode message" :title "Org mode message"
:body notification :body notification
:timeout (* org-show-notification-timeout 1000)
;; FIXME how to link to the Org icon? ;; FIXME how to link to the Org icon?
;; :app-icon "~/.emacs.d/icons/mail.png" ;; :app-icon "~/.emacs.d/icons/mail.png"
:urgency 'low)) :urgency 'low))
@ -864,7 +900,8 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward org-clock-re nil t) (while (re-search-forward org-clock-re nil t)
(push (cons (copy-marker (match-end 1) t) (push (cons (copy-marker (match-end 1) t)
(org-time-string-to-time (match-string 1))) clocks)))) (org-time-string-to-time (match-string 1)))
clocks))))
clocks)) clocks))
(defsubst org-is-active-clock (clock) (defsubst org-is-active-clock (clock)
@ -988,7 +1025,7 @@ CLOCK is a cons cell of the form (MARKER START-TIME)."
(let ((element (org-element-at-point))) (let ((element (org-element-at-point)))
(when (eq (org-element-type element) 'drawer) (when (eq (org-element-type element) 'drawer)
(when (> (org-element-property :end element) (car clock)) (when (> (org-element-property :end element) (car clock))
(org-flag-drawer nil element)) (org-hide-drawer-toggle 'off nil element))
(throw 'exit nil))))))))))) (throw 'exit nil)))))))))))
(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) (defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
@ -1027,6 +1064,9 @@ k/K Keep X minutes of the idle time (default is all). If this
that many minutes after the time that idling began, and then that many minutes after the time that idling began, and then
clocked back in at the present time. clocked back in at the present time.
t/T Like `k', but will ask you to specify a time (when you got
distracted away), instead of a number of minutes.
g/G Indicate that you \"got back\" X minutes ago. This is quite g/G Indicate that you \"got back\" X minutes ago. This is quite
different from `k': it clocks you out from the beginning of different from `k': it clocks you out from the beginning of
the idle period and clock you back in X minutes ago. the idle period and clock you back in X minutes ago.
@ -1046,19 +1086,24 @@ to be CLOCKED OUT."))))
(while (or (null char-pressed) (while (or (null char-pressed)
(and (not (memq char-pressed (and (not (memq char-pressed
'(?k ?K ?g ?G ?s ?S ?C '(?k ?K ?g ?G ?s ?S ?C
?j ?J ?i ?q))) ?j ?J ?i ?q ?t ?T)))
(or (ding) t))) (or (ding) t)))
(setq char-pressed (setq char-pressed
(read-char (concat (funcall prompt-fn clock) (read-char (concat (funcall prompt-fn clock)
" [jkKgGSscCiq]? ") " [jkKtTgGSscCiq]? ")
nil 45))) nil 45)))
(and (not (memq char-pressed '(?i ?q))) char-pressed))))) (and (not (memq char-pressed '(?i ?q))) char-pressed)))))
(default (default
(floor (org-time-convert-to-integer (org-time-since last-valid)) (floor (org-time-convert-to-integer (org-time-since last-valid))
60)) 60))
(keep (keep
(and (memq ch '(?k ?K)) (or (and (memq ch '(?k ?K))
(read-number "Keep how many minutes? " default))) (read-number "Keep how many minutes? " default))
(and (memq ch '(?t ?T))
(floor
(/ (float-time
(org-time-subtract (org-read-date t t) last-valid))
60)))))
(gotback (gotback
(and (memq ch '(?g ?G)) (and (memq ch '(?g ?G))
(read-number "Got back how many minutes ago? " default))) (read-number "Got back how many minutes ago? " default)))
@ -1073,7 +1118,7 @@ to be CLOCKED OUT."))))
(org-clock-resolve-clock clock 'now nil t nil fail-quietly)) (org-clock-resolve-clock clock 'now nil t nil fail-quietly))
(org-clock-jump-to-current-clock clock)) (org-clock-jump-to-current-clock clock))
((or (null ch) ((or (null ch)
(not (memq ch '(?k ?K ?g ?G ?s ?S ?C)))) (not (memq ch '(?k ?K ?g ?G ?s ?S ?C ?t ?T))))
(message "")) (message ""))
(t (t
(org-clock-resolve-clock (org-clock-resolve-clock
@ -1097,7 +1142,7 @@ to be CLOCKED OUT."))))
(t (t
(error "Unexpected, please report this as a bug"))) (error "Unexpected, please report this as a bug")))
(and gotback last-valid) (and gotback last-valid)
(memq ch '(?K ?G ?S)) (memq ch '(?K ?G ?S ?T))
(and start-over (and start-over
(not (memq ch '(?K ?G ?S ?C)))) (not (memq ch '(?K ?G ?S ?C))))
fail-quietly))))) fail-quietly)))))
@ -1320,7 +1365,6 @@ the default behavior."
(t (t
(insert-before-markers "\n") (insert-before-markers "\n")
(backward-char 1) (backward-char 1)
(org-indent-line)
(when (and (save-excursion (when (and (save-excursion
(end-of-line 0) (end-of-line 0)
(org-in-item-p))) (org-in-item-p)))
@ -1345,7 +1389,8 @@ the default behavior."
start-time start-time
(org-current-time org-clock-rounding-minutes t))) (org-current-time org-clock-rounding-minutes t)))
(setq ts (org-insert-time-stamp org-clock-start-time (setq ts (org-insert-time-stamp org-clock-start-time
'with-hm 'inactive)))) 'with-hm 'inactive))
(org-indent-line)))
(move-marker org-clock-marker (point) (buffer-base-buffer)) (move-marker org-clock-marker (point) (buffer-base-buffer))
(move-marker org-clock-hd-marker (move-marker org-clock-hd-marker
(save-excursion (org-back-to-heading t) (point)) (save-excursion (org-back-to-heading t) (point))
@ -1380,6 +1425,26 @@ the default behavior."
(message "Clock starts at %s - %s" ts org--msg-extra) (message "Clock starts at %s - %s" ts org--msg-extra)
(run-hooks 'org-clock-in-hook)))))) (run-hooks 'org-clock-in-hook))))))
(defun org-clock-auto-clockout ()
"Clock out the currently clocked in task if Emacs is idle.
See `org-clock-auto-clockout-timer' to set the idle time span.
This is only effective when `org-clock-auto-clockout-insinuate'
is present in the user configuration."
(when (and (numberp org-clock-auto-clockout-timer)
org-clock-current-task)
(run-with-idle-timer
org-clock-auto-clockout-timer nil #'org-clock-out)))
;;;###autoload
(defun org-clock-toggle-auto-clockout ()
(interactive)
(if (memq 'org-clock-auto-clockout org-clock-in-hook)
(progn (remove-hook 'org-clock-in-hook #'org-clock-auto-clockout)
(message "Auto clock-out after idle time turned off"))
(add-hook 'org-clock-in-hook #'org-clock-auto-clockout t)
(message "Auto clock-out after idle time turned on")))
;;;###autoload ;;;###autoload
(defun org-clock-in-last (&optional arg) (defun org-clock-in-last (&optional arg)
"Clock in the last closed clocked item. "Clock in the last closed clocked item.
@ -1517,7 +1582,7 @@ line and position cursor in that line."
(insert ":" drawer ":\n:END:\n") (insert ":" drawer ":\n:END:\n")
(org-indent-region beg (point)) (org-indent-region beg (point))
(org-flag-region (org-flag-region
(line-end-position -1) (1- (point)) t 'org-hide-drawer) (line-end-position -1) (1- (point)) t 'outline)
(forward-line -1)))) (forward-line -1))))
;; When a clock drawer needs to be created because of the ;; When a clock drawer needs to be created because of the
;; number of clock items or simply if it is missing, collect ;; number of clock items or simply if it is missing, collect
@ -1542,7 +1607,7 @@ line and position cursor in that line."
(let ((end (point-marker))) (let ((end (point-marker)))
(goto-char beg) (goto-char beg)
(save-excursion (insert ":" drawer ":\n")) (save-excursion (insert ":" drawer ":\n"))
(org-flag-region (line-end-position) (1- end) t 'org-hide-drawer) (org-flag-region (line-end-position) (1- end) t 'outline)
(org-indent-region (point) end) (org-indent-region (point) end)
(forward-line) (forward-line)
(unless org-log-states-order-reversed (unless org-log-states-order-reversed
@ -1729,7 +1794,7 @@ Optional argument N tells to change by that many units."
(delq 'org-mode-line-string global-mode-string)) (delq 'org-mode-line-string global-mode-string))
(org-clock-restore-frame-title-format) (org-clock-restore-frame-title-format)
(force-mode-line-update) (force-mode-line-update)
(error "No active clock")) (user-error "No active clock"))
(save-excursion ; Do not replace this with `with-current-buffer'. (save-excursion ; Do not replace this with `with-current-buffer'.
(with-no-warnings (set-buffer (org-clocking-buffer))) (with-no-warnings (set-buffer (org-clocking-buffer)))
(goto-char org-clock-marker) (goto-char org-clock-marker)
@ -1758,14 +1823,14 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(m (cond (m (cond
(select (select
(or (org-clock-select-task "Select task to go to: ") (or (org-clock-select-task "Select task to go to: ")
(error "No task selected"))) (user-error "No task selected")))
((org-clocking-p) org-clock-marker) ((org-clocking-p) org-clock-marker)
((and org-clock-goto-may-find-recent-task ((and org-clock-goto-may-find-recent-task
(car org-clock-history) (car org-clock-history)
(marker-buffer (car org-clock-history))) (marker-buffer (car org-clock-history)))
(setq recent t) (setq recent t)
(car org-clock-history)) (car org-clock-history))
(t (error "No active or recent clock task"))))) (t (user-error "No active or recent clock task")))))
(pop-to-buffer-same-window (marker-buffer m)) (pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen)) (if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m) (goto-char m)
@ -2323,7 +2388,7 @@ the currently selected interval size."
(save-excursion (save-excursion
(goto-char (point-at-bol)) (goto-char (point-at-bol))
(if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)"))
(error "Line needs a :block definition before this command works") (user-error "Line needs a :block definition before this command works")
(let* ((b (match-beginning 1)) (e (match-end 1)) (let* ((b (match-beginning 1)) (e (match-end 1))
(s (match-string 1)) (s (match-string 1))
block shift ins y mw d date wp m) block shift ins y mw d date wp m)
@ -2382,7 +2447,7 @@ the currently selected interval size."
(encode-time 0 0 0 1 (+ mw n) y)))) (encode-time 0 0 0 1 (+ mw n) y))))
(y (y
(setq ins (number-to-string (+ y n)))))) (setq ins (number-to-string (+ y n))))))
(t (error "Cannot shift clocktable block"))) (t (user-error "Cannot shift clocktable block")))
(when ins (when ins
(goto-char b) (goto-char b)
(insert ins) (insert ins)
@ -2397,20 +2462,21 @@ the currently selected interval size."
(setq params (org-combine-plists org-clocktable-defaults params)) (setq params (org-combine-plists org-clocktable-defaults params))
(catch 'exit (catch 'exit
(let* ((scope (plist-get params :scope)) (let* ((scope (plist-get params :scope))
(base-buffer (org-base-buffer (current-buffer)))
(files (pcase scope (files (pcase scope
(`agenda (`agenda
(org-agenda-files t)) (org-agenda-files t))
(`agenda-with-archives (`agenda-with-archives
(org-add-archive-files (org-agenda-files t))) (org-add-archive-files (org-agenda-files t)))
(`file-with-archives (`file-with-archives
(and buffer-file-name (let ((base-file (buffer-file-name base-buffer)))
(org-add-archive-files (list buffer-file-name)))) (and base-file
(org-add-archive-files (list base-file)))))
((or `nil `file `subtree `tree ((or `nil `file `subtree `tree
(and (pred symbolp) (and (pred symbolp)
(guard (string-match "\\`tree\\([0-9]+\\)\\'" (guard (string-match "\\`tree\\([0-9]+\\)\\'"
(symbol-name scope))))) (symbol-name scope)))))
(or (buffer-file-name (buffer-base-buffer)) base-buffer)
(current-buffer)))
((pred functionp) (funcall scope)) ((pred functionp) (funcall scope))
((pred consp) scope) ((pred consp) scope)
(_ (user-error "Unknown scope: %S" scope)))) (_ (user-error "Unknown scope: %S" scope))))
@ -2434,7 +2500,7 @@ the currently selected interval size."
(when step (when step
;; Write many tables, in steps ;; Write many tables, in steps
(unless (or block (and ts te)) (unless (or block (and ts te))
(error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'")) (user-error "Clocktable `:step' can only be used with `:block' or `:tstart, :end'"))
(org-clocktable-steps params) (org-clocktable-steps params)
(throw 'exit nil)) (throw 'exit nil))
@ -2540,7 +2606,7 @@ from the dynamic block definition."
(guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow)))) (guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow))))
(setq narrow-cut-p t) (setq narrow-cut-p t)
(setq narrow (string-to-number (symbol-name narrow)))) (setq narrow (string-to-number (symbol-name narrow))))
(_ (error "Invalid value %s of :narrow property in clock table" narrow))) (_ (user-error "Invalid value %s of :narrow property in clock table" narrow)))
;; Now we need to output this table stuff. ;; Now we need to output this table stuff.
(goto-char ipos) (goto-char ipos)
@ -2731,6 +2797,7 @@ a number of clock tables."
(pcase step (pcase step
(`day "Daily report: ") (`day "Daily report: ")
(`week "Weekly report starting on: ") (`week "Weekly report starting on: ")
(`semimonth "Semimonthly report starting on: ")
(`month "Monthly report starting on: ") (`month "Monthly report starting on: ")
(`year "Annual report starting on: ") (`year "Annual report starting on: ")
(_ (user-error "Unknown `:step' specification: %S" step)))) (_ (user-error "Unknown `:step' specification: %S" step))))
@ -2780,6 +2847,9 @@ a number of clock tables."
(let ((offset (if (= dow week-start) 7 (let ((offset (if (= dow week-start) 7
(mod (- week-start dow) 7)))) (mod (- week-start dow) 7))))
(list 0 0 org-extend-today-until (+ d offset) m y))) (list 0 0 org-extend-today-until (+ d offset) m y)))
(`semimonth (list 0 0 0
(if (< d 16) 16 1)
(if (< d 16) m (1+ m)) y))
(`month (list 0 0 0 month-start (1+ m) y)) (`month (list 0 0 0 month-start (1+ m) y))
(`year (list 0 0 org-extend-today-until 1 1 (1+ y))))))) (`year (list 0 0 org-extend-today-until 1 1 (1+ y)))))))
(table-begin (line-beginning-position 0)) (table-begin (line-beginning-position 0))
@ -2896,7 +2966,7 @@ PROPERTIES: The list properties specified in the `:properties' parameter
(org-trim (org-trim
(org-link-display-format (org-link-display-format
(replace-regexp-in-string (replace-regexp-in-string
"\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" ""
headline))))))) headline)))))))
(tgs (and tags (org-get-tags))) (tgs (and tags (org-get-tags)))
(tsp (tsp

View File

@ -44,6 +44,8 @@
(declare-function org-dynamic-block-define "org" (type func)) (declare-function org-dynamic-block-define "org" (type func))
(declare-function org-link-display-format "ol" (s)) (declare-function org-link-display-format "ol" (s))
(declare-function org-link-open-from-string "ol" (s &optional arg)) (declare-function org-link-open-from-string "ol" (s &optional arg))
(declare-function face-remap-remove-relative "face-remap" (cookie))
(declare-function face-remap-add-relative "face-remap" (face &rest specs))
(defvar org-agenda-columns-add-appointments-to-effort-sum) (defvar org-agenda-columns-add-appointments-to-effort-sum)
(defvar org-agenda-columns-compute-summary-properties) (defvar org-agenda-columns-compute-summary-properties)
@ -164,7 +166,7 @@ See `org-columns-summary-types' for details.")
(org-defkey org-columns-map "o" 'org-overview) (org-defkey org-columns-map "o" 'org-overview)
(org-defkey org-columns-map "e" 'org-columns-edit-value) (org-defkey org-columns-map "e" 'org-columns-edit-value)
(org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo) (org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo)
(org-defkey org-columns-map "\C-c\C-c" 'org-columns-set-tags-or-toggle) (org-defkey org-columns-map "\C-c\C-c" 'org-columns-toggle-or-columns-quit)
(org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link) (org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link)
(org-defkey org-columns-map "v" 'org-columns-show-value) (org-defkey org-columns-map "v" 'org-columns-show-value)
(org-defkey org-columns-map "q" 'org-columns-quit) (org-defkey org-columns-map "q" 'org-columns-quit)
@ -366,11 +368,18 @@ ORIGINAL is the real string, i.e., before it is modified by
("TODO" (propertize v 'face (org-get-todo-face original))) ("TODO" (propertize v 'face (org-get-todo-face original)))
(_ v))))) (_ v)))))
(defvar org-columns-header-line-remap nil
"Store the relative remapping of column header-line.
This is needed to later remove this relative remapping.")
(defun org-columns--display-here (columns &optional dateline) (defun org-columns--display-here (columns &optional dateline)
"Overlay the current line with column display. "Overlay the current line with column display.
COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument
DATELINE is non-nil when the face used should be DATELINE is non-nil when the face used should be
`org-agenda-column-dateline'." `org-agenda-column-dateline'."
(when (ignore-errors (require 'face-remap))
(setq org-columns-header-line-remap
(face-remap-add-relative 'header-line '(:inherit default))))
(save-excursion (save-excursion
(beginning-of-line) (beginning-of-line)
(let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)") (let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)")
@ -380,8 +389,7 @@ DATELINE is non-nil when the face used should be
(org-get-at-bol 'face)) (org-get-at-bol 'face))
'default)) 'default))
(color (list :foreground (face-attribute ref-face :foreground))) (color (list :foreground (face-attribute ref-face :foreground)))
(font (list :height (face-attribute 'default :height) (font (list :family (face-attribute 'default :family)))
:family (face-attribute 'default :family)))
(face (list color font 'org-column ref-face)) (face (list color font 'org-column ref-face))
(face1 (list color font 'org-agenda-column-dateline ref-face))) (face1 (list color font 'org-agenda-column-dateline ref-face)))
;; Each column is an overlay on top of a character. So there has ;; Each column is an overlay on top of a character. So there has
@ -504,6 +512,9 @@ for the duration of the command.")
(defun org-columns-remove-overlays () (defun org-columns-remove-overlays ()
"Remove all currently active column overlays." "Remove all currently active column overlays."
(interactive) (interactive)
(when (and (fboundp 'face-remap-remove-relative)
org-columns-header-line-remap)
(face-remap-remove-relative org-columns-header-line-remap))
(when org-columns-overlays (when org-columns-overlays
(when (local-variable-p 'org-previous-header-line-format) (when (local-variable-p 'org-previous-header-line-format)
(setq header-line-format org-previous-header-line-format) (setq header-line-format org-previous-header-line-format)
@ -556,13 +567,19 @@ for the duration of the command.")
(interactive "P") (interactive "P")
(org-columns-edit-value "TODO")) (org-columns-edit-value "TODO"))
(defun org-columns-set-tags-or-toggle (&optional _arg) (defun org-columns-toggle-or-columns-quit ()
"Toggle checkbox at point, or set tags for current headline." "Toggle checkbox at point, or quit column view."
(interactive "P") (interactive)
(if (string-match "\\`\\[[ xX-]\\]\\'" (or (org-columns--toggle)
(get-char-property (point) 'org-columns-value)) (org-columns-quit)))
(org-columns-next-allowed-value)
(org-columns-edit-value "TAGS"))) (defun org-columns--toggle ()
"Toggle checkbox at point. Return non-nil if toggle happened, else nil.
See info documentation about realizing a suitable checkbox."
(when (string-match "\\`\\[[ xX-]\\]\\'"
(get-char-property (point) 'org-columns-value))
(org-columns-next-allowed-value)
t))
(defvar org-overriding-columns-format nil (defvar org-overriding-columns-format nil
"When set, overrides any other format definition for the agenda. "When set, overrides any other format definition for the agenda.
@ -1618,6 +1635,7 @@ PARAMS is a property list of parameters:
(dolist (entry cache) (dolist (entry cache)
(goto-char (car entry)) (goto-char (car entry))
(org-columns--display-here (cdr entry))) (org-columns--display-here (cdr entry)))
(setq-local org-agenda-columns-active t)
(when org-agenda-columns-show-summaries (when org-agenda-columns-show-summaries
(org-agenda-colview-summarize cache))))))) (org-agenda-colview-summarize cache)))))))
@ -1682,8 +1700,7 @@ This will add overlays to the date lines, to show the summary for each day."
'face 'bold final)) 'face 'bold final))
(list spec final final))))) (list spec final final)))))
fmt) fmt)
'dateline) 'dateline))))
(setq-local org-agenda-columns-active t))))
(if (bobp) (throw :complete t) (forward-line -1))))))) (if (bobp) (throw :complete t) (forward-line -1)))))))
(defun org-agenda-colview-compute (fmt) (defun org-agenda-colview-compute (fmt)
@ -1709,4 +1726,8 @@ This will add overlays to the date lines, to show the summary for each day."
(provide 'org-colview) (provide 'org-colview)
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:
;;; org-colview.el ends here ;;; org-colview.el ends here

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