diff options
| author | Sébastien Delafond <sdelafond@gmail.com> | 2016-11-07 10:41:54 +0100 |
|---|---|---|
| committer | Sébastien Delafond <sdelafond@gmail.com> | 2016-11-07 10:41:54 +0100 |
| commit | ec84430cf4e09ba25ec675debdf802bc28111e06 (patch) | |
| tree | 9c64bc8a0cd5e8cac82aa5fdf369d40529f140f8 | |
| parent | 84539dca3aa301ecfe48858eceef1ced0505388b (diff) | |
Imported Upstream version 9.0
171 files changed, 43531 insertions, 22823 deletions
diff --git a/contrib/README b/contrib/README index 6a8918f..48c58b9 100644 --- a/contrib/README +++ b/contrib/README @@ -30,7 +30,6 @@ org-eldoc.el --- Eldoc documentation for SRC blocks org-elisp-symbol.el --- Org links to emacs-lisp symbols org-eval-light.el --- Evaluate in-buffer code on demand org-eval.el --- The <lisp> tag, adapted from Muse -org-eww.el --- Support link/copy/paste from eww to Org-mode org-expiry.el --- Expiry mechanism for Org entries org-export-generic.el --- Export framework for configurable backends org-git-link.el --- Provide org links to specific file version @@ -39,6 +38,7 @@ org-interactive-query.el --- Interactive modification of tags query org-invoice.el --- Help manage client invoices in OrgMode org-learn.el --- SuperMemo's incremental learning algorithm org-license.el --- Insert free licenses to your org documents +org-link-edit.el --- Slurp and barf with Org links org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary org-mac-link.el --- Grab links and URLs from various Mac applications org-mairix.el --- Hook mairix search into Org for different MUAs diff --git a/contrib/lisp/htmlize.el b/contrib/lisp/htmlize.el index 3bf5949..8358830 100644 --- a/contrib/lisp/htmlize.el +++ b/contrib/lisp/htmlize.el @@ -943,18 +943,7 @@ If no rgb.txt file is found, return nil." ;; frame parameters. (let* ((function (if fg #'face-foreground #'face-background)) color) - (if (>= emacs-major-version 22) - ;; For GNU Emacs 22+ set INHERIT to get the inherited values. - (setq color (funcall function face nil t)) - (setq color (funcall function face)) - ;; For GNU Emacs 21 (which has `face-attribute'): if the color - ;; is nil, recursively check for the face's parent. - (when (and (null color) - (fboundp 'face-attribute) - (face-attribute face :inherit) - (not (eq (face-attribute face :inherit) 'unspecified))) - (setq color (htmlize-face-color-internal - (face-attribute face :inherit) fg)))) + (setq color (funcall function face nil t)) (when (and (eq face 'default) (null color)) (setq color (cdr (assq (if fg 'foreground-color 'background-color) (frame-parameters))))) @@ -1132,17 +1121,7 @@ If no rgb.txt file is found, return nil." (face-underline-p face))) ;; GNU Emacs (dolist (attr '(:weight :slant :underline :overline :strike-through)) - (let ((value (if (>= emacs-major-version 22) - ;; Use the INHERIT arg in GNU Emacs 22. - (face-attribute face attr nil t) - ;; Otherwise, fake it. - (let ((face face)) - (while (and (eq (face-attribute face attr) - 'unspecified) - (not (eq (face-attribute face :inherit) - 'unspecified))) - (setq face (face-attribute face :inherit))) - (face-attribute face attr))))) + (let ((value (face-attribute face attr nil t))) (when (and value (not (eq value 'unspecified))) (htmlize-face-emacs21-attr fstruct attr value)))) (let ((size (htmlize-face-size face))) diff --git a/contrib/lisp/ob-csharp.el b/contrib/lisp/ob-csharp.el new file mode 100644 index 0000000..5ecac23 --- /dev/null +++ b/contrib/lisp/ob-csharp.el @@ -0,0 +1,83 @@ +;;; ob-csharp.el --- org-babel functions for csharp evaluation + +;; Copyright (C) 2011-2015 Free Software Foundation, Inc. + +;; Author: thomas "at" friendlyvillagers.com based on ob-java.el by Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is not part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Currently this only supports the external compilation and execution +;; of csharp code blocks (i.e., no session support). + +;;; Code: +(require 'ob) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("csharp" . "cs")) + +(defcustom org-babel-csharp-command "mono" + "Name of the csharp command. +May be either a command in the path, like mono +or an absolute path name, like /usr/local/bin/mono +parameters may be used, like mono -verbose" + :group 'org-babel + :version "24.3" + :type 'string) + +(defcustom org-babel-csharp-compiler "mcs" + "Name of the csharp compiler. +May be either a command in the path, like mcs +or an absolute path name, like /usr/local/bin/mcs +parameters may be used, like mcs -warnaserror+" + :group 'org-babel + :version "24.3" + :type 'string) + +(defun org-babel-execute:csharp (body params) + (let* ((full-body (org-babel-expand-body:generic body params)) + (cmpflag (or (cdr (assq :cmpflag params)) "")) + (cmdline (or (cdr (assq :cmdline params)) "")) + (src-file (org-babel-temp-file "csharp-src-" ".cs")) + (exe-file (concat (file-name-sans-extension src-file) ".exe")) + (compile + (progn (with-temp-file src-file (insert full-body)) + (org-babel-eval + (concat org-babel-csharp-compiler " " cmpflag " " src-file) "")))) + (let ((results (org-babel-eval (concat org-babel-csharp-command " " cmdline " " exe-file) ""))) + (org-babel-reassemble-table + (org-babel-result-cond (cdr (assq :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "c-"))) + (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-prep-session:csharp (session params) + "Return an error because csharp does not support sessions." + (error "Sessions are not supported for CSharp")) + +(provide 'ob-csharp) + + + +;;; ob-csharp.el ends here diff --git a/contrib/lisp/ob-eukleides.el b/contrib/lisp/ob-eukleides.el index 67f3bf4..e4fc298 100644 --- a/contrib/lisp/ob-eukleides.el +++ b/contrib/lisp/ob-eukleides.el @@ -58,12 +58,12 @@ (defun org-babel-execute:eukleides (body params) "Execute a block of eukleides code with org-babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (or (cdr (assoc :file params)) + (let* ((result-params (split-string (or (cdr (assq :results params)) ""))) + (out-file (or (cdr (assq :file params)) (error "Eukleides requires a \":file\" header argument"))) - (cmdline (cdr (assoc :cmdline params))) + (cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "eukleides-")) - (java (or (cdr (assoc :java params)) "")) + (java (or (cdr (assq :java params)) "")) (cmd (if (not org-eukleides-path) (error "`org-eukleides-path' is not set") (concat (expand-file-name org-eukleides-path) diff --git a/contrib/lisp/ob-fomus.el b/contrib/lisp/ob-fomus.el index 1db32e4..30f292f 100644 --- a/contrib/lisp/ob-fomus.el +++ b/contrib/lisp/ob-fomus.el @@ -48,7 +48,7 @@ (defun org-babel-expand-body:fomus (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapc (lambda (pair) (let ((name (symbol-name (car pair))) @@ -64,10 +64,10 @@ (defun org-babel-execute:fomus (body params) "Execute a block of Fomus code with org-babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (cdr (assoc :result-params params))) - (out-file (cdr (assoc :file params))) - (cmdline (cdr (assoc :cmdline params))) - (cmd (or (cdr (assoc :cmd params)) "fomus")) + (let* ((result-params (cdr (assq :result-params params))) + (out-file (cdr (assq :file params))) + (cmdline (cdr (assq :cmdline params))) + (cmd (or (cdr (assq :cmd params)) "fomus")) (in-file (org-babel-temp-file "fomus-" ".fms"))) (with-temp-file in-file (insert (org-babel-expand-body:fomus body params))) diff --git a/contrib/lisp/ob-julia.el b/contrib/lisp/ob-julia.el index 4d8deb2..41c8b5a 100644 --- a/contrib/lisp/ob-julia.el +++ b/contrib/lisp/ob-julia.el @@ -30,7 +30,7 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) +(require 'cl-lib) (declare-function orgtbl-to-csv "org-table" (table params)) (declare-function julia "ext:ess-julia" (&optional start-args)) @@ -38,7 +38,6 @@ (declare-function ess-make-buffer-current "ext:ess-inf" ()) (declare-function ess-eval-buffer "ext:ess-inf" (vis)) (declare-function org-number-sequence "org-compat" (from &optional to inc)) -(declare-function org-remove-if-not "org" (predicate seq)) (defconst org-babel-header-args:julia '((width . :any) @@ -62,7 +61,7 @@ (defvar ess-local-process-name) ; dynamically scoped (defun org-babel-edit-prep:julia (info) - (let ((session (cdr (assoc :session (nth 2 info))))) + (let ((session (cdr (assq :session (nth 2 info))))) (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) (save-match-data (org-babel-julia-initiate-session session nil))))) @@ -83,12 +82,12 @@ "Execute a block of julia code. This function is called by `org-babel-execute-src-block'." (save-excursion - (let* ((result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (let* ((result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (session (org-babel-julia-initiate-session - (cdr (assoc :session params)) params)) - (colnames-p (cdr (assoc :colnames params))) - (rownames-p (cdr (assoc :rownames params))) + (cdr (assq :session params)) params)) + (colnames-p (cdr (assq :colnames params))) + (rownames-p (cdr (assq :rownames params))) (graphics-file (org-babel-julia-graphical-output-file params)) (full-body (org-babel-expand-body:julia body params graphics-file)) (result @@ -96,10 +95,10 @@ This function is called by `org-babel-execute-src-block'." session full-body result-type result-params (or (equal "yes" colnames-p) (org-babel-pick-name - (cdr (assoc :colname-names params)) colnames-p)) + (cdr (assq :colname-names params)) colnames-p)) (or (equal "yes" rownames-p) (org-babel-pick-name - (cdr (assoc :rowname-names params)) rownames-p))))) + (cdr (assq :rowname-names params)) rownames-p))))) (if graphics-file nil result)))) (defun org-babel-prep-session:julia (session params) @@ -125,20 +124,20 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-variable-assignments:julia (params) "Return list of julia statements assigning the block's variables." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapcar (lambda (pair) (org-babel-julia-assign-elisp (car pair) (cdr pair) - (equal "yes" (cdr (assoc :colnames params))) - (equal "yes" (cdr (assoc :rownames params))))) + (equal "yes" (cdr (assq :colnames params))) + (equal "yes" (cdr (assq :rownames params))))) (mapcar (lambda (i) (cons (car (nth i vars)) (org-babel-reassemble-table (cdr (nth i vars)) - (cdr (nth i (cdr (assoc :colname-names params)))) - (cdr (nth i (cdr (assoc :rowname-names params))))))) + (cdr (nth i (cdr (assq :colname-names params)))) + (cdr (nth i (cdr (assq :rowname-names params))))))) (org-number-sequence 0 (1- (length vars))))))) (defun org-babel-julia-quote-csv-field (s) @@ -150,9 +149,9 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-julia-assign-elisp (name value colnames-p rownames-p) "Construct julia code assigning the elisp VALUE to a variable named NAME." (if (listp value) - (let ((max (apply #'max (mapcar #'length (org-remove-if-not + (let ((max (apply #'max (mapcar #'length (cl-remove-if-not #'sequencep value)))) - (min (apply #'min (mapcar #'length (org-remove-if-not + (min (apply #'min (mapcar #'length (cl-remove-if-not #'sequencep value)))) (transition-file (org-babel-temp-file "julia-import-"))) ;; ensure VALUE has an orgtbl structure (depth of at least 2) @@ -179,7 +178,7 @@ This function is called by `org-babel-execute-src-block'." (let ((session (or session "*julia*")) (ess-ask-for-ess-directory (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory) - (not (cdr (assoc :dir params)))))) + (not (cdr (assq :dir params)))))) (if (org-babel-comint-buffer-livep session) session (save-window-excursion @@ -229,7 +228,7 @@ current code buffer." If RESULT-TYPE equals 'output then return standard output as a string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (case result-type + (cl-case result-type (value (let ((tmp-file (org-babel-temp-file "julia-"))) (org-babel-eval org-babel-julia-command @@ -251,7 +250,7 @@ last statement in BODY, as elisp." If RESULT-TYPE equals 'output then return standard output as a string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (case result-type + (cl-case result-type (value (with-temp-buffer (insert (org-babel-chomp body)) diff --git a/contrib/lisp/ob-mathematica.el b/contrib/lisp/ob-mathematica.el index a796741..cb35dec 100644 --- a/contrib/lisp/ob-mathematica.el +++ b/contrib/lisp/ob-mathematica.el @@ -14,6 +14,9 @@ (require 'ob-ref) (require 'ob-comint) (require 'ob-eval) + +(declare-function org-trim "org" (s &optional keep-lead)) + ;; Optionally require mma.el for font lock, etc (require 'mma nil 'noerror) (add-to-list 'org-src-lang-modes '("mathematica" . "mma")) @@ -31,7 +34,7 @@ (defun org-babel-expand-body:mathematica (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (concat (mapconcat ;; define any variables (lambda (pair) @@ -43,11 +46,11 @@ (defun org-babel-execute:mathematica (body params) "Execute a block of Mathematica code with org-babel. This function is called by `org-babel-execute-src-block'" - (let* ((result-params (cdr (assoc :result-params params))) + (let* ((result-params (cdr (assq :result-params params))) (full-body (org-babel-expand-body:mathematica body params)) (tmp-script-file (org-babel-temp-file "mathematica-")) (cmd org-babel-mathematica-command)) - ;; actually execute the source-code block + ;; actually execute the source-code block (with-temp-file tmp-script-file (insert full-body)) ;; (with-temp-file "/tmp/dbg" (insert full-body)) ((lambda (raw) @@ -56,7 +59,7 @@ called by `org-babel-execute-src-block'" (and (member "output" result-params) (not (member "table" result-params)))) raw - (org-babel-script-escape (org-babel-trim raw)))) + (org-babel-script-escape (org-trim raw)))) (org-babel-eval (concat cmd " " tmp-script-file) "")))) (defun org-babel-prep-session:mathematica (session params) @@ -76,4 +79,3 @@ specifying a variable of the same value." (format "%S" var))) (provide 'ob-mathematica) - diff --git a/contrib/lisp/ob-mathomatic.el b/contrib/lisp/ob-mathomatic.el index 0ec1a5f..fc08d9f 100644 --- a/contrib/lisp/ob-mathomatic.el +++ b/contrib/lisp/ob-mathomatic.el @@ -49,45 +49,45 @@ (defun org-babel-mathomatic-expand (body params) "Expand a block of Mathomatic code according to its header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (mapconcat 'identity - (list - ;; graphic output - (let ((graphic-file (org-babel-mathomatic-graphical-output-file params))) - (if graphic-file - (cond - ((string-match ".\.eps$" graphic-file) - (format ;; Need to add command to send to file. - "set plot set terminal postscript eps\\;set output %S " - graphic-file)) - ((string-match ".\.ps$" graphic-file) - (format ;; Need to add command to send to file. - "set plot set terminal postscript\\;set output %S " - graphic-file)) - - ((string-match ".\.pic$" graphic-file) - (format ;; Need to add command to send to file. - "set plot set terminal gpic\\;set output %S " - graphic-file)) - (t - (format ;; Need to add command to send to file. - "set plot set terminal png\\;set output %S " - graphic-file))) - "")) - ;; variables - (mapconcat 'org-babel-mathomatic-var-to-mathomatic vars "\n") - ;; body - body - "") - "\n"))) + (let ((vars (org-babel--get-vars params))) + (mapconcat 'identity + (list + ;; graphic output + (let ((graphic-file (org-babel-mathomatic-graphical-output-file params))) + (if graphic-file + (cond + ((string-match ".\.eps$" graphic-file) + (format ;; Need to add command to send to file. + "set plot set terminal postscript eps\\;set output %S " + graphic-file)) + ((string-match ".\.ps$" graphic-file) + (format ;; Need to add command to send to file. + "set plot set terminal postscript\\;set output %S " + graphic-file)) + + ((string-match ".\.pic$" graphic-file) + (format ;; Need to add command to send to file. + "set plot set terminal gpic\\;set output %S " + graphic-file)) + (t + (format ;; Need to add command to send to file. + "set plot set terminal png\\;set output %S " + graphic-file))) + "")) + ;; variables + (mapconcat 'org-babel-mathomatic-var-to-mathomatic vars "\n") + ;; body + body + "") + "\n"))) (defun org-babel-execute:mathomatic (body params) "Execute a block of Mathomatic entries with org-babel. This function is called by `org-babel-execute-src-block'." (message "executing Mathomatic source code block") - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (let ((result-params (split-string (or (cdr (assq :results params)) ""))) (result - (let* ((cmdline (or (cdr (assoc :cmdline params)) "")) + (let* ((cmdline (or (cdr (assq :cmdline params)) "")) (in-file (org-babel-temp-file "mathomatic-" ".math")) (cmd (format "%s -t -c -q %s %s" org-babel-mathomatic-command in-file cmdline))) diff --git a/contrib/lisp/ob-oz.el b/contrib/lisp/ob-oz.el index fc778f5..9beadeb 100644 --- a/contrib/lisp/ob-oz.el +++ b/contrib/lisp/ob-oz.el @@ -197,7 +197,7 @@ StartOzServer.oz is located.") result)) (defun org-babel-expand-body:oz (body params) - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (if vars ;; prepend code to define all arguments passed to the code block (let ((var-string (mapcar (lambda (pair) @@ -214,7 +214,7 @@ StartOzServer.oz is located.") (defun org-babel-execute:oz (body params) "Execute a block of Oz code with org-babel. This function is called by `org-babel-execute-src-block' via multiple-value-bind." - (let* ((result-params (cdr (assoc :result-params params))) + (let* ((result-params (cdr (assq :result-params params))) (full-body (org-babel-expand-body:oz body params)) (wait-time (plist-get params :wait-time))) ;; actually execute the source-code block @@ -227,10 +227,10 @@ called by `org-babel-execute-src-block' via multiple-value-bind." (message "Org-babel: executing Oz expression") (oz-send-string-expression full-body (or wait-time 1))) (t (error "either 'output' or 'results' must be members of :results"))) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :roname-names params)) - (cdr (assoc :rownames params)))))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :roname-names params)) + (cdr (assq :rownames params)))))) ;; This function should be used to assign any variables in params in ;; the context of the session environment. diff --git a/contrib/lisp/ob-stata.el b/contrib/lisp/ob-stata.el index 29aa88d..d8cf52a 100644 --- a/contrib/lisp/ob-stata.el +++ b/contrib/lisp/ob-stata.el @@ -42,7 +42,7 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) +(require 'cl-lib) (declare-function orgtbl-to-csv "org-table" (table params)) (declare-function stata "ext:ess-stata" (&optional start-args)) @@ -50,7 +50,6 @@ (declare-function ess-make-buffer-current "ext:ess-inf" ()) (declare-function ess-eval-buffer "ext:ess-inf" (vis)) (declare-function org-number-sequence "org-compat" (from &optional to inc)) -(declare-function org-remove-if-not "org" (predicate seq)) (defconst org-babel-header-args:stata '((width . :any) @@ -77,7 +76,7 @@ (defvar ess-local-process-name) ; dynamically scoped (defun org-babel-edit-prep:stata (info) - (let ((session (cdr (assoc :session (nth 2 info))))) + (let ((session (cdr (assq :session (nth 2 info))))) (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) (save-match-data (org-babel-stata-initiate-session session nil))))) @@ -98,12 +97,12 @@ "Execute a block of stata code. This function is called by `org-babel-execute-src-block'." (save-excursion - (let* ((result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (let* ((result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (session (org-babel-stata-initiate-session - (cdr (assoc :session params)) params)) - (colnames-p (cdr (assoc :colnames params))) - (rownames-p (cdr (assoc :rownames params))) + (cdr (assq :session params)) params)) + (colnames-p (cdr (assq :colnames params))) + (rownames-p (cdr (assq :rownames params))) (graphics-file (org-babel-stata-graphical-output-file params)) (full-body (org-babel-expand-body:stata body params graphics-file)) (result @@ -111,10 +110,10 @@ This function is called by `org-babel-execute-src-block'." session full-body result-type result-params (or (equal "yes" colnames-p) (org-babel-pick-name - (cdr (assoc :colname-names params)) colnames-p)) + (cdr (assq :colname-names params)) colnames-p)) (or (equal "yes" rownames-p) (org-babel-pick-name - (cdr (assoc :rowname-names params)) rownames-p))))) + (cdr (assq :rowname-names params)) rownames-p))))) (if graphics-file nil result)))) (defun org-babel-prep-session:stata (session params) @@ -140,20 +139,20 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-variable-assignments:stata (params) "Return list of stata statements assigning the block's variables." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapcar (lambda (pair) (org-babel-stata-assign-elisp (car pair) (cdr pair) - (equal "yes" (cdr (assoc :colnames params))) - (equal "yes" (cdr (assoc :rownames params))))) + (equal "yes" (cdr (assq :colnames params))) + (equal "yes" (cdr (assq :rownames params))))) (mapcar (lambda (i) (cons (car (nth i vars)) (org-babel-reassemble-table (cdr (nth i vars)) - (cdr (nth i (cdr (assoc :colname-names params)))) - (cdr (nth i (cdr (assoc :rowname-names params))))))) + (cdr (nth i (cdr (assq :colname-names params)))) + (cdr (nth i (cdr (assq :rowname-names params))))))) (org-number-sequence 0 (1- (length vars))))))) (defun org-babel-stata-quote-csv-field (s) @@ -165,9 +164,9 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-stata-assign-elisp (name value colnames-p rownames-p) "Construct stata code assigning the elisp VALUE to a variable named NAME." (if (listp value) - (let ((max (apply #'max (mapcar #'length (org-remove-if-not + (let ((max (apply #'max (mapcar #'length (cl-remove-if-not #'sequencep value)))) - (min (apply #'min (mapcar #'length (org-remove-if-not + (min (apply #'min (mapcar #'length (cl-remove-if-not #'sequencep value)))) (transition-file (org-babel-temp-file "stata-import-"))) ;; ensure VALUE has an orgtbl structure (depth of at least 2) @@ -194,7 +193,7 @@ This function is called by `org-babel-execute-src-block'." (let ((session (or session "*stata*")) (ess-ask-for-ess-directory (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory) - (not (cdr (assoc :dir params)))))) + (not (cdr (assq :dir params)))))) (if (org-babel-comint-buffer-livep session) session (save-window-excursion @@ -240,7 +239,7 @@ current code buffer." If RESULT-TYPE equals 'output then return standard output as a string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (case result-type + (cl-case result-type (value (let ((tmp-file (org-babel-temp-file "stata-"))) (org-babel-eval org-babel-stata-command @@ -262,7 +261,7 @@ last statement in BODY, as elisp." If RESULT-TYPE equals 'output then return standard output as a string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (case result-type + (cl-case result-type (value (with-temp-buffer (insert (org-babel-chomp body)) diff --git a/contrib/lisp/ob-tcl.el b/contrib/lisp/ob-tcl.el index 7f75c4a..5373069 100644 --- a/contrib/lisp/ob-tcl.el +++ b/contrib/lisp/ob-tcl.el @@ -47,18 +47,18 @@ (defun org-babel-execute:tcl (body params) "Execute a block of Tcl code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((session (cdr (assoc :session params))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (let* ((session (cdr (assq :session params))) + (result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:tcl params))) (session (org-babel-tcl-initiate-session session))) (org-babel-reassemble-table (org-babel-tcl-evaluate session full-body result-type) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (defun org-babel-prep-session:tcl (session params) "Prepare SESSION according to the header arguments in PARAMS." @@ -71,7 +71,7 @@ This function is called by `org-babel-execute-src-block'." (format "set %s %s" (car pair) (org-babel-tcl-var-to-tcl (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) ;; helper functions diff --git a/contrib/lisp/ob-vbnet.el b/contrib/lisp/ob-vbnet.el new file mode 100644 index 0000000..8b27494 --- /dev/null +++ b/contrib/lisp/ob-vbnet.el @@ -0,0 +1,84 @@ +;;; ob-vbnet.el --- org-babel functions for VB.Net evaluation + +;; Copyright (C) 2011-2015 Free Software Foundation, Inc. + +;; Author: thomas "at" friendlyvillagers.com based on ob-java.el by Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is not part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Currently this only supports the external compilation and execution +;; of VB.Net code blocks (i.e., no session support). + +;;; Code: +(require 'ob) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("vbnet" . "vb")) + +(defcustom org-babel-vbnet-command "mono" + "Name of the mono command. +May be either a command in the path, like mono +or an absolute path name, like /usr/local/bin/mono +parameters may be used, like mono -verbose" + :group 'org-babel + :version "24.3" + :type 'string) + +(defcustom org-babel-vbnet-compiler "vbnc" + "Name of the VB.Net compiler. +May be either a command in the path, like vbnc +or an absolute path name, like /usr/local/bin/vbnc +parameters may be used, like vbnc /warnaserror+" + :group 'org-babel + :version "24.3" + :type 'string) + +(defun org-babel-execute:vbnet (body params) + (let* ((full-body (org-babel-expand-body:generic body params)) + (cmpflag (or (cdr (assq :cmpflag params)) "")) + (cmdline (or (cdr (assq :cmdline params)) "")) + (src-file (org-babel-temp-file "vbnet-src-" ".vb")) + (exe-file (concat (file-name-sans-extension src-file) ".exe")) + (compile + (progn (with-temp-file src-file (insert full-body)) + (org-babel-eval + (concat org-babel-vbnet-compiler " " cmpflag " " src-file) + "")))) + (let ((results (org-babel-eval (concat org-babel-vbnet-command " " cmdline " " exe-file) ""))) + (org-babel-reassemble-table + (org-babel-result-cond (cdr (assq :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "c-"))) + (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-prep-session:vbnet (session params) + "Return an error because vbnet does not support sessions." + (error "Sessions are not supported for VB.Net")) + +(provide 'ob-vbnet) + + + +;;; ob-vbnet.el ends here diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el index 7b0a89d..587aa67 100644 --- a/contrib/lisp/org-bibtex-extras.el +++ b/contrib/lisp/org-bibtex-extras.el @@ -61,6 +61,8 @@ ;;; Code: (require 'org-bibtex) +(declare-function org-trim "org" (s &optional keep-lead)) + (defcustom obe-bibtex-file nil "File holding bibtex entries.") (defcustom obe-html-link-base nil @@ -91,7 +93,7 @@ For example, to point to your `obe-bibtex-file' use the following. (replace-match (save-match-data (mapconcat (lambda (c) (format "[[%s#%s][%s]]" obe-html-link-base c c)) - (mapcar #'org-babel-trim + (mapcar #'org-trim (split-string (match-string 1) ",")) ", ")))))) (defun obe-meta-to-json (meta &optional fields) @@ -111,12 +113,12 @@ For example, to point to your `obe-bibtex-file' use the following. (add (remove-duplicates (col field) :test #'string=))) ;; build the links in the graph (dolist (citation meta) - (let ((dest (id (cdr (assoc :title citation))))) - (dolist (author (mapcar #'id (cdr (assoc :authors citation)))) + (let ((dest (id (cdr (assq :title citation))))) + (dolist (author (mapcar #'id (cdr (assq :authors citation)))) (when author (push (cons author dest) links))) - (let ((jid (id (cdr (assoc :journal citation))))) + (let ((jid (id (cdr (assq :journal citation))))) (when jid (push (cons jid dest) links))) - (let ((cid (id (cdr (assoc :category citation))))) + (let ((cid (id (cdr (assq :category citation))))) (when cid (push (cons cid dest) links))))) ;; build the json string (format "{\"nodes\":[%s],\"links\":[%s]}" diff --git a/contrib/lisp/org-bookmark.el b/contrib/lisp/org-bookmark.el index 40c7cd0..f042467 100644 --- a/contrib/lisp/org-bookmark.el +++ b/contrib/lisp/org-bookmark.el @@ -47,8 +47,9 @@ Otherwise prompt the user for the right bookmark to use." :group 'org-bookmark :type 'boolean) -(org-add-link-type "bookmark" 'org-bookmark-open) -(add-hook 'org-store-link-functions 'org-bookmark-store-link) +(org-link-set-parameters "bookmark" + :follow #'org-bookmark-open + :store #'org-bookmark-store-link) (defun org-bookmark-open (bookmark) "Visit the bookmark BOOKMARK." diff --git a/contrib/lisp/org-colview-xemacs.el b/contrib/lisp/org-colview-xemacs.el deleted file mode 100644 index a27275e..0000000 --- a/contrib/lisp/org-colview-xemacs.el +++ /dev/null @@ -1,1714 +0,0 @@ -;;; org-colview-xemacs.el --- Column View in Org-mode, XEmacs-specific version - -;; Copyright (C) 2004-2015 -;; Carsten Dominik - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of Org mode, it is not part of GNU Emacs. -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the column view for Org. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'org) - -(declare-function org-agenda-redo "org-agenda" ()) - - -;;; Define additional faces for column view - -(when (featurep 'xemacs) - - (defface org-columns-level-1;; font-lock-function-name-face - (org-compatible-face - 'outline-1 - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1" :background "grey90")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue" :background "grey30")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue" :background "grey90")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue" :background "grey30")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used for columns-level 1 headlines." - :group 'org-faces) - - (defface org-columns-level-2;; font-lock-variable-name-face - (org-compatible-face - 'outline-2 - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod" :background "grey90")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod" :background "grey30")) - (((class color) (min-colors 8) (background light)) (:foreground "yellow" :background "grey90")) - (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) - (t (:bold t)))) - "Face used for columns-level 2 headlines." - :group 'org-faces) - - (defface org-columns-level-3;; font-lock-keyword-face - (org-compatible-face - 'outline-3 - '((((class color) (min-colors 88) (background light)) (:foreground "Purple" :background "grey90")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1" :background "grey30")) - (((class color) (min-colors 16) (background light)) (:foreground "Purple" :background "grey90")) - (((class color) (min-colors 16) (background dark)) (:foreground "Cyan" :background "grey30")) - (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) - (t (:bold t)))) - "Face used for columns-level 3 headlines." - :group 'org-faces) - - (defface org-columns-level-4;; font-lock-comment-face - (org-compatible-face - 'outline-4 - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick" :background "grey90")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1" :background "grey30")) - (((class color) (min-colors 16) (background light)) (:foreground "red")) - (((class color) (min-colors 16) (background dark)) (:foreground "red1")) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face used for columns-level 4 headlines." - :group 'org-faces) - - (defface org-columns-level-5;; font-lock-type-face - (org-compatible-face - 'outline-5 - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :background "grey90")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :background "grey30")) - (((class color) (min-colors 8)) (:foreground "green")))) - "Face used for columns-level 5 headlines." - :group 'org-faces) - - (defface org-columns-level-6;; font-lock-constant-face - (org-compatible-face - 'outline-6 - '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue" :background "grey90")) - (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine" :background "grey30")) - (((class color) (min-colors 8)) (:foreground "magenta")))) - "Face used for columns-level 6 headlines." - :group 'org-faces) - - (defface org-columns-level-7;; font-lock-builtin-face - (org-compatible-face - 'outline-7 - '((((class color) (min-colors 16) (background light)) (:foreground "Orchid" :background "grey90")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue" :background "grey30")) - (((class color) (min-colors 8)) (:foreground "blue")))) - "Face used for columns-level 7 headlines." - :group 'org-faces) - - (defface org-columns-level-8;; font-lock-string-face - (org-compatible-face - 'outline-8 - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown" :background "grey90")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon" :background "grey30")) - (((class color) (min-colors 8)) (:foreground "green")))) - "Face used for columns-level 8 headlines." - :group 'org-faces) - - - (defface org-columns-space;; font-lock-function-name-face - (org-compatible-face - 'outline-1 - '((((class color) (min-colors 88) (background light)) (:background "grey90")) - (((class color) (min-colors 88) (background dark)) (:background "grey30")) - (((class color) (min-colors 16) (background light)) (:background "grey90")) - (((class color) (min-colors 16) (background dark)) (:background "grey30")) - (((class color) (min-colors 8)) (:bold t :underline t)))) - "Face used for columns space headlines." - :group 'org-faces) - - (defface org-columns-space1;; font-lock-function-name-face - (org-compatible-face - 'outline-1 - '((((class color) (min-colors 88) (background light)) (:background "grey90")) - (((class color) (min-colors 88) (background dark)) (:background "grey30")) - (((class color) (min-colors 16) (background light)) (:background "grey90")) - (((class color) (min-colors 16) (background dark)) (:background "grey30")) - (((class color) (min-colors 8)) (:bold t :underline t)))) - "Face used for columns space headlines." - :group 'org-faces) - ) - -(when (featurep 'xemacs) - (defconst org-columns-level-faces - '(org-columns-level-1 - org-columns-level-2 org-columns-level-3 - org-columns-level-4 org-columns-level-5 org-columns-level-6 - org-columns-level-7 org-columns-level-8 - )) - - (defun org-get-columns-level-face (n) - "Get the right face for match N in font-lock matching of headlines." - (setq org-l (- (match-end 2) (match-beginning 1) 1)) - (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) - (setq org-f (nth (% (1- org-l) org-n-level-faces) org-columns-level-faces)) - (cond - ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) - ((eq n 2) org-f) - (t (if org-level-color-stars-only nil org-f)))) - ) - - -;;; Column View - -(defvar org-columns-overlays nil - "Holds the list of current column overlays.") - -(defvar org-columns-current-fmt nil - "Local variable, holds the currently active column format.") -(make-variable-buffer-local 'org-columns-current-fmt) -(defvar org-columns-current-fmt-compiled nil - "Local variable, holds the currently active column format. -This is the compiled version of the format.") -(make-variable-buffer-local 'org-columns-current-fmt-compiled) -(defvar org-columns-current-widths nil - "Local variable, holds the currently widths of fields.") -(make-variable-buffer-local 'org-columns-current-widths) -(defvar org-columns-current-maxwidths nil - "Local variable, holds the currently active maximum column widths.") -(make-variable-buffer-local 'org-columns-current-maxwidths) -(defvar org-columns-begin-marker (make-marker) - "Points to the position where last a column creation command was called.") -(defvar org-columns-top-level-marker (make-marker) - "Points to the position where current columns region starts.") - -(defvar org-columns-map (make-sparse-keymap) - "The keymap valid in column display.") - -(defun org-columns-content () - "Switch to contents view while in columns view." - (interactive) - (org-overview) - (org-content)) - -(org-defkey org-columns-map "c" 'org-columns-content) -(org-defkey org-columns-map "o" 'org-overview) -(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-c" 'org-columns-set-tags-or-toggle) -(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 "q" 'org-columns-quit) -(org-defkey org-columns-map "r" 'org-columns-redo) -(org-defkey org-columns-map "g" 'org-columns-redo) -(org-defkey org-columns-map [left] 'org-columns-backward-char) -(org-defkey org-columns-map "\M-b" 'org-columns-backward-char) -(org-defkey org-columns-map "a" 'org-columns-edit-allowed) -(org-defkey org-columns-map "s" 'org-columns-edit-attributes) -(org-defkey org-columns-map "\M-f" 'org-columns-forward-char) -(org-defkey org-columns-map [right] 'org-columns-forward-char) -(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value) -(org-defkey org-columns-map "n" 'org-columns-next-allowed-value) -(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value) -(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value) -(org-defkey org-columns-map "<" 'org-columns-narrow) -(org-defkey org-columns-map ">" 'org-columns-widen) -(org-defkey org-columns-map [(meta right)] 'org-columns-move-right) -(org-defkey org-columns-map [(meta left)] 'org-columns-move-left) -(org-defkey org-columns-map [(shift meta right)] 'org-columns-new) -(org-defkey org-columns-map [(shift meta left)] 'org-columns-delete) -(dotimes (i 10) - (org-defkey org-columns-map (number-to-string i) - `(lambda () (interactive) - (org-columns-next-allowed-value nil ,i)))) - -(easy-menu-define org-columns-menu org-columns-map "Org Column Menu" - '("Column" - ["Edit property" org-columns-edit-value t] - ["Next allowed value" org-columns-next-allowed-value t] - ["Previous allowed value" org-columns-previous-allowed-value t] - ["Show full value" org-columns-show-value t] - ["Edit allowed values" org-columns-edit-allowed t] - "--" - ["Edit column attributes" org-columns-edit-attributes t] - ["Increase column width" org-columns-widen t] - ["Decrease column width" org-columns-narrow t] - "--" - ["Move column right" org-columns-move-right t] - ["Move column left" org-columns-move-left t] - ["Add column" org-columns-new t] - ["Delete column" org-columns-delete t] - "--" - ["CONTENTS" org-columns-content t] - ["OVERVIEW" org-overview t] - ["Refresh columns display" org-columns-redo t] - "--" - ["Open link" org-columns-open-link t] - "--" - ["Quit" org-columns-quit t])) - -(defun org-columns-current-column () - (if (featurep 'xemacs) - (/ (current-column) 2) - (current-column))) - -(defun org-columns-forward-char () - (interactive) - (forward-char) - (if (featurep 'xemacs) - (while (not (or (eolp) - (member (extent-at - (point) (current-buffer) - 'org-columns-key) org-columns-overlays))) - (forward-char)))) - -(defun org-columns-backward-char () - (interactive) - (backward-char) - (if (featurep 'xemacs) - (while (not (or (bolp) - (member (extent-at (point) (current-buffer) 'org-columns-key) org-columns-overlays))) - (backward-char)))) - -(defun org-columns-new-overlay (beg end &optional string face) - "Create a new column overlay and add it to the list." - (let ((ov (make-overlay beg end))) - (if (featurep 'xemacs) - (progn - (overlay-put ov 'face (or face 'org-columns-space1)) - (overlay-put ov 'start-open t) - (if string - (org-overlay-display ov string (or face 'org-columns-space1)))) - (overlay-put ov 'face (or face 'secondary-selection)) - (org-overlay-display ov string face)) - (push ov org-columns-overlays) - ov)) - -(defun org-columns-display-here (&optional props) - "Overlay the current line with column display." - (interactive) - (let* ((fmt org-columns-current-fmt-compiled) - (beg (point-at-bol)) - (level-face (save-excursion - (beginning-of-line 1) - (and (looking-at "\\(\\**\\)\\(\\* \\)") - (org-get-level-face 2)))) - (color (if (featurep 'xemacs) - (save-excursion - (beginning-of-line 1) - (and (looking-at "\\(\\**\\)\\(\\* \\)") - (org-get-columns-level-face 2))) - (list :foreground - (face-attribute - (or level-face - (and (eq major-mode 'org-agenda-mode) - (get-text-property (point-at-bol) 'face)) - 'default) :foreground)))) - (face (if (featurep 'xemacs) color (list color 'org-column))) - (pl (- (point) - (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) - (point)))) - (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp)) - pom property ass width f string ov column val modval s2 title calc) - ;; Check if the entry is in another buffer. - (unless props - (if (eq major-mode 'org-agenda-mode) - (setq pom (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker)) - props (if pom (org-entry-properties pom) nil)) - (setq props (org-entry-properties nil)))) - ;; Walk the format - (while (setq column (pop fmt)) - (setq property (car column) - title (nth 1 column) - ass (assoc-string property props t) - width (or (cdr (assoc-string property - org-columns-current-maxwidths - t)) - (nth 2 column) - (length property)) - f (format (if (featurep 'xemacs) "%%-%d.%ds |" "%%-%d.%ds | ") - width width) - val (or (cdr ass) "") - calc (nth 7 column) - modval (cond ((and org-columns-modify-value-for-display-function - (functionp - org-columns-modify-value-for-display-function)) - (funcall org-columns-modify-value-for-display-function - title val)) - ((equal property "ITEM") - (org-columns-compact-links val)) - ((and calc (functionp calc) - (not (string= val "")) - (not (get-text-property 0 'org-computed val))) - (org-columns-number-to-string - (funcall calc (org-columns-string-to-number - val (nth 4 column))) - (nth 4 column))))) - (setq s2 (org-columns-add-ellipses (or modval val) width)) - (setq string (format f s2)) - ;; Create the overlay - (org-unmodified - (setq ov (org-columns-new-overlay - beg (setq beg (1+ beg)) string face)) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'org-columns-key property) - (overlay-put ov 'org-columns-value (cdr ass)) - (overlay-put ov 'org-columns-value-modified modval) - (overlay-put ov 'org-columns-pom pom) - (overlay-put ov 'org-columns-format f) - (when (featurep 'xemacs) - (if (or (not (char-after beg)) - (equal (char-after beg) ?\n)) - (let ((inhibit-read-only t)) - (save-excursion - (goto-char beg) - (org-unmodified (insert " ")) - ;; FIXME: add props and remove later? - ))) - (goto-char beg) - (org-columns-new-overlay - beg (1+ beg) nil 'org-columns-space) - (setq beg (1+ beg)))) - - (if (or (not (char-after beg)) - (equal (char-after beg) ?\n)) - (let ((inhibit-read-only t)) - (save-excursion - (goto-char beg) - ;; FIXME: add props and remove later? - (org-unmodified (insert " ")))))) - ;; Make the rest of the line disappear. - (org-unmodified - (setq ov (org-columns-new-overlay beg (point-at-eol))) - (overlay-put ov 'invisible t) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'intangible t) - (push ov org-columns-overlays) - (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) - (overlay-put ov 'keymap org-columns-map) - (push ov org-columns-overlays) - (let ((inhibit-read-only t)) - (put-text-property (max (point-min) (1- (point-at-bol))) - (min (point-max) (1+ (point-at-eol))) - 'read-only "Type `e' to edit property"))))) - -(defun org-columns-add-ellipses (string width) - "Truncate STRING with WIDTH characters, with ellipses." - (cond - ((<= (length string) width) string) - ((<= width (length org-columns-ellipses)) - (substring org-columns-ellipses 0 width)) - (t (concat (substring string 0 (- width (length org-columns-ellipses))) - org-columns-ellipses)))) - -(defvar org-columns-full-header-line-format nil - "The full header line format, will be shifted by horizontal scrolling." ) -(defvar org-previous-header-line-format nil - "The header line format before column view was turned on.") -(defvar org-columns-inhibit-recalculation nil - "Inhibit recomputing of columns on column view startup.") - - -(defvar header-line-format) -(defvar org-columns-previous-hscroll 0) - -(defun org-columns-display-here-title () - "Overlay the newline before the current line with the table title." - (interactive) - (let ((fmt org-columns-current-fmt-compiled) - string (title "") - property width f column str widths) - (while (setq column (pop fmt)) - (setq property (car column) - str (or (nth 1 column) property) - width (or (cdr (assoc-string property - org-columns-current-maxwidths - t)) - (nth 2 column) - (length str)) - widths (push width widths) - f (format "%%-%d.%ds | " width width) - string (format f str) - title (concat title string))) - (if (featurep 'xemacs) - (let ((ext (make-extent nil nil))) - (set-extent-endpoints ext 0 (length title) title) - (set-extent-face ext (list 'bold 'underline 'org-columns-space1)) - (org-set-local 'org-previous-header-line-format - (specifier-specs top-gutter)) - (org-set-local 'org-columns-current-widths (nreverse widths)) - (set-specifier top-gutter (make-gutter-specifier - (cons (current-buffer) title)))) - (setq title (concat - (org-add-props " " nil 'display '(space :align-to 0)) - (org-add-props title nil 'face '(:weight bold :underline t)))) - (org-set-local 'org-previous-header-line-format header-line-format) - (org-set-local 'org-columns-current-widths (nreverse widths)) - (setq org-columns-full-header-line-format title) - (setq org-columns-previous-hscroll -1) - (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local)))) - -(defun org-columns-hscoll-title () - "Set the `header-line-format' so that it scrolls along with the table." - (sit-for .0001) ; need to force a redisplay to update window-hscroll - (when (not (= (window-hscroll) org-columns-previous-hscroll)) - (setq header-line-format - (concat (substring org-columns-full-header-line-format 0 1) - (substring org-columns-full-header-line-format - (1+ (window-hscroll)))) - org-columns-previous-hscroll (window-hscroll)) - (force-mode-line-update))) - -(defvar org-colview-initial-truncate-line-value nil - "Remember the value of `truncate-lines' across colview.") - -;;;###autoload -(defun org-columns-remove-overlays () - "Remove all currently active column overlays." - (interactive) - (when (marker-buffer org-columns-begin-marker) - (with-current-buffer (marker-buffer org-columns-begin-marker) - (when (local-variable-p 'org-previous-header-line-format (current-buffer)) - (if (featurep 'xemacs) - (set-specifier top-gutter - (make-gutter-specifier - (cons (current-buffer) - (cdar org-previous-header-line-format)))) - (setq header-line-format org-previous-header-line-format) - (remove-hook 'post-command-hook 'org-columns-hscoll-title 'local)) - (kill-local-variable 'org-previous-header-line-format)) - (move-marker org-columns-begin-marker nil) - (move-marker org-columns-top-level-marker nil) - (org-unmodified - (mapc 'delete-overlay org-columns-overlays) - (setq org-columns-overlays nil) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t)))) - (when (local-variable-p 'org-colview-initial-truncate-line-value - (current-buffer)) - (setq truncate-lines org-colview-initial-truncate-line-value))))) - -(defun org-columns-compact-links (s) - "Replace [[link][desc]] with [desc] or [link]." - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match - (concat "[" (match-string (if (match-end 3) 3 1) s) "]") - t t s))) - s) - -(defun org-columns-show-value () - "Show the full value of the property." - (interactive) - (let ((value (get-char-property (point) 'org-columns-value))) - (message "Value is: %s" (or value "")))) - -(defvar org-agenda-columns-active) ;; defined in org-agenda.el - -(defun org-columns-quit () - "Remove the column overlays and in this way exit column editing." - (interactive) - (org-unmodified - (org-columns-remove-overlays) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t)))) - (when (eq major-mode 'org-agenda-mode) - (setq org-agenda-columns-active nil) - (message - "Modification not yet reflected in Agenda buffer, use `r' to refresh"))) - -(defun org-columns-check-computed () - "Check if this column value is computed. -If yes, throw an error indicating that changing it does not make sense." - (let ((val (get-char-property (point) 'org-columns-value))) - (when (and (stringp val) - (get-char-property 0 'org-computed val)) - (error "This value is computed from the entry's children")))) - -(defun org-columns-todo (&optional arg) - "Change the TODO state during column view." - (interactive "P") - (org-columns-edit-value "TODO")) - -(defun org-columns-set-tags-or-toggle (&optional arg) - "Toggle checkbox at point, or set tags for current headline." - (interactive "P") - (if (string-match "\\`\\[[ xX-]\\]\\'" - (get-char-property (point) 'org-columns-value)) - (org-columns-next-allowed-value) - (org-columns-edit-value "TAGS"))) - -(defun org-columns-edit-value (&optional key) - "Edit the value of the property at point in column view. -Where possible, use the standard interface for changing this line." - (interactive) - (org-columns-check-computed) - (let* ((col (current-column)) - (key (or key (get-char-property (point) 'org-columns-key))) - (value (get-char-property (point) 'org-columns-value)) - (bol (point-at-bol)) (eol (point-at-eol)) - (pom (or (get-text-property bol 'org-hd-marker) - (point))) ; keep despite of compiler warning - (line-overlays - (delq nil (mapcar (lambda (x) - (and (eq (overlay-buffer x) (current-buffer)) - (>= (overlay-start x) bol) - (<= (overlay-start x) eol) - x)) - org-columns-overlays))) - (org-columns-time (time-to-number-of-days (current-time))) - nval eval allowed) - (cond - ((equal key "CLOCKSUM") - (error "This special column cannot be edited")) - ((equal key "ITEM") - (setq eval '(org-with-point-at pom (org-edit-headline)))) - ((equal key "TODO") - (setq eval '(org-with-point-at - pom - (call-interactively 'org-todo)))) - ((equal key "PRIORITY") - (setq eval '(org-with-point-at pom - (call-interactively 'org-priority)))) - ((equal key "TAGS") - (setq eval '(org-with-point-at - pom - (let ((org-fast-tag-selection-single-key - (if (eq org-fast-tag-selection-single-key 'expert) - t org-fast-tag-selection-single-key))) - (call-interactively 'org-set-tags))))) - ((equal key "DEADLINE") - (setq eval '(org-with-point-at - pom - (call-interactively 'org-deadline)))) - ((equal key "SCHEDULED") - (setq eval '(org-with-point-at - pom - (call-interactively 'org-schedule)))) - (t - (setq allowed (org-property-get-allowed-values pom key 'table)) - (if allowed - (setq nval (org-icompleting-read - "Value: " allowed nil - (not (get-text-property 0 'org-unrestricted - (caar allowed))))) - (setq nval (read-string "Edit: " value))) - (setq nval (org-trim nval)) - (when (not (equal nval value)) - (setq eval '(org-entry-put pom key nval))))) - (when eval - - (cond - ((equal major-mode 'org-agenda-mode) - (org-columns-eval eval) - ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be upated. - (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) - (buffer (marker-buffer pom)) - (org-agenda-contributing-files - (list (with-current-buffer buffer - (buffer-file-name (buffer-base-buffer)))))) - (org-agenda-columns))) - (t - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties - (max (point-min) (1- bol)) eol '(read-only t))) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'delete-overlay line-overlays) - (org-columns-eval eval)) - (org-columns-display-here))) - (org-move-to-column col) - (if (and (derived-mode-p 'org-mode) - (nth 3 (assoc-string key org-columns-current-fmt-compiled t))) - (org-columns-update key))))))) - -(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda???? - "Edit the current headline, the part without TODO keyword, TAGS." - (org-back-to-heading) - (when (looking-at org-todo-line-regexp) - (let ((pos (point)) - (pre (buffer-substring (match-beginning 0) (match-beginning 3))) - (txt (match-string 3)) - (post "") - txt2) - (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt) - (setq post (match-string 0 txt) - txt (substring txt 0 (match-beginning 0)))) - (setq txt2 (read-string "Edit: " txt)) - (when (not (equal txt txt2)) - (goto-char pos) - (insert pre txt2 post) - (delete-region (point) (point-at-eol)) - (org-set-tags nil t))))) - -(defun org-columns-edit-allowed () - "Edit the list of allowed values for the current property." - (interactive) - (let* ((pom (or (org-get-at-bol 'org-marker) - (org-get-at-bol 'org-hd-marker) - (point))) - (key (get-char-property (point) 'org-columns-key)) - (key1 (concat key "_ALL")) - (allowed (org-entry-get pom key1 t)) - nval) - ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.???? - ;; FIXME: Write back to #+PROPERTY setting if that is needed. - (setq nval (read-string "Allowed: " allowed)) - (org-entry-put - (cond ((marker-position org-entry-property-inherited-from) - org-entry-property-inherited-from) - ((marker-position org-columns-top-level-marker) - org-columns-top-level-marker) - (t pom)) - key1 nval))) - -(defun org-columns-eval (form) - (let (hidep) - (save-excursion - (beginning-of-line 1) - ;; `next-line' is needed here, because it skips invisible line. - (condition-case nil (org-no-warnings (next-line 1)) (error nil)) - (setq hidep (org-at-heading-p 1))) - (eval form) - (and hidep (hide-entry)))) - -(defun org-columns-previous-allowed-value () - "Switch to the previous allowed value for this column." - (interactive) - (org-columns-next-allowed-value t)) - -(defun org-columns-next-allowed-value (&optional previous nth) - "Switch to the next allowed value for this column. -When PREVIOUS is set, go to the previous value. When NTH is -an integer, select that value." - (interactive) - (org-columns-check-computed) - (let* ((col (current-column)) - (key (get-char-property (point) 'org-columns-key)) - (value (get-char-property (point) 'org-columns-value)) - (bol (point-at-bol)) (eol (point-at-eol)) - (pom (or (get-text-property bol 'org-hd-marker) - (point))) ; keep despite of compiler waring - (line-overlays - (delq nil (mapcar (lambda (x) - (and (eq (overlay-buffer x) (current-buffer)) - (>= (overlay-start x) bol) - (<= (overlay-start x) eol) - x)) - org-columns-overlays))) - (allowed (or (org-property-get-allowed-values pom key) - (and (memq - (nth 4 (assoc-string key - org-columns-current-fmt-compiled - t)) - '(checkbox checkbox-n-of-m checkbox-percent)) - '("[ ]" "[X]")) - (org-colview-construct-allowed-dates value))) - nval) - (when (integerp nth) - (setq nth (1- nth)) - (if (= nth -1) (setq nth 9))) - (when (equal key "ITEM") - (error "Cannot edit item headline from here")) - (unless (or allowed (member key '("SCHEDULED" "DEADLINE"))) - (error "Allowed values for this property have not been defined")) - (if (member key '("SCHEDULED" "DEADLINE")) - (setq nval (if previous 'earlier 'later)) - (if previous (setq allowed (reverse allowed))) - (cond - (nth - (setq nval (nth nth allowed)) - (if (not nval) - (error "There are only %d allowed values for property `%s'" - (length allowed) key))) - ((member value allowed) - (setq nval (or (car (cdr (member value allowed))) - (car allowed))) - (if (equal nval value) - (error "Only one allowed value for this property"))) - (t (setq nval (car allowed))))) - (cond - ((equal major-mode 'org-agenda-mode) - (org-columns-eval '(org-entry-put pom key nval)) - ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be upated. - (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) - (buffer (marker-buffer pom)) - (org-agenda-contributing-files - (list (with-current-buffer buffer - (buffer-file-name (buffer-base-buffer)))))) - (org-agenda-columns))) - (t - (let ((inhibit-read-only t)) - (remove-text-properties (1- bol) eol '(read-only t)) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'delete-overlay line-overlays) - (org-columns-eval '(org-entry-put pom key nval))) - (org-columns-display-here))) - (org-move-to-column col) - (and (nth 3 (assoc-string key org-columns-current-fmt-compiled t)) - (org-columns-update key)))))) - -(defun org-colview-construct-allowed-dates (s) - "Construct a list of three dates around the date in S. -This respects the format of the time stamp in S, active or non-active, -and also including time or not. S must be just a time stamp, no text -around it." - (when (and s (string-match (concat "^" org-ts-regexp3 "$") s)) - (let* ((time (org-parse-time-string s 'nodefaults)) - (active (equal (string-to-char s) ?<)) - (fmt (funcall (if (nth 1 time) 'cdr 'car) org-time-stamp-formats)) - time-before time-after) - (unless active (setq fmt (concat "[" (substring fmt 1 -1) "]"))) - (setf (car time) (or (car time) 0)) - (setf (nth 1 time) (or (nth 1 time) 0)) - (setf (nth 2 time) (or (nth 2 time) 0)) - (setq time-before (copy-sequence time)) - (setq time-after (copy-sequence time)) - (setf (nth 3 time-before) (1- (nth 3 time))) - (setf (nth 3 time-after) (1+ (nth 3 time))) - (mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x))) - (list time-before time time-after))))) - -(defun org-verify-version (task) - (cond - ((eq task 'columns) - (if (or (and (featurep 'xemacs) (not (featurep 'org-colview-xemacs))) - (and (not (featurep 'xemacs)) (< emacs-major-version 22))) - (error "This version of Emacs cannot run Column View"))))) - -(defun org-columns-open-link (&optional arg) - (interactive "P") - (let ((value (get-char-property (point) 'org-columns-value))) - (org-open-link-from-string value arg))) - -;;;###autoload -(defun org-columns-get-format-and-top-level () - (let (fmt) - (when (condition-case nil (org-back-to-heading) (error nil)) - (setq fmt (org-entry-get nil "COLUMNS" t))) - (setq fmt (or fmt org-columns-default-format)) - (org-set-local 'org-columns-current-fmt fmt) - (org-columns-compile-format fmt) - (if (marker-position org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker - org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker (point))) - fmt)) - -(defun org-columns () - "Turn on column view on an org-mode file." - (interactive) - (org-verify-version 'columns) - (when (featurep 'xemacs) - (set-face-foreground 'org-columns-space - (face-background 'org-columns-space))) - (org-columns-remove-overlays) - (move-marker org-columns-begin-marker (point)) - (let ((org-columns-time (time-to-number-of-days (current-time))) - beg end fmt cache maxwidths) - (setq fmt (org-columns-get-format-and-top-level)) - (save-excursion - (goto-char org-columns-top-level-marker) - (setq beg (point)) - (unless org-columns-inhibit-recalculation - (org-columns-compute-all)) - (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) - (point-max))) - ;; Get and cache the properties - (goto-char beg) - (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (org-clock-sum)))) - (while (re-search-forward org-outline-regexp-bol end t) - (if (and org-columns-skip-archived-trees - (looking-at (concat ".*:" org-archive-tag ":"))) - (org-end-of-subtree t) - (push (cons (org-current-line) (org-entry-properties)) cache))) - (when cache - (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) - (org-set-local 'org-columns-current-maxwidths maxwidths) - (org-columns-display-here-title) - (unless (local-variable-p 'org-colview-initial-truncate-line-value - (current-buffer)) - (org-set-local 'org-colview-initial-truncate-line-value - truncate-lines)) - (setq truncate-lines t) - (mapc (lambda (x) - (org-goto-line (car x)) - (org-columns-display-here (cdr x))) - cache))))) - -(eval-when-compile (defvar org-columns-time)) - -(defvar org-columns-compile-map - '(("none" none +) - (":" add_times +) - ("+" add_numbers +) - ("$" currency +) - ("X" checkbox +) - ("X/" checkbox-n-of-m +) - ("X%" checkbox-percent +) - ("max" max_numbers max) - ("min" min_numbers min) - ("mean" mean_numbers - (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - (":max" max_times max) - (":min" min_times min) - (":mean" mean_times - (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - ("@min" min_age min (lambda (x) (- org-columns-time x))) - ("@max" max_age max (lambda (x) (- org-columns-time x))) - ("@mean" mean_age - (lambda (&rest x) (/ (apply '+ x) (float (length x)))) - (lambda (x) (- org-columns-time x))) - ("est+" estimate org-estimate-combine)) - "Operator <-> format,function,calc map. -Used to compile/uncompile columns format and completing read in -interactive function `org-columns-new'. - - operator string used in #+COLUMNS definition describing the - summary type - format symbol describing summary type selected interactively in - `org-columns-new' and internally in - `org-columns-number-to-string' and - `org-columns-string-to-number' - function called with a list of values as argument to calculate - the summary value - calc function called on every element before summarizing. This is - optional and should only be specified if needed") - - -(defun org-columns-new (&optional prop title width op fmt fun &rest rest) - "Insert a new column, to the left of the current column." - (interactive) - (let ((n (org-columns-current-column)) - (editp (and prop (assoc-string prop - org-columns-current-fmt-compiled - t))) - cell) - (setq prop (org-icompleting-read - "Property: " (mapcar 'list (org-buffer-property-keys t nil t)) - nil nil prop)) - (setq title (read-string (concat "Column title [" prop "]: ") (or title prop))) - (setq width (read-string "Column width: " (if width (number-to-string width)))) - (if (string-match "\\S-" width) - (setq width (string-to-number width)) - (setq width nil)) - (setq fmt (org-icompleting-read "Summary [none]: " - (mapcar (lambda (x) (list (symbol-name (cadr x)))) org-columns-compile-map) - nil t)) - (setq fmt (intern fmt) - fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map)))) - (if (eq fmt 'none) (setq fmt nil)) - (if editp - (progn - (setcar editp prop) - (setcdr editp (list title width nil fmt nil fun))) - (setq cell (nthcdr (1- n) org-columns-current-fmt-compiled)) - (setcdr cell (cons (list prop title width nil fmt nil - (car fun) (cadr fun)) - (cdr cell)))) - (org-columns-store-format) - (org-columns-redo))) - -(defun org-columns-delete () - "Delete the column at point from columns view." - (interactive) - (let* ((n (org-columns-current-column)) - (title (nth 1 (nth n org-columns-current-fmt-compiled)))) - (when (y-or-n-p - (format "Are you sure you want to remove column \"%s\"? " title)) - (setq org-columns-current-fmt-compiled - (delq (nth n org-columns-current-fmt-compiled) - org-columns-current-fmt-compiled)) - (org-columns-store-format) - (org-columns-redo) - (if (>= (org-columns-current-column) - (length org-columns-current-fmt-compiled)) - (org-columns-backward-char))))) - -(defun org-columns-edit-attributes () - "Edit the attributes of the current column." - (interactive) - (let* ((n (org-columns-current-column)) - (info (nth n org-columns-current-fmt-compiled))) - (apply 'org-columns-new info))) - -(defun org-columns-widen (arg) - "Make the column wider by ARG characters." - (interactive "p") - (let* ((n (org-columns-current-column)) - (entry (nth n org-columns-current-fmt-compiled)) - (width (or (nth 2 entry) - (cdr (assoc-string (car entry) - org-columns-current-maxwidths - t))))) - (setq width (max 1 (+ width arg))) - (setcar (nthcdr 2 entry) width) - (org-columns-store-format) - (org-columns-redo))) - -(defun org-columns-narrow (arg) - "Make the column narrower by ARG characters." - (interactive "p") - (org-columns-widen (- arg))) - -(defun org-columns-move-right () - "Swap this column with the one to the right." - (interactive) - (let* ((n (org-columns-current-column)) - (cell (nthcdr n org-columns-current-fmt-compiled)) - e) - (when (>= n (1- (length org-columns-current-fmt-compiled))) - (error "Cannot shift this column further to the right")) - (setq e (car cell)) - (setcar cell (car (cdr cell))) - (setcdr cell (cons e (cdr (cdr cell)))) - (org-columns-store-format) - (org-columns-redo) - (org-columns-forward-char))) - -(defun org-columns-move-left () - "Swap this column with the one to the left." - (interactive) - (let* ((n (org-columns-current-column))) - (when (= n 0) - (error "Cannot shift this column further to the left")) - (org-columns-backward-char) - (org-columns-move-right) - (org-columns-backward-char))) - -(defun org-columns-store-format () - "Store the text version of the current columns format in appropriate place. -This is either in the COLUMNS property of the node starting the current column -display, or in the #+COLUMNS line of the current buffer." - (let (fmt (cnt 0)) - (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)) - (org-set-local 'org-columns-current-fmt fmt) - (if (marker-position org-columns-top-level-marker) - (save-excursion - (goto-char org-columns-top-level-marker) - (if (and (org-at-heading-p) - (org-entry-get nil "COLUMNS")) - (org-entry-put nil "COLUMNS" fmt) - (goto-char (point-min)) - ;; Overwrite all #+COLUMNS lines.... - (while (re-search-forward "^#\\+COLUMNS:.*" nil t) - (setq cnt (1+ cnt)) - (replace-match (concat "#+COLUMNS: " fmt) t t)) - (unless (> cnt 0) - (goto-char (point-min)) - (or (org-at-heading-p t) (outline-next-heading)) - (let ((inhibit-read-only t)) - (insert-before-markers "#+COLUMNS: " fmt "\n"))) - (org-set-local 'org-columns-default-format fmt)))))) - -(defvar org-agenda-overriding-columns-format nil - "When set, overrides any other format definition for the agenda. -Don't set this, this is meant for dynamic scoping.") - -(defun org-columns-get-autowidth-alist (s cache) - "Derive the maximum column widths from the format and the cache." - (let ((start 0) rtn) - (while (string-match (org-re "%\\([[:alpha:]][[:alnum:]_-]*\\)") s start) - (push (cons (match-string 1 s) 1) rtn) - (setq start (match-end 0))) - (mapc (lambda (x) - (setcdr x - (apply 'max - (let ((prop (car x))) - (mapcar - (lambda (y) - (length (or (cdr (assoc-string prop (cdr y) t)) - " "))) - cache))))) - rtn) - rtn)) - -(defun org-columns-compute-all () - "Compute all columns that have operators defined." - (org-unmodified - (remove-text-properties (point-min) (point-max) '(org-summaries t))) - (let ((columns org-columns-current-fmt-compiled) - (org-columns-time (time-to-number-of-days (current-time))) - col) - (while (setq col (pop columns)) - (when (nth 3 col) - (save-excursion - (org-columns-compute (car col))))))) - -(defun org-columns-update (property) - "Recompute PROPERTY, and update the columns display for it." - (org-columns-compute property) - (let (fmt val pos face) - (save-excursion - (mapc (lambda (ov) - (when (equal (overlay-get ov 'org-columns-key) property) - (setq pos (overlay-start ov)) - (goto-char pos) - (when (setq val (cdr (assoc-string - property - (get-text-property - (point-at-bol) 'org-summaries) - t))) - (setq fmt (overlay-get ov 'org-columns-format)) - (overlay-put ov 'org-columns-value val) - (if (featurep 'xemacs) - (progn - (setq face (glyph-face (extent-end-glyph ov))) - (org-overlay-display ov (format fmt val) face)) - (org-overlay-display ov (format fmt val)))))) - org-columns-overlays)))) - -;;;###autoload -(defun org-columns-compute (property) - "Sum the values of property PROPERTY hierarchically, for the entire buffer." - (interactive) - (let* ((re org-outline-regexp-bol) - (lmax 30) ; Does anyone use deeper levels??? - (lvals (make-vector lmax nil)) - (lflag (make-vector lmax nil)) - (level 0) - (ass (assoc-string property org-columns-current-fmt-compiled t)) - (format (nth 4 ass)) - (printf (nth 5 ass)) - (fun (nth 6 ass)) - (calc (or (nth 7 ass) 'identity)) - (beg org-columns-top-level-marker) - last-level val valflag flag end sumpos sum-alist sum str str1 useval) - (save-excursion - ;; Find the region to compute - (goto-char beg) - (setq end (condition-case nil (org-end-of-subtree t) (error (point-max)))) - (goto-char end) - ;; Walk the tree from the back and do the computations - (while (re-search-backward re beg t) - (setq sumpos (match-beginning 0) - last-level level - level (org-outline-level) - val (org-entry-get nil property) - valflag (and val (string-match "\\S-" val))) - (cond - ((< level last-level) - ;; put the sum of lower levels here as a property - (setq sum (when (aref lvals last-level) - (apply fun (aref lvals last-level))) - flag (aref lflag last-level) ; any valid entries from children? - str (org-columns-number-to-string sum format printf) - str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) - useval (if flag str1 (if valflag val "")) - sum-alist (get-text-property sumpos 'org-summaries)) - (let ((old (assoc-string property sum-alist t))) - (if old (setcdr old useval) - (push (cons property useval) sum-alist) - (org-unmodified - (add-text-properties sumpos (1+ sumpos) - (list 'org-summaries sum-alist))))) - (when (and val (not (equal val (if flag str val)))) - (org-entry-put nil property (if flag str val))) - ;; add current to current level accumulator - (when (or flag valflag) - (push (if flag - sum - (funcall calc (org-columns-string-to-number - (if flag str val) format))) - (aref lvals level)) - (aset lflag level t)) - ;; clear accumulators for deeper levels - (loop for l from (1+ level) to (1- lmax) do - (aset lvals l nil) - (aset lflag l nil))) - ((>= level last-level) - ;; add what we have here to the accumulator for this level - (when valflag - (push (funcall calc (org-columns-string-to-number val format)) - (aref lvals level)) - (aset lflag level t))) - (t (error "This should not happen"))))))) - -(defun org-columns-redo () - "Construct the column display again." - (interactive) - (message "Recomputing columns...") - (save-excursion - (if (marker-position org-columns-begin-marker) - (goto-char org-columns-begin-marker)) - (org-columns-remove-overlays) - (if (derived-mode-p 'org-mode) - (call-interactively 'org-columns) - (org-agenda-redo) - (call-interactively 'org-agenda-columns))) - (when (featurep 'xemacs) - (while (not (or (eolp) - (member (extent-at (point)) org-columns-overlays))) - (forward-char))) - (message "Recomputing columns...done")) - -(defun org-columns-not-in-agenda () - (if (eq major-mode 'org-agenda-mode) - (error "This command is only allowed in Org-mode buffers"))) - -(defun org-string-to-number (s) - "Convert string to number, and interpret hh:mm:ss." - (if (not (string-match ":" s)) - (string-to-number s) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum))) - -;;;###autoload -(defun org-columns-number-to-string (n fmt &optional printf) - "Convert a computed column number to a string value, according to FMT." - (cond - ((memq fmt '(estimate)) (org-estimate-print n printf)) - ((not (numberp n)) "") - ((memq fmt '(add_times max_times min_times mean_times)) - (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h)))))) - (format org-time-clocksum-format h m))) - ((eq fmt 'checkbox) - (cond ((= n (floor n)) "[X]") - ((> n 1.) "[-]") - (t "[ ]"))) - ((memq fmt '(checkbox-n-of-m checkbox-percent)) - (let* ((n1 (floor n)) (n2 (floor (+ .5 (* 1000000 (- n n1)))))) - (org-nofm-to-completion n1 (+ n2 n1) (eq fmt 'checkbox-percent)))) - (printf (format printf n)) - ((eq fmt 'currency) - (format "%.2f" n)) - ((memq fmt '(min_age max_age mean_age)) - (org-format-time-period n)) - (t (number-to-string n)))) - -(defun org-nofm-to-completion (n m &optional percent) - (if (not percent) - (format "[%d/%d]" n m) - (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m))))))) - -(defun org-columns-string-to-number (s fmt) - "Convert a column value to a number that can be used for column computing." - (if s - (cond - ((memq fmt '(min_age max_age mean_age)) - (cond ((string= s "") org-columns-time) - ((string-match - "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" - s) - (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) - (string-to-number (match-string 2 s)))) - (string-to-number (match-string 3 s)))) - (string-to-number (match-string 4 s)))) - (t (time-to-number-of-days (apply 'encode-time - (org-parse-time-string s t)))))) - ((string-match ":" s) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum)) - ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) - (if (equal s "[X]") 1. 0.000001)) - ((memq fmt '(estimate)) (org-string-to-estimate s)) - (t (string-to-number s))))) - -(defun org-columns-uncompile-format (cfmt) - "Turn the compiled columns format back into a string representation." - (let ((rtn "") e s prop title op op-match width fmt printf fun calc) - (while (setq e (pop cfmt)) - (setq prop (car e) - title (nth 1 e) - width (nth 2 e) - op (nth 3 e) - fmt (nth 4 e) - printf (nth 5 e) - fun (nth 6 e) - calc (nth 7 e)) - (when (setq op-match (rassoc (list fmt fun calc) org-columns-compile-map)) - (setq op (car op-match))) - (if (and op printf) (setq op (concat op ";" printf))) - (if (equal title prop) (setq title nil)) - (setq s (concat "%" (if width (number-to-string width)) - prop - (if title (concat "(" title ")")) - (if op (concat "{" op "}")))) - (setq rtn (concat rtn " " s))) - (org-trim rtn))) - -(defun org-columns-compile-format (fmt) - "Turn a column format string into an alist of specifications. -The alist has one entry for each column in the format. The elements of -that list are: -property the property -title the title field for the columns -width the column width in characters, can be nil for automatic -operator the operator if any -format the output format for computed results, derived from operator -printf a printf format for computed values -fun the lisp function to compute summary values, derived from operator -calc function to get values from base elements" - (let ((start 0) width prop title op op-match f printf fun calc) - (setq org-columns-current-fmt-compiled nil) - (while (string-match - (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") - fmt start) - (setq start (match-end 0) - width (match-string 1 fmt) - prop (match-string 2 fmt) - title (or (match-string 3 fmt) prop) - op (match-string 4 fmt) - f nil - printf nil - fun '+ - calc nil) - (if width (setq width (string-to-number width))) - (when (and op (string-match ";" op)) - (setq printf (substring op (match-end 0)) - op (substring op 0 (match-beginning 0)))) - (when (setq op-match (assoc op org-columns-compile-map)) - (setq f (cadr op-match) - fun (caddr op-match) - calc (cadddr op-match))) - (push (list prop title width op f printf fun calc) - org-columns-current-fmt-compiled)) - (setq org-columns-current-fmt-compiled - (nreverse org-columns-current-fmt-compiled)))) - - -;;; Dynamic block for Column view - -(defun org-columns-capture-view (&optional maxlevel skip-empty-rows) - "Get the column view of the current buffer or subtree. -The first optional argument MAXLEVEL sets the level limit. A -second optional argument SKIP-EMPTY-ROWS tells whether to skip -empty rows, an empty row being one where all the column view -specifiers except ITEM are empty. This function returns a list -containing the title row and all other rows. Each row is a list -of fields." - (if (featurep 'xemacs) - (save-excursion - (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) - (re-comment (format org-heading-keyword-regexp-format - org-comment-string)) - (re-archive (concat ".*:" org-archive-tag ":")) - (n (length title)) row tbl) - (goto-char (point-min)) - - (while (re-search-forward org-heading-regexp nil t) - (catch 'next - (when (and (or (null maxlevel) - (>= maxlevel - (if org-odd-levels-only - (/ (1+ (length (match-string 1))) 2) - (length (match-string 1))))) - (get-char-property (match-beginning 0) 'org-columns-key)) - (goto-char (match-beginning 0)) - (when (save-excursion - (goto-char (point-at-bol)) - (or (looking-at re-comment) - (looking-at re-archive))) - (org-end-of-subtree t) - (throw 'next t)) - (setq row nil) - (loop for i from 0 to (1- n) do - (push - (org-quote-vert - (or (get-char-property (point) - 'org-columns-value-modified) - (get-char-property (point) 'org-columns-value) - "")) - row) - (org-columns-forward-char)) - (setq row (nreverse row)) - (unless (and skip-empty-rows - (eq 1 (length (delete "" (delete-dups (copy-sequence row)))))) - (push row tbl))))) - (append (list title 'hline) (nreverse tbl)))) - (save-excursion - (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) - (n (length title)) row tbl) - (goto-char (point-min)) - (while (and (re-search-forward "^\\(\\*+\\) " nil t) - (or (null maxlevel) - (>= maxlevel - (if org-odd-levels-only - (/ (1+ (length (match-string 1))) 2) - (length (match-string 1)))))) - (when (get-char-property (match-beginning 0) 'org-columns-key) - (setq row nil) - (loop for i from 0 to (1- n) do - (push (or (get-char-property (+ (match-beginning 0) i) - 'org-columns-value-modified) - (get-char-property (+ (match-beginning 0) i) - 'org-columns-value) - "") - row)) - (setq row (nreverse row)) - (unless (and skip-empty-rows - (eq 1 (length (delete "" (delete-dups row))))) - (push row tbl)))) - (append (list title 'hline) (nreverse tbl)))))) - -(defun org-dblock-write:columnview (params) - "Write the column view table. -PARAMS is a property list of parameters: - -:width enforce same column widths with <N> specifiers. -:id the :ID: property of the entry where the columns view - should be built. When the symbol `local', call locally. - When `global' call column view with the cursor at the beginning - of the buffer (usually this means that the whole buffer switches - to column view). When \"file:path/to/file.org\", invoke column - view at the start of that file. Otherwise, the ID is located - using `org-id-find'. -:hlines When t, insert a hline before each item. When a number, insert - a hline before each level <= that number. -:vlines When t, make each column a colgroup to enforce vertical lines. -:maxlevel When set to a number, don't capture headlines below this level. -:skip-empty-rows - When t, skip rows where all specifiers other than ITEM are empty." - (let ((pos (point-marker)) - (hlines (plist-get params :hlines)) - (vlines (plist-get params :vlines)) - (maxlevel (plist-get params :maxlevel)) - (content-lines (org-split-string (plist-get params :content) "\n")) - (skip-empty-rows (plist-get params :skip-empty-rows)) - (case-fold-search t) - tbl id idpos nfields tmp recalc line - id-as-string view-file view-pos) - (when (setq id (plist-get params :id)) - (setq id-as-string (cond ((numberp id) (number-to-string id)) - ((symbolp id) (symbol-name id)) - ((stringp id) id) - (t ""))) - (cond ((not id) nil) - ((eq id 'global) (setq view-pos (point-min))) - ((eq id 'local)) - ((string-match "^file:\\(.*\\)" id-as-string) - (setq view-file (match-string 1 id-as-string) - view-pos 1) - (unless (file-exists-p view-file) - (error "No such file: \"%s\"" id-as-string))) - ((setq idpos (org-find-entry-with-id id)) - (setq view-pos idpos)) - ((setq idpos (org-id-find id)) - (setq view-file (car idpos)) - (setq view-pos (cdr idpos))) - (t (error "Cannot find entry with :ID: %s" id)))) - (with-current-buffer (if view-file - (get-file-buffer view-file) - (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char (or view-pos (point))) - (org-columns) - (setq tbl (org-columns-capture-view maxlevel skip-empty-rows)) - (setq nfields (length (car tbl))) - (org-columns-quit)))) - (goto-char pos) - (move-marker pos nil) - (when tbl - (when (plist-get params :hlines) - (setq tmp nil) - (while tbl - (if (eq (car tbl) 'hline) - (push (pop tbl) tmp) - (if (string-match "\\` *\\(\\*+\\)" (caar tbl)) - (if (and (not (eq (car tmp) 'hline)) - (or (eq hlines t) - (and (numberp hlines) - (<= (- (match-end 1) (match-beginning 1)) - hlines)))) - (push 'hline tmp))) - (push (pop tbl) tmp))) - (setq tbl (nreverse tmp))) - (when vlines - (setq tbl (mapcar (lambda (x) - (if (eq 'hline x) x (cons "" x))) - tbl)) - (setq tbl (append tbl (list (cons "/" (make-list nfields "<>")))))) - (setq pos (point)) - (when content-lines - (while (string-match "^#" (car content-lines)) - (insert (pop content-lines) "\n"))) - (insert (org-listtable-to-string tbl)) - (when (plist-get params :width) - (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x))) - org-columns-current-widths "|"))) - (while (setq line (pop content-lines)) - (when (string-match "^#" line) - (insert "\n" line) - (when (string-match "^[ \t]*#\\+tblfm" line) - (setq recalc t)))) - (if recalc - (progn (goto-char pos) (org-table-recalculate 'all)) - (goto-char pos) - (org-table-align))))) - -(defun org-listtable-to-string (tbl) - "Convert a listtable TBL to a string that contains the Org-mode table. -The table still need to be aligned. The resulting string has no leading -and tailing newline characters." - (mapconcat - (lambda (x) - (cond - ((listp x) - (concat "|" (mapconcat 'identity x "|") "|")) - ((eq x 'hline) "|-|") - (t (error "Garbage in listtable: %s" x)))) - tbl "\n")) - -(defun org-insert-columns-dblock () - "Create a dynamic block capturing a column view table." - (interactive) - (when (featurep 'xemacs) (org-columns-quit)) - (let ((defaults '(:name "columnview" :hlines 1)) - (id (org-icompleting-read - "Capture columns (local, global, entry with :ID: property) [local]: " - (append '(("global") ("local")) - (mapcar 'list (org-property-values "ID")))))) - (if (equal id "") (setq id 'local)) - (if (equal id "global") (setq id 'global)) - (setq defaults (append defaults (list :id id))) - (org-create-dblock defaults) - (org-update-dblock))) - -;;; Column view in the agenda - -(defvar org-agenda-view-columns-initially nil - "When set, switch to columns view immediately after creating the agenda.") - -(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el -(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el -(defvar org-agenda-columns-add-appointments-to-effort-sum); as well - -(defun org-agenda-columns () - "Turn on or update column view in the agenda." - (interactive) - (org-verify-version 'columns) - (org-columns-remove-overlays) - (move-marker org-columns-begin-marker (point)) - (let ((org-columns-time (time-to-number-of-days (current-time))) - cache maxwidths m p a d fmt) - (cond - ((and (boundp 'org-agenda-overriding-columns-format) - org-agenda-overriding-columns-format) - (setq fmt org-agenda-overriding-columns-format) - (org-set-local 'org-agenda-overriding-columns-format fmt)) - ((setq m (org-get-at-bol 'org-hd-marker)) - (setq fmt (or (org-entry-get m "COLUMNS" t) - (with-current-buffer (marker-buffer m) - org-columns-default-format)))) - ((and (boundp 'org-columns-current-fmt) - (local-variable-p 'org-columns-current-fmt (current-buffer)) - org-columns-current-fmt) - (setq fmt org-columns-current-fmt)) - ((setq m (next-single-property-change (point-min) 'org-hd-marker)) - (setq m (get-text-property m 'org-hd-marker)) - (setq fmt (or (org-entry-get m "COLUMNS" t) - (with-current-buffer (marker-buffer m) - org-columns-default-format))))) - (setq fmt (or fmt org-columns-default-format)) - (org-set-local 'org-columns-current-fmt fmt) - (org-columns-compile-format fmt) - (when org-agenda-columns-compute-summary-properties - (org-agenda-colview-compute org-columns-current-fmt-compiled)) - (save-excursion - ;; Get and cache the properties - (goto-char (point-min)) - (while (not (eobp)) - (when (setq m (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker))) - (setq p (org-entry-properties m)) - - (when (or (not (setq a (assoc-string org-effort-property p t))) - (not (string-match "\\S-" (or (cdr a) "")))) - ;; OK, the property is not defined. Use appointment duration? - (when (and org-agenda-columns-add-appointments-to-effort-sum - (setq d (get-text-property (point) 'duration))) - (setq d (org-minutes-to-clocksum-string d)) - (put-text-property 0 (length d) 'face 'org-warning d) - (push (cons org-effort-property d) p))) - (push (cons (org-current-line) p) cache)) - (beginning-of-line 2)) - (when cache - (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) - (org-set-local 'org-columns-current-maxwidths maxwidths) - (org-columns-display-here-title) - (mapc (lambda (x) - (org-goto-line (car x)) - (org-columns-display-here (cdr x))) - cache) - (when org-agenda-columns-show-summaries - (org-agenda-colview-summarize cache)))))) - -(defun org-agenda-colview-summarize (cache) - "Summarize the summarizable columns in column view in the agenda. -This will add overlays to the date lines, to show the summary for each day." - (let* ((fmt (mapcar (lambda (x) - (if (equal (car x) "CLOCKSUM") - (list "CLOCKSUM" (nth 2 x) nil 'add_times nil '+ 'identity) - (cdr x))) - org-columns-current-fmt-compiled)) - line c c1 stype calc sumfunc props lsum entries prop v) - (catch 'exit - (when (delq nil (mapcar 'cadr fmt)) - ;; OK, at least one summation column, it makes sense to try this - (goto-char (point-max)) - (while t - (when (or (get-text-property (point) 'org-date-line) - (eq (get-text-property (point) 'face) - 'org-agenda-structure)) - ;; OK, this is a date line that should be used - (setq line (org-current-line)) - (setq entries nil c cache cache nil) - (while (setq c1 (pop c)) - (if (> (car c1) line) - (push c1 entries) - (push c1 cache))) - ;; now ENTRIES are the ones we want to use, CACHE is the rest - ;; Compute the summaries for the properties we want, - ;; set nil properties for the rest. - (when (setq entries (mapcar 'cdr entries)) - (setq props - (mapcar - (lambda (f) - (setq prop (car f) - stype (nth 3 f) - sumfunc (nth 5 f) - calc (or (nth 6 f) 'identity)) - (cond - ((equal prop "ITEM") - (cons prop (buffer-substring (point-at-bol) - (point-at-eol)))) - ((not stype) (cons prop "")) - (t ;; do the summary - (setq lsum nil) - (dolist (x entries) - (setq v (cdr (assoc-string prop x t))) - (if v - (push - (funcall - (if (not (get-text-property 0 'org-computed v)) - calc - 'identity) - (org-columns-string-to-number - v stype)) - lsum))) - (setq lsum (remove nil lsum)) - (setq lsum - (cond ((> (length lsum) 1) - (org-columns-number-to-string - (apply sumfunc lsum) stype)) - ((eq (length lsum) 1) - (org-columns-number-to-string - (car lsum) stype)) - (t ""))) - (put-text-property 0 (length lsum) 'face 'bold lsum) - (unless (eq calc 'identity) - (put-text-property 0 (length lsum) 'org-computed t lsum)) - (cons prop lsum)))) - fmt)) - (org-columns-display-here props) - (org-set-local 'org-agenda-columns-active t))) - (if (bobp) (throw 'exit t)) - (beginning-of-line 0)))))) - -(defun org-agenda-colview-compute (fmt) - "Compute the relevant columns in the contributing source buffers." - (let ((files org-agenda-contributing-files) - (org-columns-begin-marker (make-marker)) - (org-columns-top-level-marker (make-marker)) - f fm a b) - (while (setq f (pop files)) - (setq b (find-buffer-visiting f)) - (with-current-buffer (or (buffer-base-buffer b) b) - (save-excursion - (save-restriction - (widen) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(org-summaries t))) - (goto-char (point-min)) - (org-columns-get-format-and-top-level) - (while (setq fm (pop fmt)) - (if (equal (car fm) "CLOCKSUM") - (org-clock-sum) - (when (and (nth 4 fm) - (setq a (assoc-string - (car fm) - org-columns-current-fmt-compiled - t)) - (equal (nth 4 a) (nth 4 fm))) - (org-columns-compute (car fm))))))))))) - -(defun org-format-time-period (interval) - "Convert time in fractional days to days/hours/minutes/seconds." - (if (numberp interval) - (let* ((days (floor interval)) - (frac-hours (* 24 (- interval days))) - (hours (floor frac-hours)) - (minutes (floor (* 60 (- frac-hours hours)))) - (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes))))) - (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) - "")) - -(defun org-estimate-mean-and-var (v) - "Return the mean and variance of an estimate." - (let* ((low (float (car v))) - (high (float (cadr v))) - (mean (/ (+ low high) 2.0)) - (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0))) - (list mean var))) - -(defun org-estimate-combine (&rest el) - "Combine a list of estimates, using mean and variance. -The mean and variance of the result will be the sum of the means -and variances (respectively) of the individual estimates." - (let ((mean 0) - (var 0)) - (mapc (lambda (e) - (let ((stats (org-estimate-mean-and-var e))) - (setq mean (+ mean (car stats))) - (setq var (+ var (cadr stats))))) - el) - (let ((stdev (sqrt var))) - (list (- mean stdev) (+ mean stdev))))) - -(defun org-estimate-print (e &optional fmt) - "Prepare a string representation of an estimate. -This formats these numbers as two numbers with a \"-\" between them." - (if (null fmt) (set 'fmt "%.0f")) - (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-"))) - -(defun org-string-to-estimate (s) - "Convert a string to an estimate. -The string should be two numbers joined with a \"-\"." - (if (string-match "\\(.*\\)-\\(.*\\)" s) - (list (string-to-number (match-string 1 s)) - (string-to-number(match-string 2 s))) - (list (string-to-number s) (string-to-number s)))) - -(provide 'org-colview) -(provide 'org-colview-xemacs) - -;;; org-colview-xemacs.el ends here diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el index edc09fe..2cadd1d 100644 --- a/contrib/lisp/org-contacts.el +++ b/contrib/lisp/org-contacts.el @@ -52,9 +52,7 @@ ;; ;;; Code: -(eval-when-compile - (require 'cl)) - +(require 'cl-lib) (require 'org) (require 'gnus-util) (require 'gnus-art) @@ -161,12 +159,14 @@ The following replacements are available: :group 'org-contacts) (defcustom org-contacts-matcher - (mapconcat 'identity (list org-contacts-email-property - org-contacts-alias-property - org-contacts-tel-property - org-contacts-address-property - org-contacts-birthday-property) - "<>\"\"|") + (mapconcat #'identity + (mapcar (lambda (x) (concat x "<>\"\"")) + (list org-contacts-email-property + org-contacts-alias-property + org-contacts-tel-property + org-contacts-address-property + org-contacts-birthday-property)) + "|") "Matching rule for finding heading that are contacts. This can be a tag name, or a property check." :type 'string @@ -232,7 +232,7 @@ A regexp matching strings of whitespace, `,' and `;'.") (defun org-contacts-db-need-update-p () "Determine whether `org-contacts-db' needs to be refreshed." (or (null org-contacts-last-update) - (org-find-if (lambda (file) + (cl-find-if (lambda (file) (or (time-less-p org-contacts-last-update (elt (file-attributes file) 5)))) (org-contacts-files)) @@ -252,9 +252,8 @@ to dead or no buffer." (defun org-contacts-db () "Return the latest Org Contacts Database." - (let* (todo-only - (contacts-matcher - (cdr (org-make-tags-matcher org-contacts-matcher))) + (let* ((org--matcher-tags-todo-only nil) + (contacts-matcher (cdr (org-make-tags-matcher org-contacts-matcher))) result) (when (org-contacts-db-need-update-p) (let ((progress-reporter @@ -288,10 +287,9 @@ to dead or no buffer." (error "File %s is not in `org-mode'" file)) (setf result (append result - (org-scan-tags - 'org-contacts-at-point - contacts-matcher - todo-only))))) + (org-scan-tags 'org-contacts-at-point + contacts-matcher + org--matcher-tags-todo-only))))) (progress-reporter-update progress-reporter (setq i (1+ i)))) (setf org-contacts-db result org-contacts-last-update (current-time)) @@ -316,22 +314,22 @@ cell corresponding to the contact properties. (null prop-match) (null tags-match)) (org-contacts-db) - (loop for contact in (org-contacts-db) - if (or - (and name-match - (org-string-match-p name-match - (first contact))) - (and prop-match - (org-find-if (lambda (prop) - (and (string= (car prop-match) (car prop)) - (org-string-match-p (cdr prop-match) (cdr prop)))) - (caddr contact))) - (and tags-match - (org-find-if (lambda (tag) - (org-string-match-p tags-match tag)) - (org-split-string - (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))) - collect contact))) + (cl-loop for contact in (org-contacts-db) + if (or + (and name-match + (string-match-p name-match + (first contact))) + (and prop-match + (cl-find-if (lambda (prop) + (and (string= (car prop-match) (car prop)) + (string-match-p (cdr prop-match) (cdr prop)))) + (caddr contact))) + (and tags-match + (cl-find-if (lambda (tag) + (string-match-p tags-match tag)) + (org-split-string + (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))) + collect contact))) (when (not (fboundp 'completion-table-case-fold)) ;; That function is new in Emacs 24... @@ -344,34 +342,34 @@ cell corresponding to the contact properties. "Custom implementation of `try-completion'. This version works only with list and alist and it looks at all prefixes rather than just the beginning of the string." - (loop with regexp = (concat "\\b" (regexp-quote to-match)) - with ret = nil - with ret-start = nil - with ret-end = nil - - for el in collection - for string = (if (listp el) (car el) el) - - for start = (when (or (null predicate) (funcall predicate string)) - (string-match regexp string)) - - if start - do (let ((end (match-end 0)) - (len (length string))) - (if (= end len) - (return t) - (destructuring-bind (string start end) - (if (null ret) - (values string start end) - (org-contacts-common-substring - ret ret-start ret-end - string start end)) - (setf ret string - ret-start start - ret-end end)))) - - finally (return - (replace-regexp-in-string "\\`[ \t\n]*" "" ret)))) + (cl-loop with regexp = (concat "\\b" (regexp-quote to-match)) + with ret = nil + with ret-start = nil + with ret-end = nil + + for el in collection + for string = (if (listp el) (car el) el) + + for start = (when (or (null predicate) (funcall predicate string)) + (string-match regexp string)) + + if start + do (let ((end (match-end 0)) + (len (length string))) + (if (= end len) + (cl-return t) + (cl-destructuring-bind (string start end) + (if (null ret) + (values string start end) + (org-contacts-common-substring + ret ret-start ret-end + string start end)) + (setf ret string + ret-start start + ret-end end)))) + + finally (cl-return + (replace-regexp-in-string "\\`[ \t\n]*" "" ret)))) (defun org-contacts-compare-strings (s1 start1 end1 s2 start2 end2 &optional ignore-case) "Compare the contents of two strings, using `compare-strings'. @@ -430,22 +428,22 @@ This function returns a list whose contains: "Custom version of `all-completions'. This version works only with list and alist and it looks at all prefixes rather than just the beginning of the string." - (loop with regexp = (concat "\\b" (regexp-quote to-match)) - for el in collection - for string = (if (listp el) (car el) el) - for match? = (when (and (or (null predicate) (funcall predicate string))) - (string-match regexp string)) - if match? - collect (progn - (let ((end (match-end 0))) - (org-no-properties string) - (when (< end (length string)) - ;; Here we add a text property that will be used - ;; later to highlight the character right after - ;; the common part between each addresses. - ;; See `org-contacts-display-sort-function'. - (put-text-property end (1+ end) 'org-contacts-prefix 't string))) - string))) + (cl-loop with regexp = (concat "\\b" (regexp-quote to-match)) + for el in collection + for string = (if (listp el) (car el) el) + for match? = (when (and (or (null predicate) (funcall predicate string))) + (string-match regexp string)) + if match? + collect (progn + (let ((end (match-end 0))) + (org-no-properties string) + (when (< end (length string)) + ;; Here we add a text property that will be used + ;; later to highlight the character right after + ;; the common part between each addresses. + ;; See `org-contacts-display-sort-function'. + (put-text-property end (1+ end) 'org-contacts-prefix 't string))) + string))) (defun org-contacts-make-collection-prefix (collection) "Make a collection function from COLLECTION which will match on prefixes." @@ -460,7 +458,7 @@ prefixes rather than just the beginning of the string." ((eq flag 'lambda) (org-contacts-test-completion-prefix string collection predicate)) ((and (listp flag) (eq (car flag) 'boundaries)) - (destructuring-bind (to-ignore &rest suffix) + (cl-destructuring-bind (to-ignore &rest suffix) flag (org-contacts-boundaries-prefix string collection predicate suffix))) ((eq flag 'metadata) @@ -471,31 +469,28 @@ prefixes rather than just the beginning of the string." (defun org-contacts-display-sort-function (completions) "Sort function for contacts display." (mapcar (lambda (string) - (loop with len = (1- (length string)) - for i upfrom 0 to len - if (memq 'org-contacts-prefix - (text-properties-at i string)) - do (set-text-properties - i (1+ i) - (list 'font-lock-face - (if (char-equal (aref string i) - (string-to-char " ")) - ;; Spaces can't be bold. - 'underline - 'bold)) string) - else - do (set-text-properties i (1+ i) nil string) - finally (return string))) + (cl-loop with len = (1- (length string)) + for i upfrom 0 to len + if (memq 'org-contacts-prefix + (text-properties-at i string)) + do (set-text-properties + i (1+ i) + (list 'font-lock-face + (if (char-equal (aref string i) + (string-to-char " ")) + ;; Spaces can't be bold. + 'underline + 'bold)) string) + else + do (set-text-properties i (1+ i) nil string) + finally (cl-return string))) completions)) (defun org-contacts-test-completion-prefix (string collection predicate) - ;; Prevents `org-find-if' from redefining `predicate' and going into - ;; an infinite loop. - (lexical-let ((predicate predicate)) - (org-find-if (lambda (el) - (and (or (null predicate) (funcall predicate el)) - (string= string el))) - collection))) + (cl-find-if (lambda (el) + (and (or (null predicate) (funcall predicate el)) + (string= string el))) + collection)) (defun org-contacts-boundaries-prefix (string collection predicate suffix) (list* 'boundaries (completion-boundaries string collection predicate suffix))) @@ -510,7 +505,7 @@ prefixes rather than just the beginning of the string." A group FOO is composed of contacts with the tag FOO." (let* ((completion-ignore-case org-contacts-completion-ignore-case) - (group-completion-p (org-string-match-p + (group-completion-p (string-match-p (concat "^" org-contacts-group-prefix) string))) (when group-completion-p (let ((completion-list @@ -520,9 +515,9 @@ A group FOO is composed of contacts with the tag FOO." (propertize (concat org-contacts-group-prefix group) 'org-contacts-group group)) (org-uniquify - (loop for contact in (org-contacts-filter) - nconc (org-split-string - (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))))) + (cl-loop for contact in (org-contacts-filter) + nconc (org-split-string + (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))))) (list start end (if (= (length completion-list) 1) ;; We've found the correct group, returns the address @@ -530,21 +525,21 @@ A group FOO is composed of contacts with the tag FOO." (car completion-list)))) (lambda (string pred &optional to-ignore) (mapconcat 'identity - (loop for contact in (org-contacts-filter - nil - tag) - ;; The contact name is always the car of the assoc-list - ;; returned by `org-contacts-filter'. - for contact-name = (car contact) - ;; Grab the first email of the contact - for email = (org-contacts-strip-link - (or (car (org-contacts-split-property - (or - (cdr (assoc-string org-contacts-email-property - (caddr contact))) - ""))) "")) - ;; If the user has an email address, append USER <EMAIL>. - if email collect (org-contacts-format-email contact-name email)) + (cl-loop for contact in (org-contacts-filter + nil + tag) + ;; The contact name is always the car of the assoc-list + ;; returned by `org-contacts-filter'. + for contact-name = (car contact) + ;; Grab the first email of the contact + for email = (org-contacts-strip-link + (or (car (org-contacts-split-property + (or + (cdr (assoc-string org-contacts-email-property + (cl-caddr contact))) + ""))) "")) + ;; If the user has an email address, append USER <EMAIL>. + if email collect (org-contacts-format-email contact-name email)) ", "))) ;; We haven't found the correct group (completion-table-case-fold completion-list @@ -559,30 +554,30 @@ with BAR. See (org) Matching tags and properties for a complete description." (let* ((completion-ignore-case org-contacts-completion-ignore-case) - (completion-p (org-string-match-p + (completion-p (string-match-p (concat "^" org-contacts-tags-props-prefix) string))) (when completion-p (let ((result (mapconcat 'identity - (loop for contact in (org-contacts-db) - for contact-name = (car contact) - for email = (org-contacts-strip-link (or (car (org-contacts-split-property - (or - (cdr (assoc-string org-contacts-email-property - (caddr contact))) - ""))) "")) - for tags = (cdr (assoc "TAGS" (nth 2 contact))) - for tags-list = (if tags - (split-string (substring (cdr (assoc "TAGS" (nth 2 contact))) 1 -1) ":") - '()) - for marker = (second contact) - if (with-current-buffer (marker-buffer marker) - (save-excursion - (goto-char marker) - (let (todo-only) - (eval (cdr (org-make-tags-matcher (subseq string 1))))))) - collect (org-contacts-format-email contact-name email)) + (cl-loop for contact in (org-contacts-db) + for contact-name = (car contact) + for email = (org-contacts-strip-link (or (car (org-contacts-split-property + (or + (cdr (assoc-string org-contacts-email-property + (cl-caddr contact))) + ""))) "")) + for tags = (cdr (assoc "TAGS" (nth 2 contact))) + for tags-list = (if tags + (split-string (substring (cdr (assoc "TAGS" (nth 2 contact))) 1 -1) ":") + '()) + for marker = (nth 1 contact) + if (with-current-buffer (marker-buffer marker) + (save-excursion + (goto-char marker) + (let (todo-only) + (eval (cdr (org-make-tags-matcher (cl-subseq string 1))))))) + collect (org-contacts-format-email contact-name email)) ","))) (when (not (string= "" result)) ;; return (start end function) @@ -593,37 +588,37 @@ description." (defun org-contacts-remove-ignored-property-values (ignore-list list) "Remove all ignore-list's elements from list and you can use regular expressions in the ignore list." - (org-remove-if (lambda (el) - (org-find-if (lambda (x) - (string-match-p x el)) - ignore-list)) - list)) + (cl-remove-if (lambda (el) + (cl-find-if (lambda (x) + (string-match-p x el)) + ignore-list)) + list)) (defun org-contacts-complete-name (start end string) "Complete text at START with a user name and email." (let* ((completion-ignore-case org-contacts-completion-ignore-case) (completion-list - (loop for contact in (org-contacts-filter) - ;; The contact name is always the car of the assoc-list - ;; returned by `org-contacts-filter'. - for contact-name = (car contact) - - ;; Build the list of the email addresses which has - ;; been expired - for ignore-list = (org-contacts-split-property - (or (cdr (assoc-string org-contacts-ignore-property - (caddr contact))) "")) - ;; Build the list of the user email addresses. - for email-list = (org-contacts-remove-ignored-property-values - ignore-list - (org-contacts-split-property - (or (cdr (assoc-string org-contacts-email-property - (caddr contact))) ""))) - ;; If the user has email addresses… - if email-list - ;; … append a list of USER <EMAIL>. - nconc (loop for email in email-list - collect (org-contacts-format-email contact-name (org-contacts-strip-link email))))) + (cl-loop for contact in (org-contacts-filter) + ;; The contact name is always the car of the assoc-list + ;; returned by `org-contacts-filter'. + for contact-name = (car contact) + + ;; Build the list of the email addresses which has + ;; been expired + for ignore-list = (org-contacts-split-property + (or (cdr (assoc-string org-contacts-ignore-property + (nth 2 contact))) "")) + ;; Build the list of the user email addresses. + for email-list = (org-contacts-remove-ignored-property-values + ignore-list + (org-contacts-split-property + (or (cdr (assoc-string org-contacts-email-property + (nth 2 contact))) ""))) + ;; If the user has email addresses… + if email-list + ;; … append a list of USER <EMAIL>. + nconc (cl-loop for email in email-list + collect (org-contacts-format-email contact-name (org-contacts-strip-link email))))) (completion-list (org-contacts-all-completions-prefix string (org-uniquify completion-list)))) @@ -662,13 +657,13 @@ description." (let* ((address (org-contacts-gnus-get-name-email)) (name (car address)) (email (cadr address))) - (cadar (or (org-contacts-filter - nil - nil - (cons org-contacts-email-property (concat "\\b" (regexp-quote email) "\\b"))) - (when name - (org-contacts-filter - (concat "^" name "$"))))))) + (cl-cadar (or (org-contacts-filter + nil + nil + (cons org-contacts-email-property (concat "\\b" (regexp-quote email) "\\b"))) + (when name + (org-contacts-filter + (concat "^" name "$"))))))) (defun org-contacts-gnus-article-from-goto () "Go to contact in the From address of current Gnus message." @@ -677,14 +672,9 @@ description." (when marker (switch-to-buffer-other-window (marker-buffer marker)) (goto-char marker) - (when (eq major-mode 'org-mode) - (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - ;; show the next heading - (org-flag-heading nil))))))) + (when (eq major-mode 'org-mode) (org-show-context 'agenda))))) -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el +(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el (defun org-contacts-anniversaries (&optional field format) "Compute FIELD anniversary for each contact, returning FORMAT. Default FIELD value is \"BIRTHDAY\". @@ -698,23 +688,23 @@ Format is a string matching the following format specification: (let ((calendar-date-style 'american) (entry "")) (unless format (setq format org-contacts-birthday-format)) - (loop for contact in (org-contacts-filter) - for anniv = (let ((anniv (cdr (assoc-string - (or field org-contacts-birthday-property) - (caddr contact))))) - (when anniv - (calendar-gregorian-from-absolute - (org-time-string-to-absolute anniv)))) - ;; Use `diary-anniversary' to compute anniversary. - if (and anniv (apply 'diary-anniversary anniv)) - collect (format-spec format - `((?l . ,(org-with-point-at (cadr contact) (org-store-link nil))) - (?h . ,(car contact)) - (?y . ,(- (calendar-extract-year date) - (calendar-extract-year anniv))) - (?Y . ,(let ((years (- (calendar-extract-year date) - (calendar-extract-year anniv)))) - (format "%d%s" years (diary-ordinal-suffix years))))))))) + (cl-loop for contact in (org-contacts-filter) + for anniv = (let ((anniv (cdr (assoc-string + (or field org-contacts-birthday-property) + (nth 2 contact))))) + (when anniv + (calendar-gregorian-from-absolute + (org-time-string-to-absolute anniv)))) + ;; Use `diary-anniversary' to compute anniversary. + if (and anniv (apply 'diary-anniversary anniv)) + collect (format-spec format + `((?l . ,(org-with-point-at (cadr contact) (org-store-link nil))) + (?h . ,(car contact)) + (?y . ,(- (calendar-extract-year date) + (calendar-extract-year anniv))) + (?Y . ,(let ((years (- (calendar-extract-year date) + (calendar-extract-year anniv)))) + (format "%d%s" years (diary-ordinal-suffix years))))))))) (defun org-completing-read-date (prompt collection &optional predicate require-match initial-input @@ -995,7 +985,7 @@ to do our best." (defun org-contacts-vcard-format (contact) "Formats CONTACT in VCard 3.0 format." - (let* ((properties (caddr contact)) + (let* ((properties (nth 2 contact)) (name (org-contacts-vcard-escape (car contact))) (n (org-contacts-vcard-encode-name name)) (email (cdr (assoc-string org-contacts-email-property properties))) @@ -1054,15 +1044,15 @@ passed to `org-contacts-export-as-vcard-internal'." (interactive "P") (when (called-interactively-p 'any) (cl-psetf name - (when name - (read-string "Contact name: " - (first (org-contacts-at-point)))) - file - (when (equal name '(16)) - (read-file-name "File: " nil org-contacts-vcard-file)) - to-buffer - (when (equal name '(64)) - (read-buffer "Buffer: ")))) + (when name + (read-string "Contact name: " + (nth 0 (org-contacts-at-point)))) + file + (when (equal name '(16)) + (read-file-name "File: " nil org-contacts-vcard-file)) + to-buffer + (when (equal name '(64)) + (read-buffer "Buffer: ")))) (org-contacts-export-as-vcard-internal name file to-buffer)) (defun org-contacts-export-as-vcard-internal (&optional name file to-buffer) @@ -1094,9 +1084,9 @@ Requires google-maps-el." (error "`org-contacts-show-map' requires `google-maps-el'")) (google-maps-static-show :markers - (loop + (cl-loop for contact in (org-contacts-filter name) - for addr = (cdr (assoc-string org-contacts-address-property (caddr contact))) + for addr = (cdr (assoc-string org-contacts-address-property (nth 2 contact))) if addr collect (cons (list addr) (list :label (string-to-char (car contact))))))) @@ -1115,6 +1105,10 @@ link string and return the pure link target." (setq colonpos (string-match ":" link)) (if startpos (substring link (1+ colonpos)) link))))) +;; Add the link type supported by org-contacts-strip-link +;; so everything is in order for its use in Org files +(org-link-set-parameters "tel") + (defun org-contacts-split-property (string &optional separators omit-nulls) "Custom version of `split-string'. Split a property STRING into sub-strings bounded by matches diff --git a/contrib/lisp/org-download.el b/contrib/lisp/org-download.el deleted file mode 100644 index cbf335b..0000000 --- a/contrib/lisp/org-download.el +++ /dev/null @@ -1,392 +0,0 @@ -;;; org-download.el --- Image drag-and-drop for Emacs org-mode - -;; Copyright (C) 2014-2016 Free Software Foundation, Inc. - -;; Author: Oleh Krehel -;; Keywords: images, screenshots, download -;; Homepage: http://orgmode.org - -;; This file is not part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; This extension facilitates moving images from point A to point B. -;; -;; Point A (the source) can be: -;; 1. An image inside your browser that you can drag to Emacs. -;; 2. An image on your file system that you can drag to Emacs. -;; 3. A local or remote image address in kill-ring. -;; Use the `org-download-yank' command for this. -;; Remember that you can use "0 w" in `dired' to get an address. -;; 4. An screenshot taken using `gnome-screenshot' or `scrot' or `gm'. -;; Use the `org-download-screenshot' command for this. -;; Customize the backend with `org-download-screenshot-method'. -;; -;; Point B (the target) is an Emacs `org-mode' buffer where the inline -;; link will be inserted. Several customization options will determine -;; where exactly on the file system the file will be stored. -;; -;; They are: -;; `org-download-method': -;; a. 'attach => use `org-mode' attachment machinery -;; b. 'directory => construct the directory in two stages: -;; 1. first part of the folder name is: -;; * either "." (current folder) -;; * or `org-download-image-dir' (if it's not nil). -;; `org-download-image-dir' becomes buffer-local when set, -;; so each file can customize this value, e.g with: -;; # -*- mode: Org; org-download-image-dir: "~/Pictures/foo"; -*- -;; 2. second part is: -;; * `org-download-heading-lvl' is nil => "" -;; * `org-download-heading-lvl' is n => the name of current -;; heading with level n. Level count starts with 0, -;; i.e. * is 0, ** is 1, *** is 2 etc. -;; `org-download-heading-lvl' becomes buffer-local when set, -;; so each file can customize this value, e.g with: -;; # -*- mode: Org; org-download-heading-lvl: nil; -*- -;; -;; `org-download-timestamp': -;; optionally add a timestamp to the file name. -;; -;; Customize `org-download-backend' to choose between `url-retrieve' -;; (the default) or `wget' or `curl'. -;; -;;; Code: - - -(eval-when-compile - (require 'cl)) -(require 'url-parse) -(require 'url-http) - -(defgroup org-download nil - "Image drag-and-drop for org-mode." - :group 'org - :prefix "org-download-") - -(defcustom org-download-method 'directory - "The way images should be stored." - :type '(choice - (const :tag "Directory" directory) - (const :tag "Attachment" attach)) - :group 'org-download) - -(defcustom org-download-image-dir nil - "If set, images will be stored in this directory instead of \".\". -See `org-download--dir-1' for more info." - :type '(choice - (const :tag "Default" nil) - (string :tag "Directory")) - :group 'org-download) -(make-variable-buffer-local 'org-download-image-dir) - -(defcustom org-download-heading-lvl 0 - "Heading level to be used in `org-download--dir-2'." - :group 'org-download) -(make-variable-buffer-local 'org-download-heading-lvl) - -(defcustom org-download-backend t - "Method to use for downloading." - :type '(choice - (const :tag "wget" "wget \"%s\" -O \"%s\"") - (const :tag "curl" "curl \"%s\" -o \"%s\"") - (const :tag "url-retrieve" t)) - :group 'org-download) - -(defcustom org-download-timestamp "_%Y-%m-%d_%H:%M:%S" - "This `format-time-string'-style string will be appended to the file name. -Set this to \"\" if you don't want time stamps." - :type 'string - :group 'org-download) - -(defcustom org-download-img-regex-list - '("<img +src=\"" "<img +\\(class=\"[^\"]+\"\\)? *src=\"") - "This regex is used to unalias links that look like images. -The html to which the links points will be searched for these -regexes, one by one, until one succeeds. The found image address -will be used." - :group 'org-download) - -(defcustom org-download-screenshot-method "gnome-screenshot -a -f %s" - "The tool to capture screenshots." - :type '(choice - (const :tag "gnome-screenshot" "gnome-screenshot -a -f %s") - (const :tag "scrot" "scrot -s %s") - (const :tag "gm" "gm import %s")) - :group 'org-download) - -(defcustom org-download-image-width 0 - "When non-zero add #+attr_html: :width tag to the image." - :type 'integer - :group 'org-download) - -(defun org-download-get-heading (lvl) - "Return the heading of the current entry's LVL level parent." - (save-excursion - (let ((cur-lvl (org-current-level))) - (if cur-lvl - (progn - (unless (= cur-lvl 1) - (org-up-heading-all (- (1- (org-current-level)) lvl))) - (substring-no-properties - (org-get-heading))) - "")))) - -(defun org-download--dir-1 () - "Return the first part of the directory path for `org-download--dir'. -It's `org-download-image-dir', unless it's nil. Then it's \".\"." - (or org-download-image-dir ".")) - -(defun org-download--dir-2 () - "Return the second part of the directory path for `org-download--dir'. -Unless `org-download-heading-lvl' is nil, it's the name of the current -`org-download-heading-lvl'-leveled heading. Otherwise it's \"\"." - (and org-download-heading-lvl - (org-download-get-heading - org-download-heading-lvl))) - -(defun org-download--dir () - "Return the directory path for image storage. - -The path is composed from `org-download--dir-1' and `org-download--dir-2'. -The directory is created if it didn't exist before." - (let* ((part1 (org-download--dir-1)) - (part2 (org-download--dir-2)) - (dir (if part2 - (format "%s/%s" part1 part2) - part1))) - (unless (file-exists-p dir) - (make-directory dir t)) - dir)) - -(defun org-download--fullname (link) - "Return the file name where LINK will be saved to. - -It's affected by `org-download-timestamp' and `org-download--dir'." - (let ((filename - (file-name-nondirectory - (car (url-path-and-query - (url-generic-parse-url link))))) - (dir (org-download--dir))) - (when (string-match ".*?\\.\\(?:png\\|jpg\\)\\(.*\\)$" filename) - (setq filename (replace-match "" nil nil filename 1))) - (abbreviate-file-name - (expand-file-name - (format "%s%s.%s" - (file-name-sans-extension filename) - (format-time-string org-download-timestamp) - (file-name-extension filename)) - dir)))) - -(defun org-download--image (link filename) - "Save LINK to FILENAME asynchronously and show inline images in current buffer." - (when (string-match "^file://\\(.*\\)" link) - (setq link (url-unhex-string (match-string 1 link)))) - (cond ((and (not (file-remote-p link)) - (file-exists-p link)) - (org-download--image/command "cp \"%s\" \"%s\"" link filename)) - ((eq org-download-backend t) - (org-download--image/url-retrieve link filename)) - (t - (org-download--image/command org-download-backend link filename)))) - -(defun org-download--image/command (command link filename) - "Using COMMAND, save LINK to FILENAME. -COMMAND is a format-style string with two slots for LINK and FILENAME." - (require 'async) - (async-start - `(lambda() (shell-command - ,(format command link - (expand-file-name filename)))) - (lexical-let ((cur-buf (current-buffer))) - (lambda(x) - (with-current-buffer cur-buf - (org-display-inline-images)))))) - -(defun org-download--image/url-retrieve (link filename) - "Save LINK to FILENAME using `url-retrieve'." - (url-retrieve - link - (lambda (status filename buffer) - ;; Write current buffer to FILENAME - ;; and update inline images in BUFFER - (let ((err (plist-get status :error))) - (if err (error - "\"%s\" %s" link - (downcase (nth 2 (assq (nth 2 err) url-http-codes)))))) - (delete-region - (point-min) - (progn - (re-search-forward "\n\n" nil 'move) - (point))) - (let ((coding-system-for-write 'no-conversion)) - (write-region nil nil filename nil nil nil 'confirm)) - (with-current-buffer buffer - (org-display-inline-images))) - (list - (expand-file-name filename) - (current-buffer)) - nil t)) - -(defun org-download-yank () - "Call `org-download-image' with current kill." - (interactive) - (org-download-image (current-kill 0))) - -(defun org-download-screenshot () - "Capture screenshot and insert the resulting file. -The screenshot tool is determined by `org-download-screenshot-method'." - (interactive) - (let ((link "/tmp/screenshot.png")) - (shell-command (format org-download-screenshot-method link)) - (org-download-image link))) - -(defun org-download-image (link) - "Save image at address LINK to `org-download--dir'." - (interactive "sUrl: ") - (unless (image-type-from-file-name link) - (with-current-buffer - (url-retrieve-synchronously link t) - (let ((regexes org-download-img-regex-list) - lnk) - (while (and (not lnk) regexes) - (goto-char (point-min)) - (when (re-search-forward (pop regexes) nil t) - (backward-char) - (setq lnk (read (current-buffer))))) - (if lnk - (setq link lnk) - (error "link %s does not point to an image; unaliasing failed" link))))) - (let ((filename - (if (eq org-download-method 'attach) - (let ((org-download-image-dir (progn (require 'org-attach) - (org-attach-dir t))) - org-download-heading-lvl) - (org-download--fullname link)) - (org-download--fullname link)))) - (when (image-type-from-file-name filename) - (org-download--image link filename) - (when (eq org-download-method 'attach) - (org-attach-attach filename nil 'none)) - (if (looking-back "^[ \t]+") - (delete-region (match-beginning 0) (match-end 0)) - (newline)) - (insert - (format "#+DOWNLOADED: %s @ %s\n%s [[%s]]" - link - (format-time-string "%Y-%m-%d %H:%M:%S") - (if (= org-download-image-width 0) - "" - (format - "#+attr_html: :width %dpx\n" org-download-image-width)) - filename)) - (org-display-inline-images)))) - -(defun org-download--at-comment-p () - "Check if current line begins with #+DOWLOADED:." - (save-excursion - (move-beginning-of-line nil) - (looking-at "#\\+DOWNLOADED:"))) - -(defun org-download-delete () - "Delete inline image link on current line, and the file that it points to." - (interactive) - (cond ((org-download--at-comment-p) - (delete-region (line-beginning-position) - (line-end-position)) - (org-download--delete (line-beginning-position) - nil - 1)) - ((region-active-p) - (org-download--delete (region-beginning) - (region-end)) - (delete-region (region-beginning) - (region-end))) - - (t (org-download--delete (line-beginning-position) - (line-end-position))))) - -(defun org-download--delete (beg end &optional times) - "Delete inline image links and the files they point to between BEG and END. - -When TIMES isn't nil, delete only TIMES links." - (unless times - (setq times most-positive-fixnum)) - (save-excursion - (goto-char beg) - (while (and (>= (decf times) 0) - (re-search-forward "\\[\\[\\([^]]*\\)\\]\\]" end t)) - (let ((str (match-string-no-properties 1))) - (delete-region beg - (match-end 0)) - (when (file-exists-p str) - (delete-file str)))))) - -(defun org-download-dnd (uri action) - "When in `org-mode' and URI points to image, download it. -Otherwise, pass URI and ACTION back to dnd dispatch." - (cond ((eq major-mode 'org-mode) - ;; probably shouldn't redirect - (unless (org-download-image uri) - (message "not an image URL"))) - ((eq major-mode 'dired-mode) - (org-download-dired uri)) - ;; redirect to someone else - (t - (let ((dnd-protocol-alist - (rassq-delete-all - 'org-download-dnd - (copy-alist dnd-protocol-alist)))) - (dnd-handle-one-url nil action uri))))) - -(defun org-download-dired (uri) - "Download URI to current directory." - (raise-frame) - (let ((filename (file-name-nondirectory - (car (url-path-and-query - (url-generic-parse-url uri)))))) - (message "Downloading %s to %s ..." - filename - (expand-file-name filename)) - (url-retrieve - uri - (lambda (status filename) - (let ((err (plist-get status :error))) - (if err (error - "\"%s\" %s" uri - (downcase (nth 2 (assq (nth 2 err) url-http-codes)))))) - (let ((coding-system-for-write 'no-conversion)) - (write-region nil nil filename nil nil nil 'confirm))) - (list - (expand-file-name filename)) - t t))) - -(defun org-download-enable () - "Enable org-download." - (unless (eq (cdr (assoc "^\\(https?\\|ftp\\|file\\|nfs\\)://" dnd-protocol-alist)) - 'org-download-dnd) - (setq dnd-protocol-alist - `(("^\\(https?\\|ftp\\|file\\|nfs\\)://" . org-download-dnd) ,@dnd-protocol-alist)))) - -(defun org-download-disable () - "Disable org-download." - (rassq-delete-all 'org-download-dnd dnd-protocol-alist)) - -(org-download-enable) - -(provide 'org-download) - -;;; org-download.el ends here diff --git a/contrib/lisp/org-ebib.el b/contrib/lisp/org-ebib.el index 2136a13..4ed5e50 100644 --- a/contrib/lisp/org-ebib.el +++ b/contrib/lisp/org-ebib.el @@ -22,9 +22,9 @@ (require 'org) -(org-add-link-type "ebib" 'org-ebib-open) - -(add-hook 'org-store-link-functions 'org-ebib-store-link) +(org-link-set-parameters "ebib" + :follow #'org-ebib-open + :store #'org-ebib-store-link) (defun org-ebib-open (key) "Open Ebib and jump to KEY." diff --git a/contrib/lisp/org-effectiveness.el b/contrib/lisp/org-effectiveness.el index b1e5a35..8d179fc 100644 --- a/contrib/lisp/org-effectiveness.el +++ b/contrib/lisp/org-effectiveness.el @@ -34,7 +34,7 @@ (require 'org) (defcustom org-effectiveness-max-todo 50 - "This variable is useful to advice to the user about + "This variable is useful to advice to the user about many TODO pending" :type 'integer :group 'org-effectiveness) @@ -42,9 +42,10 @@ many TODO pending" (defun org-effectiveness-advice() "Advicing about a possible excess of TODOS" (interactive) - (goto-char (point-min)) - (if (< org-effectiveness-max-todo (count-matches "* TODO")) - (message "An excess of TODOS!"))) + (save-excursion + (goto-char (point-min)) + (if (< org-effectiveness-max-todo (count-matches "* TODO")) + (message "An excess of TODOS!")))) ;; Check advice starting an org file (add-hook 'org-mode-hook 'org-effectiveness-advice) @@ -59,10 +60,10 @@ many TODO pending" (defun org-effectiveness-count-todo() "Print a message with the number of todo tasks in the current buffer" (interactive) - (save-excursion + (save-excursion (goto-char (point-min)) (message "Number of TODO: %d" (count-matches "* TODO")))) - + (defun org-effectiveness-count-done() "Print a message with the number of done tasks in the current buffer" (interactive) @@ -77,6 +78,13 @@ many TODO pending" (goto-char (point-min)) (message "Number of Canceled: %d" (count-matches "* CANCEL+ED")))) +(defun org-effectiveness-count-task() + "Print a message with the number of tasks and subtasks in the current buffer" + (interactive) + (save-excursion + (goto-char (point-min)) + (message "Number of tasks: %d" (count-matches "^*")))) + (defun org-effectiveness() "Returns the effectiveness in the current org buffer" (interactive) @@ -89,25 +97,41 @@ many TODO pending" (setq effectiveness (* 100 (/ done (+ done canc))))) (message "Effectiveness: %f" effectiveness)))) + (defun org-effectiveness-keywords-in-date(keyword date) (interactive "sKeyword: \nsDate: " keyword date) (setq count (count-matches (concat keyword ".*\n.*" date))) (message (concat "%sS: %d" keyword count))) -(defun org-effectiveness-dones-in-date(date) - (interactive "sGive me a date: " date) - (setq count (count-matches (concat "DONE.*\n.*" date))) - (message "DONES: %d" count)) +(defun org-effectiveness-dones-in-date(date &optional notmessage) + (interactive "sGive me a date: " date) + (save-excursion + (goto-char (point-min)) + (let ((count (count-matches (concat "DONE.*\n.*" date)))) + (if (eq notmessage 1) + (message "%d" count) + (message "DONES: %d " count))))) -(defun org-effectivenes-todos-in-date(date) - (interactive "sGive me a date: " date) - (setq count (count-matches (concat "TODO.*\n.*" date))) - (message "TODOS: %d" count)) +(defun org-effectiveness-todos-in-date(date) + (interactive "sGive me a date: " date) + (save-excursion + (goto-char (point-min)) + (setq count (count-matches (concat "TODO.*\n.*" date))) + (message "TODOS: %d" count))) (defun org-effectiveness-canceled-in-date(date) - (interactive "sGive me a date: " date) - (setq count (count-matches (concat "CANCEL+ED.*\n.*" date))) - (message "CANCELEDS: %d" count)) + (interactive "sGive me a date: " date) + (save-excursion + (goto-char (point-min)) + (setq count (count-matches (concat "CANCEL+ED.*\n.*" date))) + (message "CANCELEDS: %d" count))) + +(defun org-effectiveness-ntasks-in-date(date &optional notmessage) + (interactive "sGive me a date: " date) + (save-excursion + (goto-char (point-min)) + (let ((tasks (float (count-matches (concat "^*.*\n.*" date))))) + (message "%d" tasks)))) (defun org-effectiveness-in-date(date &optional notmessage) (interactive "sGive me a date: " date) @@ -130,14 +154,14 @@ many TODO pending" (defun org-effectiveness-plot(startdate enddate &optional save) (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate) (setq dates (org-effectiveness-check-dates startdate enddate)) - (setq syear (cadr (assoc 'startyear dates))) - (setq smonth (cadr (assoc 'startmonth dates))) - (setq eyear (cadr (assoc 'endyear dates))) - (setq emonth (assoc 'endmonth dates)) + (setq syear (cadr (assq 'startyear dates))) + (setq smonth (cadr (assq 'startmonth dates))) + (setq eyear (cadr (assq 'endyear dates))) + (setq emonth (assq 'endmonth dates)) ;; Checking the format of the dates - (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate)) + (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate)) (message "The start date must have the next format YYYY-MM")) - (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate)) + (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate)) (message "The end date must have the next format YYYY-MM")) ;; Checking if startdate < enddate (if (string-match "^[0-9][0-9][0-9][0-9]" startdate) @@ -152,19 +176,19 @@ many TODO pending" (message "The start date must be before that end date")) (if (and (= startyear endyear) (> startmonth endmonth)) (message "The start date must be before that end date")) -;; Create a file +;; Create a file (let ((month startmonth) (year startyear) (str "")) - (while (or (> endyear year) (and (= endyear year) (>= endmonth month))) + (while (or (> endyear year) (and (= endyear year) (>= endmonth month))) (setq str (concat str (number-to-string year) "-" (org-effectiveness-month-to-string month) " " (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1) "\n")) (if (= month 12) - (progn + (progn (setq year (+ 1 year)) (setq month 1)) (setq month (+ 1 month)))) (write-region str nil "/tmp/org-effectiveness")) -;; Create the bar graph +;; Create the bar graph (if (eq save t) (setq strplot "/usr/bin/gnuplot -e 'set term png; set output \"/tmp/org-effectiveness.png\"; plot \"/tmp/org-effectiveness\" using 2:xticlabels(1) with histograms' -p") (setq strplot "/usr/bin/gnuplot -e 'plot \"/tmp/org-effectiveness\" using 2:xticlabels(1) with histograms' -p")) @@ -221,9 +245,9 @@ many TODO pending" (defun org-effectiveness-check-dates (startdate enddate) "Generate a list with ((startyear startmonth) (endyear endmonth))" (setq str nil) - (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate)) + (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate)) (setq str "The start date must have the next format YYYY-MM")) - (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate)) + (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate)) (setq str "The end date must have the next format YYYY-MM")) ;; Checking if startdate < enddate (if (string-match "^[0-9][0-9][0-9][0-9]" startdate) @@ -246,12 +270,12 @@ many TODO pending" (defun org-effectiveness-plot-ascii (startdate enddate) (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate) (setq dates (org-effectiveness-check-dates startdate enddate)) - (let ((syear (cadr (assoc 'startyear dates))) - (smonth (cadr (assoc 'startmonth dates))) - (year (cadr (assoc 'startyear dates))) - (month (cadr (assoc 'startmonth dates))) - (emonth (cadr (assoc 'endmonth dates))) - (eyear (cadr (assoc 'endyear dates))) + (let ((syear (cadr (assq 'startyear dates))) + (smonth (cadr (assq 'startmonth dates))) + (year (cadr (assq 'startyear dates))) + (month (cadr (assq 'startmonth dates))) + (emonth (cadr (assq 'endmonth dates))) + (eyear (cadr (assq 'endyear dates))) (buffer (current-buffer)) (str "")) (while (or (> eyear year) (and (= eyear year) (>= emonth month))) @@ -260,22 +284,70 @@ many TODO pending" (org-effectiveness-ascii-bar (string-to-number str) (format "%s-%s" year month)) (switch-to-buffer buffer) (if (eq month 12) - (progn + (progn + (setq year (+ 1 year)) + (setq month 1)) + (setq month (+ 1 month))))) + (switch-to-buffer "*org-effectiveness*")) + + +(defun org-effectiveness-plot-ascii-ntasks (startdate enddate) + (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate) + (setq dates (org-effectiveness-check-dates startdate enddate)) + (let ((syear (cadr (assq 'startyear dates))) + (smonth (cadr (assq 'startmonth dates))) + (year (cadr (assq 'startyear dates))) + (month (cadr (assq 'startmonth dates))) + (emonth (cadr (assq 'endmonth dates))) + (eyear (cadr (assq 'endyear dates))) + (buffer (current-buffer)) + (str "")) + (while (or (> eyear year) (and (= eyear year) (>= emonth month))) + (setq str (org-effectiveness-ntasks-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1)) + (switch-to-buffer "*org-effectiveness*") + (org-effectiveness-ascii-bar (string-to-number str) (format "%s-%s" year month)) + (switch-to-buffer buffer) + (if (eq month 12) + (progn (setq year (+ 1 year)) (setq month 1)) (setq month (+ 1 month))))) (switch-to-buffer "*org-effectiveness*")) +(defun org-effectiveness-plot-ascii-dones (startdate enddate) + (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate) + (setq dates (org-effectiveness-check-dates startdate enddate)) + (let ((syear (cadr (assq 'startyear dates))) + (smonth (cadr (assq 'startmonth dates))) + (year (cadr (assq 'startyear dates))) + (month (cadr (assq 'startmonth dates))) + (emonth (cadr (assq 'endmonth dates))) + (eyear (cadr (assq 'endyear dates))) + (buffer (current-buffer)) + (str "")) + (while (or (> eyear year) (and (= eyear year) (>= emonth month))) + (setq str (org-effectiveness-dones-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1)) + (switch-to-buffer "*org-effectiveness*") + (org-effectiveness-ascii-bar (string-to-number str) (format "%s-%s" year month)) + (switch-to-buffer buffer) + (if (eq month 12) + (progn + (setq year (+ 1 year)) + (setq month 1)) + (setq month (+ 1 month))))) + (switch-to-buffer "*org-effectiveness*")) + + (defun org-effectiveness-plot-html (startdate enddate) "Print html bars about the effectiveness in a buffer" (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate) (setq dates (org-effectiveness-check-dates startdate enddate)) - (let ((syear (cadr (assoc 'startyear dates))) - (smonth (cadr (assoc 'startmonth dates))) - (year (cadr (assoc 'startyear dates))) - (month (cadr (assoc 'startmonth dates))) - (emonth (cadr (assoc 'endmonth dates))) - (eyear (cadr (assoc 'endyear dates))) + (let ((syear (cadr (assq 'startyear dates))) + (smonth (cadr (assq 'startmonth dates))) + (year (cadr (assq 'startyear dates))) + (month (cadr (assq 'startmonth dates))) + (emonth (cadr (assq 'endmonth dates))) + (eyear (cadr (assq 'endyear dates))) (buffer (current-buffer)) (str "")) (switch-to-buffer "*org-effectiveness-html*") @@ -287,7 +359,7 @@ many TODO pending" (switch-to-buffer buffer) (format "%s-%s" year month) (if (eq month 12) - (progn + (progn (setq year (+ 1 year)) (setq month 1)) (setq month (+ 1 month)))) @@ -295,4 +367,3 @@ many TODO pending" (insert "</body></html>"))) (provide 'org-effectiveness) - diff --git a/contrib/lisp/org-eldoc.el b/contrib/lisp/org-eldoc.el index 5583cb8..046918d 100644 --- a/contrib/lisp/org-eldoc.el +++ b/contrib/lisp/org-eldoc.el @@ -38,6 +38,10 @@ (require 'ob-core) (require 'eldoc) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) + (defgroup org-eldoc nil "" :group 'org) (defcustom org-eldoc-breadcrumb-separator "/" @@ -70,7 +74,7 @@ (save-match-data (when (looking-at "^[ \t]*#\\+\\(begin\\|end\\)_src") (setq info (org-babel-get-src-block-info 'light) - lang (propertize (nth 0 info) 'face 'font-lock-string-face) + lang (propertize (or (nth 0 info) "no lang") 'face 'font-lock-string-face) hdr-args (nth 2 info)) (concat lang @@ -87,13 +91,17 @@ (defun org-eldoc-get-src-lang () "Return value of lang for the current block if in block body and nil otherwise." - (let ((case-fold-search t)) - (save-match-data - (when (org-between-regexps-p ".*#\\+begin_src" - ".*#\\+end_src") - (save-excursion - (goto-char (org-babel-where-is-src-block-head)) - (car (org-babel-parse-src-block-match))))))) + (let ((element (save-match-data (org-element-at-point)))) + (and (eq (org-element-type element) 'src-block) + (>= (line-beginning-position) + (org-element-property :post-affiliated element)) + (<= + (line-end-position) + (org-with-wide-buffer + (goto-char (org-element-property :end element)) + (skip-chars-backward " \t\n") + (line-end-position))) + (org-element-property :language element)))) (defvar org-eldoc-local-functions-cache (make-hash-table :size 40 :test 'equal) "Cache of major-mode's eldoc-documentation-functions, @@ -147,7 +155,7 @@ (string= lang "golang")) (when (require 'go-eldoc nil t) (go-eldoc--documentation-function))) (t (let ((doc-fun (org-eldoc-get-mode-local-documentation-function lang))) - (when (fboundp doc-fun) (funcall doc-fun)))))))) + (when (functionp doc-fun) (funcall doc-fun)))))))) ;;;###autoload (defun org-eldoc-load () diff --git a/contrib/lisp/org-elisp-symbol.el b/contrib/lisp/org-elisp-symbol.el index cdf868b..7c98962 100644 --- a/contrib/lisp/org-elisp-symbol.el +++ b/contrib/lisp/org-elisp-symbol.el @@ -78,8 +78,9 @@ (require 'org) -(org-add-link-type "elisp-symbol" 'org-elisp-symbol-open) -(add-hook 'org-store-link-functions 'org-elisp-symbol-store-link) +(org-link-set-parameters "elisp-symbol" + :follow #'org-elisp-symbol-open + :store #'org-elisp-symbol-store-link) (defun org-elisp-symbol-open (path) "Visit the emacs-lisp elisp-symbol at PATH." diff --git a/contrib/lisp/org-expiry.el b/contrib/lisp/org-expiry.el index 396f016..45f59a2 100644 --- a/contrib/lisp/org-expiry.el +++ b/contrib/lisp/org-expiry.el @@ -186,7 +186,7 @@ restart `org-mode' if necessary." ;; need this to refresh org-mode hooks (when (eq major-mode 'org-mode) (org-mode) - (if (org-called-interactively-p) + (if (called-interactively-p 'any) (message "Org-expiry insinuated, `org-mode' restarted."))))) (defun org-expiry-deinsinuate (&optional arg) @@ -207,7 +207,7 @@ and restart `org-mode' if necessary." ;; need this to refresh org-mode hooks (when (eq major-mode 'org-mode) (org-mode) - (if (org-called-interactively-p) + (if (called-interactively-p 'any) (message "Org-expiry de-insinuated, `org-mode' restarted."))))) ;;; org-expiry-expired-p: @@ -239,7 +239,7 @@ If FORCE is non-nil, don't require confirmation from the user. Otherwise rely on `org-expiry-confirm-flag' to decide." (interactive "P") (save-excursion - (when (org-called-interactively-p) (org-reveal)) + (when (called-interactively-p) (org-reveal)) (when (org-expiry-expired-p) (org-back-to-heading) (looking-at org-complex-heading-regexp) @@ -253,7 +253,7 @@ Otherwise rely on `org-expiry-confirm-flag' to decide." (not (interactive))) (and org-expiry-confirm-flag (y-or-n-p (format "Entry expired by %d days. Process? " d)))) - (funcall 'org-expiry-handler-function)) + (funcall org-expiry-handler-function)) (delete-overlay ov))))) (defun org-expiry-process-entries (beg end) @@ -271,7 +271,7 @@ The expiry process will run the function defined by (while (and (outline-next-heading) (< (point) end)) (when (org-expiry-expired-p) (setq expired (1+ expired)) - (if (if (org-called-interactively-p) + (if (if (called-interactively-p 'any) (call-interactively 'org-expiry-process-entry) (org-expiry-process-entry)) (setq processed (1+ processed))))) @@ -339,7 +339,7 @@ and insert today's date." (save-excursion (if (org-expiry-expired-p) (org-archive-subtree) - (if (org-called-interactively-p) + (if (called-interactively-p 'any) (message "Entry at point is not expired."))))) (defun org-expiry-add-keyword (&optional keyword) @@ -350,7 +350,7 @@ and insert today's date." (save-excursion (if (org-expiry-expired-p) (org-todo keyword) - (if (org-called-interactively-p) + (if (called-interactively-p 'any) (message "Entry at point is not expired.")))) (error "\"%s\" is not a to-do keyword in this buffer" keyword))) diff --git a/contrib/lisp/org-git-link.el b/contrib/lisp/org-git-link.el index ad0ce71..9d3ff32 100644 --- a/contrib/lisp/org-git-link.el +++ b/contrib/lisp/org-git-link.el @@ -69,7 +69,7 @@ ;; org link functions ;; bare git link -(org-add-link-type "gitbare" 'org-gitbare-open) +(org-link-set-parameters "gitbare" :follow #'org-gitbare-open) (defun org-gitbare-open (str) (let* ((strlist (org-git-split-string str)) @@ -92,7 +92,7 @@ (setq buffer-read-only t))) ;; user friendly link -(org-add-link-type "git" 'org-git-open) +(org-link-set-parameters "git" :follow #'org-git-open :store #'org-git-store-link) (defun org-git-open (str) (let* ((strlist (org-git-split-string str)) @@ -135,10 +135,8 @@ (eval-and-compile - (if (featurep 'xemacs) - (defalias 'org-git-gitrepos-p 'org-git-find-gitdir) - (defalias 'org-git-gitrepos-p 'org-git-find-gitdir - "Return non-nil if path is in git repository"))) + (defalias 'org-git-gitrepos-p 'org-git-find-gitdir + "Return non-nil if path is in git repository")) ;; splitting the link string @@ -192,8 +190,6 @@ than two double colons, str2 and/or str3 may be set the empty string." :type "git" :link (org-git-create-git-link file line)))))) -(add-hook 'org-store-link-functions 'org-git-store-link) - (defun org-git-insert-link-interactively (file searchstring &optional description) (interactive "FFile: \nsSearch string: \nsDescription: ") (insert (org-make-link-string (concat "git:" file "::" searchstring) description))) diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el index aee0bac..31b675e 100644 --- a/contrib/lisp/org-index.el +++ b/contrib/lisp/org-index.el @@ -1,9 +1,9 @@ -;;; org-index.el --- A personal index for org and beyond +;;; org-index.el --- A personal adaptive index for org ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. ;; Author: Marc Ihm <org-index@2484.de> -;; Version: 4.2.1 +;; Version: 5.1.3 ;; Keywords: outlines index ;; This file is not part of GNU Emacs. @@ -27,88 +27,113 @@ ;; Purpose: ;; -;; Fast search for selected org headings and things outside of org. +;; Fast search for selected org nodes and things outside of org. ;; -;; This package creates and updates an index table of headings or -;; keywords, references and ids, where each line points to a heading -;; within org or references something outside. This table is sorted by -;; usage count, so that frequently used lines appear among the first -;; search results. +;; org-index creates and updates an index table with keywords; each line +;; either points to a heading in org, references something outside or +;; carries a snippet of text to yank. When searching the index, the set +;; of matching lines is updated with every keystroke; results are sorted +;; by usage count and date, so that frequently used entries appear first +;; in the list of results. ;; -;; References are essentially small numbers (e.g. 'R237' or '--455--'), as -;; created by this package; they are well suited to be used outside of -;; org, e.g. in folder names, issue trackers or on printed documents. +;; References are decorated numbers (e.g. 'R237' or '--455--'); they are +;; well suited to be used outside of org, e.g. in folder names, ticket +;; systems or on printed documents. ;; -;; On first invocation org-index will guide you to create a dedicated node -;; for its index table and its configuration flags. +;; On first invocation org-index will assist you in creating the index +;; table. ;; -;; For basic usage, subcommands 'add' and 'occur' are most important. +;; To start using your index, invoke subcommands 'add', 'ref' and 'yank' +;; to create entries and 'occur' to find them. ;; ;; ;; Setup: ;; +;; - Place this file in a directory from your load-path, +;; e.g. org-mode/contrib/lisp. +;; ;; - Add these lines to your .emacs: ;; ;; (require 'org-index) -;; (org-index-default-keybindings) ; optional +;; (global-set-key (kbd "C-c i") 'org-index-dispatch) ; this is optional ;; ;; - Restart your Emacs to make these lines effective. ;; -;; - Invoke `org-index', which will assist in creating your index -;; table. The variable org-index-id will be persisted within your -;; customization file (typically .emacs). +;; - Invoke `org-index'; on first run it will assist in creating your +;; index table. +;; +;; - Optionally invoke `M-x org-customize' to tune some settings (choose +;; group org-index). +;; ;; +;; Further information: ;; -;; Further reading: +;; - Watch the screencast at http://2484.de/org-index.html. ;; -;; See the documentation of `org-index', which can also be read -;; by invoking `org-index' and choosing the help-command. +;; - See the documentation of `org-index', which can also be read by +;; invoking `org-index' and choosing the command help or '?'. ;; ;; ;; Updates: ;; -;; The latest tested version of this file can always be found at: +;; The latest published version of this file can always be found at: +;; +;; http://orgmode.org/w/?p=org-mode.git;a=blob_plain;f=contrib/lisp/org-index.el;hb=HEAD +;; +;; Development version under: ;; -;; http://orgmode.org/cgit.cgi/org-mode.git/plain/contrib/lisp/org-index.el +;; https://github.com/marcIhm/org-index ;;; Change Log: +;; [2016-08-26 Fr] Version 5.1.3 +;; - Offering help during query for subcommands +;; - Removed org-index-default-keybindings +;; - Renamed subcommand multi-occur to find-ref +;; - Subcommands add and need no longer be invoked from heading +;; - Many Bugfixes +;; +;; [2015-12-29 Tu] Version 5.0.2 +;; - New commands yank, column and edit +;; - New column tags +;; - All columns are now required +;; - References are now optional +;; - Subcommand enter has been renamed to index +;; - Subcommands kill and edit can be invoked from an occur buffer +;; - Many Bugfixes +;; - Added link to screencast +;; +;; [2015-08-20 Th] Version 4.3.0 +;; - Configuration is done now via standard customize +;; - New sorting strategy 'mixed' +;; - Silenced some compiler warnings +;; ;; [2015-03-18 We] Version 4.2.1 ;; - No garbage in kill-ring ;; - No recentering after add ;; ;; [2015-03-08 Su] Version 4.2.0 ;; - Reference numbers for subcommands can be passed as a prefix argument -;; - Renamed subcommand 'point' to 'ping' ;; - New variable org-index-default-keybindings-list with a list of ;; default keybindings for org-index-default-keybindings ;; - Added new column level ;; - removed flags get-category-on-add and get-heading-on-add ;; -;; [2015-03-05 Th] Version 4.1.1 and 4.1.2 -;; - org-mark-ring is now used more consistently -;; - Bugfix when going to a heading by ref -;; -;; [2015-02-26 Th] Version 4.0.0 and 4.1.0: +;; [2015-02-26 Th] to [2015-03-05 Th] Version 4.0.0 to 4.1.2 ;; - Removed command "leave"; rather go back with org-mark-ring-goto -;; - Property "org-index-ref" is no longer used or needed ;; - Renamed column "link" to "id" ;; - Added maintainance options to find duplicate rows, to check ids, ;; update index or remove property org-index-ref from nodes -;; - New command point ;; - Shortened versin history ;; -;; [2014-12-07 Sa] to [2015-01-31 Sa] Version 3.0.0 to 3.2.0: +;; [2014-12-08 Mo] to [2015-01-31 Sa] Version 3.0.0 to 3.2.0: ;; - Complete sorting of index only occurs in idle-timer ;; - New command "maintain" with some subcommands ;; - Rewrote command "occur" with overlays in an indirect buffer -;; - introduced variable org-index-version ;; - Command "add" updates index, if node is already present ;; - New commands "add" and "delete" to easily add and remove ;; the current node to or from your index. ;; - New command "example" to create an example index. -;; - Moved flags to a list within the same node as the index table; -;; this breaks compatibility to prior versions of the package. ;; - Several new flags that are explained within index node. ;; - Removed commands "reuse", "missing", "put", "goto", ;; "update", "link", "fill", "unhighlight" @@ -139,97 +164,150 @@ ;;; Code: (require 'org-table) -(require 'cl) +(require 'cl-lib) +(require 'widget) + +;; Version of this package +(defvar org-index-version "5.1.3" "Version of `org-index', format is major.minor.bugfix, where \"major\" are incompatible changes and \"minor\" are new features.") + +;; customizable options +(defgroup org-index nil + "Options concerning the optional index for org." + :tag "Org Index" + :group 'org) (defcustom org-index-id nil "Id of the Org-mode node, which contains the index table." - :group 'org :group 'org-index) -;; Version of this package -(defvar org-index-version "4.2.1" "Version of `org-index', format is major.minor.bugfix, where \"major\" is a change in index-table and \"minor\" are new features.") +(defcustom org-index-sort-by 'mixed + "Strategy for sorting index table (and whence entries in occur). +Valid values are: + +last-access Sort index by date and time of last access; show + more recent entries first. +count Sort by usage count; more often used entries first. +mixed First, show all index entries, which have been + used today; sort them by last access. Then show + older entries sorted by usage count." + :group 'org-index + :set (lambda (s v) + (set-default s v) + (if (and org-index-id + org-index--buffer + (functionp 'org-index--sort-silent)) + (org-index--sort-silent))) + :initialize 'custom-initialize-default + :type '(choice + (const last-accessed) + (const count) + (const mixed))) + +(defcustom org-index-yank-after-add 'ref + "Specifies which column should be yanked after adding a new index row. +Valid values are some columns of index table." + :group 'org-index + :type '(choice + (const ref) + (const category) + (const keywords))) + +(defcustom org-index-point-on-add 'keywords + "Specifies in which column point will land when adding a new index row. +Valid values are some columns of index table." + :group 'org-index + :type '(choice + (const category) + (const keywords))) + +(defcustom org-index-copy-heading-to-keywords t + "When adding a new node to index: Copy heading to keywords-column ?" + :group 'org-index + :type '(choice (const :tag "Yes" t) + (const :tag "No" nil))) + +(defcustom org-index-strip-ref-and-date-from-heading t + "When adding a node to index: strip leading ref or timestamps ? + +This can be useful, if you have the habit of adding refs and +dates to the start of your headings; then, if you change your +heading and want to update your index, you do not need to remove +those pieces." + :group 'org-index + :type '(choice (const :tag "Yes" t) + (const :tag "No" nil))) + +(defcustom org-index-edit-on-add '(category keywords) + "List of columns to edit when adding a new row." + :group 'org-index + :type '(repeat (choice + (const category) + (const keywords)))) + +(defcustom org-index-edit-on-yank '(yank keywords) + "List of columns to edit when adding new text to yank." + :group 'org-index + :type '(repeat (choice + (const yank) + (const category) + (const keywords)))) + +(defcustom org-index-edit-on-ref '(category keywords) + "List of columns to edit when adding new ref." + :group 'org-index + :type '(repeat (choice + (const category) + (const keywords)))) ;; Variables to hold the configuration of the index table -(defvar org-index--maxref nil "Maximum number from reference table (e.g. '153').") -(defvar org-index--head nil "Any header before number (e.g. 'R').") +(defvar org-index--maxrefnum nil "Maximum number from reference table, e.g. 153.") +(defvar org-index--nextref nil "Next reference, that can be used, e.g. 'R154'.") +(defvar org-index--head nil "Header before number (e.g. 'R').") (defvar org-index--tail nil "Tail after number (e.g. '}' or ')'.") (defvar org-index--numcols nil "Number of columns in index table.") (defvar org-index--ref-regex nil "Regular expression to match a reference.") (defvar org-index--ref-format nil "Format, that can print a reference.") (defvar org-index--columns nil "Columns of index-table.") -(defvar org-index--special-columns nil "Columns with flags, that may appear only once.") -(defvar org-index--flagged-columns nil "Columns with flags, that may appear multiple times.") (defvar org-index--buffer nil "Buffer of index table.") (defvar org-index--point nil "Position at start of headline of index table.") (defvar org-index--below-hline nil "Position of first cell in first line below hline.") +(defvar org-index--saved-positions nil "Saved positions within current buffer and index buffer; filled by ‘org-index--save-positions’.") (defvar org-index--headings nil "Headlines of index-table as a string.") (defvar org-index--headings-visible nil "Visible part of headlines of index-table as a string.") -(defvar org-index--keymap nil "Keymap for shortcuts for some commands of `org-index'. Filled and activated by `org-index-default-keybings'.") ;; Variables to hold context and state -(defvar org-index--last-ref nil "Last reference created or visited.") +(defvar org-index--last-fingerprint nil "Fingerprint of last line created.") (defvar org-index--category-before nil "Category of node before.") (defvar org-index--active-region nil "Active region, initially. I.e. what has been marked.") (defvar org-index--below-cursor nil "Word below cursor.") -(defvar org-index--within-node nil "True, if we are within node of the index table.") +(defvar org-index--within-index-node nil "True, if we are within node of the index table.") +(defvar org-index--within-occur nil "True, if we are within the occur-buffer.") (defvar org-index--message-text nil "Text that was issued as an explanation; helpful for regression tests.") (defvar org-index--occur-help-text nil "Text for help in occur buffer.") (defvar org-index--occur-help-overlay nil "Overlay for help in occur buffer.") (defvar org-index--occur-stack nil "Stack with overlays for hiding lines.") (defvar org-index--occur-tail-overlay nil "Overlay to cover invisible lines.") +(defvar org-index--occur-lines-collected 0 "Number of lines collected in occur buffer; helpful for tests.") (defvar org-index--last-sort nil "Last column, the index has been sorted after.") (defvar org-index--sort-timer nil "Timer to sort index in correct order.") (defvar org-index--aligned nil "Remember for this Emacs session, if table has been aligned at least once.") +(defvar org-index--edit-widgets nil "List of widgets used to edit.") +(defvar org-index--context-index nil "Position and line used for index in edit buffer.") +(defvar org-index--context-occur nil "Position and line used for occur in edit buffer.") +(defvar org-index--context-node nil "Buffer and position for node in edit buffer.") +(defvar org-index--short-help-buffer-name "*org-index commands*" "Name of buffer to display short help.") +(defvar org-index--display-short-help nil "True, if short help should be displayed.") +(defvar org-index--short-help-displayed nil "True, if short help message has been displayed.") +(defvar org-index--minibuffer-saved-key nil "Temporarily save entry of minibuffer keymap.") ;; static information for this program package -(defconst org-index--commands '(occur add delete head ping enter ref help example sort multi-occur highlight maintain) "List of commands available.") -(defconst org-index--required-flags '(sort) "Flags that are required.") -(defconst org-index--single-flags '(sort point-on-add yank-after-add shift-ref-and-date-on-add) "Flags, that may only appear once; these can appear as special-columns.") -(defconst org-index--multiple-flags '(edit-on-add) "Flags, that might appear multiple times.") -(defconst org-index--all-flags (append org-index--single-flags org-index--multiple-flags) "All flags.") -(defconst org-index--required-headings '(ref id created last-accessed count) "All required headings.") -(defconst org-index--valid-headings (append org-index--required-headings '(keywords category level)) "All valid headings.") +(defconst org-index--commands '(occur add kill head ping index ref yank column edit help short-help example sort find-ref highlight maintain) "List of commands available.") +(defconst org-index--valid-headings '(ref id created last-accessed count keywords category level yank tags) "All valid headings.") (defconst org-index--occur-buffer-name "*org-index-occur*" "Name of occur buffer.") +(defconst org-index--edit-buffer-name "*org-index-edit*" "Name of edit buffer.") (defconst org-index--sort-idle-delay 300 "Delay in seconds after which buffer will sorted.") -(defvar org-index-default-keybindings-list '(("a" . 'add) ("i " . nil) ("o" . 'occur) ("a" . 'add) ("d" . 'delete) ("h" . 'head) ("e" . 'enter) ("p." . 'ping) ("r" . 'ref) ("?" . 'help)) "One-letter short cuts for selected subcommands of `org-index', put in effect by `org-index-default-keybindings'") -(defconst org-index--sample-flags -" - - columns-and-flags :: associate columns of index table with flags. Do not remove. - - ref - - yank-after-add - - category - - edit-on-add - - keywords - - edit-on-add - - point-on-add - - count - - sort - - last-accessed - - created - - id - - all-columns-explained :: All columns of the index table and their meaning. - - ref :: The reference number; will be generated automatically. - - id :: id of the node, that this line represents - - created :: When has this entry been created ? - - last-accessed :: When has this entry been accessed last ? - - count :: How many times has this entry been picked ? - - keywords :: Optional column, suggested to keep a list of keywords, - which may match your input during occur. While adding a line to your index, - this column will be filled with the nodes heading. - - category :: (optional) column to store the category of newly added nodes. - - level :: Nesting level of node - - Any name starting with a dot (`.') :: No predefined meaning, - depends on its flags. - - all-flags-explained :: All flags, that can be associated with columns. - - sort :: Sort whole table according to this column. - - yank-after-add :: This column will be yanked after picking this line during - occur. - - edit-on-add :: This field will be presented for editing, when adding - a new line to your index. - - point-on-add :: Point will land here, when adding a new line, e.g. with - command ref. - - shift-ref-and-date-on-add :: Remove leading reference and timestamp on add." -"A sample string of flags.") +(defvar org-index--short-help-text nil "Cache for result of `org-index--get-short-help-text.") +(defvar org-index--shortcut-chars nil "Cache for result of `org-index--get-shortcut-chars.") (defmacro org-index--on (column value &rest body) @@ -241,511 +319,559 @@ if VALUE cannot be found." (foundvar (make-symbol "found")) (retvar (make-symbol "ret"))) `(save-current-buffer - (set-buffer org-index--buffer) - (setq ,pointvar (point)) - (setq ,foundvar nil) - (setq ,retvar nil) + (let ((,pointvar (point)) + ,foundvar + ,retvar) + + (set-buffer org-index--buffer) + + (setq ,foundvar (org-index--go ,column ,value)) + (when ,foundvar + (setq ,retvar (progn ,@body))) + + (goto-char ,pointvar) - (setq ,foundvar (org-index--go ,column ,value)) - (when ,foundvar - (setq ,retvar (progn ,@body))) - - (goto-char ,pointvar) - - ,retvar))) + ,retvar)))) (defun org-index (&optional command search-ref arg) - "Fast search for selected org headings and things outside of org. + "Fast search-index for selected org nodes and things outside of org. -This package creates and updates an index table of headings or -keywords, references and ids, where each line points to a heading -within org or references something outside. This table is sorted by -usage count, so that frequently used lines appear among the first -search results. +org-index creates and updates an index table with keywords; each line +either points to a heading in org, references something outside or +carries a snippet of text to yank. The index table is searched for +keywords through an incremental occur; results are sorted by usage +count and date, so that frequently used entries appear first among +the results. -References are essentially small numbers (e.g. 'R237' or '--455--'), as -created by this package; they are well suited to be used outside of -org, e.g. in folder names, issue trackers or on printed documents. +References are decorated numbers (e.g. 'R237' or '--455--'); they are +well suited to be used outside of org, e.g. in folder names, ticket +systems or on printed documents. -On first invocation `org-index' will guide you to create a dedicated node -for its index table and its configuration flags. +On first invocation org-index will help to create a dedicated node +for its index table. -For basic usage, subcommands 'add' and 'occur' are most important. +To start building up your index, use subcommands 'add', 'ref' and +'yank' to create entries and use 'occur' to find them. -This is version 4.2.1 of org-index.el. -\\<org-mode-map> -The function `org-index' operates on a dedicated table, the index -table, which lives within its own Org-mode node. The table and -its containing node will be created, when you first invoke -`org-index'. The node also contains a commented list, describing -the columns of the index table and their associated flags. The -node is found through its id, which is stored within the variable -`org-index-id'. +This is version 5.1.3 of org-index.el. The function `org-index' is the only interactive function of this package and its main entry point; it will present you with a list of subcommands to choose from: - occur: Incremental search, that shows matching lines from the - index table. It is updated after every keystroke. You may - enter a list of words seperated by space or comma (`,'), to - select lines that contain all of the given words. +\(Note the one-letter shortcuts, e.g. [o]; used like 'C-c i o'.) - add: Add the current node to your index, so that it can be - found through the subcommand \"occur\". Update index, - if node has already been present. + occur: [o] Incrementally show matching lines from index. + Result is updated after every keystroke. You may enter a + list of words seperated by space or comma (`,'), to select + lines that contain all of the given words. - delete: Delete the current node from your index. + add: [a] Add the current node to index. + So that (e.g.) it can be found through the subcommand + 'occur'. Update index, if node is already present. - head: Ask for a reference number and search for this heading. + kill: [k] Kill (delete) the current node from index. + Can be invoked from index, from occur or from a headline. - enter: Enter index table and maybe go to a specific reference; - use `org-mark-ring-goto' (\\[org-mark-ring-goto]) to go back. + head: [h] Search for heading, by ref or from index line. + If invoked from within index table, go to associated + node (if any), otherwise ask for ref to search. - ping: Echo line from index table for current node or first of - its ancestor from index. + index: [i] Enter index table and maybe go to a specific reference. + Use `org-mark-ring-goto' (\\[org-mark-ring-goto]) to go back. - ref: Create a new reference. + ping: [p] Echo line from index table for current node. + If current node is not in index, than search among its + parents. - help: Show this text. + ref: [r] Create a new index line with a reference. + This line will not be associated with a node. - example: Create a temporary index, that will not be saved, but - may serve as an example. + yank: [y] Store a new string, that can be yanked from occur. + The index line will not be associated with a node. - sort: Sort lines in index, in region or buffer by contained - reference, or sort index by count, reference or last access. + column: [c] From within index table: read char and jump to column. + Shortcut for column movement; stays within one index line. - multi-occur: Apply Emacs standard `multi-occur' operation on all - `org-mode' buffers to search for the given reference. + edit: [e] Present current line in edit buffer. + Can be invoked from index, from occur or from a headline. - highlight: Highlight or unhiglight references in active region or buffer. - Call with prefix argument (`C-u') to remove highlights. + help: Show complete help text of org-index. - maintain: Offers some choices to check, update or fix your index. + short-help: [?] Show one-line description of each subcommand. + I.e. show this list but only first sentence each. + + example: Create an example index, that will not be saved. + May serve as an example. + + sort: Sort lines in index, in region or buffer. + Region or buffer can be sorted by contained reference; Index + by count, reference or last access. + + find-ref: Search for given reference in all org-buffers. + A wrapper to employ emacs standard `multi-occur' function; + asks for reference. + + highlight: Highlight or unhighlight all references. + Operates on active region or whole buffer. Call with prefix + argument (`C-u') to remove highlights. + + maintain: Index maintainance. + Offers some choices to check, update or fix your index. If you invoke `org-index' for the first time, an assistant will be -invoked, that helps you to create your own, commented index. +invoked, that helps you to create your own index. -Use `org-index-default-keybindings' to establish convenient -keyboard shortcuts. +Invoke `org-customize' to tweak the behaviour of org-index. -See the commented list of flags within your index node for ways to -modify the behaviour of org-index. +Optionally bind `org-index-dispatch' to a key, e.g. 'C-c i' in +the global keymap to invoke the most important subcommands with +a single key. A numeric prefix argument is used as a reference number for commands, that need one (e.g. 'head'). -Optional arguments for use from elisp: COMMAND is a symbol naming -the command to execute. SEARCH-REF specifies a reference to -search for, if needed. ARG allows passing in a prefix argument -as in interactive calls." +Use from elisp: Optional argument COMMAND is a symbol naming the +command to execute. SEARCH-REF specifies a reference to search +for, if needed. ARG allows passing in a prefix argument as in +interactive calls." (interactive "i\ni\nP") (let (search-id ; id to search for + search-fingerprint ; fingerprint to search for sort-what ; sort what ? kill-new-text ; text that will be appended to kill ring message-text) ; text that will be issued as an explanation + (catch 'new-index - ;; - ;; Initialize and parse - ;; + ;; + ;; Initialize and parse + ;; - ;; creates index table, if necessary - (org-index--verify-id) + ;; creates index table, if necessary + (org-index--verify-id) - ;; Get configuration of index table - (org-index--parse-table) + ;; Get configuration of index table + (org-index--parse-table) - ;; store context information - (org-index--retrieve-context) - - - ;; - ;; Arrange for proper sorting of index - ;; - - ;; lets assume, that it has been sorted this way (we try hard to make sure) - (unless org-index--last-sort (setq org-index--last-sort (org-index--special-column 'sort))) - ;; rearrange for index beeing sorted into default sort order after 300 secs of idle time - (unless org-index--sort-timer - (setq org-index--sort-timer - (run-with-idle-timer org-index--sort-idle-delay t 'org-index--sort-silent))) - - - ;; - ;; Find out, what we are supposed to do - ;; - - ;; check or read command - (if command - (unless (memq command org-index--commands) - (error "Unknown command '%s' passed as argument, valid choices are any of these symbols: %s" - command (mapconcat 'symbol-name org-index--commands ","))) - (setq command (intern (org-completing-read - "Please choose: " - (mapcar 'symbol-name org-index--commands))))) - - - ;; - ;; Get search string, if required; process possible sources one after - ;; another (lisp argument, prefix argumen, user input). - ;; - - ;; Try prefix, if no lisp argument given - (if (and (not search-ref) - (numberp arg)) - (setq search-ref (format "%s%d%s" org-index--head arg org-index--tail))) - - ;; These actions really need a search string and may even prompt for it - (when (memq command '(enter head multi-occur)) - - ;; search from surrounding text ? - (unless search-ref - (if org-index--within-node - - (if (org-at-table-p) - (setq search-ref (org-index--get-or-set-field 'ref))) - - (if (and org-index--below-cursor - (string-match (concat "\\(" org-index--ref-regex "\\)") - org-index--below-cursor)) - (setq search-ref (match-string 1 org-index--below-cursor))))) - - ;; If we still do not have a search string, ask user explicitly - (unless search-ref - (if (eq command 'enter) - (let ((r (org-index--read-search-for-enter))) - (setq search-ref (car r)) - (setq search-id (cdr r))) - (setq search-ref (read-from-minibuffer "Search reference number: ")))) - - ;; Clean up search string - (when search-ref - (setq search-ref (org-trim search-ref)) - (if (string-match "^[0-9]+$" search-ref) - (setq search-ref (concat org-index--head search-ref org-index--tail))) - (if (string= search-ref "") (setq search-ref nil))) + ;; store context information + (org-index--retrieve-context) - (if (and (not search-ref) - (not (eq command 'enter))) - (error "Command %s needs a reference number" command))) - - - ;; - ;; Command sort needs to know in advance, what to sort for - ;; - - (when (eq command 'sort) - (setq sort-what (intern (org-completing-read "You may sort:\n - index : your index table by various columns\n - region : the active region by contained reference\n - buffer : the whole current buffer\nPlease choose what to sort: " (list "index" "region" "buffer") nil t)))) - - - ;; - ;; Enter table - ;; - - ;; Arrange for beeing able to return - (when (and (memq command '(occur head enter ref example sort maintain)) - (not (string= (buffer-name) org-index--occur-buffer-name))) - (org-mark-ring-push)) - - ;; These commands will leave user in index table after they are finished - (when (or (memq command '(enter ref maintain)) - (and (eq command 'sort) - (eq sort-what 'index))) - (pop-to-buffer-same-window org-index--buffer) - (goto-char org-index--point) - (org-index--unfold-buffer)) + ;; + ;; Arrange for proper sorting of index + ;; + ;; lets assume, that it has been sorted this way (we try hard to make sure) + (unless org-index--last-sort (setq org-index--last-sort org-index-sort-by)) + ;; rearrange for index beeing sorted into default sort order after 300 secs of idle time + (unless org-index--sort-timer + (setq org-index--sort-timer + (run-with-idle-timer org-index--sort-idle-delay t 'org-index--sort-silent))) - ;; - ;; Actually do, what is requested - ;; - (cond + ;; + ;; Find out, what we are supposed to do + ;; + ;; Check or read command + (if (and command (not (eq command 'short-help))) + (unless (memq command org-index--commands) + (error "Unknown command '%s' passed as argument, valid choices are any of these symbols: %s" + command (mapconcat 'symbol-name org-index--commands ","))) - ((eq command 'help) + ;; read command; if requested display help in read-loop + (setq org-index--display-short-help (eq command 'short-help)) + (setq command (org-index--read-command)) + (setq org-index--display-short-help nil)) - ;; bring up help-buffer for this function - (describe-function 'org-index)) + ;; + ;; Get search string, if required; process possible sources one after + ;; another (lisp argument, prefix argument, user input). + ;; + + ;; Try prefix, if no lisp argument given + (if (and (not search-ref) + (numberp arg)) + (setq search-ref (format "%s%d%s" org-index--head arg org-index--tail))) + + ;; These actions really need a search string and may even prompt for it + (when (memq command '(index head find-ref)) + + ;; search from surrounding text ? + (unless search-ref + (if org-index--within-index-node + + (if (org-at-table-p) + (setq search-ref (org-index--get-or-set-field 'ref))) + + (if (and org-index--below-cursor + (string-match (concat "\\(" org-index--ref-regex "\\)") + org-index--below-cursor)) + (setq search-ref (match-string 1 org-index--below-cursor))))) + + ;; If we still do not have a search string, ask user explicitly + (unless search-ref + (if (eq command 'index) + (let ((r (org-index--read-search-for-index))) + (setq search-ref (first r)) + (setq search-id (second r)) + (setq search-fingerprint (third r))) + (unless (and (eq command 'head) + org-index--within-index-node + (org-at-table-p)) + (setq search-ref (read-from-minibuffer "Search reference number: "))))) + + ;; Clean up search string + (when search-ref + (setq search-ref (org-trim search-ref)) + (if (string-match "^[0-9]+$" search-ref) + (setq search-ref (concat org-index--head search-ref org-index--tail))) + (if (string= search-ref "") (setq search-ref nil))) + + (if (and (not search-ref) + (not (eq command 'index)) + (not (and (eq command 'head) + org-index--within-index-node + (org-at-table-p)))) + (error "Command %s needs a reference number" command))) + + + ;; + ;; Command sort needs to know in advance, what to sort for + ;; + + (when (eq command 'sort) + (setq sort-what (intern (org-completing-read "You may sort:\n - index : your index table by various columns\n - region : the active region by contained reference\n - buffer : the whole current buffer\nPlease choose what to sort: " (list "index" "region" "buffer") nil t)))) + + + ;; + ;; Enter table + ;; + + ;; Arrange for beeing able to return + (when (and (memq command '(occur head index example sort maintain)) + (not (string= (buffer-name) org-index--occur-buffer-name))) + (org-mark-ring-push)) + + ;; These commands will leave user in index table after they are finished + (when (or (memq command '(index maintain)) + (and (eq command 'sort) + (eq sort-what 'index))) + + (pop-to-buffer-same-window org-index--buffer) + (goto-char org-index--point) + (org-index--unfold-buffer)) + + + ;; + ;; Actually do, what is requested + ;; + (cond - ((eq command 'multi-occur) + ((eq command 'help) - ;; Construct list of all org-buffers - (let (buff org-buffers) - (dolist (buff (buffer-list)) - (set-buffer buff) - (if (string= major-mode "org-mode") - (setq org-buffers (cons buff org-buffers)))) + ;; bring up help-buffer for this function + (describe-function 'org-index)) - ;; Do multi-occur - (multi-occur org-buffers (org-index--make-guarded-search search-ref)) - ;; Present results - (if (get-buffer "*Occur*") - (progn - (setq message-text (format "multi-occur for '%s'" search-ref)) - (other-window 1) - (toggle-truncate-lines 1)) - (setq message-text (format "Did not find '%s'" search-ref))))) + ((eq command 'short-help) + (org-index--display-short-help)) - ((eq command 'add) - (let ((r (org-index--do-add-or-update))) - (setq message-text (car r)) - (setq kill-new-text (cdr r)))) + ((eq command 'find-ref) + ;; Construct list of all org-buffers + (let (org-buffers) + (dolist (buff (buffer-list)) + (set-buffer buff) + (if (string= major-mode "org-mode") + (setq org-buffers (cons buff org-buffers)))) - ((eq command 'delete) + ;; Do multi-occur + (multi-occur org-buffers (org-index--make-guarded-search search-ref)) - (setq message-text (org-index--do-delete))) + ;; Present results + (if (get-buffer "*Occur*") + (progn + (setq message-text (format "Found '%s'" search-ref)) + (other-window 1) + (toggle-truncate-lines 1)) + (setq message-text (format "Did not find '%s'" search-ref))))) - ((eq command 'head) + ((eq command 'add) - (if (and org-index--within-node - (org-at-table-p)) - (setq search-id (org-index--get-or-set-field 'id))) + (let ((r (org-index--do-add-or-update (if (equal arg '(4)) t nil) + (if (numberp arg) arg nil)))) + (setq message-text (car r)) + (setq kill-new-text (cdr r)))) - (setq search-id (or search-id (org-index--id-from-ref search-ref))) - (setq message-text - (if search-id - (org-index--do-head search-ref search-id) - (message "Current line has no id.")))) + ((eq command 'kill) + (setq message-text (org-index--do-kill))) - ((eq command 'enter) - (goto-char org-index--below-hline) + ((eq command 'head) - (setq message-text + (if (and org-index--within-index-node + (org-at-table-p)) + (setq search-id (org-index--get-or-set-field 'id))) - (if search-ref - (if (org-index--go 'ref search-ref) - (progn - (org-index--update-current-line) - (org-table-goto-column (org-index--column-num 'ref)) - (format "Found index line '%s'" search-ref)) - (format "Did not find index line with reference '%s'" search-ref)) + (if (and (not search-id) search-ref) + (setq search-id (org-index--id-from-ref search-ref))) + (setq message-text (if search-id - (if (org-index--go 'id search-id) + (org-index--find-id search-id) + "Current line has no id"))) + + + ((eq command 'index) + + (goto-char org-index--below-hline) + + (setq message-text + + (if search-ref + (if (org-index--go 'ref search-ref) (progn (org-index--update-current-line) (org-table-goto-column (org-index--column-num 'ref)) - (format "Found index line '%s'" (org-index--get-or-set-field 'ref))) - (format "Did not find index line with id '%s'" search-id)) + (format "Found index line '%s'" search-ref)) + (format "Did not find index line with reference '%s'" search-ref)) - ;; simply go into table - (setq message-text "At index table")))) + (if search-id + (if (org-index--go 'id search-id) + (progn + (org-index--update-current-line) + (org-table-goto-column (org-index--column-num 'ref)) + (format "Found index line '%s'" (org-index--get-or-set-field 'ref))) + (format "Did not find index line with id '%s'" search-id)) - (recenter)) + (if search-fingerprint + (if (org-index--go 'fingerprint org-index--last-fingerprint) + (progn + (org-index--update-current-line) + (beginning-of-line) + (format "Found latest index line")) + (format "Did not find index line")) + ;; simply go into table + "At index table")))) - ((eq command 'ping) + (recenter)) - (let ((moved-up 0) id info reached-top) - (unless (string= major-mode "org-mode") (error "No node at point")) - ;; take id from current node or reference - (setq id (if search-ref - (org-index--id-from-ref search-ref) - (org-id-get))) + ((eq command 'ping) - ;; move up until we find a node in index - (save-excursion - (outline-back-to-heading) - (while (not (or info - reached-top)) - (if id - (setq info (org-index--on 'id id - (mapcar (lambda (x) (org-index--get-or-set-field x)) - (list 'ref 'count 'created 'last-accessed 'category 'keywords 'ref))))) + (let ((moved-up 0) id info reached-top) - (setq reached-top (= (org-outline-level) 1)) + (unless (string= major-mode "org-mode") (error "No node at point")) + ;; take id from current node or reference + (setq id (if search-ref + (org-index--id-from-ref search-ref) + (org-id-get))) - (unless (or info - reached-top) - (outline-up-heading 1 t) - (incf moved-up)) + ;; move up until we find a node in index + (save-excursion + (outline-back-to-heading) + (while (not (or info + reached-top)) + (if id + (setq info (org-index--on 'id id + (mapcar (lambda (x) (org-index--get-or-set-field x)) + (list 'ref 'count 'created 'last-accessed 'category 'keywords 'ref))))) - (setq id (org-id-get)))) - - (if info - (progn - (setq message-text - (apply 'format - (append (list "'%s'%shas been accessed %s times between %s and %s; category is '%s', keywords are '%s'" - (pop info) - (if (> moved-up 0) (format " (parent node, %d level up) " moved-up) " ")) - info))) - (setq kill-new-text (car (last info)))) - (setq message-text "Neither this node nor any of its parents is part of index")))) - - - ((eq command 'occur) - - (set-buffer org-index--buffer) - (org-index--do-occur)) - - - ((eq command 'ref) - - (let (new) - - ;; add a new row - (setq new (org-index--create-new-line)) - - ;; fill special columns with standard values - (org-table-goto-column (org-index--column-num 'ref)) - (insert new) - (setq org-index--last-ref new) - - ;; goto point-field or first empty one or first field - (if (org-index--special-column 'point-on-add) - (org-table-goto-column (org-index--column-num (org-index--special-column 'point-on-add))) - (unless (catch 'empty - (dotimes (col org-index--numcols) - (org-table-goto-column (+ col 1)) - (if (string= (org-trim (org-table-get-field)) "") - (throw 'empty t)))) - ;; none found, goto first - (org-table-goto-column 1))) - - (if org-index--active-region (setq kill-new-text org-index--active-region)) - (setq message-text (format "Adding a new row with ref '%s'" new)))) - - - ((eq command 'sort) - - (let ((columns (list "ref" "count" "created" "last-accessed" "id")) - sort groups-and-counts) - - (cond - ((eq sort-what 'index) - (setq sort - (intern - (org-icompleting-read - "Please choose column to sort index table: " - (append (copy-list columns) (list "group-by")) - nil t nil nil (symbol-name (org-index--special-column 'sort))))) - - (when (eq sort 'group-by) - (setq sort - (intern - (org-icompleting-read - "Please choose column to group index table by: " - columns - nil t nil nil (symbol-name (org-index--special-column 'sort))))) - (setq groups-and-counts (org-index--collect-sort-groups sort))) - - (org-index--do-sort-index sort (first groups-and-counts)) - (org-table-goto-column (org-index--column-num sort)) - ;; When saving index, it should again be sorted correctly - (with-current-buffer org-index--buffer - (add-hook 'before-save-hook 'org-index--sort-silent t)) - - (setq message-text - (format - (concat "Your index has been sorted temporarily by %s and will be sorted again by %s after %d seconds of idle time" - (if groups-and-counts - "; %d groups with equal %s and a total of %d lines have been found" - "")) - (symbol-name sort) - (org-index--special-column 'sort) - org-index--sort-idle-delay - (second groups-and-counts) - (symbol-name sort) - (third groups-and-counts)))) - - ((memq sort-what '(region buffer)) - (org-index--do-sort-lines sort-what) - (setq message-text (format "Sorted %s by contained references" sort-what)))))) - - - ((eq command 'highlight) - - (let ((where "buffer")) - (save-excursion - (save-restriction - (when (and transient-mark-mode - mark-active) - (narrow-to-region (region-beginning) (region-end)) - (setq where "region")) - - (if arg - (progn - (unhighlight-regexp org-index--ref-regex) - (setq message-text (format "Removed highlights for references in %s" where))) - (highlight-regexp org-index--ref-regex 'isearch) - (setq message-text (format "Highlighted references in %s" where))))))) + (setq reached-top (= (org-outline-level) 1)) + (unless (or info + reached-top) + (outline-up-heading 1 t) + (cl-incf moved-up)) - ((eq command 'maintain) - (setq message-text (org-index--do-maintain))) + (setq id (org-id-get)))) - - ((eq command 'example) + (if info + (progn + (setq message-text + (apply 'format + (append (list "'%s'%shas been accessed %s times between %s and %s; category is '%s', keywords are '%s'" + (pop info) + (if (> moved-up 0) (format " (parent node, %d level up) " moved-up) " ")) + info))) + (setq kill-new-text (car (last info)))) + (setq message-text "Neither this node nor any of its parents is part of index")))) - (if (y-or-n-p "This assistant will help you to create a temporary index with detailed comments.\nDo you want to proceed ? ") - (org-index--create-index t))) + ((eq command 'occur) - (t (error "Unknown subcommand '%s'" command))) + (set-buffer org-index--buffer) + (org-index--do-occur)) - ;; tell, what we have done and what can be yanked - (if kill-new-text (setq kill-new-text - (substring-no-properties kill-new-text))) - (if (string= kill-new-text "") (setq kill-new-text nil)) - (let ((m (concat - message-text - (if (and message-text kill-new-text) - " and r" - (if kill-new-text "R" "")) - (if kill-new-text (format "eady to yank '%s'." kill-new-text) (if message-text "." ""))))) - (unless (string= m "") - (message m) - (setq org-index--message-text m))) - (if kill-new-text (kill-new kill-new-text)))) + ((eq command 'ref) + (let (args) -(defun org-index-default-keybindings (&optional prefix) - "Set default keybindings for `org-index'. + (setq args (org-index--collect-values-from-user org-index-edit-on-ref)) + (setq args (plist-put args 'category "yank")) + (setq args (plist-put args 'ref org-index--nextref)) + (apply 'org-index--do-new-line args) -Invoke subcommands of org index with a single key -sequence. Establish the common prefix key 'C-c i' which should be -followed by the first letter of a subcommand. + (setq kill-new-text org-index--nextref) -The ist of letters and subcommands is specified in within -`org-index-default-keybindings-list'. - -See `org-index' for a description of all subcommands. + (setq message-text (format "Added new row with ref '%s'" org-index--nextref)))) -Optional argument PREFIX specifies common prefix, defaults to 'C-c i'" - (interactive) - (define-prefix-command 'org-index--keymap) - ;; prefix command - (global-set-key (kbd (or prefix "C-c i")) 'org-index--keymap) - ;; loop over subcommands - (mapcar - (lambda (x) - ;; loop over letters, that invoke the same subcommand - (mapcar (lambda (c) - (define-key org-index--keymap (kbd (char-to-string c)) - `(lambda (arg) (interactive "P") - (message nil) - (org-index ,(cdr x) nil arg)))) - (car x))) - org-index-default-keybindings-list)) + ((eq command 'yank) + + (let (args) + + (setq args (org-index--collect-values-from-user org-index-edit-on-yank)) + (if (plist-get args 'yank) + (plist-put args 'yank (replace-regexp-in-string "|" "\\vert" (plist-get args 'yank) nil 'literal))) + (setq args (plist-put args 'category "yank")) + (apply 'org-index--do-new-line args) + + (setq message-text "Added new row with text to yank"))) + + + ((eq command 'column) + + (if (and org-index--within-index-node + (org-at-table-p)) + (let (char col num) + (setq char (read-char "Please specify, which column to go to (r=ref, k=keywords, c=category, y=yank): ")) + (unless (memq char (list ?r ?k ?c ?y)) + (error (format "Invalid char '%c', cannot goto this column" char))) + (setq col (cdr (assoc char '((?r . ref) (?k . keywords) (?c . category) (?y . yank))))) + (setq num (org-index--column-num col)) + (if num + (progn + (org-table-goto-column num) + (setq message-text (format "At column %s" (symbol-name col)))) + + (error (format "Column '%s' is not present" col)))) + (error "Need to be in index table to go to a specific column"))) + + + ((eq command 'edit) + + (setq message-text (org-index--do-edit))) + + + ((eq command 'sort) + + (let ((sorts (list "count" "last-accessed" "mixed" "id" "ref")) + sort groups-and-counts) + + (cond + ((eq sort-what 'index) + (setq sort + (intern + (completing-read + "Please choose column to sort index table: " + (cl-copy-list sorts) + nil t nil nil (symbol-name org-index-sort-by)))) + + (org-index--do-sort-index sort) + (org-table-goto-column (org-index--column-num (if (eq sort 'mixed) 'last-access sort))) + ;; When saving index, it should again be sorted correctly + (with-current-buffer org-index--buffer + (add-hook 'before-save-hook 'org-index--sort-silent t)) + + (setq message-text + (format + (concat "Your index has been sorted temporarily by %s and will be sorted again by %s after %d seconds of idle time" + (if groups-and-counts + "; %d groups with equal %s and a total of %d lines have been found" + "")) + (symbol-name sort) + org-index-sort-by + org-index--sort-idle-delay + (second groups-and-counts) + (symbol-name sort) + (third groups-and-counts)))) + + ((memq sort-what '(region buffer)) + (org-index--do-sort-lines sort-what) + (setq message-text (format "Sorted %s by contained references" sort-what)))))) + + + ((eq command 'highlight) + + (let ((where "buffer")) + (save-excursion + (save-restriction + (when (and transient-mark-mode + mark-active) + (narrow-to-region (region-beginning) (region-end)) + (setq where "region")) + + (if arg + (progn + (unhighlight-regexp org-index--ref-regex) + (setq message-text (format "Removed highlights for references in %s" where))) + (highlight-regexp org-index--ref-regex 'isearch) + (setq message-text (format "Highlighted references in %s" where))))))) + + + ((eq command 'maintain) + (setq message-text (org-index--do-maintain))) + + + ((eq command 'example) + + (if (y-or-n-p "This assistant will help you to create a temporary index with detailed comments.\nDo you want to proceed ? ") + (org-index--create-index t))) + + + ((not command) (setq message-text "No command given")) + + + (t (error "Unknown subcommand '%s'" command))) + + + ;; tell, what we have done and what can be yanked + (if kill-new-text (setq kill-new-text + (substring-no-properties kill-new-text))) + (if (string= kill-new-text "") (setq kill-new-text nil)) + (let ((m (concat + message-text + (if (and message-text kill-new-text) + " and r" + (if kill-new-text "R" "")) + (if kill-new-text (format "eady to yank '%s'." kill-new-text) (if message-text "." ""))))) + (unless (string= m "") + (message m) + (setq org-index--message-text m))) + (if kill-new-text (kill-new kill-new-text))))) + + +(defun org-index-dispatch (&optional arg) + "Read additional chars and call subcommands of `org-index'. +Can be bound in global keyboard map as central entry point. +Optional argument ARG is passed on." + (interactive "P") + (let (char command) + (if (sit-for 1) + (message "org-index (? for detailed prompt) -")) + (setq char (key-description (read-key-sequence nil))) + (if (string= char "C-g") (keyboard-quit)) + (if (string= char "SPC") (setq char "?")) + (setq command (cdr (assoc char (org-index--get-shortcut-chars)))) + (unless command + (message "No subcommand for '%s'; switching to detailed prompt" char) + (sit-for 1) + (setq command 'short-help)) + (org-index command nil arg))) (defun org-index-new-line (&rest keys-values) @@ -762,60 +888,317 @@ Example: Optional argument KEYS-VALUES specifies content of new line." - (org-index--verify-id) - (org-index--parse-table) + (let ((ref (plist-get keys-values 'ref))) + (org-index--verify-id) + (org-index--parse-table) + (if (not (memq ref '(t nil))) + (error "Column 'ref' accepts only 't' or 'nil'")) + (when ref + (setq ref org-index--nextref) + (setq keys-values (plist-put keys-values 'ref ref))) + + (apply 'org-index--do-new-line keys-values) + ref)) + + +(defun org-index--read-command (&optional with-short-help) + "Read subcommand for ‘org-index’ from minibuffer. +Optional argument WITH-SHORT-HELP displays help screen upfront." + (let (minibuffer-scroll-window + minibuffer-setup-fun + command) + (setq org-index--short-help-displayed nil) + (add-hook 'minibuffer-setup-hook 'org-index--minibuffer-setup-function) + (add-hook 'minibuffer-exit-hook 'org-index--minibuffer-exit-function) + (unwind-protect + (setq command + (intern + (completing-read + (concat + "Please choose" + (if org-index--display-short-help "" " (? for short help)") + ": ") + (mapcar 'symbol-name org-index--commands) nil t))) + (remove-hook 'minibuffer-setup-hook 'org-index--minibuffer-setup-function) + (remove-hook 'minibuffer-exit-hook 'org-index--minibuffer-exit-function) + (when org-index--short-help-displayed + (quit-windows-on org-index--short-help-buffer-name))) + command)) + + +(defun org-index--minibuffer-setup-function () + "Prepare minibuffer for `org-index--read-command'." + (setq org-index--minibuffer-saved-key (local-key-binding (kbd "?"))) + (local-set-key (kbd "?") 'org-index--display-short-help) + (if org-index--display-short-help (org-index--display-short-help))) + + +(defun org-index--minibuffer-exit-function () + "Restore minibuffer after `org-index--read-command'." + (local-set-key (kbd "?") org-index--minibuffer-saved-key) + (setq org-index--minibuffer-saved-key nil)) + + +(defun org-index--display-short-help () + "Helper function to show help in minibuffer." + (interactive) + + (with-temp-buffer-window + org-index--short-help-buffer-name nil nil + (setq org-index--short-help-displayed t) + (princ "Short help; all subcommands of `org-index', shortcuts in []\n") + (princ (org-index--get-short-help-text))) + (with-current-buffer org-index--short-help-buffer-name + (let ((inhibit-read-only t) + height-before height-after win) + (setq win (get-buffer-window)) + (setq height-before (window-height win)) + (shrink-window-if-larger-than-buffer win) + (setq height-after (window-height win)) + (goto-char (point-min)) + (end-of-line) + (insert + (if (> height-before height-after) + "." + (concat ", " + (substitute-command-keys "\\[scroll-other-window]") + " to scroll:"))) + (goto-char (point-min))))) + + +(defun org-index--get-short-help-text () + "Extract text for short help message from long help." + (or org-index--short-help-text + (with-temp-buffer + (insert (documentation 'org-index)) + (goto-char (point-min)) + (search-forward (concat " " (symbol-name (first org-index--commands)) ": ")) + (forward-line 0) + (kill-region (point-min) (point)) + (search-forward (concat " " (symbol-name (car (last org-index--commands))) ": ")) + (forward-line 1) + (kill-region (point) (point-max)) + (keep-lines "^ [-a-z]+:" (point-min) (point-max)) + (align-regexp (point-min) (point-max) "\\(\\s-*\\):") + (goto-char (point-min)) + (while (re-search-forward "\\. *$" nil t) + (replace-match "" nil nil)) + (goto-char (point-min)) + (re-search-forward "short-help") + (end-of-line) + (insert " (this text)") + (goto-char (point-min)) + (unless (= (line-number-at-pos (point-max)) (1+ (length org-index--commands))) + (error "Internal error, unable to properly extract one-line descriptions of subcommands")) + (setq org-index--short-help-text (buffer-string))))) + + +(defun org-index--get-shortcut-chars () + "Collect shortcut chars from short help message." + (or org-index--shortcut-chars + (with-temp-buffer + (insert (org-index--get-short-help-text)) + (goto-char (point-min)) + (while (< (point) (point-max)) + (when (looking-at "^ \\([-a-z]+\\) +: +\\[\\([a-z?]\\)\\] ") + (setq org-index--shortcut-chars + (cons (cons (match-string 2) (intern (match-string 1))) + org-index--shortcut-chars))) + (forward-line 1)) + (unless (> (length org-index--shortcut-chars) 0) + (error "Internal error, did not find shortcut chars")) + org-index--shortcut-chars))) + + +(defun org-index--do-edit () + "Perform command edit." + (let ((maxlen 0) cols-vals buffer-keymap field-keymap keywords-pos val) + + (setq org-index--context-node nil) + (setq org-index--context-occur nil) + + ;; change to index, if whithin occur + (if org-index--within-occur + (let ((pos (get-text-property (point) 'org-index-lbp))) + (org-index--occur-test-stale pos) + (setq org-index--context-occur (cons (point) (org-index--line-in-canonical-form))) + (set-buffer org-index--buffer) + (goto-char pos)) + + ;; change to index, if still not within + (if (not org-index--within-index-node) + (let ((id (org-id-get))) + (setq org-index--context-node (cons (current-buffer) (point))) + (set-buffer org-index--buffer) + (unless (and id (org-index--go 'id id)) + (setq org-index--context-node nil) + (error "This node is not in index"))))) + + ;; retrieve current content of index line + (dolist (col (mapcar 'car (reverse org-index--columns))) + (if (> (length (symbol-name col)) maxlen) + (setq maxlen (length (symbol-name col)))) + (setq val (org-index--get-or-set-field col)) + (if (and val (eq col 'yank)) (setq val (replace-regexp-in-string (regexp-quote "\\vert") "|" val nil 'literal))) + (setq cols-vals (cons (cons col val) + cols-vals))) + + ;; we need two different keymaps + (setq buffer-keymap (make-sparse-keymap)) + (set-keymap-parent buffer-keymap widget-keymap) + (define-key buffer-keymap (kbd "C-c C-c") 'org-index--edit-c-c-c-c) + (define-key buffer-keymap (kbd "C-c C-k") 'org-index--edit-c-c-c-k) + + (setq field-keymap (make-sparse-keymap)) + (set-keymap-parent field-keymap widget-field-keymap) + (define-key field-keymap (kbd "C-c C-c") 'org-index--edit-c-c-c-c) + (define-key field-keymap (kbd "C-c C-k") 'org-index--edit-c-c-c-k) + + ;; prepare buffer + (setq org-index--context-index (cons (point) (org-index--line-in-canonical-form))) + (if (get-buffer org-index--edit-buffer-name) (kill-buffer org-index--edit-buffer-name)) + (switch-to-buffer (get-buffer-create org-index--edit-buffer-name)) + + ;; create and fill widgets + (setq org-index--edit-widgets nil) + (widget-insert "Edit this line from index; type C-c C-c when done, C-c C-k to abort.\n\n") + (dolist (col-val cols-vals) + (if (eq (car col-val) 'keywords) (setq keywords-pos (point))) + (setq org-index--edit-widgets (cons + (cons (car col-val) + (widget-create 'editable-field + :format (format (format "%%%ds: %%%%v" maxlen) (symbol-name (car col-val))) + :keymap field-keymap + (or (cdr col-val) ""))) + org-index--edit-widgets))) + + (widget-setup) + (goto-char keywords-pos) + (beginning-of-line) + (forward-char (+ maxlen 2)) + (use-local-map buffer-keymap) + "Editing a single line from index")) + + +(defun org-index--edit-c-c-c-c () + "Function to invoked on C-c C-c in Edit buffer." + (interactive) - (car (apply 'org-index--do-new-line keys-values))) + (let ((obuf (get-buffer org-index--occur-buffer-name)) + val line) + + ;; Time might have passed + (org-index--refresh-parse-table) + + (with-current-buffer org-index--buffer + + ;; check, if buffer has become stale + (save-excursion + (goto-char (car org-index--context-index)) + (unless (string= (cdr org-index--context-index) + (org-index--line-in-canonical-form)) + (switch-to-buffer org-index--edit-buffer-name) + (error "Index table has changed: Cannot find line, that this buffer is editing"))) + + (pop-to-buffer-same-window org-index--buffer) + (goto-char (car org-index--context-index)) + + ;; write back line to index + (dolist (col-widget org-index--edit-widgets) + (setq val (widget-value (cdr col-widget))) + (if (eq (car col-widget) 'yank) (setq val (replace-regexp-in-string "|" (regexp-quote "\\vert") val))) + (org-index--get-or-set-field (car col-widget) val)) + + (setq line (org-index--align-and-fontify-current-line)) + (beginning-of-line)) + + ;; write line to occur if appropriate + (if org-index--context-occur + (if obuf + (if (string= (cdr org-index--context-index) + (cdr org-index--context-occur)) + (progn + (pop-to-buffer-same-window obuf) + (goto-char (car org-index--context-occur)) + (beginning-of-line) + (let ((inhibit-read-only t)) + (delete-region (line-beginning-position) (line-end-position)) + (insert line) + (put-text-property (line-beginning-position) (line-end-position) + 'org-index-lbp (cdr org-index--context-index)))) + (error "Occur buffer and index buffer do not match any longer")) + (message "Occur buffer has gone, cannot switch back.")) + (setq org-index--context-occur nil)) + + ;; return to node, if invoked from there + (when org-index--context-node + (pop-to-buffer-same-window (car org-index--context-node)) + (goto-char (cdr org-index--context-node))) + + ;; clean up + (kill-buffer org-index--edit-buffer-name) + (setq org-index--context-index nil) + (setq org-index--edit-widgets nil) + (beginning-of-line) + (message "Index line has been edited."))) + + +(defun org-index--edit-c-c-c-k () + "Function invoked on C-c C-k in Edit buffer." + (interactive) + (kill-buffer org-index--edit-buffer-name) + (setq org-index--context-index nil) + (setq org-index--edit-widgets nil) + (beginning-of-line) + (message "Edit aborted.")) (defun org-index--do-new-line (&rest keys-values) "Do the work for `org-index-new-line'. Optional argument KEYS-VALUES specifies content of new line." - (save-excursion - (org-index--retrieve-context) - (with-current-buffer org-index--buffer - (goto-char org-index--point) + (org-index--retrieve-context) + (with-current-buffer org-index--buffer + (goto-char org-index--point) - ;; check arguments early; they might come from lisp-user + ;; check arguments early; they might come from userland + (let ((kvs keys-values) + k v) + (while kvs + (setq k (car kvs)) + (setq v (cadr kvs)) + (if (or (not (symbolp k)) + (and (symbolp v) (not (eq v t)) (not (eq v nil)))) + (error "Arguments must be alternation of key and value")) + (unless (org-index--column-num k) + (error "Unknown column or column not defined in table: '%s'" (symbol-name k))) + (setq kvs (cddr kvs)))) + + (let (yank) + ;; create new line + (org-index--create-new-line) + + ;; fill columns (let ((kvs keys-values) k v) (while kvs (setq k (car kvs)) (setq v (cadr kvs)) - (if (eq k 'ref) - (unless (memq v '(t nil)) - (error "Column 'ref' accepts only \"t\" or \"nil\"")) - (if (or (not (symbolp k)) - (and (symbolp v) (not (eq v t)) (not (eq v nil)))) - (error "Arguments must be alternation of key and value"))) - (unless (org-index--column-num k) - (error "Unknown column or column not defined in table: '%s'" (symbol-name k))) + (org-table-goto-column (org-index--column-num k)) + (insert (org-trim (or v ""))) (setq kvs (cddr kvs)))) - (let (ref yank) - ;; create new line - (setq ref (org-index--create-new-line)) - (plist-put keys-values 'ref ref) + ;; align and fontify line + (org-index--promote-current-line) + (org-index--align-and-fontify-current-line) - ;; fill columns - (let ((kvs keys-values) - k v n) - (while kvs - (setq k (car kvs)) - (setq v (cadr kvs)) - (org-table-goto-column (org-index--column-num k)) - (insert (org-trim v)) - (setq kvs (cddr kvs)))) + ;; remember fingerprint to be able to return + (setq org-index--last-fingerprint (org-index--get-or-set-field 'fingerprint)) - ;; align and fontify line - (org-index--promote-current-line) - (org-index--align-and-fontify-current-line) - - ;; get column to yank - (setq yank (org-index--get-or-set-field (org-index--special-column 'yank-after-add))) + ;; get column to yank + (setq yank (org-index--get-or-set-field org-index-yank-after-add)) - (cons ref yank))))) + yank))) (defun org-index-get-line (column value) @@ -839,7 +1222,7 @@ argument VALUE specifies the value to search for." (unless value (error "Need a value to search for")) - + (org-index--verify-id) (org-index--parse-table) @@ -860,18 +1243,6 @@ Argument COLUMN and VALUE specify line to get." content)) -(defun org-index--delete-line (id) - "Delete a line specified by ID." - (let (content) - (org-index--on - 'id id - (let ((start (line-beginning-position))) - (beginning-of-line) - (forward-line) - (delete-region start (point)) - t)))) - - (defun org-index--ref-from-id (id) "Get reference from line ID." (org-index--on 'id id (org-index--get-or-set-field 'ref))) @@ -882,27 +1253,35 @@ Argument COLUMN and VALUE specify line to get." (org-index--on 'ref ref (org-index--get-or-set-field 'id))) -(defun org-index--read-search-for-enter () - "Special input routine for command enter." - ;; Accept single char commands or switch to reading a sequence of digits - (let (char prompt search-ref search-id) - - ;; start with short prompt but give more help on next iteration - (setq prompt "Please specify, where to go in index (0-9.,space,backspace,return or ? for help): ") - - ;; read one character - (while (not (memq char (append (number-sequence ?0 ?9) (list ?\d ?\b ?\r ?\j ?\s ?.)))) - (setq char (read-char prompt)) - (setq prompt "Go to index table and specific position. Digits specify a reference number to got to, <space> goes to top of index, <backspace> or <delete> to last line created and <return> or `.' to index line of current node. Please choose: ")) - - (if (memq char (number-sequence ?0 ?9)) - ;; read rest of digits - (setq search-ref (read-from-minibuffer "Search reference number: " (char-to-string char)))) - ;; decode single chars - (if (memq char '(?\r ?\n ?.)) (setq search-id (org-id-get))) - (if (memq char '(?\d ?\b)) (setq search-ref (number-to-string org-index--maxref))) - - (cons search-ref search-id))) +(defun org-index--get-fingerprint () + "Get fingerprint of current line." + (replace-regexp-in-string + "\\s " "" + (mapconcat (lambda (x) (org-index--get-or-set-field x)) '(id ref yank keywords created) ""))) + + +(defun org-index--read-search-for-index () + "Special input routine for command index." + + ;; Accept single char commands or switch to reading a sequence of digits + (let (char prompt search-ref search-id search-fingerprint) + + ;; start with short prompt but give more help on next iteration + (setq prompt "Please specify, where to go in index (0-9,.,space,backspace,return or ? for short help) - ") + + ;; read one character + (while (not (memq char (append (number-sequence ?0 ?9) (list ?\d ?\b ?\r ?\j ?\s ?.)))) + (setq char (read-char prompt)) + (setq prompt "Go to specific position in index table. Digits specify a reference number, <space> goes to top of index, <backspace> or <delete> to last line created and <return> or `.' to index line of current node. Please choose - ")) + + (if (memq char (number-sequence ?0 ?9)) + ;; read rest of digits + (setq search-ref (read-from-minibuffer "Search reference number: " (char-to-string char)))) + ;; decode single chars + (if (memq char '(?\r ?\n ?.)) (setq search-id (org-id-get))) + (if (memq char '(?\d ?\b)) (setq search-fingerprint org-index--last-fingerprint)) + + (list search-ref search-id search-fingerprint))) (defun org-index--verify-id () @@ -911,9 +1290,10 @@ Argument COLUMN and VALUE specify line to get." ;; Check id (unless org-index-id (let ((answer (org-completing-read "Cannot find an index (org-index-id is not set). You may:\n - read-help : to learn more about org-index\n - create-index : invoke an assistant to create an initial index\nPlease choose: " (list "read-help" "create-index") nil t nil nil "read-help"))) - (if (string= "create-index" answer) + (if (string= answer "create-index") (org-index--create-missing-index "Variable org-index-id is not set, so probably no index table has been created yet.") - (describe-function 'org-index)))) + (describe-function 'org-index) + (throw 'new-index nil)))) ;; Find node (let (marker) @@ -943,8 +1323,9 @@ Argument COLUMN and VALUE specify line to get." (beginning-of-line) (org-get-category (point) t))) - ;; Find out, if we are within index table or not - (setq org-index--within-node (string= (org-id-get) org-index-id))) + ;; Find out, if we are within index table or occur buffer + (setq org-index--within-index-node (string= (org-id-get) org-index-id)) + (setq org-index--within-occur (string= (buffer-name) org-index--occur-buffer-name))) (defun org-index--parse-table () @@ -958,7 +1339,7 @@ Argument COLUMN and VALUE specify line to get." (with-current-buffer org-index--buffer - (setq org-index--maxref 0) + (setq org-index--maxrefnum 0) (setq initial-point (point)) (org-index--go-below-hline) @@ -974,9 +1355,8 @@ Argument COLUMN and VALUE specify line to get." (org-index--go-below-hline) (setq org-index--aligned t) (set-buffer-modified-p is-modified))) - + (org-index--go-below-hline) - (setq org-index--below-hline (point-marker)) (beginning-of-line) ;; get headings to display during occur @@ -1001,7 +1381,6 @@ Argument COLUMN and VALUE specify line to get." ;; parse list of flags (goto-char org-index--point) - (org-index--parse-flags) ;; Retrieve any decorations around the number within the first nonempty ref-field (goto-char org-index--below-hline) @@ -1025,41 +1404,54 @@ Argument COLUMN and VALUE specify line to get." (regexp-quote org-index--tail))) (setq org-index--ref-format (concat org-index--head "%d" org-index--tail)) + ;; check if the table still seems to be sorted mixed + (goto-char org-index--below-hline) + (when (eq org-index-sort-by 'mixed) + (org-index--go-below-hline) + (if (string< (org-index--get-or-set-field 'last-accessed) + (org-index--get-mixed-time)) + (org-index--do-sort-index org-index-sort-by))) + ;; Go through table to find maximum number and do some checking - (let ((ref 0)) + (let ((refnum 0)) (while (org-at-table-p) (setq ref-field (org-index--get-or-set-field 'ref)) (setq id-field (org-index--get-or-set-field 'id)) - (when (and (not ref-field) - (not id-field)) - (kill-whole-line) - (message "Removing line from index-table with both ref and id empty")) - (if ref-field (if (string-match org-index--ref-regex ref-field) ;; grab number - (setq ref (string-to-number (match-string 1 ref-field))) + (setq refnum (string-to-number (match-string 1 ref-field))) (kill-whole-line) (message "Removing line from index-table whose ref does not contain a number"))) ;; check, if higher ref - (if (> ref org-index--maxref) (setq org-index--maxref ref)) + (if (> refnum org-index--maxrefnum) (setq org-index--maxrefnum refnum)) (forward-line 1))) + (setq org-index--nextref (format "%s%d%s" org-index--head (1+ org-index--maxrefnum) org-index--tail)) ;; go back to initial position (goto-char initial-point)))) +(defun org-index--refresh-parse-table () + "Fast refresh of selected results of parsing index table." + + (setq org-index--point (marker-position (org-id-find org-index-id 'marker))) + (with-current-buffer org-index--buffer + (save-excursion + (org-index--go-below-hline)))) + + (defun org-index--do-maintain () "Choose among and perform some tasks to maintain index." (let ((check-what) (max-mini-window-height 1.0) message-text) - (setq check-what (intern (org-completing-read "These checks and fixes are available:\n - statistics : compute statistics about index table\n - check : check ids by visiting their nodes\n - duplicates : check index for duplicate rows (any column)\n - clean : remove obsolete property org-index-id\n - update : update content of index lines, with an id \nPlease choose: " (list "statistics" "check" "duplicates" "clean" "update") nil t nil nil "statistics"))) + (setq check-what (intern (org-completing-read "These checks and fixes are available:\n - statistics : compute statistics about index table\n - check : check ids by visiting their nodes\n - duplicates : check index for duplicate rows (ref or id)\n - clean : remove obsolete property org-index-id\n - update : update content of index lines, with an id \nPlease choose: " (list "statistics" "check" "duplicates" "clean" "update") nil t nil nil "statistics"))) (message nil) - + (cond ((eq check-what 'check) (setq message-text (or (org-index--check-ids) @@ -1069,43 +1461,53 @@ Argument COLUMN and VALUE specify line to get." (setq message-text (org-index--do-statistics))) ((eq check-what 'duplicates) - (setq message-text "Finding duplcates can be done by sorting your index appropriately: Choose 'group-by' and select a column; rows will then be sorted together, if they have the same value within the coosen column.")) + (setq message-text (org-index--find-duplicates))) ((eq check-what 'clean) (let ((lines 0)) (org-map-entries (lambda () (when (org-entry-get (point) "org-index-ref") - (incf lines) + (cl-incf lines) (org-entry-delete (point) "org-index-ref"))) nil 'agenda) (setq message-text (format "Removed property 'org-index-ref' from %d lines" lines)))) - + ((eq check-what 'update) - (if (y-or-n-p "Updating your index will overwrite certain columns with content from the associated heading and category. If unsure, you may try this for a single, already existing line of your index by doing `add' from within your index. Are you SURE to proceed for ALL INDEX LINES ? ") + (if (y-or-n-p "Updating your index will overwrite certain columns with content from the associated heading and category. If unsure, you may try this for a single, already existing line of your index by invoking `add'. Are you SURE to proceed for ALL INDEX LINES ? ") (setq message-text (org-index--update-all-lines)) (setq message-text "Canceled.")))) message-text)) -(defun org-index--do-sort-index (sort &optional groups) - "Sort index table according to SORT, optinally with GROUPS." +(defun org-index--get-mixed-time () + "Get timestamp for sorting order mixed." + (format-time-string + (org-time-stamp-format t t) + (apply 'encode-time (append '(0 0 0) (nthcdr 3 (decode-time)))))) + + +(defun org-index--do-sort-index (sort) + "Sort index table according to SORT." (let ((is-modified (buffer-modified-p)) top bottom - ref-field - count-field) + mixed-time) (unless buffer-read-only - (message "Sorting table for %s..." (symbol-name sort)) + (message "Sorting index table for %s..." (symbol-name sort)) (undo-boundary) (let ((message-log-max nil)) ; we have just issued a message, dont need those of sort-subr + ;; if needed for mixed sort + (if (eq sort 'mixed) + (setq mixed-time (org-index--get-mixed-time))) + ;; get boundaries of table - (goto-char org-index--below-hline) + (org-index--go-below-hline) (forward-line 0) (setq top (point)) (while (org-at-table-p) (forward-line)) @@ -1116,11 +1518,12 @@ Argument COLUMN and VALUE specify line to get." (org-table-goto-column 1) (and (not (org-index--get-or-set-field 'ref)) - (not (org-index--get-or-set-field 'id)))) + (not (org-index--get-or-set-field 'id)) + (not (org-index--get-or-set-field 'yank)))) (org-table-kill-row)) (forward-line 1) (setq bottom (point)) - + ;; sort lines (save-restriction (narrow-to-region top bottom) @@ -1129,11 +1532,7 @@ Argument COLUMN and VALUE specify line to get." 'forward-line 'end-of-line (lambda () - (concat - (if groups - (format "%06d-" (cdr (assoc (org-index--get-or-set-field sort) groups))) - "") - (org-index--get-sort-key sort t))) + (org-index--get-sort-key sort t mixed-time)) nil 'string<) (goto-char (point-min)) @@ -1144,30 +1543,6 @@ Argument COLUMN and VALUE specify line to get." (setq org-index--last-sort sort)))) -(defun org-index--collect-sort-groups (sort) - "Collect groups to SORT for." - (let ((count-groups 0) (count-lines 0) - groups key key-value) - - (org-index--on - nil nil - (while (org-at-table-p) - (setq key (org-index--get-or-set-field sort)) - (setq key-value (assoc key groups)) - (if key-value - (progn - (incf (cdr key-value))) - (setq groups (cons (cons key 1) groups))) - (forward-line))) - - (mapc (lambda (x) (when (> (cdr x) 1) - (incf count-groups) - (incf count-lines (cdr x)))) - groups) - - (list groups count-groups count-lines))) - - (defun org-index--do-sort-lines (what) "Sort lines in WHAT according to contained reference." (save-restriction @@ -1193,8 +1568,7 @@ Argument COLUMN and VALUE specify line to get." (defun org-index--go-below-hline () "Move below hline in index-table." - (let ((count 0) - (errstring (format "index table within node %s" org-index-id))) + (let ((errstring (format "index table within node %s" org-index-id))) (goto-char org-index--point) @@ -1222,15 +1596,15 @@ Argument COLUMN and VALUE specify line to get." (unless (org-at-table-p) (org-index--report-index-error "Cannot find a hline within %s" errstring)) - (org-table-goto-column 1))) + (org-table-goto-column 1) + (setq org-index--below-hline (point)))) (defun org-index--parse-headings () "Parse headings of index table." - (let (field ;; field content - field-symbol ;; and as a symbol - found) + (let (field ;; field content + field-symbol) ;; and as a symbol (setq org-index--columns nil) @@ -1243,21 +1617,7 @@ Argument COLUMN and VALUE specify line to get." (error "Heading of column cannot be empty")) (if (and (not (string= (substring field 0 1) ".")) (not (member (intern field) org-index--valid-headings))) - - (if (string= field "link") - ;; Ask user to migrate his index to new version (since [2015-02-11 Mi]) - (progn - ;; pop to index buffer - (pop-to-buffer-same-window org-index--buffer) - (goto-char org-index--below-hline) - (org-reveal t) - ;; go to column - (while (org-at-table-p) - (forward-line -1)) - (forward-line) - (org-table-goto-column (+ 1 col)) - (error "Column 'link' should be named 'id' with recent versions of org-index,\nplease adjust your table (cursor is already positioned right)")) - (error "Column name '%s' is not a valid heading (custom headings may start with a dot, e.g. '.foo')" field))) + (error "Column name '%s' is not a valid heading (custom headings may start with a dot, e.g. '.foo')" field)) (setq field-symbol (intern field)) @@ -1274,142 +1634,13 @@ Argument COLUMN and VALUE specify line to get." (mapc (lambda (head) (unless (cdr (assoc head org-index--columns)) (org-index--report-index-error "No column has heading '%s'" head))) - org-index--required-headings)) - - -(defun org-index--parse-flags () - "Parse list of flags in index table." - - (let (parent parent-is-comment child) - - ;; reset configuration variables - (setq org-index--special-columns nil) - (setq org-index--flagged-columns nil) - - (org-index--goto-list "columns-and-flags" t) - (forward-line 1) - - ;; outer loop over columns - (while (and (setq parent (org-index--parse-list-item)) - parent - (> (cdr (assoc :indent parent)) 0)) - - (setq parent-is-comment (member (cdr (assoc :text parent)) '("all-columns-explained" "all-flags-explained"))) - - ;; check, that we have a valid heading - (unless (or parent-is-comment - (assoc (cdr (assoc :sym parent)) org-index--columns)) - (when (string= "link" (cdr (assoc :text parent))) - (pop-to-buffer-same-window org-index--buffer) - (org-reveal t) - (error "Flag 'link' should be named 'id' with recent versions of org-index,\nplease adjust this flag (cursor is already positioned right)")) - (org-index--report-index-error "'%s' appears within flags, but not as a index column. " (cdr (assoc :text parent)))) - - ;; inner loop over children - (while (and (forward-line 1) - (setq child (org-index--parse-list-item)) - child - (> (cdr (assoc :indent child)) - (cdr (assoc :indent parent)))) - - (unless parent-is-comment - ;; check, that we have a valid flag - (unless (memq (cdr (assoc :sym child)) org-index--all-flags) - (org-index--report-index-error "'%s' is not a valid flag" (cdr (assoc :text child)))) - - ;; process flag with respect to current index-column - (if (memq (cdr (assoc :sym child)) org-index--single-flags) - ;; Check, that none of org-index--single-flags appears twice - (if (assoc (cdr (assoc :sym child)) org-index--special-columns) - (org-index--report-index-error - "More than one column is marked with flag '%s'" (cdr (assoc :text child))) - ;; add it to list - (setq org-index--special-columns (cons (cons (cdr (assoc :sym child)) (cdr (assoc :sym parent))) - org-index--special-columns)))) - - ;; all flags are stored in org-index--flagged-columns - (let ((l (assoc (cdr (assoc :sym child)) org-index--flagged-columns))) ;; list of flag and columns, that carry this flag - (unless l - ;; no list of columns with this flag is present, create one - (setq org-index--flagged-columns - (cons (cons (cdr (assoc :sym child)) nil) - org-index--flagged-columns)) - (setq l (car org-index--flagged-columns))) - ;; prepend this column to list of columns with this flag - (setcdr l (cons (cdr (assoc :sym parent)) (cdr l))))))) - - ;; check, that all needed flags have been specified - (mapc (lambda (x) - (unless (assoc x org-index--special-columns) - (org-index--report-index-error "Required flag '%s' does not appear" (substring (symbol-name x) 1)))) - org-index--required-flags))) - - -(defun org-index--goto-list (name &optional required non-top) - "Goto list NAME (maybe NON-TOP Level) in index node, err if REQUIRED list is not present." - (goto-char org-index--point) - - ;; go to heading of node - (while (not (org-at-heading-p)) (forward-line -1)) - (forward-line 1) - - ;; go to named list - (while (and (not (let ((item (org-index--parse-list-item))) - (if item - (and (or non-top (= (cdr (assoc :indent item)) 0)) ;; accept only toplevel ? - (string= (cdr (assoc :text item)) name)) ;; with requested name - nil))) - (not (org-at-table-p)) - (not (org-at-heading-p)) - (not (eobp))) - (forward-line 1)) - - (if (org-at-item-p) - t - (if required - (org-index--report-index-error "Could not find required list '%s'" name) - nil))) - - -(defun org-index--parse-list-item () - "Parse a list item into an assoc array (indent, checkbox, text, value)." - - ;; matche full list-item, maybe with checkbox and double-colon - (if (looking-at org-list-full-item-re) - - ;; retrieve interesting parts of list item from match data - (let (indent checkbox text value next-line) - - (setq indent - (- (save-excursion (goto-char (match-beginning 1)) (current-column)) ; first column - (save-match-data (org-current-level)) ; indent-level - 1)) - (setq checkbox (match-string 3)) - (setq text (match-string 4)) - (set (if text 'value 'text) (buffer-substring (match-end 0) (line-end-position))) ; regexp did not capture this - - ;; peek ahead, if item continues on next line - (forward-line 1) - (if (looking-at org-list-full-item-re) - (forward-line -1) ; already at next item; go back - (setq next-line (buffer-substring (line-beginning-position) (line-end-position)))) - - ;; clean up strings - (mapc (lambda (x) - (if (stringp (symbol-value x)) - (set x (org-trim (substring-no-properties (symbol-value x)))))) - '(text value next-line)) - - (if next-line (setq text (concat text " " next-line))) ; append next line if - - (list (cons :indent indent) (cons :text text) (cons :value value) (cons :sym (intern text)))) - nil)) + org-index--valid-headings)) (defun org-index--create-missing-index (&rest reasons) "Create a new empty index table with detailed explanation. Argument REASONS explains why." - (org-index--ask-before-create-index "Cannot find your index table: " + (org-index--ask-before-create-index "Cannot find index table: " "new permanent" "." reasons) (org-index--create-index)) @@ -1435,7 +1666,7 @@ Argument COLUMN and VALUE specify line to get." (setq reason (apply 'format reasons)) - (setq prompt (concat explanation reason "\n\n" + (setq prompt (concat explanation reason "\n" "However, this assistant can help you to create a " type " index with detailed comments" for-what "\n\n" "Do you want to proceed ?")) @@ -1468,10 +1699,12 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (setq buffer (get-buffer (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list)))))) - (setq title (read-from-minibuffer "Please enter the title of the index node: ")) + (setq title (read-from-minibuffer "Please enter the title of the index node (leave empty for default 'index'): ")) + (if (string= title "") (setq title "index")) (while (progn - (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: ")) + (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is an integer number preceeded by some and optionally followed by some non-numeric chars; e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose (leave empty for default 'R1'): ")) + (if (string= firstref "") (setq firstref "R1")) (let (desc) (when (string-match "[[:blank:]]" firstref) (setq desc "Contains whitespace")) @@ -1498,28 +1731,26 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (if temporary (insert " Below you find your temporary index table, which WILL NOT LAST LONGER - THAN YOUR CURRENT EMACS SESSION. + THAN YOUR CURRENT EMACS SESSION; please use it only for evaluation. ") (insert " Below you find your initial index table, which will grow over time. ")) - (insert " - You may start using it by adding some lines. Just move to - another heading, invoke `org-index' and choose the command - 'add'. After adding a few nodes, try the command 'occur' - to search among them. + (insert " You may start using it by adding some lines. Just + move to another heading within org, invoke `org-index' and + choose the command 'add'. After adding a few nodes, try the + command 'occur' to search among them. To gain further insight you may invoke the subcommand 'help', or - read the description of `org-index'. + (same content) read the help of `org-index'. - Within the index table below, dhe sequence of columns does not - matter. You may reorder them in any way you please. Columns are - found by their heading. You may also add your own columns, - which should start with a dot (e.g. '.custom'). + Within the index table below, the sequence of columns does not + matter. You may reorder them in any way you like. You may also + add your own columns, which should start with a dot + (e.g. '.my-column'). - Following this explanations you will find the item-list - `columns-and-flags', which influences the behaviour of - `org-index'. See the explanations which are part of this list. + Invoke `org-customize' to tweak the behaviour of org-index + (see the group org-index). This node needs not be a top level node; its name is completely at your choice; it is found through its ID only. @@ -1531,18 +1762,15 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (setq id (org-id-get-create)) (insert (format " -%s - - | ref | category | keywords | count | last-accessed | created | id | - | | | | | | | <4> | - |-----+-----------+----------+-------+---------------+---------+------| - | %s | | %s | | | %s | %s | + | ref | category | keywords | tags | count | level | last-accessed | created | id | yank | + | | | | | | | | | <4> | <4> | + |-----+----------+----------+------+-------+-------+---------------+---------+-----+------| + | %s | | %s | | | | | %s | %s | | " - org-index--sample-flags firstref - "This node" + title (with-temp-buffer (org-insert-time-stamp nil nil t)) id)) @@ -1577,8 +1805,10 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (org-id-goto id) (org-index--unfold-buffer) (if compare - (error "Please compare your existing index (upper window) and a temporary new one (lower window) to fix your index") - (message "This is your new temporary index."))) + (progn + (message "Please compare your existing index (upper window) and a temporary new one (lower window) to fix your index") + (throw 'new-index nil)) + (message "This is your new temporary index, use command add to populate, occur to search."))) (progn ;; Only show the new index (pop-to-buffer-same-window buffer) @@ -1588,12 +1818,14 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (if (y-or-n-p "This is your new index table. It is already set for this Emacs session, so you may try it out. Do you want to save its id to make it available for future Emacs sessions too ? ") (progn (customize-save-variable 'org-index-id id) - (error "Saved org-index-id '%s' to %s" id (or custom-file - user-init-file))) + (message "Saved org-index-id '%s' to %s." id (or custom-file + user-init-file)) + (throw 'new-index nil)) (let (sq) (setq sq (format "(setq org-index-id \"%s\")" id)) (kill-new sq) - (error "Did not make the id of this new index permanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it" sq)))))))) + (message "Did not make the id of this new index permanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it." sq) + (throw 'new-index nil)))))))) (defun org-index--unfold-buffer () @@ -1604,31 +1836,31 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (save-excursion (org-back-to-heading) (forward-line) ;; on property drawer - (org-cycle) - (org-index--goto-list "columns-and-flags") (org-cycle))) -(defun org-index--update-line (&optional ref-or-id) - "Update columns count and last-accessed in line REF-OR-ID." +(defun org-index--update-line (&optional ref-or-id-or-pos) + "Update columns count and last-accessed in line REF-OR-ID-OR-POS." - (let ((newcount 0) - initial) + (let (initial) (with-current-buffer org-index--buffer (unless buffer-read-only ;; search reference or id, if given (or assume, that we are already positioned right) - (when ref-or-id + (when ref-or-id-or-pos (setq initial (point)) (goto-char org-index--below-hline) (while (and (org-at-table-p) - (not (or (string= ref-or-id (org-index--get-or-set-field 'ref)) - (string= ref-or-id (org-index--get-or-set-field 'id))))) + (not (if (integerp ref-or-id-or-pos) + (and (>= ref-or-id-or-pos (line-beginning-position)) + (< ref-or-id-or-pos (line-end-position))) + (or (string= ref-or-id-or-pos (org-index--get-or-set-field 'ref)) + (string= ref-or-id-or-pos (org-index--get-or-set-field 'id)))))) (forward-line))) (if (not (org-at-table-p)) - (error "Did not find reference or id '%s'" ref-or-id) + (error "Did not find reference or id '%s'" ref-or-id-or-pos) (org-index--update-current-line)) (if initial (goto-char initial)))))) @@ -1655,27 +1887,43 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (org-index--align-and-fontify-current-line))) -(defun org-index--align-and-fontify-current-line () - "Make current line blend well among others." - (let ((line (substring-no-properties (delete-and-extract-region (line-beginning-position) (line-end-position))))) - ;; create minimum table with fixed-width columns to align and fontiry new line +(defun org-index--align-and-fontify-current-line (&optional num) + "Make current line (or NUM lines) blend well among others." + (let (lines) + ;; get current content + (unless num (setq num 1)) + (setq lines (delete-and-extract-region (line-beginning-position) (line-end-position num))) + ;; create minimum table with fixed-width columns to align and fontify new line (insert (with-temp-buffer (org-set-font-lock-defaults) (insert org-index--headings-visible) - (goto-char (point-min)) ;; fill columns, so that aligning cannot shrink them + (goto-char (point-min)) (search-forward "|") - (replace-string " " "." nil (point) (line-end-position)) - (replace-string ".|." " | " nil (line-beginning-position) (line-end-position)) - (replace-string "|." "| " nil (line-beginning-position) (line-end-position)) + (while (search-forward " " (line-end-position) t) + (replace-match "." nil t)) + (goto-char (point-min)) + (while (search-forward ".|." (line-end-position) t) + (replace-match " | " nil t)) + (goto-char (point-min)) + (while (search-forward "|." (line-end-position) t) + (replace-match "| " nil t)) (goto-char (point-max)) - (insert line) + (insert lines) (forward-line 0) + (let ((start (point))) + (while (re-search-forward "^\s +|-" nil t) + (replace-match "| -")) + (goto-char start)) + (org-mode) (org-table-align) (font-lock-fontify-region (point-min) (point-max)) (goto-char (point-max)) - (forward-line -1) - (buffer-substring (line-beginning-position) (line-end-position)))))) + (if (eq -1 (skip-chars-backward "\n")) + (delete-char 1)) + (forward-line (- 1 num)) + (buffer-substring (line-beginning-position) (line-end-position num)))) + lines)) (defun org-index--promote-current-line () @@ -1694,7 +1942,7 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (not (org-at-table-hline-p)) (string< (org-index--get-sort-key) key)) - (incf to-skip) + (cl-incf to-skip) (forward-line -1)) (forward-line 1) @@ -1704,8 +1952,8 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (forward-line -1)))) -(defun org-index--get-sort-key (&optional sort with-ref) - "Get value for sorting from column SORT, optional WITH-REF." +(defun org-index--get-sort-key (&optional sort with-ref mixed-time) + "Get value for sorting from column SORT, optional WITH-REF; if mixes use MIXED-TIME." (let (ref ref-field key) @@ -1717,24 +1965,28 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin ;; get reference with leading zeroes, so it can be ;; sorted as text (setq ref-field (org-index--get-or-set-field 'ref)) - (string-match org-index--ref-regex ref-field) - (setq ref (format - "%06d" - (string-to-number - (or (match-string 1 ref-field) - "0"))))) + (if ref-field + (progn + (string-match org-index--ref-regex ref-field) + (setq ref (format + "%06d" + (string-to-number + (match-string 1 ref-field))))) + (setq ref "000000"))) (setq key (cond ((eq sort 'count) (format "%08d" (string-to-number (or (org-index--get-or-set-field 'count) "")))) + ((eq sort 'mixed) + (let ((last-accessed (org-index--get-or-set-field 'last-accessed))) + (unless mixed-time (setq mixed-time (org-index--get-mixed-time))) + (concat + (if (string< mixed-time last-accessed) last-accessed mixed-time) + (format "%08d" (string-to-number (or (org-index--get-or-set-field 'count) "")))))) ((eq sort 'ref) ref) - ((eq sort 'id) - (org-index--get-or-set-field sort)) - ((eq sort 'last-accessed) - (org-index--get-or-set-field sort)) - ((eq sort 'created) + ((memq sort '(id last-accessed created)) (org-index--get-or-set-field sort)) (t (error "This is a bug: unmatched case '%s'" sort)))) @@ -1747,7 +1999,11 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin "Retrieve field KEY from index table or set it to VALUE." (let (field) (save-excursion - (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value))) + (if (eq key 'fingerprint) + (progn + (if value (error "Internal error, pseudo-column fingerprint cannot be set")) + (setq field (org-index--get-fingerprint))) + (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value)))) (if (string= field "") (setq field nil)) (org-no-properties field)))) @@ -1760,68 +2016,112 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (cdr (assoc key org-index--columns)))) -(defun org-index--special-column (key) - "Return column (not a number) for special column KEY." - (cdr (assoc key org-index--special-columns))) +(defun org-index--make-guarded-search (ref &optional dont-quote) + "Make robust search string from REF; DONT-QUOTE it, if requested." + (concat "\\_<" (if dont-quote ref (regexp-quote ref)) "\\_>")) + + +(defun org-index--find-duplicates () + "Find duplicate references or ids in index table." + (let (ref-duplicates id-duplicates) + (setq ref-duplicates (org-index--find-duplicates-helper 'ref)) + (setq id-duplicates (org-index--find-duplicates-helper 'id)) + (goto-char org-index--below-hline) + (if (or ref-duplicates id-duplicates) + (progn + ;; show results + (pop-to-buffer-same-window + (get-buffer-create "*org-index-duplicates*")) + (when ref-duplicates + (insert "These references appear more than once:\n") + (mapc (lambda (x) (insert " " x "\n")) ref-duplicates) + (insert "\n\n")) + (when id-duplicates + (insert "These ids appear more than once:\n") + (mapc (lambda (x) (insert " " x "\n")) id-duplicates)) + + "Some references or ids are duplicates") + "No duplicate references or ids found"))) + + +(defun org-index--find-duplicates-helper (column) + "Helper for `org-index--find-duplicates': Go through table and count given COLUMN." + (let (counts duplicates field found) + + ;; go through table + (goto-char org-index--below-hline) + (while (org-at-table-p) -(defun org-index--flag-p (flag column) - "Check if COLUMN has FLAG set." - (unless (memq flag org-index--all-flags) - (error (format "Internal error: unknown flag %s" (symbol-name flag)))) - (memq column (assoc flag org-index--flagged-columns))) + ;; get column + (setq field (org-index--get-or-set-field column)) + ;; and increment + (setq found (assoc field counts)) + (if found + (cl-incf (cdr found)) + (setq counts (cons (cons field 1) counts))) -(defun org-index--make-guarded-search (ref &optional dont-quote) - "Make robust search string from REF; DONT-QUOTE it, if requested." - (concat "\\_<" (if dont-quote ref (regexp-quote ref)) "\\_>")) + (forward-line)) + + (mapc (lambda (x) (if (and (> (cdr x) 1) + (car x)) + (setq duplicates (cons (car x) duplicates)))) counts) + + duplicates)) (defun org-index--do-statistics () "Compute statistics about index table." - (let ((total 0) - ref-field ref min max message) - + (let ((total-lines 0) (total-refs 0) + ref ref-field min max message) - ;; go through table and remove all refs, that we see + ;; go through table (goto-char org-index--below-hline) (while (org-at-table-p) - ;; get ref-field and number + ;; get ref (setq ref-field (org-index--get-or-set-field 'ref)) - (if (and ref-field - (string-match org-index--ref-regex ref-field)) - (setq ref (string-to-number (match-string 1 ref-field)))) - ;; record min and max - (if (or (not min) (< ref min)) (setq min ref)) - (if (or (not max) (> ref max)) (setq max ref)) + (when ref-field + (string-match org-index--ref-regex ref-field) + (setq ref (string-to-number (match-string 1 ref-field))) + + ;; record min and max + (if (or (not min) (< ref min)) (setq min ref)) + (if (or (not max) (> ref max)) (setq max ref)) + + (setq total-refs (1+ total-refs))) ;; count - (setq total (1+ total)) + (setq total-lines (1+ total-lines)) (forward-line)) - (setq message (format "First reference is %s, last %s; %d values in between, %d of them are used (%d percent)" - (format org-index--ref-format min) - (format org-index--ref-format max) - (1+ (- max min)) - total - (truncate (* 100 (/ (float total) (1+ (- max min))))) - -)) + (setq message (format "%d Lines in index table. First reference is %s, last %s; %d of them are used (%d percent)" + total-lines + (format org-index--ref-format min) + (format org-index--ref-format max) + total-refs + (truncate (* 100 (/ (float total-refs) (1+ (- max min))))))) (goto-char org-index--below-hline) message)) -(defun org-index--do-add-or-update () - "For current node or current line in index, add a new line to index table or update existing." +(defun org-index--do-add-or-update (&optional create-ref tag-with-ref) + "For current node or current line in index, add or update in index table. +CREATE-REF and TAG-WITH-REF if given." - (let* (id ref args yank ref-and-yank) + (let* (id id-from-index ref args yank ret) - ;; do the same things from within index and from outside - (if org-index--within-node + (org-index--save-positions) + (unless (or org-index--within-index-node + org-index--within-occur) + (org-back-to-heading)) + + ;; try to do the same things from within index and from outside + (if org-index--within-index-node (progn (unless (org-at-table-p) @@ -1830,34 +2130,59 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (setq id (org-index--get-or-set-field 'id)) (setq ref (org-index--get-or-set-field 'ref)) (setq args (org-index--collect-values-for-add-update-remote id)) - (org-index--write-fields-for-add-update args) - (setq yank (org-index--get-or-set-field (org-index--special-column 'yank-after-add))) - - (cons (format "Updated index line %s" ref) yank)) + (org-index--write-fields args) + (setq yank (org-index--get-or-set-field org-index-yank-after-add)) - (unless (org-at-heading-p) - (error "Not at headline")) + (setq ret + (if ref + (cons (format "Updated index line %s" ref) yank) + (cons "Updated index line" nil)))) (setq id (org-id-get-create)) + (org-index--refresh-parse-table) + (setq id-from-index (org-index--on 'id id id)) (setq ref (org-index--on 'id id (org-index--get-or-set-field 'ref))) - (setq args (org-index--collect-values-for-add-update id ref)) - (if ref - ;; already have a ref, find it in index and update fields - (let ((kvs args) - found-and-message) + (if tag-with-ref + (org-toggle-tag (format "%s%d%s" org-index--head tag-with-ref org-index--tail) 'on)) + (setq args (org-index--collect-values-for-add-update id)) + + (when (and create-ref + (not ref)) + (setq ref org-index--nextref) + (setq args (plist-put args 'ref ref))) + + + (if id-from-index + ;; already have an id in index, find it and update fields + (progn (org-index--on - 'ref ref - (org-index--write-fields-for-add-update args) - (setq yank (org-index--get-or-set-field (org-index--special-column 'yank-after-add)))) - - (cons (format "Updated index line %s" ref) yank)) + 'id id + (org-index--write-fields args) + (setq yank (org-index--get-or-set-field org-index-yank-after-add))) + + (setq ret + (if ref + (cons (format "Updated index line %s" ref) yank) + (cons "Updated index line" nil)))) - ;; no ref here, create new line in index - (setq ref-and-yank (apply 'org-index--do-new-line args)) + ;; no id here, create new line in index + (if ref (setq ref (plist-put args 'ref org-index--nextref))) + (setq yank (apply 'org-index--do-new-line args)) - (cons (format "Added index line %s" (car ref-and-yank)) (concat (cdr ref-and-yank) " ")))))) + (setq ret + (if ref + (cons + (format "Added new index line %s" ref) + (concat yank " ")) + (cons + "Added new index line" + nil))))) + + (org-index--restore-positions) + + ret)) (defun org-index--check-ids () @@ -1865,7 +2190,7 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (let ((lines 0) id ids marker) - + (goto-char org-index--below-hline) (catch 'problem @@ -1877,7 +2202,7 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (when (member id ids) (org-table-goto-column (org-index--column-num 'id)) (throw 'problem "This id appears twice in index; please use command 'maintain' to check for duplicate ids")) - (incf lines) + (cl-incf lines) (setq ids (cons id ids)) ;; check, if id is valid @@ -1891,13 +2216,13 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (goto-char org-index--below-hline) nil))) - + (defun org-index--update-all-lines () "Update all lines of index at once." (let ((lines 0) id ref kvs) - + ;; check for double ids (or (org-index--check-ids) @@ -1905,13 +2230,13 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (progn (goto-char org-index--below-hline) (while (org-at-table-p) - + ;; update single line (when (setq id (org-index--get-or-set-field 'id)) (setq ref (org-index--get-or-set-field 'ref)) (setq kvs (org-index--collect-values-for-add-update-remote id)) - (org-index--write-fields-for-add-update kvs) - (incf lines)) + (org-index--write-fields kvs) + (cl-incf lines)) (forward-line)) (goto-char org-index--below-hline) @@ -1921,44 +2246,48 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin (defun org-index--collect-values-for-add-update (id &optional silent category) "Collect values for adding or updating line specified by ID, do not ask if SILENT, use CATEGORY, if given." - - (let ((args (list 'ref t 'id id)) + + (let ((args (list 'id id)) content) - - (dolist (col-num org-index--columns) - + + (dolist (col (mapcar 'car org-index--columns)) + (setq content "") - - (if (eq (car col-num) 'keywords) - (setq content (nth 4 (org-heading-components)))) - - (if (eq (car col-num) 'category) - (setq content (or category org-index--category-before))) - - (if (eq (car col-num) 'level) - (setq content (number-to-string (org-outline-level)))) - - ;; Shift ref and timestamp ? - (if (org-index--flag-p 'shift-ref-and-date-on-add (car col-num)) - (dotimes (i 2) - (if (or (string-match (concat "^\\s-*" org-index--ref-regex) content) - (string-match (concat org-ts-regexp-both) content)) - (setq content (substring content (match-end 0)))))) - - (if (and (not silent) ; do not edit, if heading has already been added - (org-index--flag-p 'edit-on-add (car col-num))) - (setq content (read-from-minibuffer - (format "Edit text for column '%s': " (symbol-name (car col-num))) - content))) - - (if (not (string= content "")) - (setq args (append (list (car col-num) content) args)))) + + (cond + ((eq col 'keywords) + (if org-index-copy-heading-to-keywords + (setq content (nth 4 (org-heading-components)))) + + ;; Shift ref and timestamp ? + (if org-index-strip-ref-and-date-from-heading + (dotimes (i 2) + (if (or (string-match (concat "^\\s-*" org-index--ref-regex) content) + (string-match (concat "^\\s-*" org-ts-regexp-both) content)) + (setq content (substring content (match-end 0))))))) + + ((eq col 'category) + (setq content (or category org-index--category-before))) + + ((eq col 'level) + (setq content (number-to-string (org-outline-level)))) + + ((eq col 'tags) + (setq content (org-get-tags-string)))) + + (unless (string= content "") + (setq args (plist-put args col content)))) + + (if (not silent) + (let ((args-edited (org-index--collect-values-from-user org-index-edit-on-add args))) + (setq args (append args-edited args)))) + args)) (defun org-index--collect-values-for-add-update-remote (id) "Wrap `org-index--collect-values-for-add-update' by prior moving to remote node identified by ID." - + (let (marker point args) (setq marker (org-id-find id t)) @@ -1972,43 +2301,158 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin args)) -(defun org-index--write-fields-for-add-update (kvs) +(defun org-index--collect-values-from-user (cols &optional defaults) + "Collect values for adding a new yank-line. +Argument COLS gives list of columns to edit. +Optional argument DEFAULTS gives default values." + + (let (content args) + + (dolist (col cols) + + (setq content "") + + (setq content (read-from-minibuffer + (format "Enter text for column '%s': " (symbol-name col)) + (plist-get col defaults))) + + (unless (string= content "") + (setq args (plist-put args col content)))) + args)) + + +(defun org-index--write-fields (kvs) "Update current line with values from KVS (keys-values)." (while kvs - (unless (eq (car kvs) 'ref) - (org-index--get-or-set-field (car kvs) (org-trim (cadr kvs)))) + (org-index--get-or-set-field (car kvs) (org-trim (cadr kvs))) (setq kvs (cddr kvs)))) -(defun org-index--do-delete () - "Perform command delete." +(defun org-index--do-kill () + "Perform command kill from within occur, index or node." - (unless (org-at-heading-p) - (error "Not at headline")) + (let (id ref chars-deleted-index text-deleted-from pos-in-index) - (let* ((id (org-entry-get (point) "ID")) - (ref (org-index--ref-from-id id))) + (org-index--save-positions) + (unless (or org-index--within-index-node + org-index--within-occur) + (org-back-to-heading)) - ;; maybe delete from heading - (if ref - (save-excursion - (end-of-line) - (let ((end (point))) - (beginning-of-line) - (when (search-forward ref end t) - (delete-char (- (length ref))) - (just-one-space))))) + ;; Collect information: What should be deleted ? + (if (or org-index--within-occur + org-index--within-index-node) - ;; delete from index table - (if (org-index--delete-line id) - (format "Deleted index line %s" ref) - (format "Did not find id %s in index" id)))) + (progn + (if org-index--within-index-node + ;; In index + (setq pos-in-index (point)) + ;; In occur + (setq pos-in-index (get-text-property (point) 'org-index-lbp)) + (org-index--occur-test-stale pos-in-index) + (set-buffer org-index--buffer) + (goto-char pos-in-index)) + ;; In Index (maybe moved there) + (setq id (org-index--get-or-set-field 'id)) + (setq ref (org-index--get-or-set-field 'ref))) + + ;; At a headline + (setq id (org-entry-get (point) "ID")) + (setq ref (org-index--ref-from-id id)) + (setq pos-in-index (org-index--on 'id id (point))) + (unless pos-in-index (error "This node is not in index"))) + + ;; Remark: Current buffer is not certain here, but we have all the information to delete + + ;; Delete from node + (when id + (let ((m (org-id-find id 'marker))) + (set-buffer (marker-buffer m)) + (goto-char m) + (move-marker m nil) + (unless (string= (org-id-get) id) + (error "Could not find node with id %s" id))) + + (org-index--delete-any-ref-from-tags) + (if ref (org-index--delete-ref-from-heading ref)) + (setq text-deleted-from (cons "node" text-deleted-from))) + + ;; Delete from index + (set-buffer org-index--buffer) + (unless pos-in-index "Internal error, pos-in-index should be defined here") + (goto-char pos-in-index) + (setq chars-deleted-index (length (delete-and-extract-region (line-beginning-position) (line-beginning-position 2)))) + (setq text-deleted-from (cons "index" text-deleted-from)) + + ;; Delete from occur only if we started there, accept that it will be stale otherwise + (if org-index--within-occur + (let ((inhibit-read-only t)) + (set-buffer org-index--occur-buffer-name) + (delete-region (line-beginning-position) (line-beginning-position 2)) + ;; correct positions + (while (org-at-table-p) + (put-text-property (line-beginning-position) (line-end-position) 'org-index-lbp + (- (get-text-property (point) 'org-index-lbp) chars-deleted-index)) + (forward-line)) + (setq text-deleted-from (cons "occur" text-deleted-from)))) + + (org-index--restore-positions) + (concat "Deleted from: " (mapconcat 'identity (sort text-deleted-from 'string<) ",")))) + + +(defun org-index--save-positions () + "Save current buffer and positions in index- and current buffer; not in occur-buffer." + + (let (cur-buf cur-mrk idx-pnt idx-mrk) + (setq cur-buf (current-buffer)) + (setq cur-mrk (point-marker)) + (set-buffer org-index--buffer) + (if (string= (org-id-get) org-index-id) + (setq idx-pnt (point)) + (setq idx-mrk (point-marker))) + (set-buffer cur-buf) + (setq org-index--saved-positions (list cur-buf cur-mrk idx-pnt idx-mrk)))) + + +(defun org-index--restore-positions () + "Restore positions as saved by `org-index--save-positions'." + + (cl-multiple-value-bind + (cur-buf cur-mrk idx-pnt idx-mrk buf) + org-index--saved-positions + (setq buf (current-buffer)) + (set-buffer cur-buf) + (goto-char cur-mrk) + (set-buffer org-index--buffer) + (goto-char (or idx-pnt idx-mrk)) + (set-buffer buf)) + (setq org-index--saved-positions nil)) + + +(defun org-index--delete-ref-from-heading (ref) + "Delete given REF from current heading." + (save-excursion + (end-of-line) + (let ((end (point))) + (beginning-of-line) + (when (search-forward ref end t) + (delete-char (- (length ref))) + (just-one-space))))) + + +(defun org-index--delete-any-ref-from-tags () + "Delete any reference from list of tags." + (let (new-tags) + (mapc (lambda (tag) + (unless (string-match org-index--ref-regex tag) + (setq new-tags (cons tag new-tags) ))) + (org-get-tags)) + (org-set-tags-to new-tags))) (defun org-index--go (&optional column value) "Position cursor on index line where COLUMN equals VALUE. Return t or nil, leave point on line or at top of table, needs to be in buffer initially." - (let (found text) + (let (found) (unless (eq (current-buffer) org-index--buffer) (error "This is a bug: Not in index buffer")) @@ -2031,11 +2475,9 @@ Return t or nil, leave point on line or at top of table, needs to be in buffer i nil))) -(defun org-index--do-head (ref id &optional other) +(defun org-index--find-id (id &optional other) "Perform command head: Find node with REF or ID and present it. If OTHER in separate window." - - (setq org-index--last-ref ref) (let (message marker) @@ -2044,25 +2486,27 @@ If OTHER in separate window." (if marker (progn (org-index--update-line id) - (let (cb) - (if other - (progn - (setq cb (current-buffer)) - (pop-to-buffer (marker-buffer marker))) - (pop-to-buffer-same-window (marker-buffer marker))) - - (goto-char marker) - (org-reveal t) - (org-show-entry) - (recenter)) - (setq message (format "Found headline %s" ref))) - (setq message (format "Did not find headline %s" ref))))) + (if other + (progn + (pop-to-buffer (marker-buffer marker))) + (pop-to-buffer-same-window (marker-buffer marker))) + + (goto-char marker) + (org-reveal t) + (org-show-entry) + (recenter) + (unless (string= (org-id-get) id) + (setq message (format "Could not go to node with id %s (narrowed ?)" id))) + (setq message "Found headline")) + (setq message (format "Did not find node with %s" id))) + message)) (defun org-index--do-occur () "Perform command occur." (let ((word "") ; last word to search for growing and shrinking on keystrokes (prompt "Search for: ") + (these-commands " NOTE: If you invoke the org-index subcommands edit or kill from within the occur buffer, the index is updated accordingly.") (lines-wanted (window-body-height)) (lines-found 0) ; number of lines found words ; list words that should match @@ -2070,22 +2514,24 @@ If OTHER in separate window." begin ; position of first line narrow ; start of narrowed buffer help-text ; cons with help text short and long - key-help ; for keys with special function search-text ; description of text to search for done ; true, if loop is done in-c-backspace ; true, while processing C-backspace - show-headings ; true, if headings should be shown help-overlay ; Overlay with help text last-point ; Last position before end of search - key ; input from user - key-sequence) ; as a sequence + initial-frame ; Frame when starting occur + key ; input from user in various forms + key-sequence + key-sequence-raw) + - ;; make and show buffer (if (get-buffer org-index--occur-buffer-name) (kill-buffer org-index--occur-buffer-name)) (setq occur-buffer (make-indirect-buffer org-index--buffer org-index--occur-buffer-name)) (pop-to-buffer-same-window occur-buffer) + (setq initial-frame (selected-frame)) + ;; avoid modifying direct buffer (setq buffer-read-only t) (toggle-truncate-lines 1) @@ -2095,9 +2541,9 @@ If OTHER in separate window." ;; reset stack and overlays (setq org-index--occur-stack nil) (setq org-index--occur-tail-overlay nil) - + ;; narrow to table rows and one line before - (goto-char (marker-position org-index--below-hline)) + (goto-char org-index--below-hline) (forward-line 0) (setq begin (point)) (forward-line -1) @@ -2110,17 +2556,20 @@ If OTHER in separate window." ;; initialize help text (setq help-text (cons - "Incremental occur; `?' toggles help and headlines.\n" (concat - (org-index--wrap - (concat - "Normal keys add to search word; <space> or <comma> start additional word; <backspace> erases last char, <C-backspace> last word; <return> jumps to heading, <tab> jumps to heading in other window; all other keys end search.\n")) + (propertize "Incremental occur" 'face 'org-todo) + (propertize "; ? toggles help and headlines.\n" 'face 'org-agenda-dimmed-todo-face)) + (concat + (propertize + (org-index--wrap + (concat + "Normal keys add to search word; <space> or <comma> start additional word; <backspace> erases last char, <C-backspace> last word; <return> jumps to heading, <tab> jumps to heading in other window, <S-return> jumps to matching line in index; all other keys end search." these-commands "\n")) + 'face 'org-agenda-dimmed-todo-face) org-index--headings))) - + ;; insert overlays for help text and to cover unsearched lines (setq help-overlay (make-overlay (point-min) begin)) (overlay-put help-overlay 'display (car help-text)) - (overlay-put help-overlay 'face 'org-agenda-dimmed-todo-face) (setq org-index--occur-tail-overlay (make-overlay (point-max) (point-max))) (overlay-put org-index--occur-tail-overlay 'invisible t) @@ -2129,14 +2578,25 @@ If OTHER in separate window." (if in-c-backspace (setq key "<backspace>") (setq search-text (mapconcat 'identity (reverse (cons word words)) ",")) - ;; read key - (setq key-sequence - (vector (read-key - (format "%s%s%s" - prompt - search-text - (if (string= search-text "") "" " "))))) - (setq key (key-description key-sequence))) + (message "foo") + + ;; read key, if selected frame has not changed + (if (eq initial-frame (selected-frame)) + (progn + (setq key-sequence + (let ((echo-keystrokes 0) + (full-prompt (format "%s%s%s" + prompt + search-text + (if (string= search-text "") "" " ")))) + (read-key-sequence full-prompt nil nil t t))) + (setq key (key-description key-sequence)) + (setq key-sequence-raw (this-single-command-raw-keys))) + (setq done t) + (setq key-sequence nil) + (setq key nil) + (setq key-sequence-raw nil))) + (cond @@ -2168,11 +2628,11 @@ If OTHER in separate window." ;; free top list of overlays and remove list (setq lines-found (or (org-index--unhide) lines-wanted)) (move-overlay org-index--occur-tail-overlay - (if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack))) + (if org-index--occur-stack (cdr (assq :end-of-visible (car org-index--occur-stack))) (point-max)) (point-max)) - - + + ;; highlight shorter word (unless (= (length word) 0) (highlight-regexp (regexp-quote word) 'isearch)) @@ -2184,8 +2644,9 @@ If OTHER in separate window." ((member key (list "SPC" ",")) ; space or comma: enter an additional search word ;; push current word and clear, no need to change display - (setq words (cons word words)) - (setq word "")) + (unless (string= word "") + (setq words (cons word words)) + (setq word ""))) ((string= key "?") ; question mark: toggle display of headlines and help @@ -2201,17 +2662,17 @@ If OTHER in separate window." ;; add to word (setq word (concat word key)) - + ;; make overlays to hide lines, that do not match longer word any more (goto-char begin) (setq lines-found (org-index--hide-with-overlays (cons word words) lines-wanted)) (move-overlay org-index--occur-tail-overlay - (if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack))) + (if org-index--occur-stack (cdr (assq :end-of-visible (car org-index--occur-stack))) (point-max)) (point-max)) - + (goto-char begin) - + ;; highlight longer word (highlight-regexp (regexp-quote word) 'isearch) @@ -2224,18 +2685,18 @@ If OTHER in separate window." ;; put back input event, that caused the loop to end (unless (string= key "C-g") - (setq unread-command-events (listify-key-sequence key-sequence)) + (setq unread-command-events (listify-key-sequence key-sequence-raw)) (message key)) - + ;; postprocessing (setq last-point (point)) - + ;; For performance reasons do not show matching lines for rest of table. So no code here. - + ;; make permanent copy ;; copy visible lines (let ((lines-collected 0) - keymap line all-lines end-of-head) + keymap line all-lines all-lines-lbp header-lines lbp) (setq cursor-type t) (goto-char begin) @@ -2247,51 +2708,67 @@ If OTHER in separate window." (while (and (invisible-p (point)) (not (eobp))) (goto-char (1+ (overlay-end (car (overlays-at (point))))))) - (setq line (buffer-substring (line-beginning-position) (line-end-position))) + (setq lbp (line-beginning-position)) + (setq line (buffer-substring-no-properties lbp (line-end-position))) (unless (string= line "") - (incf lines-collected) + (cl-incf lines-collected) (setq all-lines (cons (concat line "\n") - all-lines))) + all-lines)) + (setq all-lines-lbp (cons lbp all-lines-lbp))) (forward-line 1)) - + (kill-buffer org-index--occur-buffer-name) ; cannot keep this buffer; might become stale soon ;; create new buffer (setq occur-buffer (get-buffer-create org-index--occur-buffer-name)) (pop-to-buffer-same-window occur-buffer) (insert org-index--headings) - (setq end-of-head (point)) + (setq header-lines (line-number-at-pos)) ;; insert into new buffer (save-excursion (apply 'insert (reverse all-lines)) (if (= lines-collected lines-wanted) (insert "\n(more lines omitted)\n"))) - + (setq org-index--occur-lines-collected lines-collected) + (org-mode) (setq truncate-lines t) - (if (org-at-table-p) (org-table-align)) - (font-lock-fontify-buffer) + (if all-lines (org-index--align-and-fontify-current-line (length all-lines))) + (font-lock-ensure) + (font-lock-flush) + (when all-lines-lbp + (while (not (org-at-table-p)) + (forward-line -1)) + (while all-lines-lbp + (put-text-property (line-beginning-position) (line-end-position) 'org-index-lbp (car all-lines-lbp)) + (setq all-lines-lbp (cdr all-lines-lbp)) + (forward-line -1))) ;; prepare help text - (setq org-index--occur-help-overlay (make-overlay (point-min) end-of-head)) + (goto-char (point-min)) + (forward-line (1- header-lines)) + (setq org-index--occur-help-overlay (make-overlay (point-min) (point))) (setq org-index--occur-help-text (cons (org-index--wrap - (concat "Search is done; `?' toggles help and headlines.\n")) + (propertize "Search is done; ? toggles help and headlines.\n" 'face 'org-agenda-dimmed-todo-face)) (concat - (org-index--wrap (format (concat "Search is done. " - (if (< lines-collected lines-wanted) - " Showing all %d matches for " - " Showing one window of matches for ") - "\"" search-text - "\". <return> jumps to heading, <tab> jumps to heading in other window, <S-return> to matching line in index, <space> increments count.\n" ) - (length all-lines))) + (org-index--wrap + (propertize + (format + (concat "Search is done." + (if (< lines-collected lines-wanted) + " Showing all %d matches for " + " Showing one window of matches for ") + "\"" search-text + "\". <return> jumps to heading, <tab> jumps to heading in other window, <S-return> jumps to matching line in index, <space> increments count.\n" these-commands "\n") + (length all-lines)) + 'face 'org-agenda-dimmed-todo-face)) org-index--headings))) - + (overlay-put org-index--occur-help-overlay 'display (car org-index--occur-help-text)) - (overlay-put org-index--occur-help-overlay 'face 'org-agenda-dimmed-todo-face) ;; highlight words (setq case-fold-search t) @@ -2307,15 +2784,16 @@ If OTHER in separate window." (mapc (lambda (x) (define-key keymap (kbd x) (lambda () (interactive) - (message "%s" (org-index--occur-to-head))))) + (message "%s" (org-index--occur-action))))) (list "<return>" "RET")) (define-key keymap (kbd "<tab>") (lambda () (interactive) - (message (org-index--occur-to-head t)))) - + (message (org-index--occur-action t)))) + (define-key keymap (kbd "SPC") (lambda () (interactive) + (org-index--refresh-parse-table) ;; increment in index (let ((ref (org-index--get-or-set-field 'ref)) count) @@ -2329,19 +2807,44 @@ If OTHER in separate window." (let ((inhibit-read-only t)) (org-index--get-or-set-field 'count (number-to-string count))) (message "Incremented count to %d" count)))) - + (define-key keymap (kbd "<S-return>") (lambda () (interactive) - (org-index 'enter (org-index--get-or-set-field 'ref)))) - + (let ((pos (get-text-property (point) 'org-index-lbp))) + (org-index--refresh-parse-table) + (org-index--occur-test-stale pos) + (pop-to-buffer org-index--buffer) + (goto-char pos) + (org-reveal t) + (org-index--update-current-line) + (beginning-of-line)))) + (define-key keymap (kbd "?") (lambda () (interactive) + (org-index--refresh-parse-table) (setq-local org-index--occur-help-text (cons (cdr org-index--occur-help-text) (car org-index--occur-help-text))) (overlay-put org-index--occur-help-overlay 'display (car org-index--occur-help-text)))) - + (use-local-map keymap)))) +(defun org-index--occur-test-stale (pos) + "Test, if current line in occur buffer has become stale at POS." + (let (here there) + (org-index--refresh-parse-table) + (setq here (org-index--line-in-canonical-form)) + (with-current-buffer org-index--buffer + (goto-char pos) + (setq there (org-index--line-in-canonical-form))) + (unless (string= here there) + (error "Occur buffer has become stale")))) + + +(defun org-index--line-in-canonical-form () + "Return current line in its canonical form." + (org-trim (substring-no-properties (replace-regexp-in-string "\s +" " " (buffer-substring (line-beginning-position) (line-beginning-position 2)))))) + + (defun org-index--wrap (text) "Wrap TEXT at fill column." (with-temp-buffer @@ -2350,13 +2853,27 @@ If OTHER in separate window." (buffer-string))) -(defun org-index--occur-to-head (&optional other) - "Helper for `org-index--occur', find heading with ref or id; if OTHER, in other window." - (let ((ref (org-index--get-or-set-field 'ref)) - (id (org-index--get-or-set-field 'id))) - (if id - (org-index--do-head ref id other) - (message "Current line has no id.")))) +(defun org-index--occur-action (&optional other) + "Helper for `org-index--occur', find heading with ref or id; if OTHER, in other window; or copy yank column." + (if (org-at-table-p) + (let ((id (org-index--get-or-set-field 'id)) + (ref (org-index--get-or-set-field 'ref)) + (yank (org-index--get-or-set-field 'yank))) + (if id + (org-index--find-id id other) + (if ref + (progn + (org-mark-ring-goto) + (format "Found reference %s (no node is associated)" ref)) + (if yank + (progn + (org-index--update-line (get-text-property (point) 'org-index-lbp)) + (setq yank (replace-regexp-in-string (regexp-quote "\\vert") "|" yank nil 'literal)) + (kill-new yank) + (org-mark-ring-goto) + (format "Copied '%s' (no node is associated)" yank)) + (error "Internal error, this line contains neither id, nor reference, nor text to yank"))))) + (message "Not at table"))) (defun org-index--hide-with-overlays (words lines-wanted) @@ -2398,8 +2915,8 @@ If OTHER in separate window." (when matched (forward-line 1) (setq end-of-visible (point)) - (incf lines-found))) - + (cl-incf lines-found))) + ;; put new list on top of stack (setq org-index--occur-stack (cons (list (cons :overlays overlays) @@ -2416,11 +2933,11 @@ If OTHER in separate window." ;; delete overlays and make visible again (mapc (lambda (y) (delete-overlay y)) - (cdr (assoc :overlays (car org-index--occur-stack)))) + (cdr (assq :overlays (car org-index--occur-stack)))) ;; remove from stack (setq org-index--occur-stack (cdr org-index--occur-stack)) ;; return number of lines, that are now visible - (if org-index--occur-stack (cdr (assoc :lines (car org-index--occur-stack)))))) + (if org-index--occur-stack (cdr (assq :lines (car org-index--occur-stack)))))) (defun org-index--test-words (words) @@ -2429,7 +2946,7 @@ If OTHER in separate window." (setq line (downcase (buffer-substring (line-beginning-position) (line-beginning-position 2)))) (catch 'not-found (dolist (w words) - (or (search w line) + (or (cl-search w line) (throw 'not-found nil))) t))) @@ -2437,29 +2954,21 @@ If OTHER in separate window." (defun org-index--create-new-line () "Do the common work for `org-index-new-line' and `org-index'." - (let (new) - - ;; construct new reference - (unless new - (setq new (format "%s%d%s" org-index--head (1+ org-index--maxref) org-index--tail))) - - ;; insert ref or id as last or first line, depending on sort-column - (goto-char org-index--below-hline) - (if (eq (org-index--special-column 'sort) 'count) - (progn - (while (org-at-table-p) - (forward-line)) - (forward-line -1) - (org-table-insert-row t)) - (org-table-insert-row)) - - ;; insert some of the standard values - (org-table-goto-column (org-index--column-num 'created)) - (org-insert-time-stamp nil nil t) - (org-table-goto-column (org-index--column-num 'count)) - (insert "1") + ;; insert ref or id as last or first line, depending on sort-column + (goto-char org-index--below-hline) + (if (eq org-index-sort-by 'count) + (progn + (while (org-at-table-p) + (forward-line)) + (forward-line -1) + (org-table-insert-row t)) + (org-table-insert-row)) - new)) + ;; insert some of the standard values + (org-table-goto-column (org-index--column-num 'created)) + (org-insert-time-stamp nil nil t) + (org-table-goto-column (org-index--column-num 'count)) + (insert "1")) (defun org-index--sort-silent () @@ -2468,13 +2977,13 @@ If OTHER in separate window." (org-index--verify-id) (org-index--parse-table) (org-index--on nil nil - (org-index--do-sort-index (org-index--special-column 'sort)) + (org-index--do-sort-index org-index-sort-by) (org-table-align) (remove-hook 'before-save-hook 'org-index--sort-silent)))) (defun org-index--copy-visible (beg end) - "Copy the visible parts of the region without adding it to kill-ring; copy of `org-copy-visible'" + "Copy the visible parts of the region between BEG and END without adding it to `kill-ring'; copy of `org-copy-visible'." (let (snippets s) (save-excursion (save-restriction diff --git a/contrib/lisp/org-interactive-query.el b/contrib/lisp/org-interactive-query.el index 42ff7fd..928c801 100644 --- a/contrib/lisp/org-interactive-query.el +++ b/contrib/lisp/org-interactive-query.el @@ -81,7 +81,7 @@ not change the current one." (split-window-vertically) (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) (erase-buffer) - (org-set-local 'org-done-keywords done-keywords) + (setq-local org-done-keywords done-keywords) (insert "Query: " current "\n") (org-agenda-query-op-line op) (insert "\n\n") diff --git a/contrib/lisp/org-invoice.el b/contrib/lisp/org-invoice.el index c1340a7..4c83d2e 100644 --- a/contrib/lisp/org-invoice.el +++ b/contrib/lisp/org-invoice.el @@ -176,8 +176,8 @@ looks like tree2, where the level is 2." "Return a list where the car is the min level, and the cdr the max." (let ((max 0) min level) (dolist (info ls) - (when (cdr (assoc 'date info)) - (setq level (cdr (assoc 'level info))) + (when (cdr (assq 'date info)) + (setq level (cdr (assq 'level info))) (when (or (not min) (< level min)) (setq min level)) (when (> level max) (setq max level)))) (cons (or min 0) max))) @@ -186,11 +186,11 @@ looks like tree2, where the level is 2." "Reorganize the given list by dates." (let ((min-max (org-invoice-level-min-max ls)) new) (dolist (info ls) - (let* ((date (cdr (assoc 'date info))) - (work (cdr (assoc 'work info))) - (price (cdr (assoc 'price info))) - (long-date (cdr (assoc 'long-date info))) - (level (cdr (assoc 'level info))) + (let* ((date (cdr (assq 'date info))) + (work (cdr (assq 'work info))) + (price (cdr (assq 'price info))) + (long-date (cdr (assq 'long-date info))) + (level (cdr (assq 'level info))) (bucket (cdr (assoc date new)))) (if (and (/= (car min-max) (cdr min-max)) (= (car min-max) level) @@ -208,19 +208,19 @@ looks like tree2, where the level is 2." (push (cons date bucket) new) (setq bucket (cdr (assoc date new)))) (when (and date bucket) - (setcdr (assoc 'total-work (car bucket)) - (+ work (cdr (assoc 'total-work (car bucket))))) - (setcdr (assoc 'price (car bucket)) - (+ price (cdr (assoc 'price (car bucket))))) + (setcdr (assq 'total-work (car bucket)) + (+ work (cdr (assq 'total-work (car bucket))))) + (setcdr (assq 'price (car bucket)) + (+ price (cdr (assq 'price (car bucket))))) (nconc bucket (list info)))))) (nreverse new))) (defun org-invoice-info-to-table (info) "Create a single org table row from the given info alist." - (let ((title (cdr (assoc 'title info))) - (total (cdr (assoc 'total-work info))) - (work (cdr (assoc 'work info))) - (price (cdr (assoc 'price info))) + (let ((title (cdr (assq 'title info))) + (total (cdr (assq 'total-work info))) + (work (cdr (assq 'work info))) + (price (cdr (assq 'price info))) (with-price (plist-get org-invoice-table-params :price))) (unless total (setq diff --git a/contrib/lisp/org-link-edit.el b/contrib/lisp/org-link-edit.el index e69de29..431c934 100644 --- a/contrib/lisp/org-link-edit.el +++ b/contrib/lisp/org-link-edit.el @@ -0,0 +1,327 @@ +;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Kyle Meyer <kyle@kyleam.com> + +;; Author: Kyle Meyer <kyle@kyleam.com> +;; URL: https://github.com/kyleam/org-link-edit +;; Keywords: convenience +;; Version: 1.0.1 +;; Package-Requires: ((cl-lib "0.5") (org "8.2")) + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org Link Edit provides Paredit-inspired slurping and barfing +;; commands for Org link descriptions. +;; +;; There are four commands, all which operate when point is on an Org +;; link. +;; +;; - org-link-edit-forward-slurp +;; - org-link-edit-backward-slurp +;; - org-link-edit-forward-barf +;; - org-link-edit-backward-barf +;; +;; Org Link Edit doesn't bind these commands to any keys. Finding +;; good keys for these commands is difficult because, while it's +;; convenient to be able to quickly repeat these commands, they won't +;; be used frequently enough to be worthy of a short, repeat-friendly +;; binding. Using Hydra [1] provides a nice solution to this. After +;; an initial key sequence, any of the commands will be repeatable +;; with a single key. (Plus, you get a nice interface that displays +;; the key for each command.) Below is one example of how you could +;; configure this. +;; +;; (define-key org-mode-map YOUR-KEY +;; (defhydra hydra-org-link-edit () +;; "Org Link Edit" +;; ("j" org-link-edit-forward-slurp "forward slurp") +;; ("k" org-link-edit-forward-barf "forward barf") +;; ("u" org-link-edit-backward-slurp "backward slurp") +;; ("i" org-link-edit-backward-barf "backward barf") +;; ("q" nil "cancel"))) +;; +;; [1] https://github.com/abo-abo/hydra + +;;; Code: + +(require 'org) +(require 'org-element) +(require 'cl-lib) + +(defun org-link-edit--get-link-data () + "Return list with information about the link at point. +The list includes +- the position at the start of the link +- the position at the end of the link +- the link text +- the link description (nil when on a plain link)" + (let ((el (org-element-context))) + ;; 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))) + (unless (eq (car el) 'link) + (user-error "Point is not on a link")) + (save-excursion + (goto-char (org-element-property :begin el)) + (cond + ;; Use match-{beginning,end} because match-end is consistently + ;; positioned after ]], while the :end property is positioned + ;; at the next word on the line, if one is present. + ((looking-at org-bracket-link-regexp) + (list (match-beginning 0) + (match-end 0) + (org-link-unescape (match-string-no-properties 1)) + (or (and (match-end 3) + (match-string-no-properties 3)) + ""))) + ((looking-at org-plain-link-re) + (list (match-beginning 0) + (match-end 0) + (org-link-unescape (match-string-no-properties 0)) + nil)) + (t + (error "What am I looking at?")))))) + +(defun org-link-edit--forward-blob (n &optional no-punctuation) + "Move forward N blobs (backward if N is negative). + +A block of non-whitespace characters is a blob. If +NO-PUNCTUATION is non-nil, trailing punctuation characters are +not considered part of the blob when going in the forward +direction. + +If the edge of the buffer is reached before completing the +movement, return nil. Otherwise, return t." + (let* ((forward-p (> n 0)) + (nblobs (abs n)) + (skip-func (if forward-p 'skip-syntax-forward 'skip-syntax-backward)) + skip-func-retval) + (while (/= nblobs 0) + (funcall skip-func " ") + (setq skip-func-retval (funcall skip-func "^ ")) + (setq nblobs (1- nblobs))) + (when (and forward-p no-punctuation) + (let ((punc-tail-offset (save-excursion (skip-syntax-backward ".")))) + ;; Don't consider trailing punctuation as part of the blob + ;; unless the whole blob consists of punctuation. + (unless (= skip-func-retval (- punc-tail-offset)) + (goto-char (+ (point) punc-tail-offset))))) + (/= skip-func-retval 0))) + +;;;###autoload +(defun org-link-edit-forward-slurp (&optional n) + "Slurp N trailing blobs into link's description. + + The \[\[http://orgmode.org/\]\[Org mode\]\] site + + | + v + + The \[\[http://orgmode.org/\]\[Org mode site\]\] + +A blob is a block of non-whitespace characters. When slurping +forward, trailing punctuation characters are not considered part +of a blob. + +After slurping, return the slurped text and move point to the +beginning of the link. + +If N is negative, slurp leading blobs instead of trailing blobs." + (interactive "p") + (setq n (or n 1)) + (cond + ((= n 0)) + ((< n 0) + (org-link-edit-backward-slurp (- n))) + (t + (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data) + (goto-char (save-excursion + (goto-char end) + (or (org-link-edit--forward-blob n 'no-punctuation) + (user-error "Not enough blobs after the link")) + (point))) + (let ((slurped (buffer-substring-no-properties end (point)))) + (setq slurped (replace-regexp-in-string "\n+" " " slurped)) + (when (and (= (length desc) 0) + (string-match "^\\s-+\\(.*\\)" slurped)) + (setq slurped (match-string 1 slurped))) + (setq desc (concat desc slurped) + end (+ end (length slurped))) + (delete-region beg (point)) + (insert (org-make-link-string link desc)) + (goto-char beg) + slurped))))) + +;;;###autoload +(defun org-link-edit-backward-slurp (&optional n) + "Slurp N leading blobs into link's description. + + The \[\[http://orgmode.org/\]\[Org mode\]\] site + + | + v + + \[\[http://orgmode.org/\]\[The Org mode\]\] site + +A blob is a block of non-whitespace characters. + +After slurping, return the slurped text and move point to the +beginning of the link. + +If N is negative, slurp trailing blobs instead of leading blobs." + (interactive "p") + (setq n (or n 1)) + (cond + ((= n 0)) + ((< n 0) + (org-link-edit-forward-slurp (- n))) + (t + (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data) + (goto-char (save-excursion + (goto-char beg) + (or (org-link-edit--forward-blob (- n)) + (user-error "Not enough blobs before the link")) + (point))) + (let ((slurped (buffer-substring-no-properties (point) beg))) + (when (and (= (length desc) 0) + (string-match "\\(.*\\)\\s-+$" slurped)) + (setq slurped (match-string 1 slurped))) + (setq slurped (replace-regexp-in-string "\n+" " " slurped)) + (setq desc (concat slurped desc) + beg (- beg (length slurped))) + (delete-region (point) end) + (insert (org-make-link-string link desc)) + (goto-char beg) + slurped))))) + +(defun org-link-edit--split-first-blobs (string n) + "Split STRING into (N first blobs . other) cons cell. +'N first blobs' contains all text from the start of STRING up to +the start of the N+1 blob. 'other' includes the remaining text +of STRING. If the number of blobs in STRING is fewer than N, +'other' is nil." + (when (< n 0) (user-error "N cannot be negative")) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (with-syntax-table org-mode-syntax-table + (let ((within-bound (org-link-edit--forward-blob n))) + (skip-syntax-forward " ") + (cons (buffer-substring 1 (point)) + (and within-bound + (buffer-substring (point) (point-max)))))))) + +(defun org-link-edit--split-last-blobs (string n) + "Split STRING into (other . N last blobs) cons cell. +'N last blobs' contains all text from the end of STRING back to +the end of the N+1 last blob. 'other' includes the remaining +text of STRING. If the number of blobs in STRING is fewer than +N, 'other' is nil." + (when (< n 0) (user-error "N cannot be negative")) + (with-temp-buffer + (insert string) + (goto-char (point-max)) + (with-syntax-table org-mode-syntax-table + (let ((within-bound (org-link-edit--forward-blob (- n)))) + (skip-syntax-backward " ") + (cons (and within-bound + (buffer-substring 1 (point))) + (buffer-substring (point) (point-max))))))) + +;;;###autoload +(defun org-link-edit-forward-barf (&optional n) + "Barf N trailing blobs from link's description. + + The \[\[http://orgmode.org/\]\[Org mode\]\] site + + | + v + + The \[\[http://orgmode.org/\]\[Org\]\] mode site + +A blob is a block of non-whitespace characters. + +After barfing, return the barfed text and move point to the +beginning of the link. + +If N is negative, barf leading blobs instead of trailing blobs." + (interactive "p") + (setq n (or n 1)) + (cond + ((= n 0)) + ((< n 0) + (org-link-edit-backward-barf (- n))) + (t + (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data) + (when (= (length desc) 0) + (user-error "Link has no description")) + (pcase-let ((`(,new-desc . ,barfed) (org-link-edit--split-last-blobs + desc n))) + (unless new-desc (user-error "Not enough blobs in description")) + (delete-region beg end) + (insert (org-make-link-string link new-desc)) + (if (string= new-desc "") + ;; Two brackets are dropped when an empty description is + ;; passed to `org-make-link-string'. + (progn (goto-char (- end (+ 2 (length desc)))) + (setq barfed (concat " " barfed))) + (goto-char (- end (- (length desc) (length new-desc))))) + (insert barfed) + (goto-char beg) + barfed))))) + +;;;###autoload +(defun org-link-edit-backward-barf (&optional n) + "Barf N leading blobs from link's description. + + The \[\[http://orgmode.org/\]\[Org mode\]\] site + + | + v + + The Org \[\[http://orgmode.org/\]\[mode\]\] site + +A blob is a block of non-whitespace characters. + +After barfing, return the barfed text and move point to the +beginning of the link. + +If N is negative, barf trailing blobs instead of leading blobs." + (interactive "p") + (setq n (or n 1)) + (cond + ((= n 0)) + ((< n 0) + (org-link-edit-forward-barf (- n))) + (t + (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data) + (when (= (length desc) 0) + (user-error "Link has no description")) + (pcase-let ((`(,barfed . ,new-desc) (org-link-edit--split-first-blobs + desc n))) + (unless new-desc (user-error "Not enough blobs in description")) + (delete-region beg end) + (insert (org-make-link-string link new-desc)) + (when (string= new-desc "") + (setq barfed (concat barfed " "))) + (goto-char beg) + (insert barfed) + (goto-char (+ beg (length barfed))) + barfed))))) + +(provide 'org-link-edit) +;;; org-link-edit.el ends here diff --git a/contrib/lisp/org-mac-link.el b/contrib/lisp/org-mac-link.el index 56d67e1..ae2def3 100644 --- a/contrib/lisp/org-mac-link.el +++ b/contrib/lisp/org-mac-link.el @@ -18,6 +18,18 @@ ;; Author: Mike McLean <mike.mclean@pobox.com> ;; Add support for Microsoft Outlook for Mac as Org mode links ;; +;; Version: 1.3 +;; Author: Alan Schmitt <alan.schmitt@polytechnique.org> +;; Consistently use `org-mac-paste-applescript-links' +;; +;; Version 1.4 +;; Author: Mike McLean <mike.mclean@pobox.com> +;; Make the path to Microsoft Outlook a `defcustom' +;; +;; Version 1.5 +;; Author: Mike McLean <mike.mclean@pobox.com> +;; Add Support for Evernote +;; ;; This file is not part of GNU Emacs. ;; ;; This program is free software; you can redistribute it and/or modify @@ -58,6 +70,7 @@ ;; Skim.app - Grab a link to the selected page in the topmost pdf document ;; Microsoft Outlook.app - Grab a link to the selected message in the message list ;; DEVONthink Pro Office.app - Grab a link to the selected DEVONthink item(s); open DEVONthink item by reference +;; Evernote.app - Grab a link to the selected Evernote item(s); open Evernote item by ID ;; ;; ;; Installation: @@ -109,6 +122,12 @@ :group 'org-mac-link :type 'boolean) +(defcustom org-mac-outlook-path "/Applications/Microsoft Outlook.app" + "The path to the installed copy of Microsoft Outlook.app. Do not escape spaces as the AppleScript call will quote this string." + :tag "Path to Microsoft Outlook" + :group 'org-mac-link + :type 'string) + (defcustom org-mac-grab-devonthink-app-p t "Add menu option [d]EVONthink to grab links from DEVONthink Pro Office.app." :tag "Grab DEVONthink Pro Office.app links" @@ -165,6 +184,12 @@ :group 'org-mac-link :type 'boolean) +(defcustom org-mac-grab-Acrobat-app-p t + "Add menu option [A]crobat to grab page links from Acrobat.app." + :tag "Grab Acrobat.app page links" + :group 'org-mac-link + :type 'boolean) + (defgroup org-mac-flagged-mail nil "Options foring linking to flagged Mail.app messages." :tag "Org Mail.app" @@ -175,6 +200,23 @@ :group 'org-mac-flagged-mail :type 'string) +(defcustom org-mac-grab-Evernote-app-p + (< 0 (length (shell-command-to-string + "mdfind kMDItemCFBundleIdentifier == 'com.evernote.Evernote'"))) + "Add menu option [e]vernote to grab note links from Evernote.app." + :tag "Grab Evernote.app note links" + :group 'org-mac-link + :type 'boolean) + +(defcustom org-mac-evernote-path (replace-regexp-in-string (rx (* (any " \t\n")) eos) + "" + (shell-command-to-string + "mdfind kMDItemCFBundleIdentifier == 'com.evernote.Evernote'")) + "The path to the installed copy of Evernote.app. Do not escape spaces as the AppleScript call will quote this string." + :tag "Path to Evernote" + :group 'org-mac-link + :type 'string) + ;; In mac.c, removed in Emacs 23. (declare-function do-applescript "org-mac-message" (script)) @@ -206,13 +248,15 @@ When done, go grab the link, and insert it at point." ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p) ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p) ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p) + ("e" "evernote" org-mac-evernote-note-insert-selected ,org-mac-grab-Evernote-app-p) ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p) - ("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p))) + ("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p) + ("A" "crobat" org-mac-acrobat-insert-page ,org-mac-grab-Acrobat-app-p))) (menu-string (make-string 0 ?x)) input) ;; Create the menu string for the keymap - (mapc '(lambda (descriptor) + (mapc (lambda (descriptor) (when (elt descriptor 3) (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" @@ -223,7 +267,7 @@ When done, go grab the link, and insert it at point." ;; Prompt the user, and grab the link (message menu-string) (setq input (read-char-exclusive)) - (mapc '(lambda (descriptor) + (mapc (lambda (descriptor) (let ((key (elt (elt descriptor 0) 0)) (active (elt descriptor 3)) (grab-function (elt descriptor 2))) @@ -299,15 +343,7 @@ The links are of the form <link>::split::<name>." (defun org-mac-firefox-get-frontmost-url () (interactive) (message "Applescript: Getting Firefox url...") - (let* ((url-and-title (org-as-mac-firefox-get-frontmost-url)) - (split-link (split-string url-and-title "::split::")) - (URL (car split-link)) - (description (cadr split-link)) - (org-link)) - (when (not (string= URL "")) - (setq org-link (org-make-link-string URL description))) - (kill-new org-link) - org-link)) + (org-mac-paste-applescript-links (org-as-mac-firefox-get-frontmost-url))) (defun org-mac-firefox-insert-frontmost-url () (interactive) @@ -345,15 +381,7 @@ The links are of the form <link>::split::<name>." (defun org-mac-vimperator-get-frontmost-url () (interactive) (message "Applescript: Getting Vimperator url...") - (let* ((url-and-title (org-as-mac-vimperator-get-frontmost-url)) - (split-link (split-string url-and-title "::split::")) - (URL (car split-link)) - (description (cadr split-link)) - (org-link)) - (when (not (string= URL "")) - (setq org-link (org-make-link-string URL description))) - (kill-new org-link) - org-link)) + (org-mac-paste-applescript-links (org-as-mac-vimperator-get-frontmost-url))) (defun org-mac-vimperator-insert-frontmost-url () (interactive) @@ -383,15 +411,7 @@ The links are of the form <link>::split::<name>." (defun org-mac-chrome-get-frontmost-url () (interactive) (message "Applescript: Getting Chrome url...") - (let* ((url-and-title (org-as-mac-chrome-get-frontmost-url)) - (split-link (split-string url-and-title "::split::")) - (URL (car split-link)) - (description (cadr split-link)) - (org-link)) - (when (not (string= URL "")) - (setq org-link (org-make-link-string URL description))) - (kill-new org-link) - org-link)) + (org-mac-paste-applescript-links (org-as-mac-chrome-get-frontmost-url))) (defun org-mac-chrome-insert-frontmost-url () (interactive) @@ -422,8 +442,7 @@ The links are of the form <link>::split::<name>." ;; Handle links from together.app - -(org-add-link-type "x-together-item" '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) "Open UID, which is a reference to an item in Together." @@ -478,8 +497,7 @@ The links are of the form <link>::split::<name>." ;; Handle links from AddressBook.app - -(org-add-link-type "addressbook" 'org-mac-addressbook-item-open) +(org-link-set-parameters "addressbook" :follow #'org-mac-addressbook-item-open) (defun org-mac-addressbook-item-open (uid) "Open UID, which is a reference to an item in the addressbook." @@ -512,7 +530,7 @@ The links are of the form <link>::split::<name>." ;; ;; Original code & idea by Christopher Suckling (org-mac-protocol) -(org-add-link-type "skim" 'org-mac-skim-open) +(org-link-set-parameters "skim" :follow #'org-mac-skim-open) (defun org-mac-skim-open (uri) "Visit page of pdf in Skim" @@ -557,30 +575,73 @@ The links are of the form <link>::split::<name>." (defun org-mac-skim-get-page () (interactive) (message "Applescript: Getting Skim page link...") - (let* ((link-and-descr (as-get-skim-page-link)) - (split-link (split-string link-and-descr "::split::")) - (link (car split-link)) - (description (cadr split-link)) - (org-link)) - (when (not (string= link "")) - (setq org-link (org-make-link-string link description))) - (kill-new org-link) - org-link)) + (org-mac-paste-applescript-links (as-get-skim-page-link))) (defun org-mac-skim-insert-page () (interactive) (insert (org-mac-skim-get-page))) +;; Handle links from Adobe Acrobat Pro.app +;; +;; Original code & idea by Christopher Suckling (org-mac-protocol) +;; +;; The URI format is path_to_pdf_file::page_number + +(org-link-set-parameters "acrobat" :follow #'org-mac-acrobat-open) + +(defun org-mac-acrobat-open (uri) + "Visit page of pdf in Acrobat" + (let* ((page (when (string-match "::\\(.+\\)\\'" uri) + (match-string 1 uri))) + (document (substring uri 0 (match-beginning 0)))) + (do-applescript + (concat + "tell application \"Adobe Acrobat Pro\"\n" + " activate\n" + " set theDoc to \"" document "\"\n" + " set thePage to " page "\n" + " open theDoc\n" + " tell PDF Window 1\n" + " goto page thePage\n" + " end tell\n" + "end tell")))) + +;; The applescript returns link in the format +;; "adobe:path_to_pdf_file::page_number::split::document_title, p.page_label" + +(defun org-mac-as-get-acrobat-page-link () + (do-applescript + (concat + "tell application \"Adobe Acrobat Pro\"\n" + " set theDoc to active doc\n" + " set theWindow to (PDF Window 1 of theDoc)\n" + " set thePath to (file alias of theDoc)\n" + " set theTitle to (name of theWindow)\n" + " set thePage to (page number of theWindow)\n" + " set theLabel to (label text of (page thePage of theWindow))\n" + "end tell\n" + "set theResult to \"acrobat:\" & thePath & \"::\" & thePage & \"::split::\" & theTitle & \", p.\" & theLabel\n" + "return theResult as string\n"))) + +(defun org-mac-acrobat-get-page () + (interactive) + (message "Applescript: Getting Acrobat page link...") + (org-mac-paste-applescript-links (org-mac-as-get-acrobat-page-link))) + +(defun org-mac-acrobat-insert-page () + (interactive) + (insert (org-mac-acrobat-get-page))) + ;; Handle links from Microsoft Outlook.app -(org-add-link-type "mac-outlook" 'org-mac-outlook-message-open) +(org-link-set-parameters "mac-outlook" :follow #'org-mac-outlook-message-open) (defun org-mac-outlook-message-open (msgid) "Open a message in Outlook" (do-applescript (concat - "tell application \"/Applications/Microsoft Office 2011/Microsoft Outlook.app\"\n" + "tell application \"" org-mac-outlook-path "\"\n" (format "open message id %s\n" (substring-no-properties msgid)) "activate\n" "end tell"))) @@ -589,7 +650,7 @@ The links are of the form <link>::split::<name>." "AppleScript to create links to selected messages in Microsoft Outlook.app." (do-applescript (concat - "tell application \"/Applications/Microsoft Office 2011/Microsoft Outlook.app\"\n" + "tell application \"" org-mac-outlook-path "\"\n" "set msgCount to count current messages\n" "if (msgCount < 1) then\n" "return\n" @@ -640,27 +701,12 @@ The Org-syntax text will be pushed to the kill ring, and also returned." (interactive "sLink to (s)elected or (f)lagged messages: ") (setq select-or-flag (or select-or-flag "s")) (message "Org Mac Outlook: searching mailboxes...") - (let* ((as-link-list - (if (string= select-or-flag "s") - (org-as-get-selected-outlook-mail) - (if (string= select-or-flag "f") - (org-sh-get-flagged-outlook-mail) - (error "Please select \"s\" or \"f\"")))) - (link-list - (mapcar - (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x) - (split-string as-link-list "[\r\n]+"))) - split-link URL description orglink orglink-insert rtn orglink-list) - (while link-list - (setq split-link (split-string (pop link-list) "::split::")) - (setq URL (car split-link)) - (setq description (cadr split-link)) - (when (not (string= URL "")) - (setq orglink (org-make-link-string URL description)) - (push orglink orglink-list))) - (setq rtn (mapconcat 'identity orglink-list "\n")) - (kill-new rtn) - rtn)) + (org-mac-paste-applescript-links + (if (string= select-or-flag "s") + (org-as-get-selected-outlook-mail) + (if (string= select-or-flag "f") + (org-sh-get-flagged-outlook-mail) + (error "Please select \"s\" or \"f\""))))) (defun org-mac-outlook-message-insert-selected () "Insert a link to the messages currently selected in Microsoft Outlook.app. @@ -695,11 +741,60 @@ after heading." (insert "\n") (org-insert-heading nil t) (insert org-heading "\n" (org-mac-outlook-message-get-links "f")))))) + +;; Handle links from Evernote.app + +(org-link-set-parameters "mac-evernote" :follow #'org-mac-evernote-note-open) + +(defun org-mac-evernote-note-open (noteid) + "Open a note in Evernote" + (do-applescript + (concat + "tell application \"" org-mac-evernote-path "\"\n" + " set theNotes to get every note of every notebook where its local id is \"" (substring-no-properties noteid) "\"\n" + " repeat with _note in theNotes\n" + " if length of _note is not 0 then\n" + " set _selectedNote to _note\n" + " end if\n" + " end repeat\n" + " open note window with item 1 of _selectedNote\n" + " activate\n" + "end tell"))) + +(defun org-as-get-selected-evernote-notes () + "AppleScript to create links to selected notes in Evernote.app." + (do-applescript + (concat + "tell application \"" org-mac-evernote-path "\"\n" + " set noteCount to count selection\n" + " if (noteCount < 1) then\n" + " return\n" + " end if\n" + " set theLinkList to {}\n" + " set theSelection to selection\n" + " repeat with theNote in theSelection\n" + " set theTitle to title of theNote\n" + " set theID to local id of theNote\n" + " set theURL to \"mac-evernote:\" & theID\n" + " set theLink to theURL & \"::split::\" & theTitle & \"\n\"\n" + " copy theLink to end of theLinkList\n" + " end repeat\n" + " return theLinkList as string\n" + "end tell\n"))) + +(defun org-mac-evernote-note-insert-selected () + "Insert a link to the notes currently selected in Evernote.app. +This will use AppleScript to get the note id and the title of the +note(s) in Evernote.app and make a link out of it/them." + (interactive) + (message "Org Mac Evernote: searching notes...") +(insert (org-mac-paste-applescript-links + (org-as-get-selected-evernote-notes)))) ;; Handle links from DEVONthink Pro Office.app -(org-add-link-type "x-devonthink-item" 'org-devonthink-item-open) +(org-link-set-parameters "x-devonthink-item" :follow #'org-devonthink-item-open) (defun org-devonthink-item-open (uid) "Open UID, which is a reference to an item in DEVONthink Pro Office." @@ -734,25 +829,7 @@ selected items in DEVONthink Pro Office.app and make links out of it/them. This function will push the Org-syntax text to the kill ring, and also return it." (message "Org Mac DEVONthink: looking for selected items...") - (let* ((as-link-list (org-as-get-selected-devonthink-item)) - (link-list (if as-link-list - (mapcar - (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) - (setq x (match-string 1 x))) - x) - (split-string as-link-list "[\r\n]+")) - nil)) - orglink-list) - (while link-list - (let* ((current-item (pop link-list))) - (message "current item: %s" current-item) - (when (and current-item (not (string= current-item ""))) - (let* ((split-link (split-string current-item "::split::")) - (orglink (org-make-link-string - (url-encode-url (car split-link)) - (cadr split-link)))) - (push orglink orglink-list))))) - (kill-new (mapconcat 'identity orglink-list "\n")))) + (org-mac-paste-applescript-links (org-as-get-selected-devonthink-item))) (defun org-mac-devonthink-item-insert-selected () "Insert a link to the item(s) currently selected in DEVONthink Pro Office. @@ -764,7 +841,7 @@ selected items in DEVONthink Pro Office and make link(s) out of it/them." ;; Handle links from Mail.app -(org-add-link-type "message" 'org-mac-message-open) +(org-link-set-parameters "message" :follow #'org-mac-message-open) (defun org-mac-message-open (message-id) "Visit the message with MESSAGE-ID. diff --git a/contrib/lisp/org-mairix.el b/contrib/lisp/org-mairix.el index a19719e..84c2dfd 100644 --- a/contrib/lisp/org-mairix.el +++ b/contrib/lisp/org-mairix.el @@ -82,8 +82,9 @@ correctly, you should not need to change this. ;;; The hooks to integrate mairix into org -(org-add-link-type "mairix" 'org-mairix-open) -(add-hook 'org-store-link-functions 'org-mairix-store-gnus-link) +(org-link-set-parameters "mairix" + :follow #'org-mairix-open + :store #'org-mairix-store-gnus-link) ;;; Generic org-mairix functions @@ -93,7 +94,7 @@ correctly, you should not need to change this. (if org-mairix-threaded-links "t:") (if org-mairix-augmented-links "a:") "@@" - (org-remove-angle-brackets message-id))) + (org-unbracket-string "<" ">" message-id))) (defun org-store-mairix-link-props (&rest plist) "Take a property list describing a mail, and add mairix link diff --git a/contrib/lisp/org-man.el b/contrib/lisp/org-man.el index a9db83d..1ccd942 100644 --- a/contrib/lisp/org-man.el +++ b/contrib/lisp/org-man.el @@ -25,8 +25,10 @@ (require 'org) -(org-add-link-type "man" 'org-man-open 'org-man-export) -(add-hook 'org-store-link-functions 'org-man-store-link) +(org-link-set-parameters "man" + :follow #'org-man-open + :export #'org-man-export + :store #'org-man-store-link) (defcustom org-man-command 'man "The Emacs command to be used to display a man page." diff --git a/contrib/lisp/org-mew.el b/contrib/lisp/org-mew.el index 8f7f609..2c2bdcc 100644 --- a/contrib/lisp/org-mew.el +++ b/contrib/lisp/org-mew.el @@ -148,8 +148,7 @@ with \"t\" key." (defvar mew-summary-goto-line-then-display) ;; Install the link type -(org-add-link-type "mew" 'org-mew-open) -(add-hook 'org-store-link-functions 'org-mew-store-link) +(org-link-set-parameters "mew" :follow #'org-mew-open :store #'org-mew-store-link) ;; Implementation (defun org-mew-store-link () @@ -167,20 +166,11 @@ with \"t\" key." (from (mew-header-get-value "From:")) (to (mew-header-get-value "To:")) (date (mew-header-get-value "Date:")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) (subject (mew-header-get-value "Subject:")) desc link) - (org-store-link-props :type "mew" :from from :to to + (org-store-link-props :type "mew" :from from :to to :date date :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq message-id (org-remove-angle-brackets message-id)) + (setq message-id (org-unbracket-string "<" ">" message-id)) (setq desc (org-email-link-description)) (setq link (concat "mew:" folder-name "#" message-id)) (org-add-link-props :link link :description desc) @@ -290,12 +280,12 @@ the subject and the group number to extract. You can get rid of (setq subject (mew-header-get-value "Subject:")) (setq message-id (mew-header-get-value "Message-Id:")) (setq references (mew-header-get-value "References:"))) - (setq id-list (mapcar (lambda (id) (org-remove-angle-brackets id)) + (setq id-list (mapcar (lambda (id) (org-unbracket-string "<" ">" id)) (mew-idstr-to-id-list references))) (if last-reference-only (setq id-list (last id-list)) (if message-id - (setq id-list (cons (org-remove-angle-brackets message-id) + (setq id-list (cons (org-unbracket-string "<" ">" message-id) id-list)))) (when (and by-subject (stringp subject)) (catch 'matched diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el index 682f635..2ced42e 100644 --- a/contrib/lisp/org-mime.el +++ b/contrib/lisp/org-mime.el @@ -57,6 +57,7 @@ (declare-function org-export-string-as "ox" (string backend &optional body-only ext-plist)) +(declare-function org-trim "org" (s &optional keep-lead)) (defcustom org-mime-use-property-inheritance nil "Non-nil means al MAIL_ properties apply also for sublevels." @@ -173,7 +174,7 @@ and images in a multipart/related part." "--" "}-<<alternative>>\n")) ('vm "?"))) -(defun org-mime-replace-images (str current-file) +(defun org-mime-replace-images (str) "Replace images in html files with cid links." (let (html-images) (cons @@ -185,7 +186,7 @@ and images in a multipart/related part." (let* ((url (and (string-match "src=\"\\([^\"]+\\)\"" text) (match-string 1 text))) (path (expand-file-name - url (file-name-directory current-file))) + url temporary-file-directory)) (ext (file-name-extension path)) (id (replace-regexp-in-string "[\/\\\\]" "_" path))) (add-to-list 'html-images @@ -212,8 +213,6 @@ otherwise export the entire body." (point-max))) (raw-body (concat org-mime-default-header (buffer-substring html-start html-end))) - (tmp-file (make-temp-name (expand-file-name - "mail" temporary-file-directory))) (body (org-export-string-as raw-body 'org t)) ;; because we probably don't want to export a huge style file (org-export-htmlize-output-type 'inline-css) @@ -224,7 +223,7 @@ otherwise export the entire body." ;; to hold attachments for inline html images (html-and-images (org-mime-replace-images - (org-export-string-as raw-body 'html t) tmp-file)) + (org-export-string-as raw-body 'html t))) (html-images (unless arg (cdr html-and-images))) (html (org-mime-apply-html-hook (if arg @@ -304,7 +303,7 @@ otherwise export the entire body." ((eq fmt 'org) (require 'ox-org) (insert (org-export-string-as - (org-babel-trim (funcall bhook body 'org)) 'org t))) + (org-trim (funcall bhook body 'org)) 'org t))) ((eq fmt 'ascii) (require 'ox-ascii) (insert (org-export-string-as @@ -317,12 +316,12 @@ otherwise export the entire body." (org-export-htmlize-output-type 'inline-css) (html-and-images (org-mime-replace-images - (org-export-string-as (funcall bhook body 'html) 'html t) file)) + (org-export-string-as (funcall bhook body 'html) 'html t))) (images (cdr html-and-images)) (html (org-mime-apply-html-hook (car html-and-images)))) (insert (org-mime-multipart (org-export-string-as - (org-babel-trim + (org-trim (funcall bhook body (if (eq fmt 'html) 'org 'ascii))) (if (eq fmt 'html) 'org 'ascii) t) html) diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el index 91b34d3..d0acdec 100644 --- a/contrib/lisp/org-notify.el +++ b/contrib/lisp/org-notify.el @@ -130,7 +130,7 @@ simple timestamp string." (pr :file (nth org-notify-parse-file (org-agenda-files 'unrestricted))) (pr :timestamp deadline) (pr :uid (md5 (concat heading deadline))) (pr :deadline (- (org-time-string-to-seconds deadline) - (org-float-time)))) + (float-time)))) result))) (defun org-notify-todo-list () @@ -165,7 +165,7 @@ forgotten tasks." (dolist (prms (plist-get org-notify-map (td :notify))) (when (< deadline (org-notify-string->seconds (prm :time))) (let ((period (org-notify-string->seconds (prm :period))) - (last-run (prm last-run-sym)) (now (org-float-time)) + (last-run (prm last-run-sym)) (now (float-time)) (actions (prm :actions)) diff plist) (when (or (not last-run) (and period (< period (setq diff (- now last-run))) diff --git a/contrib/lisp/org-notmuch.el b/contrib/lisp/org-notmuch.el index 712ec5a..65d7550 100644 --- a/contrib/lisp/org-notmuch.el +++ b/contrib/lisp/org-notmuch.el @@ -65,21 +65,23 @@ Should accept a notmuch search string as the sole argument." ;; Install the link type -(org-add-link-type "notmuch" 'org-notmuch-open) -(add-hook 'org-store-link-functions 'org-notmuch-store-link) +(org-link-set-parameters "notmuch" + :follow #'org-notmuch-open + :store #'org-notmuch-store-link) (defun org-notmuch-store-link () "Store a link to a notmuch search or message." (when (eq major-mode 'notmuch-show-mode) - (let* ((message-id (notmuch-show-get-prop :id)) + (let* ((message-id (notmuch-show-get-message-id t)) (subject (notmuch-show-get-subject)) (to (notmuch-show-get-to)) (from (notmuch-show-get-from)) + (date (org-trim (notmuch-show-get-date))) desc link) - (org-store-link-props :type "notmuch" :from from :to to + (org-store-link-props :type "notmuch" :from from :to to :date date :subject subject :message-id message-id) (setq desc (org-email-link-description)) - (setq link (concat "notmuch:" "id:" message-id)) + (setq link (concat "notmuch:id:" message-id)) (org-add-link-props :link link :description desc) link))) @@ -92,13 +94,13 @@ Should accept a notmuch search string as the sole argument." Can link to more than one message, if so all matching messages are shown." (require 'notmuch) - (notmuch-show (org-link-unescape search))) - + (notmuch-show search)) -(org-add-link-type "notmuch-search" 'org-notmuch-search-open) -(add-hook 'org-store-link-functions 'org-notmuch-search-store-link) +(org-link-set-parameters "notmuch-search" + :follow #'org-notmuch-search-open + :store #'org-notmuch-search-store-link) (defun org-notmuch-search-store-link () "Store a link to a notmuch search or message." diff --git a/contrib/lisp/org-screenshot.el b/contrib/lisp/org-screenshot.el index d44063a..3716020 100644 --- a/contrib/lisp/org-screenshot.el +++ b/contrib/lisp/org-screenshot.el @@ -338,8 +338,8 @@ by most recent first" org-screenshot-rotation-index -1 org-screenshot-file-list (let ((files (directory-files org-screenshot-image-directory - t (org-image-file-name-regexp) t))) - (mapcar 'file-name-nondirectory + t (image-file-name-regexp) t))) + (mapcar 'file-name-nondirectory (sort files (lambda (file1 file2) (let ((mtime1 (nth 5 (file-attributes file1))) @@ -364,7 +364,7 @@ other direction" (link-re ;; taken from `org-display-inline-images' (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" - (substring (org-image-file-name-regexp) 0 -2) + (substring (image-file-name-regexp) 0 -2) "\\)\\]")) newfile oldfile) (save-excursion @@ -496,7 +496,7 @@ entered, at which point event will be unread" (let ((files-in-buffer) dired-buffer had-any - (image-re (org-image-file-name-regexp)) + (image-re (image-file-name-regexp)) beg end) (save-excursion (save-restriction @@ -504,7 +504,7 @@ entered, at which point event will be unread" (setq beg (or beg (point-min)) end (or end (point-max))) (goto-char beg) (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" - (substring (org-image-file-name-regexp) 0 -2) + (substring (image-file-name-regexp) 0 -2) "\\)\\]")) (case-fold-search t) old file ov img type attrwidth width) diff --git a/contrib/lisp/org-toc.el b/contrib/lisp/org-toc.el index b82952e..a692d85 100644 --- a/contrib/lisp/org-toc.el +++ b/contrib/lisp/org-toc.el @@ -197,7 +197,7 @@ specified, then make `org-toc-recenter' use this value." (setq ov (make-overlay beg end))) ;; change the folding status of this headline (cond ((or (null status) (eq status 'folded)) - (show-children) + (org-show-children) (message "CHILDREN") (overlay-put ov 'status 'children)) ((eq status 'children) @@ -441,7 +441,7 @@ current table of contents to it." (setq ov (make-overlay (match-beginning 0) (match-end 0)))) (cond ((eq (cdr hlcfg0) 'children) - (show-children) + (org-show-children) (message "CHILDREN") (overlay-put ov 'status 'children)) ((eq (cdr hlcfg0) 'branches) diff --git a/contrib/lisp/org-vm.el b/contrib/lisp/org-vm.el index 18d1be6..070d2f8 100644 --- a/contrib/lisp/org-vm.el +++ b/contrib/lisp/org-vm.el @@ -55,9 +55,8 @@ (defvar vm-folder-directory) ;; Install the link type -(org-add-link-type "vm" 'org-vm-open) -(org-add-link-type "vm-imap" 'org-vm-imap-open) -(add-hook 'org-store-link-functions 'org-vm-store-link) +(org-link-set-parameters "vm" :follow #'org-vm-open :store #'org-vm-store-link) +(org-link-set-parameters "vm-imap" :follow #'org-vm-imap-open) ;; Implementation (defun org-vm-store-link () @@ -77,12 +76,6 @@ (message-id (vm-su-message-id message)) (link-type (if (vm-imap-folder-p) "vm-imap" "vm")) (date (vm-get-header-contents message "Date")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) folder desc link) (if (vm-imap-folder-p) (let ((spec (vm-imap-find-spec-for-buffer (current-buffer)))) @@ -93,12 +86,9 @@ (string-match (concat "^" (regexp-quote vm-folder-directory)) folder)) (setq folder (replace-match "" t t folder))))) - (setq message-id (org-remove-angle-brackets message-id)) + (setq message-id (org-unbracket-string "<" ">" message-id)) (org-store-link-props :type link-type :from from :to to :subject subject - :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) + :message-id message-id :date date) (setq desc (org-email-link-description)) (setq link (concat (concat link-type ":") folder "#" message-id)) (org-add-link-props :link link :description desc) @@ -126,12 +116,10 @@ (cond ((featurep 'tramp) ;; use tramp to access the file - (if (featurep 'xemacs) - (setq folder (format "[%s@%s]%s" user host file)) - (setq folder (format "/%s@%s:%s" user host file)))) + (setq folder (format "/%s@%s:%s" user host file))) (t ;; use ange-ftp or efs - (require (if (featurep 'xemacs) 'efs 'ange-ftp)) + (require 'ange-ftp) (setq folder (format "/%s@%s:%s" user host file)))))) (when folder (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el index 428cb6c..02c170d 100644 --- a/contrib/lisp/org-wikinodes.el +++ b/contrib/lisp/org-wikinodes.el @@ -203,7 +203,7 @@ setting of `org-wikinodes-create-targets'." (widen) (goto-char (point-min)) (while (re-search-forward re nil t) - (push (org-match-string-no-properties 4) targets)))) + (push (match-string-no-properties 4) targets)))) (nreverse targets))) (defun org-wikinodes-get-links-for-directory (dir) diff --git a/contrib/lisp/org-wl.el b/contrib/lisp/org-wl.el index 9d7eb44..01eee13 100644 --- a/contrib/lisp/org-wl.el +++ b/contrib/lisp/org-wl.el @@ -109,8 +109,7 @@ googlegroups otherwise." "List of folder indicators. See Wanderlust manual, section 3.") ;; Install the link type -(org-add-link-type "wl" 'org-wl-open) -(add-hook 'org-store-link-functions 'org-wl-store-link) +(org-link-set-parameters "wl" :follow #'org-wl-open :store #'org-wl-store-link) ;; Implementation @@ -192,18 +191,12 @@ ENTITY is a message entity." (message-id (org-wl-message-field 'message-id wl-message-entity)) (message-id-no-brackets - (org-remove-angle-brackets message-id)) + (org-unbracket-string "<" ">" message-id)) (from (org-wl-message-field 'from wl-message-entity)) (to (org-wl-message-field 'to wl-message-entity)) (xref (org-wl-message-field 'xref wl-message-entity)) (subject (org-wl-message-field 'subject wl-message-entity)) (date (org-wl-message-field 'date wl-message-entity)) - (date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) desc link) ;; remove text properties of subject string to avoid possible bug @@ -243,9 +236,7 @@ ENTITY is a message entity." (setq desc (org-email-link-description)) (setq link (concat "wl:" folder-name "#" message-id-no-brackets)) (org-add-link-props :link link :description desc))) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) + (org-add-link-props :date date) (or link xref))))))) (defun org-wl-open-nntp (path) @@ -287,8 +278,8 @@ for namazu index." org-wl-namazu-default-index) org-wl-namazu-default-index (read-directory-name "Namazu index: "))))) - (if (not (elmo-folder-exists-p (org-no-warnings - (wl-folder-get-elmo-folder folder)))) + (if (not (elmo-folder-exists-p (with-no-warnings + (wl-folder-get-elmo-folder folder)))) (error "No such folder: %s" folder)) (let ((old-buf (current-buffer)) (old-point (point-marker))) @@ -299,7 +290,7 @@ for namazu index." ;; in the old buffer. (goto-char old-point)) (when article - (if (org-string-match-p "@" article) + (if (string-match-p "@" article) (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets article)) (or (wl-summary-jump-to-msg (string-to-number article)) diff --git a/contrib/lisp/ox-bibtex.el b/contrib/lisp/ox-bibtex.el index 9d548bb..56dec38 100644 --- a/contrib/lisp/ox-bibtex.el +++ b/contrib/lisp/ox-bibtex.el @@ -92,7 +92,7 @@ ;; Initialization -(eval-when-compile (require 'cl)) +(require 'cl-lib) ;;; Internal Functions @@ -136,7 +136,7 @@ contains a list of strings to be passed as options to (defun org-bibtex-citation-p (object) "Non-nil when OBJECT is a citation." - (case (org-element-type object) + (cl-case (org-element-type object) (link (equal (org-element-property :type object) "cite")) (latex-fragment (string-match "\\`\\\\cite{" (org-element-property :value object))))) @@ -159,9 +159,7 @@ to `org-bibtex-citation-p' predicate." (defun org-bibtex-goto-citation (&optional citation) "Visit a citation given its ID." (interactive) - (let ((citation (or citation - (org-icompleting-read "Citation: " - (obe-citations))))) + (let ((citation (or citation (completing-read "Citation: " (obe-citations))))) (find-file (or org-bibtex-file (error "`org-bibtex-file' has not been configured"))) (goto-char (point-min)) @@ -169,7 +167,7 @@ to `org-bibtex-citation-p' predicate." (outline-previous-visible-heading 1) t))) -(let ((jump-fn (car (org-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)) @@ -305,7 +303,7 @@ the HTML and ASCII backends." next) (while (and (setq next (org-export-get-next-element object info)) (or (and (stringp next) - (not (org-string-match-p "\\S-" next))) + (not (string-match-p "\\S-" next))) (org-bibtex-citation-p next))) (unless (stringp next) (push (org-bibtex-get-citation-key next) keys)) diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el index 9b96d5f..48bc5ea 100644 --- a/contrib/lisp/ox-confluence.el +++ b/contrib/lisp/ox-confluence.el @@ -47,6 +47,7 @@ (italic . org-confluence-italic) (item . org-confluence-item) (link . org-confluence-link) + (paragraph . org-confluence-paragraph) (property-drawer . org-confluence-property-drawer) (section . org-confluence-section) (src-block . org-confluence-src-block) @@ -57,6 +58,11 @@ (template . org-confluence-template) (underline . org-confluence-underline))) +(defcustom org-confluence-lang-alist + '(("sh" . "bash")) + "Map from org-babel language name to confluence wiki language name" + :type '(alist :key-type string :value-type string)) + ;; All the functions we use (defun org-confluence-bold (bold contents info) (format "*%s*" contents)) @@ -101,6 +107,12 @@ raw-link)) "]"))) +(defun org-confluence-paragraph (paragraph contents info) + "Transcode PARAGRAPH element for Confluence. +CONTENTS is the paragraph contents. INFO is a plist used as +a communication channel." + contents) + (defun org-confluence-property-drawer (property-drawer contents info) (and (org-string-nw-p contents) (format "\{\{%s\}\}" contents))) @@ -111,8 +123,7 @@ (defun org-confluence-src-block (src-block contents info) ;; FIXME: provide a user-controlled variable for theme (let* ((lang (org-element-property :language src-block)) - (language (if (string= lang "sh") "bash" ;; FIXME: provide a mapping of some sort - lang)) + (language (or (cdr (assoc lang org-confluence-lang-alist)) lang)) (content (org-export-format-code-default src-block info))) (org-confluence--block language "Emacs" content))) diff --git a/contrib/lisp/ox-extra.el b/contrib/lisp/ox-extra.el index e6d45cc..85dae47 100644 --- a/contrib/lisp/ox-extra.el +++ b/contrib/lisp/ox-extra.el @@ -37,9 +37,9 @@ ;; for export. These blocks should be tagged with #+header: :header ;; yes. For example: ;; #+header: :header yes -;; #+begin_latex +;; #+begin_export latex ;; ... -;; #+end_latex +;; #+end_export ;; - `ignore-headlines' -- allow a headline (but not its children) to ;; be ignored. Any headline tagged with the 'ignore' tag will be diff --git a/contrib/lisp/ox-freemind.el b/contrib/lisp/ox-freemind.el index 3e4b6ae..85323a2 100644 --- a/contrib/lisp/ox-freemind.el +++ b/contrib/lisp/ox-freemind.el @@ -43,7 +43,6 @@ ;;; Define Back-End (org-export-define-derived-backend 'freemind 'html - :export-block "FREEMIND" :menu-entry '(?f "Export to Freemind Mindmap" ((?f "As Freemind Mindmap file" org-freemind-export-to-freemind) diff --git a/contrib/lisp/ox-gfm.el b/contrib/lisp/ox-gfm.el deleted file mode 100644 index f7acc94..0000000 --- a/contrib/lisp/ox-gfm.el +++ /dev/null @@ -1,193 +0,0 @@ -;;; ox-gfm.el --- Github Flavored Markdown Back-End for Org Export Engine - -;; Copyright (C) 2014 Lars Tveito - -;; Author: Lars Tveito -;; Keywords: org, wp, markdown, github - -;; This file is not part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements a Markdown back-end (github flavor) for Org -;; exporter, based on the `md' back-end. - -;;; Code: - -(require 'ox-md) - - - -;;; User-Configurable Variables - -(defgroup org-export-gfm nil - "Options specific to Markdown export back-end." - :tag "Org Github Flavored Markdown" - :group 'org-export - :version "24.4" - :package-version '(Org . "8.0")) - -(defcustom org-gfm-lang '(("emacs-lisp" . "lisp") ("elisp" . "lisp")) - "Alist of languages that are not recognized by Github, to - languages that are. Emacs lisp is a good example of this, where - we can use lisp as a nice replacement." - :group 'org-export-gfm) - - - -;;; Define Back-End - -(org-export-define-derived-backend 'gfm 'md - :export-block '("GFM" "GITHUB FLAVORED MARKDOWN") - :filters-alist '((:filter-parse-tree . org-md-separate-elements)) - :menu-entry - '(?g "Export to Github Flavored Markdown" - ((?G "To temporary buffer" - (lambda (a s v b) (org-gfm-export-as-markdown a s v))) - (?g "To file" (lambda (a s v b) (org-gfm-export-to-markdown a s v))) - (?o "To file and open" - (lambda (a s v b) - (if a (org-gfm-export-to-markdown t s v) - (org-open-file (org-gfm-export-to-markdown nil s v))))))) - :translate-alist '((inner-template . org-gfm-inner-template) - (strike-through . org-gfm-strike-through) - (src-block . org-gfm-src-block))) - - - -;;; Transcode Functions - -;;;; Src Block - -(defun org-gfm-src-block (src-block contents info) - "Transcode SRC-BLOCK element into Github Flavored Markdown -format. CONTENTS is nil. INFO is a plist used as a communication -channel." - (let* ((lang (org-element-property :language src-block)) - (lang (or (assoc-default lang org-gfm-lang) lang)) - (code (org-export-format-code-default src-block info)) - (prefix (concat "```" lang "\n")) - (suffix "```")) - (concat prefix code suffix))) - - -;;;; Strike-Through - -(defun org-html-strike-through (strike-through contents info) - "Transcode STRIKE-THROUGH from Org to Markdown (GFM). -CONTENTS is the text with strike-through markup. INFO is a plist -holding contextual information." - (format "~~%s~~" contents)) - -;;;; Table of contents - -(defun org-gfm-format-toc (headline) - "Return an appropriate table of contents entry for HEADLINE. INFO is a -plist used as a communication channel." - (let* ((title (org-export-data - (org-export-get-alt-title headline info) info)) - (level (1- (org-element-property :level headline))) - (indent (concat (make-string (* level 2) ? ))) - (ref-str (replace-regexp-in-string " " "-" (downcase title)))) - (concat indent "- [" title "]" "(#" ref-str ")"))) - - -;;;; Template - -(defun org-gfm-inner-template (contents info) - "Return body of document after converting it to Markdown syntax. -CONTENTS is the transcoded contents string. INFO is a plist -holding export options." - (let* ((depth (plist-get info :with-toc)) - (headlines (and depth (org-export-collect-headlines info depth))) - (toc-string (or (mapconcat 'org-gfm-format-toc headlines "\n") "")) - (toc-tail (if headlines "\n\n" ""))) - (concat toc-string toc-tail contents))) - - - -;;; Interactive function - -;;;###autoload -(defun org-gfm-export-as-markdown (&optional async subtreep visible-only) - "Export current buffer to a Github Flavored Markdown buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -Export is done in a buffer named \"*Org GFM Export*\", which will -be displayed when `org-export-show-temporary-export-buffer' is -non-nil." - (interactive) - (org-export-to-buffer 'gfm "*Org GFM Export*" - async subtreep visible-only nil nil (lambda () (text-mode)))) - - -;;;###autoload -(defun org-gfm-convert-region-to-md () - "Assume the current region has org-mode syntax, and convert it -to Github Flavored Markdown. This can be used in any buffer. -For example, you can write an itemized list in org-mode syntax in -a Markdown buffer and use this command to convert it." - (interactive) - (org-export-replace-region-by 'gfm)) - - -;;;###autoload -(defun org-gfm-export-to-markdown (&optional async subtreep visible-only) - "Export current buffer to a Github Flavored Markdown file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -Return output file's name." - (interactive) - (let ((outfile (org-export-output-file-name ".md" subtreep))) - (org-export-to-file 'gfm outfile async subtreep visible-only))) - -(provide 'ox-gfm) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-gfm.el ends here diff --git a/contrib/lisp/ox-groff.el b/contrib/lisp/ox-groff.el index 6489ee7..c83d44d 100644 --- a/contrib/lisp/ox-groff.el +++ b/contrib/lisp/ox-groff.el @@ -92,7 +92,6 @@ (underline . org-groff-underline) (verbatim . org-groff-verbatim) (verse-block . org-groff-verse-block)) - :export-block "GROFF" :menu-entry '(?g "Export to GROFF" ((?g "As GROFF file" org-groff-export-to-groff) @@ -1066,9 +1065,7 @@ contextual information." (let* ((code (org-element-property :value inline-src-block))) (cond (org-groff-source-highlight - (let* ((tmpdir (if (featurep 'xemacs) - temp-directory - temporary-file-directory)) + (let* ((tmpdir temporary-file-directory) (in-file (make-temp-name (expand-file-name "srchilite" tmpdir))) (out-file (make-temp-name @@ -1489,9 +1486,7 @@ contextual information." (custom-env (and lang (cadr (assq (intern lang) org-groff-custom-lang-environments)))) - (num-start (case (org-element-property :number-lines src-block) - (continued (org-export-get-loc src-block info)) - (new 0))) + (num-start (org-export-get-loc src-block info)) (retain-labels (org-element-property :retain-labels src-block)) (caption (and (not (org-export-read-attribute :attr_groff src-block :disable-caption)) @@ -1507,9 +1502,7 @@ contextual information." ;; Case 2. Source fontification. (org-groff-source-highlight - (let* ((tmpdir (if (featurep 'xemacs) - temp-directory - temporary-file-directory)) + (let* ((tmpdir temporary-file-directory) (in-file (make-temp-name (expand-file-name "srchilite" tmpdir))) (out-file (make-temp-name @@ -1903,6 +1896,7 @@ Return PDF file name or an error if it couldn't be produced." (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) (full-name (file-truename file)) (out-dir (file-name-directory file)) + (time (current-time)) ;; Properly set working directory for compilation. (default-directory (if (file-name-absolute-p file) (file-name-directory full-name) @@ -1937,7 +1931,12 @@ Return PDF file name or an error if it couldn't be produced." (let ((pdffile (concat out-dir base-name ".pdf"))) ;; Check for process failure. Provide collected errors if ;; possible. - (if (not (file-exists-p pdffile)) + (if (or (not (file-exists-p pdffile)) + ;; Only compare times up to whole seconds as some + ;; filesystems (e.g. HFS+) do not retain any finer + ;; granularity. + (time-less-p (cl-subseq (nth 5 (file-attributes pdffile)) 0 2) + (cl-subseq time 0 2))) (error (concat (format "PDF file %s wasn't produced" pdffile) (when errors (concat ": " errors)))) ;; Else remove log files, when specified, and signal end of diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el index 48d4ead..801ab7d 100644 --- a/contrib/lisp/ox-koma-letter.el +++ b/contrib/lisp/ox-koma-letter.el @@ -41,13 +41,14 @@ ;; - PHONE_NUMBER: see `org-koma-letter-phone-number', ;; - SIGNATURE: see `org-koma-letter-signature', ;; - PLACE: see `org-koma-letter-place', +;; - LOCATION: see `org-koma-letter-location', ;; - TO_ADDRESS: If unspecified this is set to "\mbox{}". ;; -;; TO_ADDRESS and FROM_ADDRESS can also be specified using heading -;; with the special tags specified in -;; `org-koma-letter-special-tags-in-letter', namely "to" and "from". -;; LaTeX line breaks are not necessary if using these headings. If -;; both a headline and a keyword specify a to or from address the +;; TO_ADDRESS, FROM_ADDRESS, LOCATION, CLOSING, and SIGNATURE can also +;; be specified using "special headings" with the special tags +;; specified in `org-koma-letter-special-tags-in-letter'. LaTeX line +;; breaks are not necessary for TO_ADDRESS, FROM_ADDRESS and LOCATION. +;; If both a headline and a keyword specify a to or from address the ;; value is determined in accordance with ;; `org-koma-letter-prefer-special-headings'. ;; @@ -58,6 +59,7 @@ ;; - phone (see `org-koma-letter-use-phone') ;; - email (see `org-koma-letter-use-email') ;; - place (see `org-koma-letter-use-place') +;; - location (see `org-koma-letter-use-location') ;; - subject, a list of format options ;; (see `org-koma-letter-subject-format') ;; - after-closing-order, a list of the ordering of headings with @@ -80,9 +82,9 @@ ;; `org-koma-letter-special-tags-after-closing' used as macros and the ;; content of the headline is the argument. ;; -;; Headlines with two and from may also be used rather than the -;; keyword approach described above. If both a keyword and a headline -;; with information is present precedence is determined by +;; Headlines with to and from may also be used rather than the keyword +;; approach described above. If both a keyword and a headline with +;; information is present precedence is determined by ;; `org-koma-letter-prefer-special-headings'. ;; ;; You need an appropriate association in `org-latex-classes' in order @@ -188,17 +190,35 @@ This option can also be set with the PLACE keyword." :group 'org-export-koma-letter :type 'string) +(defcustom org-koma-letter-location "" + "Sender's extension field, as a string. + +This option can also be set with the LOCATION keyword. +Moreover, when: + (1) Either `org-koma-letter-prefer-special-headings' is non-nil + or there is no LOCATION keyword or the LOCATION keyword is + empty; + (2) the letter contains a headline with the special + tag \"location\"; +then the location will be set as the content of the location +special heading. + +The location field is typically printed right of the address +field (See Figure 4.9. in the English manual of 2015-10-03)." + :group 'org-export-koma-letter + :type 'string) + (defcustom org-koma-letter-opening "" "Letter's opening, as a string. This option can also be set with the OPENING keyword. Moreover, when: - (1) this value is the empty string; - (2) there's no OPENING keyword or it is empty; - (3) `org-koma-letter-headline-is-opening-maybe' is non-nil; - (4) the letter contains a headline without a special + (1) Either `org-koma-letter-prefer-special-headings' is non-nil + or the CLOSING keyword is empty + (2) `org-koma-letter-headline-is-opening-maybe' is non-nil; + (3) the letter contains a headline without a special tag (e.g. \"to\" or \"ps\"); -then the opening will be implicitly set as the headline title." +then the opening will be implicitly set as the untagged headline title." :group 'org-export-koma-letter :type 'string) @@ -206,12 +226,13 @@ then the opening will be implicitly set as the headline title." "Letter's closing, as a string. This option can also be set with the CLOSING keyword. Moreover, when: - (1) there's no CLOSING keyword or it is empty; + (1) Either `org-koma-letter-prefer-special-headings' is non-nil + or the CLOSING keyword is empty; (2) `org-koma-letter-headline-is-opening-maybe' is non-nil; (3) the letter contains a headline with the special - tag closing; + tag \"closing\"; then the opening will be set as the title of the closing special -heading." +heading title." :group 'org-export-koma-letter :type 'string) @@ -219,12 +240,15 @@ heading." "Signature, as a string. This option can also be set with the SIGNATURE keyword. Moreover, when: - (1) there's no CLOSING keyword or it is empty; + (1) Either `org-koma-letter-prefer-special-headings' is non-nil + or there is no CLOSING keyword or the CLOSING keyword is empty; (2) `org-koma-letter-headline-is-opening-maybe' is non-nil; (3) the letter contains a headline with the special - tag closing; + tag \"closing\"; then the signature will be set as the content of the -closing special heading." +closing special heading. + +Note if the content is empty the signature will not be set." :group 'org-export-koma-letter :type 'string) @@ -359,9 +383,9 @@ The value must be a member of `org-latex-classes'." :type 'string) (defcustom org-koma-letter-headline-is-opening-maybe t - "Non-nil means a headline may be used as an opening. -A headline is only used if #+OPENING is not set. See also -`org-koma-letter-opening'." + "Non-nil means a headline may be used as an opening and closing. +See also `org-koma-letter-opening' and +`org-koma-letter-closing'." :group 'org-export-koma-letter :type 'boolean) @@ -372,14 +396,17 @@ e.g. \"title-subject:t\"." :group 'org-export-koma-letter :type 'boolean) -(defconst org-koma-letter-special-tags-in-letter '(to from closing) +(defconst org-koma-letter-special-tags-in-letter '(to from closing location) "Header tags related to the letter itself.") -(defconst org-koma-letter-special-tags-after-closing '(ps encl cc) - "Header tags to be inserted after closing.") +(defconst org-koma-letter-special-tags-after-closing '(after_closing ps encl cc) + "Header tags to be inserted in the letter after closing.") + +(defconst org-koma-letter-special-tags-as-macro '(ps encl cc) + "Header tags to be inserted as macros") (defconst org-koma-letter-special-tags-after-letter '(after_letter) - "Header tags to be inserted after closing.") + "Header tags to be inserted after the letter.") (defvar org-koma-letter-special-contents nil "Holds special content temporarily.") @@ -402,20 +429,18 @@ e.g. \"title-subject:t\"." (:email "EMAIL" nil (org-koma-letter--get-value org-koma-letter-email) t) (:to-address "TO_ADDRESS" nil nil newline) (:place "PLACE" nil org-koma-letter-place) + (:location "LOCATION" nil org-koma-letter-location) (:subject "SUBJECT" nil nil parse) (:opening "OPENING" nil org-koma-letter-opening parse) (:closing "CLOSING" nil org-koma-letter-closing parse) (:signature "SIGNATURE" nil org-koma-letter-signature newline) - (:special-headings nil "special-headings" - org-koma-letter-prefer-special-headings) - (:special-tags nil nil (append - org-koma-letter-special-tags-in-letter - org-koma-letter-special-tags-after-closing - org-koma-letter-special-tags-after-letter)) - (:with-after-closing nil "after-closing-order" - org-koma-letter-special-tags-after-closing) - (:with-after-letter nil "after-letter-order" - org-koma-letter-special-tags-after-letter) + (:special-headings nil "special-headings" org-koma-letter-prefer-special-headings) + (:special-tags-as-macro nil nil org-koma-letter-special-tags-as-macro) + (:special-tags-in-letter nil nil org-koma-letter-special-tags-in-letter) + (:special-tags-after-closing nil "after-closing-order" + org-koma-letter-special-tags-after-closing) + (:special-tags-after-letter nil "after-letter-order" + org-koma-letter-special-tags-after-letter) (:with-backaddress nil "backaddress" org-koma-letter-use-backaddress) (:with-email nil "email" org-koma-letter-use-email) (:with-foldmarks nil "foldmarks" org-koma-letter-use-foldmarks) @@ -428,9 +453,11 @@ e.g. \"title-subject:t\"." ;; They are used to prioritize in-buffer settings over "lco" ;; files. See `org-koma-letter-template'. (:inbuffer-author "AUTHOR" nil 'koma-letter:empty) + (:inbuffer-from "FROM" nil 'koma-letter:empty) (:inbuffer-email "EMAIL" nil 'koma-letter:empty) (:inbuffer-phone-number "PHONE_NUMBER" nil 'koma-letter:empty) (:inbuffer-place "PLACE" nil 'koma-letter:empty) + (:inbuffer-location "LOCATION" nil 'koma-letter:empty) (:inbuffer-signature "SIGNATURE" nil 'koma-letter:empty) (:inbuffer-with-backaddress nil "backaddress" 'koma-letter:empty) (:inbuffer-with-email nil "email" 'koma-letter:empty) @@ -438,10 +465,10 @@ e.g. \"title-subject:t\"." (:inbuffer-with-phone nil "phone" 'koma-letter:empty) (:inbuffer-with-place nil "place" 'koma-letter:empty)) :translate-alist '((export-block . org-koma-letter-export-block) - (export-snippet . org-koma-letter-export-snippet) - (headline . org-koma-letter-headline) - (keyword . org-koma-letter-keyword) - (template . org-koma-letter-template)) + (export-snippet . org-koma-letter-export-snippet) + (headline . org-koma-letter-headline) + (keyword . org-koma-letter-keyword) + (template . org-koma-letter-template)) :menu-entry '(?k "Export with KOMA Scrlttr2" ((?L "As LaTeX buffer" org-koma-letter-export-as-latex) @@ -466,8 +493,9 @@ e.g. \"title-subject:t\"." (defun org-koma-letter--get-tagged-contents (key) "Get contents from a headline tagged with KEY. The contents is stored in `org-koma-letter-special-contents'." - (cdr (assoc-string (org-koma-letter--get-value key) - org-koma-letter-special-contents))) + (let ((value (cdr (assoc-string (org-koma-letter--get-value key) + org-koma-letter-special-contents)))) + (when value (org-string-nw-p (org-trim value))))) (defun org-koma-letter--get-value (value) "Turn value into a string whenever possible. @@ -479,46 +507,31 @@ return a string or nil." ((symbolp value) (symbol-name value)) (t value)))) -(defun org-koma-letter--special-contents-as-macro - (keywords &optional keep-newlines no-tag) +(defun org-koma-letter--special-contents-inline (keywords info) "Process KEYWORDS members of `org-koma-letter-special-contents'. KEYWORDS is a list of symbols. Return them as a string to be formatted. The function is used for inserting content of special headings -such as PS. - -If KEEP-NEWLINES is non-nil leading and trailing newlines are not -removed. If NO-TAG is non-nil the content in -`org-koma-letter-special-contents' are not wrapped in a macro -named whatever the members of KEYWORDS are called." +such as the one tagged with PS. +" (mapconcat (lambda (keyword) (let* ((name (org-koma-letter--get-value keyword)) - (value (org-koma-letter--get-tagged-contents name))) + (value (org-koma-letter--get-tagged-contents name)) + (macrop (memq keyword (plist-get info :special-tags-as-macro)))) (cond ((not value) nil) - (no-tag (if keep-newlines value (org-trim value))) - (t (format "\\%s{%s}\n" - name - (if keep-newlines value (org-trim value))))))) + (macrop (format "\\%s{%s}\n" name value)) + (t value)))) keywords - "")) + "\n")) -(defun org-koma-letter--determine-to-and-from (info key) - "Given INFO determine KEY for the letter. -KEY should be `to' or `from'. -`ox-koma-letter' allows two ways to specify TO and FROM. If both -are present return the preferred one as determined by -`org-koma-letter-prefer-special-headings'." - (let ((option (org-string-nw-p - (plist-get info (if (eq key 'to) :to-address :from-address)))) - (headline (org-koma-letter--get-tagged-contents key))) - (replace-regexp-in-string - "\n" "\\\\\\\\\n" - (org-trim - (if (plist-get info :special-headings) (or headline option "") - (or option headline "")))))) +(defun org-koma-letter--add-latex-newlines (string) + "Replace regular newlines with LaTeX newlines (i.e. `\\\\')" + (let ((str (org-trim string))) + (when (org-string-nw-p str) + (replace-regexp-in-string "\n" "\\\\\\\\\n" str)))) @@ -576,12 +589,35 @@ appropriate place." "Non-nil if HEADLINE is a special headline. INFO is a plist holding contextual information. Return first special tag headline." - (let ((special-tags (plist-get info :special-tags))) + (let ((special-tags (append + (plist-get info :special-tags-in-letter) + (plist-get info :special-tags-after-closing) + (plist-get info :special-tags-after-letter)))) (catch 'exit (dolist (tag (org-export-get-tags headline info)) (let ((tag (assoc-string tag special-tags))) (when tag (throw 'exit tag))))))) +(defun org-koma-letter--keyword-or-headline (plist-key pred info) + "Return the correct version of opening or closing. +PLIST-KEY should be a key in info, typically :opening +or :closing. PRED is a predicate run on headline to determine +which title to use which takes two arguments, a headline element +and an info plist. INFO is a plist holding contextual +information. Return the preferred candidate for the exported of +PLIST-KEY." + (let* ((keyword-candidate (plist-get info plist-key)) + (headline-candidate (when (and (plist-get info :with-headline-opening) + (or (plist-get info :special-headings) + (not keyword-candidate))) + (org-element-map (plist-get info :parse-tree) + 'headline + (lambda (head) + (when (funcall pred head info) + (org-element-property :title head))) + info t)))) + (org-export-data (or headline-candidate keyword-candidate "") info))) + ;;;; Template (defun org-koma-letter-template (contents info) @@ -592,8 +628,10 @@ holding export options." ;; Time-stamp. (and (plist-get info :time-stamp-file) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) + ;; LaTeX compiler + (org-latex--insert-compiler info) ;; Document class and packages. - (org-latex--make-header info) + (org-latex--make-preamble info) ;; Settings. They can come from three locations, in increasing ;; order of precedence: global variables, LCO files and in-buffer ;; settings. Thus, we first insert settings coming from global @@ -604,10 +642,6 @@ holding export options." (org-split-string (or (plist-get info :lco) "") " ") "") (org-koma-letter--build-settings 'buffer info) - ;; From address. - (let ((from-address (org-koma-letter--determine-to-and-from info 'from))) - (when (org-string-nw-p from-address) - (format "\\setkomavar{fromaddress}{%s}\n" from-address))) ;; Date. (format "\\date{%s}\n" (org-export-data (org-export-get-date info) info)) ;; Hyperref, document start, and subject and title. @@ -643,40 +677,33 @@ holding export options." (when title (format "\\setkomavar{title}{%s}\n" title)) (when (or (org-string-nw-p title) (org-string-nw-p subject)) "\n"))) ;; Letter start. - (format "\\begin{letter}{%%\n%s}\n\n" - (org-koma-letter--determine-to-and-from info 'to)) + (let ((keyword-val (plist-get info :to-address)) + (heading-val (org-koma-letter--get-tagged-contents 'to))) + (format "\\begin{letter}{%%\n%s}\n\n" + (org-koma-letter--add-latex-newlines + (or (if (plist-get info :special-headings) + (or heading-val keyword-val) + (or keyword-val heading-val)) + "\\\\mbox{}")))) ;; Opening. (format "\\opening{%s}\n\n" - (org-export-data - (or (org-string-nw-p (plist-get info :opening)) - (when (plist-get info :with-headline-opening) - (org-element-map (plist-get info :parse-tree) 'headline - (lambda (head) - (unless (org-koma-letter--special-tag head info) - (org-element-property :title head))) - info t)) - "") + (org-koma-letter--keyword-or-headline + :opening (lambda (h i) (not (org-koma-letter--special-tag h i))) info)) ;; Letter body. contents ;; Closing. - (format "\n\\closing{%s}\n" - (org-export-data - (or (org-string-nw-p (plist-get info :closing)) - (when (plist-get info :with-headline-opening) - (org-element-map (plist-get info :parse-tree) 'headline - (lambda (head) - (when (eq (org-koma-letter--special-tag head info) - 'closing) - (org-element-property :title head))) - info t))) + (format "\\closing{%s}\n" + (org-koma-letter--keyword-or-headline + :closing (lambda (h i) (eq (org-koma-letter--special-tag h i) + 'closing)) info)) - (org-koma-letter--special-contents-as-macro - (plist-get info :with-after-closing)) + (org-koma-letter--special-contents-inline + (plist-get info :special-tags-after-closing) info) ;; Letter end. "\n\\end{letter}\n" - (org-koma-letter--special-contents-as-macro - (plist-get info :with-after-letter) t t) + (org-koma-letter--special-contents-inline + (plist-get info :special-tags-after-letter) info) ;; Document end. "\n\\end{document}")) @@ -684,14 +711,24 @@ holding export options." "Build settings string according to type. SCOPE is either `global' or `buffer'. INFO is a plist used as a communication channel." - (let ((check-scope - (function - ;; Non-nil value when SETTING was defined in SCOPE. - (lambda (setting) - (let ((property (intern (format ":inbuffer-%s" setting)))) - (if (eq scope 'global) - (eq (plist-get info property) 'koma-letter:empty) - (not (eq (plist-get info property) 'koma-letter:empty)))))))) + (let* ((check-scope + (function + ;; Non-nil value when SETTING was defined in SCOPE. + (lambda (setting) + (let ((property (intern (format ":inbuffer-%s" setting)))) + (if (eq scope 'global) + (eq (plist-get info property) 'koma-letter:empty) + (not (eq (plist-get info property) 'koma-letter:empty))))))) + (heading-or-key-value + (function + (lambda (heading key &optional scoped) + (let* ((heading-val + (org-koma-letter--get-tagged-contents heading)) + (key-val (org-string-nw-p (plist-get info key))) + (scopedp (funcall check-scope (or scoped heading)))) + (and (or (and key-val scopedp) heading-val) + (not (and (eq scope 'global) heading-val)) + (if scopedp key-val heading-val))))))) (concat ;; Name. (let ((author (plist-get info :author))) @@ -699,6 +736,11 @@ a communication channel." (funcall check-scope 'author) (format "\\setkomavar{fromname}{%s}\n" (org-export-data author info)))) + ;; From. + (let ((from (funcall heading-or-key-value 'from :from-address))) + (and from + (format "\\setkomavar{fromaddress}{%s}\n" + (org-koma-letter--add-latex-newlines from)))) ;; Email. (let ((email (plist-get info :email))) (and email @@ -742,6 +784,10 @@ a communication channel." (format "\\setkomavar{place}{%s}\n" (if (plist-get info :with-place) (plist-get info :place) "")))) + ;; Location. + (let ((location (funcall heading-or-key-value 'location :location))) + (and location + (format "\\setkomavar{location}{%s}\n" location))) ;; Folding marks. (and (funcall check-scope 'with-foldmarks) (let ((foldmarks (plist-get info :with-foldmarks))) diff --git a/contrib/lisp/ox-rss.el b/contrib/lisp/ox-rss.el index 4cdfe0e..a3ba274 100644 --- a/contrib/lisp/ox-rss.el +++ b/contrib/lisp/ox-rss.el @@ -31,10 +31,11 @@ ;; `org-rss-export-as-rss' (temporary buffer) and `org-rss-export-to-rss' ;; (as a ".xml" file). ;; -;; This backend understands two new option keywords: +;; This backend understands three new option keywords: ;; ;; #+RSS_EXTENSION: xml ;; #+RSS_IMAGE_URL: http://myblog.org/mypicture.jpg +;; #+RSS_FEED_URL: http://myblog.org/feeds/blog.xml ;; ;; It uses #+HTML_LINK_HOME: to set the base url of the feed. ;; @@ -127,6 +128,7 @@ When nil, Org will create ids using `org-icalendar-create-uid'." (:with-toc nil nil nil) ;; Never include HTML's toc (:rss-extension "RSS_EXTENSION" nil org-rss-extension) (:rss-image-url "RSS_IMAGE_URL" nil org-rss-image-url) + (:rss-feed-url "RSS_FEED_URL" nil nil t) (:rss-categories nil nil org-rss-categories)) :filters-alist '((:filter-final-output . org-rss-final-function)) :translate-alist '((headline . org-rss-headline) @@ -226,59 +228,61 @@ Return output file name." "Transcode HEADLINE element into RSS format. CONTENTS is the headline contents. INFO is a plist used as a communication channel." - (unless (or (org-element-property :footnote-section-p headline) - ;; Only consider first-level headlines - (> (org-export-get-relative-level headline info) 1)) - (let* ((author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (htmlext (plist-get info :html-extension)) - (hl-number (org-export-get-headline-number headline info)) - (hl-home (file-name-as-directory (plist-get info :html-link-home))) - (hl-pdir (plist-get info :publishing-directory)) - (hl-perm (org-element-property :RSS_PERMALINK headline)) - (anchor (org-export-get-reference headline info)) - (category (org-rss-plain-text - (or (org-element-property :CATEGORY headline) "") info)) - (pubdate0 (org-element-property :PUBDATE headline)) - (pubdate (let ((system-time-locale "C")) - (if pubdate0 - (format-time-string - "%a, %d %b %Y %H:%M:%S %z" - (org-time-string-to-time pubdate0))))) - (title (or (org-element-property :RSS_TITLE headline) - (replace-regexp-in-string - org-bracket-link-regexp - (lambda (m) (or (match-string 3 m) - (match-string 1 m))) - (org-element-property :raw-value headline)))) - (publink - (or (and hl-perm (concat (or hl-home hl-pdir) hl-perm)) - (concat - (or hl-home hl-pdir) - (file-name-nondirectory - (file-name-sans-extension - (plist-get info :input-file))) "." htmlext "#" anchor))) - (guid (if org-rss-use-entry-url-as-guid - publink - (org-rss-plain-text - (or (org-element-property :ID headline) - (org-element-property :CUSTOM_ID headline) - publink) - info)))) - (if (not pubdate0) "" ;; Skip entries with no PUBDATE prop - (format - (concat - "<item>\n" - "<title>%s</title>\n" - "<link>%s</link>\n" - "<author>%s</author>\n" - "<guid isPermaLink=\"false\">%s</guid>\n" - "<pubDate>%s</pubDate>\n" - (org-rss-build-categories headline info) "\n" - "<description><![CDATA[%s]]></description>\n" - "</item>\n") - title publink author guid pubdate contents))))) + (if (> (org-export-get-relative-level headline info) 1) + (org-export-data-with-backend headline 'html info) + (unless (org-element-property :footnote-section-p headline) + (let* ((email (org-export-data (plist-get info :email) info)) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (htmlext (plist-get info :html-extension)) + (hl-number (org-export-get-headline-number headline info)) + (hl-home (file-name-as-directory (plist-get info :html-link-home))) + (hl-pdir (plist-get info :publishing-directory)) + (hl-perm (org-element-property :RSS_PERMALINK headline)) + (anchor (org-export-get-reference headline info)) + (category (org-rss-plain-text + (or (org-element-property :CATEGORY headline) "") info)) + (pubdate0 (org-element-property :PUBDATE headline)) + (pubdate (let ((system-time-locale "C")) + (if pubdate0 + (format-time-string + "%a, %d %b %Y %H:%M:%S %z" + (org-time-string-to-time pubdate0))))) + (title (org-rss-plain-text + (or (org-element-property :RSS_TITLE headline) + (replace-regexp-in-string + org-bracket-link-regexp + (lambda (m) (or (match-string 3 m) + (match-string 1 m))) + (org-element-property :raw-value headline))) info)) + (publink + (or (and hl-perm (concat (or hl-home hl-pdir) hl-perm)) + (concat + (or hl-home hl-pdir) + (file-name-nondirectory + (file-name-sans-extension + (plist-get info :input-file))) "." htmlext "#" anchor))) + (guid (if org-rss-use-entry-url-as-guid + publink + (org-rss-plain-text + (or (org-element-property :ID headline) + (org-element-property :CUSTOM_ID headline) + publink) + info)))) + (if (not pubdate0) "" ;; Skip entries with no PUBDATE prop + (format + (concat + "<item>\n" + "<title>%s</title>\n" + "<link>%s</link>\n" + "<author>%s (%s)</author>\n" + "<guid isPermaLink=\"false\">%s</guid>\n" + "<pubDate>%s</pubDate>\n" + (org-rss-build-categories headline info) "\n" + "<description><![CDATA[%s]]></description>\n" + "</item>\n") + title publink email author guid pubdate contents)))))) (defun org-rss-build-categories (headline info) "Build categories for the RSS item." @@ -316,7 +320,7 @@ as a communication channel." (defun org-rss-build-channel-info (info) "Build the RSS channel information." (let* ((system-time-locale "C") - (title (plist-get info :title)) + (title (org-export-data (plist-get info :title) info)) (email (org-export-data (plist-get info :email) info)) (author (and (plist-get info :with-author) (let ((auth (plist-get info :author))) @@ -331,10 +335,11 @@ as a communication channel." (image (url-encode-url (plist-get info :rss-image-url))) (ifile (plist-get info :input-file)) (publink - (concat (file-name-as-directory blogurl) - (file-name-nondirectory - (file-name-sans-extension ifile)) - "." rssext))) + (or (plist-get info :rss-feed-url) + (concat (file-name-as-directory blogurl) + (file-name-nondirectory + (file-name-sans-extension ifile)) + "." rssext)))) (format "\n<title>%s</title> <atom:link href=\"%s\" rel=\"self\" type=\"application/rss+xml\" /> diff --git a/contrib/lisp/ox-taskjuggler.el b/contrib/lisp/ox-taskjuggler.el index 664a0ea..133d8a3 100644 --- a/contrib/lisp/ox-taskjuggler.el +++ b/contrib/lisp/ox-taskjuggler.el @@ -603,7 +603,7 @@ doesn't include leading \"depends\"." (let ((id (org-element-property :TASK_ID dep))) (and id (string-match (concat id " +\\({.*?}\\)") dep-str) - (org-match-string-no-properties 1 dep-str)))) + (match-string-no-properties 1 dep-str)))) path) ;; Compute number of exclamation marks by looking for the ;; common ancestor between TASK and DEP. diff --git a/contrib/orgmanual.org b/contrib/orgmanual.org new file mode 100644 index 0000000..8b8ae1e --- /dev/null +++ b/contrib/orgmanual.org @@ -0,0 +1,19743 @@ +#+TITLE: Org Mode +#+AUTHOR: Carsten Dominik +#+EMAIL: tsd@tsdye.com +#+DATE: {{{modification-time}}} +#+SUBTITLE: Release {{{version}}} +#+SUBAUTHOR: with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan Davison, Eric Schulte, Thomas Dye and Jambunathan K. + +#+LANGUAGE: en +#+OPTIONS: H:4 num:t toc:t \n:nil ::t |:t ^:nil -:t f:t *:t <:t +#+OPTIONS: d:nil todo:nil pri:nil tags:not-in-toc +#+SELECT_TAGS: export +#+EXCLUDE_TAGS: noexport + +#+TEXINFO_DIR_CATEGORY: Emacs editing modes +#+TEXINFO_DIR_TITLE: Org Mode: (org) +#+TEXINFO_DIR_DESC: Outline-based notes management and organizer + +# Use proper quote and backtick for code sections in PDF output +# Cf. Texinfo manual 14.2 +#+TEXINFO_HEADER: @set txicodequoteundirected +#+TEXINFO_HEADER: @set txicodequotebacktick + +# Contact Info +#+TEXINFO_HEADER: @set MAINTAINERSITE @uref{http://orgmode.org,maintainers webpage} +#+TEXINFO_HEADER: @set MAINTAINER Carsten Dominik +#+TEXINFO_HEADER: @set MAINTAINEREMAIL @email{carsten at orgmode dot org} +#+TEXINFO_HEADER: @set MAINTAINERCONTACT @uref{mailto:carsten at orgmode dot org,contact the maintainer} + +#+STARTUP: overview +#+TODO: FIXME | FIXED + +* Introduction + :PROPERTIES: + :TITLE: Introduction + :DESCRIPTION: Getting started + :END: +#+cindex: introduction + +** Summary + :PROPERTIES: + :DESCRIPTION: Brief summary of what Org-mode does + :END: +#+cindex: summary + +Org is a mode for keeping notes, maintaining TODO lists, and doing +project planning with a fast and effective plain-text system. + +Org develops organizational tasks around NOTES files that contain +lists or information about projects as plain text. Org is implemented +on top of Outline mode, which makes it possible to keep the content of +large files well structured. Visibility cycling and structure editing +help to work with the tree. Tables are easily created with a built-in +table editor. Org supports TODO items, deadlines, timestamps, and +scheduling. It dynamically compiles entries into an agenda that +utilizes and smoothly integrates much of the Emacs calendar and diary. +Plain text URL-like links connect to websites, emails, Usenet +messages, BBDB entries, and any files related to the projects. For +printing and sharing of notes, an Org file can be exported as a +structured ASCII file, as HTML, or as an iCalendar file.[fn:1] It can +also serve as a publishing tool for a set of linked web pages. + +As a project planning environment, Org works by adding metadata to +outline nodes. Based on this data, specific entries can be extracted +in queries and create dynamic /agenda views/. + +Org mode contains the Org Babel environment which allows you to work +with embedded source code blocks in a file, to facilitate code +evaluation, documentation, and literate programming techniques. + +Org's automatic, context-sensitive table editor with spreadsheet +capabilities can be integrated into any major mode by activating the +minor Orgtbl mode. Using a translation step, it can be used to +maintain tables in arbitrary file types, for example in LaTeX. The +structure editing and list creation capabilities can be used outside +Org with the minor Orgstruct mode. + +Org keeps simple things simple. When first fired up, it should feel +like a straightforward, easy to use outliner. Complexity is not +imposed, but a large amount of functionality is available when you +need it. Org is a toolbox and can be used in different ways and for +different ends, for example: + + - an outline extension with visibility cycling and structure editing + - an ASCII system and table editor for taking structured notes + - a TODO list editor + - a full agenda and planner with deadlines and work scheduling + #+pindex: GTD, Getting Things Done + - an environment in which to implement David Allen's GTD system + - a simple hypertext system, with HTML and LaTeX export + - a publishing tool to create a set of interlinked web pages + - an environment for literate programming + +#+cindex: FAQ + +There is a [[http://orgmode.org][website for Org]] that provides links to the newest version +of Org, as well as additional information, frequently asked questions +(FAQ), links to tutorials, etc. + +#+cindex: print edition + +Version 7.3 of this manual is available as a [[http://www.network-theory.co.uk/org/manual/][paperback book from +Network Theory Ltd.]] + +{{{page}}} + +** Installation + :PROPERTIES: + :DESCRIPTION: How to install a downloaded version of Org-mode + :END: + +#+cindex: installation +#+cindex: XEmacs + +*Important:* If you have the version of Org that comes with Emacs or +as a XEmacs package, please skip this section and go directly to +[[Activation]]. If you downloaded Org as an ELPA package, please read the +instructions on the [[http://orgmode.org/elpa.html][Org ELPA page]]. To see what version of Org (if any) +is part of your Emacs distribution, type {{{kbd(M-x org-version)}}}.[fn:2] + +Installation of Org mode uses a build system, which is described in more +detail on [[http://orgmode.org/worg/dev/org-build-system.html][Worg]]. + +If you have downloaded Org from the Web as a distribution {{{file(.zip)}}} or +{{{file(.tar.gz)}}} archive, take the following steps to install it: + + - Unpack the distribution archive + - Change into (~cd~) the Org directory + - Run ~make help config~ and then check and edit the file + {{{file(local.mk)}}} if the default configuration does not match + your system + + - Set the name of the Emacs binary (likely either + {{{file(emacs)}}} or {{{file(xemacs)}}}), and the paths to the + directories where local Lisp and Info files will be installed + - If the Emacs binary is not in your path, give the full path to + the executable + - Avoid spaces in any path names + + - Run ~make config~ again to check the configuration + - Run ~make install~ or ~sudo make install~ to build and install Org + mode on your system + +If you use a cloned Git repository, then the procedure is slightly +different. The following description assumes that you are using the +~master~ branch.[fn:3] You could also use the ~maint~ branch instead, +where the release versions are published, just replace ~master~ with +~maint~ in the description below. + + - Change into (~cd~) the Org repository + - Run ~git checkout master~ to switch to the ~master~ branch of the + Org repository + - Run ~make help~ and then check and edit the file {{{file(local.mk)}}} + + - You must set the name of the Emacs binary + (likely either {{{file(emacs)}}} or {{{file(xemacs)}}}), and the + paths to the directories where local Lisp and Info files will be + installed + - If the Emacs binary is not in your path, you must give + the full path to the executable + - Avoid spaces in any path names + + - Run ~make config~ to check the configuration + - Optionally run ~make test~ to build Org mode and then run the full + test suite + - Run ~make update2~ or ~make up2~ to update the Git repository and + build and install Org mode. The latter invocation runs the + complete test suite before installation and installs only if the + build passes all tests + +If you don't have access to the system-wide directories and you don't +want to install somewhere into your home directory, you can run Org +directly from the distribution directory or Org repository by +compiling Org mode in place: + + - Change into (~cd~) the Org repository + - Run ~git checkout master~ to switch to the ~master~ branch of the + Org repository + - Run ~make compile~ + +Last but not least you can also run Org mode directly from an Org repository +without any compilation. Simply replace the last step in the recipe above +with ~make uncompiled~. + +Then add the following line to {{{file(.emacs)}}}: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(add-to-list 'load-path "~/path/to/orgdir/lisp") +#+end_src + +{{{noindent}}} +If you plan to use code files from the {{{file(contrib)}}} subdirectory without +compiling them, do a similar step for this directory: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t) +#+end_src + +If you want to include those files with the build and install, please +customize the variable ~ORG_ADD_CONTRIB~ instead in your +~local.mk~ file. For more details please see this +[[http://orgmode.org/worg/dev/org-build-system.html#sec-4-1-2][description on Worg]]. + +Installing Info files is system dependent, because of differences in +the {{{file(install-info)}}} program. The Info documentation is +installed together with the rest of Org mode. If you don't install Org +mode, it is possible to install the Info documentation separately if you +have install-info on your system.[fn:4] + +The command to do this is: + +#+begin_example + make install-info +#+end_example + +Do not forget to activate Org as described in the following section. +{{{page}}} + +** Activation + :PROPERTIES: + :DESCRIPTION: How to activate Org-mode for certain buffers + :END: +#+cindex: activation +#+cindex: autoload +#+cindex: ELPA +#+cindex: global key bindings +#+cindex: key bindings, global +#+findex: org-agenda +#+findex: org-capture +#+findex: org-store-link +#+findex: org-iswitchb + +Since Emacs 22.2, files with the {{{file(.org)}}} extension use Org mode by +default. If you are using an earlier version of Emacs, add this line to your +{{{file(.emacs)}}} file: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(add-to-list 'auto-mode-alist '("\\.org\\'" . org-mode)) +#+end_src + +Org mode buffers need font-lock to be turned on - this is the default in +Emacs.[fn:5] + +There are compatibility issues between Org mode and some other Elisp +packages, please take the time to check the list (see [[Conflicts]]). + +The four Org commands {{{command(org-store-link)}}}, +{{{command(org-capture)}}}, {{{command(org-agenda)}}}, and +{{{command(org-iswitchb)}}} should be accessible through global keys +(i.e., anywhere in Emacs, not just in Org buffers). Here are +suggested bindings for these keys, please modify the keys to your own +liking. + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(global-set-key "\C-cl" 'org-store-link) +(global-set-key "\C-cc" 'org-capture) +(global-set-key "\C-ca" 'org-agenda) +(global-set-key "\C-cb" 'org-iswitchb) +#+end_src + +#+cindex: Org mode, turning on +With this setup, all files with extension {{{samp(.org)}}} will be put +into Org mode. As an alternative, make the first line of a file look +like this: + +#+begin_example + MY PROJECTS -*- mode: org; -*- +#+end_example + +#+vindex: org-insert-mode-line-in-empty-file +{{{noindent}}} +which will select Org mode for this buffer no matter what the file's +name is. See also the variable +~org-insert-mode-line-in-empty-file~. + +Many commands in Org work on the region if the region is /active/. To +make use of this, you need to have ~transient-mark-mode~ +(~zmacs-regions~ in XEmacs) turned on. In Emacs 23 this is the +default, in Emacs 22 you need to do this yourself with + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(transient-mark-mode 1) +#+end_src + +{{{noindent}}} If you do not like ~transient-mark-mode~, you can +create an active region by using the mouse to select a region, or +pressing {{{kbdkey(C-,SPC)}}} twice before moving the cursor. + +** Feedback + :PROPERTIES: + :DESCRIPTION: Bug reports, ideas, patches, etc. + :END: +#+cindex: feedback +#+cindex: bug reports +#+cindex: maintainer +#+cindex: author + +If you find problems with Org, or if you have questions, remarks, or +ideas about it, please mail to the Org mailing list +[[mailto:emacs-orgmode@gnu.org]]. If you are not a member of +the mailing list, your mail will be passed to the list after a +moderator has approved it.[fn:6] + +For bug reports, please first try to reproduce the bug with the latest +version of Org available---if you are running an outdated version, it +is quite possible that the bug has been fixed already. If the bug +persists, prepare a report and provide as much information as +possible, including the version information of Emacs ({{{kbdspckey(M-x +emacs-version,RET)}}}) and Org ({{{kbdspckey(M-x org-version,RET)}}}), +as well as the Org related setup in {{{file(.emacs)}}}. The easiest +way to do this is to use the command {{{kbd(M-x +org-submit-bug-report)}}}, which will put all this information into an +Emacs mail buffer so that you only need to add your description. If +you are not sending the Email from within Emacs, please copy and paste +the content into your Email program. + +Sometimes you might face a problem due to an error in your Emacs or +Org mode setup. Before reporting a bug, it is very helpful to start +Emacs with minimal customizations and reproduce the problem. Doing so +often helps you determine if the problem is with your customization or +with Org mode itself. You can start a typical minimal session with a +command like the example below. + +#+begin_src sh :exports code +$ emacs -Q -l /path/to/minimal-org.el +#+end_src + +However if you are using Org mode distributed with Emacs, a minimal +setup is not necessary. In that case it is sufficient to start Emacs +as ~emacs -Q~. The ~minimal-org.el~ setup +file can have contents as shown below. + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +;;; Minimal setup to load latest `org-mode' + +;; activate debugging +(setq debug-on-error t + debug-on-signal nil + debug-on-quit nil) + +;; add latest org-mode to load path +(add-to-list 'load-path (expand-file-name "/path/to/org-mode/lisp")) +(add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp" t)) +#+end_src + +If an error occurs, a backtrace can be very useful (see [[How to +create a useful backtrace]]). Often a small example file helps, along +with clear information about: + + 1. What exactly did you do? + 2. What did you expect to happen? + 3. What happened instead? + +{{{noindent}}} Thank you for helping to improve this program. + +** How to create a useful backtrace + :PROPERTIES: + :DESCRIPTION: The best way to report an error + :END: + +#+cindex: backtrace of an error + +If working with Org produces an error with a message you don't +understand, you may have hit a bug. The best way to report this is by +providing, in addition to what was mentioned above, a /backtrace/. +This is information from the built-in debugger about where and how the +error occurred. Here is how to produce a useful backtrace: + + 1. Reload uncompiled versions of all Org mode Lisp files. The + backtrace contains much more information if it is produced with + uncompiled code. To do this, use + {{{kbdspckey(C-u M-x org-reload,RET)}}} or select + ~Org -> Refresh/Reload -> Reload Org uncompiled~ from the menu. + + 2. Go to the ~Options~ menu and select ~Enter Debugger on Error~ + (XEmacs has this option in the ~Troubleshooting~ sub-menu). + + 3. Do whatever you have to do to hit the error. Don't forget to + document the steps you take. + + 4. When you hit the error, a {{{file(*Backtrace*)}}} buffer will + appear on the screen. Save this buffer to a file (for example + using {{{kbd(C-x C-w)}}}) and attach it to your bug report. + +** Conventions + :PROPERTIES: + :DESCRIPTION: Typesetting conventions in the manual + :END: + +Conventions for typesetting keywords, keybindings, and commands in +this manual are described. + +*** Three types of keywords + :PROPERTIES: + :DESCRIPTION: TODO, tags, and properties + :END: + +Org mainly uses three types of keywords: TODO keywords, tags and property +names. In this manual we use the following conventions: + + - TODO, WAITING :: TODO keywords are written with all capitals, even if they + are user-defined. + - boss, ARCHIVE :: User-defined tags are written in lowercase; built-in + tags with special meaning are written with all capitals. + - Release, PRIORITY :: User-defined properties are capitalized; built-in + properties with special meaning are written with all capitals. + +Moreover, Org uses /option keywords/ (like ~#+TITLE~ to set the title) +and /environment keywords/ (like ~#+BEGIN_HTML~ to start a ~HTML~ +environment). They are written in uppercase in the manual to enhance +its readability, but you can use lowercase in your Org files.[fn:7] + +*** Keybindings and commands + :PROPERTIES: + :DESCRIPTION: Bind useful commands to keys + :END: + +#+kindex: C-c a +#+findex: org-agenda +#+kindex: C-c c +#+findex: org-capture + +The manual suggests two global keybindings: {{{kbd(C-c a)}}} for +~org-agenda~ and {{{kbd(C-c c)}}} for ~org-capture~. These are only +suggestions, but the rest of the manual assumes that you are using +these keybindings. + +Also, the manual lists both the keys and the corresponding commands +for accessing a functionality. Org mode often uses the same key for +different functions, depending on context. The command that is bound +to such keys has a generic name, like ~org-metaright~. In the manual +we will, wherever possible, give the function that is internally +called by the generic command. For example, in the chapter on document +structure, {{{kbdkey(M-,right)}}} will be listed to call +~org-do-demote~, while in the chapter on tables, it will be listed to +call ~org-table-move-column-right~. + +# If you prefer, you can compile the manual without the command names by unsetting the flag ~cmdnames~ in {{{file(org.texi)}}}. + +* Document structure + :PROPERTIES: + :DESCRIPTION: A tree works like your brain + :ALT_TITLE: Document Structure + :END: +#+cindex: document structure +#+cindex: structure of document + +Org is based on Outline mode and provides flexible commands to +edit the structure of the document. + +** Outlines + :PROPERTIES: + :DESCRIPTION: Org mode is based on Outline mode + :END: +#+cindex: outlines +#+cindex: Outline mode + +Org is implemented on top of Outline mode. Outlines allow a document +to be organized in a hierarchical structure, which (at least for me) +is the best representation of notes and thoughts. An overview of this +structure is achieved by folding (hiding) large parts of the document +to show only the general document structure and the parts currently +being worked on. Org greatly simplifies the use of outlines by +compressing the entire show/hide functionality into a single command, +{{{command(org-cycle)}}}, which is bound to the {{{key(TAB)}}} key. + +** Headlines + :PROPERTIES: + :DESCRIPTION: How to typeset Org tree headlines + :END: +#+cindex: headlines +#+cindex: outline tree +#+vindex: org-special-ctrl-a/e +#+vindex: org-special-ctrl-k +#+vindex: org-ctrl-k-protect-subtree + +Headlines define the structure of an outline tree. The headlines in Org +start with one or more stars, on the left margin.[fn:8] For example: + +#+begin_src org + ,* Top level headline + ,** Second level + ,*** Third level + some text + ,*** Third level + more text + ,* Another top level headline +#+end_src + +{{{noindent}}} Some people find the many stars too noisy and would +prefer an outline that has whitespace followed by a single star as +headline starters. A setup to realize this is described in the +section, [[Clean view]]. + +#+vindex: org-cycle-separator-lines +An empty line after the end of a subtree is considered part of it and +will be hidden when the subtree is folded. However, if you leave at +least two empty lines, one empty line will remain visible after folding +the subtree, in order to structure the collapsed view. See the +variable ~org-cycle-separator-lines~ to modify this behavior. + +** Visibility cycling + :PROPERTIES: + :DESCRIPTION: Show and hide, much simplified + :ALT_TITLE: Visibility cycling + :END: +#+cindex: cycling, visibility +#+cindex: visibility cycling +#+cindex: trees, visibility +#+cindex: show hidden text +#+cindex: hide text + +Outlines make it possible to hide parts of the text in the buffer. +Org uses just two commands, bound to {{{key(TAB)}}} and +{{{kbdkey(S-,TAB)}}} to change the visibility in the buffer. + +#+cindex: subtree visibility states +#+cindex: subtree cycling +#+cindex: folded, subtree visibility state +#+cindex: children, subtree visibility state +#+cindex: subtree, subtree visibility state + +#+attr_texinfo: :table-type table :indic @asis +- {{{key(TAB)}}}, ~org-cycle~ :: Subtrees can be cycled through three + states: + #+kindex: TAB + #+findex: org-cycle + + #+begin_src example + ,-> FOLDED -> CHILDREN -> SUBTREE --. + '-----------------------------------' + #+end_src + + #+vindex: org-cycle-emulate-tab + #+vindex: org-cycle-global-at-bob + + By default, the cursor must be on a headline for this to work, + but this behavior can be modified with the + ~org-cycle-emulate-tab~ option. When the cursor is at the + beginning of the buffer and the first line is not a headline, + then {{{key(TAB)}}} actually runs global cycling (see + below).[fn:9] Also, when called with a prefix argument + ({{{kbdspckey(C-u,TAB)}}}), global cycling is invoked. + +- {{{kbdkey(S-,TAB)}}} or {{{kbdspckey(C-u,TAB)}}}, ~org-global-cycle~ :: + Global cycling: Rotate the entire buffer among the states + + #+cindex: global visibility states + #+cindex: global cycling + #+cindex: overview, global visibility state + #+cindex: contents, global visibility state + #+cindex: show all, global visibility state + #+kindex: C-u TAB + #+kindex: S-TAB + #+findex: org-global-cycle + + #+begin_example + ,-> OVERVIEW -> CONTENTS -> SHOW ALL --. + '--------------------------------------' + #+end_example + + When {{{kbdkey(S-,TAB)}}} is called with a numeric prefix + argument, ~N~, the CONTENTS view up to headlines of level N will + be shown. Note that inside tables, {{{kbdkey(S-,TAB)}}} jumps + to the previous field. + +- {{{kbdspckey(C-u C-u C-u,TAB)}}}, ~show-all~ :: Show all, including + drawers. + + #+kindex: C-u C-u C-u TAB + #+findex: show-all + #+cindex: show all, command +- {{{kbd(C-c C-r)}}}, ~org-reveal~ :: Reveal context around point, + showing the current entry, the following heading and the + hierarchy above. Useful for working near a location that has + been exposed by a sparse tree command (see [[Sparse trees]]) or an + agenda command (see [[Agenda commands]]). With a prefix argument + show, on each level, all sibling headings. With a double prefix + argument, also show the entire subtree of the parent. + + #+cindex: revealing context + #+kindex: C-c C-r + #+findex: org-reveal +- {{{kbd(C-c C-k)}}}, ~show-branches~ :: Expose all the headings of + the subtree, CONTENT view for just one subtree. + + #+kindex: C-c C-k + #+findex: show-branches + #+cindex: show branches, command +- {{{kbdspckey(C-c,TAB)}}}, ~show-children~ :: Expose all direct + children of the subtree. With a numeric prefix argument, ~N~, + expose all children down to level N. + + #+kindex: C-c TAB + #+findex: show-children + #+cindex: show children, command +- {{{kbd(C-c C-x b)}}}, ~org-tree-to-indirect-buffer~ :: Show the + current subtree in an indirect buffer.[fn:10] With a numeric + prefix argument, ~N~, go up to level N and then take that tree. + If N is negative then go up that many levels. With a + {{{kbd(C-u)}}} prefix, do not remove the previously used indirect + buffer. + + #+kindex: C-c C-x b + #+findex: org-tree-to-indirect-buffer +- {{{kbd(C-c C-x v)}}}, ~org-copy-visible~ :: Copy the /visible/ text + in the region into the kill ring. + +#+vindex: org-startup-folded +#+cindex: ~overview~, STARTUP keyword +#+cindex: ~content~, STARTUP keyword +#+cindex: ~showall~, STARTUP keyword +#+cindex: ~showeverything~, STARTUP keyword + +When Emacs first visits an Org file, the global state is set to +OVERVIEW, i.e., only the top level headlines are visible. This can be +configured through the variable ~org-startup-folded~, or on a +per-file basis by adding one of the following lines anywhere in the +buffer: + +#+begin_src org + ,#+STARTUP: overview + ,#+STARTUP: content + ,#+STARTUP: showall + ,#+STARTUP: showeverything +#+end_src + +#+cindex: property, VISIBILITY + +{{{noindent}}} Furthermore, any entries with a {{{samp(VISIBILITY)}}} +property (see [[Properties and columns]]) will get their visibility +adapted accordingly. Allowed values for this property are ~folded~, +~children~, ~content~, and ~all~. + +#+attr_texinfo: :indic @asis +- {{{kbdspckey(C-u C-u,TAB)}}}, ~org-set-startup-visibility~ :: Switch + back to the startup visibility of the buffer, i.e., whatever is + requested by startup options and {{{samp(VISIBILITY)}}} + properties in individual entries. + +** Motion + :PROPERTIES: + :DESCRIPTION: Jumping to other headlines + :END: +#+cindex: motion, between headlines +#+cindex: jumping, to headlines +#+cindex: headline navigation +The following commands jump to other headlines in the buffer. + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-c C-n)}}}, ~outline-next-visible-heading~ :: Next heading. + #+kindex: C-c C-n + #+findex: outline-next-visible-heading + - {{{kbd(C-c C-p)}}}, ~outline-previous-visible-heading~ :: Previous heading. + #+kindex: C-c C-p + #+findex: outline-previous-visible-heading + - {{{kbd(C-c C-f)}}}, ~org-forward-same-level~ :: Next heading same level. + #+kindex: C-c C-f + #+findex: org-forward-same-level + - {{{kbd(C-c C-b)}}}, ~org-backward-same-level~ :: Previous heading same level. + #+kindex: C-c C-b + #+findex: org-backward-same-level + - {{{kbd(C-c C-u)}}}, ~outline-up-heading~ :: Backward to higher level heading. + #+kindex: C-c C-u + #+findex: outline-up-heading + - {{{kbd(C-c C-j)}}}, ~org-goto~ :: Jump to a different place without + changing the current outline visibility. Shows the document + structure in a temporary buffer, where you can use the + following keys to find your destination: + + #+kindex: C-c C-j + #+findex: org-goto + #+vindex: org-goto-auto-isearch + - {{{key(TAB)}}} :: Cycle visibility. + - {{{key(down)}}} / {{{key(up)}}} :: Next/previous visible headline. + - {{{key(RET)}}} :: Select this location. + - {{{kbd(/)}}} :: Do a Sparse-tree search + The following keys work if you turn off ~org-goto-auto-isearch~ + - n / p :: Next/previous visible headline. + - f / b :: Next/previous headline same level. + - u :: One level up. + - 0--9 :: Digit argument. + - q :: Quit. + +#+vindex: org-goto-interface +{{{noindent}}} See also the variable ~org-goto-interface~. + +** Structure editing + :PROPERTIES: + :DESCRIPTION: Changing sequence and level of headlines + :ALT_TITLE: Structure editing + :END: +#+cindex: structure editing +#+cindex: headline, promotion and demotion +#+cindex: promotion, of subtrees +#+cindex: demotion, of subtrees +#+cindex: subtree, cut and paste +#+cindex: pasting, of subtrees +#+cindex: cutting, of subtrees +#+cindex: copying, of subtrees +#+cindex: sorting, of subtrees +#+cindex: subtrees, cut and paste + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbdkey(M-,RET)}}}, ~org-insert-heading~ :: Insert new heading + with same level as current. If the cursor is in a plain list + item, a new item is created (see [[Plain lists]]). To force + creation of a new headline, use a prefix argument. When this + command is used in the middle of a line, the line is split and + the rest of the line becomes the new headline.[fn:11] If the + command is used at the beginning of a headline, the new + headline is created before the current line. If at the + beginning of any other line, the content of that line is made + the new heading. If the command is used at the end of a folded + subtree (i.e., behind the ellipses at the end of a headline), + then a headline like the current one will be inserted after the + end of the subtree. + + #+kindex: M-RET + #+findex: org-insert-heading + #+vindex: org-M-RET-may-split-line + - {{{kbdkey(C-,RET)}}}, ~org-insert-heading-respect-content~ :: Just + like {{{kbdkey(M-,RET)}}}, except when adding a new heading + below the current heading, the new heading is placed after the + body instead of before it. This command works from anywhere in + the entry. + + #+kindex: C-RET + #+findex: org-insert-heading-respect-content + - {{{kbdkey(M-S-,RET)}}}, ~org-insert-todo-heading~ :: Insert new + TODO entry with same level as current heading. See also the + variable ~org-treat-insert-todo-heading-as-state-change~. + + #+kindex: M-S-RET + #+findex: org-insert-todo-heading + #+vindex: org-treat-insert-todo-heading-as-state-change + - {{{kbdkey(C-S-,RET)}}}, ~org-insert-todo-heading-respect-content~ :: Insert + new TODO entry with same level as current heading. Like + {{{kbdkey(C-,RET)}}}, the new headline will be inserted after + the current subtree. + + #+kindex: C-S-RET + #+findex: org-insert-todo-heading-respect-content + - {{{key(TAB)}}}, ~org-cycle~ :: In a new entry with no text + yet, the first {{{key(TAB)}}} demotes the entry to become a + child of the previous one. The next {{{key(TAB)}}} makes it a + parent, and so on, all the way to top level. Yet another + {{{key(TAB)}}}, and you are back to the initial level. + + #+kindex: @key{TAB} + #+findex: org-cycle + - {{{kbdkey(M-,left)}}}, ~org-do-promote~ :: Promote current heading + by one level. + + #+kindex: M-left + #+findex: org-do-promote + - {{{kbdkey(M-,right)}}}, ~org-do-demote~ :: Demote current heading + by one level. + + #+kindex: M-right + #+findex: org-do-demote + - {{{kbdkey(M-S-,left)}}}, ~org-promote-subtree~ :: Promote the + current subtree by one level. + + #+kindex: M-S-left + #+findex: org-promote-subtree + - {{{kbdkey(M-S-,right)}}}, ~org-demote-subtree~ :: Demote the + current subtree by one level. + + #+kindex: M-S-right + #+findex: org-demote-subtree + - {{{kbdkey(M-S-,up)}}}, ~org-move-subtree-up~ :: Move subtree up + (swap with previous subtree of same level). + + #+kindex: M-S-up + #+findex: org-move-subtree-up + - {{{kbdkey(M-S-,down)}}}, ~org-move-subtree-down~ :: Move subtree + down (swap with next subtree of same level). + + #+kindex: M-S-,down + #+findex: org-move-subtree-down + - {{{kbd(C-c C-x C-w)}}}, ~org-cut-subtree~ :: Kill subtree, i.e., + remove it from buffer but save in kill ring. With a numeric + prefix argument N, kill N sequential subtrees. + + #+kindex: C-c C-x C-w + #+findex: org-cut-subtree + - {{{kbd(C-c C-x M-w)}}}, ~org-copy-subtree~ :: Copy subtree to kill + ring. With a numeric prefix argument N, copy the N sequential + subtrees. + + #+kindex: C-c C-x M-w + #+findex: org-copy-subtree + - {{{kbd(C-c C-x C-y)}}}, ~org-paste-subtree~ :: Yank subtree from + kill ring. This does modify the level of the subtree to make + sure the tree fits in nicely at the yank position. The yank + level can also be specified with a numeric prefix argument, or + by yanking after a headline marker like {{{samp(****)}}}. + + #+kindex: C-c C-x C-y + #+findex: org-paste-subtree + - {{{kbd(C-y)}}}, ~org-yank~ :: Depending on the variables + ~org-yank-adjusted-subtrees~ and ~org-yank-folded-subtrees~, + Org's internal ~yank~ command will paste subtrees folded and in + a clever way, using the same command as {{{kbd(C-c C-x C-y)}}}. + With the default settings, no level adjustment will take place, + but the yanked tree will be folded unless doing so would + swallow text previously visible. Any prefix argument to this + command will force a normal ~yank~ to be executed, with the + prefix passed along. A good way to force a normal yank is + {{{kbd(C-u C-y)}}}. If you use ~yank-pop~ after a yank, it + will yank previous kill items plainly, without adjustment and + folding. + + #+kindex: C-y + #+findex: org-yank + #+vindex: org-yank-adjusted-subtrees + #+vindex: org-yank-folded-subtrees + - {{{kbd(C-c C-x c)}}}, ~org-clone-subtree-with-time-shift~ :: Clone + a subtree by making a number of sibling copies of it. You will + be prompted for the number of copies to make, and you can also + specify if any timestamps in the entry should be shifted. This + can be useful, for example, to create a number of tasks related + to a series of lectures to prepare. For more details, see the + docstring of the command ~org-clone-subtree-with-time-shift~. + + #+kindex: C-c C-x c + #+findex: org-clone-subtree-with-time-shift + - {{{kbd(C-c C-w)}}}, ~org-refile~ :: Refile entry or region to a + different location. See [[Refile and copy]]. + + #+kindex: C-c C-w + #+findex: org-refile + - {{{kbd(C-c ^)}}}, ~org-sort~ :: Sort same-level entries. When + there is an active region, all entries in the region will be + sorted. Otherwise the children of the current headline are + sorted. The command prompts for the sorting method, which can + be alphabetically, numerically, by time (first timestamp with + active preferred, creation time, scheduled time, deadline + time), by priority, by TODO keyword (in the sequence the + keywords have been defined in the setup) or by the value of a + property. Reverse sorting is possible as well. You can also + supply your own function to extract the sorting key. With a + {{{kbd(C-u)}}} prefix, sorting will be case-sensitive. + + #+kindex: C-c ^ + #+findex: org-sort + - {{{kbd(C-x n s)}}}, ~org-narrow-to-subtree~ :: Narrow buffer to + current subtree. + + #+kindex: C-x n s + #+findex: org-narrow-to-subtree + - {{{kbd(C-x n b)}}}, ~org-narrow-to-block~ :: Narrow buffer to + current block. + + #+kindex: C-x n b + #+findex: org-narrow-to-block + - {{{kbd(C-x n w)}}}, ~widen~ :: Widen buffer to remove narrowing. + + #+kindex: C-x n w + #+findex: widen + - {{{kbd(C-c *)}}}, ~org-toggle-heading~ :: Turn a normal line or + plain list item into a headline (so that it becomes a + subheading at its location). Also turn a headline into a normal + line by removing the stars. If there is an active region, turn + all lines in the region into headlines. If the first line in + the region was an item, turn only the item lines into + headlines. Finally, if the first line is a headline, remove the + stars from all headlines in the region. + + #+kindex: C-c * + #+findex: org-toggle-heading + +#+cindex: region, active +#+cindex: active region +#+cindex: transient mark mode + +When there is an active region (Transient Mark mode), promotion and +demotion work on all headlines in the region. To select a region of +headlines, it is best to place both point and mark at the beginning of +a line, mark at the beginning of the first headline, and point at the +line just after the last headline to change. Note that when the +cursor is inside a table (see [[Tables]]), the Meta-Cursor keys have +different functionality. + +** Sparse trees + :PROPERTIES: + :DESCRIPTION: Matches embedded in context + :ALT_TITLE: Sparse trees + :END: +#+cindex: sparse trees +#+cindex: trees, sparse +#+cindex: folding, sparse trees +#+cindex: occur, command +#+vindex: org-show-hierarchy-above +#+vindex: org-show-following-heading +#+vindex: org-show-siblings +#+vindex: org-show-entry-below + +An important feature of Org mode is the ability to construct /sparse +trees/ for selected information in an outline tree, so that the entire +document is folded as much as possible, but the selected information +is made visible along with the headline structure above it.[fn:12] +Just try it out and you will see immediately how it works. + +Org mode contains several commands creating such trees, all these +commands can be accessed through a dispatcher: + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-c /)}}}, ~org-sparse-tree~ :: This prompts for an extra + key to select a sparse-tree creating command. + + #+kindex: C-c / + #+findex: org-sparse-tree + - {{{kbd(C-c / r)}}}, ~org-occur~ :: Prompts for a regexp and shows a + sparse tree with all matches. If the match is in a headline, + the headline is made visible. If the match is in the body of an + entry, headline and body are made visible. In order to provide + minimal context, also the full hierarchy of headlines above the + match is shown, as well as the headline following the + match. Each match is also highlighted; the highlights disappear + when the buffer is changed by an editing command, or by + pressing {{{kbd(C-c C-c)}}}.[fn:13] When called with a {{{kbd(C-u)}}} + prefix argument, previous highlights are kept, so several calls + to this command can be stacked. + + #+kindex: C-c / r + #+findex: org-occur + #+vindex: org-remove-highlights-with-change + - {{{kbd(M-g n)}}}, ~next-error~ :: + @@info:@itemx@@ {{{kbd(M-g M-n)}}} + + Jump to the next sparse tree match in this buffer. + + #+kindex: M-g n + #+kindex: M-g M-n + #+findex: next-error + - {{{kbd(M-g p)}}}, ~previous-error~ :: + @@info:@itemx@@ {{{kbd(M-g M-p)}}} + + Jump to the previous sparse tree match in this buffer. + + #+kindex: M-g p + #+kindex: M-g M-p + #+findex: previous-error +#+vindex: org-agenda-custom-commands + +{{{noindent}}} For frequently used sparse trees of specific search +strings, you can use the variable ~org-agenda-custom-commands~ to +define fast keyboard access to specific sparse trees. These commands +will then be accessible through the agenda dispatcher +(see [[Agenda dispatcher]]). For example: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp + (setq org-agenda-custom-commands + '(("f" occur-tree "FIXME"))) +#+end_src + +{{{noindent}}} will define the key {{{kbd(C-c a f)}}} as a +shortcut for creating a sparse tree matching the string +{{{samp(FIXME)}}}. + +The other sparse tree commands select headings based on TODO keywords, +tags, or properties and will be discussed later in this manual. + +#+kindex: C-c C-e v +#+cindex: printing sparse trees +#+cindex: visible text, printing + +To print a sparse tree, you can use the Emacs command +~ps-print-buffer-with-faces~ which does not print +invisible parts of the document.[fn:14] Or you can use the command +{{{kbd(C-c C-e v)}}} to export only the visible part of the +document and print the resulting file. + +** Plain lists + :PROPERTIES: + :DESCRIPTION: Additional structure within an entry + :ALT_TITLE: Plain lists + :END: +#+cindex: plain lists +#+cindex: lists, plain +#+cindex: lists, ordered +#+cindex: ordered lists + +Within an entry of the outline tree, hand-formatted lists can provide +additional structure. They also provide a way to create lists of +checkboxes (see [[Checkboxes]]). Org supports editing +such lists, and every exporter (see [[Exporting]]) +can parse and format them. + +Org knows ordered lists, unordered lists, and description lists. + +#+attr_texinfo: :table-type table :indic @bullet + - /Unordered/ list items start with ~-~, ~+~, or ~*~ as bullets.[fn:15] + + - /Ordered/ list items start with a numeral followed by either a + period or a right parenthesis,[fn:16] such as + ~1.~ or ~1~.[fn:170] If you want a list to + start with a different value (e.g., 20), start the text of the + item with ~[@20]~.[fn:17] Those constructs can be used + in any item of the list in order to enforce a particular + numbering. + #+vindex: org-plain-list-ordered-item-terminator + #+vindex: org-alphabetical-lists + + - /Description/ list items are unordered list items, and contain the + separator {{{samp( :: )}}} to distinguish the description + /term/ from the description. + + +Items belonging to the same list must have the same indentation on the +first line. In particular, if an ordered list reaches number +{{{samp(10.)}}}, then the 2--digit numbers must be written +left-aligned with the other numbers in the list. An item ends before +the next line that is less or equally indented than its bullet/number. + +#+vindex: org-empty-line-terminates-plain-lists +A list ends whenever every item has ended, which means before any line less +or equally indented than items at top level. It also ends before two blank +lines.[fn:171] In that case, all items are closed. Here is an example: + +#+begin_src texinfo + ,** Lord of the Rings + My favorite scenes are (in this order) + 1. The attack of the Rohirrim + 2. Eowyn's fight with the witch king + + this was already my favorite scene in the book + + I really like Miranda Otto. + 3. Peter Jackson being shot by Legolas + - on DVD only + He makes a really funny face when it happens. + But in the end, no individual scenes matter but the film as a whole. + Important actors in this film are: + - @b{Elijah Wood} :: He plays Frodo + - @b{Sean Austin} :: He plays Sam, Frodo's friend. I still remember + him very well from his role as Mikey Walsh in @i{The Goonies}. +#+end_src + +Org supports these lists by tuning filling and wrapping commands to +deal with them correctly.[fn:18] To turn this on, put into +{{{file(.emacs)}}}: ~(require 'filladapt)~}, and by exporting them +properly (see [[Exporting]]). Since indentation is +what governs the structure of these lists, many structural constructs +like ~#+BEGIN_ ...~ blocks can be indented to signal that they belong +to a particular item. + +#+vindex: org-list-demote-modify-bullet +#+vindex: org-list-indent-offset +If you find that using a different bullet for a sub-list (than that used for +the current list-level) improves readability, customize the variable +~org-list-demote-modify-bullet~. To get a greater difference of +indentation between items and theirs sub-items, customize +~org-list-indent-offset~. + +#+vindex: org-list-automatic-rules +The following commands act on items when the cursor is in the first line of +an item (the line with the bullet or number). Some of them imply the +application of automatic rules to keep list structure intact. If some of +these actions get in your way, configure ~org-list-automatic-rules~ +to disable them individually. + + +#+attr_texinfo: :table-type table :indic @asis + - {{{key(TAB)}}}, ~org-cycle~ :: + #+cindex: cycling, in plain lists + #+kindex: TAB + #+findex: org-cycle + #+vindex: org-cycle-include-plain-lists + + Items can be folded just like headline levels. Normally this + works only if the cursor is on a plain list item. For more + details, see the variable ~org-cycle-include-plain-lists~. If + this variable is set to ~integrate~, plain list items will be + treated like low-level headlines. The level of an item is then + given by the indentation of the bullet/number. Items are always + subordinate to real headlines, however; the hierarchies remain + completely separated. In a new item with no text yet, the first + {{{key(TAB)}}} demotes the item to become a child of the + previous one. Subsequent {{{key(TAB)}}}s move the item to + meaningful levels in the list and eventually get it back to its + initial position. + + - {{{kbdkey(M-,RET)}}}, ~org-insert-heading~ :: + #+kindex: M-RET + #+findex: org-insert-heading + #+vindex: org-M-RET-may-split-line + #+vindex: org-list-automatic-rules + + Insert new item at current level. With a prefix argument, force + a new heading (see [[Structure editing]]). If this command is used + in the middle of an item, that item is /split/ in two, and the + second part becomes the new item.[fn:19] If this command is + executed /before item's body/, the new item is created /before/ + the current one. + + - {{{kbdkey(M-S-,RET)}}} :: + #+kindex: M-S-RET + + Insert a new item with a checkbox (see [[Checkboxes]]). + + - {{{kbdkey(S-,up)}}} :: + @@info:@itemx@@ {{{kbdkey(S-,down)}}} + + Jump to the previous/next item in the current list, but + only if ~org-support-shift-select~ is off.[fn:20] If not, you can + still use paragraph jumping commands like {{{kbdkey(C-,up)}}} + and {{{kbdkey(C-,down)}}} to quite similar effect. + + #+kindex: S-up + #+kindex: S-down + #+cindex: shift-selection-mode + #+vindex: org-support-shift-select + #+vindex: org-list-use-circular-motion + - {{{kbdkey(M-,up)}}} :: + @@info:@itemx@@ {{{kbdkey(M-,down)}}} + + Move the item including subitems up/down (swap with + previous/next item of same indentation).[fn:21] If the list is + ordered, renumbering is automatic. + + #+kindex: M-up + #+kindex: M-down + - {{{kbdkey(M-,left)}}} :: + @@info:@itemx@@ {{{kbdkey(M-,right)}}} + + Decrease/increase the indentation of an item, leaving children + alone. + + #+kindex: M-left + #+kindex: M-right + - {{{kbdkey(M-S-,left)}}} :: + @@info:@itemx@@ {{{kbdkey(M-S-,right)}}} + + Decrease/increase the indentation of the item, including + subitems. Initially, the item tree is selected based on + current indentation. When these commands are executed several + times in direct succession, the initially selected region is + used, even if the new indentation would imply a different + hierarchy. To use the new hierarchy, break the command chain + with a cursor motion or so. + + #+kindex: M-S-left + #+kindex: M-S-right + + As a special case, using this command on the very first item of + a list will move the whole list. This behavior can be disabled + by configuring ~org-list-automatic-rules~. The global + indentation of a list has no influence on the text /after/ the + list. + - {{{kbd(C-c C-c)}}} :: If there is a checkbox (see [[Checkboxes]]) in + the item line, toggle the state of the checkbox. In any case, + verify bullets and indentation consistency in the whole list. + + #+kindex: C-c C-c + - {{{kbd(C-c -)}}} :: Cycle the entire list level through the + different itemize/enumerate bullets ({{{samp(-)}}}, + {{{samp(+)}}}, {{{samp(*)}}}, {{{samp(1.)}}}, {{{samp(1))}}}) + or a subset of them, depending on + ~org-plain-list-ordered-item-terminator~, the type of list, and + its indentation. With a numeric prefix argument N, select the + Nth bullet from this list. If there is an active region when + calling this, selected text will be changed into an item. With + a prefix argument, all lines will be converted to list items. + If the first line already was a list item, any item marker will + be removed from the list. Finally, even without an active + region, a normal line will be converted into a list item. + + #+kindex: C-c - + #+vindex: org-plain-list-ordered-item-terminator + - {{{kbd(C-c *)}}} :: Turn a plain list item into a headline (so + that it becomes a subheading at its location). See + [[Structure editing]], for a detailed explanation. + + #+kindex: C-c * + - {{{kbd(C-c C-*)}}} :: Turn the whole plain list into a subtree of + the current heading. Checkboxes (see [[Checkboxes]]) will become + TODO (resp. DONE) keywords when unchecked (resp. checked). + + #+kindex: C-c C-* + - {{{kbd(S-left/right)}}} :: This command also cycles bullet styles + when the cursor in on the bullet or anywhere in an item line, + details depending on ~org-support-shift-select~. + + #+vindex: org-support-shift-select + #+kindex: S-left + #+kindex: S-right + - {{{kbd(C-c ^)}}} :: Sort the plain list. You will be prompted for + the sorting method: numerically, alphabetically, by time, or by + custom function. + + #+kindex: C-c ^ + +** Drawers + :PROPERTIES: + :DESCRIPTION: Tucking stuff away + :END: +#+cindex: drawers +#+cindex: #+DRAWERS +#+cindex: visibility cycling, drawers + +#+vindex: org-drawers +#+cindex: org-insert-drawer +#+kindex: C-c C-x d +Sometimes you want to keep information associated with an entry, but you +normally don't want to see it. For this, Org mode has /drawers/. +Drawers need to be configured with the variable +~org-drawers~.[fn:172] Drawers +look like this: + +#+begin_src org + ,** This is a headline + Still outside the drawer + :DRAWERNAME: + This is inside the drawer. + :END: + After the drawer. +#+end_src + + +You can interactively insert drawers at point by calling +~org-insert-drawer~, which is bound to {{{kbd(C-c C-x d)}}}. +With an active region, this command will put the region inside the +drawer. With a prefix argument, this command calls +~org-insert-property-drawer~ and add a property drawer right +below the current headline. Completion over drawer keywords is also +possible using {{{key(M-TAB)}}}. + +Visibility cycling (see [[Visibility cycling]]) on the headline +will hide and show the entry, but keep the drawer collapsed to a +single line. In order to look inside the drawer, you need to move the +cursor to the drawer line and press {{{key(TAB)}}} there. Org mode +uses the ~PROPERTIES~ drawer for storing properties +(see [[Properties and columns]]), and you can also arrange for +state change notes (see [[Tracking TODO state changes]) and +clock times (see [[Clocking work time]) to be stored in a drawer +~LOGBOOK~. If you want to store a quick note in the LOGBOOK +drawer, in a similar way to state changes, use + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-c C-z)}}} :: Add a time-stamped note to the LOGBOOK + drawer. + + #+kindex: C-c C-z + +** Blocks + :PROPERTIES: + :DESCRIPTION: Folding blocks + :END: +#+vindex: org-hide-block-startup +#+cindex: blocks, folding + +Org mode uses ~begin~ ... ~end~ blocks for various purposes from including +source code examples (see [[Literal examples]]) to capturing time logging +information (see [[Clocking work time]]). These blocks can be folded +and unfolded by pressing TAB in the begin line. You can also get all +blocks folded at startup by configuring the variable +~org-hide-block-startup~ or on a per-file basis by using + +#+cindex: @code{hideblocks}, STARTUP keyword +#+cindex: @code{nohideblocks}, STARTUP keyword +#+begin_src org + ,#+STARTUP: hideblocks + ,#+STARTUP: nohideblocks +#+end_src + +** Creating footnotes + :PROPERTIES: + :DESCRIPTION: Define footnotes in Org syntax + :END: +#+cindex: footnotes + +Org mode supports the creation of footnotes. In contrast to the +{{{file(footnote.el)}}} package, Org mode's footnotes are designed for +work on a larger document, not only for one-off documents like emails. +The basic syntax is similar to the one used by +{{{file(footnote.el)}}}, i.e., a footnote is defined in a paragraph +that is started by a footnote marker in square brackets in column 0, +no indentation allowed. If you need a paragraph break inside a +footnote, use the LaTeX idiom ~\par~. The footnote reference is simply +the marker in square brackets, inside text. For example: + +#+begin_example + The Org homepage[fn:1] now looks a lot better than it used to. + ... + [fn:1] The link is: http://orgmode.org +#+end_example + +Org mode extends the number-based syntax to /named/ footnotes and +optional inline definition. Using plain numbers as markers (as +{{{file(footnote.el)}}} does) is supported for backward compatibility, +but not encouraged because of possible conflicts with LaTeX +snippets (see [[Embedded LaTeX]]). Here are +the valid references: + +#+attr_texinfo: :table-type table :indic @asis + - ~[1]~ :: A plain numeric footnote marker. Compatible with + {{{file(footnote.el)}}}, but not recommended because + something like ~[1]~ could easily be part of a + code snippet. + + - ~[fn:name]~ :: A named footnote reference, where ~name~ is + a unique label word, or, for simplicity of automatic + creation, a number. + - ~[fn:: This is the inline definition of this footnote]~ :: A + LaTeX-like anonymous footnote where the definition + is given directly at the reference point. + - ~[fn:name: a definition]~ :: An inline definition of a footnote, + which also specifies a name for the note. Since Org allows + multiple references to the same note, you can then use + ~[fn:name]~ to create additional references. + + +#+vindex: org-footnote-auto-label +Footnote labels can be created automatically, or you can create names +yourself. This is handled by the variable +~org-footnote-auto-label~ and its corresponding +~#+STARTUP~ keywords. See the docstring of that variable for +details. + +{{{noindent}}} The following command handles footnotes: + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-c C-x f)}}} :: The footnote action command. + #+kindex: C-c C-x f + + When the cursor is on a footnote reference, jump to the + definition. When it is at a definition, jump to the + (first) reference. + + #+vindex: org-footnote-define-inline + #+vindex: org-footnote-section + #+vindex: org-footnote-auto-adjust + + Otherwise, create a new footnote. Depending on the + variable ~org-footnote-define-inline~, the + definition will be placed right into the text as part + of the reference, or separately into the location + determined by the variable ~org-footnote-section~.[fn:173] + + When this command is called with a prefix argument, a + menu of additional options is offered: + + - {{{kbd(s)}}} :: Sort the footnote definitions by reference sequence. + During editing, Org makes no effort to sort footnote + definitions into a particular sequence. If you want them + sorted, use this command, which will also move entries + according to ~org-footnote-section~. Automatic sorting + after each insertion/deletion can be configured using the + variable ~org-footnote-auto-adjust~. + - {{{kbd(r)}}} :: Renumber the simple ~fn:N~ footnotes. Automatic + renumbering after each insertion/deletion can be + configured using the variable ~org-footnote-auto-adjust~. + - {{{kbd(S)}}} :: Short for first ~r~, then ~s~ action. + - {{{kbd(n)}}} :: Normalize the footnotes by collecting all definitions + (including inline definitions) into a special section, and + then numbering them in sequence. The references will then + also be numbers. This is meant to be the final step + before finishing a document (e.g., sending off an email). + The exporters do this automatically, and so could + something like ~message-send-hook~. + - {{{kbd(d)}}} :: Delete the footnote at point, and all definitions of and + references to it. + + Depending on the variable ~org-footnote-auto-adjust~, renumbering + and sorting footnotes can be automatic after each insertion or + deletion.[fn:174] + + - {{{kbd(C-c C-c)}}} :: If the cursor is on a footnote reference, jump to the + definition. If it is a the definition, jump back to + the reference. When called at a footnote location with + a prefix argument, offer the same menu as {{{kbd(C-c C-x f)}}}. + + #+kindex: C-c C-c + + - {{{kbd(C-c C-o)}}} or {{{kbd(mouse-1/2)}}} :: Footnote labels are also + links to the corresponding definition/reference, and you can + use the usual commands to follow these links. + + #+kindex: C-c C-o + #+kindex: mouse-1 + #+kindex: mouse-2 + +** Orgstruct mode + :PROPERTIES: + :DESCRIPTION: Structure editing outside Org + :ALT_TITLE: Orgstruct mode + :END: +#+cindex: Orgstruct mode +#+cindex: minor mode for structure editing + +If you like the intuitive way the Org mode structure editing and list +formatting works, you might want to use these commands in other modes +like Text mode or Mail mode as well. The minor mode ~orgstruct-mode~ +makes this possible. Toggle the mode with {{{kbd(M-x orgstruct-mode)}}}, or turn it on by default, for example in Message +mode, with one of: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp + (add-hook 'message-mode-hook 'turn-on-orgstruct) + (add-hook 'message-mode-hook 'turn-on-orgstruct++) +#+end_src + +When this mode is active and the cursor is on a line that looks to Org +like a headline or the first line of a list item, most structure +editing commands will work, even if the same keys normally have +different functionality in the major mode you are using. If the +cursor is not in one of those special lines, Orgstruct mode lurks +silently in the shadows. When you use ~orgstruct++-mode~, Org will +also export indentation and autofill settings into that mode, and +detect item context after the first line of an item. + +* Tables + :PROPERTIES: + :DESCRIPTION: Pure magic for quick formatting + :END: +#+cindex: tables +#+cindex: editing tables + +Org comes with a fast and intuitive table editor. Spreadsheet-like +calculations are supported using the Emacs {{{file(calc)}}} package +([[info:calc]]). + +** Built-in table editor + :PROPERTIES: + :DESCRIPTION: Simple tables + :END: +#+cindex: table editor, built-in + +Org makes it easy to format tables in plain ASCII. Any line with +{{{samp(|)}}} as the first non-whitespace character is considered part +of a table. {{{samp(|)}}} is also the column separator.[fn:22] A table +might look like this: + +#+begin_src org + | Name | Phone | Age | + |-------+-------+-----| + | Peter | 1234 | 17 | + | Anna | 4321 | 25 | +#+end_src + + +A table is re-aligned automatically each time you press {{{key(TAB)}}} +or {{{key(RET)}}} or {{{kbd(C-c C-c)}}} inside the table. +{{{key(TAB)}}} also moves to the next field ({{{key(RET)}}} to the +next row) and creates new table rows at the end of the table or before +horizontal lines. The indentation of the table is set by the first +line. Any line starting with {{{samp(|-)}}} is considered as a +horizontal separator line and will be expanded on the next re-align to +span the whole table width. So, to create the above table, you would +only type + +#+begin_src org + |Name|Phone|Age| + |- +#+end_src + + +{{{noindent}}} and then press {{{key(TAB)}}} to align the table and +start filling in fields. Even faster would be to type +~|Name|Phone|Age~ followed by {{{kbdspckey(C-c,RET)}}}. + +#+vindex: org-enable-table-editor +#+vindex: org-table-auto-blank-field + +When typing text into a field, Org treats {{{key(DEL)}}}, +{{{key(Backspace)}}}, and all character keys in a special way, so that +inserting and deleting avoids shifting other fields. Also, when +typing /immediately/ after the cursor was moved into a new field with +{{{key(TAB)}}}, {{{kbdkey(S-,TAB)}}} or {{{key(RET)}}}, the field is +automatically made blank. If this behavior is too unpredictable for +you, configure the variables ~org-enable-table-editor~ and +~org-table-auto-blank-field~. +*** Creation and conversion + :PROPERTIES: + :DESCRIPTION: Creating tabular data in Org + :END: +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c |)}}}, ~org-table-create-or-convert-from-region~ :: Convert + the active region to table. If every line contains at least one + {{{key(TAB)}}} character, the function assumes that the material + is tab separated. If every line contains a comma, comma-separated + values (CSV) are assumed. If not, lines are split at whitespace + into fields. You can use a prefix argument to force a specific + separator: {{{kbd(C-u)}}} forces CSV, {{{kbd(C-u C-u)}}} forces + {{{key(TAB)}}}, and a numeric argument ~N~ indicates that at + least N consecutive spaces, or alternatively a {{{key(TAB)}}} + will be the separator. If there is no active region, this command + creates an empty Org table. But it is easier just to start + typing, like {{{kbdspckey(|Name|Phone|Age,RET)}}} {{{kbdkey(|- + ,TAB)}}}. + + #+kindex: C-c | + #+findex: org-table-create-or-convert-from-region + +*** Re-aligning and field motion + :PROPERTIES: + :DESCRIPTION: Navigating and tidying + :END: +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-c)}}}, ~org-table-align~ :: Re-align the table without + moving the cursor. + + #+kindex: C-c C-c + #+findex: org-table-align +- {{{kbd(<TAB>)}}}, ~org-table-next-field~ :: Re-align the table, move + to the next field. Creates a new row if necessary. + + #+kindex: <TAB> + #+findex: org-table-next-field +- {{{kbdkey(S-,TAB)}}}, ~org-table-previous-field~ :: Re-align, move to + previous field. + + #+kindex: S-TAB + #+findex: org-table-previous-field +- {{{key(RET)}}}, ~org-table-next-row~ :: Re-align the table and move + down to next row. Creates a new row if necessary. At the + beginning or end of a line, {{{key(RET)}}} still does NEWLINE, so + it can be used to split a table. + + #+kindex: RET + #+findex: org-table-next-row +- {{{kbd(M-a)}}}, ~org-table-beginning-of-field~ :: Move to beginning + of the current table field, or on to the previous field. + + #+kindex: M-a + #+findex: org-table-beginning-of-field +- {{{kbd(M-e)}}}, ~org-table-end-of-field~ :: Move to end of the + current table field, or on to the next field. + + #+kindex: M-e + #+findex: org-table-end-of-field + +*** Column and row editing + :PROPERTIES: + :DESCRIPTION: Insert, kill, or move + :END: +#+attr_texinfo: :table-type table :indic @asis +- {{{kbdkey(M-,left)}}}, ~org-table-move-column-left~ :: + #+kindex: M-left + #+findex: org-table-move-column-left + + Move the current column left. + +- {{{kbdkey(M-,right)}}}, ~org-table-move-column-right~ :: + #+kindex: M-right + #+findex: org-table-move-column-right + + Move the current column right. + +- {{{kbdkey(M-S-,left)}}}, ~org-table-delete-column~ :: + #+kindex: M-S-left + #+findex: org-table-delete-column + + Kill the current column. + +- {{{kbdkey(M-S-,right)}}}, ~org-table-insert-column~ :: + #+kindex: M-S-right + #+findex: org-table-insert-column + + Insert a new column to the left of the cursor position. + +- {{{kbdkey(M-,up)}}}, ~org-table-move-row-up~ :: + #+kindex: M-up + #+findex: org-table-move-row-up + + Move the current row up. + +- {{{kbdkey(M-,down)}}}, ~org-table-move-row-down~ :: + #+kindex: M-down + #+findex: org-table-move-row-down + + Move the current row down. + +- {{{kbdkey(M-S-,up)}}}, ~org-table-kill-row~ :: Kill the current row + or horizontal line. + + #+kindex: M-S-up + #+findex: org-table-kill-row + +- {{{kbdkey(M-S-,down)}}}, ~org-table-insert-row~ :: Insert a new row + above the current row. With a prefix argument, the line is + created below the current one. + + #+kindex: M-S-down + #+findex: org-table-insert-row + +- {{{kbd(C-c -)}}}, ~org-table-insert-hline~ :: Insert a horizontal + line below current row. With a prefix argument, the line is + created above the current line. + + #+kindex: C-c - + #+findex: org-table-insert-hline + +- {{{kbdspckey(C-c,RET)}}}, ~org-table-hline-and-move~ :: Insert a + horizontal line below current row, and move the cursor into the + row below that line. + + #+kindex: C-c RET + #+findex: org-table-hline-and-move + +- {{{kbd(C-c ^)}}}, ~org-table-sort-lines~ :: Sort the table lines in + the region. The position of point indicates the column to be + used for sorting, and the range of lines is the range between the + nearest horizontal separator lines, or the entire table. If + point is before the first column, you will be prompted for the + sorting column. If there is an active region, the mark specifies + the first line and the sorting column, while point should be in + the last line to be included into the sorting. The command + prompts for the sorting type (alphabetically, numerically, or by + time). When called with a prefix argument, alphabetic sorting + will be case-sensitive. + + #+kindex: C-c ^ + #+findex: org-table-sort-lines +*** Regions + :PROPERTIES: + :DESCRIPTION: Manipulate parts of a table + :END: +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x M-w)}}}, ~org-table-copy-region~ :: Copy a rectangular + region from a table to a special clipboard. Point and mark + determine edge fields of the rectangle. If there is no active + region, copy just the current field. The process ignores + horizontal separator lines. + + #+kindex: C-c C-x M-w + #+findex: org-table-copy-region +- {{{kbd(C-c C-x C-w)}}}, ~org-table-cut-region~ :: Copy a rectangular + region from a table to a special clipboard, and blank all fields + in the rectangle. So this is the ``cut'' operation. + + #+kindex: C-c C-x C-w + #+findex: org-table-cut-region +- {{{kbd(C-c C-x C-y)}}}, ~org-table-paste-rectangle~ :: Paste a + rectangular region into a table. The upper left corner ends up + in the current field. All involved fields will be overwritten. + If the rectangle does not fit into the present table, the table + is enlarged as needed. The process ignores horizontal separator + lines. + + #+kindex: C-c C-x C-y + #+findex: org-table-paste-rectangle +- {{{kbdkey(M-,RET)}}}, ~org-table-wrap-region~ :: Split the current + field at the cursor position and move the rest to the line below. + If there is an active region, and both point and mark are in the + same column, the text in the column is wrapped to minimum width + for the given number of lines. A numeric prefix argument may be + used to change the number of desired lines. If there is no + region, but you specify a prefix argument, the current field is + made blank, and the content is appended to the field above. + + #+kindex: M-RET + #+findex: org-table-wrap-region +*** Calculations + :PROPERTIES: + :DESCRIPTION: Sum and copy + :END: +#+cindex: formula, in tables +#+cindex: calculations, in tables +#+cindex: region, active +#+cindex: active region +#+cindex: transient mark mode + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c +)}}}, ~org-table-sum~ :: Sum the numbers in the current + column, or in the rectangle defined by the active region. The + result is shown in the echo area and can be inserted with + {{{kbd(C-y)}}}. + + #+kindex: C-c + + #+findex: org-table-sum +- {{{kbdkey(S-,RET)}}}, ~org-table-copy-down~ :: When current field is + empty, copy from first non-empty field above. When not empty, + copy current field down to next row and move cursor along with + it. Depending on the variable ~org-table-copy-increment~, + integer field values will be incremented during copy. Integers + that are too large will not be incremented. Also, a ~0~ prefix + argument temporarily disables the increment. This key is also + used by shift-selection and related modes (see [[Conflicts]]). + + #+kindex: S-RET + #+findex: org-table-copy-down + #+vindex: org-table-copy-increment + +*** Misc + :PROPERTIES: + :DESCRIPTION: Some other useful operations + :END: +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c `)}}}, ~org-table-edit-field~ :: Edit the current field in + a separate window. This is useful for fields that are not fully + visible (see [[Column width and alignment]]). When called with a + {{{kbd(C-u)}}} prefix, just make the full field visible, so that + it can be edited in place. When called with two {{{kbd(C-u)}}} + prefixes, make the editor window follow the cursor through the + table and always show the current field. The follow mode exits + automatically when the cursor leaves the table, or when you + repeat this command with {{{kbd(C-u C-u C-c `)}}}. + + #+kindex: C-c ` + #+findex: org-table-edit-field +- {{{kbd(M-x org-table-import)}}} :: Import a file as a table. The + table should be TAB or whitespace separated. Use, for example, + to import a spreadsheet table or data from a database, because + these programs generally can write TAB-separated text files. + This command works by inserting the file into the buffer and then + converting the region to a table. Any prefix argument is passed + on to the converter, which uses it to determine the separator. + +- {{{kbd(C-c |)}}}, ~org-table-create-or-convert-from-region~ :: Tables + can also be imported by pasting tabular text into the Org buffer, + selecting the pasted text with {{{kbd(C-x C-x)}}} and then using + the {{{kbd(C-c |)}}} command (see [[Creation and conversion]]). + + #+kindex: C-c | + #+findex: org-table-create-or-convert-from-region +- {{{kbd(M-x org-table-export)}}} :: Export the table, by default as a + TAB-separated file. Use for data exchange with, for example, + spreadsheet or database programs. The format used to export the + file can be configured in the variable + ~org-table-export-default-format~. You may also use properties + ~TABLE_EXPORT_FILE~ and ~TABLE_EXPORT_FORMAT~ to specify the file + name and the format for table export in a subtree. Org supports + quite general formats for exported tables. The exporter format + is the same as the format used by Orgtbl radio tables, see + [[Translator functions], for a detailed description. + + #+findex: org-table-export + #+vindex: org-table-export-default-format + +If you don't like the automatic table editor because it gets in your +way on lines which you would like to start with {{{samp(|)}}}, you can +turn it off with + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(setq org-enable-table-editor nil) +#+end_src + + +{{{noindent}}} Then the only table command that still works is +{{{kbd(C-c C-c)}}} to do a manual re-align. + +** Column width and alignment + :PROPERTIES: + :DESCRIPTION: Overrule the automatic settings + :END: +#+cindex: narrow columns in tables +#+cindex: alignment in tables + +The width of columns is automatically determined by the table editor. +And also the alignment of a column is determined automatically from +the fraction of number-like versus non-number fields in the column. + +Sometimes a single field or a few fields need to carry more text, +leading to inconveniently wide columns. Or maybe you want to make a +table with several columns having a fixed width, regardless of +content. To set the width of a column, one field anywhere in the +column may contain just the string ~<N>~ where ~N~ +is an integer specifying the width of the column in characters.[fn:23] +The next re-align will then set the width of this column to this +value. + +#+begin_example + |---+------------------------------| |---+--------| + | | | | | <6> | + | 1 | one | | 1 | one | + | 2 | two | ----\ | 2 | two | + | 3 | This is a long chunk of text | ----/ | 3 | This=> | + | 4 | four | | 4 | four | + |---+------------------------------| |---+--------| +#+end_example + +{{{noindent}}} Fields that are wider become clipped and end in the +string {{{samp(=>)}}}. Note that the full text is still in the buffer +but is hidden. To see the full text, hold the mouse over the +field---a tool-tip window will show the full content. To edit such a +field, use the command {{{kbd(C-c `)}}} (that is {{{kbd(C-c)}}} +followed by the backquote). This will open a new window with the full +field. Edit it and finish with {{{kbd(C-c C-c)}}}. + +#+vindex: org-startup-align-all-tables + +When visiting a file containing a table with narrowed columns, the +necessary character hiding has not yet happened, and the table needs +to be aligned before it looks nice. Setting the option +~org-startup-align-all-tables~ will realign all tables in a file upon +visiting, but also slow down startup. You can also set this option on +a per-file basis with: + +#+begin_src org + ,#+STARTUP: align + ,#+STARTUP: noalign +#+end_src + +If you would like to overrule the automatic alignment of number-rich +columns to the right and of string-rich columns to the left, you can +use ~<r>~, ~<c>~ or ~<l>~ in a similar fashion.[fn:24] You may also +combine alignment and field width like this: ~<l10>~. + +A line that only contains these formatting cookies will be removed +automatically when exporting the document. + +** Column groups + :PROPERTIES: + :DESCRIPTION: Grouping to trigger vertical lines + :END: +#+cindex: grouping columns in tables + +When Org exports tables, it does so by default without vertical lines +because that is visually more satisfying in general. Occasionally +however, vertical lines can be useful to structure a table into groups +of columns, much like horizontal lines can do for groups of rows. In +order to specify column groups, you can use a special row where the +first field contains only {{{samp(/)}}}. The further fields can either +contain ~<~ to indicate that this column should start a group, +~>~ to indicate the end of a column, or ~<>~ (no space +between ~<~ and ~>~) to make a column a group of its own. Boundaries +between column groups will upon export be marked with vertical lines. +Here is an example: + +#+begin_src org + | N | N^2 | N^3 | N^4 | sqrt(n) | sqrt[4](N) | + |---+-----+-----+-----+---------+------------| + | / | < | | > | < | > | + | 1 | 1 | 1 | 1 | 1 | 1 | + | 2 | 4 | 8 | 16 | 1.4142 | 1.1892 | + | 3 | 9 | 27 | 81 | 1.7321 | 1.3161 | + |---+-----+-----+-----+---------+------------| + ,#+TBLFM: $2=$1^2::$3=$1^3::$4=$1^4::$5=sqrt($1)::$6=sqrt(sqrt(($1))) +#+end_src + +It is also sufficient to just insert the column group starters after +every vertical line you would like to have: + +#+begin_src org + | N | N^2 | N^3 | N^4 | sqrt(n) | sqrt[4](N) | + |----+-----+-----+-----+---------+------------| + | / | < | | | < | | +#+end_src + +** The Orgtbl mode minor mode + :PROPERTIES: + :DESCRIPTION: The table editor as minor mode + :ALT_TITLE: Ogtbl mode + :END: +#+cindex: Orgtbl mode +#+cindex: minor mode for tables + +If you like the intuitive way the Org table editor works, you might +also want to use it in other modes like Text mode or Mail mode. The +minor mode Orgtbl mode makes this possible. You can always toggle the +mode with {{{kbd(M-x orgtbl-mode)}}}. To turn it on by default, for +example in Message mode, use + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(add-hook 'message-mode-hook 'turn-on-orgtbl) +#+end_src + +Furthermore, with some special setup, it is possible to maintain +tables in arbitrary syntax with Orgtbl mode. For example, it is +possible to construct LaTeX tables with the underlying ease and +power of Orgtbl mode, including spreadsheet capabilities. For +details, see [[Tables in arbitrary syntax]]. + +** The spreadsheet + :PROPERTIES: + :DESCRIPTION: The table editor has spreadsheet capabilities + :END: +#+cindex: calculations, in tables +#+cindex: spreadsheet capabilities +#+cindex: @file{calc} package + +The table editor makes use of the Emacs {{{file(calc)}}} package to +implement spreadsheet-like capabilities. It can also evaluate Emacs +Lisp forms to derive fields from other fields. While fully featured, +Org's implementation is not identical to other spreadsheets. For +example, Org knows the concept of a /column formula/ that will be +applied to all non-header fields in a column without having to copy +the formula to each relevant field. There is also a formula debugger, +and a formula editor with features for highlighting fields in the +table corresponding to the references at the point in the formula, +moving these references by arrow keys + +*** References + :PROPERTIES: + :DESCRIPTION: How to refer to another field or range + :END: +#+cindex: references + +To compute fields in the table from other fields, formulas must +reference other fields or ranges. In Org, fields can be referenced by +name, by absolute coordinates, and by relative coordinates. To find +out what the coordinates of a field are, press {{{kbd(C-c ?)}}} in +that field, or press {{{kbd(C-c })}}} to toggle the display of a +grid. + +**** Field references + :PROPERTIES: + :DESCRIPTION: Refer to a particular field + :END: +#+cindex: field references +#+cindex: references, to fields + +Formulas can reference the value of another field in two ways. Like +in any other spreadsheet, you may reference fields with a +letter/number combination like ~B3~, meaning the 2nd field in the 3rd +row. + +#+vindex: org-table-use-standard-references +However, Org prefers to use another, more general representation that +looks like this:[fn:25] + +#+begin_example + @ROW$COLUMN +#+end_example + +Column specifications can be absolute like ~$1~, ~$2~, ..., ~$N~, or +relative to the current column (i.e., the column of the field which is +being computed) like ~$+1~ or ~$-2~. ~$<~ and ~$>~ are immutable +references to the first and last column, respectively, and you can use +~$>>>~ to indicate the third column from the right. + +The row specification only counts data lines and ignores horizontal +separator lines (hlines). Like with columns, you can use absolute row +numbers ~@1~, ~@2~, ..., ~@N~, and row numbers relative to the current +row like ~@+3~ or ~@-1~. ~@<~ and ~@>~ are immutable references the +first and last row in the table, respectively.[fn:26] You may also +specify the row relative to one of the hlines: ~@I~ refers to the +first hline, ~@II~ to the second, etc. ~@-I~ refers to the first such +line above the current line, ~@+I~ to the first such line below the +current line. You can also write ~@III+2~ which is the second data +line after the third hline in the table. + +~@0~ and ~$0~ refer to the current row and column, respectively, i.e., +to the row/column for the field being computed. Also, if you omit +either the column or the row part of the reference, the current +row/column is implied. + +Org's references with /unsigned/ numbers are fixed references in the +sense that if you use the same reference in the formula for two +different fields, the same field will be referenced each time. Org's +references with /signed/ numbers are floating references because the +same reference operator can reference different fields depending on +the field being calculated by the formula. + +Here are a few examples: + +#+attr_texinfo: :table-type table :indic @code + - @2$3 :: 2nd row, 3rd column (same as ~C2~) + - $5 :: column 5 in the current row (same as ~E&~) + - @2 :: current column, row 2 + - @-1$-3 :: the field one row up, three columns to the left + - @-I$2 :: field just under hline above current row, column 2 + - @>$5 :: field in the last row, in column 5 + +**** Range references + :PROPERTIES: + :DESCRIPTION: Refer to a range of fields + :END: +#+cindex: range references +#+cindex: references, to ranges + +You may reference a rectangular range of fields by specifying two +field references connected by two dots ~..~. If both fields are in +the current row, you may simply use ~$2..$7~, but if at least one +field is in a different row, you need to use the general ~@row$column~ +format at least for the first field (i.e., the reference must start +with ~@~ in order to be interpreted correctly). Examples: + +#+attr_texinfo: :table-type table :indic @code + - $1..$3 :: first three fields in the current row + - $P..$Q :: range, using column names (see under Advanced) + - $<<<..$>> :: start in third column, continue to the one but last + - @2$1..@4$3 :: six fields between these two fields (same as + ~A2..C4~) + - @-1$-2..@-1 :: three numbers from the column to the left, 2 up to + current row + - @I..II :: between first and second hline, short for ~@I..@II~ + + +{{{noindent}}} Range references return a vector of values that can be +fed into Calc vector functions. Empty fields in ranges are normally +suppressed, so that the vector contains only the non-empty fields (but +see the ~E~ mode switch below). If there are no non-empty fields, +~[0]~ is returned to avoid syntax errors in formulas. + +**** Field coordinates in formulas + :PROPERTIES: + :DESCRIPTION: Refer to fields in Lisp or Calc + :END: +#+cindex: field coordinates +#+cindex: coordinates, of field +#+cindex: row, of field coordinates +#+cindex: column, of field coordinates + +For Calc formulas and Lisp formulas ~@#~ and ~$#~ can be used to get +the row or column number of the field where the formula result goes. +The traditional Lisp formula equivalents are ~org-table-current-dline~ +and ~org-table-current-column~. Examples: + +#+attr_texinfo: :table-type table :indic @code + - if(@# % 2, $#, string("")) :: column number on odd lines only + - $3 = remote(FOO, @#$2) :: copy column 2 from table FOO into + column 3 of the current table + +{{{noindent}}} For the second example, table FOO must have at least as +many rows as the current table. Note that this is inefficient for +large number of rows.[fn:27] + +**** Named references + :PROPERTIES: + :DESCRIPTION: Name columns or constants + :END: +#+cindex: named references +#+cindex: references, named +#+cindex: name, of column or field +#+cindex: constants, in calculations +#+cindex: #+CONSTANTS +#+vindex: org-table-formula-constants + +{{{samp($name)}}} is interpreted as the name of a column, parameter or +constant. Constants are defined globally through the variable +~org-table-formula-constants~, and locally (for the file) through a +line like this example: + +#+begin_src org + ,#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6 +#+end_src + +{{{noindent}}} +#+vindex: constants-unit-system +#+pindex: constants.el + +Also, properties (see [[Properties and columns]]) can be used as constants +in table formulas: for a property ~:Xyz:~ use the name ~$PROP_Xyz~, +and the property will be searched in the current outline entry and in +the hierarchy above it. If you have the {{{file(constants.el)}}} +package, it will also be used to resolve constants, including natural +constants like ~$h~ for Planck's constant, and units like ~$km~ for +kilometers. Column names and parameters can be specified in special +table lines. These are described in the section, [[Advanced features]]. +All names must start with a letter, and further consist of letters and +numbers.[fn:175] + +**** Remote references + :PROPERTIES: + :DESCRIPTION: Refer to information in other tables + :END: +#+cindex: remote references +#+cindex: references, remote +#+cindex: references, to a different table +#+cindex: name, of column or field +#+cindex: constants, in calculations +#+cindex: #+TBLNAME + +You may also reference constants, fields and ranges from a different +table, either in the current file or even in a different file. The +syntax is + +#+begin_example + remote(NAME-OR-ID,REF) +#+end_example + +{{{noindent}}} where NAME can be the name of a table in the current +file as set by a ~#+TBLNAME: NAME~ line before the table. It can also +be the ID of an entry, even in a different file, and the reference +then refers to the first table in that entry. REF is an absolute field +or range reference as described above for example ~@3$3~ or +~$somename~, valid in the referenced table. + +*** Formula syntax for Calc + :PROPERTIES: + :DESCRIPTION: Using Calc to compute stuff + :END: +#+cindex: formula syntax, Calc +#+cindex: syntax, of formulas + +A formula can be any algebraic expression understood by the Emacs +{{{file(Calc)}}} package.[fn:28] Before evaluation by ~calc-eval~ (see +[[info:calc#Calling Calc from Your Programs][Calling Calc from Your Lisp Programs]]), variable substitution takes +place according to the rules described above. + +#+cindex: vectors, in table calculations +The range vectors can be directly fed into the Calc vector functions +like ~vmean~ and ~vsum~. + +#+cindex: format specifier +#+cindex: mode, for @file{calc} +#+vindex: org-calc-default-modes + +A formula can contain an optional mode string after a semicolon. This +string consists of flags to influence Calc and other modes during +execution. By default, Org uses the standard Calc modes (precision +12, angular units degrees, fraction and symbolic modes off). The +display format, however, has been changed to ~(float 8)~ to keep +tables compact. The default settings can be configured using the +variable ~org-calc-default-modes~. + +#+attr_texinfo: :table-type table :indic @code + - p20 :: set the internal Calc calculation precision to 20 digits + - n3 s3 e2 f4 :: normal, scientific, engineering, or fixed format of + the result of Calc passed back to Org. Calc + formatting is unlimited in precision as long as the + Calc calculation precision is greater. + - D R :: angle modes: degrees, radians + - F S :: fraction and symbolic modes + - N :: interpret all fields as numbers, use 0 for non-numbers + - E :: keep empty fields in ranges + - L :: literal + +{{{noindent}}} Unless you use large integer numbers or +high-precision-calculation and -display for floating point numbers you +may alternatively provide a ~printf~ format specifier to reformat the +Calc result after it has been passed back to Org instead of letting +Calc already do the formatting.[fn:29] A few examples: + +#+attr_texinfo: :table-type table :indic @code + - $1+$2 :: Sum of first and second field + - $1+$2;%.2f :: Same, format result to two decimals + - exp($2)+exp($1) :: Math functions can be used + - $0;%.1f :: Reformat current cell to 1 decimal + - ($3-32)*5/9 :: Degrees F -> C conversion + - $c/$1/$cm :: Hz -> cm conversion, using + {{{file(constants.el)}}} + - tan($1);Dp3s1 :: Compute in degrees, precision 3, display SCI 1 + - sin($1);Dp3%.1e :: Same, but use ~printf~ specifier for display + - vmean($2..$7) :: Compute column range mean, using vector + function + - vmean($2..$7);EN :: Same, but treat empty fields as 0 + - taylor($3,x=7,2) :: Taylor series of $3, at x=7, second degree + +Calc also contains a complete set of logical operations. For example + +#+attr_texinfo: :table-type table :indic @code + - if($1<20,teen,string("")) :: "teen" if age $1 less than 20, else empty + + +Note that you can also use two org-specific flags ~T~ and ~t~ for +durations computations [[Duration and time values]]. + +You can add your own Calc functions defined in Emacs Lisp with +~defmath~ and use them in formula syntax for Calc. + +*** Emacs Lisp forms as formulas + :PROPERTIES: + :DESCRIPTION: Writing formulas in Emacs Lisp + :ALT_TITLE: Formula syntax for Lisp + :END: +#+cindex: Lisp forms, as table formulas + +It is also possible to write a formula in Emacs Lisp. This can be +useful for string manipulation and control structures, if Calc's +functionality is not enough. + +If a formula starts with a single-quote followed by an opening +parenthesis, then it is evaluated as a Lisp form. The evaluation +should return either a string or a number. Just as with +{{{file(calc)}}} formulas, you can specify modes and a printf format +after a semicolon. + +With Emacs Lisp forms, you need to be conscious about the way field +references are interpolated into the form. By default, a reference +will be interpolated as a Lisp string (in double-quotes) containing +the field. If you provide the {{{samp(N)}}} mode switch, all +referenced elements will be numbers (non-number fields will be zero) +and interpolated as Lisp numbers, without quotes. If you provide the +{{{samp(L)}}} flag, all fields will be interpolated literally, without +quotes. I.e., if you want a reference to be interpreted as a string by +the Lisp form, enclose the reference operator itself in double-quotes, +like ~"$3"~. Ranges are inserted as space-separated fields, so you can +embed them in list or vector syntax. + +Here are a few examples---note how the {{{samp(N)}}} mode is used when +we do computations in Lisp. + +Swap the first two characters of the content of column 1: +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp + '(concat (substring $1 1 2) (substring $1 0 1) (substring $1 2)) +#+end_src + +Add columns 1 and 2, equivalent to Calc's ~$1+$2~: +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp + '(+ $1 $2);N +#+end_src + +Compute the sum of columns 1-4, like Calc's ~vsum($1..$4)~}: +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp + '(apply '+ '($1..$4));N +#+end_src + +*** Duration and time values + :PROPERTIES: + :DESCRIPTION: How to compute duration and time values + :END: +#+cindex: Duration, computing +#+cindex: Time, computing +#+vindex: org-table-duration-custom-format + +If you want to compute time values use the ~T~ flag, either in Calc +formulas or Elisp formulas: + +#+begin_example + | Task 1 | Task 2 | Total | + |---------+----------+----------| + | 2:12 | 1:47 | 03:59:00 | + | 3:02:20 | -2:07:00 | 0.92 | + #+TBLFM: @2$3=$1+$2;T::@3$3=$1+$2;t +#+end_example + +Input duration values must be of the form ~[HH:MM[:SS]~, where seconds +are optional. With the ~T~ flag, computed durations will be displayed +as ~HH:MM:SS~ (see the first formula above). With the ~t~ flag, +computed durations will be displayed according to the value of the +variable ~org-table-duration-custom-format~, which defaults to +~'hours~ and will display the result as a fraction of hours (see the +second formula in the example above). + +Negative duration values can be manipulated as well, and integers will +be considered as seconds in addition and subtraction. + +*** Field and range formulas + :PROPERTIES: + :DESCRIPTION: Formulas for specific (ranges of) fields + :END: +#+cindex: field formula +#+cindex: range formula +#+cindex: formula, for individual table field +#+cindex: formula, for range of fields + +To assign a formula to a particular field, type it directly into the +field, preceded by ~:=~, for example ~vsum(@II..III)~. When you press +{{{key(TAB)}}} or {{{key(RET)}}} or {{{kbd(C-c C-c)}}} with the cursor +still in the field, the formula will be stored as the formula for this +field, evaluated, and the current field will be replaced with the +result. + +#+cindex: #+TBLFM +Formulas are stored in a special line starting with ~#+TBLFM:~ +directly below the table. If you type the equation in the fourth field +of the third data line in the table, the formula will look like +~@3$4=$1+$2~. When inserting/deleting/swapping column and rows with +the appropriate commands, /absolute references/ (but not relative +ones) in stored formulas are modified in order to still reference the +same field. To avoid this from happening, in particular in range +references, anchor ranges at the table borders (using ~@<~, ~@>~, +~$<~, ~$>~), or at hlines using the ~@I~ notation. Automatic +adaptation of field references does of course not happen if you edit +the table structure with normal editing commands---then you must fix +the equations yourself. + +Instead of typing an equation into the field, you may also use the +following command + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-u C-c =)}}}, ~org-table-eval-formula~ :: Install a new + formula for the current field. The command prompts for a + formula with default taken from the {{{samp(#+TBLFM:)}}} line, + applies it to the current field, and stores it. + + #+kindex: C-u C-c = + #+findex: org-table-eval-formula +The left-hand side of a formula can also be a special expression in +order to assign the formula to a number of different fields. There is +no keyboard shortcut to enter such range formulas. To add them, use +the formula editor (see [[Editing and debugging formulas]]) or edit the +~#+TBLFM:~ line directly. + +#+attr_texinfo: :table-type table :indic @code + - $2= :: Column formula, valid for the entire column. This is so + common that Org treats these formulas in a special way, see + [[Column formulas]]. + - @3= :: Row formula, applies to all fields in the specified row. + ~@@>=~ means the last row. + - @1$2..@4$3= :: Range formula, applies to all fields in the given + rectangular range. This can also be used to + assign a formula to some but not all fields in a + row. + - $name= :: Named field, see [[Advanced features]]. + +*** Column formulas + :PROPERTIES: + :DESCRIPTION: Formulas valid for an entire column + :END: +#+cindex: column formula +#+cindex: formula, for table column + +When you assign a formula to a simple column reference like ~$3=~, the +same formula will be used in all fields of that column, with the +following very convenient exceptions: + + - If the table contains horizontal separator hlines with rows above + and below, everything before the first such hline is considered + part of the table /header/ and will not be modified by column + formulas. Therefore a header is mandatory when you use column + formulas and want to add hlines to group rows, like for example + to separate a total row at the bottom from the summand rows + above. + + - Fields that already get a value from a field/range formula will + be left alone by column formulas. These conditions make column + formulas very easy to use. + +To assign a formula to a column, type it directly into any field in +the column, preceded by an equal sign, like {{{samp(=$1+$2)}}}. When +you press {{{key(TAB)}}} or {{{key(RET)}}} or {{{kbd(C-c C-c)}}} with +the cursor still in the field, the formula will be stored as the +formula for the current column, evaluated and the current field +replaced with the result. If the field contains only {{{samp(=)}}}, +the previously stored formula for this column is used. For each +column, Org will only remember the most recently used formula. In the +{{{samp(#+TBLFM:)}}} line, column formulas will look like +{{{samp($4=$1+$2)}}}. The left-hand side of a column formula can not +be the name of column, it must be the numeric column reference or +~$>~. + +Instead of typing an equation into the field, you may also use the +following command: + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-c =)}}}, ~org-table-eval-formula~ :: Install a new formula + for the current column and replace current field with the + result of the formula. The command prompts for a formula, with + default taken from the {{{samp(#+TBLFM)}}} line, applies it to + the current field and stores it. With a numeric prefix + argument(e.g., {{{kbd(C-5 C-c =)}}}) the command will apply it + to that many consecutive fields in the current column. + + #+kindex: C-c = + #+findex: org-table-eval-formula +*** Lookup functions + :PROPERTIES: + :DESCRIPTION: Lookup functions for searching tables + :END: +#+cindex: lookup functions in tables +#+cindex: table lookup functions + +Org has three predefined Emacs Lisp functions for lookups in tables. + +#+attr_texinfo: :table-type table :indic @code + - (org-lookup-first VAL S-LIST R-LIST &optional PREDICATE) :: Searches + for the first element ~S~ in list ~S-LIST~ for which + + #+findex: org-lookup-first + + #+header: :exports code + #+header: :eval no + #+begin_src emacs-lisp + (PREDICATE VAL S) + #+end_src + is ~t~; returns the value from the corresponding position in + list ~R-LIST~. The default ~PREDICATE~ is ~equal~. Note that + the parameters ~VAL~ and ~S~ are passed to ~PREDICATE~ in the + same order as the correspoding parameters are in the call to + ~org-lookup-first~, where ~VAL~ precedes ~S-LIST~. If ~R-LIST~ + is ~nil~, the matching element ~S~ of ~S-LIST~ is returned. + - (org-lookup-last VAL S-LIST R-LIST &optional PREDICATE) :: Similar + to ~org-lookup-first~ above, but searches for the /last/ + element for which ~PREDICATE~ is ~t~. + + #+findex: org-lookup-last + - (org-lookup-all VAL S-LIST R-LIST &optional PREDICATE) :: Similar + to ~org-lookup-first~, but searches for /all/ elements for + which ~PREDICATE~ is ~t~, and returns /all/ corresponding + values. This function can not be used by itself in a formula, + because it returns a list of values. However, powerful lookups + can be built when this function is combined with other Emacs + Lisp functions. + + #+findex: org-lookup-all + +If the ranges used in these functions contain empty fields, the ~E~ +mode for the formula should usually be specified: otherwise empty +fields will not be included in ~S-LIST~ and/or ~R-LIST~ which can, for +example, result in an incorrect mapping from an element of ~S-LIST~ to +the corresponding element of ~R-LIST~. + +These three functions can be used to implement associative arrays, +count matching cells, rank results, group data, etc. For practical +examples see [[http://orgmode.org/worg/org-tutorials/org-lookups.html][this tutorial on Worg]]. + +*** Editing and debugging formulas + :PROPERTIES: + :DESCRIPTION: Fixing formulas + :END: +#+cindex: formula editing +#+cindex: editing, of table formulas + +#+vindex: org-table-use-standard-references You can edit +individual formulas in the minibuffer or directly in the field. Org +can also prepare a special buffer with all active formulas of a table. +When offering a formula for editing, Org converts references to the +standard format (like ~B3~ or ~D&~) if possible. If you prefer to +only work with the internal format (like ~@3$2~ or ~$4~), configure +the variable ~org-table-use-standard-references~. + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-c =)}}} or {{{kbd(C-u C-c =)}}}, ~org-table-eval-formula~ :: + + Edit the formula associated with the current column/field in the + minibuffer. See [[Column formulas]], and [[Field and range formulas]]. + + #+kindex: C-c = + #+kindex: C-u C-c = + #+findex: org-table-eval-formula + - {{{kbd(C-u C-u C-c =)}}}, ~org-table-eval-formula~ :: Re-insert the + active formula (either a field formula, or a column formula) + into the current field, so that you can edit it directly in the + field. The advantage over editing in the minibuffer is that + you can use the command {{{kbd(C-c ?)}}}. + + #+kindex: C-u C-u C-c = + #+findex: org-table-eval-formula + + - {{{kbd(C-c ?)}}}, ~org-table-field-info~ :: While editing a formula + in a table field, highlight the field(s) referenced by the + reference at the cursor position in the formula. + + #+kindex: C-c ? + #+findex: org-table-field-info + + - {{{kbd(C-c })}}}, ~org-table-toggle-coordinate-overlays~ :: Toggle + the display of row and column numbers for a table, using + overlays ({{{command(org-table-toggle-coordinate-overlays)}}}). + These are updated each time the table is aligned; you can force + it with {{{kbd(C-c C-c)}}}. + + #+kindex: C-c @} + #+findex: org-table-toggle-coordinate-overlays + + - {{{kbd(C-c {)}}}, ~org-table-toggle-formula-debugger~ :: Toggle + the formula debugger on and off. See below. + + #+kindex: C-c @{ + #+findex: org-table-toggle-formula-debugger + + - {{{kbd(C-c ')}}}, ~org-table-edit-formulas~ :: Edit all formulas + for the current table in a special buffer, where the formulas + will be displayed one per line. If the current field has an + active formula, the cursor in the formula editor will mark it. + While inside the special buffer, Org will automatically + highlight any field or range reference at the cursor position. + You may edit, remove and add formulas, and use the following + commands: + + #+kindex: C-c ' + #+findex: org-table-edit-formulas + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-c C-c)}}} or {{{kbd(C-x C-s)}}}, ~org-table-fedit-finish~ :: + + Exit the formula editor and store the modified formulas. With + {{{kbd(C-u)}}} prefix, also apply the new formulas to the + entire table. + + #+kindex: C-x C-s + #+kindex: C-c C-c + #+findex: org-table-fedit-finish + - {{{kbd(C-c C-q)}}}, ~org-table-fedit-abort~ :: Exit the formula + editor without installing changes. + + #+kindex: C-c C-q + #+findex: org-table-fedit-abort + - {{{kbd(C-c C-r)}}}, ~org-table-fedit-toggle-ref-type~ :: Toggle all + references in the formula editor between standard (like ~B3~) + and internal (like ~@3$2~). + + #+kindex: C-c C-r + #+findex: org-table-fedit-toggle-ref-type + - {{{key(TAB)}}}, ~org-table-fedit-lisp-indent~ :: Pretty-print or + indent Lisp formula at point. When in a line containing a Lisp + formula, format the formula according to Emacs Lisp rules. + Another {{{key(TAB)}}} collapses the formula back again. In + the open formula, {{{key(TAB)}}} re-indents just like in Emacs + Lisp mode. + + #+kindex: TAB + #+findex: org-table-fedit-lisp-indent + - {{{kbdkey(M-,TAB)}}}, ~lisp-complete-symbol~ :: Complete Lisp + symbols, just like in Emacs Lisp mode. + + #+kindex: M-TAB + #+findex: lisp-complete-symbol + - {{{kbdkey(S-,up)}}}/{{{key(down)}}}/{{{key(left)}}}/{{{key(right)}}} :: Shift + the reference at point. For example, if the reference is ~B3~ + and you press {{{kbdkey(S-,right)}}}, it will become ~C3~. + This also works for relative references and for hline + references. + + #+kindex: S-up + #+kindex: S-down + #+kindex: S-left + #+kindex: S-right + #+findex: org-table-fedit-ref-up + #+findex: org-table-fedit-ref-down + #+findex: org-table-fedit-ref-left + #+findex: org-table-fedit-ref-right + - {{{kbdkey(M-S-,up)}}}, ~org-table-fedit-line-up~ :: + + Move the test line for column formulas up in the Org buffer. + + #+kindex: M-S-up + #+findex: org-table-fedit-line-up + + - {{{kbdkey(M-S-,down)}}}, ~org-table-fedit-line-down~ :: + + Move the test line for column formulas down in the Org buffer. + + #+kindex: M-S-down + #+findex: org-table-fedit-line-down + + - {{{kbdkey(M-,up)}}}, ~org-table-fedit-scroll-up~ :: + + Scroll up the window displaying the table. + + #+kindex: M-up + #+findex: org-table-fedit-scroll-up + + - {{{kbdkey(M-,down)}}}, ~org-table-fedit-scroll-down~ :: + + Scroll down the window displaying the table. + + #+kindex: M-down + #+findex: org-table-fedit-scroll-down + + - {{{kbd(C-c })}}} :: Turn the coordinate grid in the table on and + off. + + #+kindex: C-c @@ + #+findex: org-table-toggle-coordinate-overlays + +Making a table field blank does not remove the formula associated with +the field, because that is stored in a different line (the +{{{samp(#+TBLFM)}}} line)---during the next recalculation the field +will be filled again. To remove a formula from a field, you have to +give an empty reply when prompted for the formula, or to edit the +{{{samp(#+TBLFM)}}} line. + +#+kindex: C-c C-c +You may edit the {{{samp(#+TBLFM)}}} directly and re-apply the changed +equations with {{{kbd(C-c C-c)}}} in that line or with the normal +recalculation commands in the table. + +*** Debugging formulas + :PROPERTIES: + :DESCRIPTION: Help fixing formulas + :END: + +#+cindex: formula debugging +#+cindex: debugging, of table formulas + +When the evaluation of a formula leads to an error, the field content +becomes the string {{{samp(#ERROR)}}}. If you would like see what is +going on during variable substitution and calculation in order to find +a bug, turn on formula debugging in the ~Tbl~ menu and repeat the +calculation, for example by pressing {{{kbdspckey(C-u C-u C-c =,RET)}}} +in a field. Detailed information will be displayed. + +*** Updating the table + :PROPERTIES: + :DESCRIPTION: Recomputing all dependent fields + :END: +#+cindex: recomputing table fields +#+cindex: updating, table + +Recalculation of a table is normally not automatic, but needs to be +triggered by a command. See [[Advanced features]], for a way to make +recalculation at least semi-automatic. + +In order to recalculate a line of a table or the entire table, use the +following commands: + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-c *)}}}, ~org-table-recalculate~ :: Recalculate the + current row by first applying the stored column formulas from + left to right, and all field/range formulas in the current row. + + #+kindex: C-c * + #+findex: org-table-recalculate + - {{{kbd(C-u C-c *)}}} or {{{kbd(C-u C-c C-c)}}} :: Recompute the + entire table, line by line. Any lines before the first hline + are left alone, assuming that these are part of the table + header. + + #+kindex: C-u C-c * + #+kindex: C-u C-c C-c + - {{{kbd(C-u C-u C-c *)}}} or {{{kbd(C-u C-u C-c C-c)}}}, ~org-table-iterate~ :: + + Iterate the table by recomputing it until no further changes + occur. This may be necessary if some computed fields use the + value of other fields that are computed /later/ in the + calculation sequence. + + #+kindex: C-u C-u C-c * + #+kindex: C-u C-u C-c C-c + #+findex: org-table-iterate + - {{{kbd(M-x org-table-recalculate-buffer-tables)}}} :: Recompute + all tables in the current buffer. + + #+findex: org-table-recalculate-buffer-tables + - {{{kbd(M-x org-table-iterate-buffer-tables)}}} :: Iterate all + tables in the current buffer, in order to converge + table-to-table dependencies. + + #+findex: org-table-iterate-buffer-tables +*** Advanced features + :PROPERTIES: + :DESCRIPTION: Field and column names, parameters, and automatic recalc + :END: +If you want the recalculation of fields to happen automatically, or if +you want to be able to assign /names/ to fields and columns, +you need to reserve the first column of the table for special marking +characters.[fn:30] + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-#)}}}, ~org-table-rotate-recalc-marks~ :: Rotate the + calculation mark in first column through the states {{{samp( )}}}, {{{samp(#)}}}, {{{samp(*)}}}, {{{samp(!)}}}, + {{{samp($)}}}. When there is an active region, change all + marks in the region. + + #+kindex: C-# + #+findex: org-table-rotate-recalc-marks +Here is an example of a table that collects exam results of students +and makes use of these features: + +#+begin_src org + |---+---------+--------+--------+--------+-------+------| + | | Student | Prob 1 | Prob 2 | Prob 3 | Total | Note | + |---+---------+--------+--------+--------+-------+------| + | ! | | P1 | P2 | P3 | Tot | | + | # | Maximum | 10 | 15 | 25 | 50 | 10.0 | + | ^ | | m1 | m2 | m3 | mt | | + |---+---------+--------+--------+--------+-------+------| + | # | Peter | 10 | 8 | 23 | 41 | 8.2 | + | # | Sam | 2 | 4 | 3 | 9 | 1.8 | + |---+---------+--------+--------+--------+-------+------| + | | Average | | | | 25.0 | | + | ^ | | | | | at | | + | $ | max=50 | | | | | | + |---+---------+--------+--------+--------+-------+------| + ,#+TBLFM: $6=vsum($P1..$P3)::$7=10*$Tot/$max;%.1f::$at=vmean(@-II..@-I);%.1f +#+end_src + +{{{noindent}}} Important: please note that for these special tables, +recalculating the table with {{{kbd(C-u C-c *)}}} will only affect +rows that are marked ~#~ or ~*~, and fields that +have a formula assigned to the field itself. The column formulas are +not applied in rows with empty first field. + +#+cindex: marking characters, tables +The marking characters have the following meaning: +#+attr_texinfo: :table-type table :indic @samp + - ! :: The fields in this line define names for the columns, so that + you may refer to a column as {{{samp($Tot)}}} instead of + {{{samp($6)}}}. + - ^ :: This row defines names for the fields @emph{above} the row. + With such a definition, any formula in the table may use + {{{samp($m1)}}} to refer to the value {{{samp(10)}}}. Also, + if you assign a formula to a names field, it will be stored + as ~$name= ...~. + - _ :: Similar to {{{samp(^)}}}, but defines names for the fields in + the row /below/. + - $ :: Fields in this row can define /parameters/ for formulas. For + example, if a field in a {{{samp($)}}} row contains + {{{samp(max=50)}}}, then formulas in this table can refer to + the value 50 using {{{samp($max)}}}. Parameters work exactly + like constants, only that they can be defined on a per-table + basis. + - # :: Fields in this row are automatically recalculated when + pressing {{{key(TAB)}}} or {{{key(RET)}}} or + {{{kbdkey(S-,TAB)}}} in this row. Also, this row is selected + for a global recalculation with {{{kbd(C-u C-c *)}}}. + Unmarked lines will be left alone by this command. + - * :: Selects this line for global recalculation with {{{kbd(C-u C-c *)}}}, but not for automatic recalculation. Use this + when automatic recalculation slows down editing too much. + - \nbsp :: Unmarked lines are exempt from recalculation with {{{kbd(C-u C-c *)}}}. All lines that should be recalculated should be + marked with ~#~ or ~*~. + - / :: Do not export this line. Useful for lines that contain the + narrowing ~<N>~ markers or column group markers. + + +Finally, just to whet your appetite for what can be done with the +fantastic {{{file(calc.el)}}} package, here is a table that computes +the Taylor series of degree ~n~ at location ~x~ for a couple of +functions. + +#+begin_src org + |---+-------------+---+-----+--------------------------------------| + | | Func | n | x | Result | + |---+-------------+---+-----+--------------------------------------| + | # | exp(x) | 1 | x | 1 + x | + | # | exp(x) | 2 | x | 1 + x + x^2 / 2 | + | # | exp(x) | 3 | x | 1 + x + x^2 / 2 + x^3 / 6 | + | # | x^2+sqrt(x) | 2 | x=0 | x*(0.5 / 0) + x^2 (2 - 0.25 / 0) / 2 | + | # | x^2+sqrt(x) | 2 | x=1 | 2 + 2.5 x - 2.5 + 0.875 (x - 1)^2 | + | * | tan(x) | 3 | x | 0.0175 x + 1.77e-6 x^3 | + |---+-------------+---+-----+--------------------------------------| + ,#+TBLFM: $5=taylor($2,$4,$3);n3 +#+end_src + +** Org-Plot + :PROPERTIES: + :DESCRIPTION: Plotting from Org tables + :END: +#+cindex: graph, in tables +#+cindex: plot tables using Gnuplot +#+cindex: #+PLOT + +Org-Plot can produce 2D and 3D graphs of information stored in org +tables using [[http://www.gnuplot.info/][Gnuplot]] and [[http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html][gnuplot-mode]]. To see this in action, ensure +that you have both Gnuplot and Gnuplot-mode installed on your system, +then call ~org-plot/gnuplot~ on the following table. + +#+begin_src org + ,#+PLOT: title:"Citas" ind:1 deps:(3) type:2d with:histograms set:"yrange [0:]" + | Sede | Max cites | H-index | + |-----------+-----------+---------| + | Chile | 257.72 | 21.39 | + | Leeds | 165.77 | 19.68 | + | Sao Paolo | 71.00 | 11.50 | + | Stockholm | 134.19 | 14.33 | + | Morels | 257.56 | 17.67 | +#+end_src + +Notice that Org Plot is smart enough to apply the table's headers as +labels. Further control over the labels, type, content, and appearance +of plots can be exercised through the ~#+PLOT:~ lines preceding a +table. See below for a complete list of Org-plot options. For more +information and examples see the [[http://orgmode.org/worg/org-tutorials/org-plot.html][Org-plot tutorial]]. + +Org-Plot recognizes the following options: + +#+attr_texinfo: :table-type table :indic @code + - set :: Specify any {{{command(gnuplot)}}} option to be set when + graphing. + - title :: Specify the title of the plot. + - ind :: Specify which column of the table to use as the ~x~ axis. + - deps :: Specify the columns to graph as a Lisp style list, + surrounded by parentheses and separated by spaces for + example ~dep:(3 4)~ to graph the third and fourth columns + (defaults to graphing all other columns aside from the + ~ind~ column). + - type :: Specify whether the plot will be ~2d~, ~3d~, or ~grid~. + - with :: Specify a ~with~ option to be inserted for every col being + plotted (e.g., ~lines~, ~points~, ~boxes~, ~impulses~, + etc.). Defaults to ~lines~. + - file :: If you want to plot to a file, specify + ~"{path/to/desired/output-file}"~. + - labels :: List of labels to be used for the ~deps~ (defaults to + the column headers if they exist). + - line :: Specify an entire line to be inserted in the Gnuplot + script. + - map :: When plotting ~3d~ or ~grid~ types, set this to ~t~ to + graph a flat mapping rather than a ~3d~ slope. + - timefmt :: Specify format of Org mode timestamps as they will be + parsed by Gnuplot. Defaults to + {{{samp(%Y-%m-%d-%H:%M:%S)}}}. + - script :: If you want total control, you can specify a script file + (place the file name between double-quotes) which will + be used to plot. Before plotting, every instance of + ~$datafile~ in the specified script will be replaced + with the path to the generated data file. Note: even if + you set this option, you may still want to specify the + plot type, as that can impact the content of the data + file. + +* Hyperlinks + :PROPERTIES: + :DESCRIPTION: Notes in context + :ORDERED: t + :END: +#+cindex: hyperlinks + +Like HTML, Org provides links inside a file, external links to +other files, Usenet articles, emails, and much more. + +** Link format + :PROPERTIES: + :DESCRIPTION: How links in Org are formatted + :END: +#+cindex: link format +#+cindex: format, of links + +Org will recognize plain URL-like links and activate them as clickable +links. The general link format, however, looks like this: + +#+begin_src org + [[link][description]] or [[link]] +#+end_src + + +{{{noindent}}} Once a link in the buffer is complete (all brackets +present), Org will change the display so that {{{samp(description)}}} +is displayed instead of ~[[link][description]]~ and {{{samp(link)}}} +is displayed instead of ~[[link]]~. Links will be highlighted +in the face ~org-link~, which by default is an underlined face. You +can directly edit the visible part of a link. Note that this can be +either the {{{samp(link)}}} part (if there is no description) or the +{{{samp(description)}}} part. To edit also the invisible +{{{samp(link)}}} part, use {{{kbd(C-c C-l)}}} with the cursor on the +link. + +If you place the cursor at the beginning or just behind the end of the +displayed text and press {{{key(BACKSPACE)}}}, you will remove the +(invisible) bracket at that location. This makes the link incomplete +and the internals are again displayed as plain text. Inserting the +missing bracket hides the link internals again. To show the internal +structure of all links, use the menu entry ~Org->Hyperlinks->Literal +links~. + +** Internal links + :PROPERTIES: + :DESCRIPTION: Links to other places in the current file + :END: +#+cindex: internal links +#+cindex: links, internal +#+cindex: targets, for links +#+cindex: property, CUSTOM_ID + +If the link does not look like a URL, it is considered to be internal +in the current file. The most important case is a link like +~[[#my-custom-id]]~ which will link to the entry with the +~CUSTOM_ID~ property {{{samp(my-custom-id)}}}. Such custom IDs are +very good for HTML export (see [[HTML export]]) where they produce pretty +section links. You are responsible yourself to make sure these custom +IDs are unique in a file. + +Links such as the two in the following example: + +#+begin_example + [[My Target]] or [[My Target][Find my target]] +#+end_example + +{{{noindent}}} lead to a text search in the current file. + +The link can be followed with {{{kbd(C-c C-o)}}} when the cursor is on +the link, or with a mouse click (see [[Handling links]]). Links to custom +IDs will point to the corresponding headline. The preferred match for +a text link is a /dedicated target/: the same string in double angular +brackets. Targets may be located anywhere; sometimes it is convenient +to put them into a comment line. For example + +#+begin_src org + # <<My Target>> +#+end_src + +{{{noindent}}} In HTML export (see [[HTML export]]), such targets will +become named anchors for direct access through {{{samp(http)}}} +links.[fn:31] + +If no dedicated target exists, Org will search for a headline that is +exactly the link text but may also include a TODO keyword and +tags.[fn:32] In non-Org files, the search will look for the words in +the link text. In the above example the search would be for ~my target~. + +Following a link pushes a mark onto Org's own mark ring. You can +return to the previous position with {{{kbd(C-c &)}}}. Using this +command several times in direct succession goes back to positions +recorded earlier. + +** Radio targets + :PROPERTIES: + :DESCRIPTION: Automatically create internal links + :END: +#+cindex: radio targets +#+cindex: targets, radio +#+cindex: links, radio targets + +Org can automatically turn any occurrences of certain target names in +normal text into a link. So without explicitly creating a link, the +text connects to the target radioing its position. Radio targets are +enclosed by triple angular brackets. For example, a target +~<<<My Target>>>~ causes each occurrence of ~my target~ in +normal text to become activated as a link. The Org file is scanned +automatically for radio targets only when the file is first loaded +into Emacs. To update the target list during editing, press +{{{kbd(C-c C-c)}}} with the cursor on or at a target. + +** External links + :PROPERTIES: + :DESCRIPTION: URL-like links to the world + :END: +#+cindex: links, external +#+cindex: external links +#+cindex: links, external +#+cindex: Gnus links +#+cindex: BBDB links +#+cindex: IRC links +#+cindex: URL links +#+cindex: file links +#+cindex: VM links +#+cindex: RMAIL links +#+cindex: WANDERLUST links +#+cindex: MH-E links +#+cindex: USENET links +#+cindex: SHELL links +#+cindex: Info links +#+cindex: Elisp links + +Org supports links to files, websites, Usenet and email messages, BBDB +database entries and links to both IRC conversations and their logs. +External links are URL-like locators. They start with a short +identifying string followed by a colon. There can be no space after +the colon. The following list shows examples for each link type. + +#+attr_texinfo: :table-type table :indic @asis + - ~http://www.astro.uva.nl/~dominik~ :: on the web + - ~doi:10.1000/182~ :: DOI for an electronic resource + - ~file:/home/dominik/images/jupiter.jpg~ :: file, absolute path + - ~/home/dominik/images/jupiter.jpg~ :: same as above + - ~file:papers/last.pdf~ :: file, relative path + - ~./papers/last.pdf~ :: same as above + - ~file:/myself@some.where:papers/last.pdf~ :: file, path on remote machine + - ~/myself@some.where:papers/last.pdf~ :: same as above + - ~file:sometextfile::NNN~ :: file, jump to line number + - ~file:projects.org~ :: another Org file + - ~file:projects.org::some words~ :: text search in Org file[fn:33] + - ~file:projects.org::*task title~ :: heading search in Org file + - ~file+sys:/path/to/file~ :: open via OS, like double-click + - ~file+emacs:/path/to/file~ :: force opening by Emacs + - ~docview:papers/last.pdf::NNN~ :: open in doc-view mode at page + - ~id:B7423F4D-2E8A-471B-8810-C40F074717E9~ :: Link to heading by ID + - ~news:comp.emacs~ :: Usenet link + - ~mailto:adent@galaxy.net~ :: Mail link + - ~vm:folder~ :: VM folder link + - ~vm:folder#id~ :: VM message link + - ~vm://myself@some.where.org/folder#id~ :: VM on remote machine + - ~vm-imap:account:folder~ :: VM IMAP folder link + - ~vm-imap:account:folder#id~ :: VM IMAP message link + - ~wl:folder~ :: WANDERLUST folder link + - ~wl:folder#id~ :: WANDERLUST message link + - ~mhe:folder~ :: MH-E folder link + - ~mhe:folder#id~ :: MH-E message link + - ~rmail:folder~ :: RMAIL folder link + - ~rmail:folder#id~ :: RMAIL message link + - ~gnus:group~ :: Gnus group link + - ~gnus:group#id~ :: Gnus article link + - ~bbdb:R.*Stallman~ :: BBDB link (with regexp) + - ~irc:/irc.com/#emacs/bob~ :: IRC link + - ~info:org#External links~ :: Info node link + - ~shell:ls *.org~ :: A shell command + - ~elisp:org-agenda~ :: Interactive Elisp command + - ~elisp:(find-file-other-frame "Elisp.org")~ :: Elisp form to evaluate + + +For customizing Org to add new link types [[Adding hyperlink types]]. + +A link should be enclosed in double brackets and may contain a +descriptive text to be displayed instead of the URL (see [[Link format]]), +for example: + +#+begin_src org + [[http://www.gnu.org/software/emacs/][GNU Emacs]] +#+end_src + +{{{noindent}}} If the description is a file name or URL that points to +an image, HTML export (see [[HTML export]]) will inline the image as a +clickable button. If there is no description at all and the link +points to an image, that image will be inlined into the exported HTML +file. + +#+cindex: square brackets, around links +#+cindex: plain text external links + +Org also finds external links in the normal text and activates them as +links. If spaces must be part of the link (for example in +{{{samp(bbdb:Richard Stallman)}}}), or if you need to remove +ambiguities about the end of the link, enclose them in square +brackets. + +** Handling links + :PROPERTIES: + :DESCRIPTION: URL-like links to the world + :END: +#+cindex: links, handling + +Org provides methods to create a link in the correct syntax, to +insert it into an Org file, and to follow the link. + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-c l)}}}, ~org-store-link~ :: Store a link to the current + location. This is a /global/ command (you must create the key + binding yourself) which can be used in any buffer to create a + link. The link will be stored for later insertion into an Org + buffer (see below). What kind of link will be created depends + on the current buffer: + + #+cindex: storing links + #+kindex: C-c l + #+findex: org-store-link + - Org mode buffers :: For Org files, if there is a + ~<<target>>~ at the cursor, the link points to the + target. Otherwise it points to the current headline, which + will also be the description.[fn:34] + + #+vindex: org-link-to-org-use-id + #+cindex: property, CUSTOM_ID + #+cindex: property, ID + + If the headline has a ~CUSTOM_ID~ property, a link to this + custom ID will be stored. In addition or alternatively + (depending on the value of ~org-link-to-org-use-id~), a + globally unique ~ID~ property will be created and/or used to + construct a link.[fn:176] So using this command in Org buffers will + potentially create two links: a human-readable link from the + custom ID, and one that is globally unique and works even if + the entry is moved from file to file. Later, when inserting + the link, you need to decide which one to use. + + - Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus :: Pretty + much all Emacs mail clients are supported. The link will + point to the current article, or, in some GNUS buffers, to + the group. The description is constructed from the author + and the subject. + + - Web browsers: W3 and W3M :: Here the link will be the current + URL, with the page title as description. + + - Contacts: BBDB :: Links created in a BBDB buffer will point to + the current entry. + - Chat: IRC :: For IRC links, if you set the variable + ~org-irc-link-to-logs~ to ~t~, a ~file:~ + style link to the relevant point in the logs for + the current conversation is created. Otherwise an + ~irc:/~ style link to the + user/channel/server under the point will be stored. + + #+vindex: org-irc-link-to-logs + + - Other files :: For any other files, the link will point to the + file, with a search string (see [[Search options]]) + pointing to the contents of the current line. If + there is an active region, the selected words + will form the basis of the search string. If the + automatically created link is not working + correctly or accurately enough, you can write + custom functions to select the search string and + to do the search for particular file types---see + [[Custom searches]]. The key binding {{{kbd(C-c l)}}} + is only a suggestion---see [[Installation]]. + + - Agenda view :: When the cursor is in an agenda view, the created + link points to the entry referenced by the + current line. + + - {{{kbd(C-c C-l)}}}, ~org-insert-link~ :: Insert a link.[fn:35] This + prompts for a link to be inserted into the buffer. You can just + type a link, using text for an internal link, or one of the + link type prefixes mentioned in the examples above. The link + will be inserted into the buffer, along with a + descriptive text.[fn:36] If some text was selected when this command + is called, the selected text becomes the default description. + + #+cindex: link completion + #+cindex: completion, of links + #+cindex: inserting links + #+vindex: org-keep-stored-link-after-insertion + #+kindex: C-c C-l + #+findex: org-insert-link + - Inserting stored links :: All links stored during the current + session are part of the history for this prompt, so you can + access them with {{{key(up)}}} and {{{key(down)}}} (or + {{{kbd(M-p/n)}}}). + + - Completion support :: Completion with {{{key(TAB)}}} will help + you to insert valid link prefixes like ~http:~ or + ~ftp:~, including the prefixes defined through link + abbreviations (see [[Link abbreviations]]). If you press + {{{key(RET)}}} after inserting only the + {{{var(prefix)}}}, Org will offer specific completion + support for some link types.[fn:37] For example, if you type + {{{kbdspckey(file,RET)}}}, file name completion (alternative + access: {{{kbd(C-u C-c C-l)}}}, see below) will be offered, + and after {{{kbdspckey(bbdb,RET)}}} you can complete contact + names. + + - {{{kbd(C-u C-c C-l)}}} :: When {{{kbd(C-c C-l)}}} is called with a + {{{kbd(C-u)}}} prefix argument, a link to a file will be + inserted and you may use file name completion to select the + name of the file. The path to the file is inserted relative to + the directory of the current Org file, if the linked file is in + the current directory or in a sub-directory of it, or if the + path is written relative to the current directory using + {{{samp(../)}}}. Otherwise an absolute path is used, if + possible with {{{samp(~/)}}} for your home directory. You can + force an absolute path with two {{{kbd(C-u)}}} prefixes. + + #+cindex: file name completion + #+cindex: completion, of file names + #+kindex: C-u C-c C-l + + - {{{kbd(C-c C-l)}}} (with cursor on existing link) :: When the + cursor is on an existing link, {{{kbd(C-c C-l)}}} allows you to + edit the link and description parts of the link. + + #+cindex: following links + + - {{{kbd(C-c C-o)}}}, ~org-open-at-point~ :: Open link at + point. This will launch a web browser for URLs (using + {{{command(browse-url-at-point)}}}), run + VM/MH-E/Wanderlust/Rmail/Gnus/BBDB for the corresponding + links, and execute the command in a shell link. When the + cursor is on an internal link, this command runs the + corresponding search. When the cursor is on a TAG list in a + headline, it creates the corresponding TAGS view. If the + cursor is on a timestamp, it compiles the agenda for that + date. Furthermore, it will visit text and remote files in + ~file:~ links with Emacs and select a suitable + application for local non-text files. Classification of files + is based on file extension only. See option ~org-file-apps~. + If you want to override the default application and visit the + file with Emacs, use a {{{kbd(C-u)}}} prefix. If you want to + avoid opening in Emacs, use a {{{kbd(C-u C-u)}}} prefix. If + the cursor is on a headline, but not on a link, offer all + links in the headline and entry text. If you want to setup + the frame configuration for following links, customize + ~org-link-frame-setup~. + + #+vindex: org-file-apps + #+vindex: org-link-frame-setup + #+kindex: C-c C-o + #+findex: org-open-at-point + - {{{key(RET)}}} :: When ~org-return-follows-link~ is set, + {{{key(RET)}}} will also follow the link at + point. + + #+vindex: org-return-follows-link + #+kindex: RET + - {{{key(mouse-2)}}} or {{{key(mouse-1)}}} :: On links, + {{{kbd(mouse-2)}}} will open the link just as {{{kbd(C-c C-o)}}} would. Under Emacs 22 and later, {{{kbd(mouse-1)}}} + will also follow a link. + + #+kindex: mouse-2 + #+kindex: mouse-1 + - {{{key(mouse-3)}}} :: Like {{{kbd(mouse-2)}}}, but force file + links to be opened with Emacs, and internal links to be + displayed in another window.[fn:38] + + #+vindex: org-display-internal-link-with-indirect-buffer + #+kindex: mouse-3 + - {{{kbd(C-c C-x C-v)}}}, ~org-toggle-inline-images~ :: + #+cindex: inlining images + #+cindex: images, inlining + #+vindex: org-startup-with-inline-images + #+cindex: ~inlineimages~, STARTUP keyword + #+cindex: ~noinlineimages~, STARTUP keyword + #+kindex: C-c C-x C-v + #+findex: org-toggle-inline-images + + Toggle the inline display of linked images. Normally this + will only inline images that have no description part in the + link, i.e., images that will also be inlined during export. + When called with a prefix argument, also display images that + do have a link description. You can ask for inline images to + be displayed at startup by configuring the variable + ~org-startup-with-inline-images~.[fn:177] + + - {{{kbd(C-c %)}}}, ~org-mark-ring-push~ :: + #+kindex: C-c % + #+findex: org-mark-ring-push + #+cindex: mark ring + + Push the current position onto the mark ring, to be able to + return easily. Commands following an internal link do this + automatically. + + - {{{kbd(C-c &)}}}, ~org-mark-ring-goto~ :: + #+kindex: C-c & + #+findex: org-mark-ring-goto + #+cindex: links, returning to + + Jump back to a recorded position. A position is recorded by + the commands following internal links, and by {{{kbd(C-c %)}}}. Using this command several times in direct succession + moves through a ring of previously recorded positions. + + - {{{kbd(C-c C-x C-n)}}}, ~org-next-link~ :: + @@info:@itemx@@ {{{kbd(C-c C-x C-p)}}}, ~org-previous-link~ + #+cindex: links, finding next/previous + + #+kindex: C-c C-x C-p + #+findex: org-previous-link + #+kindex: C-c C-x C-n + #+findex: org-next-link + + Move forward/backward to the next link in the buffer. At the + limit of the buffer, the search fails once, and then wraps + around. The key bindings for this are really too long; you + might want to bind this also to {{{kbd(C-n)}}} and + {{{kbd(C-p)}}} + + #+header: :exports code + #+header: :eval no + #+begin_src emacs-lisp + (add-hook 'org-load-hook + (lambda () + (define-key org-mode-map "\C-n" 'org-next-link) + (define-key org-mode-map "\C-p" 'org-previous-link))) + #+end_src + +** Using links outside Org + :PROPERTIES: + :DESCRIPTION: Linking from my C source code? + :END: + +You can insert and follow links that have Org syntax not only in Org, +but in any Emacs buffer. For this, you should create two global +commands, like this (please select suitable global keys yourself): + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp + (global-set-key "\C-c L" 'org-insert-link-global) + (global-set-key "\C-c o" 'org-open-at-point-global) +#+end_src + +** Link abbreviations + :PROPERTIES: + :DESCRIPTION: Shortcuts for writing complex links + :END: +#+cindex: link abbreviations +#+cindex: abbreviation, links + +Long URLs can be cumbersome to type, and often many similar links are +needed in a document. For this you can use link abbreviations. An +abbreviated link looks like this + +#+begin_src org +[[linkword:tag][description]] +#+end_src + +#+vindex: org-link-abbrev-alist + +{{{noindent}}} where the tag is optional. The /linkword/ must be a +word, starting with a letter, followed by letters, numbers, +{{{samp(-)}}}, and {{{samp(_)}}}. Abbreviations are resolved +according to the information in the variable ~org-link-abbrev-alist~ +that relates the linkwords to replacement text. Here is an example: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp + (setq org-link-abbrev-alist + '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=") + ("url-to-ja" . "http://translate.google.fr/translate?sl=en&tl=ja&u=%h") + ("google" . "http://www.google.com/search?q=") + ("gmap" . "http://maps.google.com/maps?q=%s") + ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1") + ("ads" . "http://adsabs.harvard.edu/cgi-bin/nph-abs_connect?author=%s&db_key=AST"))) +#+end_src + +If the replacement text contains the string {{{samp(%s)}}}, it will be +replaced with the tag. Using {{{samp(%h)}}} instead of {{{samp(%s)}}} +will url-encode the tag (see the example above, where we need to +encode the URL parameter.) Using {{{samp(%(my-function))}}} will pass +the tag to a custom function, and replace it by the resulting string. + +If the replacement text don't contain any specifier, it will simply be +appended to the string in order to create the link. + +Instead of a string, you may also specify a function that will be +called with the tag as the only argument to create the link. + +With the above setting, you could link to a specific bug with +~[[bugzilla:129]]~, search the web for {{{samp(OrgMode)}}} with +~[[google:OrgMode]]~, show the map location of the Free Software +Foundation ~[[gmap:51 Franklin Street, Boston]]~ or of Carsten office +~[[omap:Science Park 904, Amsterdam, The Netherlands]]~ and find out what +the Org author is doing besides Emacs hacking with ~[[ads:Dominik,C]]~. + +If you need special abbreviations just for a single Org buffer, you +can define them in the file with + +#+cindex: #+LINK +#+begin_src org + ,#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id= + ,#+LINK: google http://www.google.com/search?q=%s +#+end_src + +{{{noindent}}} In-buffer completion (see [[Completion]]) can be used +after {{{samp([)}}} to complete link abbreviations. You may also +define a function that implements special (e.g., completion) support +for inserting such a link with {{{kbd(C-c C-l)}}}. Such a function +should not accept any arguments, and return the full link with +prefix. You can set the link completion function like this: + +#+BEGIN_SRC emacs-lisp +(org-link-set-parameter "type" :complete #'some-completion-function) +#+END_SRC + +** Search options + :PROPERTIES: + :DESCRIPTION: Linking to a specific location + :END: +#+cindex: search option in file links +#+cindex: file links, searching + +File links can contain additional information to make Emacs jump to a +particular location in the file when following a link. This can be a +line number or a search option after a double colon.[fn:39] +For example, when the command {{{kbd(C-c l)}}} creates a link (see +[[Handling links]]) to a file, it encodes the words in the current line as +a search string that can be used to find this line back later when +following the link with {{{kbd(C-c C-o)}}}. + +Here is the syntax of the different ways to attach a search to a file +link, together with an explanation: + +#+begin_src org + [[file:~/code/main.c::255]] + [[file:~/xx.org::My Target]] + [[file:~/xx.org::*My Target]] + [[file:~/xx.org::#my-custom-id]] + [[file:~/xx.org::/regexp/]] +#+end_src + +#+attr_texinfo: :indic @code +- 255 :: Jump to line 255. +- My Target :: Search for a link target ~<<My Target>>~, or do a text search for {{{samp(my target)}}}, + similar to the search in internal links, see [[Internal links]]. + In HTML export (see [[HTML export]]), such a file link will + become a HTML reference to the corresponding named anchor in the + linked file. +- *My Target :: In an Org file, restrict search to headlines. +- #my-custom-id :: Link to a heading with a ~CUSTOM_ID~ property +- /regexp/ :: Do a regular expression search for ~regexp~. This + uses the Emacs command ~occur~ to list all matches + in a separate window. If the target file is in + Org mode, ~org-occur~ is used to create a sparse + tree with the matches. @c If the target file is a + directory, @c ~grep~ will be used to search all + files in the directory. + +As a degenerate case, a file link with an empty file name can be used +to search the current file. For example, ~[[file:::find me]]~ does a +search for ~find me~ in the current file, just as +~[[find me]]~ would. + +** Custom searches + :PROPERTIES: + :DESCRIPTION: When the default search is not enough + :END: +#+cindex: custom search strings +#+cindex: search strings, custom + +The default mechanism for creating search strings and for doing the +actual search related to a file link may not work correctly in all +cases. For example, BibTeX database files have many entries like +{{{samp(year="1993")}}} which would not result in good search strings, +because the only unique identification for a BibTeX entry is the +citation key. + +#+vindex: org-create-file-search-functions +#+vindex: org-execute-file-search-functions + +If you come across such a problem, you can write custom functions to +set the right search string for a particular file type, and to do the +search for the string in the file. Using ~add-hook~, these functions +need to be added to the hook variables +~org-create-file-search-functions~ and +~org-execute-file-search-functions~. See the docstring for these +variables for more information. Org actually uses this mechanism for +BibTeX database files, and you can use the corresponding code as an +implementation example. See the file {{{file(org-bibtex.el)}}}. + +* TODO items + :PROPERTIES: + :DESCRIPTION: Every tree branch can be a TODO item + :ALT_TITLE: TODO Items + :END: +#+cindex: TODO items + +Org mode does not maintain TODO lists as separate documents.[fn:40] +Instead, TODO items are an integral part of the notes file, because +TODO items usually come up while taking notes! With Org mode, simply +mark any entry in a tree as being a TODO item. In this way, +information is not duplicated, and the entire context from which the +TODO item emerged is always present. + +Of course, this technique for managing TODO items scatters them +throughout your notes file. Org mode compensates for this by providing +methods to give you an overview of all the things that you have to do. + +** TODO basics + :PROPERTIES: + :DESCRIPTION: Marking and displaying TODO entries + :TITLE: Basic TODO functionality + :END: + +Any headline becomes a TODO item when it starts with the word +{{{samp(TODO)}}}, for example: + +#+begin_src org + ,*** TODO Write letter to Sam Fortune +#+end_src + +{{{noindent}}} The most important commands to work with TODO entries +are: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-t)}}}, ~org-todo~ :: + #+kindex: C-c C-t + #+cindex: cycling, of TODO states + + Rotate the TODO state of the current item among + + #+begin_example + ,-> (unmarked) -> TODO -> DONE --. + '--------------------------------' + #+end_example + + The same rotation can also be done ``remotely'' from the timeline and + agenda buffers with the {{{kbd(t)}}} command key (see [[Agenda commands]]). + +- {{{kbd(C-u C-c C-t)}}} :: + #+kindex: C-u C-c C-t + + Select a specific keyword using completion or (if it has been set up) + the fast selection interface. For the latter, you need to assign keys + to TODO states, see [[Per-file keywords]], and [[Setting tags]], for + more information. + + #+kindex: S-@key{right} + #+kindex: S-@key{left} + +- {{{kbdkey(S-,right)}}} {{{kbdkey(S-,left)}}} :: + + #+vindex: org-treat-S-cursor-todo-selection-as-state-change + + Select the following/preceding TODO state, similar to cycling. + Useful mostly if more than two TODO states are possible + (see [[TODO extensions]]). See also [[Conflicts]], for a discussion of the + interaction with ~shift-selection-mode~. See also the variable + ~org-treat-S-cursor-todo-selection-as-state-change~. + +- {{{kbd(C-c / t)}}}, ~org-show-todo-tree~ :: + #+kindex: C-c / t + + #+cindex: sparse tree, for TODO + #+vindex: org-todo-keywords + + View TODO items in a /sparse tree/ (see [[Sparse trees]]). Folds the entire + buffer, but shows all TODO items (with not-DONE state) and the + headings hierarchy above them. With a prefix argument (or by using + {{{kbd(C-c / T)}}}), search for a specific TODO. You will be + prompted for the keyword, and you can also give a list of keywords + like ~KWD1|KWD2|...~ to list entries that match any one of these + keywords. With a numeric prefix argument N, show the tree for the + Nth keyword in the variable ~org-todo-keywords~. With two prefix + arguments, find all TODO states, both un-done and done. + +- {{{kbd(C-c a t)}}}, ~org-todo-list~ :: + #+kindex: C-c a t + + Show the global TODO list. Collects the TODO items (with not-DONE states) + from all agenda files (see [[Agenda views]]) into a single buffer. The new + buffer will be in ~agenda-mode~, which provides commands to examine and + manipulate the TODO entries from the new buffer (see [[Agenda commands]]). + See [[Global TODO list]], for more information. + +- {{{kbdkey(S-M-,RET)}}}, ~org-insert-todo-heading~ :: + #+kindex: S-M-@key{RET} + + Insert a new TODO entry below the current one. + + +{{{noindent}}} +#+vindex: org-todo-state-tags-triggers +Changing a TODO state can also trigger tag changes. See the docstring of the +option ~org-todo-state-tags-triggers~ for details. + +** TODO extensions + :PROPERTIES: + :DESCRIPTION: Work flow and assignments + :TITLE: Extended use of TODO keywords + :END: + +#+cindex: extended TODO keywords + +#+vindex: org-todo-keywords + +By default, marked TODO entries have one of only two states: TODO and +DONE. Org mode allows you to classify TODO items in more complex ways +with /TODO keywords/ (stored in ~org-todo-keywords~). With special +setup, the TODO keyword system can work differently in different +files. + +Note that /tags/ are another way to classify headlines in general and +TODO items in particular (see [[Tags]]). + +*** Workflow states + :PROPERTIES: + :DESCRIPTION: From TODO to DONE in steps + :TITLE: TODO keywords as workflow states + :END: +#+cindex: TODO workflow +#+cindex: workflow states as TODO keywords + +You can use TODO keywords to indicate different /sequential/ states +in the process of working on an item, for example:[fn:41] + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(setq org-todo-keywords + '((sequence "TODO" "FEEDBACK" "VERIFY" "|" "DONE" "DELEGATED"))) +#+end_src + +The vertical bar separates the TODO keywords (states that /need +action/) from the DONE states (which need /no further action/). If +you don't provide the separator bar, the last state is used as the DONE +state. + +#+cindex: completion, of TODO keywords + +With this setup, the command {{{kbd(C-c C-t)}}} will cycle an entry +from TODO to FEEDBACK, then to VERIFY, and finally to DONE and +DELEGATED. You may also use a numeric prefix argument to quickly +select a specific state. For example {{{kbd(C-3 C-c C-t)}}} will +change the state immediately to VERIFY. Or you can use +{{{kbdkey(S-,left)}}} to go backward through the sequence. If you +define many keywords, you can use in-buffer completion (see [[Completion]]) or +even a special one-key selection scheme (see [[Fast access to TODO states]]) +to insert these words into the buffer. Changing a TODO state can be +logged with a timestamp, see [[Tracking TODO state changes]], for +more information. + +*** TODO types + :PROPERTIES: + :DESCRIPTION: I do this, Fred does the rest + :TITLE: TODO keywords as types + :END: +#+cindex: TODO types +#+cindex: names as TODO keywords +#+cindex: types as TODO keywords + +The second possibility is to use TODO keywords to indicate different +/types/ of action items. For example, you might want to indicate +that items are for ``work'' or ``home''. Or, when you work with several +people on a single project, you might want to assign action items +directly to persons, by using their names as TODO keywords. This would +be set up like this: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(setq org-todo-keywords '((type "Fred" "Sara" "Lucy" "|" "DONE"))) +#+end_src + +In this case, different keywords do not indicate a sequence, but rather +different types. So the normal work flow would be to assign a task to a +person, and later to mark it DONE. Org mode supports this style by adapting +the workings of the command {{{kbd(C-c C-t)}}}.[fn:42] When used several +times in succession, it will still cycle through all names, in order to first +select the right type for a task. But when you return to the item after some +time and execute {{{kbd(C-c C-t)}}} again, it will switch from any name directly +to DONE. Use prefix arguments or completion to quickly select a specific +name. You can also review the items of a specific TODO type in a sparse tree +by using a numeric prefix to {{{kbd(C-c / t)}}}. For example, to see all things +Lucy has to do, you would use {{{kbd(C-3 C-c / t)}}}. To collect Lucy's items +from all agenda files into a single buffer, you would use the numeric prefix +argument as well when creating the global TODO list: {{{kbd(C-3 C-c a t)}}}. + +*** Multiple sets in one file + :PROPERTIES: + :DESCRIPTION: Mixing it all, and still finding your way + :TITLE: Multiple keyword sets in one file + :END: +#+cindex: TODO keyword sets + +Sometimes you may want to use different sets of TODO keywords in +parallel. For example, you may want to have the basic +~TODO~ / ~DONE~, but also a workflow for bug fixing, and a +separate state indicating that an item has been canceled (so it is not +DONE, but also does not require action). Your setup would then look +like this: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(setq org-todo-keywords + '((sequence "TODO" "|" "DONE") + (sequence "REPORT" "BUG" "KNOWNCAUSE" "|" "FIXED") + (sequence "|" "CANCELED"))) +#+end_src + +The keywords should all be different, this helps Org mode to keep track +of which subsequence should be used for a given entry. In this setup, +{{{kbd(C-c C-t)}}} only operates within a subsequence, so it switches from +~DONE~ to (nothing) to ~TODO~, and from ~FIXED~ to +(nothing) to ~REPORT~. Therefore you need a mechanism to initially +select the correct sequence. Besides the obvious ways like typing a +keyword or using completion, you may also apply the following commands: + +#+kindex: C-S-@key{right} +#+kindex: C-S-@key{left} +#+kindex: C-u C-u C-c C-t +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-u C-u C-c C-t)}}} {{{kbdkey(C-S-,right)}}} {{{kbdkey(C-S-,left)}}} :: + + These keys jump from one TODO subset to the next. In the above + example, {{{kbd(C-u C-u C-c C-t)}}} or {{{kbdkey(C-S-,right)}}} + would jump from ~TODO~ or ~DONE~ to ~REPORT~, and any of the + words in the second row to ~CANCELED~. Note that the + {{{kbd(C-S-)}}} key binding conflict with ~shift-selection-mode~ + (see [[Conflicts]]). + +- {{{kbdkey(S-,right)}}} {{{kbdkey(S-,left)}}} :: + #+kindex: S-@key{right} + #+kindex: S-@key{left} + + {{{kbdkey(S-,left)}}} and {{{kbdkey(S-,right)}}} walk through /all/ + keywords from all sets, so for example {{{kbdkey(S-,right)}}} would switch + from ~DONE~ to ~REPORT~ in the example above. See also + [[Conflicts]], for a discussion of the interaction with + ~shift-selection-mode~. + +*** Fast access to TODO states + :PROPERTIES: + :DESCRIPTION: Single letter selection of state + :END: +If you would like to quickly change an entry to an arbitrary TODO state +instead of cycling through the states, you can set up keys for single-letter +access to the states. This is done by adding the selection character after +each keyword, in parentheses.[fn:43] For example: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(setq org-todo-keywords + '((sequence "TODO(t)" "|" "DONE(d)") + (sequence "REPORT(r)" "BUG(b)" "KNOWNCAUSE(k)" "|" "FIXED(f)") + (sequence "|" "CANCELED(c)"))) +#+end_src + +#+vindex: org-fast-tag-selection-include-todo + +If you then press {{{kbd(C-c C-t)}}} followed by the selection key, +the entry will be switched to this state. {{{kbd(SPC)}}} can be used +to remove any TODO keyword from an entry.[fn:44] + +*** Per-file keywords + :PROPERTIES: + :DESCRIPTION: Different files, different requirements + :TITLE: Setting up keywords for individual files + :END: +#+cindex: keyword options +#+cindex: per-file keywords +#+cindex: #+TODO +#+cindex: #+TYP_TODO +#+cindex: #+SEQ_TODO + +It can be very useful to use different aspects of the TODO mechanism in +different files. For file-local settings, you need to add special lines +to the file which set the keywords and interpretation for that file +only. For example, to set one of the two examples discussed above, you +need one of the following lines, starting in column zero anywhere in the +file: + +#+begin_example + ,#+TODO: TODO FEEDBACK VERIFY | DONE CANCELED +#+end_example + +{{{noindent}}} (you may also write ~#+SEQ_TODO~ to be explicit about the +interpretation, but it means the same as ~#+TODO~), or + +#+begin_example + ,#+TYP_TODO: Fred Sara Lucy Mike | DONE +#+end_example + +A setup for using several sets in parallel would be: + +#+begin_example + ,#+TODO: TODO | DONE + ,#+TODO: REPORT BUG KNOWNCAUSE | FIXED + ,#+TODO: | CANCELED +#+end_example + +#+cindex: completion, of option keywords +#+kindex: M-@key{TAB} +{{{noindent}}} To make sure you are using the correct keyword, type +{{{samp(#+)}}} into the buffer and then use {{{kbdkey(M-,TAB)}}} completion. + +#+cindex: DONE, final TODO keyword +Remember that the keywords after the vertical bar (or the last keyword +if no bar is there) must always mean that the item is DONE (although you +may use a different word). After changing one of these lines, use +{{{kbd(C-c C-c)}}} with the cursor still in the line to make the changes +known to Org mode.[fn:45] + +*** Faces for TODO keywords + :PROPERTIES: + :DESCRIPTION: Highlighting states + :END: +#+cindex: faces, for TODO keywords +#+vindex: org-todo @r{(face)} +#+vindex: org-done @r{(face)} +#+vindex: org-todo-keyword-faces + +Org mode highlights TODO keywords with special faces: ~org-todo~ +for keywords indicating that an item still has to be acted upon, and +~org-done~ for keywords indicating that an item is finished. If +you are using more than 2 different states, you might want to use +special faces for some of them. This can be done using the variable +~org-todo-keyword-faces~. For example: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(setq org-todo-keyword-faces + '(("TODO" . org-warning) ("STARTED" . "yellow") + ("CANCELED" . (:foreground "blue" :weight bold)))) +#+end_src + +While using a list with face properties as shown for CANCELED /should/ +work, this does not always seem to be the case. If necessary, define a +special face and use that. A string is interpreted as a color. The variable +~org-faces-easy-properties~ determines if that color is interpreted as a +foreground or a background color. + +*** TODO dependencies + :PROPERTIES: + :DESCRIPTION: When one task needs to wait for others + :END: +#+cindex: TODO dependencies +#+cindex: dependencies, of TODO states +#+vindex: org-enforce-todo-dependencies +#+cindex: property, ORDERED + +The structure of Org files (hierarchy and lists) makes it easy to define TODO +dependencies. Usually, a parent TODO task should not be marked DONE until +all subtasks (defined as children tasks) are marked as DONE. And sometimes +there is a logical sequence to a number of (sub)tasks, so that one task +cannot be acted upon before all siblings above it are done. If you customize +the variable ~org-enforce-todo-dependencies~, Org will block entries +from changing state to DONE while they have children that are not DONE. +Furthermore, if an entry has a property ~ORDERED~, each of its children +will be blocked until all earlier siblings are marked DONE. Here is an +example: + +#+begin_src org + ,* TODO Blocked until (two) is done + ,** DONE one + ,** TODO two + + ,* Parent + :PROPERTIES: + :ORDERED: t + :END: + ,** TODO a + ,** TODO b, needs to wait for (a) + ,** TODO c, needs to wait for (a) and (b) +#+end_src + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x o)}}}, ~org-toggle-ordered-property~ :: + #+kindex: C-c C-x o + #+vindex: org-track-ordered-property-with-tag + #+cindex: property, ORDERED + + Toggle the ~ORDERED~ property of the current entry. A property is used + for this behavior because this should be local to the current entry, not + inherited like a tag. However, if you would like to /track/ the value of + this property with a tag for better visibility, customize the variable + ~org-track-ordered-property-with-tag~. +- {{{kbd(C-u C-u C-u C-c C-t)}}} :: + #+kindex: C-u C-u C-u C-c C-t + + Change TODO state, circumventing any state blocking. + + +#+vindex: org-agenda-dim-blocked-tasks + +If you set the variable ~org-agenda-dim-blocked-tasks~, TODO entries +that cannot be closed because of such dependencies will be shown in a dimmed +font or even made invisible in agenda views (see [[Agenda views]]). + +#+cindex: checkboxes and TODO dependencies +#+vindex: org-enforce-todo-dependencies + +You can also block changes of TODO states by looking at checkboxes +(see [[Checkboxes]]). If you set the variable +~org-enforce-todo-checkbox-dependencies~, an entry that has unchecked +checkboxes will be blocked from switching to DONE. + +If you need more complex dependency structures, for example dependencies +between entries in different trees or files, check out the contributed +module {{{file(org-depend.el)}}}. + +{{{page}}} + +** Progress logging + :PROPERTIES: + :DESCRIPTION: Dates and notes for progress + :END: +#+cindex: progress logging +#+cindex: logging, of progress + +Org mode can automatically record a timestamp and possibly a note when +you mark a TODO item as DONE, or even each time you change the state of +a TODO item. This system is highly configurable, settings can be on a +per-keyword basis and can be localized to a file or even a subtree. For +information on how to clock working time for a task, see [[Clocking work time]]. + +*** Closing items + :PROPERTIES: + :DESCRIPTION: When was this entry marked DONE? + :END: + +The most basic logging is to keep track of /when/ a certain TODO +item was finished. This is achieved with:[fn:46] + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(setq org-log-done 'time) +#+end_src + +{{{noindent}}} Then each time you turn an entry from a TODO (not-done) +state into any of the DONE states, a line {{{samp(CLOSED: [timestamp])}}} will be inserted just after the headline. If you turn +the entry back into a TODO item through further state cycling, that +line will be removed again. If you want to record a note along with +the timestamp, use:[fn:47] + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(setq org-log-done 'note) +#+end_src + +{{{noindent}}} You will then be prompted for a note, and that note +will be stored below the entry with a {{{samp(Closing Note)}}} +heading. + +In the timeline (see [[Timeline for a single file]]) and in the agenda +(see [[Weekly/daily agenda]]), you can then use the {{{kbd(l)}}} key to +display the TODO items with a {{{samp(CLOSED)}}} timestamp on each +day, giving you an overview of what has been done. + +*** Tracking TODO state changes + :PROPERTIES: + :DESCRIPTION: When did the status change? + :END: +#+cindex: drawer, for state change recording +#+vindex: org-log-states-order-reversed +#+vindex: org-log-into-drawer +#+cindex: property, LOG_INTO_DRAWER + +When TODO keywords are used as workflow states (see [[Workflow +states]]), you might want to keep track of when a state change occurred +and maybe take a note about this change. You can either record just a +timestamp, or a time-stamped note for a change. These records will be +inserted after the headline as an itemized list, newest first.[fn:48] +When taking a lot of notes, you might want to get the notes out of the +way into a drawer (see [[Drawers]]). Customize the variable +~org-log-into-drawer~ to get this behavior---the recommended drawer +for this is called ~LOGBOOK~.[fn:178] You can also overrule the setting +of this variable for a subtree by setting a ~LOG_INTO_DRAWER~ +property. + +Since it is normally too much to record a note for every state, Org +mode expects configuration on a per-keyword basis for this. This is +achieved by adding special markers {{{samp(!)}}} (for a timestamp) or +{{{samp(@)}}} (for a note with timestamp) in parentheses after each +keyword. For example, with the setting: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(setq org-todo-keywords + '((sequence "TODO(t)" "WAIT(w@@/!)" "|" "DONE(d!)" "CANCELED(c@@)"))) +#+end_src + +{{{noindent}}} +#+vindex: org-log-done + +you not only define global TODO keywords and fast access keys, but +also request that a time is recorded when the entry is set to +DONE, and that a note is recorded when switching to WAIT or +CANCELED.[fn:49] The setting for WAIT is even more special: the {{{samp(!)}}} +after the slash means that in addition to the note taken when entering +the state, a timestamp should be recorded when /leaving/ the WAIT +state, if and only if the /target/ state does not configure logging +for entering it. So it has no effect when switching from WAIT to DONE, +because DONE is configured to record a timestamp only. But when +switching from WAIT back to TODO, the {{{samp(/!)}}} in the WAIT +setting now triggers a timestamp even though TODO has no logging +configured. + +To record a timestamp without a note for TODO keywords configured with +{{{samp(@)}}}, just type {{{kbd(C-c C-c)}}} to enter a blank note +when prompted. + +You can use the exact same syntax for setting logging preferences local +to a buffer: + +#+begin_example + ,#+TODO: TODO(t) WAIT(w@/!) | DONE(d!) CANCELED(c@) +#+end_example + +#+cindex: property, LOGGING + +In order to define logging settings that are local to a subtree or a +single item, define a LOGGING property in this entry. Any non-empty +LOGGING property resets all logging settings to nil. You may then turn +on logging for this specific tree using STARTUP keywords like +~lognotedone~ or ~logrepeat~, as well as adding state specific +settings like ~TODO(!)~. For example: + +#+begin_example + ,* TODO Log each state with only a time + :PROPERTIES: + :LOGGING: TODO(!) WAIT(!) DONE(!) CANCELED(!) + :END: + ,* TODO Only log when switching to WAIT, and when repeating + :PROPERTIES: + :LOGGING: WAIT(@) logrepeat + :END: + ,* TODO No logging at all + :PROPERTIES: + :LOGGING: nil + :END: +#+end_example + +*** Tracking your habits + :PROPERTIES: + :DESCRIPTION: How consistent have you been? + :END: + :LOGBOOK: + - State "DONE" from "DONE" [2013-01-07 Mon 14:10] + - State "DONE" from "" [2013-01-07 Mon 14:10] + :END: +#+cindex: habits + +Org has the ability to track the consistency of a special category of TODOs, +called "habits." A habit has the following properties: + + 1. You have enabled the ~habits~ module by customizing the variable + ~org-modules~. + + 2. The habit is a TODO item, with a TODO keyword representing an + open state. + + 3. The property ~STYLE~ is set to the value ~habit~. + + 4. The TODO has a scheduled date, usually with a ~.+~ style repeat + interval. A ~++~ style may be appropriate for habits with time + constraints, e.g., must be done on weekends, or a ~+~ style for + an unusual habit that can have a backlog, e.g., weekly reports. + + 5. The TODO may also have minimum and maximum ranges specified by + using the syntax {{{samp(.+2d/3d)}}}, which says that you want to + do the task at least every three days, but at most every two + days. + + 6. You must also have state logging for the ~DONE~ state enabled + (see [[Tracking TODO state changes]]), in order for historical + data to be represented in the consistency graph. If it is not + enabled it is not an error, but the consistency graphs will be + largely meaningless. + + +To give you an idea of what the above rules look like in action, here's an +actual habit with some history: + +#+begin_example + ,** TODO Shave + SCHEDULED: <2009-10-17 Sat .+2d/4d> + - State "DONE" from "TODO" [2009-10-15 Thu] + - State "DONE" from "TODO" [2009-10-12 Mon] + - State "DONE" from "TODO" [2009-10-10 Sat] + - State "DONE" from "TODO" [2009-10-04 Sun] + - State "DONE" from "TODO" [2009-10-02 Fri] + - State "DONE" from "TODO" [2009-09-29 Tue] + - State "DONE" from "TODO" [2009-09-25 Fri] + - State "DONE" from "TODO" [2009-09-19 Sat] + - State "DONE" from "TODO" [2009-09-16 Wed] + - State "DONE" from "TODO" [2009-09-12 Sat] + :PROPERTIES: + :STYLE: habit + :LAST_REPEAT: [2009-10-19 Mon 00:36] + :END: +#+end_example + +What this habit says is: I want to shave at most every 2 days (given +by the ~SCHEDULED~ date and repeat interval) and at least every 4 +days. If today is the 15th, then the habit first appears in the agenda +on Oct 17, after the minimum of 2 days has elapsed, and will appear +overdue on Oct 19, after four days have elapsed. + +What's really useful about habits is that they are displayed along +with a consistency graph, to show how consistent you've been at +getting that task done in the past. This graph shows every day that +the task was done over the past three weeks, with colors for each day. +The colors used are: + +#+attr_texinfo: :table-type table :indic @asis + - ~Blue~ :: If the task wasn't to be done yet on that day. + - ~Green~ :: If the task could have been done on that day. + - ~Yellow~ :: If the task was going to be overdue the next day. + - ~Red~ :: If the task was overdue on that day. + + +In addition to coloring each day, the day is also marked with an +asterisk if the task was actually done that day, and an exclamation +mark to show where the current day falls in the graph. + +There are several configuration variables that can be used to change +the way habits are displayed in the agenda. + +#+attr_texinfo: :table-type table :indic @asis + - ~org-habit-graph-column~ :: The buffer column at which the + consistency graph should be drawn. This will overwrite any text + in that column, so it is a good idea to keep your habits' + titles brief and to the point. + + - ~org-habit-preceding-days~ :: The amount of history, in days before + today, to appear in consistency graphs. + + - ~org-habit-following-days~ :: The number of days after today that + will appear in consistency graphs. + + - ~org-habit-show-habits-only-for-today~ :: If non-nil, only show + habits in today's agenda view. This is set to true by default. + + +Lastly, pressing {{{kbd(K)}}} in the agenda buffer will cause habits +to temporarily be disabled and they won't appear at all. Press +{{{kbd(K)}}} again to bring them back. They are also subject to tag +filtering, if you have habits which should only be done in certain +contexts, for example. + +** FIXME Priorities + :PROPERTIES: + :DESCRIPTION: Some things are more important than others + :END: +#+cindex: priorities + +If you use Org mode extensively, you may end up with enough TODO items that +it starts to make sense to prioritize them. Prioritizing can be done by +placing a /priority cookie/ into the headline of a TODO item, like this: + +#+begin_example + ,*** TODO [#A] Write letter to Sam Fortune +#+end_example + +#+vindex: org-priority-faces + +{{{noindent}}} By default, Org mode supports three priorities: {{{samp(A)}}}, +{{{samp(B)}}}, and {{{samp(C)}}}. {{{samp(A)}}} is the highest +priority. An entry without a cookie is treated just like priority +{{{samp(B)}}}. Priorities make a difference only for sorting in the +agenda (see [[Weekly/daily agenda]]); outside the agenda, they have no +inherent meaning to Org mode. The cookies can be highlighted with +special faces by customizing the variable ~org-priority-faces~. + +Priorities can be attached to any outline node; they do not need to be TODO +items. + +#+attr_texinfo: :table-type table :indic @asis + - {{{kbd(C-c XXX)}}} :: + #+kindex: C-c , + # #+kindex: @key{C-c ,} + # Preceding line won't export to pdf + #+findex: org-priority + # Should be C-c , + Set the priority of the current headline (~org-priority~). The + command prompts for a priority character {{{samp(A)}}}, {{{samp(B)}}} + or {{{samp(C)}}}. When you press {{{key(SPC)}}}} instead, the priority + cookie is removed from the headline. The priorities can also be + changed ``remotely'' from the timeline and agenda buffer with the + {{{kbd(\,)}}} command (see [[Agenda commands]]). + + - {{{kbdkey(S-,up)}}}, {{{kbdkey(S-,down)}}}, {{{command(org-priority-up)}}}, {{{command(org-priority-down)}}} :: + #+vindex: org-priority-start-cycle-with-default + + Increase/decrease priority of current headline.[fn:50] Note + that these keys are also used to modify timestamps + (see [[Creating timestamps]]). See also [[Conflicts]], for a + discussion of the interaction with ~shift-selection-mode~. + + +#+vindex: org-highest-priority +#+vindex: org-lowest-priority +#+vindex: org-default-priority + +You can change the range of allowed priorities by setting the +variables ~org-highest-priority~, ~org-lowest-priority~, and +~org-default-priority~. For an individual buffer, you may set these +values (highest, lowest, default) like this (please make sure that the +highest priority is earlier in the alphabet than the lowest priority): + +#+cindex: #+PRIORITIES + +#+begin_example + ,#+PRIORITIES: A C B +#+end_example + +** Breaking down tasks + :PROPERTIES: + :DESCRIPTION: Splitting a task into manageable pieces + :END: +#+cindex: tasks, breaking down +#+cindex: statistics, for TODO items +#+vindex: org-agenda-todo-list-sublevels + +It is often advisable to break down large tasks into smaller, +manageable subtasks. You can do this by creating an outline tree below +a TODO item, with detailed subtasks on the tree.[fn:51] To keep the +overview over the fraction of subtasks that are already completed, +insert either {{{samp([/])}}} or {{{samp([%])}}} anywhere in the +headline. These cookies will be updated each time the TODO status of a +child changes, or when pressing {{{kbd(C-c C-c)}}} on the cookie. For +example: + +#+begin_example + ,* Organize Party [33%] + ,** TODO Call people [1/2] + ,*** TODO Peter + ,*** DONE Sarah + ,** TODO Buy food + ,** DONE Talk to neighbor +#+end_example + +#+cindex: property, COOKIE_DATA + +If a heading has both checkboxes and TODO children below it, the +meaning of the statistics cookie become ambiguous. Set the property +~COOKIE_DATA~ to either {{{samp(checkbox)}}} or {{{samp(todo)}}} to +resolve this issue. + +#+vindex: org-hierarchical-todo-statistics + +If you would like to have the statistics cookie count any TODO entries +in the subtree (not just direct children), configure the variable +~org-hierarchical-todo-statistics~. To do this for a single subtree, +include the word {{{samp(recursive)}}} into the value of the +~COOKIE_DATA~ property. + +#+begin_example + ,* Parent capturing statistics [2/20] + :PROPERTIES: + :COOKIE_DATA: todo recursive + :END: +#+end_example + +If you would like a TODO entry to automatically change to DONE +when all children are done, you can use the following setup: + +#+header: :exports code +#+header: :eval no +#+begin_src emacs-lisp +(defun org-summary-todo (n-done n-not-done) + "Switch entry to DONE when all subentries are done, to TODO otherwise." + (let (org-log-done org-log-states) ; turn off logging + (org-todo (if (= n-not-done 0) "DONE" "TODO")))) + +(add-hook 'org-after-todo-statistics-hook 'org-summary-todo) +#+end_src + +Another possibility is the use of checkboxes to identify (a hierarchy +of) a large number of subtasks (see [[Checkboxes]]). + +** Checkboxes + :PROPERTIES: + :DESCRIPTION: Tick-off lists + :END: + +#+cindex: checkboxes +#+vindex: org-list-automatic-rules + +Every item in a plain list (see [[Plain lists]]) can be made into a +checkbox by starting it with the string {{{samp([ ])}}}.[fn:52] This +feature is similar to TODO items (see [[TODO items]]), but is more +lightweight. Checkboxes are not included into the global TODO list, so +they are often great to split a task into a number of simple steps. Or +you can use them in a shopping list. To toggle a checkbox, use +{{{kbd(C-c C-c)}}}, or use the mouse (thanks to Piotr Zielinski's +{{{file(org-mouse.el)}}}). + +Here is an example of a checkbox list. + +#+begin_example + ,* TODO Organize party [2/4] + - [-] call people [1/3] + - [ ] Peter + - [X] Sarah + - [ ] Sam + - [X] order food + - [ ] think about what music to play + - [X] talk to the neighbors +#+end_example + +Checkboxes work hierarchically, so if a checkbox item has children +that are checkboxes, toggling one of the children checkboxes will make +the parent checkbox reflect if none, some, or all of the children are +checked. + +#+cindex: statistics, for checkboxes +#+cindex: checkbox statistics +#+cindex: property, COOKIE_DATA +#+vindex: org-hierarchical-checkbox-statistics + +The {{{samp([2/4])}}} and {{{samp([1/3])}}} in the first and second +line are cookies indicating how many checkboxes present in this entry +have been checked off, and the total number of checkboxes present. +This can give you an idea on how many checkboxes remain, even without +opening a folded entry. The cookies can be placed into a headline or +into (the first line of) a plain list item. Each cookie covers +checkboxes of direct children structurally below the headline/item on +which the cookie appears.[fn:53] You have to insert the cookie +yourself by typing either {{{samp([/])}}} or {{{samp([%])}}}. With +{{{samp([/])}}} you get an {{{samp(n out of m)}}} result, as in the +examples above. With {{{samp([%])}}} you get information about the +percentage of checkboxes checked (in the above example, this would be +{{{samp([50%])}}} and {{{samp([33%])}}}, respectively). In a headline, +a cookie can count either checkboxes below the heading or TODO states +of children, and it will display whatever was changed last. Set the +property ~COOKIE_DATA~ to either {{{samp(checkbox)}}} or +{{{samp(todo)}}} to resolve this issue. + +#+cindex: blocking, of checkboxes +#+cindex: checkbox blocking +#+cindex: property, ORDERED + +If the current outline node has an ~ORDERED~ property, checkboxes must +be checked off in sequence, and an error will be thrown if you try to +check off a box while there are unchecked boxes above it. + +{{{noindent}}} The following commands work with checkboxes: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-c)}}}, ~org-toggle-checkbox~ :: Toggle checkbox status + or (with prefix arg) checkbox presence at point. With a single + prefix argument, add an empty checkbox or remove the current + one.[fn:54] With a double prefix argument, set it to + {{{samp([-])}}}, which is considered to be an intermediate state. + +- {{{kbd(C-c C-x C-b)}}}, ~org-toggle-checkbox~ :: Toggle checkbox + status or (with prefix arg) checkbox presence at point. With + double prefix argument, set it to {{{samp([-])}}}, which is + considered to be an intermediate state. + + - If there is an active region, toggle the first checkbox in the region + and set all remaining boxes to the same status as the first. With a prefix + arg, add or remove the checkbox for all items in the region. + + - If the cursor is in a headline, toggle checkboxes in the region + between this headline and the next (so /not/ the entire subtree). + + - If there is no active region, just toggle the checkbox at point. + + +- {{{kbdkey(M-S-,RET)}}}, ~org-insert-todo-heading~ :: Insert a new + item with a checkbox. This works only if the cursor is already in + a plain list item (see [[Plain lists]]). + +- {{{kbd(C-c C-x o)}}}, ~org-toggle-ordered-property~ :: + #+kindex: C-c C-x o + #+vindex: org-track-ordered-property-with-tag + #+cindex: property, ORDERED + + Toggle the ~ORDERED~ property of the entry, to toggle if checkboxes + must be checked off in sequence. A property is used for this + behavior because this should be local to the current entry, not + inherited like a tag. However, if you would like to /track/ the + value of this property with a tag for better visibility, + customize the variable ~org-track-ordered-property-with-tag~. + +- {{{kbd(C-c #)}}}, ~org-update-statistics-cookies~ :: + #+kindex: C-c # + + Update the statistics cookie in the current outline entry. When + called with a {{{kbd(C-u)}}} prefix, update the entire file. + Checkbox statistic cookies are updated automatically if you + toggle checkboxes with {{{kbd(C-c C-c)}}} and make new ones with + {{{kbdkey(M-S-,RET)}}}. TODO statistics cookies update when + changing TODO states. If you delete boxes/entries or add/change + them by hand, use this command to get things back into sync. + +* Tags + :PROPERTIES: + :DESCRIPTION: Tagging headlines and matching sets of tags + :END: +#+cindex: tags +#+cindex: headline tagging +#+cindex: matching, tags +#+cindex: sparse tree, tag based + +An excellent way to implement labels and contexts for +cross-correlating information is to assign /tags/ to headlines. Org +mode has extensive support for tags. + +#+vindex: org-tag-faces + +Every headline can contain a list of tags; they occur at the end of +the headline. Tags are normal words containing letters, numbers, +{{{samp(_)}}}, and {{{samp(@)}}}. Tags must be preceded and followed +by a single colon, e.g., {{{samp(:work:)}}}. Several tags can be +specified, as in {{{samp(:work:urgent:)}}}. Tags will by default be in +bold face with the same color as the headline. You may specify special +faces for specific tags using the variable ~org-tag-faces~, in much +the same way as you can for TODO keywords (see [[Faces for TODO keywords]]). + +** Tag inheritance + :PROPERTIES: + :DESCRIPTION: Tags use the tree structure of an outline + :END: +#+cindex: tag inheritance +#+cindex: inheritance, of tags +#+cindex: sublevels, inclusion into tags match + +/Tags/ make use of the hierarchical structure of outline trees. If a +heading has a certain tag, all subheadings will inherit the tag as +well. For example, in the list + +#+begin_example + ,* Meeting with the French group :work: + ,** Summary by Frank :boss:notes: + ,*** TODO Prepare slides for him :action: +#+end_example + +{{{noindent}}} the final heading will have the tags +{{{samp(:work:)}}}, {{{samp(:boss:)}}}, {{{samp(:notes:)}}}, and +{{{samp(:action:)}}} even though the final heading is not explicitly +marked with those tags. You can also set tags that all entries in a +file should inherit just as if these tags were defined in a +hypothetical level zero that surrounds the entire file. Use a line +like this:[fn:55] + +#+cindex: #+FILETAGS +#+begin_example + ,#+FILETAGS: :Peter:Boss:Secret: +#+end_example + +#+vindex: org-use-tag-inheritance +#+vindex: org-tags-exclude-from-inheritance + +{{{noindent}}} To limit tag inheritance to specific tags, or to turn +it off entirely, use the variables ~org-use-tag-inheritance~ and +~org-tags-exclude-from-inheritance~. + +#+vindex: org-tags-match-list-sublevels + +When a headline matches during a tags search while tag inheritance is +turned on, all the sublevels in the same tree will (for a simple match +form) match as well.[fn:56] The list of matches may then become very +long. If you only want to see the first tags match in a subtree, +configure the variable ~org-tags-match-list-sublevels~ (not +recommended). + +** Setting tags + :PROPERTIES: + :DESCRIPTION: How to assign tags to a headline + :END: +#+cindex: setting tags +#+cindex: tags, setting +#+kindex: M-@key{TAB} + +Tags can simply be typed into the buffer at the end of a headline. +After a colon, {{{kbdkey(M-,TAB)}}} offers completion on tags. There is +also a special command for inserting tags: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-q)}}}, ~org-set-tags-command~ :: + #+kindex: C-c C-q + + #+cindex: completion, of tags + #+vindex: org-tags-column + + Enter new tags for the current headline. Org mode will either offer + completion or a special single-key interface for setting tags, see + below. After pressing {{{key(RET)}}}, the tags will be inserted and aligned + to ~org-tags-column~. When called with a {{{kbd(C-u)}}} prefix, all + tags in the current buffer will be aligned to that column, just to make + things look nice. TAGS are automatically realigned after promotion, + demotion, and TODO state changes (see [[TODO basics]]). + +- {{{kbd(C-c C-c)}}}, ~org-set-tags-command~ :: + #+kindex: C-c C-c + + When the cursor is in a headline, this does the same as {{{kbd(C-c C-q)}}}. + + +#+vindex: org-tag-alist + +Org supports tag insertion based on a /list of tags/. By default this +list is constructed dynamically, containing all tags currently used in +the buffer. You may also globally specify a hard list of tags with the +variable ~org-tag-alist~. Finally you can set the default tags for a +given file with lines like + +#+cindex: #+TAGS +#+begin_example + ,#+TAGS: @work @home @tennisclub + ,#+TAGS: laptop car pc sailboat +#+end_example + +If you have globally defined your preferred set of tags using the +variable ~org-tag-alist~, but would like to use a dynamic tag list +in a specific file, add an empty TAGS option line to that file: + +#+begin_example + ,#+TAGS: +#+end_example + +#+vindex: org-tag-persistent-alist + +If you have a preferred set of tags that you would like to use in +every file, in addition to those defined on a per-file basis by TAGS +option lines, then you may specify a list of tags with the variable +~org-tag-persistent-alist~. You may turn this off on a per-file basis +by adding a STARTUP option line to that file: + +#+begin_example + ,#+STARTUP: noptag +#+end_example + +By default Org mode uses the standard minibuffer completion facilities +for entering tags. However, it also implements another, quicker, tag +selection method called /fast tag selection/. This allows you to +select and deselect tags with just a single key press. For this to +work well you should assign unique letters to most of your commonly +used tags. You can do this globally by configuring the variable +~org-tag-alist~ in your {{{file(.emacs)}}} file. For example, you may +find the need to tag many items in different files with +{{{samp(:@home:)}}}. In this case you can set something like: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-tag-alist '(("@@work" . ?w) ("@@home" . ?h) ("laptop" . ?l))) +#+end_src + +{{{noindent}}} If the tag is only relevant to the file you are working +on, then you can instead set the TAGS option line as: + +#+begin_example + ,#+TAGS: @work(w) @home(h) @tennisclub(t) laptop(l) pc(p) +#+end_example + +{{{noindent}}} The tags interface will show the available tags in a splash +window. If you want to start a new line after a specific tag, insert +~\n~ into the tag list, like this: + +#+begin_example + ,#+TAGS: @work(w) @home(h) @tennisclub(t) \n laptop(l) pc(p) +#+end_example + +{{{noindent}}} or write them in two lines: + +#+begin_example + ,#+TAGS: @work(w) @home(h) @tennisclub(t) + ,#+TAGS: laptop(l) pc(p) +#+end_example + +{{{noindent}}} +You can also group together tags that are mutually exclusive by using +braces, as in: + +#+begin_example + ,#+TAGS: { @work(w) @home(h) @tennisclub(t) } laptop(l) pc(p) +#+end_example + +{{{noindent}}} you indicate that at most one of {{{samp(@work)}}}, +{{{samp(@home)}}}, and {{{samp(@tennisclub)}}} should be selected. +Multiple such groups are allowed. + +{{{noindent}}} Don't forget to press {{{kbd(C-c C-c)}}} with the +cursor in one of these lines to activate any changes. + +{{{noindent}}} To set these mutually exclusive groups in the variable +~org-tags-alist~, you must use the dummy tags ~:startgroup~ and +~:endgroup~ instead of the braces. Similarly, you can use ~:newline~ +to indicate a line break. The previous example would be set globally +by the following configuration: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-tag-alist '((:startgroup . nil) + ("@@work" . ?w) ("@@home" . ?h) + ("@@tennisclub" . ?t) + (:endgroup . nil) + ("laptop" . ?l) ("pc" . ?p))) +#+end_src + +If at least one tag has a selection key then pressing {{{kbd(C-c C-c)}}} will +automatically present you with a special interface, listing inherited tags, +the tags of the current headline, and a list of all valid tags with +corresponding keys.[fn:57] In this interface, you can use the following +keys: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(a-z...)}}} :: + #+kindex: a-z... + + Pressing keys assigned to tags will add or remove them from the list of + tags in the current line. Selecting a tag in a group of mutually + exclusive tags will turn off any other tags from that group. + +- {{{key(TAB)}}} :: + #+kindex: @key{TAB} + + Enter a tag in the minibuffer, even if the tag is not in the predefined + list. You will be able to complete on all tags present in the buffer. + You can also add several tags: just separate them with a comma. + +- {{{key(SPC)}}} :: + #+kindex: @key{SPC} + + Clear all tags for this line. + +- {{{key(RET)}}} :: + #+kindex: @key{RET} + + Accept the modified set. + +- C-g :: + + Abort without installing changes. + +- q :: + + If {{{kbd(q)}}} is not assigned to a tag, it aborts like {{{kbd(C-g)}}}. + +- ! :: + + Turn off groups of mutually exclusive tags. Use this to (as an + exception) assign several tags from such a group. + +- C-c :: + + Toggle auto-exit after the next change (see below). + If you are using expert mode, the first {{{kbd(C-c)}}} will display the + selection window. + + +{{{noindent}}} This method lets you assign tags to a headline with +very few keys. With the above setup, you could clear the current tags +and set {{{samp(@home)}}}, {{{samp(laptop)}}} and {{{samp(pc)}}} tags +with just the following keys: {{{ksksksk(C-c C-c,SPC,h l p,RET)}}}. Switching from {{{samp(@home)}}} to +{{{samp(@work)}}} would be done with {{{kbdspckey(C-c C-c w,RET)}}} or +alternatively with {{{kbd(C-c C-c C-c w)}}}. Adding the non-predefined +tag {{{samp(Sarah)}}} could be done with +{{{ksksksksk(C-c C-c,TAB,S a r a h,RET,RET)}}}. + +#+vindex: org-fast-tag-selection-single-key + +If you find that most of the time you need only a single key press to +modify your list of tags, set the variable +~org-fast-tag-selection-single-key~. Then you no longer have to press +{{{key(RET)}}} to exit fast tag selection---it will immediately exit after +the first change. If you then occasionally need more keys, press +{{{kbd(C-c)}}} to turn off auto-exit for the current tag selection +process (in effect: start selection with {{{kbd(C-c C-c C-c)}}} +instead of {{{kbd(C-c C-c)}}}). If you set the variable to the value +~expert~, the special window is not even shown for single-key tag +selection, it comes up only when you press an extra {{{kbd(C-c)}}}. + +** Tag searches + :PROPERTIES: + :DESCRIPTION: Searching for combinations of tags + :END: +#+cindex: tag searches +#+cindex: searching for tags + +Once a system of tags has been set up, it can be used to collect related +information into special lists. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c / m)}}}, ~C-c \~ ~org-match-sparse-tree~ :: + + Create a sparse tree with all headlines matching a tags search. With a + {{{kbd(C-u)}}} prefix argument, ignore headlines that are not a TODO + line. + +- {{{kbd(C-c a m)}}}, ~org-tags-view~ :: + #+kindex: C-c a m + + Create a global list of tag matches from all agenda files. + See [[Matching tags and properties]]. + +- {{{kbd(C-c a M)}}}, ~org-tags-view~ :: + #+kindex: C-c a M + #+vindex: org-tags-match-list-sublevels + + Create a global list of tag matches from all agenda files, but check + only TODO items and force checking subitems (see variable + ~org-tags-match-list-sublevels~). + + +These commands all prompt for a match string which allows basic +Boolean logic like {{{samp(+boss+urgent-project1)}}}, to find entries +with tags {{{samp(boss)}}} and {{{samp(urgent)}}}, but not +{{{samp(project1)}}}, or {{{samp(Kathy|Sally)}}} to find entries which +are tagged, like {{{samp(Kathy)}}} or {{{samp(Sally)}}}. The full +syntax of the search string is rich and allows also matching against +TODO keywords, entry levels and properties. For a complete description +with many examples, see [[Matching tags and properties]]. + +* Properties and columns + :PROPERTIES: + :DESCRIPTION: Storing information about an entry + :ALT_TITLE: Properties and Columns + :END: +#+cindex: properties + +A property is a key-value pair associated with an entry. Properties +can be set so they are associated with a single entry, with every +entry in a tree, or with every entry in an Org mode file. + +There are two main applications for properties in Org mode. First, +properties are like tags, but with a value. Imagine maintaining a file +where you document bugs and plan releases for a piece of software. +Instead of using tags like ~:release_1:~, ~:release_2:~, you can use a +property, say ~:Release:~, that in different subtrees has different +values, such as ~1.0~ or ~2.0~. Second, you can use properties to +implement (very basic) database capabilities in an Org buffer. Imagine +keeping track of your music CDs, where properties could be things such +as the album, artist, date of release, number of tracks, and so on. + +Properties can be conveniently edited and viewed in column view +(see [[Column view]]). + +** Property syntax + :PROPERTIES: + :DESCRIPTION: How properties are spelled out + :END: +#+cindex: property syntax +#+cindex: drawer, for properties + +Properties are key-value pairs. When they are associated with a single +entry or with a tree they need to be inserted into a special drawer +(see [[Drawers]]) with the name ~PROPERTIES~. Each property is specified +on a single line, with the key (surrounded by colons) first, and the +value after it. Here is an example: + +#+begin_example + ,* CD collection + ,** Classic + ,*** Goldberg Variations + , :PROPERTIES: + , :Title: Goldberg Variations + , :Composer: J.S. Bach + , :Artist: Glen Gould + , :Publisher: Deutsche Grammophon + , :NDisks: 1 + , :END: +#+end_example + +Depending on the value of ~org-use-property-inheritance~, a property +set this way will either be associated with a single entry, or the +sub-tree defined by the entry, see [[Property inheritance]]. + +You may define the allowed values for a particular property +{{{samp(:Xyz:)}}} by setting a property {{{samp(:Xyz_ALL:)}}}. This +special property is /inherited/, so if you set it in a level 1 entry, +it will apply to the entire tree. When allowed values are defined, +setting the corresponding property becomes easier and is less prone to +typing errors. For the example with the CD collection, we can +predefine publishers and the number of disks in a box like this: + +#+begin_example + ,* CD collection + , :PROPERTIES: + , :NDisks_ALL: 1 2 3 4 + , :Publisher_ALL: "Deutsche Grammophon" Philips EMI + , :END: +#+end_example + +If you want to set properties that can be inherited by any entry in a +file, use a line like: + +#+cindex: property, _ALL +#+cindex: #+PROPERTY +#+begin_example + ,#+PROPERTY: NDisks_ALL 1 2 3 4 +#+end_example + +If you want to add to the value of an existing property, append a ~+~ +to the property name. The following results in the property ~var~ +having the value ``foo=1 bar=2''. + +#+cindex: property, + +#+begin_example + ,#+PROPERTY: var foo=1 + ,#+PROPERTY: var+ bar=2 +#+end_example + +It is also possible to add to the values of inherited properties. The +following results in the ~genres~ property having the value ``Classic +Baroque'' under the ~Goldberg Variations~ subtree. + +#+cindex: property, + +#+begin_example + ,* CD collection + ,** Classic + , :PROPERTIES: + , :GENRES: Classic + , :END: + ,*** Goldberg Variations + , :PROPERTIES: + , :Title: Goldberg Variations + , :Composer: J.S. Bach + , :Artist: Glen Gould + , :Publisher: Deutsche Grammophon + , :NDisks: 1 + , :GENRES+: Baroque + , :END: +#+end_example +Note that a property can only have one entry per Drawer. + +#+vindex: org-global-properties + +Property values set with the global variable ~org-global-properties~ +can be inherited by all entries in all Org files. + +{{{noindent}}} +The following commands help to work with properties: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbdkey(M-,TAB)}}}, ~pcomplete~ :: + #+kindex: M-@key{TAB} + + After an initial colon in a line, complete property keys. All keys + used in the current file will be offered as possible completions. + +- {{{kbd(C-c C-x p)}}}, ~org-set-property~ :: + #+kindex: C-c C-x p + + Set a property. This prompts for a property name and a value. If + necessary, the property drawer is created as well. + +- C-u M-x org-insert-drawer RET :: + #+cindex: org-insert-drawer + + Insert a property drawer into the current entry. The drawer will be + inserted early in the entry, but after the lines with planning + information like deadlines. + +- {{{kbd(C-c C-c)}}}, ~org-property-action~ :: + #+kindex: C-c C-c + + With the cursor in a property drawer, this executes property commands. + +- {{{kbd(C-c C-c s)}}}, ~org-set-property~ :: + #+kindex: C-c C-c s + + Set a property in the current entry. Both the property and the value + can be inserted using completion. + +- {{{kbdkey(S-,right)}}} {{{kbdkey(S-,left)}}}, ~org-property-next-allowed-value~ ~org-property-previous-allowed-value~ :: + #+kindex: S-@key{right} + + Switch property at point to the next/previous allowed value. + +- {{{kbd(C-c C-c d)}}}, ~org-delete-property~ :: + #+kindex: C-c C-c d + + Remove a property from the current entry. + +- {{{kbd(C-c C-c D)}}}, ~org-delete-property-globally~ :: + #+kindex: C-c C-c D + + Globally remove a property, from all entries in the current file. + +- {{{kbd(C-c C-c c)}}}, ~org-compute-property-at-point~ :: + #+kindex: C-c C-c c + + Compute the property at point, using the operator and scope from the + nearest column format definition. + +** Special properties + :PROPERTIES: + :DESCRIPTION: Access to other Org mode features + :END: +#+cindex: properties, special + +Special properties provide an alternative access method to Org mode +features, like the TODO state or the priority of an entry, discussed +in the previous chapters. This interface exists so that you can +include these states in a column view (see [[Column view]]), or to use +them in queries. The following property names are special and (except +for ~:CATEGORY:~) should not be used as keys in the properties drawer: + +#+cindex: property, special, ID +#+cindex: property, special, TODO +#+cindex: property, special, TAGS +#+cindex: property, special, ALLTAGS +#+cindex: property, special, CATEGORY +#+cindex: property, special, PRIORITY +#+cindex: property, special, DEADLINE +#+cindex: property, special, SCHEDULED +#+cindex: property, special, CLOSED +#+cindex: property, special, TIMESTAMP +#+cindex: property, special, TIMESTAMP_IA +#+cindex: property, special, CLOCKSUM +#+cindex: property, special, CLOCKSUM_T +#+cindex: property, special, BLOCKED +# guessing that ITEM is needed in this area; also, should this list be sorted? +#+cindex: property, special, ITEM +#+cindex: property, special, FILE + +#+attr_texinfo: :columns 0.3 0.7 +| ID | A globally unique ID used for synchronization during | +| | iCalendar or MobileOrg export. | +| TODO | The TODO keyword of the entry. | +| TAGS | The tags defined directly in the headline. | +| ALLTAGS | All tags, including inherited ones. | +| CATEGORY | The category of an entry. | +| PRIORITY | The priority of the entry, a string with a single letter. | +| DEADLINE | The deadline time string, without the angular brackets. | +| SCHEDULED | The scheduling timestamp, without the angular brackets. | +| CLOSED | When was this entry closed? | +| TIMESTAMP | The first keyword-less timestamp in the entry. | +| TIMESTAMP_IA | The first inactive timestamp in the entry. | +| CLOCKSUM | The sum of CLOCK intervals in the subtree. ~org-clock-sum~ | +| | must be run first to compute the values in the current buffer. | +| CLOCKSUM_T | The sum of CLOCK intervals in the subtree for today. | +| | ~org-clock-sum-today~ must be run first to compute the | +| | values in the current buffer. | +| BLOCKED | "t" if task is currently blocked by children or siblings | +| ITEM | The headline of the entry. | +| FILE | The filename the entry is located in. | + +** Property searches + :PROPERTIES: + :DESCRIPTION: Matching property values + :END: +#+cindex: properties, searching +#+cindex: searching, of properties + +To create sparse trees and special lists with selection based on properties, +the same commands are used as for tag searches (see [[Tag searches]]). + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c / m)}}}, ~C-c \~ ~org-match-sparse-tree~ :: + #+kindex: C-c / m + + Create a sparse tree with all matching entries. With a {{{kbd(C-u)}}} + prefix argument, ignore headlines that are not a TODO line. + +- {{{kbd(C-c a m)}}}, ~org-tags-view~ :: + #+kindex: C-c a m + + Create a global list of tag/property matches from all agenda files. + See [[Matching tags and properties]]. + +- {{{kbd(C-c a M)}}}, ~org-tags-view~ :: + #+kindex: C-c a M + #+vindex: org-tags-match-list-sublevels + + Create a global list of tag matches from all agenda files, but check + only TODO items and force checking of subitems (see variable + ~org-tags-match-list-sublevels~). + + +The syntax for the search string is described in [[Matching tags and +properties]]. + +There is also a special command for creating sparse trees based on a +single property: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c / p)}}} :: + #+kindex: C-c / p + + Create a sparse tree based on the value of a property. This first + prompts for the name of a property, and then for a value. A sparse + tree is created with all entries that define this property with the + given value. If you enclose the value in curly braces, it is + interpreted as a regular expression and matched against the property + values. + +** Property inheritance + :PROPERTIES: + :DESCRIPTION: Passing values down a tree + :END: +#+cindex: properties, inheritance +#+cindex: inheritance, of properties + +#+vindex: org-use-property-inheritance + +The outline structure of Org mode documents lends itself to an +inheritance model of properties: if the parent in a tree has a certain +property, the children can inherit this property. Org mode does not +turn this on by default, because it can slow down property searches +significantly and is often not needed. However, if you find +inheritance useful, you can turn it on by setting the variable +~org-use-property-inheritance~. It may be set to ~t~ to make all +properties inherited from the parent, to a list of properties that +should be inherited, or to a regular expression that matches inherited +properties. If a property has the value {{{samp(nil)}}}, this is +interpreted as an explicit undefine of the property, so that +inheritance search will stop at this value and return ~nil~. + +Org mode has a few properties for which inheritance is hard-coded, at +least for the special applications for which they are used: + + +#+attr_texinfo: :table-type table :indic @asis +- ~COLUMNS~ :: + #+cindex: property, COLUMNS + + The ~:COLUMNS:~ property defines the format of column view (see [[Column + view]]). It is inherited in the sense that the level where a ~:COLUMNS:~ + property is defined is used as the starting point for a column view + table, independently of the location in the subtree from where columns + view is turned on. + +- ~CATEGORY~ :: + #+cindex: property, CATEGORY + + For agenda view, a category set through a ~:CATEGORY:~ property + applies to the entire subtree. + +- ~ARCHIVE~ :: + #+cindex: property, ARCHIVE + + For archiving, the ~:ARCHIVE:~ property may define the archive + location for the entire subtree (see [[Moving subtrees]]). + +- ~LOGGING~ :: + #+cindex: property, LOGGING + + The LOGGING property may define logging settings for an entry or a + subtree (see [[Tracking TODO state changes]]). + +** Column view + :PROPERTIES: + :DESCRIPTION: Tabular viewing and editing + :END: + +A great way to view and edit properties in an outline tree is /column +view/. In column view, each outline node is turned into a table row. +Columns in this table provide access to properties of the entries. Org +mode implements columns by overlaying a tabular structure over the +headline of each item. While the headlines have been turned into a +table row, you can still change the visibility of the outline tree. +For example, you get a compact table by switching to CONTENTS view +({{{kbdkey(S-,TAB)}}}} {{{kbdkey(S-,TAB)}}}), or simply {{{kbd(c)}}} while +column view is active), but you can still open, read, and edit the +entry below each headline. Or, you can switch to column view after +executing a sparse tree command and in this way get a table only for +the selected items. Column view also works in agenda buffers (see +[[Agenda views]]) where queries have collected selected items, possibly +from a number of files. + +*** Defining columns + :PROPERTIES: + :DESCRIPTION: The COLUMNS format property + :END: +#+cindex: column view, for properties +#+cindex: properties, column view + +Setting up a column view first requires defining the columns. This is +done by defining a column format line. + +**** Scope of column definitions + :PROPERTIES: + :DESCRIPTION: Where defined, where valid? + :END: + +To define a column format for an entire file, use a line like: + +#+cindex: #+COLUMNS +#+begin_example + ,#+COLUMNS: %25ITEM %TAGS %PRIORITY %TODO +#+end_example + +To specify a format that only applies to a specific tree, add a +~:COLUMNS:~ property to the top node of that tree, for example: + +#+begin_example + ,** Top node for columns view + , :PROPERTIES: + , :COLUMNS: %25ITEM %TAGS %PRIORITY %TODO + , :END: +#+end_example + +If a ~:COLUMNS:~ property is present in an entry, it defines columns +for the entry itself, and for the entire subtree below it. Since the +column definition is part of the hierarchical structure of the +document, you can define columns on level 1 that are general enough +for all sublevels, and more specific columns further down, when you +edit a deeper part of the tree. + +**** Column attributes + :PROPERTIES: + :DESCRIPTION: Appearance and content of a column + :END: +A column definition sets the attributes of a column. The general +definition looks like this: + + %[{{{var(width)}}}]{{{var(property)}}}[({{{var(title)}}})][{{{{var(summary-type)}}}}] + +{{{noindent}}} Except for the percent sign and the property name, all +items are optional. The individual parts have the following meaning: + +#+attr_texinfo: :columns 0.2 0.8 +| Variable | Meaning | +|-------------------------+--------------------------------------------------------------| +| {{{var(width)}}} | An integer specifying the width of the column in characters. | +| | If omitted, the width will be determined automatically. | +| {{{var(property)}}} | The property that should be edited in this column. | +| | Special properties representing meta data are allowed here | +| | as well (see [[Special properties]]) | +| {{{var(title)}}} | The header text for the column. If omitted, the property | +| | name is used. | +| {{{var(summary-type)}}} | The summary type. If specified, the column values for | +| | parent nodes are computed from the children. | + +{{{noindent}}} Supported summary types are: + +#+attr_texinfo: :columns 0.2 0.8 +| Type | Meaning | +|----------+-----------------------------------------------------------------------| +| ~+~ | Sum numbers in this column. | +| ~+;%.1f~ | Like ~+~, but format result with {{{samp(%.1f)}}}. | +| ~$~ | Currency, short for {{{samp(+;%.2f)}}}. | +| ~:~ | Sum times, HH:MM, plain numbers are hours. | +| ~X~ | Checkbox status, {{{samp([X])}}} if all children are {{{samp([X])}}}. | +| ~X/~ | Checkbox status, {{{samp([n/m])}}}. | +| ~X%~ | Checkbox status, {{{samp([n%])}}}. | +| ~min~ | Smallest number in column. | +| ~max~ | Largest number. | +| ~mean~ | Arithmetic mean of numbers. | +| ~:min~ | Smallest time value in column. | +| ~:max~ | Largest time value. | +| ~:mean~ | Arithmetic mean of time values. | +| ~@min~ | Minimum age (in days/hours/mins/seconds). | +| ~@max~ | Maximum age (in days/hours/mins/seconds). | +| ~@mean~ | Arithmetic mean of ages (in days/hours/mins/seconds). | +| ~est+~ | Add low-high estimates. | + + +{{{noindent}}} Be aware that you can only have one summary type for +any property you include. Subsequent columns referencing the same +property will all display the same summary information. + +The ~est+~ summary type requires further explanation. It is used for +combining estimates, expressed as low-high ranges. For example, +instead of estimating a particular task will take 5 days, you might +estimate it as 5-6 days if you're fairly confident you know how much +work is required, or 1-10 days if you don't really know what needs to +be done. Both ranges average at 5.5 days, but the first represents a +more predictable delivery. + +When combining a set of such estimates, simply adding the lows and +highs produces an unrealistically wide result. Instead, ~est+~ adds +the statistical mean and variance of the sub-tasks, generating a final +estimate from the sum. For example, suppose you had ten tasks, each of +which was estimated at 0.5 to 2 days of work. Straight addition +produces an estimate of 5 to 20 days, representing what to expect if +everything goes either extremely well or extremely poorly. In +contrast, ~est+~ estimates the full job more realistically, at 10-15 +days. + +Here is an example for a complete columns definition, along with allowed +values.[fn:58] + +#+begin_example + :COLUMNS: %25ITEM %9Approved(Approved?){X} %Owner %11Status \ + %10Time_Estimate{:} %CLOCKSUM %CLOCKSUM_T + :Owner_ALL: Tammy Mark Karl Lisa Don + :Status_ALL: "In progress" "Not started yet" "Finished" "" + :Approved_ALL: "[ ]" "[X]" +#+end_example + +{{{noindent}}} The first column, {{{samp(%25ITEM)}}}, means the first +25 characters of the item itself, i.e., of the headline. You probably +always should start the column definition with the {{{samp(ITEM)}}} +specifier. The other specifiers create columns {{{samp(Owner)}}} with +a list of names as allowed values, for {{{samp(Status)}}} with four +different possible values, and for a checkbox field +{{{samp(Approved)}}}. When no width is given after the {{{samp(%)}}} +character, the column will be exactly as wide as it needs to be in +order to fully display all values. The {{{samp(Approved)}}} column +does have a modified title ({{{samp(Approved?)}}}, with a question +mark). Summaries will be created for the {{{samp(Time_Estimate)}}} +column by adding time duration expressions like HH:MM, and for the +{{{samp(Approved)}}} column, by providing an {{{samp([X])}}} status if +all children have been checked. The {{{samp(CLOCKSUM)}}} and +{{{samp(CLOCKSUM_T)}}} columns are special, they lists the sums of +CLOCK intervals in the subtree, either for all clocks or just for +today. + +*** Using column view + :PROPERTIES: + :DESCRIPTION: How to create and use column view + :END: + +The following commands turn column view on or off: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x C-c)}}}, ~org-columns~ :: + #+kindex: C-c C-x C-c + #+vindex: org-columns-default-format + + Turn on column view. If the cursor is before the first headline in the + file, column view is turned on for the entire file, using the + ~#+COLUMNS~ definition. If the cursor is somewhere inside the outline, + this command searches the hierarchy, up from point, for a ~:COLUMNS:~ + property that defines a format. When one is found, the column view + table is established for the tree starting at the entry that contains + the ~:COLUMNS:~ property. If no such property is found, the format is + taken from the ~#+COLUMNS~ line or from the variable + ~org-columns-default-format~, and column view is established for the + current entry and its subtree. + +- {{{kbd(r)}}}, ~org-columns-redo~ :: + #+kindex: r + + Recreate the column view, to include recent changes made in the + buffer. + +- {{{kbd(g)}}}, ~org-columns-redo~ :: + #+kindex: g + + Same as {{{kbd(r)}}}. + +- {{{kbd(q)}}}, ~org-columns-quit~ :: + #+kindex: q + + Exit column view. + +The following commands let you edit information in column view: + +#+attr_texinfo: :table-type table :indic @asis +- {{{key(left)}}} {{{key(right)}}} {{{key(up)}}} {{{key(down)}}} :: + + Move through the column view from field to field. + +- {{{kbdkey(S-,left)}}} {{{kbdkey(S-,right)}}} :: + #+kindex: S-@key{left} + #+kindex: S-@key{right} + + Switch to the next/previous allowed value of the field. For this, you + have to have specified allowed values for a property. + +- {{{kbd(1..9\,0)}}} :: + #+kindex: 1..9,0 + + Directly select the Nth allowed value, {{{kbd(0)}}} selects the 10th + value. + +- {{{kbd(n)}}} {{{kbd(p)}}}, ~org-columns-next-allowed-value~ ~org-columns-previous-allowed-value~ :: + #+kindex: n + + Same as {{{kbdkey(S-,left)}}} {{{kbdkey(S-,right)}}} + +- {{{kbd(e)}}}, ~org-columns-edit-value~ :: + #+kindex: e + + Edit the property at point. For the special properties, this will + invoke the same interface that you normally use to change that + property. For example, when editing a TAGS property, the tag + completion or fast selection interface will pop up. + +- {{{kbd(C-c C-c)}}}, ~org-columns-set-tags-or-toggle~ :: + #+kindex: C-c C-c + + When there is a checkbox at point, toggle it. + +- {{{kbd(v)}}}, ~org-columns-show-value~ :: + #+kindex: v + + View the full value of this property. This is useful if the width of + the column is smaller than that of the value. + +- {{{kbd(a)}}}, ~org-columns-edit-allowed~ :: + #+kindex: a + + Edit the list of allowed values for this property. If the list is found + in the hierarchy, the modified values is stored there. If no list is + found, the new value is stored in the first entry that is part of the + current column view. + + +The following commands modify column view on-the-fly: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(<)}}} {{{kbd(>)}}}, ~org-columns-narrow~ ~org-columns-widen~ :: + #+kindex: < + + Make the column narrower/wider by one character. + +- {{{kbdkey(S-M-,right)}}}, ~org-columns-new~ :: + #+kindex: S-M-@key{right} + + Insert a new column, to the left of the current column. + +- {{{kbdkey(S-M-,left)}}}, ~org-columns-delete~ :: + #+kindex: S-M-@key{left} + + Delete the current column. + +*** Capturing column view + :PROPERTIES: + :DESCRIPTION: A dynamic block for column view + :END: + +Since column view is just an overlay over a buffer, it cannot be +exported or printed directly. If you want to capture a column view, +use a ~columnview~ dynamic block (see [[Dynamic blocks]]). The frame of +this block looks like this: + +#+cindex: #+BEGIN, columnview +#+begin_example + ,* The column view + ,#+BEGIN: columnview :hlines 1 :id "label" + + ,#+END: +#+end_example + +{{{noindent}}} This dynamic block has the following parameters: + +#+attr_texinfo: :table-type table :indic @asis +- ~:id~ :: + + This is the most important parameter. Column view is a feature that is + often localized to a certain (sub)tree, and the capture block might be + at a different location in the file. To identify the tree whose view + to capture, you can use 4 values: + + #+cindex: property, ID + #+attr_texinfo: :columns 0.35 0.65 + | Value | Meaning | + |---------------------+---------------------------------------------------------------| + | local | Use the tree in which the capture block is located. | + | global | Make a global view, including all headings in the file. | + | =file:PATH-TO-FILE= | Run column view at the top of this file. | + | ID | Call column view in the tree that has an ~:ID:~ | + | | property with the value /label/. You can use | + | | {{{kbd(M-x org-id-copy)}}} to create a globally unique ID for | + | | the current entry and copy it to the kill-ring. | + + - local :: + + Use the tree in which the capture block is located. + + - global :: + + Make a global view, including all headings in the file. + + - =file:PATH-TO-FILE= :: + + Run column view at the top of this file. + + - ID :: + + Call column view in the tree that has an ~:ID:~ property with the + value /label/. You can use {{{kbd(M-x org-id-copy)}}} to + create a globally unique ID for the current entry and copy + it to the kill-ring. + +- ~:hlines~ :: + + When ~t~, insert an hline after every line. When a number ~N~, + insert an hline before each headline with level ~<=~ + {{{var(N)}}}. + +- ~:vlines~ :: + + When set to ~t~, force column groups to get vertical lines. + +- ~:maxlevel~ :: + + When set to a number, don't capture entries below this level. + +- ~:skip-empty-rows~ :: + + When set to ~t~, skip rows where the only non-empty specifier of the + column view is ~ITEM~. + + + +{{{noindent}}} The following commands insert or update the dynamic +block: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x i)}}}, ~org-insert-columns-dblock~ :: + #+kindex: C-c C-x i + + Insert a dynamic block capturing a column view. You will be prompted + for the scope or ID of the view. + +- {{{kbd(C-c C-c)}}} {{{kbd(C-c C-x C-u)}}}, ~org-dblock-update~ :: + #+kindex: C-c C-c + + Update dynamic block at point. The cursor needs to be in the ~#+BEGIN~ + line of the dynamic block. + +- {{{kbd(C-u C-c C-x C-u)}}}, ~org-update-all-dblocks~ :: + #+kindex: C-u C-c C-x C-u + + Update all dynamic blocks (see [[Dynamic blocks]]). This is useful if you + have several clock table blocks, column-capturing blocks or other + dynamic blocks in a buffer. + + +You can add formulas to the column view table and you may add plotting +instructions in front of the table---these will survive an update of the +block. If there is a ~#+TBLFM:~ after the table, the table will +actually be recalculated automatically after an update. + +An alternative way to capture and process property values into a table +is provided by Eric Schulte's {{{file(org-collector.el)}}} which is a +contributed package.[fn:59] It provides a general API to collect +properties from entries in a certain scope, and arbitrary Lisp +expressions to process these values before inserting them into a table +or a dynamic block. + +** Property API + :PROPERTIES: + :DESCRIPTION: Properties for Lisp programmers + :END: +#+cindex: properties, API +#+cindex: API, for properties + +There is a full API for accessing and changing properties. This API +can be used by Emacs Lisp programs to work with properties and to +implement features based on them. For more information see [[Using the +property API]]. + +* Dates and times + :PROPERTIES: + :DESCRIPTION: Making items useful for planning + :ALT_TITLE: Dates and Times + :END: +#+cindex: dates +#+cindex: times +#+cindex: timestamp +#+cindex: date stamp + +To assist project planning, TODO items can be labeled with a date and/or +a time. The specially formatted string carrying the date and time +information is called a /timestamp/ in Org mode. This may be a +little confusing because timestamp is often used as indicating when +something was created or last changed. However, in Org mode this term +is used in a much wider sense. + +** Timestamps + :PROPERTIES: + :DESCRIPTION: Assigning a time to a tree entry + :TITLE: Timestamps, deadlines, and scheduling + :END: +#+cindex: timestamps +#+cindex: ranges, time +#+cindex: date stamps +#+cindex: deadlines +#+cindex: scheduling + +A timestamp is a specification of a date (possibly with a time or a +range of times) in a special format, either ~<2003-09-16 Tue>~ or +~<2003-09-16 Tue 09:39>~ or ~<2003-09-16 Tue 12:00-12:30>~.[fn:60] A +timestamp can appear anywhere in the headline or body of an Org tree +entry. Its presence causes entries to be shown on specific dates in +the agenda (see [[Weekly/daily agenda]]). We distinguish: + +#+attr_texinfo: :table-type table :indic @asis +- Plain timestamp; Event; Appointment :: + #+cindex: timestamp + #+cindex: appointment + + A simple timestamp just assigns a date/time to an item. This is just + like writing down an appointment or event in a paper agenda. In the + timeline and agenda displays, the headline of an entry associated with + a plain timestamp will be shown exactly on that date. + + #+begin_example + ,* Meet Peter at the movies + <2006-11-01 Wed 19:15> + ,* Discussion on climate change + <2006-11-02 Thu 20:00-22:00> + #+end_example + +- Timestamp with repeater interval :: + #+cindex: timestamp, with repeater interval + + A timestamp may contain a /repeater interval/, indicating that it + applies not only on the given date, but again and again after a + certain interval of N days (d), weeks (w), months (m), or years (y). + The following will show up in the agenda every Wednesday: + + #+begin_example + ,* Pick up Sam at school + <2007-05-16 Wed 12:30 +1w> + #+end_example + +- Diary-style sexp entries :: + + For more complex date specifications, Org mode supports using the + special sexp diary entries implemented in the Emacs calendar/diary + package.[fn:61] For example, with optional time: + + #+begin_example + ,* 22:00-23:00 The nerd meeting on every 2nd Thursday of the month + <%%(org-float t 4 2)> + #+end_example + +- Time/Date range :: + #+cindex: timerange + #+cindex: date range + + Two timestamps connected by {{{samp(--)}}} denote a range. The headline + will be shown on the first and last day of the range, and on any dates + that are displayed and fall in the range. Here is an example: + + #+begin_example + ,** Meeting in Amsterdam + <2004-08-23 Mon>--<2004-08-26 Thu> + #+end_example + +- Inactive timestamp :: + #+cindex: timestamp, inactive + #+cindex: inactive timestamp + + Just like a plain timestamp, but with square brackets instead of + angular ones. These timestamps are inactive in the sense that they do + /not/ trigger an entry to show up in the agenda. + + #+begin_example + ,* Gillian comes late for the fifth time + [2006-11-01 Wed] + #+end_example + +** Creating timestamps + :PROPERTIES: + :DESCRIPTION: Commands to insert timestamps + :END: +For Org mode to recognize timestamps, they need to be in the specific +format. All commands listed below produce timestamps in the correct +format. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c .)}}}, ~org-time-stamp~ :: + #+kindex: C-c . + + Prompt for a date and insert a corresponding timestamp. When the + cursor is at an existing timestamp in the buffer, the command is used + to modify this timestamp instead of inserting a new one. When this + command is used twice in succession, a time range is inserted. + +- {{{kbd(C-c !)}}}, ~org-time-stamp-inactive~ :: + #+kindex: C-c ! + + Like {{{kbd(C-c .)}}}, but insert an inactive timestamp that will not + cause an agenda entry. + +- {{{kbd(C-u C-c .)}}} {{{kbd(C-u C-c !)}}} :: + #+kindex: C-u C-c . + #+kindex: C-u C-c . + #+kindex: C-u C-c ! + #+vindex: org-time-stamp-rounding-minutes + + Like {{{kbd(C-c .)}}} and {{{kbd(C-c !)}}}, but use the alternative + format which contains date and time. The default time can be rounded + to multiples of 5 minutes, see the option + ~org-time-stamp-rounding-minutes~. + +- {{{kbd(C-c C-c)}}} :: + #+kindex: C-c C-c + + Normalize timestamp, insert/fix day name if missing or wrong. + +- {{{kbd(C-c <)}}}, ~org-date-from-calendar~ :: + #+kindex: C-c < + + Insert a timestamp corresponding to the cursor date in the Calendar. + +- {{{kbd(C-c >)}}}, ~org-goto-calendar~ :: + #+kindex: C-c > + + Access the Emacs calendar for the current date. If there is a + timestamp in the current line, go to the corresponding date instead. + +- {{{kbd(C-c C-o)}}}, ~org-open-at-point~ :: + #+kindex: C-c C-o + + Access the agenda for the date given by the timestamp or -range at + point (see [[Weekly/daily agenda]]). + +- {{{kbdkey(S-,left)}}} {{{kbdkey(S-,right)}}}, ~org-timestamp-down-day~ ~org-timestamp-up-day~ :: + #+kindex: S-@key{left} + + Change date at cursor by one day. These key bindings conflict with + shift-selection and related modes (see [[Conflicts]]). + +- {{{kbdkey(S-,up)}}} {{{kbdkey(S-,down)}}}, ~org-timestamp-up~ ~org-timestamp-down-down~ :: + #+kindex: S-@key{up} + + Change the item under the cursor in a timestamp. The cursor can be on + a year, month, day, hour or minute. When the timestamp contains a time + range like {{{samp(15:30-16:30)}}}, modifying the first time will also + shift the second, shifting the time block with constant length. To + change the length, modify the second time. Note that if the cursor is + in a headline and not at a timestamp, these same keys modify the + priority of an item. (see [[Priorities]]). The key bindings also conflict + with shift-selection and related modes (see [[Conflicts]]). + +- {{{kbd(C-c C-y)}}}, ~org-evaluate-time-range~ :: + #+kindex: C-c C-y + #+cindex: evaluate time range + + Evaluate a time range by computing the difference between start and + end. With a prefix argument, insert result after the time range (in a + table: into the following column). + +*** The date/time prompt + :PROPERTIES: + :DESCRIPTION: How Org mode helps you enter dates and times + :END: +#+cindex: date, reading in minibuffer +#+cindex: time, reading in minibuffer + +#+vindex: org-read-date-prefer-future + +When Org mode prompts for a date/time, the default is shown in default +date/time format, and the prompt therefore seems to ask for a specific +format. But it will in fact accept date/time information in a variety +of formats. Generally, the information should start at the beginning +of the string. Org mode will find whatever information is in there and +derive anything you have not specified from the /default date and +time/. The default is usually the current date and time, but when +modifying an existing timestamp, or when entering the second stamp of +a range, it is taken from the stamp in the buffer. When filling in +information, Org mode assumes that most of the time you will want to +enter a date in the future: if you omit the month/year and the given +day/month is /before/ today, it will assume that you mean a future +date.[fn:62] If the date has been automatically shifted into the +future, the time prompt will show this with {{{samp((=>F))}}}. + +For example, let's assume that today is *June 13, 2006*. Here is how +various inputs will be interpreted, the items filled in by Org mode +are in *bold*. + +| Input | Interpretation | +|--------------+------------------------------------------------------| +| 3-2-5 | {{{result}}} 2003-02-05 | +| 2/5/3 | {{{result}}} 2003-02-05 | +| 14 | {{{result}}} *2006*-*06*-14 | +| 12 | {{{result}}} *2006*-*07*-12 | +| 2/5 | {{{result}}} *2007*-02-05 | +| Fri | {{{result}}} nearest Friday (default date or later) | +| sep 15 | {{{result}}} *2006*-09-15 | +| feb 15 | {{{result}}} *2007*-02-15 | +| sep 12 9 | {{{result}}} 2009-09-12 | +| 12:45 | {{{result}}} *2006*-*06*-*13* 12:45 | +| 22 sept 0:34 | {{{result}}} *2006*-09-22 0:34 | +| w4 | {{{result}}} ISO week for of the current year *2006* | +| 2012 w4 fri | {{{result}}} Friday of ISO week 4 in 2012 | +| 2012-w04-5 | {{{result}}} Same as above | + + +Furthermore you can specify a relative date by giving, as the /first/ +thing in the input: a plus/minus sign, a number and a letter ([dwmy]) +to indicate change in days, weeks, months, or years. With a single +plus or minus, the date is always relative to today. With a double +plus or minus, it is relative to the default date. If instead of a +single letter, you use the abbreviation of day name, the date will be +the Nth such day, e.g.: + +| Input | Interpretation | +|-------+------------------------------------------| +| +0 | {{{result}}} today | +| . | {{{result}}} today | +| +4d | {{{result}}} four days from today | +| +4 | {{{result}}} same as +4d | +| +2w | {{{result}}} two weeks from today | +| ++5 | {{{result}}} five days from default date | +| +2tue | {{{result}}} second Tuesday from now | + + +#+vindex: parse-time-months +#+vindex: parse-time-weekdays + +The function understands English month and weekday abbreviations. If +you want to use unabbreviated names and/or other languages, configure +the variables ~parse-time-months~ and ~parse-time-weekdays~. + +#+vindex: org-read-date-force-compatible-dates + +Not all dates can be represented in a given Emacs implementation. By +default Org mode forces dates into the compatibility range 1970--2037 +which works on all Emacs implementations. If you want to use dates +outside of this range, read the docstring of the variable +~org-read-date-force-compatible-dates~. + +You can specify a time range by giving start and end times or by +giving a start time and a duration (in HH:MM format). Use one or two +dash(es) as the separator in the former case and use '+' as the +separator in the latter case, e.g.: + +| Range | Result | +|--------------+----------------------------| +| 11am-1:15pm | {{{result}}} 11:00-13:15 | +| 11am--1:15pm | {{{result}}} same as above | +| 11am+2:15 | {{{result}}} same as above | + +#+cindex: calendar, for selecting date +#+vindex: org-popup-calendar-for-date-prompt + +Parallel to the minibuffer prompt, a calendar is popped up.[fn:63] +When you exit the date prompt, either by clicking on a date in the +calendar, or by pressing {{{key(RET)}}}, the date selected in the +calendar will be combined with the information entered at the prompt. +You can control the calendar fully from the minibuffer: + +#+kindex: < +#+kindex: > +#+kindex: M-v +#+kindex: C-v +#+kindex: mouse-1 +#+kindex: S-@key{right} +#+kindex: S-@key{left} +#+kindex: S-@key{down} +#+kindex: S-@key{up} +#+kindex: M-S-@key{right} +#+kindex: M-S-@key{left} +#+kindex: @key{RET} + +#+attr_texinfo: :columns 0.3 0.7 +| Key binding | Meaning | +|---------------------------+----------------------------------------| +| {{{key(RET)}}} | Choose date at cursor in calendar. | +| {{{key(mouse-1)}}} | Select date by clicking on it. | +| {{{kbdkey(S-,right)}}} | One day forward. | +| {{{kbdkey(S-,left)}}} | One day backward. | +| {{{kbdkey(S-,down)}}} | One week forward. | +| {{{kbdkey(S-,up)}}} | One week backward. | +| {{{kbdkey(M-S-,right)}}} | One month forward. | +| {{{kbdkey(M-S-,left)}}} | One month backward. | +| {{{kbd(>)}}} | Scroll calendar forward by one month. | +| {{{kbd(<)}}} | Scroll calendar backward by one month. | +| {{{kbd(M-v)}}} | Scroll calendar forward by 3 months. | +| {{{kbd(C-v)}}} | Scroll calendar backward by 3 months. | + + +#+vindex: org-read-date-display-live + +The actions of the date/time prompt may seem complex, but I assure you they +will grow on you, and you will start getting annoyed by pretty much any other +way of entering a date/time out there. To help you understand what is going +on, the current interpretation of your input will be displayed live in the +minibuffer.[fn:64] + +*** Custom time format + :PROPERTIES: + :DESCRIPTION: Making dates look different + :END: +#+cindex: custom date/time format +#+cindex: time format, custom +#+cindex: date format, custom + +#+vindex: org-display-custom-times +#+vindex: org-time-stamp-custom-formats + +Org mode uses the standard ISO notation for dates and times as it is +defined in ISO 8601. If you cannot get used to this and require +another representation of date and time to keep you happy, you can get +it by customizing the variables ~org-display-custom-times~ and +~org-time-stamp-custom-formats~. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x C-t)}}}, ~org-toggle-time-stamp-overlays~ :: + #+kindex: C-c C-x C-t + + Toggle the display of custom formats for dates and times. + + +{{{noindent}}} +Org mode needs the default format for scanning, so the custom date/time +format does not /replace/ the default format---instead it is put +/over/ the default format using text properties. This has the +following consequences: + + +- You cannot place the cursor onto a timestamp anymore, only before or + after. + +- The {{{kbdkey(S-,up)}}} {{{kbdkey(S-,down)}}} keys can no longer be + used to adjust each component of a timestamp. If the cursor is at + the beginning of the stamp, {{{kbdkey(S-,up)}}} + {{{kbdkey(S-,down)}}} will change the stamp by one day, just like + {{{kbdkey(S-,left)}}} {{{kbdkey(S-,right)}}}. At the end of the + stamp, the time will be changed by one minute. + +- If the timestamp contains a range of clock times or a repeater, + these will not be overlaid, but remain in the buffer as they were. + +- When you delete a timestamp character-by-character, it will only + disappear from the buffer after /all/ (invisible) characters + belonging to the ISO timestamp have been removed. + +- If the custom timestamp format is longer than the default and you + are using dates in tables, table alignment will be messed up. If + the custom format is shorter, things do work as expected. + +** Deadlines and scheduling + :PROPERTIES: + :DESCRIPTION: Planning your work + :END: + +A timestamp may be preceded by special keywords to facilitate planning: + +#+attr_texinfo: :table-type table :indic @asis +- ~DEADLINE~ :: + #+cindex: DEADLINE keyword + + Meaning: the task (most likely a TODO item, though not necessarily) is + supposed to be finished on that date. + + #+vindex: org-deadline-warning-days + + On the deadline date, the task will be listed in the agenda. In + addition, the agenda for /today/ will carry a warning about the + approaching or missed deadline, starting ~org-deadline-warning-days~ + before the due date, and continuing until the entry is marked DONE. An + example: + + #+begin_example + ,*** TODO write article about the Earth for the Guide + DEADLINE: <2004-02-29 Sun> + The editor in charge is [[bbdb:Ford Prefect]] + #+end_example + + You can specify a different lead time for warnings for a specific + deadlines using the following syntax. Here is an example with a + warning period of 5 days ~DEADLINE: <2004-02-29 Sun -5d>~. + +- ~SCHEDULED~ :: + #+cindex: SCHEDULED keyword + + Meaning: you are planning to start working on that task on the given + date. + + #+vindex: org-agenda-skip-scheduled-if-done + + The headline will be listed under the given date.[fn:65] In addition, + a reminder that the scheduled date has passed will be present in the + compilation for /today/, until the entry is marked DONE, i.e., the + task will automatically be forwarded until completed. + + #+begin_example + ,*** TODO Call Trillian for a date on New Years Eve. + SCHEDULED: <2004-12-25 Sat> + #+end_example + + {{{noindent}}} + *Important:* Scheduling an item in Org mode should /not/ be + understood in the same way that we understand /scheduling a meeting/. + Setting a date for a meeting is just a simple appointment, you should + mark this entry with a simple plain timestamp, to get this item shown + on the date where it applies. This is a frequent misunderstanding by + Org users. In Org mode, /scheduling/ means setting a date when you + want to start working on an action item. + + +You may use timestamps with repeaters in scheduling and deadline +entries. Org mode will issue early and late warnings based on the +assumption that the timestamp represents the /nearest instance/ of +the repeater. However, the use of diary sexp entries like + +~<%%(org-float t 42)>~ + +in scheduling and deadline timestamps is limited. Org mode does not +know enough about the internals of each sexp function to issue early and +late warnings. However, it will show the item on each day where the +sexp entry matches. + +*** Inserting deadline/schedule + :PROPERTIES: + :DESCRIPTION: Planning items + :TITLE: Inserting deadlines or schedules + :END: + +The following commands allow you to quickly insert a deadline or to schedule +an item:[fn:66] + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-d)}}}, ~org-deadline~ :: + #+kindex: C-c C-d + + Insert {{{samp(DEADLINE)}}} keyword along with a stamp. The insertion + will happen in the line directly following the headline. Any CLOSED + timestamp will be removed. When called with a prefix arg, an existing + deadline will be removed from the entry. Depending on the variable + ~org-log-redeadline~, a note will be taken when changing an existing + deadline.[fn:67] + +- {{{kbd(C-c C-s)}}}, ~org-schedule~ :: + #+kindex: C-c C-s + + Insert {{{samp(SCHEDULED)}}} keyword along with a stamp. The insertion + will happen in the line directly following the headline. Any + {{{samp(CLOSED)}}} timestamp will be removed. When called with a + prefix argument, remove the scheduling date from the entry. Depending + on the variable ~org-log-reschedule~, a note will be taken when + changing an existing scheduling time.[fn:68] + +- {{{kbd(C-c C-x C-k)}}}, ~org-mark-entry-for-agenda-action~ :: + #+kindex: C-c C-x C-k + #+kindex: k a + #+kindex: k s + + Mark the current entry for agenda action. After you have marked the + entry like this, you can open the agenda or the calendar to find an + appropriate date. With the cursor on the selected date, press + {{{kbd(k s)}}} or {{{kbd(k d)}}} to schedule the marked item. + +- {{{kbd(C-c / d)}}}, ~org-check-deadlines~ :: + #+kindex: C-c / d + #+cindex: sparse tree, for deadlines + #+vindex: org-deadline-warning-days + + Create a sparse tree with all deadlines that are either past-due, or + which will become due within ~org-deadline-warning-days~. With + {{{kbd(C-u)}}} prefix, show all deadlines in the file. With a numeric + prefix, check that many days. For example, {{{kbd(C-1 C-c / d)}}} + shows all deadlines due tomorrow. + +- {{{kbd(C-c / b)}}}, ~org-check-before-date~ :: + #+kindex: C-c / b + + Sparse tree for deadlines and scheduled items before a given date. + +- {{{kbd(C-c / a)}}}, ~org-check-after-date~ :: + #+kindex: C-c / a + + Sparse tree for deadlines and scheduled items after a given date. + + +Note that ~org-schedule~ and ~org-deadline~ supports setting the date +by indicating a relative time: e.g. +1d will set the date to the next +day after today, and --1w will set the date to the previous week +before any current timestamp. + +*** Repeated tasks + :PROPERTIES: + :DESCRIPTION: Items that show up again and again + :END: +#+cindex: tasks, repeated +#+cindex: repeated tasks + +Some tasks need to be repeated again and again. Org mode helps to +organize such tasks using a so-called repeater in a DEADLINE, SCHEDULED, +or plain timestamp. In the following example: + +#+begin_example + ,** TODO Pay the rent + DEADLINE: <2005-10-01 Sat +1m> +#+end_example + +{{{noindent}}} the ~+1m~ is a repeater; the intended interpretation is +that the task has a deadline on <2005-10-01> and repeats itself every +(one) month starting from that time. You can use yearly, monthly, +weekly, daily and hourly repeat cookies by using the ~y/w/m/d/h~ +letters. If you need both a repeater and a special warning period in a +deadline entry, the repeater should come first and the warning period +last: ~DEADLINE: <2005-10-01 Sat +1m -3d>~. + +#+vindex: org-todo-repeat-to-state + +Deadlines and scheduled items produce entries in the agenda when they +are over-due, so it is important to be able to mark such an entry as +completed once you have done so. When you mark a DEADLINE or a +SCHEDULE with the TODO keyword DONE, it will no longer produce entries +in the agenda. The problem with this is, however, that then also the +/next/ instance of the repeated entry will not be active. Org mode +deals with this in the following way: When you try to mark such an +entry DONE (using {{{kbd(C-c C-t)}}}), it will shift the base date of +the repeating timestamp by the repeater interval, and immediately set +the entry state back to TODO.[fn:69] In the example above, setting the +state to DONE would actually switch the date like this: + +#+begin_example + ,** TODO Pay the rent + DEADLINE: <2005-11-01 Tue +1m> +#+end_example + +#+vindex: org-log-repeat + +A timestamp will be added under the deadline, to keep a record that +you actually acted on the previous instance of this deadline.[fn:70] + +As a consequence of shifting the base date, this entry will no longer be +visible in the agenda when checking past dates, but all future instances +will be visible. + +With the {{{samp(+1m)}}} cookie, the date shift will always be exactly one +month. So if you have not paid the rent for three months, marking this +entry DONE will still keep it as an overdue deadline. Depending on the +task, this may not be the best way to handle it. For example, if you +forgot to call your father for 3 weeks, it does not make sense to call +him 3 times in a single day to make up for it. Finally, there are tasks +like changing batteries which should always repeat a certain time +/after/ the last time you did it. For these tasks, Org mode has +special repeaters {{{samp(++)}}} and {{{samp(.+)}}}. For example: + +#+begin_example + ,** TODO Call Father + DEADLINE: <2008-02-10 Sun ++1w> + Marking this DONE will shift the date by at least one week, + but also by as many weeks as it takes to get this date into + the future. However, it stays on a Sunday, even if you called + and marked it done on Saturday. + ,** TODO Check the batteries in the smoke detectors + DEADLINE: <2005-11-01 Tue .+1m> + Marking this DONE will shift the date to one month after + today. +#+end_example + +You may have both scheduling and deadline information for a specific +task---just make sure that the repeater intervals on both are the +same. + +An alternative to using a repeater is to create a number of copies of +a task subtree, with dates shifted in each copy. The command +{{{kbd(C-c C-x c)}}} was created for this purpose, it is described in +[[Structure editing]]. + +** Clocking work time + :PROPERTIES: + :DESCRIPTION: Tracking how long you spend on a task + :END: +#+cindex: clocking time +#+cindex: time clocking + +Org mode allows you to clock the time you spend on specific tasks in a +project. When you start working on an item, you can start the clock. When +you stop working on that task, or when you mark the task done, the clock is +stopped and the corresponding time interval is recorded. It also computes +the total time spent on each subtree of a project.[fn:71] And it remembers a +history or tasks recently clocked, to that you can jump quickly between a +number of tasks absorbing your time. + +To save the clock history across Emacs sessions, use: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp + (setq org-clock-persist 'history) + (org-clock-persistence-insinuate) +#+end_src + +When you clock into a new task after resuming Emacs, the incomplete +clock will be found (see [[Resolving idle time]]) and you will be prompted +about what to do with it.[fn:72] + +*** Clocking commands + :PROPERTIES: + :DESCRIPTION: Starting and stopping a clock + :END: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x C-i)}}}, ~org-clock-in~ :: + #+kindex: C-c C-x C-i + #+vindex: org-clock-into-drawer + #+vindex: org-clock-continuously + #+cindex: property, LOG_INTO_DRAWER + + Start the clock on the current item (clock-in). This inserts the CLOCK + keyword together with a timestamp. If this is not the first clocking + of this item, the multiple CLOCK lines will be wrapped into a + ~:LOGBOOK:~ drawer (see also the variable ~org-clock-into-drawer~). + You can also overrule the setting of this variable for a subtree by + setting a ~CLOCK_INTO_DRAWER~ or ~LOG_INTO_DRAWER~ property. When + called with a {{{kbd(C-u)}}} prefix argument, select the task from a + list of recently clocked tasks. With two {{{kbd(C-u C-u)}}} prefixes, + clock into the task at point and mark it as the default task; the + default task will then always be available with letter {{{kbd(d)}}} + when selecting a clocking task. With three {{{kbd(C-u C-u C-u)}}} + prefixes, force continuous clocking by starting the clock when the + last clock stopped.@* + + #+cindex: property: CLOCK_MODELINE_TOTAL + #+cindex: property: LAST_REPEAT + #+vindex: org-clock-modeline-total + + While the clock is running, the current clocking time is shown in the + mode line, along with the title of the task. The clock time shown will + be all time ever clocked for this task and its children. If the task + has an effort estimate (see [[Effort estimates]]), the mode line displays + the current clocking time against it.[fn:73] If the task is a + repeating one (see [[Repeated tasks]]), only the time since the last reset + of the task will be shown.[fn:74] More control over what time is shown + can be exercised with the ~CLOCK_MODELINE_TOTAL~ property. It may have + the values ~current~ to show only the current clocking instance, + ~today~ to show all time clocked on this tasks today (see also the + variable ~org-extend-today-until~), ~all~ to include all time, or + ~auto~ which is the default.[fn:75] Clicking with {{{kbd(mouse-1)}}} + onto the mode line entry will pop up a menu with clocking options. + +- {{{kbd(C-c C-x C-o)}}}, ~org-clock-out~ :: + #+kindex: C-c C-x C-o + #+vindex: org-log-note-clock-out + + Stop the clock (clock-out). This inserts another timestamp at the same + location where the clock was last started. It also directly computes + the resulting time in inserts it after the time range as + {{{samp(=>HH:MM)}}}. See the variable ~org-log-note-clock-out~ for the + possibility to record an additional note together with the clock-out + timestamp.[fn:76] + +- {{{kbd(C-c C-x C-x)}}}, ~org-clock-in-last~ :: + #+kindex: C-c C-x C-x + #+vindex: org-clock-continuously + + Reclock the last clocked task. With one {{{kbd(C-u)}}} prefix + argument, select the task from the clock history. With two + {{{kbd(C-u)}}} prefixes, force continuous clocking by starting the + clock when the last clock stopped. + +- {{{kbd(C-c C-x C-e)}}}, ~org-clock-modify-effort-estimate~ :: + #+kindex: C-c C-x C-e + + Update the effort estimate for the current clock task. +- {{{kbd(C-c C-c)}}} {{{kbd(C-c C-y)}}}, ~org-evaluate-time-range~ :: + #+kindex: C-c C-c + #+kindex: C-c C-y + #+kindex: C-c C-c + + Recompute the time interval after changing one of the timestamps. This + is only necessary if you edit the timestamps directly. If you change + them with {{{kbdkey(S-,cursor)}}} keys, the update is automatic. + +- {{{kbdkey(C-S-,up)}}} {{{kbdkey(C-S-,down)}}}, ~org-clock-timestamps-up/down~ :: + #+kindex: C-S-@key{up/down} + + On ~CLOCK~ log lines, increase/decrease both timestamps so that the + clock duration keeps the same. + +- {{{kbdkey(S-M-,up)}}} {{{kbdkey(S-M-,down)}}}, ~org-timestamp-up/down~ :: + #+kindex: S-M-@key{up/down} + + On ~CLOCK~ log lines, increase/decrease the timestamp at point and the + one of the previous (or the next clock) timestamp by the same + duration. For example, if you hit {{{kbdkey(S-M-,up)}}} to increase a + clocked-out timestamp by five minutes, then the clocked-in timestamp + of the next clock will be increased by five minutes. + +- {{{kbd(C-c C-t)}}}, ~org-todo~ :: + #+kindex: C-c C-t + + Changing the TODO state of an item to DONE automatically stops the + clock if it is running in this same item. + +- {{{kbd(C-c C-x C-q)}}}, ~org-clock-cancel~ :: + #+kindex: C-c C-x C-q + + Cancel the current clock. This is useful if a clock was started by + mistake, or if you ended up working on something else. + +- {{{kbd(C-c C-x C-j)}}}, ~org-clock-goto~ :: + #+kindex: C-c C-x C-j + + Jump to the headline of the currently clocked in task. With a + {{{kbd(C-u)}}} prefix arg, select the target task from a list of + recently clocked tasks. + +- {{{kbd(C-c C-x C-d)}}}, ~org-clock-display~ :: + #+kindex: C-c C-x C-d + #+vindex: org-remove-highlights-with-change + + Display time summaries for each subtree in the current buffer. This + puts overlays at the end of each headline, showing the total time + recorded under that heading, including the time of any subheadings. + You can use visibility cycling to study the tree, but the overlays + disappear when you change the buffer (see variable + ~org-remove-highlights-with-change~) or press {{{kbd(C-c C-c)}}}. + + +The {{{kbd(l)}}} key may be used in the timeline (see [[Timeline for a +single file]]) and in the agenda (see [[Weekly/daily agenda]]) to show which +tasks have been worked on or closed during a day. + +*Important:* note that both ~org-clock-out~ and ~org-clock-in-last~ +can have a global keybinding and will not modify the window +disposition. + +*** The clock table + :PROPERTIES: + :DESCRIPTION: Detailed reports + :END: +#+cindex: clocktable, dynamic block +#+cindex: report, of clocked time + +Org mode can produce quite complex reports based on the time clocking +information. Such a report is called a /clock table/, because it is +formatted as one or several Org tables. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x C-r)}}}, ~org-clock-report~ :: + #+kindex: C-c C-x C-r + + Insert a dynamic block (see [[Dynamic blocks]]) containing a clock report + as an Org mode table into the current file. When the cursor is at an + existing clock table, just update it. When called with a prefix + argument, jump to the first clock report in the current document and + update it. The clock table always includes also trees with ~:ARCHIVE:~ + tag. + +- {{{kbd(C-c C-c)}}} {{{kbd(C-c C-x C-u)}}}, ~org-dblock-update~ :: + #+kindex: C-c C-c + + Update dynamic block at point. The cursor needs to be in the + ~#+BEGIN~ line of the dynamic block. + +- {{{kbd(C-u C-c C-x C-u)}}} :: + #+kindex: C-u C-c C-x C-u + + Update all dynamic blocks (see [[Dynamic blocks]]). This is useful if you + have several clock table blocks in a buffer. + +- {{{kbdkey(S-,left)}}} {{{kbdkey(S-,right)}}}, ~org-clocktable-try-shift~ :: + + Shift the current ~:block~ interval and update the table. The cursor + needs to be in the ~#+BEGIN: clocktable~ line for this command. If + ~:block~ is ~today~, it will be shifted to ~today-1~ etc. + + +Here is an example of the frame for a clock table as it is inserted +into the buffer with the {{{kbd(C-c C-x C-r)}}} command: + +#+cindex: #+BEGIN, clocktable +#+begin_example + ,#+BEGIN: clocktable :maxlevel 2 :emphasize nil :scope file + ,#+END: clocktable +#+end_example +{{{noindent}}} +#+vindex: org-clocktable-defaults +The {{{samp(BEGIN)}}} line and specify a number of options to define the scope, +structure, and formatting of the report. Defaults for all these options can +be configured in the variable ~org-clocktable-defaults~. + +{{{noindent}}} First there are options that determine which clock entries are to +be selected: + +#+attr_texinfo: :table-type table :indic @asis +- :maxlevel :: + + Maximum level depth to which times are listed in the table. Clocks at + deeper levels will be summed into the upper level. + +- :scope :: + + The scope to consider. This can be any of the following: + + - nil :: the current buffer or narrowed region + - file :: the full current buffer + - subtree :: the subtree where the clocktable is located + - tree {{{var(N)}}} :: the surrounding level {{{var(N)}}} tree, for example ~tree3~ + - tree :: the surrounding level 1 tree + - agenda :: all agenda files + - ("file"..) :: scan these files + - file-with-archives :: current file and its archives + - agenda-with-archives :: all agenda files, including archives + +- :block :: + + The time block to consider. This block is specified either absolute, + or relative to the current time and may be any of these formats: + + - 2007-12-31 :: New year eve 2007 + - 2007-12 :: December 2007 + - 2007-W50 :: ISO-week 50 in 2007 + - 2007-Q2 :: 2nd quarter in 2007 + - 2007 :: the year 2007 + - today, yesterday, today-{{{var(N)}}} :: a relative day + - thisweek, lastweek, thisweek-{{{var(N)}}} :: a relative week + - thismonth, lastmonth, thismonth-{{{var(N)}}} :: a relative month + - thisyear, lastyear, thisyear-{{{var(N)}}} :: a relative year + + Use {{{kbdkey(S-,left)}}} or {{{kbdkey(S-,right)}}} to shift the + time interval. + +- :tstart :: + + A time string specifying when to start considering times. + +- :tend :: + + A time string specifying when to stop considering times. + +- :step :: + + Set to ~week~ or ~day~ to split the table into chunks. To use this, + ~:block~ or ~:tstart~, ~:tend~ are needed. + +- :stepskip0 :: + + Do not show steps that have zero time. + +- :fileskip0 :: + + Do not show table sections from files which did not contribute. + +- :tags :: + + A tags match to select entries that should contribute. See [[Matching + tags and properties]] for the match syntax. + + +Then there are options which determine the formatting of the table. There +options are interpreted by the function ~org-clocktable-write-default~, +but you can specify your own function using the ~:formatter~ parameter. + +#+attr_texinfo: :table-type table :indic @asis +- :emphasize :: + + When ~t~, emphasize level one and level two items. + +- :lang :: + + Language to use for descriptive cells like "Task".[fn:77] + +- :link :: + + Link the item headlines in the table to their origins. + +- :narrow :: + + An integer to limit the width of the headline column in the org table. + If you write it like {{{samp(50!)}}}, then the headline will also be + shortened in export. + +- :indent :: + + Indent each headline field according to its level. + +- :tcolumns :: + + Number of columns to be used for times. If this is smaller than + ~:maxlevel~, lower levels will be lumped into one column. + +- :level :: + + Should a level number column be included? + +- :compact :: + + Abbreviation for ~:level nil :indent t :narrow 40! :tcolumns 1~. All + are overwritten except if there is an explicit ~:narrow~. + +- :timestamp :: + + A timestamp for the entry, when available. Look for SCHEDULED, + DEADLINE, TIMESTAMP and TIMESTAMP_IA, in this order. + +- :properties :: + + List of properties that should be shown in the table. Each property + will get its own column. + +- :inherit-props :: + + When this flag is ~t~, the values for ~:properties~ will be inherited. + +- :formula :: + + Content of a ~#+TBLFM~ line to be added and evaluated. As a special + case, {{{samp(:formula %)}}} adds a column with % time. If you do not + specify a formula here, any existing formula below the clock table + will survive updates and be evaluated. + +- :formatter :: + + A function to format clock data and insert it into the buffer. + + +To get a clock summary of the current level 1 tree, for the current +day, you could write: + +#+begin_example + ,#+BEGIN: clocktable :maxlevel 2 :block today :scope tree1 :link t + ,#+END: clocktable +#+end_example + +{{{noindent}}} To use a specific time range you could write:[fn:78] + +#+begin_example + ,#+BEGIN: clocktable :tstart "<2006-08-10 Thu 10:00>" + :tend "<2006-08-10 Thu 12:00>" + ,#+END: clocktable +#+end_example + +A summary of the current subtree with % times would be: + +#+begin_example + ,#+BEGIN: clocktable :scope subtree :link t :formula % + ,#+END: clocktable +#+end_example + +A horizontally compact representation of everything clocked during +last week would be: + +#+begin_example + ,#+BEGIN: clocktable :scope agenda :block lastweek :compact t + ,#+END: clocktable +#+end_example + +*** Resolving idle time + :PROPERTIES: + :DESCRIPTION: Resolving time when you've been idle + :TITLE: Resolving idle time and continuous clocking + :END: + +#+cindex: resolve idle time +#+cindex: idle, resolve, dangling + +If you clock in on a work item, and then walk away from your +computer---perhaps to take a phone call---you often need to +``resolve'' the time you were away by either subtracting it from the +current clock, or applying it to another one. + +#+vindex: org-clock-idle-time + +By customizing the variable ~org-clock-idle-time~ to some integer, +such as 10 or 15, Emacs can alert you when you get back to your +computer after being idle for that many minutes, and ask what you want +to do with the idle time.[fn:79] There will be a question waiting for you +when you get back, indicating how much idle time has passed +(constantly updated with the current amount), as well as a set of +choices to correct the discrepancy: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(k)}}} :: + #+kindex: k + + To keep some or all of the minutes and stay clocked in, press + {{{kbd(k)}}}. Org will ask how many of the minutes to keep. Press + {{{key(RET)}}} to keep them all, effectively changing nothing, or + enter a number to keep that many minutes. + +- {{{kbd(K)}}} :: + #+kindex: K + + If you use the shift key and press {{{kbd(K)}}}, it will keep however + many minutes you request and then immediately clock out of that task. + If you keep all of the minutes, this is the same as just clocking out + of the current task. + +- {{{kbd(s)}}} :: + #+kindex: s + + To keep none of the minutes, use {{{kbd(s)}}} to subtract all the away + time from the clock, and then check back in from the moment you + returned. + +- {{{kbd(S)}}} :: + #+kindex: S + + To keep none of the minutes and just clock out at the start of the + away time, use the shift key and press {{{kbd(S)}}}. Remember that + using shift will always leave you clocked out, no matter which option + you choose. + +- {{{kbd(C)}}} :: + #+kindex: C + + To cancel the clock altogether, use {{{kbd(C)}}}. Note that if instead + of canceling you subtract the away time, and the resulting clock + amount is less than a minute, the clock will still be canceled rather + than clutter up the log with an empty entry. + + +What if you subtracted those away minutes from the current clock, and +now want to apply them to a new clock? Simply clock in to any task +immediately after the subtraction. Org will notice that you have +subtracted time ``on the books'', so to speak, and will ask if you +want to apply those minutes to the next task you clock in on. + +There is one other instance when this clock resolution magic occurs. +Say you were clocked in and hacking away, and suddenly your cat chased +a mouse who scared a hamster that crashed into your UPS's power +button! You suddenly lose all your buffers, but thanks to auto-save +you still have your recent Org mode changes, including your last clock +in. + +If you restart Emacs and clock into any task, Org will notice that you +have a dangling clock which was never clocked out from your last +session. Using that clock's starting time as the beginning of the +unaccounted-for period, Org will ask how you want to resolve that +time. The logic and behavior is identical to dealing with away time +due to idleness; it is just happening due to a recovery event rather +than a set amount of idle time. + +You can also check all the files visited by your Org agenda for +dangling clocks at any time using {{{kbd(M-x org-resolve-clocks RET)}}} + (or {{{kbd(C-c C-x C-z)}}}). + +*** Continuous clocking +#+cindex: continuous clocking +#+vindex: org-clock-continuously + +You may want to start clocking from the time when you clocked out the +previous task. To enable this systematically, set +~org-clock-continuously~ to ~t~. Each time you clock in, Org retrieves +the clock-out time of the last clocked entry for this session, and +start the new clock from there. + +If you only want this from time to time, use three universal prefix +arguments with ~org-clock-in~ and two {{{kbd(C-u C-u)}}} with +~org-clock-in-last~. + +** Effort estimates + :PROPERTIES: + :DESCRIPTION: Planning work effort in advance + :END: +#+cindex: effort estimates +#+cindex: property, Effort +#+vindex: org-effort-property + +If you want to plan your work in a very detailed way, or if you need +to produce offers with quotations of the estimated work effort, you +may want to assign effort estimates to entries. If you are also +clocking your work, you may later want to compare the planned effort +with the actual working time, a great way to improve planning +estimates. Effort estimates are stored in a special property +{{{samp(Effort)}}}.[fn:80] You can set the effort for an entry with +the following commands: + +#+attr_texinfo: :table-type table :indic @kbd +- {{{kbd(C-c C-x e)}}}, ~org-set-effort~ :: + #+kindex: C-c C-x e + + Set the effort estimate for the current entry. With a numeric prefix + argument, set it to the Nth allowed value (see below). This command is + also accessible from the agenda with the {{{kbd(e)}}} key. + +- {{{kbd(C-c C-x C-e)}}}, ~org-clock-modify-effort-estimate~ :: + #+kindex: C-c C-x C-e + + Modify the effort estimate of the item currently being clocked. + + +Clearly the best way to work with effort estimates is through column +view (see [[Column view]]). You should start by setting up discrete values +for effort estimates, and a ~COLUMNS~ format that displays these +values together with clock sums (if you want to clock your time). For +a specific buffer you can use: + +#+begin_example + ,#+PROPERTY: Effort_ALL 0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 + ,#+COLUMNS: %40ITEM(Task) %17Effort(Estimated Effort){:} %CLOCKSUM +#+end_example + +#+vindex: org-global-properties +#+vindex: org-columns-default-format + +{{{noindent}}} or, even better, you can set up these values globally +by customizing the variables ~org-global-properties~ and +~org-columns-default-format~. In particular if you want to use this +setup also in the agenda, a global setup may be advised. + +The way to assign estimates to individual items is then to switch to +column mode, and to use {{{kbdkey(S-,right)}}} and +{{{kbdkey(S-,left)}}} to change the value. The values you enter will +immediately be summed up in the hierarchy. In the column next to it, +any clocked time will be displayed. + +#+vindex: org-agenda-columns-add-appointments-to-effort-sum + +If you switch to column view in the daily/weekly agenda, the effort column +will summarize the estimated work effort for each day, and you can use this to find space in your schedule. To get +an overview of the entire part of the day that is committed, you can set the +option ~org-agenda-columns-add-appointments-to-effort-sum~.[fn:179] The +appointments on a day that take place over a specified time interval will +then also be added to the load estimate of the day. + +Effort estimates can be used in secondary agenda filtering that is +triggered with the {{{kbd(/)}}} key in the agenda (see [[Agenda +commands]]). If you have these estimates defined consistently, two or +three key presses will narrow down the list to stuff that fits into an +available time slot. + +** Relative timer + :PROPERTIES: + :DESCRIPTION: Notes with a running timer + :TITLE: Taking notes with a relative timer + :END: +#+cindex: relative timer + +When taking notes during, for example, a meeting or a video viewing, it can +be useful to have access to times relative to a starting time. Org provides +such a relative timer and make it easy to create timed notes. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x .)}}}, ~org-timer~ :: + #+kindex: C-c C-x . + + Insert a relative time into the buffer. The first time you use this, the + timer will be started. When called with a prefix argument, the timer is + restarted. + +- {{{kbd(C-c C-x -)}}}, ~org-timer-item~ :: + #+kindex: C-c C-x - + + Insert a description list item with the current relative time. With a prefix + argument, first reset the timer to 0. + +- {{{kbdkey(M-,RET)}}}, ~org-insert-heading~ :: + #+kindex: M-@key{RET} + + Once the timer list is started, you can also use {{{kbdkey(M-,RET)}}} + to insert new timer items. + +- {{{kbd(C-c C-x \,)}}} :: + #+kindex: C-c C-x , + #+kindex: C-c C-x , + + Pause the timer, or continue it if it is already paused + ({{{command(org-timer-pause-or-continue)}}}). + +- {{{kbd(C-u C-c C-x \,)}}} :: + #+kindex: C-u C-c C-x , + #+kindex: C-u C-c C-x , + + Stop the timer. After this, you can only start a new timer, not + continue the old one. This command also removes the timer from the + mode line. + +- {{{kbd(C-c C-x 0)}}}, ~org-timer-start~ :: + #+kindex: C-c C-x 0 + + Reset the timer without inserting anything into the buffer. By + default, the timer is reset to 0. When called with a {{{kbd(C-u)}}} + prefix, reset the timer to specific starting offset. The user is + prompted for the offset, with a default taken from a timer string at + point, if any, So this can be used to restart taking notes after a + break in the process. When called with a double prefix argument + {{{kbd(C-u C-u)}}}, change all timer strings in the active region by a + certain amount. This can be used to fix timer strings if the timer was + not started at exactly the right moment. + +** Countdown timer + :PROPERTIES: + :DESCRIPTION: Starting a countdown timer for a task + :END: +#+cindex: Countdown timer +#+kindex: C-c C-x ; +#+kindex: ; + +Calling ~org-timer-set-timer~ from an Org mode buffer runs a countdown +timer. Use {{{kbd(;)}}} from agenda buffers, {{{key(C-c C-x ;)}}} +everywhere else. + +~org-timer-set-timer~ prompts the user for a duration and displays a +countdown timer in the modeline. ~org-timer-default-timer~ sets the +default countdown value. Giving a prefix numeric argument overrides this +default value. + +* Capture - Refile - Archive + :PROPERTIES: + :DESCRIPTION: The ins and outs for projects + :END: +#+cindex: capture + +An important part of any organization system is the ability to quickly +capture new ideas and tasks, and to associate reference material with +them. Org does this using a process called /capture/. It also can +store files related to a task (/attachments/) in a special directory. +Once in the system, tasks and projects need to be moved around. Moving +completed project trees to an archive file keeps the system compact +and fast. + +** Capture + :PROPERTIES: + :DESCRIPTION: Capturing new stuff + :END: +#+cindex: capture + +Org's method for capturing new items is heavily inspired by John +Wiegley excellent remember package. Up to version 6.36 Org used a +special setup for {{{file(remember.el)}}}. The file {{{file(org-remember.el)}}} +is still part of Org mode for backward compatibility with existing +setups. You can find the documentation for org-remember at +[[http://orgmode.org/org-remember.pdf]]. + +The new capturing setup described here is preferred and should be used by new +users. To convert your ~org-remember-templates~, run the following command: +{{{kbdspckey(M-x org-capture-import-remember-templates,RET)}}} + +{{{noindent}}} and then customize the new variable with +{{{kbd(M-x customize-variable org-capture-templates)}}}, check the result, and +save the customization. You can then use both remember and capture +until you are familiar with the new mechanism. + +Capture lets you quickly store notes with little interruption of your work +flow. The basic process of capturing is very similar to remember, but Org +does enhance it with templates and more. + +*** Setting up capture + :PROPERTIES: + :DESCRIPTION: Where notes will be stored + :END: + +The following customization sets a default target file for notes, and defines +a global key for capturing new material.[fn:81] + +#+vindex: org-default-notes-file +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-default-notes-file (concat org-directory "/notes.org")) +(define-key global-map "\C-cc" 'org-capture) +#+end_src + +*** Using capture + :PROPERTIES: + :DESCRIPTION: Commands to invoke and terminate capture + :END: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c c)}}}, ~org-capture~ :: + #+kindex: C-c c + #+cindex: date tree + + Call the command ~org-capture~. Note that this keybinding is global + and not active by default - you need to install it. If you have + templates defined (see [[Capture templates]], it will offer these + templates for selection or use a new Org outline node as the default + template. It will insert the template into the target file and switch + to an indirect buffer narrowed to this new node. You may then insert + the information you want. + +- {{{kbd(C-c C-c)}}}, ~org-capture-finalize~ :: + #+kindex: C-c C-c + + Once you have finished entering information into the capture buffer, + {{{kbd(C-c C-c)}}} will return you to the window configuration before + the capture process, so that you can resume your work without further + distraction. When called with a prefix argument, finalize and then + jump to the captured item. + +- {{{kbd(C-c C-w)}}}, ~org-capture-refile~ :: + #+kindex: C-c C-w + + Finalize the capture process by refiling the note to a different place + (see [[Refile and copy]]). Please realize that this is a normal refiling + command that will be executed---so the cursor position at the moment + you run this command is important. If you have inserted a tree with a + parent and children, first move the cursor back to the parent. Any + prefix argument given to this command will be passed on to the + ~org-refile~ command. + +- {{{kbd(C-c C-k)}}}, ~org-capture-kill~ :: + #+kindex: C-c C-k + + Abort the capture process and return to the previous state. + + +You can also call ~org-capture~ in a special way from the agenda, +using the {{{kbd(k c)}}} key combination. With this access, timestamps +inserted by the selected capture template will default to the cursor +date in the agenda, rather than to the current date. + +To find the locations of the last stored capture, use ~org-capture~ with +prefix commands: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-u C-c c)}}} :: + #+kindex: C-u C-c c + + Visit the target location of a capture template. You get to select the + template in the usual way. + +- {{{kbd(C-u C-u C-c c)}}} :: + #+kindex: C-u C-u C-c c + + Visit the last stored capture item in its buffer. + + +#+vindex: org-capture-bookmark +#+cindex: org-capture-last-stored + +You can also jump to the bookmark ~org-capture-last-stored~, which +will automatically be created unless you set ~org-capture-bookmark~ to +~nil~. + +To insert the capture at point in an Org buffer, call ~org-capture~ +with a ~C-0~ prefix argument. + +*** Capture templates + :PROPERTIES: + :DESCRIPTION: Define the outline of different note types + :END: +#+cindex: templates, for Capture + +You can use templates for different types of capture items, and for +different target locations. The easiest way to create such templates +is through the customize interface. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c c C)}}} :: + #+kindex: C-c c C + + Customize the variable ~org-capture-templates~. + + +Before we give the formal description of template definitions, let's +look at an example. Say you would like to use one template to create +general TODO entries, and you want to put these entries under the +heading {{{samp(Tasks)}}} in your file {{{file(~/org/gtd.org)}}}. +Also, a date tree in the file {{{file(journal.org)}}} should capture +journal entries. A possible configuration would look like: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-capture-templates + '(("t" "Todo" entry (file+headline "~/org/gtd.org" "Tasks") + "* TODO %?\n %i\n %a") + ("j" "Journal" entry (file+datetree "~/org/journal.org") + "* %?\nEntered on %U\n %i\n %a"))) +#+end_src + +{{{noindent}}} If you then press {{{kbd(C-c c t)}}}, Org will prepare +the template for you like this: + +#+begin_example + ,* TODO + [[file:link to where you initiated capture]] +#+end_example + +{{{noindent}}} During expansion of the template, ~%a~ has been +replaced by a link to the location from where you called the capture +command. This can be extremely useful for deriving tasks from emails, +for example. You fill in the task definition, press ~C-c C-c~ and Org +returns you to the same place where you started the capture process. + +To define special keys to capture to a particular template without +going through the interactive template selection, you can create your +key binding like this: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(define-key global-map "\C-cx" + (lambda () (interactive) (org-capture nil "x"))) +#+end_src + +**** Template elements + :PROPERTIES: + :DESCRIPTION: What is needed for a complete template entry + :END: + +Now lets look at the elements of a template definition. Each entry in +~org-capture-templates~ is a list with the following items: + +#+attr_texinfo: :table-type table :indic @asis +- ~keys~ :: + + The keys that will select the template, as a string, characters + only, for example "a" for a template to be selected with a + single key, or "BTW" for selection with two keys. When using + several keys, keys using the same prefix key must be sequential + in the list and preceded by a 2-element entry explaining the + prefix key, for example: + + #+header: :eval no + #+header: :exports code + #+begin_src emacs-lisp + ("b" "Templates for marking stuff to buy") + #+end_src + + {{{noindent}}} If you do not define a template for the {{{kbd(C)}}} + key, this key will be used to open the customize buffer for this + complex variable. + +- ~description~ :: + + A short string describing the template, which will be shown during + selection. + +- ~type~ :: + + The type of entry, a symbol. Valid values are: + + - ~entry~ :: + + An Org mode node, with a headline. Will be filed as the child of the + target entry or as a top-level entry. The target file should be an Org + mode file. + + - ~item~ :: + + A plain list item, placed in the first plain list at the target + location. Again the target file should be an Org file. + + - ~checkitem~ :: + + A checkbox item. This only differs from the plain list item by the + default template. + + - ~table-line~ :: + + A new line in the first table at the target location. Where exactly + the line will be inserted depends on the properties ~:prepend~ and + ~:table-line-pos~ (see below). + + - plain :: + + Text to be inserted as it is. + +- target :: + #+vindex: org-default-notes-file + + Specification of where the captured item should be placed. In Org mode + files, targets usually define a node. Entries will become children of this + node. Other types will be added to the table or list in the body of this + node. Most target specifications contain a file name. If that file name is + the empty string, it defaults to ~org-default-notes-file~. A file can + also be given as a variable, function, or Emacs Lisp form. + + Valid values are: + + - ~(file "path/to/file")~ :: + + Text will be placed at the beginning or end of that file. + + - ~(id "id of existing org entry")~ :: + + Filing as child of this entry, or in the body of the entry. + + - ~(file+headline "path/to/file" "node headline")~ :: + + Fast configuration if the target heading is unique in the file. + + - ~(file+olp "path/to/file" "Level 1 heading" "Level 2" ...)~ :: + + For non-unique headings, the full path is safer. + + - ~(file+regexp "path/to/file" "regexp to find location")~ :: + + Use a regular expression to position the cursor. + + - ~(file+datetree "path/to/file")~ :: + + Will create a heading in a date tree for today's date. + + - ~(file+datetree+prompt "path/to/file")~ :: + + Will create a heading in a date tree, but will prompt for the date. + + - ~(file+function "path/to/file" function-finding-location)~ :: + + A function to find the right location in the file. + + - ~(clock)~ :: + + File to the entry that is currently being clocked. + + - ~(function function-finding-location)~ :: + + Most general way, write your own function to find both + file and location. + +- ~template~ :: + + The template for creating the capture item. If you leave this empty, + an appropriate default template will be used. Otherwise this is a + string with escape codes, which will be replaced depending on time and + context of the capture call. The string with escapes may be loaded + from a template file, using the special syntax + ~(file "path/to/template")~. See below for more details. + +- ~properties~ :: + + The rest of the entry is a property list of additional options. + Recognized properties are: + + - ~:prepend~ :: + + Normally new captured information will be appended at the target + location (last child, last table line, last list item, ...). Setting + this property will change that. + + - ~:immediate-finish~ :: + + When set, do not offer to edit the information, just file it away + immediately. This makes sense if the template only needs information + that can be added automatically. + + - ~:empty-lines~ :: + + Set this to the number of lines to insert before and after the new + item. The default is 0, and the only other common value is 1. + + - ~:clock-in~ :: + + Start the clock in this item. + + - ~:clock-keep~ :: + + Keep the clock running when filing the captured entry. + + - ~:clock-resume~ :: + + If starting the capture interrupted a clock, restart that clock when + finished with the capture. Note that ~:clock-keep~ has precedence over + ~:clock-resume~. When setting both to ~t~, the current clock will run + and the previous one will not be resumed. + + - ~:unnarrowed~ :: + + Do not narrow the target buffer, simply show the full buffer. Default + is to narrow it so that you only see the new material. + + - ~:table-line-pos~ :: + + Specification of the location in the table where the new line should + be inserted. It should be a string like "II-3" meaning that the new + line should become the third line before the second horizontal + separator line. + + - ~:kill-buffer~ :: + + If the target file was not yet visited when capture was invoked, kill + the buffer again after capture is completed. + +**** Template expansion + :PROPERTIES: + :DESCRIPTION: Filling in information about time and context + :END: + +In the template itself, special {{{kbd(%)}}}-escapes allow dynamic +insertion of content.[fn:82] The templates are expanded in the order given +here: + +#+attr_texinfo: :table-type table :indic @asis +- %[{{{var(file)}}}] :: + + Insert the contents of the file given by {{{var(file)}}}. + +- %({{{var(sexp)}}}) :: + + Evaluate Elisp {{{var(sexp)}}} and replace with the result. The + {{{var(sexp)}}} must return a string. + +- %<...> :: + + The result of format-time-string on the ... format specification. + +- %t :: + + Timestamp, date only. + +- %T :: + + Timestamp, with date and time. + +- %u, %U :: + + Like ~%t~, ~%T~ above, but inactive timestamps. + +- %i :: + + Initial content, the region when capture is called while the region is + active. The entire text will be indented like ~%i~ itself. + +- %a :: + + Annotation, normally the link created with ~org-store-link~. + +- %A :: + + Like ~%a~, but prompt for the description part. + +- %l :: + + Like ~%a~, but only insert the literal link. + +- %c :: + + Current kill ring head. + +- %x :: + + Content of the X clipboard. + +- %k :: + + Title of the currently clocked task. + +- %K :: + + Link to the currently clocked task. + +- %n :: + + User name (taken from ~user-full-name~). + +- %f :: + + File visited by current buffer when org-capture was called. + +- %F :: + + Full path of the file or directory visited by current buffer. + +- %:keyword :: + + Specific information for certain link types, see below. + +- %^g :: + + Prompt for tags, with completion on tags in target file. + +- %^G :: + + Prompt for tags, with completion all tags in all agenda files. + +- %^t :: + + Like ~%t~, but prompt for date. Similarly ~%^T~, ~%^u~, ~%^U~. You may + define a prompt like ~%^{Birthday}t~. + +- %^C :: + + Interactive selection of which kill or clip to use. + +- %^L :: + + Like ~%^C~, but insert as link. + +- %^{PROP}p :: + + Prompt the user for a value for property {{{var(prop)}}}. + +- %^{PROMPT} :: + + Prompt the user for a string and replace this sequence with it. You + may specify a default value and a completion table with + ~%^{prompt|default|completion2|completion3...}~. The arrow keys access + a prompt-specific history. + +- %\n :: + + Insert the text entered at the nth %^{PROMPT}, where ~n~ is + a number, starting from 1. + +- %? :: + + After completing the template, position cursor here. + + +{{{noindent}}} For specific link types, the following keywords will be +defined:[fn:83] + +#+vindex: org-from-is-user-regexp + + +#+attr_texinfo: :table-type table :indic @asis +- bbdb :: ~%:name %:company~ +- irc :: ~%:server %:port %:nick~ +- vm vm-imap wl mh mew rmail :: + ~%:type %:subject %:message-id~ + ~%:from %:fromname %:fromaddress~ + ~%:to %:toname %:toaddress~ + ~%:date~ (message date header field) + ~%:date-timestamp~ (date as active timestamp) + ~%:date-timestamp-inactive~ (date as inactive timestamp) + ~%:fromto~ (either "to NAME" or "from NAME")[fn:84] +- gnus :: ~%:group~, for messages also all email fields +- w3 w3m :: ~%:url~ +- info :: ~%:file %:node~ +- calendar :: ~%:date~ + +{{{noindent}}} To place the cursor after template expansion use: + +#+begin_example + %? After completing the template, position cursor here. +#+end_example + +**** Templates in contexts + :PROPERTIES: + :DESCRIPTION: Only show a template in a specific context + :END: + +#+vindex: org-capture-templates-contexts + +To control whether a capture template should be accessible from a +specific context, you can customize ~org-capture-templates-contexts~. +Let's say, for example, that you have a capture template "p" for +storing Gnus emails containing patches. Then you would configure this +option like this: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-capture-templates-contexts + '(("p" (in-mode . "message-mode")))) +#+end_src + +You can also tell that the command key "p" should refer to another +template. In that case, add this command key like this: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-capture-templates-contexts + '(("p" "q" (in-mode . "message-mode")))) +#+end_src + +See the docstring of the variable ~org-capture-templates-contexts~ for +more information. + +** Attachments + :PROPERTIES: + :DESCRIPTION: Add files to tasks + :END: +#+cindex: attachments +#+vindex: org-attach-directory + +It is often useful to associate reference material with an outline +node/task. Small chunks of plain text can simply be stored in the +subtree of a project. Hyperlinks (see [[Hyperlinks]]) can establish +associations with files that live elsewhere on your computer or in the +cloud, like emails or source code files belonging to a project. +Another method is /attachments/, which are files located in a +directory belonging to an outline node. Org uses directories named by +the unique ID of each entry. These directories are located in the +{{{file(data)}}} directory which lives in the same directory where +your Org file lives.[fn:85] If you initialize this directory with +~git init~, Org will automatically commit changes when it sees them. +The attachment system has been contributed to Org by John Wiegley. + +In cases where it seems better to do so, you can also attach a +directory of your choice to an entry. You can also make children +inherit the attachment directory from a parent, so that an entire +subtree uses the same attached directory. + +{{{noindent}}} The following commands deal with attachments: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-a)}}}, ~org-attach~ :: + #+kindex: C-c C-a + + The dispatcher for commands related to the attachment system. After + these keys, a list of commands is displayed and you must press an + additional key to select a command: + + - {{{kbd(a)}}}, ~org-attach-attach~ :: + #+kindex: C-c C-a a + #+vindex: org-attach-method + + Select a file and move it into the task's attachment directory. The + file will be copied, moved, or linked, depending on + ~org-attach-method~. Note that hard links are not supported on all + systems. + + - {{{kbd(c)}}}/{{{kbd(m)}}}/{{{kbd(l)}}} :: + #+kindex: C-c C-a c + #+kindex: C-c C-a m + #+kindex: C-c C-a l + + Attach a file using the copy/move/link method. Note that hard links + are not supported on all systems. + + - {{{kbd(n)}}}, ~org-attach-new~ :: + #+kindex: C-c C-a n + + Create a new attachment as an Emacs buffer. + + - {{{kbd(z)}}}, ~org-attach-sync~ :: + #+kindex: C-c C-a z + + Synchronize the current task with its attachment directory, in case + you added attachments yourself. + + - {{{kbd(o)}}}, ~org-attach-open~ :: + #+kindex: C-c C-a o + #+vindex: org-file-apps + + Open current task's attachment. If there is more than one, prompt for + a file name first. Opening will follow the rules set by + ~org-file-apps~. For more details, see the information on following + hyperlinks (see [[Handling links]]). + + - {{{kbd(O)}}}, ~org-attach-open-in-emacs~ :: + #+kindex: C-c C-a O + + Also open the attachment, but force opening the file in Emacs. + + - {{{kbd(f)}}}, ~org-attach-reveal~ :: + #+kindex: C-c C-a f + + Open the current task's attachment directory. + + - {{{kbd(F)}}}, ~org-attach-reveal-in-emacs~ :: + #+kindex: C-c C-a F + + Also open the directory, but force using @command{dired} in Emacs. + + - {{{kbd(d)}}}, ~org-attach-delete-one~ :: + #+kindex: C-c C-a d + + Select and delete a single attachment. + + - {{{kbd(D)}}}, ~org-attach-delete-all~ :: + #+kindex: C-c C-a D + + Delete all of a task's attachments. A safer way is to open the + directory in {{{command(dired)}}} and delete from there. + + - {{{kbd(s)}}}, ~org-attach-set-directory~ :: + #+kindex: C-c C-a s + #+cindex: property, ATTACH_DIR + + Set a specific directory as the entry's attachment directory. This + works by putting the directory path into the ~ATTACH_DIR~ property. + + - {{{kbd(i)}}}, ~org-attach-set-inherit~ :: + #+kindex: C-c C-a i + #+cindex: property, ATTACH_DIR_INHERIT + + Set the ~ATTACH_DIR_INHERIT~ property, so that children will use the + same directory for attachments as the parent does. + +** RSS feeds + :PROPERTIES: + :DESCRIPTION: Getting input from RSS feeds + :END: +#+cindex: RSS feeds +#+cindex: Atom feeds + +Org can add and change entries based on information found in RSS feeds and +Atom feeds. You could use this to make a task out of each new podcast in a +podcast feed. Or you could use a phone-based note-creating service on the +web to import tasks into Org. To access feeds, configure the variable +~org-feed-alist~. The docstring of this variable has detailed +information. Here is an example: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-feed-alist + '(("Slashdot" + "http://rss.slashdot.org/Slashdot/slashdot" + "~/txt/org/feeds.org" "Slashdot Entries"))) +#+end_src + +{{{noindent}}} will configure that new items from the feed provided by +~rss.slashdot.org~ will result in new entries in the file +{{{file(~/org/feeds.org)}}} under the heading ~Slashdot Entries~, +whenever the following command is used: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x g)}}}, ~org-feed-update-all~ :: + #+kindex: C-c C-x g + + Collect items from the feeds configured in ~org-feed-alist~ and act + upon them. + +- {{{kbd(C-c C-x G)}}}, ~org-feed-goto-inbox~ :: + #+kindex: C-c C-x G + + Prompt for a feed name and go to the inbox configured for this feed. + + +Under the same headline, Org will create a drawer +{{{samp(FEEDSTATUS)}}} in which it will store information about the +status of items in the feed, to avoid adding the same item several +times. You should add {{{samp(FEEDSTATUS)}}} to the list of drawers in +that file: + +#+begin_example + ,#+DRAWERS: LOGBOOK PROPERTIES FEEDSTATUS +#+end_example + +For more information, including how to read atom feeds, see +{{{file(org-feed.el)}}} and the docstring of ~org-feed-alist~. + +** Protocols + :PROPERTIES: + :DESCRIPTION: External (e.g., browser) access to Emacs and Org + :TITLE: Protocols for external access + :END: + +#+cindex: protocols, for external access +#+cindex: emacsserver + +You can set up Org for handling protocol calls from outside +applications that are passed to Emacs through the +{{{file(emacsserver)}}}. For example, you can configure bookmarks in +your web browser to send a link to the current page to Org and create +a note from it using capture (see [[Capture]]). Or you could create a +bookmark that will tell Emacs to open the local source file of a +remote website you are looking at with the browser. See +[[http://orgmode.org/worg/org-contrib/org-protocol.php]] for detailed +documentation and setup instructions. + +** Refile and copy + :PROPERTIES: + :DESCRIPTION: Moving/copying a tree from one place to another + :END: +#+cindex: refiling notes +#+cindex: copying notes + +When reviewing the captured data, you may want to refile or to copy some of +the entries into a different list, for example into a project. Cutting, +finding the right location, and then pasting the note is cumbersome. To +simplify this process, you can use the following special command: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c M-w)}}}, ~org-copy~ :: + #+kindex: C-c M-w + #+findex: org-copy + + Copying works like refiling, except that the original note is not deleted. + +- {{{kbd(C-c C-w)}}}, ~org-refile~ :: + #+kindex: C-c C-w + #+findex: org-refile + #+vindex: org-reverse-note-order + #+vindex: org-refile-targets + #+vindex: org-refile-use-outline-path + #+vindex: org-outline-path-complete-in-steps + #+vindex: org-refile-allow-creating-parent-nodes + #+vindex: org-log-refile + #+vindex: org-refile-use-cache + + Refile the entry or region at point. This command offers possible + locations for refiling the entry and lets you select one with + completion. The item (or all items in the region) is filed below the + target heading as a subitem. Depending on ~org-reverse-note-order~, it + will be either the first or last subitem. + + By default, all level 1 headlines in the current buffer are considered + to be targets, but you can have more complex definitions across a + number of files. See the variable ~org-refile-targets~ for details. If + you would like to select a location via a file-path-like completion + along the outline path, see the variables + ~org-refile-use-outline-path~ and + ~org-outline-path-complete-in-steps~. If you would like to be able to + create new nodes as new parents for refiling on the fly, check the + variable ~org-refile-allow-creating-parent-nodes~. When the variable + ~org-log-refile~ is set, a timestamp or a note will be recorded when + an entry has been refiled.[fn:86] + +- {{{kbd(C-u C-c C-w)}}} :: + #+kindex: C-u C-c C-w + + Use the refile interface to jump to a heading. + +- {{{kbd(C-u C-u C-c C-w)}}}, ~org-refile-goto-last-stored~ :: + #+kindex: C-u C-u C-c C-w + + Jump to the location where ~org-refile~ last moved a tree to. + +- {{{kbd(C-2 C-c C-w)}}} :: + #+kindex: C-2 C-c C-w + + Refile as the child of the item currently being clocked. + +- {{{kbd(C-0 C-c C-w)}}} or {{{kbd(C-u C-u C-u C-c C-w)}}}, ~org-refile-cache-clear~ :: + #+kindex: C-u C-u C-u C-c C-w + #+kindex: C-0 C-c C-w + + Clear the target cache. Caching of refile targets can be turned on by + setting ~org-refile-use-cache~. To make the command see new possible + targets, you have to clear the cache with this command. + +** Archiving + :PROPERTIES: + :DESCRIPTION: What to do with finished products + :END: +#+cindex: archiving + +When a project represented by a (sub)tree is finished, you may want to +move the tree out of the way and to stop it from contributing to the +agenda. Archiving is important to keep your working files compact and +global searches like the construction of agenda views fast. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x C-a)}}}, ~org-archive-subtree-default~ :: + #+kindex: C-c C-x C-a + #+vindex: org-archive-default-command + + Archive the current entry using the command specified in the variable + ~org-archive-default-command~. + +*** Moving subtrees + :PROPERTIES: + :DESCRIPTION: Moving a tree to an archive file + :TITLE: Moving a tree to an archive file + :END: +#+cindex: external archiving + +The most common archiving action is to move a project tree to another file, +the archive file. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x C-s)}}} or short {{{kbd(C-c $)}}}, ~org-archive-subtree~ :: + #+kindex: C-c C-x C-s + #+kindex: C-c $ + #+vindex: org-archive-location + + Archive the subtree starting at the cursor position to the location + given by ~org-archive-location~. + +- {{{Kbd(C-u C-c C-x C-s)}}} :: + #+kindex: C-u C-c C-x C-s + + Check if any direct children of the current headline could be moved to + the archive. To do this, each subtree is checked for open TODO + entries. If none are found, the command offers to move it to the + archive location. If the cursor is /not/ on a headline when this + command is invoked, the level 1 trees will be checked. + + +#+cindex: archive locations + +The default archive location is a file in the same directory as the +current file, with the name derived by appending {{{file(_archive)}}} +to the current file name. You can also choose what heading to file +archived items under, with the possibility to add them to a datetree +in a file. For information and examples on how to specify the file and +the heading, see the documentation string of the variable +~org-archive-location~. + +There is also an in-buffer option for setting this variable, for +example:[fn:87] + +#+cindex: #+ARCHIVE +#+begin_example + ,#+ARCHIVE: %s_done:: +#+end_example + +#+cindex: property, ARCHIVE + +{{{noindent}}} If you would like to have a special ARCHIVE location +for a single entry or a (sub)tree, give the entry an ~:ARCHIVE:~ +property with the location as the value (see [[Properties and columns]]). + +#+vindex: org-archive-save-context-info + +When a subtree is moved, it receives a number of special properties +that record context information like the file from where the entry +came, its outline path the archiving time etc. Configure the variable +~org-archive-save-context-info~ to adjust the amount of information +added. + +*** Internal archiving + :PROPERTIES: + :DESCRIPTION: Switch off a tree but keep it in the file + :END: + +If you want to just switch off (for agenda views) certain subtrees +without moving them to a different file, you can use the ~ARCHIVE +tag~. + +A headline that is marked with the ARCHIVE tag (see [[Tags]]) stays at +its location in the outline tree, but behaves in the following way: + +- It does not open when you attempt to do so with a visibility cycling + command (see [[Visibility cycling]]). You can force cycling archived + subtrees with {{{kbdkey(C-,TAB)}}}, or by setting the option + ~org-cycle-open-archived-trees~. Also normal outline commands like + ~show-all~ will open archived subtrees. + + #+vindex: org-cycle-open-archived-trees + +- During sparse tree construction (see [[Sparse trees]]), matches in + archived subtrees are not exposed, unless you configure the option + ~org-sparse-tree-open-archived-trees~. + + #+vindex: org-sparse-tree-open-archived-trees + +- During agenda view construction (see [[Agenda views]]), the content of + archived trees is ignored unless you configure the option + ~org-agenda-skip-archived-trees~, in which case these trees will + always be included. In the agenda you can press {{{kbd(v a)}}} to + get archives temporarily included. + + #+vindex: org-agenda-skip-archived-trees + +- Archived trees are not exported (see [[Exporting]]), only the headline + is. Configure the details using the variable + ~org-export-with-archived-trees~. + + #+vindex: org-export-with-archived-trees + +- Archived trees are excluded from column view unless the variable + ~org-columns-skip-archived-trees~ is configured to ~nil~. + + #+vindex: org-columns-skip-archived-trees + + +The following commands help manage the ARCHIVE tag: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x a)}}}, ~org-toggle-archive-tag~ :: + #+kindex: C-c C-x a + + Toggle the ARCHIVE tag for the current headline. When the tag is set, + the headline changes to a shadowed face, and the subtree below it is + hidden. + +- {{{kbd(C-u C-c C-x a)}}} :: + #+kindex: C-u C-c C-x a + + Check if any direct children of the current headline should be + archived. To do this, each subtree is checked for open TODO entries. + If none are found, the command offers to set the ARCHIVE tag for the + child. If the cursor is /not/ on a headline when this command is + invoked, the level 1 trees will be checked. + +- {{{kbdkey(C-,TAB)}}}, ~org-force-cycle-archived~ :: + + Cycle a tree even if it is tagged with ARCHIVE. + +- {{{kbd(C-c C-x A)}}}, ~org-archive-to-archive-sibling~ :: + #+kindex: C-c C-x A + + Move the current entry to the /Archive Sibling/. This is a sibling of + the entry with the heading {{{samp(Archive)}}} and the tag + {{{samp(ARCHIVE)}}}. The entry becomes a child of that sibling and in + this way retains a lot of its original context, including inherited + tags and approximate position in the outline. + +* FIXME Agenda views + :PROPERTIES: + :DESCRIPTION: Collecting information into views + :ALT_TITLE: Agenda Views + :END: + +Due to the way Org works, TODO items, time-stamped items, and tagged +headlines can be scattered throughout a file or even a number of +files. To get an overview of open action items, or of events that are +important for a particular date, this information must be collected, +sorted and displayed in an organized way. + +Org can select items based on various criteria and display them +in a separate buffer. Seven different view types are provided: + +- an /agenda/ that is like a calendar and shows information for + specific dates, + +- a /TODO list/ that covers all unfinished action items, + +- a /match view/, showings headlines based on the tags, properties, + and TODO state associated with them, + +- a /timeline view/ that shows all events in a single Org file, in + time-sorted view, + +- a /text search view/ that shows all entries from multiple files that + contain specified keywords, + +- a /stuck projects view/ showing projects that currently don't move + along, and + +- /custom views/ that are special searches and combinations of + different views. + + +{{{noindent}}} The extracted information is displayed in a special +/agenda buffer/. This buffer is read-only, but provides commands to +visit the corresponding locations in the original Org files, and even +to edit these files remotely. + +#+vindex: org-agenda-window-setup +#+vindex: org-agenda-restore-windows-after-quit + +Two variables control how the agenda buffer is displayed and whether +the window configuration is restored when the agenda exits: +~org-agenda-window-setup~ and ~org-agenda-restore-windows-after-quit~. + +** Agenda files + :PROPERTIES: + :DESCRIPTION: Files being searched for agenda information + :END: +#+cindex: agenda files +#+cindex: files for agenda +#+vindex: org-agenda-files + +The information to be shown is normally collected from all /agenda +files/, the files listed in the variable ~org-agenda-files~.[fn:180] If +a directory is part of this list, all files with the extension +{{{file(.org)}}} in this directory will be part of the list. + +Thus, even if you only work with a single Org file, that file should +be put into the list.[fn:88] You can customize ~org-agenda-files~, but +the easiest way to maintain it is through the following commands + +#+cindex: files, adding to agenda list +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c [)}}}, ~org-agenda-file-to-front~ :: + #+kindex: C-c [ + + Add current file to the list of agenda files. The file is added to the + front of the list. If it was already in the list, it is moved to the + front. With a prefix argument, file is added/moved to the end. + +- {{{kbd(C-c ])}}}, ~org-remove-file~ :: + #+kindex: C-c ] + + Remove current file from the list of agenda files. + +- {{{kbd(C-')}}} {{{kbd(C-)}}}, ~org-cycle-agenda-files~ :: + #+kindex: C-' + #+kindex: C-, + #+cindex: cycling, of agenda files + + Cycle through agenda file list, visiting one file after the other. + +- {{{kbd(M-x org-iswitchb)}}} :: + #+findex: org-iswitchb + + Command to use an ~iswitchb~-like interface to switch to and between + Org buffers. + + +{{{noindent}}} The Org menu contains the current list of files and can +be used to visit any of them. + +If you would like to focus the agenda temporarily on a file not in +this list, or on just one file in the list, or even on only a subtree +in a file, then this can be done in different ways. For a single +agenda command, you may press {{{kbd(<)}}} once or several times in +the dispatcher (see [[Agenda dispatcher]]). To restrict the agenda scope +for an extended period, use the following commands: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x <)}}}, ~org-agenda-set-restriction-lock~ :: + #+kindex: C-c C-x < + + Permanently restrict the agenda to the current subtree. When with a + prefix argument, or with the cursor before the first headline in a + file, the agenda scope is set to the entire file. This restriction + remains in effect until removed with {{{kbd(C-c C-x >)}}}, or by + typing either {{{kbd(<)}}} or {{{kbd(>)}}} in the agenda dispatcher. + If there is a window displaying an agenda view, the new restriction + takes effect immediately. + +- {{{kbd(C-c C-x >)}}}, ~org-agenda-remove-restriction-lock~ :: + #+kindex: C-c C-x > + + Remove the permanent restriction created by {{{kbd(C-c C-x <)}}}. + + +{{{noindent}}} When working with {{{file(speedbar.el)}}}, you can use +the following commands in the Speedbar frame: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(<)}}} in the speedbar frame ~org-speedbar-set-agenda-restriction~ :: + #+kindex: < + + Permanently restrict the agenda to the item---either an Org file or a + subtree in such a file---at the cursor in the Speedbar frame. If there + is a window displaying an agenda view, the new restriction takes + effect immediately. + +- {{{kbd(>)}}} in the speedbar frame ~org-agenda-remove-restriction-lock~ :: + #+kindex: > + + Lift the restriction. + +** Agenda dispatcher + :PROPERTIES: + :DESCRIPTION: Keyboard access to agenda views + :TITLE: The agenda dispatcher + :END: +#+cindex: agenda dispatcher +#+cindex: dispatching agenda commands + +The views are created through a dispatcher, which should be bound to a +global key---for example {{{kbd(C-c a)}}} (see [[Activation]]). In the +following we will assume that {{{kbd(C-c a)}}} is indeed how the +dispatcher is accessed and list keyboard access to commands +accordingly. After pressing {{{kbd(C-c a)}}}, an additional letter is +required to execute a command. The dispatcher offers the following +default commands: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(a)}}} :: + #+kindex: C-c a a + + Create the calendar-like agenda (see [[Weekly/daily agenda]]). + +- {{{kbd(t)}}} or {{{kbd(T)}}} :: + #+kindex: C-c a t + #+kindex: C-c a T + + Create a list of all TODO items (see [[Global TODO list]]). + +- {{{kbd(m)}}} or {{{kbd(M)}}} :: + #+kindex: C-c a m + #+kindex: C-c a M + + Create a list of headlines matching a TAGS expression (see [[Matching tags and properties]]). + +- {{{kbd(L)}}} :: + #+kindex: C-c a L + + Create the timeline view for the current buffer + (see [[Timeline for a single file]]). + +- {{{kbd(s)}}} :: + #+kindex: C-c a s + + Create a list of entries selected by a boolean expression of keywords + and/or regular expressions that must or must not occur in the entry. + +- {{{kbd(/)}}} :: + #+kindex: C-c a / + #+vindex: org-agenda-text-search-extra-files + + Search for a regular expression in all agenda files and additionally + in the files listed in ~org-agenda-text-search-extra-files~. This uses + the Emacs command ~multi-occur~. A prefix argument can be used to + specify the number of context lines for each match, default is + 1. + +- {{{kbd(#)}}} or {{{kbd(!)}}} :: + #+kindex: C-c a # + #+kindex: C-c a ! + Create a list of stuck projects (see [[Stuck projects]]). + +- {{{kbd(<)}}} :: + #+kindex: C-c a < + + Restrict an agenda command to the current buffer.[fn:89] After + pressing {{{kbd(<)}}}, you still need to press the character selecting + the command. + +- {{{kbd(< <)}}} :: + #+kindex: C-c a < < + + If there is an active region, restrict the following agenda command to + the region. Otherwise, restrict it to the current subtree.[fn:90] + After pressing {{{kbd(< <)}}}, you still need to press the character + selecting the command. + +- {{{kbd(*)}}} :: + #+kindex: C-c a * + #+vindex: org-agenda-sticky + + Toggle sticky agenda views. By default, Org maintains only a single + agenda buffer and rebuilds it each time you change the view, to make + sure everything is always up to date. If you switch between views + often and the build time bothers you, you can turn on sticky agenda + buffers (make this the default by customizing the variable + ~org-agenda-sticky~). With sticky agendas, the dispatcher only + switches to the selected view, you need to update it by hand with + {{{kbd(r)}}} or {{{kbd(g)}}}. You can toggle sticky agenda view any + time with ~org-toggle-sticky-agenda~. + + +You can also define custom commands that will be accessible through +the dispatcher, just like the default commands. This includes the +possibility to create extended agenda buffers that contain several +blocks together, for example the weekly agenda, the global TODO list +and a number of special tags matches. See [[Custom agenda views]]. + +** Built-in agenda views + :PROPERTIES: + :DESCRIPTION: What is available out of the box? + :TITLE: The built-in agenda views + :END: +In this section we describe the built-in views. + +*** FIXED Weekly/daily agenda + :PROPERTIES: + :DESCRIPTION: The calendar page with current tasks + :END: +#+cindex: agenda +#+cindex: weekly agenda +#+cindex: daily agenda + +The purpose of the weekly/daily /agenda/ is to act like a page of a +paper agenda, showing all the tasks for the current week or day. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c a a)}}}, ~org-agenda-list~ :: + #+cindex: org-agenda, command + + Compile an agenda for the current week from a list of Org files. The + agenda shows the entries for each day. With a numeric prefix (like + {{{kbd(C-u 2 1 C-c a a)}}}) you may set the number of days to be + displayed.[fn:91] + + +#+vindex: org-agenda-span +#+vindex: org-agenda-ndays +The default number of days displayed in the agenda is set by the variable +~org-agenda-span~ (or the obsolete ~org-agenda-ndays~). This +variable can be set to any number of days you want to see by default in the +agenda, or to a span name, such a ~day~, ~week~, ~month~ or +~year~. + +Remote editing from the agenda buffer means, for example, that you can +change the dates of deadlines and appointments from the agenda buffer. +The commands available in the Agenda buffer are listed in [[Agenda +commands]]. + +**** FIXED Calendar/Diary integration + :PROPERTIES: + :DESCRIPTION: Integrate the Emacs diary with Org + :END: +#+cindex: calendar integration +#+cindex: diary integration +#+cindex: Reingold, Edward M. + +Emacs contains the calendar and diary by Edward M. Reingold. The +calendar displays a three-month calendar with holidays from different +countries and cultures. The diary allows you to keep track of +anniversaries, lunar phases, sunrise/set, recurrent appointments +(weekly, monthly) and more. In this way, it is quite complementary to +Org. It can be very useful to combine output from Org with +the diary. + +In order to include entries from the Emacs diary into Org mode's +agenda, you only need to customize the variable + +#+begin_src emacs-lisp + (setq org-agenda-include-diary t) +#+end_src + +{{{noindent}}} After that, everything will happen automatically. All diary +entries including holidays, anniversaries, etc., will be included in the +agenda buffer created by Org mode. {{{key(SPC)}}}, {{{key(TAB)}}}, and +{{{key(RET)}}} can be used from the agenda buffer to jump to the diary +file in order to edit existing diary entries. The {{{kbd(i)}}} command to +insert new entries for the current date works in the agenda buffer, as +well as the commands {{{kbd(S)}}}, {{{kbd(M)}}}, and {{{kbd(C)}}} to display +Sunrise/Sunset times, show lunar phases and to convert to other +calendars, respectively. {{{kbd(c)}}} can be used to switch back and forth +between calendar and agenda. + +If you are using the diary only for sexp entries and holidays, it is +faster to not use the above setting, but instead to copy or even move +the entries into an Org file. Org mode evaluates diary-style sexp +entries, and does it faster because there is no overhead for first +creating the diary display. Note that the sexp entries must start at +the left margin, no whitespace is allowed before them. For example, +the following segment of an Org file will be processed and entries +will be made in the agenda:[fn:181] + +#+begin_example + ,* Birthdays and similar stuff + ,#+CATEGORY: Holiday + %%(org-calendar-holiday) ; special function for holiday names + ,#+CATEGORY: Ann + %%(org-anniversary 1956 5 14) Arthur Dent is %d years old + %%(org-anniversary 1869 10 2) Mahatma Gandhi would be %d years old +#+end_example + +**** FIXED Anniversaries from BBDB + :PROPERTIES: + :DESCRIPTION: Integrate Big Brother Database and Org + :END: + +#+cindex: BBDB, anniversaries +#+cindex: anniversaries, from BBDB + +If you are using the Big Brothers Database to store your contacts, you will +very likely prefer to store anniversaries in BBDB rather than in a +separate Org or diary file. Org supports this and will show BBDB +anniversaries as part of the agenda. All you need to do is to add the +following to one of your agenda files: + +#+begin_example + ,* Anniversaries + , :PROPERTIES: + , :CATEGORY: Anniv + , :END: + ,%%(org-bbdb-anniversaries) +#+end_example + +You can then go ahead and define anniversaries for a BBDB record. +Basically, you need to press {{{kbdspckey(C-o anniversary,RET)}}} with +the cursor in a BBDB record and then add the date in the format +~YYYY-MM-DD~ or ~MM-DD~, followed by a space and the class of the +anniversary ({{{samp(birthday)}}} or {{{samp(wedding)}}}, or a format +string). If you omit the class, it will default to +{{{samp(birthday)}}}. Here are a few examples, the header for the file +{{{file(org-bbdb.el)}}} contains more detailed information. + +#+begin_example + 1973-06-22 + 06-22 + 1955-08-02 wedding + 2008-04-14 %s released version 6.01 of org mode, %d years ago +#+end_example + +After a change to BBDB, or for the first agenda display during an +Emacs session, the agenda display will suffer a short delay as Org +updates its hash with anniversaries. However, from then on things will +be very fast---much faster in fact than a long list of +{{{samp(%%(diary-anniversary))}}} entries in an Org or Diary file. + +**** FIXED Appointment reminders + :PROPERTIES: + :DESCRIPTION: Integrate the Emacs appointment facility and Org + :END: +#+cindex: @file{appt.el} +#+cindex: appointment reminders +#+cindex: appointment +#+cindex: reminders + +Org can interact with Emacs appointments notification facility. To add the +appointments of your agenda files, use the command ~org-agenda-to-appt~. +This command lets you filter through the list of your appointments and add +only those belonging to a specific category or matching a regular expression. +It also reads a ~APPT_WARNTIME~ property which will then override the +value of ~appt-message-warning-time~ for this appointment. See the +docstring for details. + +*** FIXED Global TODO list + :PROPERTIES: + :DESCRIPTION: All unfinished action items + :END: +#+cindex: global TODO list +#+cindex: TODO list, global + +The global TODO list contains all unfinished TODO items formatted and +collected into a single place. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c a t)}}}, ~org-todo-list~ :: + + Show the global TODO list. This collects the TODO items from all + agenda files (see [[Agenda views]]) into a single buffer. By default, this + lists items with a state the is not a DONE state. The buffer is in + ~agenda-mode~, so there are commands to examine and manipulate the + TODO entries directly from that buffer (see [[Agenda commands]]). + +- {{{kbd(C-c a T)}}}, ~org-todo-list~ :: + + #+cindex: TODO keyword matching + #+vindex: org-todo-keywords + + Like the above, but allows selection of a specific TODO keyword. You + can also do this by specifying a prefix argument to {{{kbd(C-c a + t)}}}. You are prompted for a keyword, and you may also specify + several keywords by separating them with {{{samp(|)}}} as the boolean + OR operator. With a numeric prefix, the Nth keyword in + ~org-todo-keywords~ is selected. + + #+kindex: r + + The {{{kbd(r)}}} key in the agenda buffer regenerates it, and you can give + a prefix argument to this command to change the selected TODO keyword, + for example {{{kbd(3 r)}}}. If you often need a search for a specific + keyword, define a custom command for it (see [[Agenda dispatcher]]). + + Matching specific TODO keywords can also be done as part of a tags + search (see [[Tag searches]]). + + +Remote editing of TODO items means that you can change the state of a +TODO entry with a single key press. The commands available in the +TODO list are described in [[Agenda commands]]. + +#+cindex: sublevels, inclusion into TODO list + +Normally the global TODO list simply shows all headlines with TODO +keywords. This list can become very long. There are two ways to keep +it more compact: + + +- Some people view a TODO item that has been /scheduled/ for execution + or have a /deadline/ (see [[Timestamps]]) as no longer /open/. Configure + the variables ~org-agenda-todo-ignore-scheduled~, + ~org-agenda-todo-ignore-deadlines~, + ~org-agenda-todo-ignore-timestamp~ and/or + ~org-agenda-todo-ignore-with-date~ to exclude such items from the + global TODO list. + + #+vindex: org-agenda-todo-ignore-scheduled + #+vindex: org-agenda-todo-ignore-deadlines + #+vindex: org-agenda-todo-ignore-timestamp + #+vindex: org-agenda-todo-ignore-with-date + +- TODO items may have sublevels to break up the task into subtasks. In + such cases it may be enough to list only the highest level TODO + headline and omit the sublevels from the global list. Configure the + variable ~org-agenda-todo-list-sublevels~ to get this behavior. + + #+vindex: org-agenda-todo-list-sublevels + +*** Matching tags and properties + :PROPERTIES: + :DESCRIPTION: Structured information with fine-tuned search + :END: +#+cindex: matching, of tags +#+cindex: matching, of properties +#+cindex: tags view +#+cindex: match view + +If headlines in the agenda files are marked with /tags/ (see [[Tags]]), or +have properties (see [[Properties and columns]]), you can select headlines +based on this metadata and collect them into an agenda buffer. The +match syntax described here also applies when creating sparse trees +with {{{kbd(C-c / m)}}}. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c a m)}}}, ~org-tags-view~ :: + + Produce a list of all headlines that match a given set of tags. The + command prompts for a selection criterion, which is a boolean logic + expression with tags, like {{{samp(+work+urgent-withboss)}}} or + {{{samp(work|home)}}} (see [[Tags]]). If you often need a specific search, + define a custom command for it (see [[Agenda dispatcher]]). + +- {{{kbd(C-c a M)}}}, ~org-tags-view~ :: + + #+vindex: org-tags-match-list-sublevels + #+vindex: org-agenda-tags-todo-honor-ignore-options + + Like {{{kbd(C-c a m)}}}, but only select headlines that are also TODO + items in a not-DONE state and force checking subitems (see the variable + ~org-tags-match-list-sublevels~). To exclude scheduled/deadline items, + see the variable ~org-agenda-tags-todo-honor-ignore-options~. Matching + specific TODO keywords together with a tags match is also possible, + see [[Tag searches]]. + + +The commands available in the tags list are described in [[Agenda +commands]]. + + +#+cindex: Boolean logic, for tag or property searches + +A search string can use Boolean operators {{{samp(&)}}} for AND and +{{{samp(|)}}} for OR. {{{samp(&)}}} binds more strongly than +{{{samp(|)}}}. Parentheses are currently not implemented. Each element +in the search is either a tag, a regular expression matching tags, or +an expression like ~PROPERTY OPERATOR VALUE~ with a comparison +operator, accessing a property value. Each element may be preceded by +{{{samp(-)}}}, to select against it, and {{{samp(+)}}} is syntactic +sugar for positive selection. The AND operator {{{samp(&)}}} is +optional when {{{samp(+)}}} or {{{samp(-)}}} is present. Here are some +examples, using only tags. + +#+attr_texinfo: :table-type table :indic @samp +- +work-boss :: + + Select headlines tagged {{{samp(:work:)}}}, but discard those also + tagged {{{samp(:boss:)}}}. + +- work|laptop :: + + Selects lines tagged {{{samp(:work:)}}} or {{{samp(:laptop:)}}}. + +- work|laptop+night :: + + Like before, but require the {{{samp(:laptop:)}}} lines to be tagged + also {{{samp(:night:)}}}. + + +#+cindex: regular expressions, with tags search + +Instead of a tag, you may also specify a regular expression enclosed +in curly braces. For example, {{{samp(work+{^boss.*})}}} matches +headlines that contain the tag {{{samp(:work:)}}} and any tag +/starting/ with {{{samp(boss)}}}. + +#+cindex: TODO keyword matching, with tags search +#+cindex: level, require for tags/property match +#+cindex: category, require for tags/property match +#+vindex: org-odd-levels-only + +You may also test for properties (see [[Properties and columns]]) at the +same time as matching tags. The properties may be real properties, or +special properties that represent other metadata (see [[Special +properties]]). For example, the "property" ~TODO~ represents the TODO +keyword of the entry. Or, the "property" ~LEVEL~ represents the +level of an entry. So a search {{{samp(+LEVEL=3+boss-TODO="DONE")}}} +lists all level three headlines that have the tag {{{samp(boss)}}} and +are /not/ marked with the TODO keyword DONE. In buffers with +~org-odd-levels-only~ set, {{{samp(LEVEL)}}} does not count the number +of stars, but {{{samp(LEVEL=2)}}} will correspond to 3 stars etc. The +ITEM special property cannot currently be used in tags/property +searches.[fn:92] + +Here are more examples: + +#+attr_texinfo: :table-type table :indic @samp +- work+TODO="WAITING" :: + + Select {{{samp(:work:)}}}-tagged TODO lines with the specific TODO + keyword {{{samp(WAITING)}}}. + +- work+TODO="WAITING"|home+TODO="WAITING" :: + + Waiting tasks both at work and at home. + + +When matching properties, a number of different operators can be used to test +the value of a property. Here is a complex example: + +#+begin_example + +work-boss+PRIORITY="A"+Coffee="unlimited"+Effort<2 + +With={Sarah|Denny}+SCHEDULED>="<2008-10-11>" +#+end_example + +{{{noindent}}} The type of comparison will depend on how the +comparison value is written: + +- If the comparison value is a plain number, a numerical comparison is + done, and the allowed operators are ~<~, ~=~, ~>~, ~<=~, ~>=~, and + ~<>~. + +- If the comparison value is enclosed in double-quotes, a string + comparison is done, and the same operators are allowed. + +- If the comparison value is enclosed in double-quotes /and/ angular + brackets (like {{{samp(DEADLINE<="<2008-12-24 18:30>")}}}), both + values are assumed to be date/time specifications in the standard + Org way, and the comparison will be done accordingly. Special values + that will be recognized are ~"<now>"~ for now (including time), and + ~"<today>"~, and ~"<tomorrow>"~ for these days at 0:00 hours, i.e.@: + without a time specification. Also strings like ~"<+5d>"~ or + ~"<-2m>"~ with units ~d~, ~w~, ~m~, and ~y~ for day, week, month, + and year, respectively, can be used. + +- If the comparison value is enclosed in curly braces, a regexp match + is performed, with {{{samp(=)}}} meaning that the regexp matches the + property value, and ~<>~ meaning that it does not match. + + +So the search string in the example finds entries tagged +{{{samp(:work:)}}} but not {{{samp(:boss:)}}}, which also have a +priority value {{{samp(A)}}}, a {{{samp(:Coffee:)}}} property with the +value {{{samp(unlimited)}}}, an {{{samp(Effort)}}} property that is +numerically smaller than 2, a {{{samp(:With:)}}} property that is +matched by the regular expression {{{samp(Sarah|Denny)}}}, and that +are scheduled on or after October 11, 2008. + +Accessing TODO, LEVEL, and CATEGORY during a search is fast. Accessing +any other properties will slow down the search. However, once you have +paid the price by accessing one property, testing additional +properties is cheap again. + +You can configure Org mode to use property inheritance during a +search, but beware that this can slow down searches considerably. See +[[Property inheritance]], for details. + +For backward compatibility, and also for typing speed, there is also a +different way to test TODO states in a search. For this, terminate the +tags/property part of the search string (which may include several +terms connected with {{{samp(|)}}}) with a {{{samp(/)}}} and then +specify a Boolean expression just for TODO keywords. The syntax is +then similar to that for tags, but should be applied with care: for +example, a positive selection on several TODO keywords cannot +meaningfully be combined with boolean AND. However, /negative +selection/ combined with AND can be meaningful. To make sure that only +lines are checked that actually have any TODO keyword (resulting in a +speed-up), use {{{kbd(C-c a M)}}}, or equivalently start the TODO part +after the slash with {{{samp(!)}}}. Using {{{kbd(C-c a M)}}} or +{{{samp(/!)}}} will not match TODO keywords in a DONE state. Examples: + +#+attr_texinfo: :table-type table :indic @samp +- work/WAITING :: + + Same as {{{samp(work+TODO="WAITING")}}} + +- work/!-WAITING-NEXT :: + + Select {{{samp(:work:)}}}-tagged TODO lines that are neither {{{samp(WAITING)}}} + nor {{{samp(NEXT)}}} + +- work/!+WAITING|+NEXT :: + + Select {{{samp(:work:)}}}-tagged TODO lines that are either + {{{samp(WAITING)}}} or {{{samp(NEXT)}}}. + +*** FIXED Timeline for a single file + :PROPERTIES: + :DESCRIPTION: Time-sorted view for a single file + :ALT_TITLE: Timeline + :END: + +#+cindex: timeline, single file +#+cindex: time-sorted view + +The timeline summarizes all time-stamped items from a single Org mode +file in a /time-sorted view/. The main purpose of this command is +to give an overview over events in a project. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c a L)}}}, ~org-timeline~ :: + + Show a time-sorted view of the Org file, with all time-stamped items. + When called with a {{{kbd(C-u)}}} prefix, all unfinished TODO entries + (scheduled or not) are also listed under the current date. + + +{{{noindent}}} The commands available in the timeline buffer are +listed in [[Agenda commands]]. + +*** FIXED Search view + :PROPERTIES: + :DESCRIPTION: Find entries by searching for text + :END: +#+cindex: search view +#+cindex: text search +#+cindex: searching, for text + +This agenda view is a general text search facility for Org mode entries. +It is particularly useful to find notes. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c a s)}}}, ~org-search-view~ :: + + This is a special search that lets you select entries by matching a + substring or specific words using a boolean logic. + + +For example, the search string {{{samp(computer equipment)}}} will +find entries that contain {{{samp(computer equipment)}}} as a +substring. If the two words are separated by more space or a line +break, the search will still match. Search view can also search for +specific keywords in the entry, using Boolean logic. The search string +{{{samp(+computer +wifi -ethernet -{8.11[bg]})}}} will search for +note entries that contain the keywords ~computer~ and ~wifi~, but not +the keyword ~ethernet~, and which are also not matched by the regular +expression ~8.11[bg]~, meaning to exclude both 8.11b and 8.11g. The +first {{{samp(+)}}} is necessary to turn on word search, other +{{{samp(+)}}} characters are optional. For more details, see the +docstring of the command ~org-search-view~. + +#+vindex: org-agenda-text-search-extra-files + +Note that in addition to the agenda files, this command will also +search the files listed in ~org-agenda-text-search-extra-files~. + +*** FIXED Stuck projects + :PROPERTIES: + :DESCRIPTION: Find projects you need to review + :END: +#+pindex: GTD, Getting Things Done + +If you are following a system like David Allen's GTD to organize your +work, one of the "duties" you have is a regular review to make sure +that all projects move along. A /stuck/ project is a project that has +no defined next actions, so it will never show up in the TODO lists +Org mode produces. During the review, you need to identify such +projects and define next actions for them. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c a #)}}}, ~org-agenda-list-stuck-projects~ :: + + List projects that are stuck. + +- {{{kbd(C-c a !)}}} :: + + #+vindex: org-stuck-projects + #+kindex: C-c a ! + + Customize the variable ~org-stuck-projects~ to define what a stuck + project is and how to find it. + + +You almost certainly will have to configure this view before it will +work for you. The built-in default assumes that all your projects are +level-2 headlines, and that a project is not stuck if it has at least +one entry marked with a TODO keyword TODO or NEXT or NEXTACTION. + +Let's assume that you, in your own way of using Org mode, identify +projects with a tag PROJECT, and that you use a TODO keyword MAYBE to +indicate a project that should not be considered yet. Let's further +assume that the TODO keyword DONE marks finished projects, and that +NEXT and TODO indicate next actions. The tag @SHOP indicates shopping +and is a next action even without the NEXT tag. Finally, if the +project contains the special word IGNORE anywhere, it should not be +listed either. In this case you would start by identifying eligible +projects with a tags/todo match (see [[Tag searches]]). +{{{samp(+PROJECT/-MAYBE-DONE)}}}, and then check for TODO, NEXT, +@SHOP, and IGNORE in the subtree to identify projects that are not +stuck. The correct customization for this is: + +#+begin_src emacs-lisp +(setq org-stuck-projects + '("+PROJECT/-MAYBE-DONE" ("NEXT" "TODO") ("@@SHOP") + "\\<IGNORE\\>")) +#+end_src + +Note that if a project is identified as non-stuck, the subtree of this entry +will still be searched for stuck projects. + +** Presentation and sorting + :PROPERTIES: + :DESCRIPTION: How agenda items are prepared for display + :END: +#+cindex: presentation, of agenda items +#+vindex: org-agenda-prefix-format +#+vindex: org-agenda-tags-column + +Before displaying items in an agenda view, Org mode visually prepares +the items and sorts them. Each item occupies a single line. The line +starts with a /prefix/ that contains the /category/ (see [[Categories]]) +of the item and other important information. You can customize in +which column tags will be displayed through ~org-agenda-tags-column~. +You can also customize the prefix using the option +~org-agenda-prefix-format~. This prefix is followed by a cleaned-up +version of the outline headline associated with the item. + +*** Categories + :PROPERTIES: + :DESCRIPTION: Not all tasks are equal + :END: + +#+cindex: category +#+cindex: #+CATEGORY + +The category is a broad label assigned to each agenda item. By +default, the category is simply derived from the file name, but you +can also specify it with a special line in the buffer, like +this:[fn:93] + +#+begin_example + ,#+CATEGORY: Thesis +#+end_example + +{{{noindent}}} +#+cindex: property, CATEGORY + +If you would like to have a special CATEGORY for a single entry or a +(sub)tree, give the entry a ~:CATEGORY:~ property with the special +category you want to apply as the value. + +{{{noindent}}} The display in the agenda buffer looks best if the +category is not longer than 10 characters. + +{{{noindent}}} You can set up icons for category by customizing the +~org-agenda-category-icon-alist~ variable. +#+vindex: org-agenda-category-icon-alist + +*** Time-of-day specifications + :PROPERTIES: + :DESCRIPTION: How the agenda knows the time + :END: +#+cindex: time-of-day specification + +Org mode checks each agenda item for a time-of-day specification. The +time can be part of the timestamp that triggered inclusion into the +agenda, for example as in ~<2005-05-10 Tue 19:00>~. Time +ranges can be specified with two timestamps, like: + + ~<2005-05-10 Tue 20:30>--<2005-05-10 Tue 22:15>~. + +In the headline of the entry itself, a time(range) may also appear as +plain text (like {{{samp(12:45)}}} or a {{{samp(8:30-1pm)}}}). If the +agenda integrates the Emacs diary (see [[Weekly/daily agenda]]), time +specifications in diary entries are recognized as well. + +For agenda display, Org mode extracts the time and displays it in a +standard 24 hour format as part of the prefix. The example times in +the previous paragraphs would end up in the agenda like this: + +#+begin_example + 8:30-13:00 Arthur Dent lies in front of the bulldozer + 12:45...... Ford Prefect arrives and takes Arthur to the pub + 19:00...... The Vogon reads his poem + 20:30-22:15 Marvin escorts the Hitchhikers to the bridge +#+end_example + +#+cindex: time grid + +If the agenda is in single-day mode, or for the display of today, the +timed entries are embedded in a time grid, like + +#+begin_example + 8:00...... ------------------ + 8:30-13:00 Arthur Dent lies in front of the bulldozer + 10:00...... ------------------ + 12:00...... ------------------ + 12:45...... Ford Prefect arrives and takes Arthur to the pub + 14:00...... ------------------ + 16:00...... ------------------ + 18:00...... ------------------ + 19:00...... The Vogon reads his poem + 20:00...... ------------------ + 20:30-22:15 Marvin escorts the Hitchhikers to the bridge +#+end_example + +#+vindex: org-agenda-use-time-grid +#+vindex: org-agenda-time-grid + +The time grid can be turned on and off with the variable +~org-agenda-use-time-grid~, and can be configured with +~org-agenda-time-grid~. + +*** Sorting of agenda items + :PROPERTIES: + :DESCRIPTION: The order of things + :END: +#+cindex: sorting, of agenda items +#+cindex: priorities, of agenda items + +Before being inserted into a view, the items are sorted. How this is +done depends on the type of view. + +- For the daily/weekly agenda, the items for each day are sorted. The + default order is to first collect all items containing an explicit + time-of-day specification. These entries will be shown at the + beginning of the list, as a /schedule/ for the day. After that, + items remain grouped in categories, in the sequence given by + ~org-agenda-files~. Within each category, items are sorted by + priority (see [[Priorities]]), which is composed of the base priority + (2000 for priority {{{samp(A)}}}, 1000 for {{{samp(B)}}}, and 0 for + {{{samp(C)}}}), plus additional increments for overdue scheduled or deadline items. + + #+vindex: org-agenda-files + +- For the TODO list, items remain in the order of categories, but + within each category, sorting takes place according to priority (see + [[Priorities]]). The priority used for sorting derives from the + priority cookie, with additions depending on how close an item is to + its due or scheduled date. + +- For tags matches, items are not sorted at all, but just appear in + the sequence in which they are found in the agenda files. + + +#+vindex: org-agenda-sorting-strategy + +Sorting can be customized using the variable +~org-agenda-sorting-strategy~, and may also include criteria based on +the estimated effort of an entry (see [[Effort estimates]]). + +** FIXME Agenda commands + :PROPERTIES: + :DESCRIPTION: Remote editing of Org trees + :TITLE: Commands in the agenda buffer + :END: +#+cindex: commands, in agenda buffer + +Entries in the agenda buffer are linked back to the Org file or diary +file where they originate. You are not allowed to edit the agenda +buffer itself, but commands are provided to show and jump to the +original entry location, and to edit the Org files ``remotely'' from +the agenda buffer. In this way, all information is stored only once, +removing the risk that your agenda and note files may diverge. + +Some commands can be executed with mouse clicks on agenda lines. For +the other commands, the cursor needs to be in the desired line. + +*** FIXME Motion2 +#+cindex: motion commands in agenda + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(n)}}}, ~org-agenda-next-line~ :: + #+kindex: n + + Next line (same as {{{key(down)}}} and {{{kbd(C-n)}}}). + +- {{{kbd(p)}}}, ~org-agenda-previous-line~ :: + #+kindex: p + + Previous line (same as {{{key(up)}}} and {{{kbd(C-p)}}}). + +*** View/Go to Org file +#+cindex: view file commands in agenda + +#+attr_texinfo: :table-type table :indic @asis +- {{{key(SPC)}}} or {{{key(mouse-3)}}}, ~org-agenda-show-and-scroll-up~ :: + #+kindex: @key{SPC} + #+kindex: mouse-3 + + Display the original location of the item in another window. With + prefix arg, make sure that the entire entry is made visible in the + outline, not only the heading. + +- {{{kbd(L)}}}, ~org-agenda-recenter~ :: + #+kindex: L + + Display original location and recenter that window. + +- {{{key(TAB)}}} or {{{key(mouse-2)}}}, ~org-agenda-goto~ :: + #+kindex: @key{TAB} + #+kindex: mouse-2 + + Go to the original location of the item in another window. + +- {{{key(RET)}}}, ~org-agenda-switch-to~ :: + #+kindex: @key{RET} + + Go to the original location of the item and delete other windows. + +- {{{kbd(F)}}}, ~org-agenda-follow-mode~ :: + #+kindex: F + #+vindex: org-agenda-start-with-follow-mode + + Toggle Follow mode. In Follow mode, as you move the cursor through the + agenda buffer, the other window always shows the corresponding + location in the Org file. The initial setting for this mode in new + agenda buffers can be set with the variable + ~org-agenda-start-with-follow-mode~. + +- {{{kbd(C-c C-x b)}}}, ~org-agenda-tree-to-indirect-buffer~ :: + #+kindex: C-c C-x b + + Display the entire subtree of the current item in an indirect buffer. + With a numeric prefix argument N, go up to level N and then take that + tree. If N is negative, go up that many levels. With a {{{kbd(C-u)}}} + prefix, do not remove the previously used indirect buffer. + +- {{{kbd(C-c C-o)}}}, ~org-agenda-open-link~ :: + #+kindex: C-c C-o + + Follow a link in the entry. This will offer a selection of any links + in the text belonging to the referenced Org node. If there is only one + link, it will be followed without a selection prompt. + +*** Change display +#+cindex: change agenda display + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(A)}}} :: + #+kindex: A + #+cindex: display changing, in agenda + + Interactively select another agenda view and append it to the current + view. + +- {{{kbd(o)}}} :: + #+kindex: o + + Delete other windows. + +- {{{kbd(v d)}}} or short {{{kbd(d)}}}, ~org-agenda-day-view~ :: + #+kindex: v d + #+kindex: d + #+vindex: org-agenda-span + + Switch to day view. When switching to day view, this setting becomes + the default for subsequent agenda refreshes. A numeric prefix argument + may be used to jump directly to a specific day of the year. For + example, {{{kbd(32 d)}}} jumps to February 1st. When setting day view, + a year may be encoded in the prefix argument as well. For example, + {{{kbd(200712 d)}}} will jump to January 12, 2007. If such a year + specification has only one or two digits, it will be mapped to the + interval 1938-2037. + +- {{{kbd(v w)}}} or short {{{kbd(w)}}}, ~org-agenda-week-view~ :: + #+kindex: v w + #+kindex: w + #+vindex: org-agenda-span + + Switch to week view. When switching week view, this setting becomes + the default for subsequent agenda refreshes. A numeric prefix argument + may be used to jump directly to a specific day of the ISO week. For + example {{{kbd(9 w)}}} to ISO week number 9. When setting week view, a + year may be encoded in the prefix argument as well. For example, + {{{kbd(200712 w)}}} will jump to week 12 in 2007. If such a year + specification has only one or two digits, it will be mapped to the + interval 1938-2037. + +- {{{kbd(v m)}}}, ~org-agenda-month-view~ :: + #+kindex: v m + #+vindex: org-agenda-span + + Switch to month view. Because month views are slow to create, they do + not become the default for subsequent agenda refreshes. A numeric + prefix argument may be used to jump directly to a specific day of the + month. When setting month view, a year may be encoded in the prefix + argument as well. For example, {{{kbd(200712 m)}}} will jump to + December, 2007. If such a year specification has only one or two + digits, it will be mapped to the interval 1938-2037. + +- {{{kbd(v y)}}}, ~org-agenda-year-view~ :: + #+kindex: v y + #+vindex: org-agenda-span + + Switch to year view. Because year views are slow to create, they do + not become the default for subsequent agenda refreshes. A numeric + prefix argument may be used to jump directly to a specific day of the + year. + +- {{{kbdspckey(v,SPC)}}}, ~org-agenda-reset-view~ :: + #+kindex: v @key{SPC} + #+vindex: org-agenda-span + + Reset ~org-agenda-span~ to the current span. + +- {{{kbd(f)}}}, ~org-agenda-later~ :: + #+kindex: f + + Go forward in time to display the following ~org-agenda-current-span~ + days. For example, if the display covers a week, switch to the + following week. With prefix arg, go forward that many times + ~org-agenda-current-span~ days. + +- {{{kbd(b)}}}, ~org-agenda-earlier~ :: + #+kindex: b + + Go backward in time to display earlier dates. + +- {{{kbd(.)}}}, ~org-agenda-goto-today~ :: + #+kindex: . + + Go to today. + +- {{{kbd(j)}}}, ~org-agenda-goto-date~ :: + #+kindex: j + + Prompt for a date and go there. + +- {{{kbd(J)}}}, ~org-agenda-clock-goto~ :: + #+kindex: J + + Go to the currently clocked-in task /in the agenda buffer/. + +- {{{kbd(D)}}}, ~org-agenda-toggle-diary~ :: + #+kindex: D + + Toggle the inclusion of diary entries. See [[Weekly/daily agenda]]. + +- {{{kbd(v l)}}} or {{{kbd(v L)}}} or short {{{kbd(l)}}}, ~org-agenda-log-mode~ :: + #+kindex: v l + #+kindex: l + #+kindex: v L + #+vindex: org-log-done + #+vindex: org-agenda-log-mode-items + + Toggle Logbook mode. In Logbook mode, entries that were marked DONE + while logging was on (see the variable ~org-log-done~) are shown in + the agenda, as are entries that have been clocked on that day. You can + configure the entry types that should be included in log mode using + the variable ~org-agenda-log-mode-items~. When called with a + {{{kbd(C-u)}}} prefix, show all possible logbook entries, including + state changes. When called with two prefix args {{{kbd(C-u C-u)}}}, + show only logging information, nothing else. {{{kbd(v L)}}} is + equivalent to {{{kbd(C-u v l)}}}. + +- {{{kbd(v [)}}} or short {{{kbd([)}}}, ~org-agenda-manipulate-query-add~ :: + #+kindex: v [ + #+kindex: [ + + Include inactive timestamps into the current view. Only for + weekly/daily agenda and timeline views. + +- {{{kbd(v a)}}}, ~org-agenda-archives-mode~ :: + #+kindex: v a + + Toggle Archives mode. In Archives mode, trees that are marked + ~ARCHIVED~ are also scanned when producing the agenda. To exit + archives mode, press {{{kbd(v a)}}} again. + +- {{{kbd(v A)}}}, ~org-agenda-archives-mode 'files~ :: + + Toggle Archives mode. In Archives mode, trees that are marked + ~ARCHIVED~ are also scanned when producing the agenda, including all + archive files. To exit archives mode, press {{{kbd(v a)}}}. + +- {{{kbd(v R)}}} or short {{{kbd(R)}}}, ~org-agenda-clockreport-mode~ :: + #+kindex: v R + #+kindex: R + #+vindex: org-agenda-start-with-clockreport-mode + #+vindex: org-clock-report-include-clocking-task + + Toggle Clockreport mode. In Clockreport mode, the daily/weekly agenda + will always show a table with the clocked times for the timespan and + file scope covered by the current agenda view. The initial setting for + this mode in new agenda buffers can be set with the variable + ~org-agenda-start-with-clockreport-mode~. By using a prefix argument + when toggling this mode (i.e., {{{kbd(C-u R)}}}), the clock table will + not show contributions from entries that are hidden by agenda + filtering.[fn:94] See also the variable + ~org-clock-report-include-clocking-task~. + +- {{{kbd(v c)}}} :: + #+kindex: v c + #+vindex: org-agenda-clock-consistency-checks + + Show overlapping clock entries, clocking gaps, and other clocking + problems in the current agenda range. You can then visit clocking + lines and fix them manually. See the variable + ~org-agenda-clock-consistency-checks~ for information on how to + customize the definition of what constituted a clocking problem. To + return to normal agenda display, press {{{kbd(l)}}} to exit Logbook + mode. + +- {{{kbd(v E)}}} or short {{{kbd(E)}}}, ~org-agenda-entry-text-mode~ :: + #+kindex: v E + #+kindex: E + #+vindex: org-agenda-start-with-entry-text-mode + #+vindex: org-agenda-entry-text-maxlines + + Toggle entry text mode. In entry text mode, a number of lines from the + Org outline node referenced by an agenda line will be displayed below + the line. The maximum number of lines is given by the variable + ~org-agenda-entry-text-maxlines~. Calling this command with a numeric + prefix argument will temporarily modify that number to the prefix + value. + +- {{{kbd(G)}}}, ~org-agenda-toggle-time-grid~ :: + #+kindex: G + #+vindex: org-agenda-use-time-grid + #+vindex: org-agenda-time-grid + + Toggle the time grid on and off. See also the variables + ~org-agenda-use-time-grid~ and ~org-agenda-time-grid~. + +- {{{kbd(r)}}}, ~org-agenda-redo~ :: + #+kindex: r + + Recreate the agenda buffer, for example to reflect the changes after + modification of the timestamps of items with {{{kbdkey(S-,left)}}} and + {{{kbdkey(S-,right)}}}. When the buffer is the global TODO list, a prefix + argument is interpreted to create a selective list for a specific TODO + keyword. + +- {{{kbd(g)}}}, ~org-agenda-redo~ :: + #+kindex: g + + Same as {{{kbd(r)}}}. + +- {{{kbd(C-x C-s)}}} or short {{{kbd(s)}}}, ~org-save-all-org-buffers~ :: + #+kindex: C-x C-s + #+kindex: s + + Save all Org buffers in the current Emacs session, and also the + locations of IDs. + +- {{{kbd(C-c C-x C-c)}}}, ~org-agenda-columns~ :: + #+kindex: C-c C-x C-c + #+vindex: org-columns-default-format + + Invoke column view (see [[Column view]]) in the agenda buffer. The column + view format is taken from the entry at point, or (if there is no entry + at point), from the first entry in the agenda view. So whatever the + format for that entry would be in the original buffer (taken from a + property, from a ~#+COLUMNS~ line, or from the default variable + ~org-columns-default-format~), will be used in the agenda. + +- {{{kbd(C-c C-x >)}}}, ~org-agenda-remove-restriction-lock~ :: + #+kindex: C-c C-x > + + Remove the restriction lock on the agenda, if it is currently + restricted to a file or subtree (see [[Agenda files]]). + +*** FIXME Secondary filtering and query editing +#+cindex: filtering, by tag category and effort, in agenda +#+cindex: tag filtering, in agenda +#+cindex: category filtering, in agenda +#+cindex: effort filtering, in agenda +#+cindex: query editing, in agenda + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(<)}}}, ~org-agenda-filter-by-category~ :: + #+kindex: < + #+vindex: org-agenda-category-filter-preset + + Filter the current agenda view with respect to the category of the + item at point. Pressing {{{kbd(<)}}} another time will remove this + filter. You can add a filter preset through the option + ~org-agenda-category-filter-preset~ (see below). + +- {{{kbd(/)}}}, ~org-agenda-filter-by-tag~ :: + #+kindex: / + #+vindex: org-agenda-tag-filter-preset + + Filter the current agenda view with respect to a tag and/or effort + estimates. The difference between this and a custom agenda command is + that filtering is very fast, so that you can switch quickly between + different filters without having to recreate the + agenda.[fn:95] + + You will be prompted for a tag selection letter; {{{key(SPC)}}} will + mean any tag at all. Pressing {{{key(TAB)}}} at that prompt will offer + use completion to select a tag (including any tags that do not have a + selection character). The command then hides all entries that do not + contain or inherit this tag. When called with prefix arg, remove the + entries that /do/ have the tag. A second {{{kbd(/)}}} at the prompt + will turn off the filter and unhide any hidden entries. If the first + key you press is either {{{kbd(+)}}} or {{{kbd(-)}}}, the previous + filter will be narrowed by requiring or forbidding the selected + additional tag. Instead of pressing {{{kbd(+)}}} or {{{kbd(-)}}} after + {{{kbd(/)}}}, you can also immediately use the ~\~ command. + + #+vindex: org-sort-agenda-noeffort-is-high + + In order to filter for effort estimates, you should set up allowed + efforts globally, for example: + #+header: :eval no + #+header: :exports code + #+begin_src emacs-lisp + (setq org-global-properties + '(("Effort_ALL". "0 0:10 0:30 1:00 2:00 3:00 4:00"))) + #+end_src + + You can then filter for an effort by first typing an operator, one of + {{{kbd(<)}}}, {{{kbd(>)}}}, and {{{kbd(=)}}}, and then the one-digit + index of an effort estimate in your array of allowed values, where + {{{kbd(0)}}} means the 10th value. The filter will then restrict to + entries with effort smaller-or-equal, equal, or larger-or-equal than + the selected value. If the digits 0-9 are not used as fast access keys + to tags, you can also simply press the index digit directly without an + operator. In this case, {{{kbd(<)}}} will be assumed. For application + of the operator, entries without a defined effort will be treated + according to the value of ~org-sort-agenda-noeffort-is-high~. To + filter for tasks without effort definition, press {{{kbd(?)}}} as the + operator. + + Org also supports automatic, context-aware tag filtering. If the + variable ~org-agenda-auto-exclude-function~ is set to a user-defined + function, that function can decide which tags should be excluded from + the agenda automatically. Once this is set, the {{{kbd(/)}}} command + then accepts {{{kbd(RET)}}} as a sub-option key and runs the auto + exclusion logic. For example, let's say you use a ~Net~ tag to + identify tasks which need network access, an ~Errand~ tag for errands + in town, and a ~Call~ tag for making phone calls. You could + auto-exclude these tags based on the availability of the Internet, and + outside of business hours, with something like this: + + #+header: :eval no + #+header: :exports code + #+begin_src emacs-lisp + (defun org-my-auto-exclude-function (tag) + (and (cond + ((string= tag "Net") + (/= 0 (call-process "/sbin/ping" nil nil nil + "-c1" "-q" "-t1" "mail.gnu.org"))) + ((or (string= tag "Errand") (string= tag "Call")) + (let ((hour (nth 2 (decode-time)))) + (or (< hour 8) (> hour 21))))) + (concat "-" tag))) + (setq org-agenda-auto-exclude-function 'org-my-auto-exclude-function) + #+end_src + +- ~\~ ~org-agenda-filter-by-tag-refine~ :: + #+kindex: XXX + #+comment: Should be \ + Narrow the current agenda filter by an additional condition. When + called with prefix arg, remove the entries that /do/ have the tag, or + that do match the effort criterion. You can achieve the same effect by + pressing {{{kbd(+)}}} or {{{kbd(-)}}} as the first key after the + {{{kbd(/)}}} command. + +- {{{kbd([)}}} {{{kbd(])}}} {{{kbd({)}}} {{{kbd(})}}} in search view :: + #+kindex: [ + #+kindex: ] + #+kindex: @{ + #+kindex: @} + + Add new search words ({{{kbd([)}}} and {{{kbd(])}}}) or new regular + expressions ({{{kbd({)}}} and {{{kbd(})}}}) to the query string. The + opening bracket/brace will add a positive search term prefixed by + {{{samp(+)}}}, indicating that this search term /must/ occur/match in + the entry. The closing bracket/brace will add a negative search term + which /must not/ occur/match in the entry for it to be selected. + +*** FIXME Remote editing +#+cindex: remote editing, from agenda + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(0--9)}}} :: + + Digit argument. + +- {{{kbd(C-_)}}}, ~org-agenda-undo~ :: + #+kindex: C-_ + #+cindex: undoing remote-editing events + #+cindex: remote editing, undo + + Undo a change due to a remote editing command. The change is undone + both in the agenda buffer and in the remote buffer. + +- {{{kbd(t)}}}, ~org-agenda-todo~ :: + #+kindex: t + + Change the TODO state of the item, both in the agenda and in the + original org file. + +- {{{kbdkey(C-S-,right)}}}, ~org-agenda-todo-nextset~ :: + #+kindex: C-S-@key{right} + + Switch to the next set of TODO keywords. + +- {{{kbdkey(C-S-,left)}}}, ~org-agenda-todo-previousset~ :: + #+kindex: C-S-@key{left} + + Switch to the previous set of TODO keywords. + +- {{{kbd(C-k)}}}, ~org-agenda-kill~ :: + #+kindex: C-k + #+vindex: org-agenda-confirm-kill + + Delete the current agenda item along with the entire subtree belonging + to it in the original Org file. If the text to be deleted remotely is + longer than one line, the kill needs to be confirmed by the user. See + variable ~org-agenda-confirm-kill~. + +- {{{kbd(C-c C-w)}}}, ~org-agenda-refile~ :: + #+kindex: C-c C-w + + Refile the entry at point. + +- {{{kbd(C-c C-x C-a)}}} or short {{{kbd(a)}}}, ~org-agenda-archive-default-with-confirmation~ :: + #+kindex: C-c C-x C-a + #+kindex: a + #+vindex: org-archive-default-command + + Archive the subtree corresponding to the entry at point using the + default archiving command set in ~org-archive-default-command~. When + using the ~a~ key, confirmation will be required. + +- {{{kbd(C-c C-x a)}}}, ~org-agenda-toggle-archive-tag~ :: + #+kindex: C-c C-x a + + Toggle the ARCHIVE tag for the current headline. + +- {{{kbd(C-c C-x A)}}}, ~org-agenda-archive-to-archive-sibling~ :: + #+kindex: C-c C-x A + + Move the subtree corresponding to the current entry to its /archive + sibling/. + +- {{{kbd(C-c C-x C-s)}}} or short {{{kbd($)}}}, ~org-agenda-archive~ :: + #+kindex: C-c C-x C-s + #+kindex: $ + + Archive the subtree corresponding to the current headline. This means + the entry will be moved to the configured archive location, most + likely a different file. + +- {{{kbd(T)}}}, ~org-agenda-show-tags~ :: + #+kindex: T + #+vindex: org-agenda-show-inherited-tags + + Show all tags associated with the current item. This is useful if you + have turned off ~org-agenda-show-inherited-tags~, but still want to + see all tags of a headline occasionally. + +- {{{kbd(:)}}}, ~org-agenda-set-tags~ :: + #+kindex: : + + Set tags for the current headline. If there is an active region in the + agenda, change a tag for all headings in the region. + +- {{{kbd(\\\,)}}} :: + #+kindex: , + Set the priority for the current item (~org-agenda-priority~). Org + mode prompts for the priority character. If you reply with + {{{key(SPC)}}}, the priority cookie is removed from the entry. + +- {{{kbd(P)}}}, ~org-agenda-show-priority~ :: + #+kindex: P + + Display weighted priority of current item. + +- {{{kbd(+)}}} {{{kbdkey(S-,up)}}}, ~org-agenda-priority-up~ :: + #+kindex: + + + Increase the priority of the current item. The priority is changed in + the original buffer, but the agenda is not resorted. Use the + {{{kbd(r)}}} key for this. + +- {{{kbd(-)}}} {{{kbdkey(S-,down)}}}, ~org-agenda-priority-down~ :: + #+kindex: - + + Decrease the priority of the current item. + +- {{{kbd(z)}}} {{{kbd(C-c C-z)}}}, ~org-agenda-add-note~ :: + #+kindex: z + #+vindex: org-log-into-drawer + + Add a note to the entry. This note will be recorded, and then filed to + the same location where state change notes are put. Depending on + ~org-log-into-drawer~, this may be inside a drawer. + +- {{{kbd(C-c C-a)}}}, ~org-attach~ :: + #+kindex: C-c C-a + + Dispatcher for all command related to attachments. + +- {{{kbd(C-c C-s)}}}, ~org-agenda-schedule~ :: + #+kindex: C-c C-s + + Schedule this item. With prefix arg remove the scheduling timestamp + +- {{{kbd(C-c C-d)}}}, ~org-agenda-deadline~ :: + #+kindex: C-c C-d + + Set a deadline for this item. With prefix arg remove the deadline. + +- {{{kbdkey(S-,right)}}}, ~org-agenda-do-date-later~ :: + #+kindex: S-@key{right} + + Change the timestamp associated with the current line by one day into + the future. If the date is in the past, the first call to this command + will move it to today. With a numeric prefix argument, change it by + that many days. For example, {{{kbdkey(3 6 5 S-,right)}}} will change + it by a year. With a {{{kbd(C-u)}}} prefix, change the time by one + hour. If you immediately repeat the command, it will continue to + change hours even without the prefix arg. With a double + {{{kbd(C-u C-u)}}} prefix, do the same for changing minutes. The stamp is changed + in the original Org file, but the change is not directly reflected in + the agenda buffer. Use {{{kbd(r)}}} or {{{kbd(g)}}} to update the + buffer. + +- {{{kbdkey(S-,left)}}}, ~org-agenda-do-date-earlier~ :: + #+kindex: S-@key{left} + + Change the timestamp associated with the current line by one day + into the past. + +- {{{kbd(>)}}}, ~org-agenda-date-prompt~ :: + #+kindex: > + + Change the timestamp associated with the current line. The key + {{{kbd(>)}}} has been chosen, because it is the same as {{{kbd(S-.)}}} + on my keyboard. + +- {{{kbd(I)}}}, ~org-agenda-clock-in~ :: + #+kindex: I + + Start the clock on the current item. If a clock is running already, it + is stopped first. + +- {{{kbd(O)}}}, ~org-agenda-clock-out~ :: + #+kindex: O + + Stop the previously started clock. + +- {{{kbd(X)}}}, ~org-agenda-clock-cancel~ :: + #+kindex: X + + Cancel the currently running clock. + +- {{{kbd(J)}}}, ~org-agenda-clock-goto~ :: + #+kindex: J + + Jump to the running clock in another window. + +- {{{kbd(k)}}}, ~org-agenda-capture~ :: + #+kindex: k + #+cindex: capturing, from agenda + #+vindex: org-capture-use-agenda-date + + Like ~org-capture~, but use the date at point as the default date for + the capture template. See ~org-capture-use-agenda-date~ to make this + the default behavior of ~org-capture~. + +*** Bulk remote editing selected entries +#+cindex: remote editing, bulk, from agenda +#+vindex: org-agenda-bulk-persistent-marks +#+vindex: org-agenda-bulk-custom-functions + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(m)}}}, ~org-agenda-bulk-mark~ :: + #+kindex: m + + Mark the entry at point for bulk action. With prefix arg, mark that + many successive entries. + +- {{{kbd(%)}}}, ~org-agenda-bulk-mark-regexp~ :: + #+kindex: % + + Mark entries matching a regular expression for bulk action. + +- {{{kbd(u)}}}, ~org-agenda-bulk-unmark~ :: + #+kindex: u + + Unmark entry for bulk action. + +- {{{kbd(U)}}}, ~org-agenda-bulk-remove-all-marks~ :: + #+kindex: U + + Unmark all marked entries for bulk action. + +- {{{kbd(B)}}}, ~org-agenda-bulk-action~ :: + #+kindex: B + + Bulk action: act on all marked entries in the agenda. This will prompt + for another key to select the action to be applied. The prefix arg to + {{{kbd(B)}}} will be passed through to the {{{kbd(s)}}} and + {{{kbd(d)}}} commands, to bulk-remove these special timestamps. By + default, marks are removed after the bulk. If you want them to + persist, set ~org-agenda-bulk-persistent-marks~ to ~t~ or hit + {{{kbd(p)}}} at the prompt. + + - {{{kbd(*)}}} :: + + Toggle persistent marks. + + - {{{kbd($)}}} :: + + Archive all selected entries. + + - {{{kbd(A)}}} :: + + Archive entries by moving them to their respective archive siblings. + + - {{{kbd(t)}}} :: + + Change TODO state. This prompts for a single TODO keyword and changes + the state of all selected entries, bypassing blocking and suppressing + logging notes (but not timestamps). + + - {{{kbd(+)}}} :: + + Add a tag to all selected entries. + + - {{{kbd(-)}}} :: + + Remove a tag from all selected entries. + + - {{{kbd(s)}}} :: + + Schedule all items to a new date. To shift existing schedule dates by + a fixed number of days, use something starting with double plus at the + prompt, for example {{{samp(++8d)}}} or {{{samp(++2w)}}}. + + - {{{kbd(d)}}} :: + + Set deadline to a specific date. + + - {{{kbd(r)}}} :: + + Prompt for a single refile target and move all entries. The entries + will no longer be in the agenda; refresh ({{{kbd(g)}}}) to bring them + back. + + - {{{kbd(S)}}} :: + + Reschedule randomly into the coming N days. N will be prompted for. + With prefix arg ({{{kbd(C-u B S)}}}), scatter only across weekdays. + + - {{{kbd(f)}}} :: + + Apply a function to marked entries.[fn:96] For example, the function + below sets the CATEGORY property of the entries to web. + + #+header: :eval no + #+header: :exports code + #+begin_src emacs-lisp + (defun set-category () + (interactive "P") + (let* ((marker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer marker))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char marker) + (org-back-to-heading t) + (org-set-property "CATEGORY" "web")))))) + #+end_src + +*** Calendar commands +#+cindex: calendar commands, from agenda + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(c)}}}, ~org-agenda-goto-calendar~ :: + #+kindex: c + + Open the Emacs calendar and move to the date at the agenda cursor. + +- {{{kbd(c)}}}, ~org-calendar-goto-agenda~ :: + #+kindex: c + + When in the calendar, compute and show the Org mode agenda for the + date at the cursor. + +- {{{kbd(i)}}}, ~org-agenda-diary-entry~ :: + #+kindex: i + #+vindex: org-agenda-diary-file + #+cindex: diary entries, creating from agenda + + Insert a new entry into the diary, using the date at the cursor and + (for block entries) the date at the mark. This will add to the Emacs + diary file, in a way similar to the {{{kbd(i)}}} command in the + calendar.[fn:97] The diary file will pop up in another window, where + you can add the entry. + + If you configure ~org-agenda-diary-file~ to point to an Org mode file, + Org will create entries (in Org mode syntax) in that file instead. + Most entries will be stored in a date-based outline tree that will + later make it easy to archive appointments from previous months/years. + The tree will be built under an entry with a ~DATE_TREE~ property, or + else with years as top-level entries. Emacs will prompt you for the + entry text---if you specify it, the entry will be created in + ~org-agenda-diary-file~ without further interaction. If you directly + press {{{key(RET)}}} at the prompt without typing text, the target + file will be shown in another window for you to finish the entry + there. See also the {{{kbd(k r)}}} command. + +- {{{kbd(M)}}}, ~org-agenda-phases-of-moon~ :: + #+kindex: M + + Show the phases of the moon for the three months around current date. + +- {{{kbd(S)}}}, ~org-agenda-sunrise-sunset~ :: + #+kindex: S + + Show sunrise and sunset times. The geographical location must be set + with calendar variables, see the documentation for the Emacs calendar. + +- {{{kbd(C)}}}, ~org-agenda-convert-date~ :: + #+kindex: C + + Convert the date at cursor into many other cultural and historic + calendars. + +- {{{kbd(H)}}}, ~org-agenda-holidays~ :: + #+kindex: H + + Show holidays for three months around the cursor date. + +- {{{kbd(M-x org-export-icalendar-combine-agenda-files)}}} :: + + Export a single iCalendar file containing entries from all agenda + files. This is a globally available command, and also available in the + agenda menu. + +*** Exporting to a file +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-x C-w)}}}, ~org-agenda-write~ :: + #+kindex: C-x C-w + #+cindex: exporting agenda views + #+cindex: agenda views, exporting + #+vindex: org-agenda-exporter-settings + + Write the agenda view to a file. Depending on the extension of the + selected file name, the view will be exported as HTML (extension + {{{file(.html)}}} or {{{file(.htm)}}}), Postscript (extension + {{{file(.ps)}}}), PDF (extension {{{file(.pdf)}}}), and plain text + (any other extension). When called with a {{{kbd(C-u)}}} prefix + argument, immediately open the newly created file. Use the variable + ~org-agenda-exporter-settings~ to set options for {{{file(ps-print)}}} + and for {{{file(htmlize)}}} to be used during export. + +*** Quit and exit +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(q)}}}, ~org-agenda-quit~ :: + #+kindex: q + + Quit agenda, remove the agenda buffer. + +- {{{kbd(x)}}}, ~org-agenda-exit~ :: + #+kindex: x + #+cindex: agenda files, removing buffers + + Exit agenda, remove the agenda buffer and all buffers loaded by Emacs + for the compilation of the agenda. Buffers created by the user to + visit Org files will not be removed. + +** Custom agenda views + :PROPERTIES: + :DESCRIPTION: Defining special searches and views + :END: +#+cindex: custom agenda views +#+cindex: agenda views, custom + +Custom agenda commands serve two purposes: to store and quickly access +frequently used TODO and tags searches, and to create special composite +agenda buffers. Custom agenda commands will be accessible through the +dispatcher (see [[Agenda dispatcher]]), just like the default commands. + +*** Storing searches + :PROPERTIES: + :DESCRIPTION: Type once, use often + :END: + +The first application of custom searches is the definition of keyboard +shortcuts for frequently used searches, either creating an agenda +buffer, or a sparse tree (the latter covering of course only the +current buffer). + +#+kindex: C-c a C +#+vindex: org-agenda-custom-commands + +Custom commands are configured in the variable +~org-agenda-custom-commands~. You can customize this variable, for +example by pressing {{{kbd(C-c a C)}}}. You can also directly set it +with Emacs Lisp in {{{file(.emacs)}}}. The following example contains +all valid search types: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-agenda-custom-commands + '(("w" todo "WAITING") + ("W" todo-tree "WAITING") + ("u" tags "+boss-urgent") + ("v" tags-todo "+boss-urgent") + ("U" tags-tree "+boss-urgent") + ("f" occur-tree "\\<FIXME\\>") + ("h" . "HOME+Name tags searches") ; description for "h" prefix + ("hl" tags "+home+Lisa") + ("hp" tags "+home+Peter") + ("hk" tags "+home+Kim"))) +#+end_src + +{{{noindent}}} The initial string in each entry defines the keys you +have to press after the dispatcher command {{{kbd(C-c a)}}} in order +to access the command. Usually this will be just a single character, +but if you have many similar commands, you can also define two-letter +combinations where the first character is the same in several +combinations and serves as a prefix key.[fn:98] The second parameter +is the search type, followed by the string or regular expression to be +used for the matching. The example above will therefore define: + +#+attr_texinfo: :table-type table :indic @kbd +- C-c a w :: + + A global search for TODO entries with {{{samp(WAITING)}}} as the TODO + keyword. + +- C-c a W :: + + The same search, but only in the current buffer and displaying the + results as a sparse tree. + +- C-c a u :: + + A global tags search for headlines marked {{{samp(:boss:)}}} but not + {{{samp(:urgent:)}}}. + +- C-c a v :: + + The same search as {{{kbd(C-c a u)}}}, but limiting the search to + headlines that are also TODO items. + +- C-c a U :: + + The same search as {{{kbd(C-c a u)}}}, but only in the current buffer and + displaying the result as a sparse tree. + +- C-c a f :: + + Create a sparse tree (again: current buffer only) with all entries + containing the word {{{samp(FIXME)}}} + +- C-c a h :: + + A prefix command for a HOME tags search where you have to press an + additional key ({{{kbd(l)}}}, {{{kbd(p)}}} or {{{kbd(k)}}}) to select + a name (Lisa, Peter, or Kim) as additional tag to match. + + +*** Block agenda + :PROPERTIES: + :DESCRIPTION: All the stuff you need in a single buffer + :END: +#+cindex: block agenda +#+cindex: agenda, with block views + +Another possibility is the construction of agenda views that comprise +the results of /several/ commands, each of which creates a block in +the agenda buffer. The available commands include ~agenda~ for the +daily or weekly agenda (as created with {{{kbd(C-c a a)}}}), ~alltodo~ +for the global TODO list (as constructed with {{{kbd(C-c a t)}}}), and +the matching commands discussed above: ~todo~, ~tags~, and +~tags-todo~. Here are two examples: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-agenda-custom-commands + '(("h" "Agenda and Home-related tasks" + ((agenda "") + (tags-todo "home") + (tags "garden"))) + ("o" "Agenda and Office-related tasks" + ((agenda "") + (tags-todo "work") + (tags "office"))))) +#+end_src + +{{{noindent}}} This will define {{{kbd(C-c a h)}}} to create a +multi-block view for stuff you need to attend to at home. The +resulting agenda buffer will contain your agenda for the current week, +all TODO items that carry the tag {{{samp(home)}}}, and also all lines +tagged with {{{samp(garden)}}}. Finally the command {{{kbd(C-c a o)}}} +provides a similar view for office tasks. + +*** Setting options for custom commands + :PROPERTIES: + :DESCRIPTION: Changing the rules + :END: +#+cindex: options, for custom agenda views +#+vindex: org-agenda-custom-commands + +Org mode contains a number of variables regulating agenda construction +and display. The global variables define the behavior for all agenda +commands, including the custom commands. However, if you want to +change some settings just for a single custom view, you can do so. +Setting options requires inserting a list of variable names and values +at the right spot in ~org-agenda-custom-commands~. For example: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-agenda-custom-commands + '(("w" todo "WAITING" + ((org-agenda-sorting-strategy '(priority-down)) + (org-agenda-prefix-format " Mixed: "))) + ("U" tags-tree "+boss-urgent" + ((org-show-following-heading nil) + (org-show-hierarchy-above nil))) + ("N" search "" + ((org-agenda-files '("~org/notes.org")) + (org-agenda-text-search-extra-files nil))))) +#+end_src + +{{{noindent}}} Now the {{{kbd(C-c a w)}}} command will sort the +collected entries only by priority, and the prefix format is modified +to just say {{{samp( Mixed: )}}} instead of giving the category of the +entry. The sparse tags tree of {{{kbd(C-c a U)}}} will now turn out +ultra-compact, because neither the headline hierarchy above the match, +nor the headline following the match will be shown. The command +{{{kbd(C-c a N)}}} will do a text search limited to only a single +file. + +#+vindex: org-agenda-custom-commands + +For command sets creating a block agenda, ~org-agenda-custom-commands~ +has two separate spots for setting options. You can add options that +should be valid for just a single command in the set, and options that +should be valid for all commands in the set. The former are just added +to the command entry; the latter must come after the list of command +entries. Going back to the block agenda example (see [[Block +agenda]]), let's change the sorting strategy for the {{{kbd(C-c a +h)}}} commands to ~priority-down~, but let's sort the results for +GARDEN tags query in the opposite order, ~priority-up~. This would +look like this: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-agenda-custom-commands + '(("h" "Agenda and Home-related tasks" + ((agenda) + (tags-todo "home") + (tags "garden" + ((org-agenda-sorting-strategy '(priority-up))))) + ((org-agenda-sorting-strategy '(priority-down)))) + ("o" "Agenda and Office-related tasks" + ((agenda) + (tags-todo "work") + (tags "office"))))) +#+end_src + +As you see, the values and parentheses setting is a little complex. +When in doubt, use the customize interface to set this variable---it +fully supports its structure. Just one caveat: when setting options in +this interface, the /values/ are just Lisp expressions. So if the +value is a string, you need to add the double-quotes around the value +yourself. + +#+vindex: org-agenda-custom-commands-contexts + +To control whether an agenda command should be accessible from a +specific context, you can customize +~org-agenda-custom-commands-contexts~. Let's say for example that you +have an agenda command {{{kbd(o)}}} displaying a view that you only +need when reading emails. Then you would configure this option like +this: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-agenda-custom-commands-contexts + '(("o" (in-mode . "message-mode")))) +#+end_src + +You can also tell that the command key {{{kbd(o)}}} should refer to another +command key {{{kbd(r)}}}. In that case, add this command key like this: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-agenda-custom-commands-contexts + '(("o" "r" (in-mode . "message-mode")))) +#+end_src + +See the docstring of the variable for more information. + +** Exporting agenda views + :PROPERTIES: + :DESCRIPTION: Writing a view to a file + :END: +#+cindex: agenda views, exporting + +If you are away from your computer, it can be very useful to have a +printed version of some agenda views to carry around. Org mode can +export custom agenda views as plain text, HTML, Postscript, +PDF, and iCalendar files.[fn:99] If you want to +do this only occasionally, use the following command: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-x C-w)}}}, ~org-agenda-write~ :: + + #+cindex: exporting agenda views + #+cindex: agenda views, exporting + #+vindex: org-agenda-exporter-settings + + Write the agenda view to a file. Depending on the extension of the + selected file name, the view will be exported as HTML (extension + {{{file(.html)}}} or {{{file(.htm)}}}), Postscript (extension + {{{file(.ps)}}}), iCalendar (extension {{{file(.ics)}}}), or plain + text (any other extension). Use the variable + ~org-agenda-exporter-settings~ to set options for {{{file(ps-print)}}} + and for {{{file(htmlize)}}} to be used during export, for example: + + #+vindex: org-agenda-add-entry-text-maxlines + #+vindex: htmlize-output-type + #+vindex: ps-number-of-columns + #+vindex: ps-landscape-mode + + #+header: :eval no + #+header: :exports code + #+begin_src emacs-lisp + (setq org-agenda-exporter-settings + '((ps-number-of-columns 2) + (ps-landscape-mode t) + (org-agenda-add-entry-text-maxlines 5) + (htmlize-output-type 'css))) + #+end_src + + +If you need to export certain agenda views frequently, you can +associate any custom agenda command with a list of output file +names.[fn:100] Here is an example that first defines custom commands +for the agenda and the global TODO list, together with a number of +files to which to export them. Then we define two block agenda +commands and specify file names for them as well. File names can be +relative to the current working directory, or absolute. + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-agenda-custom-commands + '(("X" agenda "" nil ("agenda.html" "agenda.ps")) + ("Y" alltodo "" nil ("todo.html" "todo.txt" "todo.ps")) + ("h" "Agenda and Home-related tasks" + ((agenda "") + (tags-todo "home") + (tags "garden")) + nil + ("~/views/home.html")) + ("o" "Agenda and Office-related tasks" + ((agenda) + (tags-todo "work") + (tags "office")) + nil + ("~/views/office.ps" "~/calendars/office.ics")))) +#+end_src + +The extension of the file name determines the type of export. If it is +{{{file(.html)}}}, Org mode will use the {{{file(htmlize.el)}}} +package to convert the buffer to HTML and save it to this file name. +If the extension is {{{file(.ps)}}}, ~ps-print-buffer-with-faces~ is +used to produce Postscript output. If the extension is +{{{file(.ics)}}}, iCalendar export is run export over all files that +were used to construct the agenda, and limit the export to entries +listed in the agenda. Any other extension produces a plain ASCII file. + +The export files are /not/ created when you use one of those +commands interactively because this might use too much overhead. +Instead, there is a special command to produce /all/ specified +files in one step: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c a e)}}}, ~org-store-agenda-views~ :: + + Export all agenda views that have export file names associated with + them. + + +You can use the options section of the custom agenda commands to also +set options for the export commands. For example: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-agenda-custom-commands + '(("X" agenda "" + ((ps-number-of-columns 2) + (ps-landscape-mode t) + (org-agenda-prefix-format " [ ] ") + (org-agenda-with-colors nil) + (org-agenda-remove-tags t)) + ("theagenda.ps")))) +#+end_src + +{{{noindent}}} This command sets two options for the Postscript +exporter, to make it print in two columns in landscape format---the +resulting page can be cut in two and then used in a paper agenda. The +remaining settings modify the agenda prefix to omit category and +scheduling information, and instead include a checkbox to check off +items. We also remove the tags to make the lines compact, and we don't +want to use colors for the black-and-white printer. Settings specified +in ~org-agenda-exporter-settings~ will also apply, but the settings in +~org-agenda-custom-commands~ take precedence. + +{{{noindent}}} From the command line you may also use: + +#+begin_src sh + emacs -eval (org-batch-store-agenda-views) -kill +#+end_src + +{{{noindent}}} or, if you need to modify some parameters:[fn:101] + +#+begin_example + emacs -eval '(org-batch-store-agenda-views \ + org-agenda-span (quote month) \ + org-agenda-start-day "2007-11-01" \ + org-agenda-include-diary nil \ + org-agenda-files (quote ("~/org/project.org")))' \ + -kill +#+end_example + +{{{noindent}}} which will create the agenda views restricted to the +file {{{file(~/org/project.org)}}}, without diary entries and with a +30-day extent. + +You can also extract agenda information in a way that allows further +processing by other programs. See [[Extracting agenda information]], for +more information. + +** Using column view in the agenda + :PROPERTIES: + :DESCRIPTION: Using column view for collected entries + :ALT_TITLE: Agenda column view + :END: +#+cindex: column view, in agenda +#+cindex: agenda, column view +<<Agenda column view>> + +Column view (see [[Column view]]) is normally used to view and edit +properties embedded in the hierarchical structure of an Org file. It +can be quite useful to use column view also from the agenda, where +entries are collected by certain criteria. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x C-c)}}}, ~org-agenda-columns~ :: + + Turn on column view in the agenda. + + +To understand how to use this properly, it is important to realize that the +entries in the agenda are no longer in their proper outline environment. +This causes the following issues: + +1. Org needs to make a decision which ~COLUMNS~ format to use. Since + the entries in the agenda are collected from different files, and + different files may have different ~COLUMNS~ formats, this is a + non-trivial problem. Org first checks if the variable + ~org-agenda-overriding-columns-format~ is currently set, and if so, + takes the format from there. Otherwise it takes the format + associated with the first item in the agenda, or, if that item does + not have a specific format (defined in a property, or in its file), + it uses ~org-columns-default-format~. + + #+vindex: org-columns-default-format + #+vindex: org-overriding-columns-format + +2. If any of the columns has a summary type defined (see [[Column + attributes]]), turning on column view in the agenda will visit all + relevant agenda files and make sure that the computations of this + property are up to date. This is also true for the special + ~CLOCKSUM~ property. Org will then sum the values displayed in the + agenda. In the daily/weekly agenda, the sums will cover a single + day; in all other views they cover the entire block. It is vital to + realize that the agenda may show the same entry /twice/ (for + example as scheduled and as a deadline), and it may show two + entries from the same hierarchy (for example a /parent/ and its + /child/). In these cases, the summation in the agenda will lead to + incorrect results because some values will count double. + + #+cindex: property, special, CLOCKSUM + +3. When the column view in the agenda shows the ~CLOCKSUM~, that is + always the entire clocked time for this item. So even in the + daily/weekly agenda, the clocksum listed in column view may + originate from times outside the current view. This has the + advantage that you can compare these values with a column listing + the planned total effort for a task---one of the major applications + for column view in the agenda. If you want information about + clocked time in the displayed period use clock table mode (press + {{{kbd(R)}}} in the agenda). + +4. When the column view in the agenda shows the ~CLOCKSUM_T~, that is + always today's clocked time for this item. So even in the weekly agenda, + the clocksum listed in column view only originates from today. This lets + you compare the time you spent on a task for today, with the time already + spent (via ~CLOCKSUM~) and with the planned total effort for it. + + #+cindex: property, special, CLOCKSUM_T + +* FIXME Markup for rich export + :PROPERTIES: + :DESCRIPTION: Prepare text for rich export + :ALT_TITLE: Markup + :END: + +When exporting Org mode documents, the exporter tries to reflect the +structure of the document as accurately as possible in the backend. +Since export targets like HTML, LaTeX, or DocBook allow much richer +formatting, Org mode has rules on how to prepare text for rich export. +This section summarizes the markup rules used in an Org mode buffer. + +** Structural markup elements + :PROPERTIES: + :DESCRIPTION: The basic structure as seen by the exporter + :END: + +*** Document title + :PROPERTIES: + :DESCRIPTION: Where the title is taken from + :END: +#+cindex: document title, markup rules + +{{{noindent}}} The title of the exported document is taken from the +special line: + +#+cindex: #+TITLE +#+begin_example + ,#+TITLE: This is the title of the document +#+end_example + +{{{noindent}}} If this line does not exist, the title is derived from +the first non-empty, non-comment line in the buffer. If no such line +exists, or if you have turned off exporting of the text before the +first headline (see below), the title will be the file name without +extension. + +#+cindex: property, EXPORT_TITLE + +If you are exporting only a subtree by marking is as the region, the +heading of the subtree will become the title of the document. If the +subtree has a property ~EXPORT_TITLE~, that will take precedence. + +*** Headings and sections + :PROPERTIES: + :DESCRIPTION: The document structure as seen by the exporter + :END: +#+cindex: headings and sections, markup rules + +#+vindex: org-export-headline-levels + +The outline structure of the document as described in [[Document +structure]], forms the basis for defining sections of the exported +document. However, since the outline structure is also used for (for +example) lists of tasks, only the first three outline levels will be +used as headings. Deeper levels will become itemized lists. You can +change the location of this switch globally by setting the variable +~org-export-headline-levels~, or on a per-file basis with the ~H~ option: + +#+cindex: #+OPTIONS +#+begin_example + ,#+OPTIONS: H:4 +#+end_example + +*** Table of contents + :PROPERTIES: + :DESCRIPTION: The if and where of the table of contents + :END: +#+cindex: table of contents, markup rules + +#+vindex: org-export-with-toc + +The table of contents is normally inserted directly before the first +headline of the file. If you would like to get it to a different +location, insert the string ~[TABLE-OF-CONTENTS]~ on a line by itself +at the desired location. The depth of the table of contents is by +default the same as the number of headline levels, but you can choose +a smaller number, or turn off the table of contents entirely, by +configuring the variable ~org-export-with-toc~, or on a per-file basis +with the ~toc~ option: + +#+begin_example + ,#+OPTIONS: toc:2 (only to two levels in TOC) + ,#+OPTIONS: toc:nil (no TOC at all) +#+end_example + +*** Initial text + :PROPERTIES: + :DESCRIPTION: Text before the first heading? + :TITLE: Text before the first headline + :END: +#+cindex: text before first headline, markup rules +#+cindex: #+TEXT + +Org mode normally exports the text before the first headline, and even uses +the first line as the document title. The text will be fully marked up. If +you need to include literal HTML, LaTeX, or DocBook code, use the special +constructs described below in the sections for the individual exporters. + +#+vindex: org-export-skip-text-before-1st-heading + +Some people like to use the space before the first headline for setup +and internal links and therefore would like to control the exported +text before the first headline in a different way. You can do so by +setting the variable ~org-export-skip-text-before-1st-heading~ to ~t~. +On a per-file basis, you can get the same effect with +{{{samp(#+OPTIONS: skip:t)}}}. + +{{{noindent}}} + +If you still want to have some text before the first headline, use the +~#+TEXT~ construct: + +#+begin_example + ,#+OPTIONS: skip:t + ,#+TEXT: This text will go before the *first* headline. + ,#+TEXT: [TABLE-OF-CONTENTS] + ,#+TEXT: This goes between the table of contents and the *first* headline +#+end_example + +*** Lists + :PROPERTIES: + :DESCRIPTION: Lists + :END: +#+cindex: lists, markup rules + +Plain lists as described in [[Plain lists]], are translated to the +backend's syntax for such lists. Most backends support unordered, +ordered, and description lists. + +*** Paragraphs + :PROPERTIES: + :DESCRIPTION: Paragraphs + :END: +#+cindex: paragraphs, markup rules + +Paragraphs are separated by at least one empty line. If you need to +enforce a line break within a paragraph, use ~\\~ at the end +of a line. + +To keep the line breaks in a region, but otherwise use normal +formatting, you can use ~VERSE~ blocks, which can also be used to +format poetry: + +#+cindex: #+BEGIN_VERSE +#+begin_example + #+BEGIN_VERSE + Great clouds overhead + Tiny black birds rise and fall + Snow covers Emacs + + -- AlexSchroeder + #+END_VERSE +#+end_example + +When quoting a passage from another document, it is customary to +format this as a paragraph that is indented on both the left and the +right margin. You can include quotations in Org mode documents like +this: + +#+cindex: #+BEGIN_QUOTE +#+begin_example + #+BEGIN_QUOTE + Everything should be made as simple as possible, + but not any simpler -- Albert Einstein + #+END_QUOTE +#+end_example + +If you would like to center some text, do it like this: +#+cindex: #+BEGIN_CENTER +#+begin_example + #+BEGIN_CENTER + Everything should be made as simple as possible, \\ + but not any simpler + #+END_CENTER +#+end_example + +*** Footnote markup + :PROPERTIES: + :DESCRIPTION: Footnotes + :END: +#+cindex: footnotes, markup rules +#+cindex: @file{footnote.el} + +Footnotes defined in the way described in [[Creating footnotes]], will be exported +by all backends. Org allows multiple references to the same note, and +multiple footnotes side by side. + +*** Emphasis and monospace + :PROPERTIES: + :DESCRIPTION: Bold, italic, etc. + :END: + +#+cindex: underlined text, markup rules +#+cindex: bold text, markup rules +#+cindex: italic text, markup rules +#+cindex: verbatim text, markup rules +#+cindex: code text, markup rules +#+cindex: strike-through text, markup rules + +You can make words **bold**, //italic//, _underlined_, ~=code=~ +and ~~verbatim~~, and, if you must, {{{samp(+strike-through+)}}}. Text +in the code and verbatim string is not processed for Org mode specific +syntax; it is exported verbatim. + +*** Horizontal rules + :PROPERTIES: + :DESCRIPTION: Make a line + :END: +#+cindex: horizontal rules, markup rules + +A line consisting of only dashes, and at least 5 of them, will be +exported as a horizontal line (~<hr/>~ in HTML and ~\hrule~ +in LaTeX). + +*** Comment lines + :PROPERTIES: + :DESCRIPTION: What will *not* be exported + :END: +#+cindex: comment lines +#+cindex: exporting, not +#+cindex: #+BEGIN_COMMENT + +Lines starting with zero or more whitespace characters followed by one +{{{samp(#)}}} and a whitespace are treated as comments and will never +be exported. Also entire subtrees starting with the word +{{{samp(COMMENT)}}} will never be exported. Finally, regions +surrounded by {{{samp(#+BEGIN_COMMENT)}}} ... +{{{samp(#+END_COMMENT)}}} will not be exported. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c ;)}}} :: + #+kindex: C-c ; + + Toggle the COMMENT keyword at the beginning of an entry. + +** Images and tables + :PROPERTIES: + :DESCRIPTION: Tables and images can be exported + :END: + +#+cindex: tables, markup rules +#+cindex: #+CAPTION +#+cindex: #+LABEL + +Both the native Org mode tables (see [[Tables]]) and tables formatted with +the {{{file(table.el)}}} package will be exported properly. For Org +mode tables, the lines before the first horizontal separator line will +become table header lines. You can use the following lines somewhere +before the table to assign a caption and a label for cross references, +and in the text you can refer to the object with +~\ref{tab:basic-data}~: + +#+begin_example + #+CAPTION: This is the caption for the next table (or link) + #+LABEL: tab:basic-data + | ... | ...| + |-----|----| +#+end_example + +Optionally, the caption can take the form: +#+begin_example + #+CAPTION: [Caption for list of figures]{Caption for table (or link).} +#+end_example + +#+cindex: inlined images, markup rules + +Some backends (HTML, LaTeX, and DocBook) allow you to directly +include images into the exported document. Org does this, if a link to +an image files does not have a description part, for example +~[[./img/a.jpg]]~. If you wish to define a caption for the image and maybe +a label for internal cross references, make sure that the link is on a +line by itself and precede it with ~#+CAPTION~ and ~#+LABEL~ as +follows: + +#+begin_example + #+CAPTION: This is the caption for the next figure link (or table) + #+LABEL: fig:SED-HR4049 + [[./img/a.jpg]] +#+end_example + +You may also define additional attributes for the figure. As this is +backend-specific, see the sections about the individual backends for +more information. + +See [[Handling links][the discussion of image links]]. + +** Literal examples + :PROPERTIES: + :DESCRIPTION: Source code examples with special formatting + :END: +#+cindex: literal examples, markup rules +#+cindex: code line references, markup rules + +You can include literal examples that should not be subjected to +markup. Such examples will be typeset in monospace, so this is well +suited for source code and similar examples. +#+cindex: #+BEGIN_EXAMPLE + +#+begin_example + ,#+BEGIN_EXAMPLE + Some example from a text file. + ,#+END_EXAMPLE +#+end_example + +Note that such blocks may be /indented/ in order to align nicely with +indented text and in particular with plain list structure (see [[Plain +lists]]). For simplicity when using small examples, you can also start +the example lines with a colon followed by a space. There may also be +additional whitespace before the colon: + +#+begin_example + Here is an example + : Some example from a text file. +#+end_example + +#+cindex: formatting source code, markup rules + +If the example is source code from a programming language, or any +other text that can be marked up by font-lock in Emacs, you can ask +for the example to look like the fontified Emacs buffer.[fn:102] This +is done with the {{{samp(src)}}} block, where you also need to specify +the name of the major mode that should be used to fontify the example, +see [[Easy templates]] for shortcuts to easily insert code blocks.[fn:103] + +#+cindex: #+BEGIN_SRC + +#+begin_example + #+BEGIN_SRC emacs-lisp + (defun org-xor (a b) + "Exclusive or." + (if a (not b) b)) + #+END_SRC +#+end_example + +Both in ~example~ and in ~src~ snippets, you can add a ~-n~ switch to +the end of the ~BEGIN~ line, to get the lines of the example numbered. +If you use a ~+n~ switch, the numbering from the previous numbered +snippet will be continued in the current one. In literal examples, Org +will interpret strings like {{{samp((ref:name))}}} as labels, and use +them as targets for special hyperlinks like ~[[(name)]]~ (i.e., the +reference name enclosed in single parenthesis). In HTML, hovering the +mouse over such a link will remote-highlight the corresponding code +line, which is kind of cool. + +You can also add a ~-r~ switch which /removes/ the labels from the +source code.[fn:104] With the ~-n~ switch, links to these references +will be labeled by the line numbers from the code listing, otherwise +links will use the labels with no parentheses. Here is an example: + +#+begin_example + #+BEGIN_SRC emacs-lisp -n -r + (save-excursion (ref:sc) + (goto-char (point-min)) (ref:jump) + #+END_SRC + In line [[(sc)]] we remember the current position. [[(jump)][Line (jump)]] + jumps to point-min. +#+end_example + +#+vindex: org-coderef-label-format + +If the syntax for the label format conflicts with the language syntax, +use a ~-l~ switch to change the format, for example +{{{samp(#+BEGIN_SRC pascal -n -r -l "((%s))")}}}. See also the +variable ~org-coderef-label-format~. + +HTML export also allows examples to be published as text areas +(see [[Text areas in HTML export]]). + +Because the ~#+BEGIN_...~ and ~#+END_...~ patterns need to be added so +often, shortcuts are provided using the Easy Templates facility (see +[[Easy templates]]). + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c ')}}} :: + #+kindex: C-c ' + + Edit the source code example at point in its native mode. This works + by switching to a temporary buffer with the source code. You need to + exit by pressing {{{kbd(C-c ')}}} again.[fn:105] The edited version + will then replace the old version in the Org buffer. Fixed-width + regions (where each line starts with a colon followed by a space) will + be edited using ~artist-mode~ to allow creating ASCII drawings + easily.[fn:106] Using this command in an empty line will create a new + fixed-width region. + +- {{{kbd(C-c l)}}} :: + #+kindex: C-c l + + Calling ~org-store-link~ while editing a source code example in a + temporary buffer created with {{{kbd(C-c ')}}} will prompt for a + label. Make sure that it is unique in the current buffer, and insert + it with the proper formatting like {{{samp((ref:label))}}} at the end + of the current line. Then the label is stored as a link + {{{samp((label))}}}, for retrieval with {{{kbd(C-c C-l)}}}. + +** Include files + :PROPERTIES: + :DESCRIPTION: Include additional files into a document + :END: +#+cindex: include files, markup rules + +During export, you can include the content of another file. For +example, to include your {{{file(.emacs)}}} file, you could use: + +#+cindex: #+INCLUDE + +#+begin_example + ,#+INCLUDE: "~/.emacs" src emacs-lisp +#+end_example + +{{{noindent}}} The optional second and third parameter are the markup +(e.g., {{{samp(quote)}}}, {{{samp(example)}}}, or {{{samp(src)}}}), +and, if the markup is {{{samp(src)}}}, the language for formatting the +contents. The markup is optional; if it is not given, the text will be +assumed to be in Org mode format and will be processed normally. The +include line will also allow additional keyword parameters ~:prefix1~ +and ~:prefix~ to specify prefixes for the first line and for each +following line, ~:minlevel~ in order to get Org mode content demoted +to a specified level, as well as any options accepted by the selected +markup. For example, to include a file as an item, use: + +#+begin_example + ,#+INCLUDE: "~/snippets/xx" :prefix1 " + " :prefix " " +#+end_example + +You can also include a portion of a file by specifying a lines range +using the ~:lines~ parameter. The line at the upper end of the range +will not be included. The start and/or the end of the range may be +omitted to use the obvious defaults. + +#+attr_texinfo: :table-type table :indic @asis +- #+INCLUDE: "~/.emacs" :lines "5-10" :: + + Include lines 5 to 10, 10 excluded. + +- #+INCLUDE: "~/.emacs" :lines "-10" :: + + Include lines 1 to 10, 10 excluded. + +- #+INCLUDE: "~/.emacs" :lines "10-" :: + + Include lines from 10 to EOF. + + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c ')}}} + #+kindex: C-c ' + + Visit the include file at point. + +** Index entries + :PROPERTIES: + :DESCRIPTION: Making an index + :END: +#+cindex: index entries, for publishing + +You can specify entries that will be used for generating an index +during publishing. This is done by lines starting with ~#+INDEX~. An +entry the contains an exclamation mark will create a sub item. See +[[Generating an index]] for more information. + +#+begin_example + ,* Curriculum Vitae + #+INDEX: CV + #+INDEX: Application!CV +#+end_example + +** Macro replacement + :PROPERTIES: + :DESCRIPTION: Use macros to create complex output + :END: +#+cindex: macro replacement, during export +#+cindex: #+MACRO + +You can define text snippets with a macro: + +#+begin_example + ,#+MACRO: name replacement text $1, $2 are arguments +#+end_example + +{{{noindent}}} which can be referenced anywhere in the document (even in +code examples) with ~{{{name(arg1,arg2)}}}~. In addition to +defined macros, ~{{{title}}}~, ~{{{author}}}~, etc., +will reference information set by the ~#+TITLE:~, ~#+AUTHOR:~, and +similar lines. Also, ~{{{date(FORMAT)}}}~ and +~{{{modification-time(FORMAT)}}}~ refer to current date time +and to the modification time of the file being exported, respectively. +~FORMAT~ should be a format string understood by +~format-time-string~. + +Macro expansion takes place during export, and some people use it to +construct complex HTML code. + +** FIXME Embedded LaTeX + :PROPERTIES: + :DESCRIPTION: LaTeX can be freely used inside Org documents + :ALT_TITLE: Embedded Latex + :END: +#+cindex: @TeX{} interpretation +#+cindex: @LaTeX{} interpretation + +Plain ASCII is normally sufficient for almost all note taking. +Exceptions include scientific notes, which often require mathematical +symbols and the occasional formula. LaTeX is widely used to typeset +scientific documents.[fn:107] Org mode supports embedding LaTeX +code into its files, because many academics are used to writing and +reading LaTeX source code, and because it can be readily processed +to produce pretty output for a number of export backends. + +*** Special symbols + :PROPERTIES: + :DESCRIPTION: Greek letters and other symbols + :END: +#+cindex: math symbols +#+cindex: special symbols +#+cindex: @TeX{} macros +#+cindex: @LaTeX{} fragments, markup rules +#+cindex: HTML entities +#+cindex: @LaTeX{} entities + +You can use LaTeX macros to insert special symbols like +~\alpha~ to indicate the Greek letter, or ~\to~ to +indicate an arrow. Completion for these macros is available, just type +~\~ and maybe a few letters, and press {{{kbdkey(M-,TAB)}}} +to see possible completions. Unlike LaTeX code, Org mode allows +these macros to be present without surrounding math delimiters, for +example: + +#+begin_example + Angles are written as Greek letters \alpha, \beta and \gamma. +#+end_example + +#+vindex: org-entities + +During export, these symbols will be transformed into the native +format of the exporter backend. Strings like ~\alpha~ will be exported +as ~α~ in the HTML output, and as ~$\alpha$~ in the LaTeX +output. Similarly, ~\nbsp~ will become ~ ~ in HTML and ~~~ in +LaTeX. If you need such a symbol inside a word, terminate it like +this: ~\Aacute{}stor~. + +A large number of entities is provided, with names taken from both +HTML and LaTeX; see the variable ~org-entities~ for the complete +list. ~\-~ is treated as a shy hyphen, and {{{samp(--)}}}, +{{{samp(---)}}}, and {{{samp(...)}}} are all converted into special +commands creating hyphens of different lengths or a compact set of +dots. + +If you would like to see entities displayed as UTF8 characters, use the +following command:[fn:108] + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x XXX)}}} :: + #+kindex: C-c C-x XXX +# Should be \ + Toggle display of entities as UTF-8 characters. This does not change + the buffer content which remains plain ASCII, but it overlays the + UTF-8 character for display purposes only. + +*** FIXME Subscripts and superscripts + :PROPERTIES: + :DESCRIPTION: Simple syntax for raising/lowering text + :END: +#+cindex: subscript +#+cindex: superscript + +Just like in LaTeX, {{{samp(^)}}} and {{{samp(_)}}} are used to +indicate super- and subscripts. Again, these can be used without +embedding them in math-mode delimiters. To increase the readability of +ASCII text, it is not necessary (but OK) to surround multi-character +sub- and superscripts with curly braces. For example + +#+begin_example + The mass of the sun is M_sun = 1.989 x 10^30 kg. The radius of + the sun is R_{sun} = 6.96 x 10^8 m. +#+end_example + +#+vindex: org-export-with-sub-superscripts + +To avoid interpretation as raised or lowered text, you can quote +{{{kbd(^)}}} and {{{kbd(_)}}} with a backslash: ~\^~ and ~\_~. If you +write a text where the underscore is often used in a different +context, Org's convention to always interpret these as subscripts can +get in your way. Configure the variable +~org-export-with-sub-superscripts~ to globally change this convention, +or use, on a per-file basis: + +#+begin_example + ,#+OPTIONS: ^:{} +#+end_example + +{{{noindent}}} With this setting, ~a_b~ will not be interpreted as a +subscript, but ~a_{b}~ will. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x XXX)}}} :: + #+kindex: C-c C-x XXX +# Should be \ + In addition to showing entities as UTF-8 characters, this command will + also format sub- and superscripts in a WYSIWYM way. + +*** LaTeX fragments + :PROPERTIES: + :DESCRIPTION: Complex formulas made easy + :END: +#+cindex: @LaTeX{} fragments +#+vindex: org-format-latex-header + +Going beyond symbols and sub- and superscripts, a full formula +language is needed. Org mode can contain LaTeX math fragments, and +it supports ways to process these for several export backends. When +exporting to LaTeX, the code is obviously left as it is. When +exporting to HTML, Org invokes the [[http://www.mathjax.org][MathJax library]] (see [[Math +formatting in HTML export]]) to process and display the math.[fn:109] +Finally, it can also process the mathematical expressions into images +that can be displayed in a browser or in DocBook documents.[fn:110] + +LaTeX fragments don't need any special marking at all. The following +snippets will be identified as LaTeX source code: + +- Environments of any kind.[fn:111] The only requirement is that the + ~\begin~ statement appears on a new line, preceded by only whitespace. + +- Text within the usual LaTeX math delimiters. To avoid conflicts + with currency specifications, single ~$~ characters are + only recognized as math delimiters if the enclosed text contains at + most two line breaks, is directly attached to the ~$~ + characters with no whitespace in between, and if the closing + ~$~ is followed by whitespace, punctuation or a dash. For + the other delimiters, there is no such restriction, so when in + doubt, use ~\(...\)~ as inline math delimiters. + + +{{{noindent}}} For example: + +#+begin_example + \begin{equation} % arbitrary environments, + x=\sqrt{b} % even tables, figures + \end{equation} % etc + + If $a^2=b$ and \( b=2 \), then the solution must be + either $$ a=+\sqrt{2} $$ or \[ a=-\sqrt{2} \]. +#+end_example + +{{{noindent}}} +#+vindex: org-format-latex-options + +If you need any of the delimiter ASCII sequences for other purposes, +you can configure the option ~org-format-latex-options~ to deselect +the ones you do not wish to have interpreted by the LaTeX +converter. + +#+vindex: org-export-with-LaTeX-fragments + +LaTeX processing can be configured with the variable +~org-export-with-LaTeX-fragments~. The default setting is ~t~ which +means {{{file(MathJax)}}} for HTML, and no processing for DocBook, +ASCII and LaTeX backends. You can also set this variable on a +per-file basis using one of these lines: + +#+attr_texinfo: :table-type table :indic @asis +- #+OPTIONS: LaTeX:t :: + + Do the right thing automatically (MathJax). + +- #+OPTIONS: LaTeX:dvipng :: + + Force using dvipng images. + +- #+OPTIONS: LaTeX:nil :: + + Do not process LaTeX fragments at all + +- #+OPTIONS: LaTeX:verbatim :: + + Verbatim export, for jsMath or so. + +*** Previewing LaTeX fragments + :PROPERTIES: + :DESCRIPTION: What will this snippet look like? + :END: +#+cindex: @LaTeX{} fragments, preview + +If you have {{{file(dvipng)}}} installed, LaTeX fragments can be +processed to produce preview images of the typeset expressions: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x C-l)}}} :: + #+kindex: C-c C-x C-l + + Produce a preview image of the LaTeX fragment at point and overlay + it over the source code. If there is no fragment at point, process all + fragments in the current entry (between two headlines). When called + with a prefix argument, process the entire subtree. When called with + two prefix arguments, or when the cursor is before the first headline, + process the entire buffer. + +- {{{kbd(C-c C-c)}}} :: + #+kindex: C-c C-c + + Remove the overlay preview images. + + +#+vindex: org-format-latex-options + +You can customize the variable ~org-format-latex-options~ to influence +some aspects of the preview. In particular, the ~:scale~ (and for HTML +export, ~:html-scale~) property can be used to adjust the size of the +preview images. + +*** CDLaTeX mode + :PROPERTIES: + :DESCRIPTION: Speed up entering of formulas + :TITLE: Using CDLaTeX to enter math + :END: +#+cindex: CD@LaTeX{} + +CDLaTeX mode is a minor mode that is normally used in combination +with a major LaTeX mode like AUCTeX in order to speed-up +insertion of environments and math templates. Inside Org mode, you can +make use of some of the features of CDLaTeX mode. You need to +install {{{file(cdlatex.el)}}} and {{{file(texmathp.el)}}} (the latter +comes also with AUCTeX) from +[[http://www.astro.uva.nl/~dominik/Tools/cdlatex]]. Don't use CDLaTeX +mode itself under Org mode, but use the light version +~org-cdlatex-mode~ that comes as part of Org mode. Turn it on for the +current buffer with ~M-x org-cdlatex-mode~, or for all Org files with +this hook: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(add-hook 'org-mode-hook 'turn-on-org-cdlatex) +#+end_src + +When this mode is enabled, the following features are present (for more +details see the documentation of CDLaTeX mode): + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c {)}}} :: + #+kindex: C-c @{ + + Insert an environment template. + +- {{{key(TAB)}}} :: + #+kindex: @key{TAB} + + Expand a template if the cursor is inside a LaTeX fragment.[fn:112] + For example, {{{key(TAB)}}} will expand ~fr~ to ~\frac{}{}~ and + position the cursor correctly inside the first brace. Another + {{{key(TAB)}}} will get you into the second brace. Even outside + fragments, {{{key(TAB)}}} will expand environment abbreviations at the + beginning of a line. For example, if you write {{{samp(equ)}}} at the + beginning of a line and press {{{key(TAB)}}}, this abbreviation will + be expanded to an ~equation~ environment. To get a list of all + abbreviations, type {{{kbd(M-x cdlatex-command-help)}}}. + +- {{{kbd(_)}}} {{{kbd(^)}}} :: + #+kindex: _ + #+kindex: ^ + #+vindex: cdlatex-simplify-sub-super-scripts + + Pressing {{{kbd(_)}}} and {{{kbd(^)}}} inside a LaTeX fragment will + insert these characters together with a pair of braces. If you use + {{{key(TAB)}}} to move out of the braces, and if the braces surround + only a single character or macro, they are removed again (depending on + the variable ~cdlatex-simplify-sub-super-scripts~). + +- {{{kbd(`)}}} :: + #+kindex: ` + + Pressing the backquote followed by a character inserts math macros, + also outside LaTeX fragments. If you wait more than 1.5 seconds + after the backquote, a help window will pop up. + +- {{{kbd(')}}} :: + #+kindex: ' + + Pressing the single-quote followed by another character modifies the + symbol before point with an accent or a font. If you wait more than + 1.5 seconds after the single-quote, a help window will pop up. + Character modification will work only inside LaTeX fragments; + outside the quote is normal. + +* FIXME Exporting + :PROPERTIES: + :DESCRIPTION: Sharing and publishing notes + :END: +#+cindex: exporting + +Org mode documents can be exported into a variety of other formats. +For printing and sharing of notes, ASCII export produces a readable +and simple version of an Org file. HTML export allows you to publish a +notes file on the web, while the XOXO format provides a solid base for +exchange with a broad range of other applications. LaTeX export +lets you use Org mode and its structured editing functions to easily +create LaTeX files. DocBook export makes it possible to convert Org +files to many other formats using DocBook tools. OpenDocument Text +(ODT) export allows seamless collaboration across organizational +boundaries. For project management you can create gantt and resource +charts by using TaskJuggler export. To incorporate entries with +associated times like deadlines or appointments into a desktop +calendar program like iCal, Org mode can also produce extracts in the +iCalendar format. Currently, Org mode only supports export, not import +of these different formats. + +Org supports export of selected regions when ~transient-mark-mode~ is +enabled (default in Emacs 23). + +** Selective export + :PROPERTIES: + :DESCRIPTION: Using tags to select and exclude trees + :END: +#+cindex: export, selective by tags or TODO keyword +#+vindex: org-export-select-tags +#+vindex: org-export-exclude-tags +#+cindex: org-export-with-tasks + +You may use tags to select the parts of a document that should be exported, +or to exclude parts from export. This behavior is governed by two variables: +~org-export-select-tags~ and ~org-export-exclude-tags~, +respectively defaulting to ~:export:~ and ~:noexport:~. + +1. Org first checks if any of the /select/ tags is present in the + buffer. If yes, all trees that do not carry one of these tags will + be excluded. If a selected tree is a subtree, the heading hierarchy + above it will also be selected for export, but not the text below + those headings. + +2. If none of the select tags is found, the whole buffer will be + selected for export. + +3. Finally, all subtrees that are marked by any of the /exclude/ tags + will be removed from the export buffer. + + +The variable ~org-export-with-tasks~ can be configured to select which +kind of tasks should be included for export. See the docstring of the +variable for more information. + +** FIXME Export options + :PROPERTIES: + :DESCRIPTION: Per-file export settings + :END: +#+cindex: options, for export +#+cindex: completion, of option keywords + +The exporter recognizes special lines in the buffer which provide +additional information. These lines may be put anywhere in the file. +The whole set of lines can be inserted into the buffer with +{{{kbd(C-c C-e t)}}}. For individual lines, a good way to make sure the keyword +is correct is to type {{{samp(#+)}}} and then use {{{kbdkey(M-,TAB)}}} +completion (see [[Completion]]). For a summary of other in-buffer settings +not specifically related to export, see [[In-buffer settings]]. In +particular, note that you can place commonly-used (export) options in +a separate file which can be included using ~#+SETUPFILE~. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e t)}}}, ~org-insert-export-options-template~ :: + #+kindex: C-c C-e t + + Insert template with export options, see example below. + + +#+cindex: #+TITLE +#+cindex: #+AUTHOR +#+cindex: #+DATE +#+cindex: #+EMAIL +#+cindex: #+DESCRIPTION +#+cindex: #+KEYWORDS +#+cindex: #+LANGUAGE +#+cindex: #+TEXT +#+cindex: #+OPTIONS +#+cindex: #+BIND +#+cindex: #+LINK_UP +#+cindex: #+LINK_HOME +#+cindex: #+EXPORT_SELECT_TAGS +#+cindex: #+EXPORT_EXCLUDE_TAGS +#+cindex: #+XSLT +#+cindex: #+LaTeX_HEADER +#+vindex: user-full-name +#+vindex: user-mail-address +#+vindex: org-export-default-language +#+vindex: org-export-date-timestamp-format + +#+attr_texinfo: :table-type table :indic @asis +- #+TITLE: :: + + The title to be shown (default is the buffer name). + +- #+AUTHOR: :: + + The author (default taken from ~user-full-name~). + +- #+DATE: :: + + A date, an Org timestamp, or a format string for + ~format-time-string~.[fn:113] + +- #+EMAIL: :: + + His/her email address (default from ~user-mail-address~). + +- #+DESCRIPTION: :: + + The page description, e.g., for the XHTML meta tag. + +- #+KEYWORDS: :: + + The page keywords, e.g., for the XHTML meta tag. + +- #+LANGUAGE: :: + + Language for HTML, e.g., en (~org-export-default-language~). + +- #+TEXT: :: + + Some descriptive text to be inserted at the beginning. + +- #+TEXT: :: + + Several lines may be given. + +- #+OPTIONS: :: + + H:2 num:t toc:t \n:nil @:t ::t |:t ^:t f:t TeX:t ... + +- #+BIND: :: + + Lisp-var lisp-val, e.g., org-export-latex-low-levels itemize. You need + to confirm using these, or configure ~org-export-allow-BIND~. + +- #+LINK_UP: :: + + The ``up'' link of an exported page. + +- #+LINK_HOME: :: + + The ``home'' link of an exported page. + +- #+LaTeX_HEADER: :: + + Extra line(s) for the LaTeX header, like ~\usepackage{xyz}~. + +- #+EXPORT_SELECT_TAGS: :: + + Tags that select a tree for export. + +- #+EXPORT_EXCLUDE_TAGS: :: + + Tags that exclude a tree from export. + +- #+XSLT: :: + + The XSLT stylesheet used by DocBook exporter to generate FO file. + + + +{{{noindent}}} The ~#+OPTIONS~ line is a compact form to specify +export settings.[fn:114] Here you can: + +#+cindex: headline levels +#+cindex: section-numbers +#+cindex: table of contents +#+cindex: line-break preservation +#+cindex: quoted HTML tags +#+cindex: fixed-width sections +#+cindex: tables +#+cindex: @TeX{}-like syntax for sub- and superscripts +#+cindex: footnotes +#+cindex: special strings +#+cindex: emphasized text +#+cindex: @TeX{} macros +#+cindex: @LaTeX{} fragments +#+cindex: author info, in export +#+cindex: time info, in export +#+vindex: org-export-plist-vars +#+vindex: org-export-author-info +#+vindex: org-export-creator-info +#+vindex: org-export-email-info +#+vindex: org-export-time-stamp-file + +#+attr_texinfo: :table-type table :indic @code +- H: :: + + Set the number of headline levels for export. + +- num: :: + + Turn on/off section-numbers. + +- toc: :: + + Turn on/off table of contents, or set level limit (integer). + +- \n: :: + + Turn on/off line-break-preservation (DOES NOT WORK). + +- @: :: + + Turn on/off quoted HTML tags. + +- :: :: + + Turn on/off fixed-width sections. + +- |: :: + + Turn on/off tables, + +- ^: :: + + Turn on/off TeX-like syntax for sub- and superscripts. If you write + "^:{}", ~a_{b}~ will be interpreted, but the simple ~a_b~ will be left + as it is. + +- : :: + + Turn on/off conversion of special strings. + +- f: :: + + Turn on/off footnotes like this: ~[1]~. + +- todo: :: + + Turn on/off inclusion of TODO keywords into exported text. + +- tasks: :: + + Turn on/off inclusion of tasks (TODO items), can be nil to remove all + tasks, ~todo~ to remove DONE tasks, or list of keywords to keep. + +- pri: :: + + Turn on/off priority cookies. + +- tags: :: + + Turn on/off inclusion of tags, may also be ~not-in-toc~. + +- <: :: + + Turn on/off inclusion of any time/date stamps like DEADLINES. + +- *: :: + + Turn on/off emphasized text (bold, italic, underlined). + +- TeX: :: + + Turn on/off simple TeX macros in plain text. + +- LaTeX: :: + + Configure export of LaTeX fragments. Default ~auto~. + +- skip: :: + + Turn on/off skipping the text before the first heading. + +- author: :: + + Turn on/off inclusion of author name/email into exported file. + +- email: :: + + Turn on/off inclusion of author email into exported file. + +- creator: :: + + Turn on/off inclusion of creator info into exported file. + +- timestamp: :: + + Turn on/off inclusion creation time into exported file. + +- d: :: + + Turn on/off inclusion of drawers, or list drawers to include. + + +{{{noindent}}} These options take effect in both the HTML and LaTeX +export, except for ~TeX~ and ~LaTeX~ options, which are respectively +~t~ and ~nil~ for the LaTeX export. + +The default values for these and many other options are given by a set +of variables. For a list of such variables, the corresponding OPTIONS +keys and also the publishing keys (see [[Project alist]]), see the +constant ~org-export-plist-vars~. + +When exporting only a single subtree by selecting it with +{{{kbd(C-c @)}}} before calling an export command, the subtree can +overrule some of the file's export settings with properties +~EXPORT_FILE_NAME~, ~EXPORT_TITLE~, ~EXPORT_TEXT~, ~EXPORT_AUTHOR~, +~EXPORT_DATE~, and ~EXPORT_OPTIONS~. + +** The export dispatcher + :PROPERTIES: + :DESCRIPTION: How to access exporter commands + :END: +#+cindex: dispatcher, for export commands + +All export commands can be reached using the export dispatcher, which +is a prefix key that prompts for an additional key specifying the +command. Normally the entire file is exported, but if there is an +active region that contains one outline tree, the first heading is +used as document title and the subtrees are exported. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e)}}}, ~org-export~ :: + #+kindex: C-c C-e + #+vindex: org-export-run-in-background + + Dispatcher for export and publishing commands. Displays a help-window + listing the additional key(s) needed to launch an export or publishing + command. The prefix arg is passed through to the exporter. A double + prefix {{{kbd(C-u C-u)}}} causes most commands to be executed in the + background, in a separate Emacs process.[fn:115] + +- {{{kbd(C-c C-e v)}}}, ~org-export-visible~ :: + #+kindex: C-c C-e v + + Like {{{kbd(C-c C-e)}}}, but only export the text that is currently visible + (i.e., not hidden by outline visibility). + +- {{{kbd(C-u C-u C-c C-e)}}}, ~org-export~ :: + #+kindex: C-u C-u C-c C-e + #+vindex: org-export-run-in-background + + Call the exporter, but reverse the setting of + ~org-export-run-in-background~, i.e., request background processing if + not set, or force processing in the current Emacs process if set. + +** ASCII/Latin-1/UTF-8 export + :PROPERTIES: + :DESCRIPTION: Exporting to flat files with encoding + :END: +#+cindex: ASCII export +#+cindex: Latin-1 export +#+cindex: UTF-8 export + +ASCII export produces a simple and very readable version of an Org +mode file, containing only plain ASCII. Latin-1 and UTF-8 export +augment the file with special characters and symbols available in +these encodings. + +#+cindex: region, active +#+cindex: active region +#+cindex: transient-mark-mode + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e a)}}}, ~org-export-as-ascii~ :: + #+kindex: C-c C-e a + #+cindex: property, EXPORT_FILE_NAME + + Export as an ASCII file. For an Org file, {{{file(myfile.org)}}}, the + ASCII file will be {{{file(myfile.txt)}}}. The file will be + overwritten without warning. If there is an active region, only the + region will be exported.[fn:116] If the selected region is a single + tree, the tree head will become the document title.[fn:117] If the + tree head entry has or inherits an ~EXPORT_FILE_NAME~ property, that + name will be used for the export. + +- {{{kbd(C-c C-e A)}}}, ~org-export-as-ascii-to-buffer~ :: + #+kindex: C-c C-e A + + Export to a temporary buffer. Do not create a file. + +- {{{kbd(C-c C-e n)}}}, ~org-export-as-latin1~ :: + #+kindex: C-c C-e n + + Like {{{kbd(C-c C-e a)}}}, but use Latin-1 encoding. + +- {{{kbd(C-c C-e N)}}}, ~org-export-as-latin1-to-buffer~ :: + #+kindex: C-c C-e N + + Like {{{kbd(C-c C-e A)}}}, but use Latin-1 encoding. + +- {{{kbd(C-c C-e u)}}}, ~org-export-as-utf8~ :: + #+kindex: C-c C-e u + + Like {{{kbd(C-c C-e a)}}}, but use UTF-8 encoding. + +- {{{kbd(C-c C-e U)}}}, ~org-export-as-utf8-to-buffer~ :: + #+kindex: C-c C-e U + + Like {{{kbd(C-c C-e A)}}}, but use UTF-8 encoding. + + +- {{{kbd(C-c C-e v a/n/u)}}} :: + #+kindex: C-c C-e v a + #+kindex: C-c C-e v n + #+kindex: C-c C-e v u + + Export only the visible part of the document. + + +#+cindex: headline levels, for exporting + +In the exported version, the first 3 outline levels will become +headlines, defining a general document structure. Additional levels +will be exported as itemized lists. If you want that transition to +occur at a different level, specify it with a prefix argument, e.g.: + +#+begin_example + C-1 C-c C-e a +#+end_example + +{{{noindent}}} This setting creates only top level headlines and +exports the rest as items. When headlines are converted to items, the +indentation of the text following the headline is changed to fit +nicely under the item. This is done with the assumption that the first +body line indicates the base indentation of the body text. Any +indentation larger than this is adjusted to preserve the layout +relative to the first line. Should there be lines with less +indentation than the first one, these are left alone. + +#+vindex: org-export-ascii-links-to-notes + +Links will be exported in a footnote-like style, with the descriptive +part in the text and the link in a note before the next heading. See +the variable ~org-export-ascii-links-to-notes~ for details and other +options. + +** HTML export + :PROPERTIES: + :DESCRIPTION: Exporting to HTML + :END: +#+cindex: HTML export +#+cindex: Gruber, John + +Org mode contains a HTML (XHTML 1.0 strict) exporter with extensive +HTML formatting, in ways similar to John Gruber's /markdown/ language, +but with additional support for tables. + +*** HTML export commands + :PROPERTIES: + :DESCRIPTION: How to invoke HTML export + :END: +#+cindex: region, active +#+cindex: active region +#+cindex: transient-mark-mode + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e h)}}}, ~org-export-as-html~ :: + #+kindex: C-c C-e h + #+cindex: property, EXPORT_FILE_NAME + + Export as an HTML file. For an Org file {{{file(myfile.org)}}}, the + HTML file will be {{{file(myfile.html)}}}. The file will be + overwritten without warning. If there is an active region, only the + active region will be exported.[fn:118] If the selected region is a + single tree, the tree head will become the document title.[fn:119] If + the tree head entry has, or inherits, an ~EXPORT_FILE_NAME~ property, + that name will be used for the export. + +- {{{kbd(C-c C-e b)}}}, ~org-export-as-html-and-open~ :: + #+kindex: C-c C-e b + + Export as a HTML file and immediately open it with a browser. + +- {{{kbd(C-c C-e H)}}}, ~org-export-as-html-to-buffer~ :: + #+kindex: C-c C-e H + + Export to a temporary buffer. Do not create a file. + +- {{{kbd(C-c C-e R)}}}, ~org-export-region-as-html~ :: + #+kindex: C-c C-e R + + Export the active region to a temporary buffer. With a prefix + argument, do not produce the file header and footer, but just the + plain HTML section for the region. This is good for cut-and-paste + operations. + +- {{{kbd(C-c C-e v h/b/H/R)}}} :: + #+kindex: C-c C-e v h + #+kindex: C-c C-e v b + #+kindex: C-c C-e v H + #+kindex: C-c C-e v R + + Export only the visible part of the document. + +- {{{kbd(M-x org-export-region-as-html)}}} :: + + Convert the region to HTML under the assumption that it was in Org + mode syntax before. This is a global command that can be invoked in + any buffer. + +- {{{kbd(M-x org-replace-region-by-HTML)}}} :: + + Replace the active region (assumed to be in Org mode syntax) by HTML + code. + + +#+cindex: headline levels, for exporting + +In the exported version, the first three outline levels will become +headlines, defining a general document structure. Additional levels +will be exported as itemized lists. If you want that transition to +occur at a different level, specify it with a numeric prefix argument, +e.g.: + +#+begin_example + C-2 C-c C-e b +#+end_example + +{{{noindent}}} This setting creates two levels of headings and exports +the rest as list items. + +*** HTML preamble and postamble + :PROPERTIES: + :DESCRIPTION: How to insert a preamble and postamble + :END: +#+vindex: org-export-html-preamble +#+vindex: org-export-html-postamble +#+vindex: org-export-html-preamble-format +#+vindex: org-export-html-postamble-format +#+vindex: org-export-html-validation-link +#+vindex: org-export-author-info +#+vindex: org-export-email-info +#+vindex: org-export-creator-info +#+vindex: org-export-time-stamp-file + +The HTML exporter lets you define a preamble and a postamble. + +The default value for ~org-export-html-preamble~ is ~t~, which means +that the preamble is inserted depending on the relevant format string +in ~org-export-html-preamble-format~. + +Setting ~org-export-html-preamble~ to a string will override the default +format string. Setting it to a function, will insert the output of the +function, which must be a string; such a function takes no argument but you +can check against the value of ~opt-plist~, which contains the list of +publishing properties for the current file. Setting to ~nil~ will not +insert any preamble. + +The default value for ~org-export-html-postamble~ is +{{{samp('auto)}}}, which means that the HTML exporter will look for +the value of ~org-export-author-info~, ~org-export-email-info~, +~org-export-creator-info~ and ~org-export-time-stamp-file~, +~org-export-html-validation-link~ and build the postamble from these +values. Setting ~org-export-html-postamble~ to ~t~ will insert the +postamble from the relevant format string found in +~org-export-html-postamble-format~. Setting it to ~nil~ will not +insert any postamble. + +*** Quoting HTML tags + :PROPERTIES: + :DESCRIPTION: Using direct HTML in Org mode + :END: + +Plain ~<~ and {{{samp(>)}}} are always transformed to +{{{samp(<)}}} and {{{samp(>)}}} in HTML export. If you want to +include simple HTML tags which should be interpreted as such, mark +them with {{{samp(@)}}} as in {{{samp(@<b>bold text@</b>)}}}. Note +that this really works only for simple tags. For more extensive HTML +that should be copied verbatim to the exported file use either ~#+HTML~: + +#+cindex: #+HTML +#+cindex: #+BEGIN_HTML +#+begin_example + ,#+HTML: Literal HTML code for export +#+end_example + +{{{noindent}}} or an HTML block: +#+cindex: #+BEGIN_HTML + +#+begin_example + #+BEGIN_HTML + All lines between these markers are exported literally + #+END_HTML +#+end_example + +*** Links in HTML export + :PROPERTIES: + :DESCRIPTION: How links will be interpreted and formatted + :END: +#+cindex: links, in HTML export +#+cindex: internal links, in HTML export +#+cindex: external links, in HTML export + +Internal links (see [[Internal links]]) will continue to work in HTML. +This includes automatic links created by radio targets (see [[Radio +targets]]). Links to external files will still work if the target file +is on the same /relative/ path as the published Org file. Links to +other {{{file(.org)}}} files will be translated into HTML links under +the assumption that a HTML version also exists of the linked file, at +the same relative path. ~id:~ links can then be used to jump +to specific entries across files. For information related to linking +files while publishing them to a publishing directory see [[Publishing +links]]. + +If you want to specify attributes for links, you can do so using a +special ~#+ATTR_HTML~ line to define attributes that will be added to +the ~<a>~ or ~<img>~ tags. Here is an example that sets ~title~ and +~style~ attributes for a link: + +#+cindex: #+ATTR_HTML +#+begin_example + ,#+ATTR_HTML: title="The Org mode homepage" style="color:red;" + ,[[http://orgmode.org]] +#+end_example + +*** Tables in HTML export + :PROPERTIES: + :DESCRIPTION: How to modify the formatting of tables + :END: +#+cindex: tables, in HTML +#+vindex: org-export-html-table-tag + +Org mode tables are exported to HTML using the table tag defined in +~org-export-html-table-tag~. The default setting makes tables without +cell borders and frame. If you would like to change this for +individual tables, place something like the following before the +table: + +#+cindex: #+CAPTION +#+cindex: #+ATTR_HTML +#+begin_example + ,#+CAPTION: This is a table with lines around and between cells + ,#+ATTR_HTML: border="2" rules="all" frame="border" +#+end_example + +*** Images in HTML export + :PROPERTIES: + :DESCRIPTION: How to insert figures into HTML output + :END: +#+cindex: images, inline in HTML +#+cindex: inlining images in HTML +#+vindex: org-export-html-inline-images + +HTML export can inline images given as links in the Org file, and it +can make an image the clickable part of a link. By default, images are +inlined if a link does not have a description.[fn:120] So +~[[file:myimg.jpg]]~ will be inlined, while ~[[file:myimg.jpg][the +image]]~ will just produce a link {{{samp(the image)}}} that points to +the image. If the description part itself is a ~file:~ link or +a ~http:~ URL pointing to an image, this image will be inlined and +activated so that clicking on the image will activate the link. For +example, to include a thumbnail that will link to a high resolution +version of the image, you could use: + +#+begin_example + [[file:highres.jpg][file:thumb.jpg]] +#+end_example + +If you need to add attributes to an inlined image, use a ~#+ATTR_HTML~. +In the example below we specify the ~alt~ and ~title~ attributes to +support text viewers and accessibility, and align it to the right. + +#+cindex: #+CAPTION +#+cindex: #+ATTR_HTML +#+begin_example + ,#+CAPTION: A black cat stalking a spider + ,#+ATTR_HTML: alt="cat/spider image" title="Action!" align="right" + [[./img/a.jpg]] +#+end_example + +{{{noindent}}} You could use ~http~ addresses just as well. + +*** Math formatting in HTML export + :PROPERTIES: + :DESCRIPTION: Beautiful math also on the web + :END: +#+cindex: MathJax +#+cindex: dvipng + +LaTeX math snippets (see [[LaTeX fragments]]) can be displayed in two +different ways on HTML pages. The default is to use the [[http://www.mathjax.org][MathJax system]] +which should work out of the box with Org mode installation because +~http://orgmode.org~ serves {{{file(MathJax)}}} for Org mode users for +small applications and for testing purposes.[fn:121] To configure +{{{file(MathJax)}}}, use the variable +~org-export-html-mathjax-options~ or insert something like the +following into the buffer: + +#+begin_example + ,#+MATHJAX: align:"left" mathml:t path:"/MathJax/MathJax.js" +#+end_example + +{{{noindent}}} See the docstring of the variable +~org-export-html-mathjax-options~ for the meaning of the parameters in +this line. + +If you prefer, you can also request that LaTeX fragments are +processed into small images that will be inserted into the browser +page. Before the availability of MathJax, this was the default method +for Org files. This method requires that the {{{file(dvipng)}}} +program is available on your system. You can still get this processing +with the following option: + +#+begin_example + ,#+OPTIONS: LaTeX:dvipng +#+end_example + +*** Text areas in HTML export + :PROPERTIES: + :DESCRIPTION: An alternate way to show an example + :END: +#+cindex: text areas, in HTML + +An alternative way to publish literal code examples in HTML is to use +text areas, where the example can even be edited before pasting it +into an application. It is triggered by a ~-t~ switch at an ~example~ +or ~src~ block. Using this switch disables any options for syntax and +label highlighting, and line numbering, which may be present. You may +also use ~-h~ and ~-w~ switches to specify the height and width of the +text area, which default to the number of lines in the example, and +80, respectively. For example + +#+begin_example + ,#+BEGIN_EXAMPLE -t -w 40 + (defun org-xor (a b) + "Exclusive or." + (if a (not b) b)) + ,#+END_EXAMPLE +#+end_example + +*** CSS support + :PROPERTIES: + :DESCRIPTION: Changing the appearance of the output + :END: +#+cindex: CSS, for HTML export +#+cindex: HTML export, CSS +#+vindex: org-export-html-todo-kwd-class-prefix +#+vindex: org-export-html-tag-class-prefix + +You can also give style information for the exported file. The HTML +exporter assigns the following special CSS classes to appropriate +parts of the document---your style specifications may change these, in +addition to any of the standard classes like for headlines, tables, +etc.[fn:122] + +#+attr_texinfo: :table-type table :indic @code +- p.author :: author information, including email +- p.date :: publishing date +- p.creator :: creator info, about org mode version +- .title :: document title +- .todo :: TODO keywords, all not-done states +- .done :: the DONE keywords, all states that count as done +- .WAITING :: each TODO keyword also uses a class named after itself +- .timestamp :: timestamp +- .timestamp-kwd :: keyword associated with a timestamp, like SCHEDULED +- .timestamp-wrapper :: span around keyword plus timestamp +- .tag :: tag in a headline +- ._HOME :: each tag uses itself as a class, "@" replaced by "_" +- .target :: target for links +- .linenr :: the line number in a code example +- .code-highlighted :: for highlighting referenced code lines +- div.outline-N :: div for outline level N (headline plus text)) +- div.outline-text-N :: extra div for text at outline level N +- .section-number-N :: section number in headlines, different for each level +- div.figure :: how to format an inlined image +- pre.src :: formatted source code +- pre.example :: normal example +- p.verse :: verse paragraph +- div.footnotes :: footnote section headline +- p.footnote :: footnote definition paragraph, containing a footnote +- .footref :: a footnote reference number (always a <sup>) +- .footnum :: footnote number in footnote definition (always <sup>) + + +#+vindex: org-export-html-style-default +#+vindex: org-export-html-style-include-default +#+vindex: org-export-html-style +#+vindex: org-export-html-extra +#+vindex: org-export-html-style-default + +Each exported file contains a compact default style that defines these +classes in a basic way.[fn:123] You may overwrite these +settings, or add to them by using the variables ~org-export-html-style~ +(for Org-wide settings) and ~org-export-html-style-extra~ (for more +fine-grained settings, like file-local settings). To set the latter variable +individually for each file, you can use a ~#+STYLE:~ line: + +#+cindex: #+STYLE +#+begin_example + ,#+STYLE: <link rel="stylesheet" type="text/css" href="stylesheet.css" /> +#+end_example + +{{{noindent}}} For longer style definitions, you can use several such +lines. You could also directly write a ~<style>~ ~</style>~ section in +this way, without referring to an external file. + +In order to add styles to a subtree, use the ~:HTML_CONTAINER_CLASS:~ +property to assign a class to the tree. In order to specify CSS styles +for a particular headline, you can use the id specified in a +~:CUSTOM_ID:~ property. + +# FIXME: More about header and footer styles +# FIXME: Talk about links and targets. + +*** JavaScript support + :PROPERTIES: + :DESCRIPTION: Info and folding in a web browser + :END: +#+cindex: Rose, Sebastian + +Sebastian Rose has written a JavaScript program especially designed to +enhance the web viewing experience of HTML files created with Org. This +program allows you to view large files in two different ways. The first one +is an /Info/-like mode where each section is displayed separately and +navigation can be done with the {{{kbd(n)}}} and {{{kbd(p)}}} keys (and some other keys +as well, press {{{kbd(?)}}} for an overview of the available keys). The second +view type is a /folding/ view much like Org provides inside Emacs. The +script is available at [[http://orgmode.org/org-info.js]] and you can find +the documentation for it at [[http://orgmode.org/worg/code/org-info-js/]]. +We host the script at our site, but if you use it a lot, you might +not want to be dependent on ~orgmode.org~ and prefer to install a local +copy on your own web server. + +To use the script, you need to make sure that the +{{{file(org-jsinfo.el)}}} module gets loaded. It should be loaded by +default, but you can try {{{ksksksk(M-x customize-variable,RET,org-modules,RET)}}} +to convince yourself that this is indeed the case. All it then takes to make use of the program +is adding a single line to the Org file: + +#+cindex: #+INFOJS_OPT +#+begin_example + ,#+INFOJS_OPT: view:info toc:nil +#+end_example + +{{{noindent}}} If this line is found, the HTML header will +automatically contain the code needed to invoke the script. Using the +line above, you can set the following viewing options: + +#+attr_texinfo: :table-type table :indic @code +- path: :: + + The path to the script. The default is to grab the script from + [[http://orgmode.org/org-info.js]], but you might want to have + a local copy and use a path like {{{samp(../scripts/org-info.js)}}}. + +- view: :: + + Initial view when the website is first shown. Possible values are: + + - info :: Info-like interface with one section per page. + - overview :: Folding interface, initially showing only top-level. + - content :: Folding interface, starting with all headlines visible. + - showall :: Folding interface, all headlines and text visible. + +- sdepth: :: + + Maximum headline level that will still become an independent section + for info and folding modes. The default is taken from + ~org-export-headline-levels~ (= the ~H~ switch in ~#+OPTIONS~). If + this is smaller than in ~org-export-headline-levels~, each + info/folding section can still contain child headlines. + +- toc: :: + + Should the table of contents /initially/ be visible? Even when ~nil~, + you can always get to the "toc" with {{{kbd(i)}}}. + +- tdepth: :: + + The depth of the table of contents. The defaults are taken from the + variables ~org-export-headline-levels~ and ~org-export-with-toc~. + +- ftoc: :: + + Does the CSS of the page specify a fixed position for the "toc"? If + yes, the toc will never be displayed as a section. + +- ltoc: :: + + Should there be short contents (children) in each section? Make this + ~above~ if the section should be above initial text. + +- mouse: :: + + Headings are highlighted when the mouse is over them. Should be + {{{samp(underline)}}} (default) or a background color like + {{{samp(#cccccc)}}}. + +- buttons: :: + + Should view-toggle buttons be everywhere? When ~nil~ (the default), + only one such button will be present. + + +#+vindex: org-infojs-options +#+vindex: org-export-html-use-infojs + +{{{noindent}}} You can choose default values for these options by +customizing the variable ~org-infojs-options~. If you always want to +apply the script to your pages, configure the variable +~org-export-html-use-infojs~. + +** LaTeX and PDF export + :PROPERTIES: + :DESCRIPTION: Exporting to LaTeX and processing to PDF + :END: +#+cindex: @LaTeX{} export +#+cindex: PDF export +#+cindex: Guerry, Bastien + +Org mode contains a LaTeX exporter written by Bastien Guerry. With +further processing, this backend is also used to produce PDF +output.[fn:124] Since the LaTeX output uses {{{file(hyperref)}}} to +implement links and cross references, the PDF output file will be +fully linked. Beware of the fact that your ~org~ file has to be +properly structured in order to be correctly exported: respect the +hierarchy of sections. + +*** LaTeX/PDF export commands + :PROPERTIES: + :DESCRIPTION: Invoking export to LaTeX/PDF + :END: +#+cindex: region, active +#+cindex: active region +#+cindex: transient-mark-mode + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e l)}}}, ~org-export-as-latex~ :: + #+kindex: C-c C-e l + #+cindex: property EXPORT_FILE_NAME + + Export as a LaTeX file. For an Org file {{{file(myfile.org)}}}, the + LaTeX file will be {{{file(myfile.tex)}}}. The file will be + overwritten without warning. If there is an active region, only the + active region will be exported.[fn:125] If the selected region is a + single tree, the tree head will become the document title.[fn:126] If + the tree head entry has or inherits an ~EXPORT_FILE_NAME~ property, + that name will be used for the export. + +- {{{kbd(C-c C-e L)}}}, ~org-export-as-latex-to-buffer~ :: + #+kindex: C-c C-e L + + Export to a temporary buffer. Do not create a file. + +- {{{kbd(C-c C-e v l/L)}}} :: + + Export only the visible part of the document. + +- {{{kbd(M-x org-export-region-as-latex)}}} :: + + Convert the region to LaTeX under the assumption that it was in Org + mode syntax before. This is a global command that can be invoked in + any buffer. + +- {{{kbd(M-x org-replace-region-by-latex)}}} :: + + Replace the active region (assumed to be in Org mode syntax) by + LaTeX code. + +- {{{kbd(C-c C-e p)}}}, ~org-export-as-pdf~ :: + #+kindex: C-c C-e p + + Export as LaTeX and then process to PDF. + +- {{{kbd(C-c C-e d)}}}, ~org-export-as-pdf-and-open~ :: + #+kindex: C-c C-e d + + Export as LaTeX and then process to PDF, then open the resulting + PDF file. + + +#+cindex: headline levels, for exporting +#+vindex: org-latex-low-levels + +In the exported version, the first 3 outline levels will become +headlines, defining a general document structure. Additional levels +will be exported as description lists. The exporter can ignore them or +convert them to a custom string depending on ~org-latex-low-levels~. + +If you want that transition to occur at a different level, specify it +with a numeric prefix argument, e.g.: + +#+begin_example + C-2 C-c C-e l +#+end_example + +{{{noindent}}} The example setting creates two levels of headings and +exports the rest as list items. + +*** Header and sectioning + :PROPERTIES: + :DESCRIPTION: Setting up the export file structure + :TITLE: Header and sectioning structure + :END: +#+cindex: @LaTeX{} class +#+cindex: @LaTeX{} sectioning structure +#+cindex: @LaTeX{} header +#+cindex: header, for @LaTeX{} files +#+cindex: sectioning structure, for @LaTeX{} export + +By default, the LaTeX output uses the class ~article~. + +#+vindex: org-export-latex-default-class +#+vindex: org-export-latex-classes +#+vindex: org-export-latex-default-packages-alist +#+vindex: org-export-latex-packages-alist +#+cindex: #+LaTeX_HEADER +#+cindex: #+LaTeX_CLASS +#+cindex: #+LaTeX_CLASS_OPTIONS +#+cindex: property, LaTeX_CLASS +#+cindex: property, LaTeX_CLASS_OPTIONS + +You can change this globally by setting a different value for +~org-export-latex-default-class~ or locally by adding an option like +~#+LaTeX_CLASS: myclass~ in your file, or with a ~:LaTeX_CLASS:~ +property that applies when exporting a region containing only this +(sub)tree. The class must be listed in ~org-export-latex-classes~. +This variable defines a header template for each class, and allows you +to define the sectioning structure for each class.[fn:127] You can +also define your own classes there. ~#+LaTeX_CLASS_OPTIONS~ or a +~:LaTeX_CLASS_OPTIONS:~ property can specify the options for the +~\documentclass~ macro. The options to documentclass have to be +provided, as expected by LaTeX, within square brackets. You can +also use ~#+LaTeX_HEADER: \usepackage{xyz}~ to add lines to the +header. See the docstring of ~org-export-latex-classes~ for more +information. An example is shown below. + +#+begin_example + ,#+LaTeX_CLASS: article + ,#+LaTeX_CLASS_OPTIONS: [a4paper] + ,#+LaTeX_HEADER: \usepackage{xyz} + + ,* Headline 1 + some text +#+end_example + +*** Quoting LaTeX code + :PROPERTIES: + :DESCRIPTION: Incorporating literal LaTeX code + :END: + +Embedded LaTeX as described in [[Embedded LaTeX]], will be correctly +inserted into the LaTeX file. This includes simple macros like +~\ref{LABEL}~ to create a cross reference to a figure. Furthermore, +you can add special code that should only be present in LaTeX export +with the following constructs: + +#+cindex: #+LaTeX +#+cindex: #+BEGIN_LaTeX +#+begin_example + ,#+LaTeX: Literal LaTeX code for export +#+end_example + +{{{noindent}}} or + +#+cindex: #+BEGIN_LaTeX + +#+begin_example + ,#+BEGIN_LaTeX + All lines between these markers are exported literally + ,#+END_LaTeX +#+end_example + +*** Tables in LaTeX export + :PROPERTIES: + :DESCRIPTION: Options for exporting tables to LaTeX + :END: +#+cindex: tables, in @LaTeX{} export + +For LaTeX export of a table, you can specify a label, a caption and +placement options (see [[Images and tables]]). You can also use the +~ATTR_LaTeX~ line to request a ~longtable~ environment for the +table, so that it may span several pages, or to change the default table +environment from ~table~ to ~table*~ or to change the default inner +tabular environment to ~tabularx~ or ~tabulary~. Finally, you can +set the alignment string, and (with ~tabularx~ or ~tabulary~) the +width: + +#+cindex: #+CAPTION +#+cindex: #+LABEL +#+cindex: #+ATTR_LaTeX +#+begin_example + ,#+CAPTION: A long table + ,#+LABEL: tbl:long + ,#+ATTR_LaTeX: longtable align=l|lp@{3cm@}r|l + | ..... | ..... | + | ..... | ..... | +#+end_example + +or to specify a multicolumn table with ~tabulary~: + +#+cindex: #+CAPTION +#+cindex: #+LABEL +#+cindex: #+ATTR_LaTeX +#+begin_example + ,#+CAPTION: A wide table with tabulary + ,#+LABEL: tbl:wide + ,#+ATTR_LaTeX: table* tabulary width=\textwidth + | ..... | ..... | + | ..... | ..... | +#+end_example + +*** Images in LaTeX export + :PROPERTIES: + :DESCRIPTION: How to insert figures into LaTeX output + :END: +#+cindex: images, inline in LaTeX +#+cindex: inlining images in LaTeX + +Images that are linked to without a description part in the link, like +~[[file:img.jpg]]~ or ~[[./img.jpg]]~ will be inserted into the PDF +output file resulting from LaTeX processing. Org will use an +~\includegraphics~ macro to insert the image. If you have specified +a caption and/or a label as described in [[Images and tables]], the +figure will be wrapped into a ~figure~ environment and thus become +a floating element. You can use an ~#+ATTR_LaTeX:~ line to specify +various other options. You can ask org to export an image as a float +without specifying a label or a caption by using the keyword ~float~ +in this line. Various optional arguments to the ~\includegraphics~ +macro can also be specified in this fashion. To modify the placement +option of the floating environment, add something like +{{{samp(placement=[h!])}}} to the attributes. It is to be noted this +option can be used with tables as well.[fn:128] + +If you would like to let text flow around the image, add the word +{{{samp(wrap)}}} to the ~#+ATTR_LaTeX:~ line, which will make the +figure occupy the left half of the page. To fine-tune, the ~placement~ +field will be the set of additional arguments needed by the +~wrapfigure~ environment. Note that if you change the size of the +image, you need to use compatible settings for ~\includegraphics~ and +~wrapfigure~. + +#+cindex: #+CAPTION +#+cindex: #+LABEL +#+cindex: #+ATTR_LaTeX +#+begin_example + ,#+CAPTION: The black-body emission of the disk around HR 4049 + ,#+LABEL: fig:SED-HR4049 + ,#+ATTR_LaTeX: width=5cm,angle=90 + [[./img/sed-hr4049.pdf]] + + ,#+ATTR_LaTeX: width=0.38\textwidth wrap placement=@{r@}@{0.4\textwidth@} + [[./img/hst.png]] +#+end_example + +If you wish to include an image which spans multiple columns in a page, you +can use the keyword ~multicolumn~ in the ~#+ATTR_LaTeX~ line. This +will export the image wrapped in a ~figure*~ environment. + +If you need references to a label created in this way, write +~\ref{fig:SED-HR4049}~ just like in LaTeX. + +*** Beamer class export + :PROPERTIES: + :DESCRIPTION: Turning the file into a presentation + :END: + +The LaTeX class {{{file(beamer)}}} allows production of high +quality presentations using LaTeX and pdf processing. Org mode has +special support for turning an Org mode file or tree into a +{{{file(beamer)}}} presentation. + +When the LaTeX class for the current buffer (as set with ~#+LaTeX_CLASS: +beamer~) or subtree (set with a ~LaTeX_CLASS~ property) is +~beamer~, a special export mode will turn the file or tree into a beamer +presentation. Any tree with not-too-deep level nesting should in principle be +exportable as a beamer presentation. By default, the top-level entries (or +the first level below the selected subtree heading) will be turned into +frames, and the outline structure below this level will become itemize lists. +You can also configure the variable ~org-beamer-frame-level~ to a +different level---then the hierarchy above frames will produce the sectioning +structure of the presentation. + +A template for useful in-buffer settings or properties can be inserted +into the buffer with +{{{kbd(M-x org-insert-beamer-options-template)}}}. Among other things, this will +install a column view format which is very handy for editing special +properties used by beamer. + +You can influence the structure of the presentation using the following +properties: + +#+attr_texinfo: :table-type table :indic @asis +- ~BEAMER_env~ :: + + The environment that should be used to format this entry. Valid + environments are defined in the constant + ~org-beamer-environments-default~, and you can define more in + ~org-beamer-environments-extra~. If this property is set, the entry + will also get a ~:B_environment:~ tag to make this visible. This tag + has no semantic meaning, it is only a visual aid. + +- ~BEAMER_envargs~ :: + + The beamer-special arguments that should be used for the environment, + like ~[t]~ or ~[<+->]~ of ~<2-3>~. If the ~BEAMER_col~ property is + also set, something like ~C[t]~ can be added here as well to set an + options argument for the implied ~columns~ environment. ~c[t]~ or + ~c<2->~ will set an options for the implied ~column~ environment. + +- ~BEAMER_col~ :: + + The width of a column that should start with this entry. If this + property is set, the entry will also get a ~:BMCOL:~ property to make + this visible. Also this tag is only a visual aid. When this is a plain + number, it will be interpreted as a fraction of ~\textwidth~. + Otherwise it will be assumed that you have specified the units, like + {{{samp(3cm)}}}. The first such property in a frame will start a + ~columns~ environment to surround the columns. This environment is + closed when an entry has a ~BEAMER_col~ property with value 0 or 1, or + automatically at the end of the frame. + +- ~BEAMER_extra~ :: + + Additional commands that should be inserted after the environment has + been opened. For example, when creating a frame, this can be used to + specify transitions. + + +Frames will automatically receive a ~fragile~ option if they contain +source code that uses the verbatim environment. Special {{{file(beamer)}}} +specific code can be inserted using ~#+BEAMER:~ and +~#+BEGIN_BEAMER~ ... ~#+END_BEAMER~ constructs, similar to other export +backends, but with the difference that ~#+LaTeX:~ stuff will be included +in the presentation as well. + +Outline nodes with ~BEAMER_env~ property value {{{samp(note)}}} or +{{{samp(noteNH)}}} will be formatted as beamer notes, i,e, they will be wrapped +into ~\note{...}~. The former will include the heading as part of the +note text, the latter will ignore the heading of that node. To simplify note +generation, it is actually enough to mark the note with a /tag/ (either +~:B_note:~ or ~:B_noteNH:~) instead of creating the +~BEAMER_env~ property. + +You can turn on a special minor mode ~org-beamer-mode~ for editing +support with the following line: + +#+begin_example + ,#+STARTUP: beamer +#+end_example + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-b)}}}, ~org-beamer-select-environment~ :: + #+kindex: C-c C-b + + In ~org-beamer-mode~, this key offers fast selection of a beamer + environment or the ~BEAMER_col~ property. + + +Column view provides a great way to set the environment of a node and +other important parameters. Make sure you are using a COLUMN format +that is geared toward this special purpose. The command +{{{kbd(M-x org-insert-beamer-options-template)}}} defines such a format. + +Here is a simple example Org document that is intended for beamer export. + +#+begin_example + ,#+LaTeX_CLASS: beamer + ,#+TITLE: Example Presentation + ,#+AUTHOR: Carsten Dominik + ,#+LaTeX_CLASS_OPTIONS: [presentation] + ,#+BEAMER_FRAME_LEVEL: 2 + ,#+BEAMER_HEADER_EXTRA: \usetheme@{Madrid@}\usecolortheme@{default@} + ,#+COLUMNS: %35ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Args) %4BEAMER_col(Col) %8BEAMER_extra(Ex) + + ,* This is the first structural section + + ,** Frame 1 \\ with a subtitle + ,*** Thanks to Eric Fraga :BMCOL:B_block: + :PROPERTIES: + :BEAMER_env: block + :BEAMER_envargs: C[t] + :BEAMER_col: 0.5 + :END: + for the first viable beamer setup in Org + ,*** Thanks to everyone else :BMCOL:B_block: + :PROPERTIES: + :BEAMER_col: 0.5 + :BEAMER_env: block + :BEAMER_envargs: <2-> + :END: + for contributing to the discussion + ,**** This will be formatted as a beamer note :B_note: + ,** Frame 2 \\ where we will not use columns + ,*** Request :B_block: + Please test this stuff! + :PROPERTIES: + :BEAMER_env: block + :END: +#+end_example + +For more information, see the documentation on Worg. + +** DocBook export + :PROPERTIES: + :DESCRIPTION: Exporting to DocBook + :END: +#+cindex: DocBook export +#+cindex: PDF export +#+cindex: Cui, Baoqiu + +Org contains a DocBook exporter written by Baoqiu Cui. Once an Org file is +exported to DocBook format, it can be further processed to produce other +formats, including PDF, HTML, man pages, etc., using many available DocBook +tools and stylesheets. + +Currently DocBook exporter only supports DocBook V5.0. + +*** DocBook export commands + :PROPERTIES: + :DESCRIPTION: How to invoke DocBook export + :END: +#+cindex: region, active +#+cindex: active region +#+cindex: transient-mark-mode + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e D)}}}, ~org-export-as-docbook~ :: + #+kindex: C-c C-e D + #+cindex: property EXPORT_FILE_NAME + + Export as a DocBook file. For an Org file, {{{file(myfile.org)}}}, the + DocBook XML file will be {{{file(myfile.xml)}}}. The file will be + overwritten without warning. If there is an active region, only the + region will be exported.[fn:129] If the selected region is a single + tree, the tree head will become the document title.[fn:130] If the + tree head entry has, or inherits, an ~EXPORT_FILE_NAME~ property, that + name will be used for the export. + +- {{{kbd(C-c C-e V)}}}, ~org-export-as-docbook-pdf-and-open~ :: + #+kindex: C-c C-e V + + Export as a DocBook file, process to PDF, then open the resulting PDF + file. + + #+vindex: org-export-docbook-xslt-proc-command + #+vindex: org-export-docbook-xsl-fo-proc-command + + Note that, in order to produce PDF output based on an exported DocBook + file, you need to have XSLT processor and XSL-FO processor software + installed on your system. Check variables + ~org-export-docbook-xslt-proc-command~ and + ~org-export-docbook-xsl-fo-proc-command~. + + #+vindex: org-export-docbook-xslt-stylesheet + + The stylesheet argument ~%s~ in variable + ~org-export-docbook-xslt-proc-command~ is replaced by the value of + variable ~org-export-docbook-xslt-stylesheet~, which needs to be set by + the user. You can also overrule this global setting on a per-file basis by + adding an in-buffer setting ~#+XSLT:~ to the Org file. + +- {{{kbd(C-c C-e v D)}}} :: + #+kindex: C-c C-e v D + + Export only the visible part of the document. + +*** Quoting DocBook code + :PROPERTIES: + :DESCRIPTION: Incorporating DocBook code in Org files + :END: +You can quote DocBook code in Org files and copy it verbatim into exported +DocBook file with the following constructs: + +#+cindex: #+DOCBOOK +#+cindex: #+BEGIN_DOCBOOK +#+begin_example + ,#+DOCBOOK: Literal DocBook code for export +#+end_example + +{{{noindent}}} or +#+cindex: #+BEGIN_DOCBOOK + +#+begin_example + ,#+BEGIN_DOCBOOK + All lines between these markers are exported by DocBook exporter + literally. + ,#+END_DOCBOOK +#+end_example + +For example, you can use the following lines to include a DocBook warning +admonition. As to what this warning says, you should pay attention to the +document context when quoting DocBook code in Org files. You may make +exported DocBook XML files invalid by not quoting DocBook code correctly. + +#+begin_example + ,#+BEGIN_DOCBOOK + <warning> + <para>You should know what you are doing when quoting DocBook XML code + in your Org file. Invalid DocBook XML may be generated by + DocBook exporter if you are not careful!</para> + </warning> + ,#+END_DOCBOOK +#+end_example + +*** Recursive sections + :PROPERTIES: + :DESCRIPTION: Recursive sections in DocBook + :END: +#+cindex: DocBook recursive sections + +DocBook exporter exports Org files as articles using the ~article~ +element in DocBook. Recursive sections, i.e., ~section~ elements, are +used in exported articles. Top level headlines in Org files are +exported as top level sections, and lower level headlines are exported +as nested sections. The entire structure of Org files will be exported +completely, no matter how many nested levels of headlines there are. + +Using recursive sections makes it easy to port and reuse exported +DocBook code in other DocBook document types like ~book~ or ~set~. + +*** Tables in DocBook export + :PROPERTIES: + :DESCRIPTION: Tables are exported as HTML tables + :END: +#+cindex: tables, in DocBook export + +Tables in Org files are exported as HTML tables, which have been +supported since DocBook V4.3. + +If a table does not have a caption, an informal table is generated +using the ~informaltable~ element; otherwise, a formal table will be +generated using the ~table~ element. + +*** Images in DocBook export + :PROPERTIES: + :DESCRIPTION: How to insert figures into DocBook output + :END: +#+cindex: images, inline in DocBook +#+cindex: inlining images in DocBook + +Images that are linked to without a description part in the link, like +~[[file:img.jpg]]~ or ~[[./img.jpg]]~, will be exported to +DocBook using ~mediaobject~ elements. Each ~mediaobject~ element +contains an ~imageobject~ that wraps an ~imagedata~ element. If you +have specified a caption for an image as described in [[Images and +tables]], a ~caption~ element will be added in ~mediaobject~. If a label +is also specified, it will be exported as an ~xml:id~ attribute of the +~mediaobject~ element. + +#+vindex: org-export-docbook-default-image-attributes + +Image attributes supported by the ~imagedata~ element, like ~align~ or +~width~, can be specified in two ways: you can either customize +variable ~org-export-docbook-default-image-attributes~ or use the +~#+ATTR_DOCBOOK:~ line. Attributes specified in variable +~org-export-docbook-default-image-attributes~ are applied to all +inline images in the Org file to be exported (unless they are +overridden by image attributes specified in ~#+ATTR_DOCBOOK:~ lines). + +The ~#+ATTR_DOCBOOK:~ line can be used to specify additional image +attributes or override default image attributes for individual images. +If the same attribute appears in both the ~#+ATTR_DOCBOOK:~ line and +variable ~org-export-docbook-default-image-attributes~, the former +takes precedence. Here is an example about how image attributes can be +set: + +#+cindex: #+CAPTION +#+cindex: #+LABEL +#+cindex: #+ATTR_DOCBOOK +#+begin_example + ,#+CAPTION: The logo of Org mode + ,#+LABEL: unicorn-svg + ,#+ATTR_DOCBOOK: scalefit="1" width="100%" depth="100%" + [[./img/org-mode-unicorn.svg]] +#+end_example + +#+vindex: org-export-docbook-inline-image-extensions + +By default, DocBook exporter recognizes the following image file +types: {{{file(jpeg)}}}, {{{file(jpg)}}}, {{{file(png)}}}, +{{{file(gif)}}}, and {{{file(svg)}}}. You can customize variable +~org-export-docbook-inline-image-extensions~ to add more types to this +list as long as DocBook supports them. + +*** Special characters + :PROPERTIES: + :DESCRIPTION: How to handle special characters + :TITLE: Special characters in DocBook export + :END: +#+vindex: org-export-docbook-doctype +#+vindex: org-entities + +Special characters that are written in TeX-like syntax, such as +~\alpha~, ~\Gamma~, and ~\Zeta~, are supported by DocBook exporter. +These characters are rewritten to XML entities, like ~α~, +~Γ~, and ~Ζ~, based on the list saved in variable +~org-entities~. As long as the generated DocBook file includes the +corresponding entities, these special characters are recognized. + +You can customize variable ~org-export-docbook-doctype~ to include the +entities you need. For example, you can set variable +~org-export-docbook-doctype~ to the following value to recognize all +special characters included in XHTML entities: + +#+begin_example + "<!DOCTYPE article [ + <!ENTITY % xhtml1-symbol PUBLIC + \"-//W3C//ENTITIES Symbol for HTML//EN//XML\" + \"http://www.w3.org/2003/entities/2007/xhtml1-symbol.ent\" + > + %xhtml1-symbol; + ]> + " +#+end_example + +** OpenDocument Text export + :PROPERTIES: + :DESCRIPTION: Exporting to OpenDocument Text + :END: +#+cindex: K, Jambunathan +#+cindex: ODT +#+cindex: OpenDocument +#+cindex: export, OpenDocument +#+cindex: LibreOffice +#+cindex: org-odt.el +#+cindex: org-modules + +Org Mode supports export to OpenDocument Text (ODT) format using the +{{{file(org-odt.el)}}} module.[fn:131] Documents created by this +exporter use the {{{cite(OpenDocument-v1.2 specification)}}} and +are compatible with LibreOffice 3.4.[fn:132] + +*** Pre-requisites for ODT export + :PROPERTIES: + :DESCRIPTION: What packages ODT exporter relies on + :END: +#+cindex: zip + +The ODT exporter relies on the {{{file(zip)}}} program to create the +final output. Check the availability of this program before proceeding +further. + +*** ODT export commands + :PROPERTIES: + :DESCRIPTION: How to invoke ODT export + :ALT_TITLE: Exporting to ODT + :END: +<<x-export-to-odt>> + +#+cindex: region, active +#+cindex: active region +#+cindex: transient-mark-mode + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e o)}}}, ~org-export-as-odt~ :: + #+kindex: C-c C-e o + #+cindex: property EXPORT_FILE_NAME + + Export as OpenDocument Text file. + + #+vindex: org-export-odt-preferred-output-format + + If ~org-export-odt-preferred-output-format~ is specified, + automatically convert the exported file to that format. See + [[Automatically exporting to other formats]]. + + For an Org file {{{file(myfile.org)}}}, the ODT file will be + {{{file(myfile.odt)}}}. The file will be overwritten without warning. + If there is an active region, only the region will be + exported.[fn:133] If the selected region is a single tree, the tree + head will become the document title.[fn:134] If the tree head entry + has, or inherits, an ~EXPORT_FILE_NAME~ property, that name will be + used for the export. + +- {{{kbd(C-c C-e O)}}}, ~org-export-as-odt-and-open~ :: + #+kindex: C-c C-e O + + Export as an OpenDocument Text file and open the resulting file. + + #+vindex: org-export-odt-preferred-output-format + + If ~org-export-odt-preferred-output-format~ is specified, open the + converted file instead. See [[x-export-to-other-formats][Automatically exporting to other formats]]. + +*** Extending ODT export + :PROPERTIES: + :DESCRIPTION: How to produce ~doc~, ~pdf~ files + :END: + +The ODT exporter can interface with a variety of document converters +and supports popular converters out of the box. As a result, you can +use it to export to formats like {{{samp(doc)}}} or convert a document +from one format (say {{{samp(csv)}}}) to another format (say +{{{samp(ods)}}} or {{{samp(xls)}}}). + +#+cindex: @file{unoconv} +#+cindex: LibreOffice + +If you have a working installation of LibreOffice, a document +converter is pre-configured for you and you can use it right away. If +you would like to use {{{file(unoconv)}}} as your preferred converter, +customize the variable ~org-export-odt-convert-process~ to point to +~unoconv~. You can also use your own favorite converter or tweak the +default settings of the {{{file(LibreOffice)}}} and +{{{samp(unoconv)}}} converters. See [[Configuring a document converter]]. + +**** Automatically exporting to other formats + :PROPERTIES: + :DESCRIPTION: Automatic conversion to doc, docx, etc. + :END: +<<x-export-to-other-formats>> + +#+vindex: org-export-odt-preferred-output-format + +Very often, you will find yourself exporting to ODT format, only to +immediately save the exported document to other formats like +{{{samp(doc)}}}, {{{samp(docx)}}}, {{{samp(rtf)}}}, {{{samp(pdf)}}} +etc. In such cases, you can specify your preferred output format by +customizing the variable ~org-export-odt-preferred-output-format~. +This way, the export commands (see [[x-export-to-odt][Exporting to ODT]]) +can be extended to export to a format that is of immediate interest to +you. + +**** Converting between document formats + :PROPERTIES: + :DESCRIPTION: Interacting with configured converters + :END: +# <<x-convert-to-other-formats>> + +There are many document converters in the wild that support +conversion to and from various file formats, including, but not +limited to the ODT format. LibreOffice converter, mentioned above, is +one such converter. Once a converter is configured, you can interact +with it using the following command. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(M-x org-export-odt-convert)}}} :: + #+vindex: org-export-odt-convert + + Convert an existing document from one format to another. With a prefix + argument, also open the newly produced file. + +*** Applying custom styles + :PROPERTIES: + :DESCRIPTION: How to apply custom styles to the output + :END: +#+cindex: styles, custom +#+cindex: template, custom + +The ODT exporter ships with a set of OpenDocument styles +(see [[Working with OpenDocument style files]]) that ensure a well-formatted output. +These factory styles, however, may not cater to your specific tastes. +To customize the output, you can either modify the above styles files +directly, or generate the required styles using an application like +LibreOffice. The latter method is suitable for expert and non-expert +users alike, and is described here. + +Custom styles can be applied in three easy steps: + +1. Create a sample {{{file(example.org)}}} file with the below + settings and export it to ODT format. + + #+begin_example + ,#+OPTIONS: H:10 num:t + #+end_example + +2. Open the above {{{file(example.odt)}}} using LibreOffice. Use the + {{{file(Stylist)}}} to locate the target styles---these typically + have the {{{samp(Org)}}} prefix---and modify those to your taste. + Save the modified file either as an OpenDocument Text + ({{{file(.odt)}}}) or OpenDocument Template ({{{file(.ott)}}}) + file. + +3. Customize the variable ~org-export-odt-styles-file~ and point it to + the newly created file. For additional configuration options see + [[x-overriding-factory-styles][Overriding factory styles]]. + + #+cindex: #+ODT_STYLES_FILE + #+vindex: org-export-odt-styles-file + + If you would like to choose a style on a per-file basis, you can use + the ~#+ODT_STYLES_FILE~ option. A typical setting will look like + one of these two examples: + + #+begin_example + ,#+ODT_STYLES_FILE: "/path/to/example.ott" + #+end_example + + or + + #+begin_example + ,#+ODT_STYLES_FILE: ("/path/to/file.ott" ("styles.xml" "image/hdr.png")) + #+end_example + +Although you can use third-party styles and templates for customizing +your output, this will produce the desired output only if the template +provides all style names that the {{{samp(ODT)}}} exporter relies +upon. Unless this condition is met, the output is going to be less +than satisfactory. It is highly recommended that you only work with +templates that are directly derived from the factory settings. + +*** Links in ODT export + :PROPERTIES: + :DESCRIPTION: How links will be interpreted and formatted + :END: +#+cindex: tables, in DocBook export + +ODT exporter creates native cross-references for internal links. It +creates Internet-style links for all other links. + +A link with no description and destined to a regular (un-itemized) +outline heading is replaced with a cross-reference and section number +of the heading. + +A ~\ref{label}~-style reference to an image, table etc. is replaced +with a cross-reference and sequence number of the labeled entity. See +[[Labels and captions in ODT export]]. + +*** Tables in ODT export + :PROPERTIES: + :DESCRIPTION: How tables are exported + :END: + +#+cindex: tables, in DocBook export + +Export of native Org mode tables (see [[Tables]]) and simple +{{{file(table.el)}}} tables is supported. However, export of complex +{{{file(table.el)}}} tables---tables that have column or row +spans---is not supported. Such tables are stripped from the exported +document. + +By default, a table is exported with top and bottom frames and with +rules separating row and column groups (see [[Column groups]]). +Furthermore, all tables are typeset to occupy the same width. If the +table specifies alignment and relative width for its columns (see +[[Column width and alignment]]) then these are honored on export.[fn:135] + +#+cindex: #+ATTR_ODT + +You can control the width of the table by specifying ~:rel-width~ +property using an ~#+ATTR_ODT~ line. + +For example, consider the following table which makes use of all the +rules mentioned above. + +#+begin_example + #+ATTR_ODT: :rel-width 50 + | Area/Month | Jan | Feb | Mar | Sum | + |---------------+-------+-------+-------+-------| + | / | < | | | < | + | <l13> | <r5> | <r5> | <r5> | <r6> | + | North America | 1 | 21 | 926 | 948 | + | Middle East | 6 | 75 | 844 | 925 | + | Asia Pacific | 9 | 27 | 790 | 826 | + |---------------+-------+-------+-------+-------| + | Sum | 16 | 123 | 2560 | 2699 | +#+end_example + +On export, the table will occupy 50% of text area. The columns will be +sized (roughly) in the ratio of 13:5:5:5:6. The first column will be +left-aligned and rest of the columns will be right-aligned. There will +be vertical rules after separating the header and last columns from +other columns. There will be horizontal rules separating the header +and last rows from other rows. + +If you are not satisfied with the above formatting options, you can +create custom table styles and associate them with a table using the +~#+ATTR_ODT~ line. See [[Customizing tables in ODT export]]. + +*** Images in ODT export + :PROPERTIES: + :DESCRIPTION: How to insert images + :END: +#+cindex: images, embedding in ODT +#+cindex: embedding images in ODT + +You can embed images within the exported document by providing a link to the +desired image file with no link description. For example, to embed +{{{samp(img.png)}}} do either of the following: + +#+begin_example + [[file:img.png]] +#+end_example + +#+begin_example + [[./img.png]] +#+end_example + +You can create clickable images by providing a link whose description +is a link to an image file. For example, to embed an image +{{{file(org-mode-unicorn.png)}}}, which when clicked jumps to +[[http://Orgmode.org]] website, do the following: + +#+begin_example + [[http://orgmode.org][./org-mode-unicorn.png]] +#+end_example + +#+cindex: #+ATTR_ODT + +You can control the size and scale of the embedded images using the +~#+ATTR_ODT~ attribute. + +#+cindex: identify, ImageMagick +#+vindex: org-export-odt-pixels-per-inch + +The exporter specifies the desired size of the image in the final +document in units of centimeters. In order to scale the embedded +images, the exporter queries for pixel dimensions of the images using +either ImageMagick's {{{file(identify)}}} program, or Emacs' +`create-image' and `image-size' APIs.[fn:136] The pixel dimensions are +subsequently converted to centimeters using +~org-export-odt-pixels-per-inch~. The default value of this variable +is set to ~display-pixels-per-inch~. You can tweak this variable to +achieve the best results. + +The examples below illustrate the various possibilities. + +#+attr_texinfo: :table-type table :indic @asis +- Explicitly size the image :: + + To embed {{{file(img.png)}}} as a 10 cm x 10 cm image, do the + following: + + #+begin_example + #+ATTR_ODT: :width 10 :height 10 + [[./img.png]] + #+end_example + +- Scale the image :: + + To embed {{{file(img.png)}}} at half its size, do the following: + + #+begin_example + #+ATTR_ODT: :scale 0.5 + [[./img.png]] + #+end_example + +- Scale the image to a specific width :: + + To embed {{{file(img.png)}}} with a width of 10 cm while retaining the + original height:width ratio, do the following: + + #+begin_example + #+ATTR_ODT: :width 10 + [[./img.png]] + #+end_example + +- Scale the image to a specific height :: + + To embed {{{file(img.png)}}} with a height of 10 cm while retaining + the original height:width ratio, do the following: + + #+begin_example + #+ATTR_ODT: :height 10 + [[./img.png]] + #+end_example + +#+cindex: #+ATTR_ODT + +You can control the manner in which an image is anchored by setting +the ~:anchor~ property of it's ~#+ATTR_ODT~ line. You can specify one +of the the following three values for the ~:anchor~ property - +{{{samp("as-char")}}}, {{{samp("paragraph")}}} and {{{samp("page")}}}. + +To create an image that is anchored to a page, do the following: + +#+begin_example + #+ATTR_ODT: :anchor "page" + [[./img.png]] +#+end_example + +*** Math formatting in ODT export + :PROPERTIES: + :DESCRIPTION: How LaTeX fragments are formatted + :END: + +The ODT exporter has special support for handling math. + +**** Working with LaTeX math snippets + :PROPERTIES: + :DESCRIPTION: How to embed LaTeX math fragments + :END: + +LaTeX math snippets (see [[LaTeX fragments]]) can be embedded in the ODT +document in one of the following ways: + +#+cindex: MathML +#+attr_texinfo: :table-type table :indic @asis +- MathML :: + + This option is activated on a per-file basis with the following option: + + #+begin_example + ,#+OPTIONS: LaTeX:t + #+end_example + + With this option, LaTeX fragments are first converted into MathML + fragments using an external LaTeX-to-MathML converter program. The + resulting MathML fragments are then embedded as an OpenDocument Formula in + the exported document. + + #+vindex: org-latex-to-mathml-convert-command + #+vindex: org-latex-to-mathml-jar-file + + You can specify the LaTeX-to-MathML converter by customizing the variables + ~org-latex-to-mathml-convert-command~ and + ~org-latex-to-mathml-jar-file~. + + If you prefer to use {{{file(MathToWeb)}}} as your converter, you can + configure the above variables as shown below.[fn:137] + + #+header: :eval no + #+header: :exports code + #+begin_src emacs-lisp + (setq org-latex-to-mathml-convert-command + "java -jar %j -unicode -force -df %o %I" + org-latex-to-mathml-jar-file + "/path/to/mathtoweb.jar") + #+end_src + + You can use the following commands to quickly verify the reliability of + the LaTeX-to-MathML converter. + + - {{{kbd(M-x org-export-as-odf)}}} :: + + Convert a LaTeX math snippet to an OpenDocument formula + ({{{file(.odf)}}}) file. + + - {{{kbd(M-x org-export-as-odf-and-open)}}} :: + + Convert a LaTeX math snippet to an OpenDocument formula + ({{{file(.odf)}}}) file and open the formula file with the + system-registered application. + +- PNG images :: + #+cindex: dvipng + + This option is activated on a per-file basis with + + #+begin_example + ,#+OPTIONS: LaTeX:dvipng + #+end_example + + With this option, LaTeX fragments are processed into PNG images and + the resulting images are embedded in the exported document. This + method requires that the {{{file(dvipng)}}} program be available on + your system. + +**** Working with MathML or OpenDocument formula files + :PROPERTIES: + :DESCRIPTION: How to embed equations in native format + :END: + +For various reasons, you may find embedding LaTeX math snippets in +an ODT document less than reliable. In that case, you can embed a math +equation by linking to its MathML ({{{file(.mml)}}}) source or its +OpenDocument formula ({{{file(.odf)}}}) file as shown below: + +#+begin_example + [[./equation.mml]] +#+end_example + +or + +#+begin_example + [[./equation.odf]] +#+end_example + +*** Labels and captions in ODT export + :PROPERTIES: + :DESCRIPTION: How captions are rendered + :END: + +You can label and caption various category of objects---an inline +image, a table, a LaTeX fragment or a Math formula---using +~#+LABEL~ and ~#+CAPTION~ lines. See [[Images and tables]]. ODT exporter +enumerates each labeled or captioned object of a given category +separately. As a result, each such object is assigned a sequence +number based on order of its appearance in the Org file. + +In the exported document, a user-provided caption is augmented with +the category and sequence number. Consider the following inline image +in an Org file: + +#+begin_example + ,#+CAPTION: Bell curve + ,#+LABEL: fig:SED-HR4049 + [[./img/a.png]] +#+end_example + +It could be rendered as shown below in the exported document. + +#+begin_example + Figure 2: Bell curve +#+end_example + +#+vindex: org-export-odt-category-strings + +You can modify the category component of the caption by customizing +the variable ~org-export-odt-category-strings~. For example, to tag +all embedded images with the string {{{samp(Illustration)}}} (instead +of the default {{{samp(Figure)}}}) use the following setting. + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-export-odt-category-strings + '(("en" "Table" "Illustration" "Equation" "Equation"))) +#+end_src + +With this, previous image will be captioned as below in the exported +document. + +#+begin_example + Illustration 2: Bell curve +#+end_example + +*** Literal examples in ODT export + :PROPERTIES: + :DESCRIPTION: How source and example blocks are formatted + :END: + +Export of literal examples (see [[Literal examples]]) with full +fontification is supported. Internally, the exporter relies on +{{{file(htmlfontify.el)}}} to generate all style definitions needed +for a fancy listing.[fn:138] The auto-generated styles have +{{{samp(OrgSrc)}}} as prefix and inherit their color from the faces +used by Emacs ~font-lock~ library for the source language. + +#+vindex: org-export-odt-fontify-srcblocks + +If you prefer to use your own custom styles for fontification, you can +do so by customizing the variable +~org-export-odt-create-custom-styles-for-srcblocks~. + +#+vindex: org-export-odt-create-custom-styles-for-srcblocks + +You can turn off fontification of literal examples by customizing the +variable ~org-export-odt-fontify-srcblocks~. + +*** Advanced topics in ODT export + :PROPERTIES: + :DESCRIPTION: Read this if you are a power user + :END: + +If you rely heavily on ODT export, you may want to exploit the full +set of features that the exporter offers. This section describes +features that would be of interest to power users. + +**** Configuring a document converter + :PROPERTIES: + :DESCRIPTION: How to register a document converter + :END: +#+cindex: convert +#+cindex: doc, docx, rtf +#+cindex: converter + +The ODT exporter can work with popular converters with little or no +extra configuration from your side. See [[Extending ODT export]]. If you +are using a converter that is not supported by default or if you would +like to tweak the default converter settings, proceed as below. + +#+attr_texinfo: :table-type table :indic @asis +- Register the converter :: + + #+vindex: org-export-odt-convert-processes + + Name your converter and add it to the list of known converters by + customizing the variable ~org-export-odt-convert-processes~. Also + specify how the converter can be invoked via command-line to effect + the conversion. + +- Configure its capabilities :: + + #+vindex: org-export-odt-convert-capabilities + # <<x-odt-converter-capabilities>> + + Specify the set of formats the converter can handle by customizing the + variable ~org-export-odt-convert-capabilities~. Use the default value + for this variable as a guide for configuring your converter. As suggested by + the default setting, you can specify the full set of formats supported by the + converter and not limit yourself to specifying formats that are related to + just the OpenDocument Text format. + +- Choose the converter :: + + #+vindex: org-export-odt-convert-process + + Select the newly added converter as the preferred one by customizing the + variable ~org-export-odt-convert-process~. + +**** Working with OpenDocument style files + :PROPERTIES: + :DESCRIPTION: Explore the internals + :END: +#+cindex: styles, custom +#+cindex: template, custom + +This section explores the internals of the ODT exporter and the means +by which it produces styled documents. Read this section if you are +interested in exploring the automatic and custom OpenDocument styles +used by the exporter. + +# <<x-factory-styles>> + +The ODT exporter relies on two files for generating its output. +These files are bundled with the distribution under the directory pointed to +by the variable ~org-odt-styles-dir~. The two files are: + +#+attr_texinfo: :table-type table :indic @asis +- {{{file(OrgOdtStyles.xml)}}} :: + <<x-orgodtstyles-xml>> + + This file contributes to the {{{file(styles.xml)}}} file of the final + {{{samp(ODT)}}} document. This file is modified to control outline + numbering based on user settings, and To add styles generated by + {{{file(htmlfontify.el)}}} for fontification of code blocks. + +- {{{file(OrgOdtContentTemplate.xml)}}} :: + <<x-orgodtcontenttemplate-xml>> + + This file contributes to the {{{file(content.xml)}}} file of the final + {{{samp(ODT)}}} document. The contents of the Org outline are inserted + between the ~<office:text>~ and ~</office:text>~ + elements of this file. + + In addition to serving as a template file for the final + {{{file(content.xml)}}}, the file also contains automatic styles for + formatting of tables which are referenced by the exporter, and + ~<text:sequence-decl>~ ... ~</text:sequence-decl>~ + elements that control how various entities---tables, images, + equations, etc.---are numbered. + + +<<x-overriding-factory-styles>> + +The following two variables control the location from which the ODT +exporter picks up the custom styles and content template files. You +can customize these variables to override the factory styles used by +the exporter. + +#+attr_texinfo: :table-type table :indic @asis +- ~org-export-odt-styles-file~ :: + <<x-org-export-odt-styles-file>> + + Use this variable to specify the {{{file(styles.xml)}}} that will be + used in the final output. You can specify one of the following values: + + - A {{{file(styles.xml)}}} file :: + + Use this file instead of the default {{{file(styles.xml)}}} + + - A {{{file(.odt)}}} or {{{file(.ott)}}} file :: + + Use the {{{file(styles.xml)}}} contained in the specified OpenDocument + Text or Template file. + + - A {{{file(.odt)}}} or {{{file(.ott)}}} file and a subset of files contained within them :: + + Use the {{{file(styles.xml)}}} contained in the specified OpenDocument + Text or Template file. Additionally extract the specified member files + and embed those within the final {{{samp(ODT)}}} document. + + Use this option if the {{{file(styles.xml)}}} file references + additional files like header and footer images. + + - ~nil~ :: + + Use the default {{{file(styles.xml)}}} + +- ~org-export-odt-content-template-file~ :: + <<x-org-export-odt-content-template-file>> + + Use this variable to specify the blank {{{file(content.xml)}}} that + will be used in the final output. + +**** Creating one-off styles + :PROPERTIES: + :DESCRIPTION: How to produce custom highlighting, etc. + :END: + +There are times when you would want one-off formatting in the exported +document. You can achieve this by embedding raw OpenDocument XML in +the Org file. The use of this feature is better illustrated with +couple of examples. + +#+attr_texinfo: :table-type table :indic @asis +- Embedding ODT tags as part of regular text :: + + You can include simple OpenDocument tags by prefixing them with + {{{samp(@)}}}. For example, to highlight a region of text do the + following: + + #+begin_example + @<text:span text:style-name="Highlight">This is a + highlighted text@</text:span>. But this is a + regular text. + #+end_example + + *Hint:* To see the above example in action, edit your + {{{file(styles.xml)}}} (see [[x-orgodtstyles-xml][Factory styles]]) and + add a custom {{{samp(Highlight)}}} style as shown below. + + #+begin_example + <style:style style:name="Highlight" style:family="text"> + <style:text-properties fo:background-color="#ff0000"/> + </style:style> + #+end_example + +- Embedding a one-line OpenDocument XML :: + + You can add a simple OpenDocument one-liner using the ~#+ODT:~ + directive. For example, to force a page break do the following: + + #+begin_example + #+ODT: <text:p text:style-name="PageBreak"/> + #+end_example + + *Hint:* To see the above example in action, edit your + {{{file(styles.xml)}}} (see [[x-orgodtstyles-xml][Factory styles]]) and + add a custom {{{samp(PageBreak)}}} style as shown below. + + #+begin_example + <style:style style:name="PageBreak" style:family="paragraph" + style:parent-style-name="Text_20_body"> + <style:paragraph-properties fo:break-before="page"/> + </style:style> + #+end_example + +- Embedding a block of OpenDocument XML :: + + You can add a large block of OpenDocument XML using the + ~#+BEGIN_ODT~ ... ~#+END_ODT~ construct. + + For example, to create a one-off paragraph that uses bold text, do the + following: + + #+begin_example + #+BEGIN_ODT + <text:p text:style-name="Text_20_body_20_bold"> + This paragraph is specially formatted and uses bold text. + </text:p> + #+END_ODT + #+end_example + +**** Customizing tables in ODT export + :PROPERTIES: + :DESCRIPTION: How to define and use table templates + :END: +#+cindex: tables, in ODT export +#+cindex: #+ATTR_ODT + +You can override the default formatting of the table by specifying a +custom table style with the ~#+ATTR_ODT~ line. For a discussion on +default formatting of tables see [[Tables in ODT export]]. + +This feature closely mimics the way table templates are defined in the +OpenDocument-v1.2 specification.[fn:139] + +To have a quick preview of this feature, install the following setting and +export the example table. + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp + (setq org-export-odt-table-styles + (append org-export-odt-table-styles + '(("TableWithHeaderRowAndColumn" "Custom" + ((use-first-row-styles . t) + (use-first-column-styles . t))) + ("TableWithFirstRowandLastRow" "Custom" + ((use-first-row-styles . t) + (use-last-row-styles . t)))))) +#+end_src + +#+begin_example + ,#+ATTR_ODT: :style "TableWithHeaderRowAndColumn" + | Name | Phone | Age | + | Peter | 1234 | 17 | + | Anna | 4321 | 25 | +#+end_example + +In the above example, you used a template named {{{samp(Custom)}}} and +installed two table styles with the names +{{{samp(TableWithHeaderRowAndColumn)}}} and +{{{samp(TableWithFirstRowandLastRow)}}}. (*Important:* The +OpenDocument styles needed for producing the above template have been +pre-defined for you. These styles are available under the section +marked {{{samp(Custom Table Template)}}} in +{{{file(OrgOdtContentTemplate.xml)}}} (see +[[x-orgodtcontenttemplate-xml][Factory styles]]). If you need additional +templates you have to define these styles yourself. + + +To use this feature proceed as follows: + +#+attr_texinfo: :table-type table :indic @asis +- Create a table template[fn:140] :: + + A table template is nothing but a set of {{{samp(table-cell)}}} and + {{{samp(paragraph)}}} styles for each of the following table cell + categories: + + - Body + - First column + - Last column + - First row + - Last row + - Even row + - Odd row + - Even column + - Odd Column + + The names for the above styles must be chosen based on the name of the + table template using a well-defined convention. + + The naming convention is better illustrated with an example. For a + table template with the name {{{samp(Custom)}}}, the needed style + names are listed in the following table. + + | Table cell type | ~table-cell~ style | ~paragraph~ style | + |-----------------+----------------------------------------+---------------------------------------------| + | Body | {{{samp(CustomTableCell)}}} | {{{samp(CustomTableParagraph)}}} | + | First column | {{{samp(CustomFirstColumnTableCell)}}} | {{{samp(CustomFirstColumnTableParagraph)}}} | + | Last column | {{{samp(CustomLastColumnTableCell)}}} | {{{samp(CustomLastColumnTableParagraph)}}} | + | First row | {{{samp(CustomFirstRowTableCell)}}} | {{{samp(CustomFirstRowTableParagraph)}}} | + | Last row | {{{samp(CustomLastRowTableCell)}}} | {{{samp(CustomLastRowTableParagraph)}}} | + | Even row | {{{samp(CustomEvenRowTableCell)}}} | {{{samp(CustomEvenRowTableParagraph)}}} | + | Odd row | {{{samp(CustomOddRowTableCell)}}} | {{{samp(CustomOddRowTableParagraph)}}} | + | Even column | {{{samp(CustomEvenColumnTableCell)}}} | {{{samp(CustomEvenColumnTableParagraph)}}} | + | Odd column | {{{samp(CustomOddColumnTableCell)}}} | {{{samp(CustomOddColumnTableParagraph)}}} | + + + To create a table template with the name {{{samp(Custom)}}}, define + the above styles in the ~<office:automatic-styles>~ ... + ~</office:automatic-styles>~ element of the content template file (see + [[x-orgodtcontenttemplate-xml][Factory styles]]). + +- Define a table style[fn:141] :: + + #+vindex: org-export-odt-table-styles + + To define a table style, create an entry for the style in the variable + ~org-export-odt-table-styles~ and specify the following: + + - the name of the table template created in step (1) + - the set of cell styles in that template that are to be activated + + + For example, the entry below defines two different table styles + {{{samp(TableWithHeaderRowAndColumn)}}} and + {{{samp(TableWithFirstRowandLastRow)}}} based on the same template + {{{samp(Custom)}}}. The styles achieve their intended effect by + selectively activating the individual cell styles in that template. + + #+header: :eval no + #+header: :exports code + #+begin_src emacs-lisp + (setq org-export-odt-table-styles + (append org-export-odt-table-styles + '(("TableWithHeaderRowAndColumn" "Custom" + ((use-first-row-styles . t) + (use-first-column-styles . t))) + ("TableWithFirstRowandLastRow" "Custom" + ((use-first-row-styles . t) + (use-last-row-styles . t)))))) + #+end_src + +- Associate a table with the table style :: + + To do this, specify the table style created in step (2) as part of + the ~ATTR_ODT~ line as shown below. + + #+begin_example + ,#+ATTR_ODT: :style "TableWithHeaderRowAndColumn" + | Name | Phone | Age | + | Peter | 1234 | 17 | + | Anna | 4321 | 25 | + #+end_example + +**** Validating OpenDocument XML + :PROPERTIES: + :DESCRIPTION: How to debug corrupt OpenDocument files + :END: + +Occasionally, you will discover that the document created by the ODT +exporter cannot be opened by your favorite application. One of the +common reasons for this is that the {{{file(.odt)}}} file is corrupt. +In such cases, you may want to validate the document against the +OpenDocument RELAX NG Compact Syntax (RNC) schema. + +For de-compressing the {{{file(.odt)}}} file[fn:142]: +[[info:emacs#File Archives]]. For general help with validation (and +schema-sensitive editing) of XML files: [[info:nxml-mode#Introduction]]. +#+vindex: org-export-odt-schema-dir + +If you have ready access to OpenDocument {{{file(.rnc)}}} files and +the needed schema-locating rules in a single folder, you can customize +the variable ~org-export-odt-schema-dir~ to point to that directory. +The ODT exporter will take care of updating the +~rng-schema-locating-files~ for you. + +** TaskJuggler export + :PROPERTIES: + :DESCRIPTION: Exporting to TaskJuggler + :END: +#+cindex: TaskJuggler export +#+cindex: Project management + +[[http://www.taskjuggler.org/][TaskJuggler]] is a project management tool. It provides an optimizing +scheduler that computes your project time lines and resource +assignments based on the project outline and the constraints that you +have provided. + +The TaskJuggler exporter is a bit different from other exporters, such +as the ~HTML~ and LaTeX exporters for example, in that it does not +export all the nodes of a document or strictly follow the order of the +nodes in the document. + +Instead the TaskJuggler exporter looks for a tree that defines the +tasks and optionally trees that define the resources and reports for +this project. It then creates a TaskJuggler file based on these trees +and the attributes defined in all the nodes. + +*** TaskJuggler export commands + :PROPERTIES: + :DESCRIPTION: Key bindings for TaskJuggler export + :END: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e j)}}}, ~org-export-as-taskjuggler~ :: + #+kindex: C-c C-e j + + Export as a TaskJuggler file. + +- {{{kbd(C-c C-e J)}}}, ~org-export-as-taskjuggler-and-open~ :: + #+kindex: C-c C-e J + + Export as a TaskJuggler file and then open the file with TaskJugglerUI + (only for TaskJugglerUI 2.x). + +*** Tasks + :PROPERTIES: + :DESCRIPTION: Marking tasks for TaskJuggler export + :END: +#+vindex: org-export-taskjuggler-project-tag + +Create your tasks as you usually do with Org mode. Assign efforts to +each task using properties (it is easiest to do this in the column +view). You should end up with something similar to the example by +Peter Jones in +[[http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org]]. +Now mark the top node of your tasks with a tag named +~:taskjuggler_project:~ (or whatever you customized +~org-export-taskjuggler-project-tag~ to). You are now ready to export +the project plan with {{{kbd(C-c C-e J)}}} which will export the +project plan and open a gantt chart in TaskJugglerUI. + +*** Resources + :PROPERTIES: + :DESCRIPTION: Define TaskJuggler resources + :END: +#+vindex: org-export-taskjuggler-resource-tag + +Next you can define resources and assign those to work on specific +tasks. You can group your resources hierarchically. Tag the top node +of the resources with ~:taskjuggler_resource:~ (or whatever you +customized ~org-export-taskjuggler-resource-tag~ to). You can +optionally assign an identifier (named {{{samp(resource_id)}}}) to the +resources (using the standard Org properties commands, see [[Property +syntax]]) or you can let the exporter generate identifiers automatically +(the exporter picks the first word of the headline as the identifier +as long as it is unique---see the documentation of +~org-taskjuggler-get-unique-id~). Using that identifier you can then +allocate resources to tasks. This is again done with the +{{{samp(allocate)}}} property on the tasks. Do this in column view or +when on the task type +{{{ksksksk(C-c C-x p allocate,RET,<resource_id>,RET)}}}. + +Once the allocations are done you can again export to TaskJuggler and +check in the Resource Allocation Graph which person is working on what +task at what time. + +*** Export of properties + :PROPERTIES: + :DESCRIPTION: Which properties will be exported? + :END: + +The exporter also takes TODO state information into consideration, +i.e., if a task is marked as done it will have the corresponding +attribute in TaskJuggler ({{{samp(complete 100)}}}). Scheduling +information is also taken into account to set start/end dates for +tasks. + +The exporter will also export any property on a task resource or +resource node which is known to TaskJuggler, such as +{{{samp(limits)}}}, {{{samp(vacation)}}}, {{{samp(shift)}}}, +{{{samp(booking)}}}, {{{samp(efficiency)}}}, {{{samp(journalentry)}}}, +{{{samp(rate)}}} for resources or {{{samp(account)}}}, +{{{samp(start)}}}, {{{samp(note)}}}, {{{samp(duration)}}}, +{{{samp(end)}}}, {{{samp(journalentry)}}}, {{{samp(milestone)}}}, +{{{samp(reference)}}}, {{{samp(responsible)}}}, +{{{samp(scheduling)}}}, etc for tasks. + +*** Dependencies + :PROPERTIES: + :DESCRIPTION: How the exporter handles dependencies + :END: + +The exporter will handle dependencies that are defined in the tasks +either with the {{{samp(ORDERED)}}} attribute (see [[TODO dependencies]]), +with the {{{samp(BLOCKER)}}} attribute (see {{{file(org-depend.el)}}}) +or alternatively with a {{{samp(depends)}}} attribute. Both the +{{{samp(BLOCKER)}}} and the {{{samp(depends)}}} attribute can be +either {{{samp(previous-sibling)}}} or a reference to an identifier +(named {{{samp(task_id)}}}) which is defined for another task in the +project. {{{samp(BLOCKER)}}} and the {{{samp(depends)}}} attribute can +define multiple dependencies separated by either space or comma. You +can also specify optional attributes on the dependency by simply +appending it. The following examples should illustrate this: + +#+begin_example + ,* Preparation + , :PROPERTIES: + , :task_id: preparation + , :ORDERED: t + , :END: + ,* Training material + , :PROPERTIES: + , :task_id: training_material + , :ORDERED: t + , :END: + ,** Markup Guidelines + , :PROPERTIES: + , :Effort: 2d + , :END: + ,** Workflow Guidelines + , :PROPERTIES: + , :Effort: 2d + , :END: + ,* Presentation + , :PROPERTIES: + , :Effort: 2d + , :BLOCKER: training_material { gapduration 1d } preparation + , :END: +#+end_example + +*** Reports + :PROPERTIES: + :DESCRIPTION: Gantt charts, etc. + :END: +#+vindex: org-export-taskjuggler-default-reports + +TaskJuggler can produce many kinds of reports (e.g., gantt chart, +resource allocation, etc). The user defines what kind of reports +should be generated for a project in the TaskJuggler file. By default, +the exporter will automatically insert some pre-set reports in the +file. These defaults are defined in +~org-export-taskjuggler-default-reports~. They can be modified using +customize along with a number of other options. For a more complete +list, see +{{{ksksksk(M-x customize-group,RET,org-export-taskjuggler,RET)}}}. + +Alternately, the user can tag a tree with +~org-export-taskjuggler-report-tag~, and define reports in sub-nodes, +similarly to what is done with tasks or resources. The properties used +for report generation are defined in +~org-export-taskjuggler-valid-report-attributes~. In addition, a +special property named {{{samp(report-kind)}}} is used to define the +kind of report one wants to generate (by default, a +{{{samp(taskreport)}}}). + +For more information and examples see the Org-taskjuggler tutorial at +[[http://orgmode.org/worg/org-tutorials/org-taskjuggler.html]]. + +** Freemind export + :PROPERTIES: + :DESCRIPTION: Exporting to Freemind mind maps + :END: +#+cindex: Freemind export +#+cindex: mind map + +The Freemind exporter was written by Lennart Borgman. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e m)}}}, ~org-export-as-freemind~ :: + #+kindex: C-c C-e m + + Export as a Freemind mind map. For an Org file {{{file(myfile.org)}}}, + the Freemind file will be {{{file(myfile.mm)}}}. + +** XOXO export + :PROPERTIES: + :DESCRIPTION: Exporting to XOXO + :END: +#+cindex: XOXO export + +Org mode contains an exporter that produces XOXO-style output. +Currently, this exporter only handles the general outline structure +and does not interpret any additional Org mode features. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e x)}}}, ~org-export-as-xoxo~ :: + #+kindex: C-c C-e x + + Export as an XOXO file. For an Org file {{{file(myfile.org)}}}, the + XOXO file will be {{{file(myfile.html)}}}. + +- {{{kbd(C-c C-e v x)}}} :: + #+kindex: C-c C-e v x + + Export only the visible part of the document. + +** iCalendar export + :PROPERTIES: + :DESCRIPTION: Exporting to iCalendar format + :END: +#+cindex: iCalendar export + +#+vindex: org-icalendar-include-todo +#+vindex: org-icalendar-use-deadline +#+vindex: org-icalendar-use-scheduled +#+vindex: org-icalendar-categories +#+vindex: org-icalendar-alarm-time + +Some people use Org mode for keeping track of projects, but still +prefer a standard calendar application for anniversaries and +appointments. In this case it can be useful to show deadlines and +other time-stamped items in Org files in the calendar application. Org +mode can export calendar information in the standard iCalendar format. +If you also want to have TODO entries included in the export, +configure the variable ~org-icalendar-include-todo~. Plain timestamps +are exported as VEVENT, and TODO items as VTODO. It will also create +events from deadlines that are in non-TODO items. Deadlines and +scheduling dates in TODO items will be used to set the start and due +dates for the TODO entry.[fn:143] As categories, it will use the tags +locally defined in the heading, and the file/tree category.[fn:144] +See the variable ~org-icalendar-alarm-time~ for a way to assign alarms +to entries with a time. + +#+vindex: org-icalendar-store-UID +#+cindex: property, ID + +The iCalendar standard requires each entry to have a globally unique +identifier (UID). Org creates these identifiers during export. If you +set the variable ~org-icalendar-store-UID~, the UID will be stored in +the ~:ID:~ property of the entry and re-used next time you report this +entry. Since a single entry can give rise to multiple iCalendar +entries (as a timestamp, a deadline, a scheduled item, and as a TODO +item), Org adds prefixes to the UID, depending on what triggered the +inclusion of the entry. In this way the UID remains unique, but a +synchronization program can still figure out from which entry all the +different instances originate. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e i)}}}, ~org-export-icalendar-this-file~ :: + #+kindex: C-c C-e i + + Create iCalendar entries for the current file and store them in the + same directory, using a file extension {{{file(.ics)}}}. + +- {{{kbd(C-c C-e I)}}}, ~ org-export-icalendar-all-agenda-files~ :: + #+kindex: C-c C-e I + #+vindex: org-agenda-files + + Like {{{kbd(C-c C-e i)}}}, but do this for all files in + ~org-agenda-files~. For each of these files, a separate iCalendar file + will be written. + +- {{{kbd(C-c C-e c)}}}, ~org-export-icalendar-combine-agenda-files~ :: + #+kindex: C-c C-e c + #+vindex: org-combined-agenda-icalendar-file + + Create a single large iCalendar file from all files in + ~org-agenda-files~ and write it to the file given by + ~org-combined-agenda-icalendar-file~. + + +#+vindex: org-use-property-inheritance +#+vindex: org-icalendar-include-body +#+cindex: property, SUMMARY +#+cindex: property, DESCRIPTION +#+cindex: property, LOCATION + +The export will honor SUMMARY, DESCRIPTION and LOCATION properties if +the selected entries have them.[fn:145] If not, the summary will be +derived from the headline, and the description from the body (limited +to ~org-icalendar-include-body~ characters). + +How this calendar is best read and updated, depends on the application +you are using. The FAQ covers this issue. + +* Publishing + :PROPERTIES: + :DESCRIPTION: Create a web site of linked Org files + :END: +#+cindex: publishing +#+cindex: O'Toole, David + +Org includes a publishing management system that allows you to +configure automatic HTML conversion of /projects/ composed of +interlinked org files. You can also configure Org to automatically +upload your exported HTML pages and related attachments, such as +images and source code files, to a web server. + +You can also use Org to convert files into PDF, or even combine HTML +and PDF conversion so that files are available in both formats on the +server. + +Publishing has been contributed to Org by David O'Toole. + +** Configuration + :PROPERTIES: + :DESCRIPTION: Defining projects + :END: +Publishing needs significant configuration to specify files, +destination and many other properties of a project. + +*** Project alist + :PROPERTIES: + :DESCRIPTION: The central configuration variable + :TITLE: The variable ~org-publish-project-alist~ + :END: +#+cindex: org-publish-project-alist +#+cindex: projects, for publishing +#+vindex: org-publish-project-alist + +Publishing is configured almost entirely through setting the value of +one variable, called ~org-publish-project-alist~. Each element of the +list configures one project, and may be in one of the two following +forms: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp + ("project-name" :property value :property value ...) +#+end_src + +i.e., a well-formed property list with alternating keys and values, +or: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp + ("project-name" :components ("project-name" "project-name" ...)) +#+end_src + +In both cases, projects are configured by specifying property values. +A project defines the set of files that will be published, as well as +the publishing configuration to use when publishing those files. When +a project takes the second form listed above, the individual members +of the ~:components~ property are taken to be sub-projects, which +group together files requiring different publishing options. When you +publish such a "meta-project," all the components will also be +published, in the sequence given. + +*** Sources and destinations + :PROPERTIES: + :DESCRIPTION: From here to there + :TITLE: Sources and destinations for files + :END: +#+cindex: directories, for publishing + +Most properties are optional, but some should always be set. In +particular, Org needs to know where to look for source files, and +where to put published files. + +#+attr_texinfo: :table-type table :indic @asis +- ~:base-directory~ :: + + Directory containing publishing source files + +- ~:publishing-directory~ :: + + Directory where output files will be published. You can directly + publish to a webserver using a file name syntax appropriate for the + Emacs {{{file(tramp)}}} package. Or you can publish to a local + directory and use external tools to upload your website + (see [[Uploading files]]). + +- ~:preparation-function~ :: + + Function or list of functions to be called before starting the + publishing process, for example, to run ~make~ for updating files to + be published. The project property list is scoped into this call as + the variable ~project-plist~. + +- ~:completion-function~ :: + + Function or list of functions called after finishing the publishing + process, for example, to change permissions of the resulting files. + The project property list is scoped into this call as the variable + ~project-plist~. + +*** Selecting files + :PROPERTIES: + :DESCRIPTION: What files are part of the project? + :END: +#+cindex: files, selecting for publishing + +By default, all files with extension {{{file(.org)}}} in the base directory +are considered part of the project. This can be modified by setting the +following properties: + +#+attr_texinfo: :table-type table :indic @asis +- ~:base-extension~ :: + + Extension (without the dot!) of source files. This actually is a + regular expression. Set this to the symbol ~any~ if you want to get + all files in ~:base-directory~, even without extension. + +- ~:exclude~ :: + + Regular expression to match file names that should not be published, + even though they have been selected on the basis of their extension. + +- ~:include~ :: + + List of files to be included regardless of ~:base-extension~ and + ~:exclude~. + +- ~:recursive~ :: + + Non-nil means, check base-directory recursively for files to publish. + +*** Publishing action + :PROPERTIES: + :DESCRIPTION: Setting the function doing the publishing + :END: +#+cindex: action, for publishing + +Publishing means that a file is copied to the destination directory and +possibly transformed in the process. The default transformation is to export +Org files as HTML files, and this is done by the function +~org-publish-org-to-html~ which calls the HTML exporter (see [[HTML +export]]). But you also can publish your content as PDF files using +~org-publish-org-to-pdf~, or as ~ascii~, ~latin1~ or +~utf8~ encoded files using the corresponding functions. If you want to +publish the Org file itself, but with /archived/, /commented/, and +/tag-excluded/ trees removed, use ~org-publish-org-to-org~ and set the +parameters ~:plain-source~ and/or ~:htmlized-source~. This will +produce {{{file(file.org)}}} and {{{file(file.org.html)}}} in the publishing +directory.[fn:146] Other files like images only need to be copied to the +publishing destination; for this you may use ~org-publish-attachment~. +For non-Org files, you always need to specify the publishing function: + +#+attr_texinfo: :table-type table :indic @asis +- ~:publishing-function~ :: + + Function executing the publication of a file. This may also be a list + of functions, which will all be called in turn. + +- ~:plain-source~ :: + + Non-nil means, publish plain source. + +- ~:htmlized-source~ :: + + Non-nil means, publish htmlized source. + + +The function must accept three arguments: a property list containing +at least a ~:publishing-directory~ property, the name of the file to +be published, and the path to the publishing directory of the output +file. It should take the specified file, make the necessary +transformation (if any) and place the result into the destination +folder. + +*** Publishing options + :PROPERTIES: + :DESCRIPTION: Tweaking HTML/LaTeX export + :END: +#+cindex: options, for publishing + +The property list can be used to set many export options for the HTML +and LaTeX exporters. In most cases, these properties correspond to user +variables in Org. The table below lists these properties along +with the variable they belong to. See the documentation string for the +respective variable for details. + +#+vindex: org-export-html-link-up +#+vindex: org-export-html-link-home +#+vindex: org-export-default-language +#+vindex: org-display-custom-times +#+vindex: org-export-headline-levels +#+vindex: org-export-with-section-numbers +#+vindex: org-export-section-number-format +#+vindex: org-export-with-toc +#+vindex: org-export-preserve-breaks +#+vindex: org-export-with-archived-trees +#+vindex: org-export-with-emphasize +#+vindex: org-export-with-sub-superscripts +#+vindex: org-export-with-special-strings +#+vindex: org-export-with-footnotes +#+vindex: org-export-with-drawers +#+vindex: org-export-with-tags +#+vindex: org-export-with-todo-keywords +#+vindex: org-export-with-tasks +#+vindex: org-export-with-done-tasks +#+vindex: org-export-with-priority +#+vindex: org-export-with-TeX-macros +#+vindex: org-export-with-LaTeX-fragments +#+vindex: org-export-skip-text-before-1st-heading +#+vindex: org-export-with-fixed-width +#+vindex: org-export-with-timestamps +#+vindex: org-export-author-info +#+vindex: org-export-email-info +#+vindex: org-export-creator-info +#+vindex: org-export-time-stamp-file +#+vindex: org-export-with-tables +#+vindex: org-export-highlight-first-table-line +#+vindex: org-export-html-style-include-default +#+vindex: org-export-html-style-include-scripts +#+vindex: org-export-html-style +#+vindex: org-export-html-style-extra +#+vindex: org-export-html-link-org-files-as-html +#+vindex: org-export-html-inline-images +#+vindex: org-export-html-extension +#+vindex: org-export-html-table-tag +#+vindex: org-export-html-expand +#+vindex: org-export-html-with-timestamp +#+vindex: org-export-publishing-directory +#+vindex: org-export-html-preamble +#+vindex: org-export-html-postamble +#+vindex: user-full-name +#+vindex: user-mail-address +#+vindex: org-export-select-tags +#+vindex: org-export-exclude-tags + +#+attr_texinfo: :table-type table :indic @asis +- ~:link-up~ :: ~org-export-html-link-up~ +- ~:link-home~ :: ~org-export-html-link-home~ +- ~:language~ :: ~org-export-default-language~ +- ~:customtime~ :: ~org-display-custom-times~ +- ~:headline-levels~ :: ~org-export-headline-levels~ +- ~:section-numbers~ :: ~org-export-with-section-numbers~ +- ~:section-number-format~ :: ~org-export-section-number-format~ +- ~:table-of-contents~ :: ~org-export-with-toc~ +- ~:preserve-breaks~ :: ~org-export-preserve-breaks~ +- ~:archived-trees~ :: ~org-export-with-archived-trees~ +- ~:emphasize~ :: ~org-export-with-emphasize~ +- ~:sub-superscript~ :: ~org-export-with-sub-superscripts~ +- ~:special-strings~ :: ~org-export-with-special-strings~ +- ~:footnotes~ :: ~org-export-with-footnotes~ +- ~:drawers~ :: ~org-export-with-drawers~ +- ~:tags~ :: ~org-export-with-tags~ +- ~:todo-keywords~ :: ~org-export-with-todo-keywords~ +- ~:tasks~ :: ~org-export-with-tasks~ +- ~:priority~ :: ~org-export-with-priority~ +- ~:TeX-macros~ :: ~org-export-with-TeX-macros~ +- ~:LaTeX-fragments~ :: ~org-export-with-LaTeX-fragments~ +- ~:latex-listings~ :: ~org-export-latex-listings~ +- ~:skip-before-1st-heading~ :: ~org-export-skip-text-before-1st-heading~ +- ~:fixed-width~ :: ~org-export-with-fixed-width~ +- ~:timestamps~ :: ~org-export-with-timestamps~ +- ~:author~ :: ~user-full-name~ +- ~:email~ :: ~user-mail-address~ : ~addr;addr;..~ +- ~:author-info~ :: ~org-export-author-info~ +- ~:email-info~ :: ~org-export-email-info~ +- ~:creator-info~ :: ~org-export-creator-info~ +- ~:tables~ :: ~org-export-with-tables~ +- ~:table-auto-headline~ :: ~org-export-highlight-first-table-line~ +- ~:style-include-default~ :: ~org-export-html-style-include-default~ +- ~:style-include-scripts~ :: ~org-export-html-style-include-scripts~ +- ~:style~ :: ~org-export-html-style~ +- ~:style-extra~ :: ~org-export-html-style-extra~ +- ~:convert-org-links~ :: ~org-export-html-link-org-files-as-html~ +- ~:inline-images~ :: ~org-export-html-inline-images~ +- ~:html-extension~ :: ~org-export-html-extension~ +- ~:html-preamble~ :: ~org-export-html-preamble~ +- ~:html-postamble~ :: ~org-export-html-postamble~ +- ~:xml-declaration~ :: ~org-export-html-xml-declaration~ +- ~:html-table-tag~ :: ~org-export-html-table-tag~ +- ~:expand-quoted-html~ :: ~org-export-html-expand~ +- ~:timestamp~ :: ~org-export-html-with-timestamp~ +- ~:publishing-directory~ :: ~org-export-publishing-directory~ +- ~:select-tags~ :: ~org-export-select-tags~ +- ~:exclude-tags~ :: ~org-export-exclude-tags~ +- ~:latex-image-options~ :: ~org-export-latex-image-default-option~ + + +Most of the ~org-export-with-*~ variables have the same effect in both +HTML and LaTeX exporters, except for ~:TeX-macros~ and +~:LaTeX-fragments~ options, respectively ~nil~ and ~t~ in the LaTeX +export. See ~org-export-plist-vars~ to check this list of options. + +#+vindex: org-publish-project-alist + +When a property is given a value in ~org-publish-project-alist~, its +setting overrides the value of the corresponding user variable (if +any) during publishing. Options set within a file (see [[Export +options]]), however, override everything. + +*** Publishing links + :PROPERTIES: + :DESCRIPTION: Which links keep working after publishing? + :END: +#+cindex: links, publishing + +To create a link from one Org file to another, you would use something +like ~[[file:foo.org][The foo]]~ or simply ~[[file:foo.org]]~ (see +[[Hyperlinks]]). When published, this link becomes a link to +{{{file(foo.html)}}}. In this way, you can interlink the pages of your +"org web" project and the links will work as expected when you publish +them to HTML. If you also publish the Org source file and want to link +to that, use an ~http:~ link instead of a ~file:~ link, because +~file:~ links are converted to link to the corresponding +{{{file(html)}}} file. + +You may also link to related files, such as images. Provided you are +careful with relative file names, and provided you have also +configured Org to upload the related files, these links will work too. +See [[Complex example]], for an example of this usage. + +Sometimes an Org file to be published may contain links that are only +valid in your production environment, but not in the publishing +location. In this case, use the following property to define a +function for checking link validity: + +#+attr_texinfo: :table-type table :indic @asis +- ~:link-validation-function~ :: + Function to validate links + + +{{{noindent}}} This function must accept two arguments, the file name +and a directory relative to which the file name is interpreted in the +production environment. If this function returns ~nil~, then the HTML +generator will only insert a description into the HTML file, but no +link. One option for this function is ~org-publish-validate-link~ +which checks if the given file is part of any project in +~org-publish-project-alist~. + +*** Site map + :PROPERTIES: + :DESCRIPTION: Generating a list of all pages + :TITLE: Generating a sitemap + :END: +#+cindex: sitemap, of published pages + +The following properties may be used to control publishing of +a map of files for a given project. + +#+attr_texinfo: :table-type table :indic @asis +- ~:auto-sitemap~ :: + + When non-nil, publish a sitemap during ~org-publish-current-project~ + or ~org-publish-all~. + +- ~:sitemap-filename~ :: + + Filename for output of sitemap. Defaults to {{{file(sitemap.org)}}} (which + becomes {{{file(sitemap.html)}}}). + +- ~:sitemap-title~ :: + + Title of sitemap page. Defaults to name of file. + +- ~:sitemap-function~ :: + + Plug-in function to use for generation of the sitemap. Defaults to + ~org-publish-org-sitemap~, which generates a plain list of links to + all files in the project. + +- ~:sitemap-sort-folders~ :: + + Where folders should appear in the sitemap. Set this to ~first~ + (default) or ~last~ to display folders first or last, respectively. + Any other value will mix files and folders. + +- ~:sitemap-sort-files~ :: + + How the files are sorted in the site map. Set this to ~alphabetically~ + (default), ~chronologically~ or ~anti-chronologically~. + ~chronologically~ sorts the files with older date first while + ~anti-chronologically~ sorts the files with newer date first. + ~alphabetically~ sorts the files alphabetically. The date of a file is + retrieved with ~org-publish-find-date~. + +- ~:sitemap-ignore-case~ :: + + Should sorting be case-sensitive? Default ~nil~. + +- ~:sitemap-file-entry-format~ :: + + With this option one can tell how a sitemap's entry is formatted in + the sitemap. This is a format string with some escape sequences: ~%t~ + stands for the title of the file, ~%a~ stands for the author of the + file and ~%d~ stands for the date of the file. The date is retrieved + with the ~org-publish-find-date~ function and formatted with + ~org-publish-sitemap-date-format~. Default ~%t~. + +- ~:sitemap-date-format~ :: + + Format string for the ~format-time-string~ function that tells how a + sitemap entry's date is to be formatted. This property bypasses + ~org-publish-sitemap-date-format~ which defaults to ~%Y-%m-%d~. + +- ~:sitemap-sans-extension~ :: + + When non-nil, remove filenames' extensions from the generated sitemap. + Useful to have cool URIs (see [[http://www.w3.org/Provider/Style/URI]]). + Defaults to ~nil~. + +*** Generating an index + :PROPERTIES: + :DESCRIPTION: An index that reaches across pages + :END: +#+cindex: index, in a publishing project + +Org mode can generate an index across the files of a publishing project. + +#+attr_texinfo: :table-type table :indic @asis +- ~:makeindex~ :: + + When non-nil, generate in index in the file {{{file(theindex.org)}}} + and publish it as {{{file(theindex.html)}}}. + + +The file will be created when first publishing a project with the +~:makeindex~ set. The file only contains a statement +{{{samp(#+INCLUDE: "theindex.inc")}}}. You can then build around this +include statement by adding a title, style information, etc. + +** Uploading files + :PROPERTIES: + :DESCRIPTION: How to get files up on the server + :END: +#+cindex: rsync +#+cindex: unison + +For those people already utilizing third party sync tools such as +{{{command(rsync)}}} or {{{command(unison)}}}, it might be preferable +not to use the built in remote publishing facilities of Org mode +which rely heavily on Tramp. Tramp, while very useful and powerful, +tends not to be so efficient for multiple file transfer and has been +known to cause problems under heavy usage. + +Specialized synchronization utilities offer several advantages. In +addition to timestamp comparison, they also do content and +permissions/attribute checks. For this reason you might prefer to +publish your web to a local directory (possibly even in place with +your Org files) and then use {{{file(unison)}}} or {{{file(rsync)}}} +to do the synchronization with the remote host. + +Since Unison (for example) can be configured as to which files to +transfer to a certain remote destination, it can greatly simplify the +project publishing definition. Simply keep all files in the correct +location, process your Org files with ~org-publish~ and let the +synchronization tool do the rest. You do not need, in this scenario, +to include attachments such as {{{file(jpg)}}}, {{{file(css)}}} or +{{{file(gif)}}} files in the project definition since the 3rd party +tool syncs them. + +Publishing to a local directory is also much faster than to a remote +one, so that you can afford more easily to republish entire projects. +If you set ~org-publish-use-timestamps-flag~ to ~nil~, you gain the +main benefit of re-including any changed external files such as source +example files you might include with ~#+INCLUDE:~. The timestamp +mechanism in Org is not smart enough to detect if included files have +been modified. + +** Sample configuration + :PROPERTIES: + :DESCRIPTION: Example projects + :END: +Below we provide two example configurations. The first one is a simple +project publishing only a set of Org files. The second example is +more complex, with a multi-component project. + +*** Simple example + :PROPERTIES: + :DESCRIPTION: One-component publishing + :TITLE: Example: simple publishing configuration + :END: +This example publishes a set of Org files to the {{{file(public_html)}}} +directory on the local machine. + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-publish-project-alist + '(("org" + :base-directory "~/org/" + :publishing-directory "~/public_html" + :section-numbers nil + :table-of-contents nil + :style "<link rel=\"stylesheet\" + href=\"../other/mystyle.css\" + type=\"text/css\"/>"))) +#+end_src + +*** Complex example + :PROPERTIES: + :DESCRIPTION: A multi-component publishing example + :TITLE: Example: complex publishing configuration + :END: +This more complicated example publishes an entire website, including +Org files converted to HTML, image files, Emacs Lisp source code, and +style sheets. The publishing directory is remote and private files are +excluded. + +To ensure that links are preserved, care should be taken to replicate +your directory structure on the web server, and to use relative file +paths. For example, if your Org files are kept in {{{file(~/org)}}} +and your publishable images in {{{file(~/images)}}}, you would link to +an image with + +#+begin_example + file:../images/myimage.png +#+end_example + +On the web server, the relative path to the image should be the +same. You can accomplish this by setting up an "images" folder in the +right place on the web server, and publishing images to it. + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-publish-project-alist + '(("orgfiles" + :base-directory "~/org/" + :base-extension "org" + :publishing-directory "/ssh:user@@host:~/html/notebook/" + :publishing-function org-publish-org-to-html + :exclude "PrivatePage.org" ;; regexp + :headline-levels 3 + :section-numbers nil + :table-of-contents nil + :style "<link rel=\"stylesheet\" + href=\"../other/mystyle.css\" type=\"text/css\"/>" + :html-preamble t) + + ("images" + :base-directory "~/images/" + :base-extension "jpg\\|gif\\|png" + :publishing-directory "/ssh:user@@host:~/html/images/" + :publishing-function org-publish-attachment) + + ("other" + :base-directory "~/other/" + :base-extension "css\\|el" + :publishing-directory "/ssh:user@@host:~/html/other/" + :publishing-function org-publish-attachment) + ("website" :components ("orgfiles" "images" "other")))) +#+end_src + +** Triggering publication + :PROPERTIES: + :DESCRIPTION: Publication commands + :END: +Once properly configured, Org can publish with the following commands: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-e X)}}}, ~org-publish~ :: + #+kindex: C-c C-e X + + Prompt for a specific project and publish all files that belong to it. + +- {{{kbd(C-c C-e P)}}}, ~org-publish-current-project~ :: + #+kindex: C-c C-e P + + Publish the project containing the current file. + +- {{{kbd(C-c C-e F)}}}, ~org-publish-current-file~ :: + #+kindex: C-c C-e F + + Publish only the current file. + +- {{{kbd(C-c C-e E)}}}, ~org-publish-all~ :: + #+kindex: C-c C-e E + + Publish every project. + + +#+vindex: org-publish-use-timestamps-flag + +Org uses timestamps to track when a file has changed. The above +functions normally only publish changed files. You can override this +and force publishing of all files by giving a prefix argument to any +of the commands above, or by customizing the variable +~org-publish-use-timestamps-flag~. This may be necessary in particular +if files include other files via ~#+SETUPFILE:~ or ~#+INCLUDE:~. + +* Working with source code + :PROPERTIES: + :DESCRIPTION: Export, evaluate, and tangle code blocks + :ALT_TITLE: Working With Source Code + :END: +#+cindex: Schulte, Eric +#+cindex: Davison, Dan +#+cindex: source code, working with + +Source code can be included in Org mode documents using a +{{{samp(src)}}} block, e.g.: + +#+begin_example + #+BEGIN_SRC emacs-lisp + (defun org-xor (a b) + "Exclusive or." + (if a (not b) b)) + #+END_SRC +#+end_example + +Org mode provides a number of features for working with live source +code, including editing of code blocks in their native major-mode, +evaluation of code blocks, converting code blocks into source files +(known as "tangling" in literate programming), and exporting code +blocks and their results in several formats. This functionality was +contributed by Eric Schulte and Dan Davison, and was originally named +Org-babel. + +The following sections describe Org mode's code block handling facilities. + +** Structure of code blocks + :PROPERTIES: + :DESCRIPTION: Code block syntax described + :END: +#+cindex: code block, structure +#+cindex: source code, block structure +#+cindex: #+NAME +#+cindex: #+BEGIN_SRC + +Live code blocks can be specified with a {{{samp(src)}}} block or +inline.[fn:147] The structure of a {{{samp(src)}}} block is shown in +the following example: + +#+begin_example + ,#+NAME: <name> + ,#+BEGIN_SRC <language> <switches> <header arguments> + <body> + ,#+END_SRC +#+end_example + +The ~#+NAME:~ line is optional, and can be used to name the code +block. Live code blocks require that a language be specified on the +~#+BEGIN_SRC~ line. Switches and header arguments are optional. +#+cindex: source code, inline + +Live code blocks can also be specified inline using the following +syntax: + +#+begin_example + src_<language>{<body>} +#+end_example + +or + +#+begin_example + src_<language>[<header arguments>]{<body>} +#+end_example + +#+attr_texinfo: :table-type table :indic @asis +- ~<#+NAME: name>~ :: + #+cindex: #+NAME + + This line associates a name with the code block. This is similar to + the ~#+TBLNAME: NAME~ lines that can be used to name tables in Org + mode files. Referencing the name of a code block makes it possible to + evaluate the block from other places in the file, from other files, or + from Org mode table formulas (see [[The spreadsheet]]). Names are assumed + to be unique and the behavior of Org mode when two or more blocks + share the same name is undefined. + +- ~<language>~ :: + #+cindex: source code, language + + The language of the code in the block (see [[Languages]]). + +- ~<switches>~ :: + #+cindex: source code, switches + + Optional switches control code block export (see the discussion of + switches in [[Literal examples]]). + +- ~<header arguments>~ :: + #+cindex: source code, header arguments + + Optional header arguments control many aspects of evaluation, export + and tangling of code blocks (see [[Header arguments]]). Header arguments + can also be set on a per-buffer or per-subtree basis using properties. + +- ~<body>~ :: + + Source code in the specified language. + +** Editing source code + :PROPERTIES: + :DESCRIPTION: Language major-mode editing + :END: +#+cindex: code block, editing +#+cindex: source code, editing +#+kindex: C-c ' + +Use {{{kbd(C-c ')}}} to edit the current code block. This brings up a +language major-mode edit buffer containing the body of the code block. +Saving this buffer will write the new contents back to the Org buffer. +Use {{{kbd(C-c ')}}} again to exit. + +The ~org-src-mode~ minor mode will be active in the edit buffer. The +following variables can be used to configure the behavior of the edit +buffer. See also the customization group ~org-edit-structure~ for +further configuration options. + +#+attr_texinfo: :table-type table :indic @asis +- ~org-src-lang-modes~ :: + + If an Emacs major-mode named ~<lang>-mode~ exists, where + ~<lang>~ is the language named in the header line of the code block, + then the edit buffer will be placed in that major-mode. This variable + can be used to map arbitrary language names to existing major modes. + +- ~org-src-window-setup~ :: + + Controls the way Emacs windows are rearranged when the edit buffer is + created. + +- ~org-src-preserve-indentation~ :: + + This variable is especially useful for tangling languages such as + Python, in which whitespace indentation in the output is meaningful. + +- ~org-src-ask-before-returning-to-edit-buffer~ :: + + By default, Org will ask before returning to an open edit buffer. Set this + variable to nil to switch without asking. + + +To turn on native code fontification in the Org mode buffer, configure +the variable ~org-src-fontify-natively~. + +** Exporting code blocks + :PROPERTIES: + :DESCRIPTION: Export contents and/or results + :END: +#+cindex: code block, exporting +#+cindex: source code, exporting + +It is possible to export the /code/ of code blocks, the /results/ of +code block evaluation, /both/ the code and the results of code block +evaluation, or /none/. For most languages, the default exports code. +However, for some languages (e.g., ~ditaa~) the default exports the +results of code block evaluation. For information on exporting code +block bodies, see [[Literal examples]]. + +The ~:exports~ header argument can be used to specify export +behavior with the following arguments: + +#+attr_texinfo: :table-type table :indic @asis +- ~:exports code~ :: + + The default in most languages. The body of the code block is exported, as + described in [[Literal examples]]. + +- ~:exports results~ :: + + The code block will be evaluated and the results will be placed in the + Org mode buffer for export, either updating previous results of the + code block located anywhere in the buffer or, if no previous results + exist, placing the results immediately after the code block. The body + of the code block will not be exported. + +- ~:exports both~ :: + + Both the code block and its results will be exported. + +- ~:exports none~ :: + + Neither the code block nor its results will be exported. + + +It is possible to inhibit the evaluation of code blocks during export. +Setting the ~org-export-babel-evaluate~ variable to ~nil~ will ensure +that no code blocks are evaluated as part of the export process. This +can be useful in situations where potentially untrusted Org mode files +are exported in an automated fashion, for example when Org mode is +used as the markup language for a wiki. + +** Extracting source code + :PROPERTIES: + :DESCRIPTION: Create pure source code files + :END: +#+cindex: tangling +#+cindex: source code, extracting +#+cindex: code block, extracting source code + +Creating pure source code files by extracting code from source blocks +is referred to as "tangling"---a term adopted from the literate +programming community. During tangling of code blocks their bodies are +expanded using ~org-babel-expand-src-block~ which can expand both +variable and ``noweb'' style references (see [[Noweb reference syntax]]). + +*** Header arguments for tangling +#+attr_texinfo: :table-type table :indic @asis +- ~:tangle no~ :: + + The default. The code block is not included in the tangled output. + +- ~:tangle yes~ :: + + Include the code block in the tangled output. The output file name is + the name of the org file with the extension {{{samp(.org)}}} replaced + by the extension for the block language. + +- ~:tangle filename~ :: + + Include the code block in the tangled output to file {{{samp(filename)}}}. + +*** Functions for tangling +#+attr_texinfo: :table-type table :indic @asis +- ~org-babel-tangle~ :: + #+kindex: C-c C-v t + + Tangle the current file. Bound to {{{kbd(C-c C-v t)}}}. + + With a prefix argument only tangle the current code block. + +- ~org-babel-tangle-file~ :: + #+kindex: C-c C-v f + + Choose a file to tangle. Bound to {{{kbd(C-c C-v f)}}}. + +*** Hooks for tangling +#+attr_texinfo: :table-type table :indic @asis +- ~org-babel-post-tangle-hook~ :: + + This hook is run from within code files tangled by ~org-babel-tangle~. + Example applications could include post-processing, compilation, or + evaluation of tangled code files. + +** Evaluating code blocks + :PROPERTIES: + :DESCRIPTION: Place results in the Org buffer + :END: +#+cindex: code block, evaluating +#+cindex: source code, evaluating +#+cindex: #+RESULTS + +Code blocks can be evaluated and the results of evaluation optionally +placed in the Org mode buffer.[fn:148] The results of evaluation are +placed following a line that begins by default with ~#+RESULTS~ and +optionally a cache identifier and/or the name of the evaluated code +block. The default value of ~#+RESULTS~ can be changed with the +customizable variable ~org-babel-results-keyword~. + +By default, the evaluation facility is only enabled for Lisp code +blocks specified as ~emacs-lisp~. However, source code blocks in many +languages can be evaluated within Org mode (see [[Languages]] for a list +of supported languages and [[Structure of code blocks]] for information on +the syntax used to define a code block). + +#+kindex: C-c C-c +#+kindex: C-c C-v e + +There are a number of ways to evaluate code blocks. The simplest is to +press {{{kbd(C-c C-c)}}} or {{{kbd(C-c C-v e)}}} with the point on a +code block.[fn:149] This will call the ~org-babel-execute-src-block~ +function to evaluate the block and insert its results into the Org +mode buffer. + +#+cindex: #+CALL + +It is also possible to evaluate named code blocks from anywhere in an +Org mode buffer or an Org mode table. Live code blocks located in the +current Org mode buffer or in the ``Library of Babel'' (see [[Library of +Babel]]) can be executed. Named code blocks can be executed with a +separate ~#+CALL:~ line or inline within a block of text. + +The syntax of the ~#+CALL:~ line is: + +#+begin_example + ,#+CALL: <name>(<arguments>) + ,#+CALL: <name>[<inside header arguments>](<arguments>) <end header arguments> +#+end_example + +The syntax for inline evaluation of named code blocks is: + +#+begin_example + ... call_<name>(<arguments>) ... + ... call_<name>[<inside header arguments>](<arguments>)[<end header arguments>] ... +#+end_example + +#+attr_texinfo: :table-type table :indic @asis +- ~<name>~ :: + + The name of the code block to be evaluated (see [[Structure of code + blocks]]). + +- ~<arguments>~ :: + + Arguments specified in this section will be passed to the code block. + These arguments use standard function call syntax, rather than header + argument syntax. For example, a ~#+CALL:~ line that passes the number + four to a code block named ~double~, which declares the header + argument ~:var n=2~, would be written as ~#+CALL: double(n=4)~. + +- ~<inside header arguments>~ :: + + Inside header arguments are passed through and applied to the named + code block. These arguments use header argument syntax rather than + standard function call syntax. Inside header arguments affect how the + code block is evaluated. For example, ~[:results output]~ will collect + the results of everything printed to ~STDOUT~ during execution of the + code block. + +- ~<end header arguments>~ :: + + End header arguments are applied to the calling instance and do not + affect evaluation of the named code block. They affect how the results + are incorporated into the Org mode buffer and how the call line is + exported. For example, ~:results html~ will insert the results of the + call line evaluation in the Org buffer, wrapped in a ~BEGIN_HTML:~ + block. + + +For more examples of passing header arguments to ~#+CALL:~ lines see +[[Header arguments in function calls]]. + +** Library of Babel + :PROPERTIES: + :DESCRIPTION: Use and contribute to a source code library + :END: +#+cindex: babel, library of +#+cindex: source code, library +#+cindex: code block, library + +The ``Library of Babel'' consists of code blocks that can be called +from any Org mode file. Code blocks defined in the ``Library of +Babel'' can be called remotely as if they were in the current Org mode +buffer (see [[Evaluating code blocks]] for information on the syntax of +remote code block evaluation). + + +The central repository of code blocks in the ``Library of Babel'' is +housed in an Org mode file located in the {{{samp(contrib)}}} +directory of Org mode. + +Users can add code blocks they believe to be generally useful to their +``Library of Babel.'' The code blocks can be stored in any Org mode +file and then loaded into the library with ~org-babel-lob-ingest~. + +#+kindex: C-c C-v i + +Code blocks located in any Org mode file can be loaded into the +``Library of Babel'' with the ~org-babel-lob-ingest~ function, bound +to {{{kbd(C-c C-v i)}}}. + +** Languages + :PROPERTIES: + :DESCRIPTION: Supported code block languages + :END: +#+cindex: babel, languages +#+cindex: source code, languages +#+cindex: code block, languages + +Code blocks in the following languages are supported. + +#+attr_texinfo: :columns 0.24 0.24 0.04 0.24 0.24 +| Language | Identifier | | Language | Identifier | +|------------+--------------+---+----------------+--------------| +| Asymptote | asymptote | | Awk | awk | +| Emacs Calc | calc | | C | C | +| C++ | C++ | | Clojure | clojure | +| CSS | css | | ditaa | ditaa | +| Graphviz | dot | | Emacs Lisp | emacs-lisp | +| gnuplot | gnuplot | | Haskell | haskell | +| Java | java | | | | +| Javascript | js | | LaTeX | latex | +| Ledger | ledger | | Lisp | lisp | +| Lilypond | lilypond | | MATLAB | matlab | +| Mscgen | mscgen | | Objective Caml | ocaml | +| Octave | octave | | Org mode | org | +| Oz | oz | | Perl | perl | +| Plantuml | plantuml | | Python | python | +| R | R | | Ruby | ruby | +| Sass | sass | | Scheme | scheme | +| GNU Screen | screen | | shell | sh | +| SQL | sql | | SQLite | sqlite | + + +Language-specific documentation is available for some languages. If +available, it can be found at +[[http://orgmode.org/worg/org-contrib/babel/languages.html]]. + +The variable ~org-babel-load-languages~ controls which languages are +enabled for evaluation (by default only ~emacs-lisp~ is enabled). This +variable can be set using the customization interface or by adding +code like the following example, disables ~emacs-lisp~ evaluation and +enables evaluation of ~R~ code blocks, to your emacs configuration: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(org-babel-do-load-languages + 'org-babel-load-languages + '((emacs-lisp . nil) + (R . t))) +#+end_src + +It is also possible to enable support for a language by loading the +related elisp file with ~require~. + +{{{noindent}}} The following example adds support for evaluating +~clojure~ code blocks: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(require 'ob-clojure) +#+end_src + +** Header arguments + :PROPERTIES: + :DESCRIPTION: Configure code block functionality + :END: +#+cindex: code block, header arguments +#+cindex: source code, block header arguments + +Code block functionality can be configured with header arguments. This +section provides an overview of the use of header arguments, and then +describes each header argument in detail. + +*** Using header arguments + :PROPERTIES: + :DESCRIPTION: Different ways to set header arguments + :END: + +The values of header arguments can be set in six different ways, each +more specific (and having higher priority) than the last. + +**** System-wide header arguments + :PROPERTIES: + :DESCRIPTION: Set global default values + :END: +#+vindex: org-babel-default-header-args + +System-wide values of header arguments can be specified by customizing +the ~org-babel-default-header-args~ variable: + +#+begin_example + :session => "none" + :results => "replace" + :exports => "code" + :cache => "no" + :noweb => "no" +#+end_example + +# #+begin_example +# org-babel-default-header-args is a variable defined in `org-babel.el'. +# Its value is +# ((:session . "none") +# (:results . "replace") +# (:exports . "code") +# (:cache . "no") +# (:noweb . "no")) + + +# Documentation: +# Default arguments to use when evaluating a code block. +# #+end_example + +For example, the following code could be used to set the default +value of ~:noweb~ header arguments to ~yes~. This would have the +effect of expanding ~:noweb~ references by default when evaluating +source code blocks. + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp + (setq org-babel-default-header-args + (cons '(:noweb . "yes") + (assq-delete-all :noweb org-babel-default-header-args))) +#+end_src + +**** Language-specific header arguments + :PROPERTIES: + :DESCRIPTION: Set default values by language + :END: + +Each language can define its own set of default header arguments. See +the language-specific documentation available online at +[[http://orgmode.org/worg/org-contrib/babel]]. + +**** Buffer-wide header arguments + :PROPERTIES: + :DESCRIPTION: Set default values for a specific buffer + :END: + +Buffer-wide header arguments may be specified as properties through +the use of ~#+PROPERTY:~ lines placed anywhere in an Org mode file +(see [[Property syntax]]). + +For example the following would set ~session~ to ~*R*~, and ~results~ +to ~silent~ for every code block in the buffer, ensuring that all +execution took place in the same session, and no results would be +inserted into the buffer. + +#+begin_example + ,#+PROPERTY: session *R* + ,#+PROPERTY: results silent +#+end_example + +**** Header arguments in Org mode properties + :PROPERTIES: + :DESCRIPTION: Set default values for a buffer or heading + :END: + +Header arguments are also read from Org mode properties (see [[Property +syntax]]), which can be set on a buffer-wide or per-heading basis. An +example of setting a header argument for all code blocks in a buffer +is as follows: + +#+begin_example + ,#+PROPERTY: tangle yes +#+end_example + +#+vindex: org-use-property-inheritance + +When properties are used to set default header arguments, they are +looked up with inheritance, regardless of the value of +~org-use-property-inheritance~. In the following example the value of +the ~:cache~ header argument will default to ~yes~ in all code blocks +in the subtree rooted at the following heading: + +#+begin_example + ,* outline header + ,:PROPERTIES: + ,:cache: yes + ,:END: +#+end_example + +#+kindex: C-c C-x p +#+vindex: org-babel-default-header-args + +Properties defined in this way override the properties set in +~org-babel-default-header-args~. It is convenient to use the +~org-set-property~ function bound to {{{kbd(C-c C-x p)}}} to set +properties in Org mode documents. + +**** Code block specific header arguments + :PROPERTIES: + :DESCRIPTION: The most common way to set values + :END: + +The most common way to assign values to header arguments is at the +code block level. This can be done by listing a sequence of header +arguments and their values as part of the ~#+BEGIN_SRC~ line. +Properties set in this way override both the values of +~org-babel-default-header-args~ and header arguments specified as +properties. In the following example, the ~:results~ header argument +is set to ~silent~, meaning the results of execution will not be +inserted in the buffer, and the ~:exports~ header argument is set to +~code~, meaning only the body of the code block will be preserved on +export to HTML or LaTeX. + +#+begin_example + #+NAME: factorial + #+BEGIN_SRC haskell :results silent :exports code :var n=0 + fac 0 = 1 + fac n = n * fac (n-1) + #+END_SRC +#+end_example + +Similarly, it is possible to set header arguments for inline code blocks: + +#+begin_example + src_haskell[:exports both]@{fac 5@} +#+end_example + +Code block header arguments can span multiple lines using ~#+HEADER:~ +or ~#+HEADERS:~ lines preceding a code block or nested between the +~#+NAME:~ line and the ~#+BEGIN_SRC~ line of a named code block. + +#+cindex: #+HEADER: +#+cindex: #+HEADERS: + +This is an example of multi-line header arguments on an un-named code +block: + +#+begin_example + ,#+HEADERS: :var data1=1 + ,#+BEGIN_SRC emacs-lisp :var data2=2 + (message "data1:%S, data2:%S" data1 data2) + ,#+END_SRC + + ,#+RESULTS: + : data1:1, data2:2 +#+end_example + +This is an example of multi-line header arguments on a named code block: + +#+begin_example + ,#+NAME: named-block + ,#+HEADER: :var data=2 + ,#+BEGIN_SRC emacs-lisp + (message "data:%S" data) + ,#+END_SRC + + ,#+RESULTS: named-block + : data:2 +#+end_example + +**** Header arguments in function calls + :PROPERTIES: + :DESCRIPTION: The most specific level + :END: + +At the most specific level, header arguments for ``Library of Babel'' +or ~#+CALL:~ lines can be set as shown in the two examples below. For +more information on the structure of ~#+CALL:~ lines see [[Evaluating +code blocks]]. + +The following example will apply the ~:exports results~ header +argument to the evaluation of the ~#+CALL:~ line: + +#+begin_example + ,#+CALL: factorial(n=5) :exports results +#+end_example + +The following example will apply the ~:session special~ header +argument to the evaluation of the ~factorial~ code block: + +#+begin_example + ,#+CALL: factorial[:session special](n=5) +#+end_example + +*** Specific header arguments + :PROPERTIES: + :DESCRIPTION: List of header arguments + :END: +Header arguments consist of an initial colon followed by the name of +the argument in lowercase letters. Additional header arguments are +defined on a language-specific basis, see [[Languages]]. + +The following header arguments are defined: + +**** var + :PROPERTIES: + :DESCRIPTION: Pass arguments to code blocks + :END: +The ~:var~ header argument is used to pass arguments to code blocks. +The specifics of how arguments are included in a code block vary by +language; these are addressed in the language-specific documentation. +However, the syntax used to specify arguments is the same across all +languages. In every case, variables require a default value when they +are declared. + +The values passed to arguments can either be literal values, +references, or Emacs Lisp code (see [[Emacs Lisp evaluation of +variables]]). References include anything in the Org mode file that +takes a ~#+NAME:~, ~#+TBLNAME:~, or ~#+RESULTS:~ line. This includes +tables, lists, ~#+BEGIN_EXAMPLE~ blocks, other code blocks, and the +results of other code blocks. + +Argument values can be indexed in a manner similar to arrays (see +[[Indexable variable values]]). + +The following syntax is used to pass arguments to code blocks using the +~:var~ header argument: + +#+begin_example + :var name=assign +#+end_example + +The argument, ~assign~, can either be a literal value, such as a +string {{{samp("string")}}} or a number {{{samp(9)}}}, or a reference +to a table, a list, a literal example, another code block (with or +without arguments), or the results of evaluating another code block. + +Here are examples of passing values by reference: + +#+attr_texinfo: :table-type table :indic @asis +- a table named with either ~#+NAME:~ or ~#+TBLNAME:~ :: + + #+begin_example + #+TBLNAME: example-table + | 1 | + | 2 | + | 3 | + | 4 | + + #+NAME: table-length + #+BEGIN_SRC emacs-lisp :var table=example-table + (length table) + #+END_SRC + + #+RESULTS: table-length + : 4 + #+end_example + +- a simple list named with ~#+NAME:~ :: + + #+begin_example + #+NAME: example-list + - simple + - not + - nested + - list + + #+BEGIN_SRC emacs-lisp :var x=example-list + (print x) + #+END_SRC + + #+RESULTS: + | simple | list | + #+end_example + + Note that nesting is not carried through to the source code block. + +- a named code block without arguments, optionally followed by parentheses :: + + #+begin_example + #+BEGIN_SRC emacs-lisp :var length=table-length() + (* 2 length) + #+END_SRC + + #+RESULTS: + : 8 + #+end_example + +- a named code block with arguments :: + + #+begin_example + #+NAME: double + #+BEGIN_SRC emacs-lisp :var input=8 + (* 2 input) + #+END_SRC + + #+RESULTS: double + : 16 + + #+NAME: squared + #+BEGIN_SRC emacs-lisp :var input=double(input=1) + (* input input) + #+END_SRC + + #+RESULTS: squared + : 4 + #+end_example + +- a literal example block :: + + #+begin_example + ,#+NAME: literal-example + ,#+BEGIN_EXAMPLE + A literal example + on two lines + ,#+END_EXAMPLE + + ,#+NAME: read-literal-example + ,#+BEGIN_SRC emacs-lisp :var x=literal-example + (concatenate 'string x " for you.") + ,#+END_SRC + + ,#+RESULTS: read-literal-example + : A literal example + : on two lines for you. + #+end_example + +# ***** Alternate argument syntax +<<Alternate argument syntax>> + +It is also possible to specify arguments in a potentially more natural +way using the ~#+NAME:~ line of a code block. As in the following +example, arguments can be packed inside of parentheses, separated by +commas, following the source name. + +#+begin_example + ,#+NAME: double(input=0, x=2) + ,#+BEGIN_SRC emacs-lisp + (* 2 (+ input x)) + ,#+END_SRC +#+end_example + +# ***** Indexable variable values +<<Indexable variable values>> + +It is possible to reference portions of variable values by +/indexing/ into the variables. Indexes are 0 based with negative +values counting back from the end. If an index is separated by commas +then each subsequent section will index into the next deepest nesting +or dimension of the value. Note that this indexing occurs /before/ +other table related header arguments like ~:hlines~, ~:colnames~, and +~:rownames~ are applied. The following example assigns the last cell +of the first row the table ~example-table~ to the variable ~data~: + +#+begin_example + ,#+NAME: example-table + | 1 | a | + | 2 | b | + | 3 | c | + | 4 | d | + + ,#+BEGIN_SRC emacs-lisp :var data=example-table[0,-1] + data + ,#+END_SRC + + ,#+RESULTS: + : a +#+end_example + +Ranges of variable values can be referenced using two integers +separated by a ~:~, in which case the entire inclusive range is +referenced. The following example assigns the middle three rows of +~example-table~ to ~data~. + +#+begin_example + #+NAME: example-table + | 1 | a | + | 2 | b | + | 3 | c | + | 4 | d | + | 5 | 3 | + + #+BEGIN_SRC emacs-lisp :var data=example-table[1:3] + data + #+END_SRC + + #+RESULTS: + | 2 | b | + | 3 | c | + | 4 | d | +#+end_example + +Additionally, an empty index, or the single character ~*~, are both +interpreted to mean the entire range and as such are equivalent to +~0:-1~, as shown in the following example in which the entire first +column is referenced: + +#+begin_example + #+NAME: example-table + | 1 | a | + | 2 | b | + | 3 | c | + | 4 | d | + + #+BEGIN_SRC emacs-lisp :var data=example-table[,0] + data + #+END_SRC + + #+RESULTS: + | 1 | 2 | 3 | 4 | +#+end_example + +It is possible to index into the results of code blocks as well as +tables. Any number of dimensions can be indexed. Dimensions are +separated from one another by commas, as shown in the following +example: + +#+begin_example + #+NAME: 3D + #+BEGIN_SRC emacs-lisp + '(((1 2 3) (4 5 6) (7 8 9)) + ((10 11 12) (13 14 15) (16 17 18)) + ((19 20 21) (22 23 24) (25 26 27))) + #+END_SRC + + #+BEGIN_SRC emacs-lisp :var data=3D[1,,1] + data + #+END_SRC + + #+RESULTS: + | 11 | 14 | 17 | +#+end_example + +# ***** Emacs Lisp evaluation of variables +<<Emacs Lisp evaluation of variables>> + +Emacs lisp code can be used to initialize variable values. When a +variable value starts with ~(~, ~[~, ~'~ or ~`~ it will be evaluated +as Emacs Lisp and the result of the evaluation will be assigned as the +variable value. The following example demonstrates use of this +evaluation to reliably pass the file-name of the Org mode buffer to a +code block:[fn:150] + +#+begin_example + #+BEGIN_SRC sh :var filename=(buffer-file-name) :exports both + wc -w $filename + #+END_SRC +#+end_example + +Note that values read from tables and lists will not be evaluated as +Emacs Lisp, as shown in the following example, which contains a Lisp +list as the sole table element: + +#+begin_example + #+NAME: table + | (a b c) | + + #+HEADERS: :var data=table[0,0] + #+BEGIN_SRC perl + $data + #+END_SRC + + #+RESULTS: + : (a b c) +#+end_example + +**** results + :PROPERTIES: + :DESCRIPTION: Specify the type of results and how they will be collected and handled + :END: +There are three classes of ~:results~ header argument. Only one option +per class may be supplied per code block. + +#+attr_texinfo: :table-type table :indic @asis +- Collection :: + + These header arguments specify how the results should be collected + from the code block. + +- Type :: + + These header arguments specify what type of result the code block will + return---which has implications for how they will be inserted into the + Org mode buffer. + +- Handling :: + + These header arguments specify how the results of evaluating the code + block should be handled. + +# ***** Collection +<<Collection>> + +The following ~:results~ options are mutually exclusive, and specify +how the results should be collected from the code block. + +#+attr_texinfo: :table-type table :indic @asis +- ~value~ :: + + This is the default. The result is the value of the last statement in + the code block. This header argument places the evaluation in + functional mode. Note that in some languages, e.g., Python, use of + this result type requires that a ~return~ statement be included in the + body of the source code block. + +- ~output~ :: + + The result is the collection of everything printed to STDOUT during + the execution of the code block. This header argument places the + evaluation in scripting mode. + +# ***** Type +<<Type>> + +The following ~:results~ options are mutually exclusive and specify +what type of results the code block will return. By default, results +are inserted as either a table or scalar depending on their value. + +#+attr_texinfo: :table-type table :indic @asis +- ~table~, ~vector~ :: + + The results should be interpreted as an Org mode table. If a single + value is returned, it will be converted into a table with one row and + one column. E.g., ~:results value table~. + +- ~scalar~, ~verbatim~ :: + + The results should be interpreted literally---they will not be + converted into a table. The results will be inserted into the Org mode + buffer as quoted text. E.g., ~:results value verbatim~. + +- ~list~ :: + + The results should be interpreted as an Org mode list. If a single + scalar value is returned it will be converted into a list with only + one element. + +- ~file~ :: + + The results will be interpreted as the path to a file, and will be + inserted into the Org mode buffer as a file link. E.g., ~:results + value file~. + +- ~raw~ :: + + The results are interpreted as raw Org mode code and are inserted + directly into the buffer. If the results look like a table they will + be aligned as such by Org mode. E.g., ~:results value raw~. + +- ~org~ :: + + The results are will be enclosed in a ~BEGIN_SRC org~ block. They are + not comma-escaped by default but they will be if you hit + {{{kbd(TAB)}}} in the block and/or if you export the file. E.g., + ~:results value org~. + +- ~html~ :: + + Results are assumed to be HTML and will be enclosed in a ~BEGIN_HTML~ + block. E.g., ~:results value html~. + +- ~latex~ :: + + Results assumed to be LaTeX and are enclosed in a ~BEGIN_LaTeX~ + block. E.g., ~:results value latex~. + +- ~code~ :: + + Result are assumed to be parsable code and are enclosed in a code + block. E.g., ~:results value code~. + +- ~pp~ :: + + The result is converted to pretty-printed code and is enclosed in a + code block. This option currently supports Emacs Lisp, Python, and + Ruby. E.g., ~:results value pp~. + +- ~drawer~ :: + + The result is wrapped in a RESULTS drawer. This can be useful for + inserting ~raw~ or ~org~ syntax results in such a way that their + extent is known and they can be automatically removed or replaced. + +# ***** Handling +<<Handling>> +The following ~:results~ options indicate what happens with the +results once they are collected. + +#+attr_texinfo: :table-type table :indic @asis +- ~replace~ :: + + The default value. Any existing results will be removed, and the new + results will be inserted into the Org mode buffer in their place. + E.g., ~:results output replace~. + +- ~append~ :: + + If there are pre-existing results of the code block then the new + results will be appended to the existing results. Otherwise the new + results will be inserted as with ~replace~. + +- ~prepend~ :: + + If there are pre-existing results of the code block then the new + results will be prepended to the existing results. Otherwise the new + results will be inserted as with ~replace~. + +- ~silent~ :: + + The results will be echoed in the minibuffer but will not be inserted + into the Org mode buffer. E.g., ~:results output silent~. + +**** file + :PROPERTIES: + :DESCRIPTION: Specify a path for file output + :END: + +The header argument ~:file~ is used to specify an external file in +which to save code block results. After code block evaluation an Org +mode style ~[[file:]]~ link (see [[Link format]]) to the file will be inserted +into the Org mode buffer. Some languages including R, gnuplot, dot, +and ditaa provide special handling of the ~:file~ header argument, +automatically wrapping the code block body in the boilerplate code +required to save output to the specified file. This is often useful +for saving graphical output of a code block to the specified file. + +The argument to ~:file~ should be either a string specifying the path +to a file, or a list of two strings in which case the first element of +the list should be the path to a file and the second a description for +the link. + +**** file-desc + :PROPERTIES: + :DESCRIPTION: Specify a description for file results + :END: + +The value of the ~:file-desc~ header argument is used to provide a +description for file code block results which are inserted as Org mode +links (see [[Link format]]). If the ~:file-desc~ header argument is given +with no value the link path will be placed in both the ``link'' and +the ``description'' portion of the Org mode link. + +**** dir + :PROPERTIES: + :DESCRIPTION: Specify the default (possibly remote) directory for code block execution + :TITLE: ~:dir~ and remote execution + :END: + +While the ~:file~ header argument can be used to specify the path to +the output file, ~:dir~ specifies the default directory during code +block execution. If it is absent, then the directory associated with +the current buffer is used. In other words, supplying ~:dir path~ +temporarily has the same effect as changing the current directory with +{{{kbd(M-x cd path)}}}, and then not supplying ~:dir~. Under the +surface, ~:dir~ simply sets the value of the Emacs variable +~default-directory~. + +When using ~:dir~, you should supply a relative path for file output +(e.g., ~:file myfile.jpg~ or ~:file results/myfile.jpg~) in which +case that path will be interpreted relative to the default directory. + +In other words, if you want your plot to go into a folder called +{{{file(Work)}}} in your home directory, you could use a code block +like the following example: + +#+begin_example + #+BEGIN_SRC R :file myplot.png :dir ~/Work + matplot(matrix(rnorm(100), 10), type="l") + #+END_SRC +#+end_example + +# ***** Remote execution +<<Remote execution>> + +A directory on a remote machine can be specified using tramp file +syntax, in which case the code will be evaluated on the remote +machine. An example is: + +#+begin_example + #+BEGIN_SRC R :file plot.png :dir /dand@yakuba.princeton.edu: + plot(1:10, main=system("hostname", intern=TRUE)) + #+END_SRC +#+end_example + +Text results will be returned to the local Org mode buffer as usual, +and file output will be created on the remote machine with relative +paths interpreted relative to the remote directory. An Org mode link +to the remote file will be created. + +So, in the above example a plot will be created on the remote machine, +and a link of the following form will be inserted in the org buffer: + +#+begin_example + [[file:/scp:dand@yakuba.princeton.edu:/home/dand/plot.png][plot.png]] +#+end_example + +Most of this functionality follows immediately from the fact that +~:dir~ sets the value of the Emacs variable ~default-directory~, +thanks to tramp. Those using XEmacs, or GNU Emacs prior to version 23 +may need to install tramp separately in order for these features to +work correctly. + +# ***** Further points +<<Further points>> +Please be aware of these further points: + +- If ~:dir~ is used in conjunction with ~:session~, although it will + determine the starting directory for a new session as expected, no + attempt is currently made to alter the directory associated with an + existing session. + +- ~:dir~ should typically not be used to create files during export + with ~:exports results~ or ~:exports both~. The reason is that, in + order to retain portability of exported material between machines, + during export links inserted into the buffer will /not/ be expanded + against ~default directory~. Therefore, if ~default-directory~ is + altered using ~:dir~, it is probable that the file will be created + in a location to which the link does not point. + +**** exports + :PROPERTIES: + :DESCRIPTION: Export code and/or results + :END: +The ~:exports~ header argument specifies what should be included in HTML +or LaTeX exports of the Org mode file. + +#+attr_texinfo: :table-type table :indic @asis +- ~code~ :: + + The default. The body of code is included into the exported file. + E.g., ~:exports code~. + +- ~results~ :: + + The result of evaluating the code is included in the exported file. + E.g., ~:exports results~. + +- ~both~ :: + + Both the code and results are included in the exported file. E.g., + ~:exports both~. + +- ~none~ :: + + Nothing is included in the exported file. E.g., ~:exports none~. + +**** tangle + :PROPERTIES: + :DESCRIPTION: Toggle tangling and specify file name + :END: + +The ~:tangle~ header argument specifies whether or not the code +block should be included in tangled extraction of source code files. + +#+attr_texinfo: :table-type table :indic @asis +- ~tangle~ :: + + The code block is exported to a source code file named after the full + path (including the directory) and file name (w/o extension) of the + Org mode file. E.g., ~:tangle yes~. + +- ~no~ :: + + The default. The code block is not exported to a source code file. + E.g., ~:tangle no~. + +- other :: + + Any other string passed to the ~:tangle~ header argument is + interpreted as a path (directory and file name relative to the + directory of the Org mode file) to which the block will be exported, + e.g., ~:tangle path~. + +**** mkdirp +:PROPERTIES: +:DESCRIPTION: Toggle creation of parent directories of target files during tangling +:END: + +The ~:mkdirp~ header argument can be used to create parent directories +of tangled files when missing. This can be set to ~yes~ to enable +directory creation or to ~no~ to inhibit directory creation. + +**** comments +:PROPERTIES: +:DESCRIPTION: Toggle insertion of comments in tangled code files +:END: + +By default code blocks are tangled to source-code files without any +insertion of comments beyond those which may already exist in the body +of the code block. The ~:comments~ header argument can be set as +follows to control the insertion of extra comments into the tangled +code file. + +#+attr_texinfo: :table-type table :indic @asis +- ~no~ :: + + The default. No extra comments are inserted during tangling. + +- ~link~ :: + + The code block is wrapped in comments which contain pointers back to + the original Org file from which the code was tangled. + +- ~yes~ :: + + A synonym for ``link'' to maintain backwards compatibility. + +- ~org~ :: + + Include text from the Org mode file as a comment. + + The text is picked from the leading context of the tangled code and is + limited by the nearest headline or source block as the case may be. + +- ~both~ :: + + Turns on both the ``link'' and ``org'' comment options. + +- ~noweb~ :: + + Turns on the ``link'' comment option, and additionally wraps expanded + noweb references in the code block body in link comments. + +**** padline +:PROPERTIES: +:DESCRIPTION: Control insertion of padding lines in tangle code files +:END: + +Control in insertion of padding lines around code block bodies in tangled +code files. The default value is ~yes~ which results in insertion of +newlines before and after each tangled code block. The following arguments +are accepted: + +#+attr_texinfo: :table-type table :indic @asis +- ~yes~ :: + + Insert newlines before and after each code block body in tangled code + files. + +- ~no~ :: + + Do not insert any newline padding in tangled output. + +**** no-expand +:PROPERTIES: +:DESCRIPTION: Turn off variable assignment and noweb expansion during tangling +:END: + +By default, code blocks are expanded with ~org-babel-expand-src-block~ +during tangling. This has the effect of assigning values to variables +specified with ~:var~ (see [[var]]), and of replacing ``noweb'' references +(see [[Noweb reference syntax]]) with their targets. The ~:no-expand~ +header argument can be used to turn off this behavior. + +**** session +:PROPERTIES: +:DESCRIPTION: Preserve state of code evaluation +:END: + +The ~:session~ header argument starts a session for an interpreted +language where state is preserved. + +By default, a session is not started. + +A string passed to the ~:session~ header argument will give the +session a name. This makes it possible to run concurrent sessions for +each interpreted language. + +**** noweb +:PROPERTIES: +:DESCRIPTION: Toggle expansion of noweb references +:END: + +The ~:noweb~ header argument controls expansion of ``noweb'' syntax +references (see [[Noweb reference syntax]]) when the code block is +evaluated, tangled, or exported. The ~:noweb~ header argument can have +one of the five values: ~no~, ~yes~, ~tangle~, ~no-export~, or +~strip-export~. + +#+attr_texinfo: :table-type table :indic @asis +- ~no~ :: + + The default. ``Noweb'' syntax references in the body of the code block + will not be expanded before the code block is evaluated, tangled or + exported. + +- ~yes~ :: + + ``Noweb'' syntax references in the body of the code block will be + expanded before the code block is evaluated, tangled or exported. + +- ~tangle~ :: + + ``Noweb'' syntax references in the body of the code block will be + expanded before the code block is tangled. However, ``noweb'' syntax + references will not be expanded when the code block is evaluated or + exported. + +- ~no-export~ :: + + ``Noweb'' syntax references in the body of the code block will be + expanded before the block is evaluated or tangled. However, ``noweb'' + syntax references will not be expanded when the code block is + exported. + +- ~strip-export~ :: + + ``Noweb'' syntax references in the body of the code block will be + expanded before the block is evaluated or tangled. However, ``noweb'' + syntax references will not be removed when the code block is exported. + +- ~eval~ :: + + ``Noweb'' syntax references in the body of the code block will only be + expanded before the block is evaluated. + +# ***** Noweb prefix lines +<<Noweb prefix lines>> + +Noweb insertions are placed behind the line prefix of the +~<<reference>>~. Because the ~<<example>>~ noweb reference appears +behind the SQL comment syntax in the following example, each line of +the expanded noweb reference will be commented. + +This code block: + +#+begin_example + -- <<example>> +#+end_example + + +expands to: + +#+begin_example + -- this is the + -- multi-line body of example +#+end_example + +Note that noweb replacement text that does not contain any newlines +will not be inserted behind the line prefix, so it is always possible +to use inline noweb references. + +**** noweb-ref +:PROPERTIES: +:DESCRIPTION: Specify block's noweb reference resolution target +:END: + +When expanding ``noweb'' style references the bodies of all code block +with /either/ a block name matching the reference name /or/ a +~:noweb-ref~ header argument matching the reference name will be +concatenated together to form the replacement text. + +By setting this header argument at the sub-tree or file level, simple code +block concatenation may be achieved. For example, when tangling the +following Org mode file, the bodies of code blocks will be concatenated into +the resulting pure code file.[fn:151] + +#+begin_example + #+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh + <<fullest-disk>> + #+END_SRC + ,* the mount point of the fullest disk + :PROPERTIES: + :noweb-ref: fullest-disk + :END: + + ,** query all mounted disks + #+BEGIN_SRC sh + df \ + #+END_SRC + + ,** strip the header row + #+BEGIN_SRC sh + |sed '1d' \ + #+END_SRC + + ,** sort by the percent full + #+BEGIN_SRC sh + |awk '@{print $5 " " $6@}'|sort -n |tail -1 \ + #+END_SRC + + ,** extract the mount point + #+BEGIN_SRC sh + |awk '@{print $2@}' + #+END_SRC +#+end_example + +The ~:noweb-sep~ (see [[noweb-sep]]) header argument holds the string used +to separate accumulate noweb references like those above. By default a +newline is used. + +**** noweb-sep +:PROPERTIES: +:DESCRIPTION: String used to separate noweb references +:END: + +The ~:noweb-sep~ header argument holds the string used to separate +accumulated noweb references (see [[noweb-ref]]). By default a newline is +used. + +**** cache +:PROPERTIES: +:DESCRIPTION: Avoid re-evaluating unchanged code blocks +:END: + +The ~:cache~ header argument controls the use of in-buffer caching of +the results of evaluating code blocks. It can be used to avoid +re-evaluating unchanged code blocks. Note that the ~:cache~ header +argument will not attempt to cache results when the ~:session~ header +argument is used, because the results of the code block execution may +be stored in the session outside of the Org mode buffer. The ~:cache~ +header argument can have one of two values: ~yes~ or ~no~. + +#+attr_texinfo: :table-type table :indic @asis +- ~no~ :: + + The default. No caching takes place, and the code block will be + evaluated every time it is called. + +- ~yes~ :: + + Every time the code block is run a SHA1 hash of the code and arguments + passed to the block will be generated. This hash is packed into the + ~#+RESULTS:~ line and will be checked on subsequent executions of the + code block. If the code block has not changed since the last time it + was evaluated, it will not be re-evaluated. + + +Code block caches notice if the value of a variable argument +to the code block has changed. If this is the case, the cache is +invalidated and the code block is re-run. In the following example, +~caller~ will not be re-run unless the results of ~random~ have +changed since it was last run. + +#+begin_example + #+NAME: random + #+BEGIN_SRC R :cache yes + runif(1) + #+END_SRC + + #+RESULTS[a2a72cd647ad44515fab62e144796432793d68e1]: random + 0.4659510825295 + + #+NAME: caller + #+BEGIN_SRC emacs-lisp :var x=random :cache yes + x + #+END_SRC + + #+RESULTS[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller + 0.254227238707244 +#+end_example + +**** sep +:PROPERTIES: +:DESCRIPTION: Delimiter for writing tabular results outside Org +:END: +#+kindex: C-c C-o + +The ~:sep~ header argument can be used to control the delimiter used +when writing tabular results out to files external to Org mode. This +is used either when opening tabular results of a code block by calling +the ~org-open-at-point~ function bound to {{{kbd(C-c C-o)}}} on the +code block, or when writing code block results to an external file +(see [[file]]) header argument. + +By default, when ~:sep~ is not specified output tables are tab +delimited. + +**** hlines +:PROPERTIES: +:DESCRIPTION: Handle horizontal lines in tables +:END: + +Tables are frequently represented with one or more horizontal lines, +or hlines. The ~:hlines~ argument to a code block accepts the values +~yes~ or ~no~, with a default value of ~no~. + +#+attr_texinfo: :table-type table :indic @asis +- ~no~ :: + + Strips horizontal lines from the input table. In most languages this + is the desired effect because an ~hline~ symbol is interpreted as an + unbound variable and raises an error. Setting ~:hlines no~ or relying + on the default value yields the following results. + + #+begin_example + #+TBLNAME: many-cols + | a | b | c | + |---+---+---| + | d | e | f | + |---+---+---| + | g | h | i | + + #+NAME: echo-table + #+BEGIN_SRC python :var tab=many-cols + return tab + #+END_SRC + + #+RESULTS: echo-table + | a | b | c | + | d | e | f | + | g | h | i | + #+end_example + +- ~yes~ :: + + Leaves hlines in the table. Setting ~:hlines yes~ has this effect. + + #+begin_example + #+TBLNAME: many-cols + | a | b | c | + |---+---+---| + | d | e | f | + |---+---+---| + | g | h | i | + + #+NAME: echo-table + #+BEGIN_SRC python :var tab=many-cols :hlines yes + return tab + #+END_SRC + + #+RESULTS: echo-table + | a | b | c | + |---+---+---| + | d | e | f | + |---+---+---| + | g | h | i | + #+end_example + +**** colnames +:PROPERTIES: +:DESCRIPTION: Handle column names in tables +:END: + +The ~:colnames~ header argument accepts the values ~yes~, ~no~, or +~nil~ for unassigned. The default value is ~nil~. Note that the +behavior of the ~:colnames~ header argument may differ across +languages. For example Emacs Lisp code blocks ignore the ~:colnames~ +header argument entirely given the ease with which tables with column +names may be handled directly in Emacs Lisp. + +#+attr_texinfo: :table-type table :indic @asis +- ~nil~ :: + + If an input table looks like it has column names (because its second + row is an hline), then the column names will be removed from the table + before processing, then reapplied to the results. + + #+begin_example + #+TBLNAME: less-cols + | a | + |---| + | b | + | c | + + #+NAME: echo-table-again + #+BEGIN_SRC python :var tab=less-cols + return [[val + '*' for val in row] for row in tab] + #+END_SRC + + #+RESULTS: echo-table-again + | a | + |----| + | b* | + | c* | + #+end_example + + Please note that column names are not removed before the table is + indexed using variable indexing. See [[Indexable variable values]]. + +- ~no~ :: + + No column name pre-processing takes place + +- ~yes~ :: + + Column names are removed and reapplied as with ~nil~ even if the table + does not ``look like'' it has column names (i.e., the second row is + not an hline). + +**** rownames +:PROPERTIES: +:DESCRIPTION: Handle row names in tables +:END: + +The ~:rownames~ header argument can take on the values ~yes~ +or ~no~, with a default value of ~no~. + +#+attr_texinfo: :table-type table :indic @asis +- ~no~ :: + + No row name pre-processing will take place. + +- ~yes~ :: + + The first column of the table is removed from the table before + processing, and is then reapplied to the results. + + #+begin_example + #+TBLNAME: with-rownames + | one | 1 | 2 | 3 | 4 | 5 | + | two | 6 | 7 | 8 | 9 | 10 | + + #+NAME: echo-table-once-again + #+BEGIN_SRC python :var tab=with-rownames :rownames yes + return [[val + 10 for val in row] for row in tab] + #+END_SRC + + #+RESULTS: echo-table-once-again + | one | 11 | 12 | 13 | 14 | 15 | + | two | 16 | 17 | 18 | 19 | 20 | + #+end_example + + Please note that row names are not removed before the table is indexed + using variable indexing. See [[Indexable variable values]]. + +**** shebang +:PROPERTIES: +:DESCRIPTION: Make tangles files executable +:END: + +Setting the ~:shebang~ header argument to a string value (e.g., +{{{samp(:shebang "#!/bin/bash")}}}) causes the string to be inserted as the +first line of any tangled file holding the code block, and the file +permissions of the tangled file are set to make it executable. + +**** eval +:PROPERTIES: +:DESCRIPTION: Limit evaluation of specific code blocks +:END: + +The ~:eval~ header argument can be used to limit the evaluation of +specific code blocks. The ~:eval~ header argument can be useful for +protecting against the evaluation of dangerous code blocks or to +ensure that evaluation will require a query regardless of the value of +the ~org-confirm-babel-evaluate~ variable. The possible values of +~:eval~ and their effects are shown below. + +#+attr_texinfo: :table-type table :indic @asis +- ~never~ or ~no~ :: + + The code block will not be evaluated under any circumstances. + +- ~query~ :: + + Evaluation of the code block will require an affirmative answer to a + query. + +- ~never-export~ or ~no-export~ :: + + The code block will not be evaluated during export but may still be + called interactively. + +- ~query-export~ :: + + Evaluation of the code block during export will require an affirmative + answer to a query. + + +If this header argument is not set then evaluation is determined by the value +of the ~org-confirm-babel-evaluate~ variable (see [[Code evaluation +security]]). + +**** wrap +:PROPERTIES: +:DESCRIPTION: Mark source block evaluation results +:END: + +The ~:wrap~ header argument is used to mark the results of source +block evaluation. The header argument can be passed a string that will +be appended to ~#+BEGIN_~ and ~#+END_~, which will then be used to +wrap the results. If no string is specified then the results will be +wrapped in a ~#+BEGIN/END_RESULTS~ block. + +** Results of evaluation + :PROPERTIES: + :DESCRIPTION: How evaluation results are handled + :END: +#+cindex: code block, results of evaluation +#+cindex: source code, results of evaluation + +The way in which results are handled depends on whether a session is +invoked, as well as on whether ~:results value~ or ~:results output~ +is used. The following table shows the table possibilities. For a full +listing of the possible results header arguments, see [[results]]. + +| | *Non-session* | *Session* | +|-------------------+--------------------------+-------------------------------------| +| ~:results value~ | value of last expression | value of last expression | +| ~:results output~ | contents of STDOUT | concatenation of interpreter output | + + +Please note that with ~:results value~, the result in both ~:session~ +and non-session is returned to Org mode as a table (a one- or +two-dimensional vector of strings or numbers) when appropriate. + +*** Non-session + +#+attr_texinfo: :table-type table :indic @asis +- ~:results value~ :: + + This is the default. Internally, the value is obtained by wrapping the + code in a function definition in the external language, and evaluating + that function. Therefore, code should be written as if it were the + body of such a function. In particular, note that Python does not + automatically return a value from a function unless a ~return~ + statement is present, and so a {{{samp(return)}}} statement will + usually be required in Python. + + This is the only one of the four evaluation contexts in which the code + is automatically wrapped in a function definition. + +- ~:results output~ :: + + The code is passed to the interpreter as an external process, and the + contents of the standard output stream are returned as text.[fn:152] + +*** Session + +#+attr_texinfo: :table-type table :indic @asis +- ~:results value~ :: + + The code is passed to an interpreter running as an interactive Emacs + inferior process. Only languages which provide tools for interactive + evaluation of code have session support, so some language (e.g., C and + ditaa) do not support the ~:session~ header argument, and in other + languages (e.g., Python and Haskell) which have limitations on the + code which may be entered into interactive sessions, those limitations + apply to the code in code blocks using the ~:session~ header argument + as well. + + Unless the ~:results output~ option is supplied (see below) the result + returned is the result of the last evaluation performed by the + interpreter.[fn:153] + +- ~:results output~ :: + + The code is passed to the interpreter running as an interactive Emacs + inferior process. The result returned is the concatenation of the + sequence of (text) output from the interactive interpreter. Notice + that this is not necessarily the same as what would be sent to + ~STDOUT~ if the same code were passed to a non-interactive interpreter + running as an external process. Compare the following two + examples: + + #+begin_example + #+BEGIN_SRC python :results output + print "hello" + 2 + print "bye" + #+END_SRC + + #+RESULTS: + : hello + : bye + #+end_example + + In non-session mode, the `2' is not printed and does not appear. + + #+begin_example + #+BEGIN_SRC python :results output :session + print "hello" + 2 + print "bye" + #+END_SRC + + #+RESULTS: + : hello + : 2 + : bye + #+end_example + + But in ~:session~ mode, the interactive interpreter receives input `2' + and prints out its value, `2'. (Indeed, the other print statements are + unnecessary here). + +** Noweb reference syntax + :PROPERTIES: + :DESCRIPTION: Literate programming in Org mode + :END: +#+cindex: code block, noweb reference +#+cindex: syntax, noweb +#+cindex: source code, noweb reference + +The ``noweb'' (see [[http://www.cs.tufts.edu/~nr/noweb/]]) Literate +Programming system allows named blocks of code to be referenced using +the familiar Noweb syntax: + +#+begin_example + <<code-block-name>> +#+end_example + +When a code block is tangled or evaluated, whether or not ``noweb'' +references are expanded depends upon the value of the ~:noweb~ header +argument. If ~:noweb yes~, then a Noweb reference is expanded before +evaluation. If ~:noweb no~, the default, then the reference is not +expanded before evaluation. See the [[noweb-ref]] header argument for a +more flexible way to resolve noweb references. + +It is possible to include the /results/ of a code block rather than +the body. This is done by appending parenthesis to the code block +name, which may optionally contain arguments to the code block as +shown below. + +#+begin_example + <<code-block-name(optional arguments)>> +#+end_example + +Note that the default value, ~:noweb no~, was chosen to ensure that +correct code is not broken in a language, such as Ruby, where +~<<arg>>~ is a syntactically valid construct. If ~<<arg>>~ is not +syntactically valid in languages that you use, then please consider +setting the default value. + +If noweb tangling is slow in large Org mode files, consider +setting the ~*org-babel-use-quick-and-dirty-noweb-expansion*~ variable +to true. This will result in faster noweb reference resolution at the +expense of not correctly resolving inherited values of the +~:noweb-ref~ header argument. + +** Key bindings and useful functions + :PROPERTIES: + :DESCRIPTION: Work quickly with code blocks + :END: +#+cindex: code block, key bindings + +Many common Org mode key sequences are re-bound depending on +the context. + +Within a code block, the following key bindings +are active: +#+kindex: C-c C-c +#+kindex: C-c C-o +#+kindex: C-up +#+kindex: M-down + +#+attr_texinfo: :columns 0.2 0.55 +| Key binding | Function | +|-----------------------+-----------------------------------| +| {{{kbd(C-c C-c)}}} | ~org-babel-execute-src-block~ | +| {{{kbd(C-c C-o)}}} | ~org-babel-open-src-block-result~ | +| {{{kbdkey(C-,up)}}} | ~org-babel-load-in-session~ | +| {{{kbdkey(M-,down)}}} | ~org-babel-pop-to-session~ | + + +In an Org mode buffer, the following key bindings are active: + +#+kindex: C-c C-v p +#+kindex: C-c C-v C-p +#+kindex: C-c C-v n +#+kindex: C-c C-v C-n +#+kindex: C-c C-v e +#+kindex: C-c C-v C-e +#+kindex: C-c C-v o +#+kindex: C-c C-v C-o +#+kindex: C-c C-v v +#+kindex: C-c C-v C-v +#+kindex: C-c C-v u +#+kindex: C-c C-v C-u +#+kindex: C-c C-v g +#+kindex: C-c C-v C-g +#+kindex: C-c C-v r +#+kindex: C-c C-v C-r +#+kindex: C-c C-v b +#+kindex: C-c C-v C-b +#+kindex: C-c C-v s +#+kindex: C-c C-v C-s +#+kindex: C-c C-v d +#+kindex: C-c C-v C-d +#+kindex: C-c C-v t +#+kindex: C-c C-v C-t +#+kindex: C-c C-v f +#+kindex: C-c C-v C-f +#+kindex: C-c C-v c +#+kindex: C-c C-v C-c +#+kindex: C-c C-v j +#+kindex: C-c C-v C-j +#+kindex: C-c C-v l +#+kindex: C-c C-v C-l +#+kindex: C-c C-v i +#+kindex: C-c C-v C-i +#+kindex: C-c C-v I +#+kindex: C-c C-v C-I +#+kindex: C-c C-v z +#+kindex: C-c C-v C-z +#+kindex: C-c C-v a +#+kindex: C-c C-v C-a +#+kindex: C-c C-v h +#+kindex: C-c C-v C-h +#+kindex: C-c C-v x +#+kindex: C-c C-v C-x + +#+attr_texinfo: :columns 0.4 0.6 +| Key binding | Function | +|------------------------------------------------+--------------------------------------------| +| {{{kbd(C-c C-v p)}}} or {{{kbd(C-c C-v C-p)}}} | ~org-babel-previous-src-block~ | +| {{{kbd(C-c C-v n)}}} or {{{kbd(C-c C-v C-n)}}} | ~org-babel-next-src-block~ | +| {{{kbd(C-c C-v e)}}} or {{{kbd(C-c C-v C-e)}}} | ~org-babel-execute-maybe~ | +| {{{kbd(C-c C-v o)}}} or {{{kbd(C-c C-v C-o)}}} | ~org-babel-open-src-block-result~ | +| {{{kbd(C-c C-v v)}}} or {{{kbd(C-c C-v C-v)}}} | ~org-babel-expand-src-block~ | +| {{{kbd(C-c C-v u)}}} or {{{kbd(C-c C-v C-u)}}} | ~org-babel-goto-src-block-head~ | +| {{{kbd(C-c C-v g)}}} or {{{kbd(C-c C-v C-g)}}} | ~org-babel-goto-named-src-block~ | +| {{{kbd(C-c C-v r)}}} or {{{kbd(C-c C-v C-r)}}} | ~org-babel-goto-named-result~ | +| {{{kbd(C-c C-v b)}}} or {{{kbd(C-c C-v C-b)}}} | ~org-babel-execute-buffer~ | +| {{{kbd(C-c C-v s)}}} or {{{kbd(C-c C-v C-s)}}} | ~org-babel-execute-subtree~ | +| {{{kbd(C-c C-v d)}}} or {{{kbd(C-c C-v C-d)}}} | ~org-babel-demarcate-block~ | +| {{{kbd(C-c C-v t)}}} or {{{kbd(C-c C-v C-t)}}} | ~org-babel-tangle~ | +| {{{kbd(C-c C-v f)}}} or {{{kbd(C-c C-v C-f)}}} | ~org-babel-tangle-file~ | +| {{{kbd(C-c C-v c)}}} or {{{kbd(C-c C-v C-c)}}} | ~org-babel-check-src-block~ | +| {{{kbd(C-c C-v j)}}} or {{{kbd(C-c C-v C-j)}}} | ~org-babel-insert-header-arg~ | +| {{{kbd(C-c C-v l)}}} or {{{kbd(C-c C-v C-l)}}} | ~org-babel-load-in-session~ | +| {{{kbd(C-c C-v i)}}} or {{{kbd(C-c C-v C-i)}}} | ~org-babel-lob-ingest~ | +| {{{kbd(C-c C-v I)}}} or {{{kbd(C-c C-v C-I)}}} | ~org-babel-view-src-block-info~ | +| {{{kbd(C-c C-v z)}}} or {{{kbd(C-c C-v C-z)}}} | ~org-babel-switch-to-session-with-code~ | +| {{{kbd(C-c C-v a)}}} or {{{kbd(C-c C-v C-a)}}} | ~org-babel-sha1-hash~ | +| {{{kbd(C-c C-v h)}}} or {{{kbd(C-c C-v C-h)}}} | ~org-babel-describe-bindings~ | +| {{{kbd(C-c C-v x)}}} or {{{kbd(C-c C-v C-x)}}} | ~org-babel-do-key-sequence-in-edit-buffer~ | + + +# When possible these keybindings were extended to work when the control key is +# kept pressed, resulting in the following additional keybindings. + +# @multitable @columnfractions 0.25 0.75 +# - {{{kbd(C-c C-v C-a)}}} @tab ~org-babel-sha1-hash~ +# - {{{kbd(C-c C-v C-b)}}} @tab ~org-babel-execute-buffer~ +# - {{{kbd(C-c C-v C-f)}}} @tab ~org-babel-tangle-file~ +# - {{{kbd(C-c C-v C-l)}}} @tab ~org-babel-lob-ingest~ +# - {{{kbd(C-c C-v C-p)}}} @tab ~org-babel-expand-src-block~ +# - {{{kbd(C-c C-v C-s)}}} @tab ~org-babel-execute-subtree~ +# - {{{kbd(C-c C-v C-t)}}} @tab ~org-babel-tangle~ +# - {{{kbd(C-c C-v C-z)}}} @tab ~org-babel-switch-to-session~ +# @end multitable + +** Batch execution + :PROPERTIES: + :DESCRIPTION: Call functions from the command line + :END: +#+cindex: code block, batch execution +#+cindex: source code, batch execution + +It is possible to call functions from the command line. This shell +script calls ~org-babel-tangle~ on every one of its arguments. + +Be sure to adjust the paths to fit your system. + +#+begin_example + #!/bin/sh + # -*- mode: shell-script -*- + # + # tangle files with org-mode + # + DIR=`pwd` + FILES="" + + # wrap each argument in the code required to call tangle on it + for i in $@; do + FILES="$FILES \"$i\"" + done + + emacs -Q --batch \ + --eval "(progn + (add-to-list 'load-path (expand-file-name \"~/src/org/lisp/\")) + (add-to-list 'load-path (expand-file-name \"~/src/org/contrib/lisp/\" t)) + (require 'org)(require 'org-exp)(require 'ob)(require 'ob-tangle) + (mapc (lambda (file) + (find-file (expand-file-name file \"$DIR\")) + (org-babel-tangle) + (kill-buffer)) '($FILES)))" 2>&1 |grep tangled +#+end_example + +* FIXME Miscellaneous + :PROPERTIES: + :DESCRIPTION: All the rest which did not fit elsewhere + :END: + +** FIXME Completion + :PROPERTIES: + :DESCRIPTION: M-TAB knows what you need + :END: +#+cindex: completion, of @TeX{} symbols +#+cindex: completion, of TODO keywords +#+cindex: completion, of dictionary words +#+cindex: completion, of option keywords +#+cindex: completion, of tags +#+cindex: completion, of property keys +#+cindex: completion, of link abbreviations +#+cindex: @TeX{} symbol completion +#+cindex: TODO keywords completion +#+cindex: dictionary word completion +#+cindex: option keyword completion +#+cindex: tag completion +#+cindex: link abbreviations, completion of + +Emacs would not be Emacs without completion, and Org mode uses it +whenever it makes sense. If you prefer an iswitchb- or ido-like +interface for some of the completion prompts, you can specify your +preference by setting at most one of the variables +~org-completion-use-iswitchb~ or ~org-completion-use-ido~. + +Org supports in-buffer completion. This type of completion does not +make use of the minibuffer. You simply type a few letters into the +buffer and use the {{{key(TAB)}}} key to complete text right there. + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbdkey(M-,TAB)}}} :: + #+kindex: M-@key{TAB} + + Complete word at point. + + - At the beginning of a headline :: + + Complete TODO keywords. + + - After {{{kbd(XXX)}}} :: + # Should be \ + Complete TeX symbols supported by the exporter. + + - After {{{samp(*)}}} :: + + Complete headlines in the current buffer so that they can be used in + search links like: + + #+begin_example + [[*find this headline]] + #+end_example + + - After {{{samp(:)}}} in a headline :: + + Complete tags. The list of tags is taken from the variable + ~org-tag-alist~ (possibly set through the {{{samp(#+TAGS)}}} in-buffer + option, see [[Setting tags]]), or it is created dynamically from all tags + used in the current buffer. + + - After {{{samp(:)}}} and not in a headline :: + + Complete property keys. The list of keys is constructed dynamically + from all keys used in the current buffer. + + - After {{{samp([)}}} :: + + Complete link abbreviations (see [[Link abbreviations]]). + + - After {{{samp(#+)}}} :: + + Complete the special keywords like {{{samp(TYP_TODO)}}} or + {{{samp(OPTIONS)}}} which set file-specific options for Org mode. When + the option keyword is already complete, pressing {{{kbdkey(M-,TAB)}}} + again will insert example settings for this keyword. + + - In the line after {{{samp(#+STARTUP: )}}} :: + + Complete startup keywords, i.e., valid keys for this line. + + - Elsewhere :: + + Complete dictionary words using Ispell. + +** Easy templates + :PROPERTIES: + :DESCRIPTION: Quick insertion of structural elements + :END: +#+cindex: template insertion +#+cindex: insertion, of templates + +Org mode supports insertion of empty structural elements (like +~#+BEGIN_SRC~ and ~#+END_SRC~ pairs) with just a few key strokes. This +is achieved through a native template expansion mechanism. Note that +Emacs has several other template mechanisms which could be used in a +similar way, for example {{{file(yasnippet)}}}. + +To insert a structural element, type a {{{kbd(<)}}}, followed by a +template selector and {{{kbdkey(,TAB)}}}. Completion takes effect only +when the above keystrokes are typed on a line by itself. + +The following template selectors are currently supported: +#+kindex: s +#+kindex: e +#+kindex: q +#+kindex: v +#+kindex: c +#+kindex: l +#+kindex: L +#+kindex: h +#+kindex: H +#+kindex: a +#+kindex: A +#+kindex: i +#+kindex: I + +#+attr_texinfo: :columns 0.2 0.7 +| Selector | Template | +|--------------+---------------------------------------| +| {{{kbd(a)}}} | ~#+BEGIN_ASCII~ ...~ #+END_ASCII~ | +| {{{kbd(A)}}} | ~#+ASCII:~ | +| {{{kbd(c)}}} | ~#+BEGIN_CENTER~ ... ~#+END_CENTER~ | +| {{{kbd(e)}}} | ~#+BEGIN_EXAMPLE~ ... ~#+END_EXAMPLE~ | +| {{{kbd(h)}}} | ~#+BEGIN_HTML~ ... ~#+END_HTML~ | +| {{{kbd(H)}}} | ~#+HTML:~ | +| {{{kbd(i)}}} | ~#+INDEX:~ | +| {{{kbd(I)}}} | ~#+INCLUDE:~ | +| {{{kbd(l)}}} | ~#+BEGIN_LaTeX~ ... ~#+END_LaTeX~ | +| {{{kbd(L)}}} | ~#+LaTeX:~ | +| {{{kbd(q)}}} | ~#+BEGIN_QUOTE~ ... ~#+END_QUOTE~ | +| {{{kbd(s)}}} | ~#+BEGIN_SRC~ ... ~#+END_SRC~ | +| {{{kbd(v)}}} | ~#+BEGIN_VERSE~ ... ~#+END_VERSE~ | + +For example, on an empty line, typing "<e" and then pressing TAB, will expand +into a complete EXAMPLE template. + +You can install additional templates by customizing the variable +~org-structure-template-alist~. See the docstring of the variable for +additional details. + +** Speed keys + :PROPERTIES: + :DESCRIPTION: Electric commands at the beginning of a headline + :END: +#+cindex: speed keys +#+vindex: org-use-speed-commands +#+vindex: org-speed-commands-user + +Single keys can be made to execute commands when the cursor is at the +beginning of a headline, i.e., before the first star. Configure the +variable ~org-use-speed-commands~ to activate this feature. There is a +pre-defined list of commands, and you can add more such commands using +the variable ~org-speed-commands-user~. Speed keys do not only speed +up navigation and other commands, but they also provide an alternative +way to execute commands bound to keys that are not or not easily +available on a TTY, or on a small mobile device with a limited +keyboard. + +To see which commands are available, activate the feature and press +{{{kbd(?)}}} with the cursor at the beginning of a headline. + +** Code evaluation security + :PROPERTIES: + :DESCRIPTION: Org mode files evaluate in-line code + :TITLE: Code evaluation and security issues + :END: + +Org provides tools to work with the code snippets, including +evaluating them. + +Running code on your machine always comes with a security risk. Badly +written or malicious code can be executed on purpose or by accident. +Org has default settings that will only evaluate source code if you +give explicit permission to do so, and as a casual user of these +features you should leave these precautions intact. + +For people who regularly work with source code, the confirmation +prompts can become annoying, and you might want to turn them off. This +can be done, but you must be aware of the risks that are involved. + +Code evaluation can happen under the following circumstances: + +#+attr_texinfo: :table-type table :indic @asis +- Source code blocks :: + + Source code blocks can be evaluated during export, or when pressing + {{{kbd(C-c C-c)}}} in the block. The most important thing to realize + here is that Org mode files which contain code snippets are, in a + certain sense, like executable files. So you should accept them and + load them into Emacs only from trusted sources---just like you would + do with a program you install on your computer. + + Make sure you know what you are doing before customizing the variables + that take off the default security brakes. + + - ~org-confirm-babel-evaluate~ :: + + When ~t~ (the default), the user is asked before every code block + evaluation. When ~nil~, the user is not asked. When set to a function, + it is called with two arguments (language and body of the code block) + and should return ~t~ to ask and ~nil~ not to ask. + + For example, here is how to execute "ditaa" code (which is considered + safe) without asking: + + #+header: :eval no + #+header: :exports code + #+begin_src emacs-lisp + (defun my-org-confirm-babel-evaluate (lang body) + (not (string= lang "ditaa"))) ; don't ask for ditaa + (setq org-confirm-babel-evaluate 'my-org-confirm-babel-evaluate) + #+end_src + +- Following ~shell~ and ~elisp~ links :: + + Org has two link types that can directly evaluate code (see [[External + links]]). These links can be problematic because the code to be + evaluated is not visible. + + - ~org-confirm-shell-link-function~ :: + + Function to queries user about shell link execution. + + - ~org-confirm-elisp-link-function~ :: + + Function to query user for Emacs Lisp link execution. + +- Formulas in tables :: + + Formulas in tables (see [[The spreadsheet]]) are code that is evaluated + either by the /calc/ interpreter, or by the /Emacs Lisp/ interpreter. + +** Customization + :PROPERTIES: + :DESCRIPTION: Adapting Org to your taste + :END: +#+cindex: customization +#+cindex: options, for customization +#+cindex: variables, for customization + +There are more than 500 variables that can be used to customize Org. +For the sake of compactness of the manual, I am not describing the +variables here. A structured overview of customization variables is +available with {{{kbd(M-x org-customize)}}}. Or select ~Browse Org +Group~ from the ~Org->Customization~ menu. Many settings can also be +activated on a per-file basis, by putting special lines into the +buffer (see [[In-buffer settings]]). + +** In-buffer settings + :PROPERTIES: + :DESCRIPTION: Overview of the #+KEYWORDS + :TITLE: Summary of in-buffer settings + :END: +#+cindex: in-buffer settings +#+cindex: special keywords + +Org mode uses special lines in the buffer to define settings on a +per-file basis. These lines start with a {{{samp(#+)}}} followed by a +keyword, a colon, and then individual words defining a setting. +Several setting words can be in the same line, but you can also have +multiple lines for the keyword. While these settings are described +throughout the manual, here is a summary. After changing any of those +lines in the buffer, press {{{kbd(C-c C-c)}}} with the cursor still in +the line to activate the changes immediately. Otherwise they become +effective only when the file is visited again in a new Emacs session. + +#+vindex: org-archive-location +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(#+ARCHIVE: %s_done)}}} :: + + This line sets the archive location for the agenda file. It applies to + all subsequent lines, until the next {{{samp(#+ARCHIVE)}}} line or the + end of the file. The first such line also applies to any entries + before it. The corresponding variable is ~org-archive-location~. + +- {{{kbd(#+CATEGORY:)}}} :: + + This line sets the category for the agenda file. The category applies + to all subsequent lines, until the next {{{samp(#+CATEGORY)}}} line or + the end of the file. The first such line also applies to any entries + before it. + +- {{{kbd(#+COLUMNS: %25ITEM ...)}}} :: + #+cindex: property, COLUMNS + + Set the default format for columns view. This format applies when + columns view is invoked in locations where no ~COLUMNS~ property + applies. + +- {{{kbd(#+CONSTANTS: name1=value1 ...)}}} :: + #+vindex: org-table-formula-constants + #+vindex: org-table-formula + + Set file-local values for constants to be used in table formulas. This + line sets the local variable ~org-table-formula-constants-local~. The + global version of this variable is ~org-table-formula-constants~. + +- {{{kbd(#+FILETAGS: :tag1:tag2:tag3:)}}} :: + + Set tags that can be inherited by any entry in the file, including the + top-level entries. + +- {{{kbd(#+DRAWERS: NAME1 ...)}}} :: + #+vindex: org-drawers + + Set the file-local set of additional drawers. The corresponding global + variable is ~org-drawers~. + +- {{{kbd(#+LINK: linkword replace)}}} :: + #+vindex: org-link-abbrev-alist + + These lines (several are allowed) specify link abbreviations. See + [[Link abbreviations]]. The corresponding variable is ~org-link-abbrev-alist~. + +- {{{kbd(#+PRIORITIES: highest lowest default)}}} :: + #+vindex: org-highest-priority + #+vindex: org-lowest-priority + #+vindex: org-default-priority + + This line sets the limits and the default for the priorities. All + three must be either letters A-Z or numbers 0-9. The highest priority + must have a lower ASCII number than the lowest priority. + +- {{{kbd(#+PROPERTY: Property_Name Value)}}} :: + + This line sets a default inheritance value for entries in the current + buffer, most useful for specifying the allowed values of a property. + +- {{{kbd(#+SETUPFILE: file)}}} :: + #+cindex: #+SETUPFILE + + This line defines a file that holds more in-buffer setup. Normally + this is entirely ignored. Only when the buffer is parsed for + option-setting lines (i.e., when starting Org mode for a file, when + pressing {{{kbd(C-c C-c)}}} in a settings line, or when exporting), + then the contents of this file are parsed as if they had been included + in the buffer. In particular, the file can be any other Org mode file + with internal setup. You can visit the file the cursor is in the line + with {{{kbd(C-c ')}}}. + +- {{{kbd(#+STARTUP:)}}} :: + #+cindex: #+STARTUP: + + This line sets options to be used at startup of Org mode, when an + Org file is being visited. + + The first set of options deals with the initial visibility of the + outline tree. The corresponding variable for global default settings + is ~org-startup-folded~, with a default value ~t~, which means + ~overview~. + + #+vindex: org-startup-folded + #+cindex: @code{overview}, STARTUP keyword + #+cindex: @code{content}, STARTUP keyword + #+cindex: @code{showall}, STARTUP keyword + #+cindex: @code{showeverything}, STARTUP keyword + + #+attr_texinfo: :table-type table :indic @asis + - ~overview~ :: top-level headlines only + - ~content~ :: all headlines + - ~showall~ :: no folding of any entries + - ~showeverything~ :: show even drawer contents + + #+vindex: org-startup-indented + #+cindex: @code{indent}, STARTUP keyword + #+cindex: @code{noindent}, STARTUP keyword + + Dynamic virtual indentation is controlled by the variable + ~org-startup-indented~.[fn:182] + + #+attr_texinfo: :table-type table :indic @asis + - ~indent~ :: start with ~org-indent-mode~ turned on + - ~noindent~ :: start with ~org-indent-mode~ turned off + + #+vindex: org-startup-align-all-tables + + Then there are options for aligning tables upon visiting a file. This + is useful in files containing narrowed table columns. The corresponding + variable is ~org-startup-align-all-tables~, with a default value + ~nil~. + + #+cindex: @code{align}, STARTUP keyword + #+cindex: @code{noalign}, STARTUP keyword + + #+attr_texinfo: :table-type table :indic @asis + - ~align~ :: align all tables + - ~noalign~ :: don't align tables on startup + + #+vindex: org-startup-with-inline-images + + When visiting a file, inline images can be automatically displayed. + The corresponding variable is ~org-startup-with-inline-images~, with a + default value ~nil~ to avoid delays when visiting a file. + + #+cindex: @code{inlineimages}, STARTUP keyword + #+cindex: @code{noinlineimages}, STARTUP keyword + + #+attr_texinfo: :table-type table :indic @asis + - ~inlineimages~ show inline images + - ~noinlineimages~ don't show inline images on startup + + #+vindex: org-log-done + #+vindex: org-log-note-clock-out + #+vindex: org-log-repeat + + Logging the closing and reopening of TODO items and clock intervals + can be configured using these options (see variables ~org-log-done~, + ~org-log-note-clock-out~, and ~org-log-repeat~). + + #+cindex: @code{logdone}, STARTUP keyword + #+cindex: @code{lognotedone}, STARTUP keyword + #+cindex: @code{nologdone}, STARTUP keyword + #+cindex: @code{lognoteclock-out}, STARTUP keyword + #+cindex: @code{nolognoteclock-out}, STARTUP keyword + #+cindex: @code{logrepeat}, STARTUP keyword + #+cindex: @code{lognoterepeat}, STARTUP keyword + #+cindex: @code{nologrepeat}, STARTUP keyword + #+cindex: @code{logreschedule}, STARTUP keyword + #+cindex: @code{lognotereschedule}, STARTUP keyword + #+cindex: @code{nologreschedule}, STARTUP keyword + #+cindex: @code{logredeadline}, STARTUP keyword + #+cindex: @code{lognoteredeadline}, STARTUP keyword + #+cindex: @code{nologredeadline}, STARTUP keyword + #+cindex: @code{logrefile}, STARTUP keyword + #+cindex: @code{lognoterefile}, STARTUP keyword + #+cindex: @code{nologrefile}, STARTUP keyword + + #+attr_texinfo: :table-type table :indic @asis + - ~logdone~ :: record a timestamp when an item is marked DONE + - ~lognotedone~ :: record timestamp and a note when DONE + - ~nologdone~ :: don't record when items are marked DONE + - ~logrepeat~ :: record a time when reinstating a repeating item + - ~lognoterepeat~ :: record a note when reinstating a repeating item + - ~nologrepeat~ :: do not record when reinstating repeating item + - ~lognoteclock-out~ :: record a note when clocking out + - ~nolognoteclock-out~ :: don't record a note when clocking out + - ~logreschedule~ :: record a timestamp when scheduling time changes + - ~lognotereschedule~ :: record a note when scheduling time changes + - ~nologreschedule~ :: do not record when a scheduling date changes + - ~logredeadline~ :: record a timestamp when deadline changes + - ~lognoteredeadline~ :: record a note when deadline changes + - ~nologredeadline~ :: do not record when a deadline date changes + - ~logrefile~ :: record a timestamp when refiling + - ~lognoterefile~ :: record a note when refiling + - ~nologrefile~ :: do not record when refiling + + #+vindex: org-hide-leading-stars + #+vindex: org-odd-levels-only + + Here are the options for hiding leading stars in outline headings, and + for indenting outlines. The corresponding variables are + ~org-hide-leading-stars~ and ~org-odd-levels-only~, both with a + default setting ~nil~ (meaning ~showstars~ and ~oddeven~). + + #+cindex: @code{hidestars}, STARTUP keyword + #+cindex: @code{showstars}, STARTUP keyword + #+cindex: @code{odd}, STARTUP keyword + #+cindex: @code{even}, STARTUP keyword + + #+attr_texinfo: :table-type table :indic @asis + - ~hidestars~ :: make all but one of the stars starting a headline invisible. + - ~showstars~ :: show all stars starting a headline + - ~indent~ :: virtual indentation according to outline level + - ~noindent~ :: no virtual indentation according to outline level + - ~odd~ :: allow only odd outline levels (1, 3, ...) + - ~oddeven~ :: allow all outline levels + + #+vindex: org-put-time-stamp-overlays + #+vindex: org-time-stamp-overlay-formats + + To turn on custom format overlays over timestamps (variables + ~org-put-time-stamp-overlays~ and ~org-time-stamp-overlay-formats~), + use: + + #+cindex: @code{customtime}, STARTUP keyword + + #+attr_texinfo: :table-type table :indic @asis + - ~customtime~ :: overlay custom time format + + #+vindex: constants-unit-system + + The following options influence the table spreadsheet (variable + ~constants-unit-system~). + + #+cindex: @code{constcgs}, STARTUP keyword + #+cindex: @code{constSI}, STARTUP keyword + + #+attr_texinfo: :table-type table :indic @asis + - ~constcgs~ :: {{{file(constants.el)}}} should use the c-g-s unit system + - ~constSI~ :: {{{file(constants.el)}}} should use the SI unit system + + #+vindex: org-footnote-define-inline + #+vindex: org-footnote-auto-label + #+vindex: org-footnote-auto-adjust + + To influence footnote settings, use the following keywords. The + corresponding variables are ~org-footnote-define-inline~, + ~org-footnote-auto-label~, and ~org-footnote-auto-adjust~. + + #+cindex: @code{fninline}, STARTUP keyword + #+cindex: @code{nofninline}, STARTUP keyword + #+cindex: @code{fnlocal}, STARTUP keyword + #+cindex: @code{fnprompt}, STARTUP keyword + #+cindex: @code{fnauto}, STARTUP keyword + #+cindex: @code{fnconfirm}, STARTUP keyword + #+cindex: @code{fnplain}, STARTUP keyword + #+cindex: @code{fnadjust}, STARTUP keyword + #+cindex: @code{nofnadjust}, STARTUP keyword + + #+attr_texinfo: :table-type table :indic @asis + - ~fninline~ :: define footnotes inline + - ~fnnoinline~ :: define footnotes in separate section + - ~fnlocal~ :: define footnotes near first reference, but not inline + - ~fnprompt~ :: prompt for footnote labels + - ~fnauto~ :: create ~[fn:1]~-like labels automatically (default) + - ~fnconfirm~ :: offer automatic label for editing or confirmation + - ~fnplain~ :: create ~[1]~-like labels automatically + - ~fnadjust~ :: automatically renumber and sort footnotes + - ~nofnadjust~ :: do not renumber and sort automatically + + #+cindex: org-hide-block-startup + + To hide blocks on startup, use these keywords. The corresponding + variable is ~org-hide-block-startup~. + + #+cindex: @code{hideblocks}, STARTUP keyword + #+cindex: @code{nohideblocks}, STARTUP keyword + + #+attr_texinfo: :table-type table :indic @asis + - ~hideblocks~ :: Hide all begin/end blocks on startup + - ~nohideblocks~ :: Do not hide blocks on startup + + #+cindex: org-pretty-entities + + The display of entities as UTF-8 characters is governed by the + variable ~org-pretty-entities~ and the keywords + + #+cindex: @code{entitiespretty}, STARTUP keyword + #+cindex: @code{entitiesplain}, STARTUP keyword + + #+attr_texinfo: :table-type table :indic @asis + - ~entitiespretty~ :: Show entities as UTF-8 characters where possible + - ~entitiesplain~ :: Leave entities plain + +- {{{kbd(#+TAGS: TAG1(c1) TAG2(c2))}}} :: + #+vindex: org-tag-alist + + These lines (several such lines are allowed) specify the valid tags in + this file, and (potentially) the corresponding /fast tag selection/ + keys. The corresponding variable is ~org-tag-alist~. + +- {{{kbd(#+TBLFM:)}}} :: + + This line contains the formulas for the table directly above the line. + +- {{{kbd(#+TITLE:)}}}, {{{kbd(#+AUTHOR:)}}}, {{{kbd(#+EMAIL:)}}}, {{{kbd(#+LANGUAGE:)}}}, {{{kbd(#+TEXT:)}}}, {{{kbd(#+DATE:)}}}, {{{kbd(#+OPTIONS:)}}}, {{{kbd(#+BIND:)}}}, {{{kbd(#+XSLT:)}}}, {{{kbd(#+DESCRIPTION:)}}}, {{{kbd(#+KEYWORDS:)}}}, {{{kbd(#+LaTeX_HEADER:)}}}, {{{kbd(#+STYLE:)}}}, {{{kbd(#+LINK_UP:)}}}, {{{kbd(#+LINK_HOME:)}}}, {{{kbd(#+EXPORT_SELECT_TAGS:)}}}, {{{kbd(#+EXPORT_EXCLUDE_TAGS:)}}} :: + + These lines provide settings for exporting files. For more details see + [[Export options]]. + +- {{{kbd(#+TODO:)}}}, {{{kbd(#+SEQ_TODO:)}}}, {{{kbd(#+TYP_TODO:)}}} :: + #+vindex: org-todo-keywords + + These lines set the TODO keywords and their interpretation in the + current file. The corresponding variable is ~org-todo-keywords~. + +** The very busy C-c C-c key + :PROPERTIES: + :DESCRIPTION: When in doubt, press C-c C-c + :TITLE: The very busy C-c C-c key + :END: +#+kindex: C-c C-c +#+cindex: C-c C-c, overview + +The key {{{kbd(C-c C-c)}}} has many purposes in Org, which are all +mentioned scattered throughout this manual. One specific function of +this key is to add /tags/ to a headline (see [[Tags]]). In many +other circumstances it means something like "Hey Org, look +here and update according to what you see here." Here is a summary of +what this means in different contexts. + +- If there are highlights in the buffer from the creation of a sparse + tree, or from clock display, remove these highlights. +- If the cursor is in one of the special ~#+KEYWORD~ lines, this + triggers scanning the buffer for these lines and updating the + information. +- If the cursor is inside a table, realign the table. This command + works even if the automatic table editor has been turned off. +- If the cursor is on a ~#+TBLFM~ line, re-apply the formulas to the + entire table. +- If the current buffer is a capture buffer, close the note and file + it. With a prefix argument, file it, without further interaction, to + the default location. +- If the cursor is on a ~<<<target>>>~, update radio targets and + corresponding links in this buffer. +- If the cursor is in a property line or at the start or end of a + property drawer, offer property commands. +- If the cursor is at a footnote reference, go to the corresponding + definition, and vice versa. +- If the cursor is on a statistics cookie, update it. +- If the cursor is in a plain list item with a checkbox, toggle the + status of the checkbox. +- If the cursor is on a numbered item in a plain list, renumber the + ordered list. +- If the cursor is on the ~#+BEGIN~ line of a dynamic block, the block + is updated. +- If the cursor is at a timestamp, fix the day name in the timestamp. + +** Clean view + :PROPERTIES: + :DESCRIPTION: Getting rid of leading stars in the outline + :TITLE: A cleaner outline view + :END: +#+cindex: hiding leading stars +#+cindex: dynamic indentation +#+cindex: odd-levels-only outlines +#+cindex: clean outline view + +Some people find it noisy and distracting that the Org headlines start +with a potentially large number of stars, and that text below the +headlines is not indented. While this is no problem when writing a +/book-like/ document where the outline headings are really section +headings, in a more /list-oriented/ outline, indented structure is a +lot cleaner: + +#+begin_example + ,* Top level headline | * Top level headline + ,** Second level | * Second level + ,*** 3rd level | * 3rd level + some text | some text + ,*** 3rd level | * 3rd level + more text | more text + ,* Another top level headline | * Another top level headline +#+end_example + +{{{noindent}}} If you are using at least Emacs 23.2 and version 6.29 +of Org, this kind of view can be achieved dynamically at display time +using ~org-indent-mode~.[fn:183] In this minor mode, all lines are +prefixed for display with the necessary amount of space.[fn:154] Also +headlines are prefixed with additional stars, so that the amount of +indentation shifts by two spaces per level.[fn:155] All headline stars +but the last one are made invisible using the ~org-hide~ face---see +below under {{{samp(2.)}}} for more information on how this +works.[fn:156] You can turn on ~org-indent-mode~ for all files by +customizing the variable ~org-startup-indented~, or you can turn it on +for individual files using + +#+begin_example + ,#+STARTUP: indent +#+end_example + +If you want a similar effect in an earlier version of Emacs and/or +Org, or if you want the indentation to be hard space characters so +that the plain text file looks as similar as possible to the Emacs +display, Org supports you in the following way: + +#+attr_texinfo: :table-type table :indic @asis +- Indentation of text below headlines :: + + You may indent text below each headline to make the left boundary line up + with the headline, like + + #+begin_example + ,*** 3rd level + more text, now indented + #+end_example + + #+vindex: org-adapt-indentation + + Org supports this with paragraph filling, line wrapping, and structure + editing, + preserving or adapting the indentation as appropriate.[fn:157] + +- Hiding leading stars :: + #+vindex: org-hide-leading-stars + + You can modify the display in such a way that all leading stars become + invisible. To do this in a global way, configure the variable + ~org-hide-leading-stars~ or change this on a per-file basis with + + #+begin_example + ,#+STARTUP: hidestars + ,#+STARTUP: showstars + #+end_example + + With hidden stars, the tree becomes: + + #+begin_example + ,* Top level headline + , * Second level + , * 3rd level + ... + #+end_example + + #+vindex: org-hide @r{(face)} + + {{{noindent}}} The leading stars are not truly replaced by whitespace, + they are only fontified with the face ~org-hide~ that uses the + background color as font color. If you are not using either white or + black background, you may have to customize this face to get the + wanted effect. Another possibility is to set this font such that the + extra stars are /almost/ invisible, for example using the color + ~grey90~ on a white background. +- Odd levels :: + #+vindex: org-odd-levels-only + + Things become cleaner still if you skip all the even levels and use + only odd levels 1, 3, 5, ..., effectively adding two stars to go from + one outline level to the next.[fn:158] In this way we get the outline + view shown at the beginning of this section. In order to make the + structure editing and export commands handle this convention + correctly, configure the variable ~org-odd-levels-only~, or set this + on a per-file basis with one of the following lines: + + #+begin_example + ,#+STARTUP: odd + ,#+STARTUP: oddeven + #+end_example + + You can convert an Org file from single-star-per-level to the + double-star-per-level convention with {{{kbdkey(M-x + org-convert-to-odd-levels , RET)}}} in that file. The reverse + operation is {{{kbd(M-x org-convert-to-oddeven-levels)}}}. + +** TTY keys + :PROPERTIES: + :DESCRIPTION: Using Org on a tty + :TITLE: Using Org on a tty + :END: + +Because Org contains a large number of commands, by default many of +Org's core commands are bound to keys that are generally not +accessible on a tty, such as the cursor keys ({{{key(left)}}}, +{{{key(right)}}}, {{{key(up)}}}, {{{key(down)}}}), {{{key(TAB)}}} and +{{{key(RET)}}}, in particular when used together with modifiers like +{{{key(Meta)}}} and/or {{{key(Shift)}}}. To access these commands on a +tty when special keys are unavailable, the following alternative +bindings can be used. The tty bindings below will likely be more +cumbersome; you may find for some of the bindings below that a +customized workaround suits you better. For example, changing a +timestamp is really only fun with {{{kbdkey(S-,cursor)}}} keys, +whereas on a tty you would rather use {{{kbd(C-c .)}}} to re-insert +the timestamp. + +#+attr_texinfo: :columns 0.2 0.3 0.1 0.4 +| Default | Alternative 1 | Speed key | Alternative 2 | +|--------------------------+------------------------------+--------------+---------------------------| +| {{{kbdkey(S-,TAB)}}} | {{{kbdspckey(C-u,TAB)}}} | {{{kbd(C)}}} | | +| {{{kbdkey(M-,left)}}} | {{{kbd(C-c C-x l)}}} | {{{kbd(l)}}} | {{{kbdkeys(,Esc,left)}}} | +| {{{kbdkey(M-S-,left)}}} | {{{kbd(C-c C-x L)}}} | {{{kbd(L)}}} | | +| {{{kbdkey(M-,right)}}} | {{{kbd(C-c C-x r)}}} | {{{kbd(r)}}} | {{{kbdkeys(,Esc,right)}}} | +| {{{kbdkey(M-S-,right)}}} | {{{kbd(C-c C-x R)}}} | {{{kbd(R)}}} | | +| {{{kbdkey(M-,up)}}} | {{{kbd(C-c C-x u)}}} | {{{kbd( )}}} | {{{kbdkeys(,Esc,up)}}} | +| {{{kbdkey(M-S-,up)}}} | {{{kbd(C-c C-x U)}}} | {{{kbd(U)}}} | | +| {{{kbdkey(M-,down)}}} | {{{kbd(C-c C-x d)}}} | {{{kbd( )}}} | {{{kbdkeys(,Esc,down)}}} | +| {{{kbdkey(M-S-,down)}}} | {{{kbd(C-c C-x D)}}} | {{{kbd(D)}}} | | +| {{{kbdkey(S-,RET)}}} | {{{kbd(C-c C-x c)}}} | {{{kbd( )}}} | | +| {{{kbdkey(M-,RET)}}} | {{{kbd(C-c C-x m)}}} | {{{kbd( )}}} | {{{kbdkeys(,Esc,RET)}}} | +| {{{kbdkey(M-S-,RET)}}} | {{{kbd(C-c C-x M)}}} | {{{kbd( )}}} | | +| {{{kbdkey(S-,left)}}} | {{{kbdspckey(C-c,left)}}} | {{{kbd( )}}} | | +| {{{kbdkey(S-,right)}}} | {{{kbdspckey(C-c,right)}}} | {{{kbd( )}}} | | +| {{{kbdkey(S-,up)}}} | {{{kbdspckey(C-c,up)}}} | {{{kbd( )}}} | | +| {{{kbdkey(S-,down)}}} | {{{kbdspckey(C-c,down)}}} | {{{kbd( )}}} | | +| {{{kbdkey(C-S-,left)}}} | {{{kbdspckey(C-c C-x,left)}}} | {{{kbd( )}}} | | +| {{{kbdkey(C-S-,right)}}} | {{{kbdspckey(C-c C-x,right)}}} | {{{kbd( )}}} | | + +** Interaction + :PROPERTIES: + :DESCRIPTION: Other Emacs packages + :TITLE: Interaction with other packages + :END: +#+cindex: packages, interaction with other +Org lives in the world of GNU Emacs and interacts in various ways +with other code out there. + +*** FIXME Cooperation + :PROPERTIES: + :DESCRIPTION: Packages Org cooperates with + :TITLE: Packages that Org cooperates with + :END: + +#+attr_texinfo: :table-type table :indic @asis +- {{{file(calc.el)}}} by Dave Gillespie :: + #+cindex: @file{calc.el} + #+cindex: Gillespie, Dave + + Org uses the Calc package for implementing spreadsheet functionality + in its tables (see [[The spreadsheet]]). Org checks for the availability + of Calc by looking for the function ~calc-eval~ which will have been + autoloaded during setup if Calc has been installed properly. As of + Emacs 22, Calc is part of the Emacs distribution. Another possibility + for interaction between the two packages is using Calc for embedded + calculations. See [[info:calc:Embedded Mode][GNU Emacs Calc Manual]]. + +- {{{file(constants.el)}}} by Carsten Dominik :: + #+cindex: @file{constants.el} + #+cindex: Dominik, Carsten + #+vindex: org-table-formula-constants + + In a table formula (see [[The spreadsheet]]), it is possible to use names + for natural constants or units. Instead of defining your own constants + in the variable ~org-table-formula-constants~, install the + {{{file(constants)}}} package which defines a large number of + constants and units, and lets you use unit prefixes like {{{samp(M)}}} + for {{{samp(Mega)}}}, etc. You will need version 2.0 of this package, + available at [[http://www.astro.uva.nl/~dominik/Tools]]. Org checks for + the function ~constants-get~, which has to be autoloaded in your + setup. See the installation instructions in the file + {{{file(constants.el)}}}. + +- {{{file(cdlatex.el)}}} by Carsten Dominik :: + #+cindex: @file{cdlatex.el} + #+cindex: Dominik, Carsten + + Org mode can make use of the CDLaTeX package to efficiently enter + LaTeX fragments into Org files. See [[CDLaTeX mode]]. + +- {{{file(imenu.el)}}} by Ake Stenhoff and Lars Lindberg :: + #+cindex: @file{imenu.el} + #+cindex: Stenhoff, Ake + #+cindex: Lindberg, Lars + + Imenu allows menu access to an index of items in a file. Org mode + supports Imenu---all you need to do to get the index is the following: + + #+begin_src emacs-lisp + (add-hook 'org-mode-hook + (lambda () (imenu-add-to-menubar "Imenu"))) + #+end_src + + #+vindex: org-imenu-depth + + By default the index is two levels deep---you can modify the depth + using the option ~org-imenu-depth~. + +- {{{file(remember.el)}}} by John Wiegley :: + #+cindex: @file{remember.el} + #+cindex: Wiegley, John + + Org used to use this package for capture, but no longer does. + +- {{{file(speedbar.el)}}} by Eric M. Ludlam :: + #+cindex: @file{speedbar.el} + #+cindex: Ludlam, Eric M. + + Speedbar is a package that creates a special frame displaying files and + index items in files. Org mode supports Speedbar and allows you to + drill into Org files directly from the Speedbar. It also allows you to + restrict the scope of agenda commands to a file or a subtree by using + the command {{{kbd(<)}}} in the Speedbar frame. + +- {{{file(table.el)}}} by Takaaki Ota :: + #+kindex: C-c C-c + #+cindex: table editor, @file{table.el} + #+cindex: @file{table.el} + #+cindex: Ota, Takaaki + + Complex ASCII tables with automatic line wrapping, column- and row-spanning, + and alignment can be created using the Emacs table package by Takaaki Ota + ([[http://sourceforge.net/projects/table]], and also part of Emacs 22). + Org mode will recognize these tables and export them properly. Because of + interference with other Org mode functionality, you unfortunately cannot edit + these tables directly in the buffer. Instead, you need to use the command + {{{kbd(C-c ')}}} to edit them, similar to source code snippets. + + - {{{kbd(C-c ')}}}, ~org-edit-special~ :: + #+kindex: C-c ' + + Edit a {{{file(table.el)}}} table. Works when the cursor is in a + table.el table. + + - {{{kbd(C-c XXX)}}}, ~org-table-create-with-table.el~ :: + #+kindex: C-c ~ + # Should be ~ + Insert a {{{file(table.el)}}} table. If there is already a table at + point, this command converts it between the {{{file(table.el)}}} + format and the Org mode format. See the documentation string of the + command ~org-convert-table~ for the restrictions under which this is + possible. + + {{{file(table.el)}}} is part of Emacs since Emacs 22. + +- {{{file(footnote.el)}}} by Steven L. Baur :: + #+cindex: @file{footnote.el} + #+cindex: Baur, Steven L. + + Org mode recognizes numerical footnotes as provided by this package. + However, Org mode also has its own footnote support (see [[Creating footnotes]]), + which makes using {{{file(footnote.el)}}} unnecessary. + +*** Conflicts + :PROPERTIES: + :DESCRIPTION: Packages that lead to conflicts + :END: + +#+cindex: @code{shift-selection-mode} +#+vindex: org-support-shift-select + +In Emacs 23, ~shift-selection-mode~ is on by default, meaning that +cursor motions combined with the shift key should start or enlarge +regions. This conflicts with the use of {{{kbdkey(S-,cursor)}}} +commands in Org to change timestamps, TODO keywords, priorities, and +item bullet types if the cursor is at such a location. By default, +{{{kbdkey(S-,cursor)}}} commands outside special contexts don't do +anything, but you can customize the variable +~org-support-shift-select~. Org mode then tries to accommodate shift +selection by using it outside of the special contexts where +special commands apply, and by extending an existing active +region even if the cursor moves across a special context. + +#+attr_texinfo: :table-type table :indic @asis +- {{{file(CUA.el)}}} by Kim. F. Storm :: + #+cindex: @file{CUA.el} + #+cindex: Storm, Kim. F. + #+vindex: org-replace-disputed-keys + + Key bindings in Org conflict with the {{{kbdkey(S-,<cursor>)}}} keys + used by CUA mode (as well as ~pc-select-mode~ and ~s-region-mode~) to + select and extend the region. In fact, Emacs 23 has this built-in in + the form of ~shift-selection-mode~, see previous paragraph. If you are + using Emacs 23, you probably don't want to use another package for + this purpose. However, if you prefer to leave these keys to a + different package while working in Org mode, configure the variable + ~org-replace-disputed-keys~. When set, Org will move the following key + bindings in Org files, and in the agenda buffer (but not during date + selection). + + | S-UP {{{result}}} M-p | S-DOWN {{{result}}} M-n | + | S-LEFT {{{result}}} M-- | S-RIGHT {{{result}}} M-+ | + | C-S-LEFT {{{result}}} M-S-- | C-S-RIGHT {{{result}}} M-S-+ | + + #+vindex: org-disputed-keys + + Yes, these are unfortunately more difficult to remember. If you want + to have other replacement keys, look at the variable + ~org-disputed-keys~. + +- {{{file(filladapt.el)}}} by Kyle Jones :: + #+cindex: @file{filladapt.el} + #+cindex: Jones, Kyle + + Org mode tries to do the right thing when filling paragraphs, list + items and other elements. Many users reported they had problems using + both {{{file(filladapt.el)}}} and Org mode, so a safe thing to do is + to disable it like this: + + #+begin_src emacs-lisp + (add-hook 'org-mode-hook 'turn-off-filladapt-mode) + #+end_src + +- {{{file(yasnippet.el)}}} :: + #+cindex: @file{yasnippet.el} + + The way Org mode binds the {{{key(TAB)}}} key (binding to ~[tab]~ + instead of ~"\t"~) overrules YASnippet's access to this key. The + following code fixed this problem: + + #+begin_src emacs-lisp + (add-hook 'org-mode-hook + (lambda () + (org-set-local 'yas/trigger-key [tab]) + (define-key yas/keymap [tab] 'yas/next-field-or-maybe-expand))) + #+end_src + + The latest version of yasnippet doesn't play well with Org mode. If the + above code does not fix the conflict, start by defining the following + function: + + #+begin_src emacs-lisp + (defun yas/org-very-safe-expand () + (let ((yas/fallback-behavior 'return-nil)) (yas/expand))) + #+end_src + + Then, tell Org mode what to do with the new function: + + #+begin_src emacs-lisp + (add-hook 'org-mode-hook + (lambda () + (make-variable-buffer-local 'yas/trigger-key) + (setq yas/trigger-key [tab]) + (add-to-list 'org-tab-first-hook 'yas/org-very-safe-expand) + (define-key yas/keymap [tab] 'yas/next-field))) + #+end_src + +- {{{file(windmove.el)}}} by Hovav Shacham :: + #+cindex: @file{windmove.el} + #+cindex: Shacham, Hovav + + This package also uses the {{{kbd(S-<cursor>)}}} keys, so everything + written in the paragraph above about CUA mode also applies here. If + you want make the windmove function active in locations where Org mode + does not have special functionality on {{{kbdkey(S-,cursor)}}}, add + this to your configuration: + + #+begin_src emacs-lisp + ;; Make windmove work in org-mode: + (add-hook 'org-shiftup-final-hook 'windmove-up) + (add-hook 'org-shiftleft-final-hook 'windmove-left) + (add-hook 'org-shiftdown-final-hook 'windmove-down) + (add-hook 'org-shiftright-final-hook 'windmove-right) + #+end_src + +- {{{file(viper.el)}}} by Michael Kifer :: + #+cindex: @file{viper.el} + #+cindex: Kifer, Michael + #+kindex: C-c / + + Viper uses {{{kbd(C-c /)}}} and therefore makes this key not access the + corresponding Org mode command ~org-sparse-tree~. You need to find + another key for this command, or override the key in + ~viper-vi-global-user-map~ with + + #+begin_src emacs-lisp + (define-key viper-vi-global-user-map "C-c /" 'org-sparse-tree) + #+end_src + +** org-crypt + :PROPERTIES: + :DESCRIPTION: Encrypting Org files + :END: +#+cindex: @file{+org-crypt.el} +#+cindex: @code{org-decrypt-entry} + +Org-crypt will encrypt the text of an entry, but not the headline, or +properties. Org-crypt uses the Emacs EasyPG library to encrypt and +decrypt files. + +Any text below a headline that has a {{{samp(:crypt:)}}} tag will +automatically be encrypted when the file is saved. If you want to use +a different tag just customize the ~org-crypt-tag-matcher~ setting. + +To use org-crypt it is suggested that you have the following in your +{{{file(.emacs)}}}: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(require 'org-crypt) +(org-crypt-use-before-save-magic) +(setq org-tags-exclude-from-inheritance (quote ("crypt"))) + +(setq org-crypt-key nil) + ;; GPG key to use for encryption + ;; Either the Key ID or set to nil to use symmetric encryption. + +(setq auto-save-default nil) + ;; Auto-saving does not cooperate with org-crypt.el: so you need + ;; to turn it off if you plan to use org-crypt.el quite often. + ;; Otherwise, you'll get an (annoying) message each time you + ;; start Org. + + ;; To turn it off only locally, you can insert this: + ;; + ;; # -*- buffer-auto-save-file-name: nil; -*- +#+end_src + +Excluding the crypt tag from inheritance prevents already encrypted text +being encrypted again. + +* Hacking + :PROPERTIES: + :DESCRIPTION: How to hack your way around + :APPENDIX: Appendix + :END: +#+cindex: hacking + +This appendix describes some ways a user can extend the functionality +of Org. + +** Hooks + :PROPERTIES: + :DESCRIPTION: How to reach into Org's internals + :END: +#+cindex: hooks + +Org has a large number of hook variables that can be used to add +functionality. This appendix about hacking is going to illustrate the +use of some of them. A complete list of all hooks with documentation is +maintained by the Worg project and can be found at +[[http://orgmode.org/worg/org-configs/org-hooks.php]]. + +** Add-on packages + :PROPERTIES: + :DESCRIPTION: Available extensions + :END: +#+cindex: add-on packages + +A large number of add-on packages have been written by various +authors. These packages are not part of Emacs, but they are +distributed as contributed packages with the separate release +available at the Org mode home page at [[http://orgmode.org]]. The +list of contributed packages, along with documentation about each +package, is maintained by the Worg project at +[[http://orgmode.org/worg/org-contrib/]]. + +** Adding hyperlink types + :PROPERTIES: + :DESCRIPTION: New custom link types + :END: +#+cindex: hyperlinks, adding new types + +Org has a large number of hyperlink types built-in (see [[Hyperlinks]]). +If you would like to add new link types, Org provides an interface for +doing so. Let's look at an example file, {{{file(org-man.el)}}}, that +will add support for creating links like: + +#+begin_example + [[man:printf][The printf manual]] +#+end_example + +to show Unix manual pages inside Emacs: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +;;; org-man.el - Support for links to manpages in Org + +(require 'org) + +(org-add-link-type "man" 'org-man-open) +(add-hook 'org-store-link-functions 'org-man-store-link) + +(defcustom org-man-command 'man + "The Emacs command to be used to display a man page." + :group 'org-link + :type '(choice (const man) (const woman))) + +(defun org-man-open (path) + "Visit the manpage on PATH. +PATH should be a topic that can be thrown at the man command." + (funcall org-man-command path)) + +(defun org-man-store-link () + "Store a link to a manpage." + (when (memq major-mode '(Man-mode woman-mode)) + ;; This is a man page, we do make this link + (let* ((page (org-man-get-page-name)) + (link (concat "man:" page)) + (description (format "Manpage for %s" page))) + (org-store-link-props + :type "man" + :link link + :description description)))) + +(defun org-man-get-page-name () + "Extract the page name from the buffer name." + ;; This works for both `Man-mode' and `woman-mode'. + (if (string-match " \\(\\S-+\\)\\*" (buffer-name)) + (match-string 1 (buffer-name)) + (error "Cannot create link to this man page"))) + +(provide 'org-man) + +;;; org-man.el ends here +#+end_src + +{{{noindent}}} You would activate this new link type in +{{{file(.emacs)}}} with: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(require 'org-man) +#+end_src + +{{{noindent}}} Let's go through the file and see what it does. +#+vindex: org-store-link-functions + +1. It does ~(require 'org)~ to make sure that {{{file(org.el)}}} has + been loaded. + +2. The next line calls ~org-add-link-type~ to define a new link type + with prefix {{{samp(man)}}}. The call also contains the name of a + function that will be called to follow such a link. + +3. The next line adds a function to ~org-store-link-functions~, in + order to allow the command {{{kbd(C-c l)}}} to record a useful link + in a buffer displaying a man page. + + +The rest of the file defines the necessary variables and functions. +First there is a customization variable that determines which Emacs +command should be used to display man pages. There are two options, +~man~ and ~woman~. Then the function to follow a link is defined. It +gets the link path as an argument---in this case the link path is just +a topic for the manual command. The function calls the value of +~org-man-command~ to display the man page. + +Finally the function ~org-man-store-link~ is defined. When you try to +store a link with {{{kbd(C-c l)}}}, this function will be called to +try to make a link. The function must first decide if it is supposed +to create the link for this buffer type; we do this by checking the +value of the variable ~major-mode~. If not, the function must exit and +return the value ~nil~. If yes, the link is created by getting the +manual topic from the buffer name and prefixing it with the string +{{{samp(man:)}}}. Then it must call the command ~org-store-link-props~ +and set the ~:type~ and ~:link~ properties. Optionally you can also +set the ~:description~ property to provide a default for the link +description when the link is later inserted into an Org buffer with +{{{kbd(C-c C-l)}}}. + +When it makes sense for your new link type, you may also define a +function that implements special (e.g., completion) support for +inserting such a link with {{{kbd(C-c C-l)}}}. Such a function should +not accept any arguments, and return the full link with prefix. + +** Context-sensitive commands + :PROPERTIES: + :DESCRIPTION: How to add functionality to such commands + :END: +#+cindex: context-sensitive commands, hooks +#+cindex: add-ons, context-sensitive commands +#+vindex: org-ctrl-c-ctrl-c-hook + +Org has several commands that act differently depending on context. +The most important example is the {{{kbd(C-c C-c)}}} (see [[The very +busy C-c C-c key]]). Also the {{{kbd(M-cursor)}}} and +{{{kbd(M-S-cursor)}}} keys have this property. + +Add-ons can tap into this functionality by providing a function that +detects special context for that add-on and executes functionality +appropriate for the context. Here is an example from Dan Davison's +{{{file(org-R.el)}}} which allows you to evaluate commands based on +the {{{file(R)}}} programming language.[fn:159] For this package, +special contexts are lines that start with ~#+R:~ or ~#+RR:~. + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(defun org-R-apply-maybe () + "Detect if this is context for org-R and execute R commands." + (if (save-excursion + (beginning-of-line 1) + (looking-at "#\\+RR?:")) + (progn (call-interactively 'org-R-apply) + t) ;; to signal that we took action + nil)) ;; to signal that we did not + +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-R-apply-maybe) +#+end_src + +The function first checks if the cursor is in such a line. If that is +the case, ~org-R-apply~ is called and the function returns ~t~ to +signal that action was taken, and {{{kbd(C-c C-c)}}} will stop looking +for other contexts. If the function finds it should do nothing +locally, it returns ~nil~ so that other, similar functions can have a +try. + +** Tables in arbitrary syntax + :PROPERTIES: + :DESCRIPTION: Orgtbl for LaTeX and other programs + :END: +#+cindex: tables, in other modes +#+cindex: lists, in other modes +#+cindex: Orgtbl mode + +Since Orgtbl mode can be used as a minor mode in arbitrary buffers, a +frequent feature request has been to make it work with native tables +in specific languages, for example LaTeX. However, this is +extremely hard to do in a general way, would lead to a customization +nightmare, and would take away much of the simplicity of the Orgtbl +mode table editor. + +This appendix describes a different approach. We keep the Orgtbl mode +table in its native format (the source table), and use a custom +function to /translate/ the table to the correct syntax, and to +/install/ it in the right location (the target table). This puts +the burden of writing conversion functions on the user, but it allows +for a very flexible system. + +Bastien added the ability to do the same with lists, in Orgstruct +mode. You can use Org's facilities to edit and structure lists by +turning ~orgstruct-mode~ on, then locally exporting such lists in +another format (HTML, LaTeX or Texinfo.) + +*** Radio tables + :PROPERTIES: + :DESCRIPTION: Sending and receiving radio tables + :END: +#+cindex: radio tables + +To define the location of the target table, you first need to create +two lines that are comments in the current mode, but contain magic +words for Orgtbl mode to find. Orgtbl mode will insert the translated +table between these lines, replacing whatever was there before. For +example: + +#+begin_example + /* BEGIN RECEIVE ORGTBL table_name */ + /* END RECEIVE ORGTBL table_name */ +#+end_example + +{{{noindent}}} Just above the source table, we put a special line that +tells Orgtbl mode how to translate this table and where to install it. +For example: + +#+cindex: #+ORGTBL +#+begin_example + ,#+ORGTBL: SEND table_name translation_function arguments ... +#+end_example + +{{{noindent}}} Here, ~table_name~ is the reference name for the table +that is also used in the receiver lines. ~translation_function~ is the +Lisp function that does the translation. Furthermore, the line can +contain a list of arguments (alternating key and value) at the end. +The arguments will be passed as a property list to the translation +function for interpretation. A few standard parameters are already +recognized and acted upon before the translation function is called: + +#+attr_texinfo: :table-type table :indic @asis +- ~:skip N~ :: + + Skip the first N lines of the table. Hlines do count as separate lines + for this parameter! + +- ~:skipcols (n1 n2 ...)~ :: + + List of columns that should be skipped. If the table has a column with + calculation marks, that column is automatically discarded as well. + Please note that the translator function sees the table /after/ the + removal of these columns, the function never knows that there have + been additional columns. + +- ~:no-escape t~ :: + + When non-nil, do not escape special characters ~&%#_^~ when exporting + the table. The default value is nil. + + +{{{noindent}}} The one problem remaining is how to keep the source +table in the buffer without disturbing the normal workings of the +file, for example during compilation of a C file or processing of a +LaTeX file. There are a number of different solutions: + +- The table could be placed in a block comment if that is supported by + the language. For example, in C mode you could wrap the table + between {{{samp(/*)}}} and {{{samp(*/)}}} lines. + +- Sometimes it is possible to put the table after some kind of END + statement, for example ~\bye~ in TeX and ~\end{document}~ in + LaTeX. + +- You can just comment the table line-by-line whenever you want to + process the file, and uncomment it whenever you need to edit the + table. This only sounds tedious---the command {{{kbd(M-x + orgtbl-toggle-comment)}}} makes this comment-toggling very easy, in + particular if you bind it to a key. + +*** A LaTeX example + :PROPERTIES: + :DESCRIPTION: Step by step, almost a tutorial + :TITLE: A LaTeX example of radio tables + :END: +#+cindex: @LaTeX{}, and Orgtbl mode + +The best way to wrap the source table in LaTeX is to use the +~comment~ environment provided by {{{file(comment.sty)}}}. It has to +be activated by placing ~\usepackage{comment}~ into the document +header. Orgtbl mode can insert a radio table skeleton with the command +{{{kbd(M-x orgtbl-insert-radio-table)}}}.[fn:160] You will be prompted +for a table name, let's say we use {{{samp(salesfigures)}}}. You will +then get the following template: + +#+cindex: #+ORGTBL, SEND +#+begin_example + % BEGIN RECEIVE ORGTBL salesfigures + % END RECEIVE ORGTBL salesfigures + \begin{comment} + #+ORGTBL: SEND salesfigures orgtbl-to-latex + | | | + \end{comment} +#+end_example + +#+vindex: @LaTeX{}-verbatim-environments + +{{{noindent}}} The ~#+ORGTBL: SEND~ line tells Orgtbl mode to use the +function ~orgtbl-to-latex~ to convert the table into LaTeX and to +put it into the receiver location with name ~salesfigures~. You may +now fill in the table---feel free to use the spreadsheet features:[fn:161] + +#+begin_example + % BEGIN RECEIVE ORGTBL salesfigures + % END RECEIVE ORGTBL salesfigures + \begin{comment} + #+ORGTBL: SEND salesfigures orgtbl-to-latex + | Month | Days | Nr sold | per day | + |-------+------+---------+---------| + | Jan | 23 | 55 | 2.4 | + | Feb | 21 | 16 | 0.8 | + | March | 22 | 278 | 12.6 | + #+TBLFM: $4=$3/$2;%.1f + % $ (optional extra dollar to keep font-lock happy, see footnote) + \end{comment} +#+end_example + +{{{noindent}}} When you are done, press {{{kbd(C-c C-c)}}} in the +table to get the converted table inserted between the two marker +lines. + +Now let's assume you want to make the table header by hand, because +you want to control how columns are aligned, etc. In this case we make +sure that the table translator skips the first 2 lines of the source +table, and tell the command to work as a splice, i.e., to not +produce header and footer commands of the target table: + +#+begin_example + \begin{tabular}{lrrr} + Month & \multicolumn{1}{c}{Days} & Nr.\ sold & per day\\ + % BEGIN RECEIVE ORGTBL salesfigures + % END RECEIVE ORGTBL salesfigures + \end{tabular} + % + \begin{comment} + #+ORGTBL: SEND salesfigures orgtbl-to-latex :splice t :skip 2 + | Month | Days | Nr sold | per day | + |-------+------+---------+---------| + | Jan | 23 | 55 | 2.4 | + | Feb | 21 | 16 | 0.8 | + | March | 22 | 278 | 12.6 | + #+TBLFM: $4=$3/$2;%.1f + \end{comment} +#+end_example + +The LaTeX translator function ~orgtbl-to-latex~ is already part of +Orgtbl mode. It uses a ~tabular~ environment to typeset the table and +marks horizontal lines with ~\hline~. Furthermore, it interprets the +following parameters (see also see [[Translator functions]]): + +#+attr_texinfo: :table-type table :indic @asis +- ~:splice nil/t~ :: + + When set to ~t~, return only table body lines, don't wrap them into a + tabular environment. Default is ~nil~. + +- ~:fmt fmt~ :: + + A format to be used to wrap each field, it should contain ~%s~ for the + original field value. For example, to wrap each field value in + dollars, you could use ~:fmt "$%s$"~. This may also be a property list + with column numbers and formats, for example ~:fmt (2 "$%s$" 4 + "%s\\%%")~. A function of one argument can be used in place of the + strings; the function must return a formatted string. + +- ~:efmt efmt~ :: + + Use this format to print numbers with exponentials. The format should + have ~%s~ twice for inserting mantissa and exponent, for example: + + #+begin_example + "%s\\times10^{%s}" + #+end_example + + The default is: + + #+begin_example + "%s\\,(%s)" + #+end_example + + This may also be a property list with column numbers and formats, for + example: + + #+begin_example + :efmt (2 "$%s\\times10^{%s}$" 4 "$%s\\cdot10^{%s}$") + #+end_example + + After ~efmt~ has been applied to a value, ~fmt~ will also be applied. + Similar to ~fmt~, functions of two arguments can be supplied instead + of strings. + +*** Translator functions + :PROPERTIES: + :DESCRIPTION: Copy and modify + :END: +#+cindex: HTML, and Orgtbl mode +#+cindex: translator function + +Orgtbl mode has several translator functions built-in: ~orgtbl-to-csv~ +(comma-separated values), ~orgtbl-to-tsv~ (TAB-separated values) +~orgtbl-to-latex~, ~orgtbl-to-html~, and ~orgtbl-to-texinfo~. Except +for ~orgtbl-to-html~, these all use a generic translator, +~orgtbl-to-generic~.[fn:162] For example, ~orgtbl-to-latex~ itself is +a very short function that computes the column definitions for the +~tabular~ environment, defines a few field and line separators and +then hands processing over to the generic translator. Here is the +entire code: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(defun orgtbl-to-latex (table params) + "Convert the Orgtbl mode TABLE to LaTeX." + (let* ((alignment (mapconcat (lambda (x) (if x "r" "l")) + org-table-last-alignment "")) + (params2 + (list + :tstart (concat "\\begin@{tabular@}@{" alignment "@}") + :tend "\\end@{tabular@}" + :lstart "" :lend " \\\\" :sep " & " + :efmt "%s\\,(%s)" :hline "\\hline"))) + (orgtbl-to-generic table (org-combine-plists params2 params)))) +#+end_src + +As you can see, the properties passed into the function (variable +~PARAMS~) are combined with the ones newly defined in the function +(variable ~PARAMS2~). The ones passed into the function (i.e., the +ones set by the {{{samp(ORGTBL SEND)}}} line) take precedence. So if +you would like to use the LaTeX translator, but wanted the line +endings to be ~\\[2mm]~ instead of the default ~\\~, you could just +overrule the default with: + +#+begin_example + ,#+ORGTBL: SEND test orgtbl-to-latex :lend " \\\\[2mm]" +#+end_example + +For a new language, you can either write your own converter function +in analogy with the LaTeX translator, or you can use the generic +function directly. For example, if you have a language where a table +is started with {{{samp(!BTBL!)}}}, ended with {{{samp(!ETBL!)}}}, and +where table lines are started with {{{samp(!BL!)}}}, ended with +{{{samp(!EL!)}}}, and where the field separator is a TAB, you could +call the generic translator like this (on a single line!): + +#+begin_example + ,#+ORGTBL: SEND test orgtbl-to-generic :tstart "!BTBL!" :tend "!ETBL!" + :lstart "!BL! " :lend " !EL!" :sep "\t" +#+end_example + +{{{noindent}}} Please check the documentation string of the function +~orgtbl-to-generic~ for a full list of parameters understood by that +function, and remember that you can pass each of them into +~orgtbl-to-latex~, ~orgtbl-to-texinfo~, and any other function using +the generic function. + +Of course you can also write a completely new function doing +complicated things the generic translator cannot do. A translator +function takes two arguments. The first argument is the table, a list +of lines, each line either the symbol ~hline~ or a list of fields. The +second argument is the property list containing all parameters +specified in the {{{samp(#+ORGTBL: SEND)}}} line. The function must +return a single string containing the formatted table. If you write a +generally useful translator, please post it to the [[mailto:emacs-orgmode@gnu.org][mailing list]] so +that others can benefit from your work. + +*** Radio lists + :PROPERTIES: + :DESCRIPTION: Doing the same for lists + :END: +#+cindex: radio lists +#+cindex: org-list-insert-radio-list + +Sending and receiving radio lists works exactly the same way as +sending and receiving radio tables (see [[Radio tables]]). As for radio +tables, you can insert radio list templates in HTML, LaTeX and +Texinfo modes by calling ~org-list-insert-radio-list~. + +Here are the differences with radio tables: + +- Orgstruct mode must be active. + +- Use the ~ORGLST~ keyword instead of ~ORGTBL~. + +- The available translation functions for radio lists don't take + parameters. + +- {{{kbd(C-c C-c)}}} will work when pressed on the first item of the + list. + + +Here is a LaTeX example. Let's say that you have this in your +LaTeX file: + +#+cindex: #+ORGLST +#+begin_example + % BEGIN RECEIVE ORGLST to-buy + % END RECEIVE ORGLST to-buy + \begin{comment} + #+ORGLST: SEND to-buy org-list-to-latex + - a new house + - a new computer + + a new keyboard + + a new mouse + - a new life + \end{comment} +#+end_example + +Pressing `C-c C-c' on ~a new house~ will insert the converted +LaTeX list between the two marker lines. + +** Dynamic blocks + :PROPERTIES: + :DESCRIPTION: Automatically filled blocks + :END: +#+cindex: dynamic blocks + +Org documents can contain /dynamic blocks/. These are specially marked +regions that are updated by some user-written function. A good example +for such a block is the clock table inserted by the command +{{{kbd(C-c C-x C-r)}}} (see [[Clocking work time]]). + +Dynamic blocks are enclosed by a BEGIN-END structure that assigns a +name to the block and can also specify parameters for the function +producing the content of the block. + +#+cindex: #+BEGIN:dynamic block +#+begin_example + ,#+BEGIN: myblock :parameter1 value1 :parameter2 value2 ... + + ,#+END: +#+end_example + +Dynamic blocks are updated with the following commands: + +#+attr_texinfo: :table-type table :indic @asis +- {{{kbd(C-c C-x C-u)}}}, ~org-dblock-update~ :: + #+kindex: C-c C-x C-u + + Update dynamic block at point. + +- {{{kbd(C-u C-c C-x C-u)}}} :: + #+kindex: C-u C-c C-x C-u + + Update all dynamic blocks in the current file. + + +Updating a dynamic block means to remove all the text between ~BEGIN~ +and ~END~, parse the ~BEGIN~ line for parameters and then call the +specific writer function for this block to insert the new content. If +you want to use the original content in the writer function, you can +use the extra parameter ~:content~. + +For a block with name ~myblock~, the writer function is +~org-dblock-write:myblock~ with as only parameter a property list +with the parameters given in the begin line. Here is a trivial example +of a block that keeps track of when the block update function was last +run: + +#+begin_example + ,#+BEGIN: block-update-time :format "on %m/%d/%Y at %H:%M" + + ,#+END: +#+end_example + +{{{noindent}}} The corresponding block writer function could look like +this: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(defun org-dblock-write:block-update-time (params) + (let ((fmt (or (plist-get params :format) "%d. %m. %Y"))) + (insert "Last block update at: " + (format-time-string fmt (current-time))))) +#+end_src + +If you want to make sure that all dynamic blocks are always +up-to-date, you could add the function ~org-update-all-dblocks~ to a +hook, for example ~before-save-hook~. ~org-update-all-dblocks~ is +written in a way such that it does nothing in buffers that are not in +~org-mode~. + +You can narrow the current buffer to the current dynamic block (like +any other block) with ~org-narrow-to-block~. + +** Special agenda views + :PROPERTIES: + :DESCRIPTION: Customized views + :END: +#+cindex: agenda views, user-defined +#+vindex: org-agenda-skip-function +#+vindex: org-agenda-skip-function-global + +Org provides a special hook that can be used to narrow down the +selection made by these agenda views: ~agenda~, ~todo~, ~alltodo~, +~tags~, ~tags-todo~, ~tags-tree~. You may specify a function that is +used at each match to verify if the match should indeed be part of the +agenda view, and if not, how much should be skipped. You can specify a +global condition that will be applied to all agenda views, this +condition would be stored in the variable +~org-agenda-skip-function-global~. More commonly, such a definition is +applied only to specific custom searches, using +~org-agenda-skip-function~. + +Let's say you want to produce a list of projects that contain a +~WAITING~ tag anywhere in the project tree. Let's further assume that +you have marked all tree headings that define a project with the TODO +keyword PROJECT. In this case you would run a TODO search for the +keyword PROJECT, but skip the match unless there is a ~WAITING~ tag +anywhere in the subtree belonging to the project line. + +To achieve this, you must write a function that searches the subtree for +the tag. If the tag is found, the function must return ~nil~ to +indicate that this match should not be skipped. If there is no such +tag, return the location of the end of the subtree, to indicate that +search should continue from there. + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(defun my-skip-unless-waiting () + "Skip trees that are not waiting" + (let ((subtree-end (save-excursion (org-end-of-subtree t)))) + (if (re-search-forward ":waiting:" subtree-end t) + nil ; tag found, do not skip + subtree-end))) ; tag not found, continue after end of subtree +#+end_src + +Now you may use this function in an agenda custom command, for example +like this: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(org-add-agenda-custom-command + '("b" todo "PROJECT" + ((org-agenda-skip-function 'my-skip-unless-waiting) + (org-agenda-overriding-header "Projects waiting for something: ")))) +#+end_src + +#+vindex: org-agenda-overriding-header + +Note that this also binds ~org-agenda-overriding-header~ to get a +meaningful header in the agenda view. + +#+vindex: org-odd-levels-only +#+vindex: org-agenda-skip-function + +A general way to create custom searches is to base them on a search +for entries with a certain level limit. If you want to study all +entries with your custom search function, simply do a search for +{{{samp(LEVEL>0)}}}, and then use ~org-agenda-skip-function~ to select +the entries you really want to have.[fn:163] + +You may also put a Lisp form into ~org-agenda-skip-function~. In +particular, you may use the functions ~org-agenda-skip-entry-if~ +and ~org-agenda-skip-subtree-if~ in this form, for example: + +#+attr_texinfo: :table-type table :indic @asis +- {{{samp((org-agenda-skip-entry-if 'scheduled))}}} :: + + Skip current entry if it has been scheduled. + +- {{{samp((org-agenda-skip-entry-if 'notscheduled))}}} :: + + Skip current entry if it has not been scheduled. + +- {{{samp((org-agenda-skip-entry-if 'deadline))}}} :: + + Skip current entry if it has a deadline. + +- {{{samp((org-agenda-skip-entry-if 'scheduled 'deadline))}}} :: + + Skip current entry if it has a deadline, or if it is scheduled. + +- {{{samp((org-agenda-skip-entry-if 'todo '("TODO" "WAITING")))}}} :: + + Skip current entry if the TODO keyword is TODO or WAITING. + +- {{{samp((org-agenda-skip-entry-if 'todo 'done))}}} :: + + Skip current entry if the TODO keyword marks a DONE state. + +- {{{samp((org-agenda-skip-entry-if 'timestamp))}}} :: + + Skip current entry if it has any timestamp, may also be deadline or scheduled. + <<x-agenda-skip-entry-regexp>> + +- {{{samp((org-agenda-skip-entry-if 'regexp "regular expression"))}}} :: + + Skip current entry if the regular expression matches in the entry. + +- {{{samp((org-agenda-skip-entry-if 'notregexp "regular expression"))}}} :: + + Skip current entry unless the regular expression matches. + +- {{{samp((org-agenda-skip-subtree-if 'regexp "regular expression"))}}} :: + + Same as above, but check and skip the entire subtree. + + +Therefore we could also have written the search for WAITING projects +like this, even without defining a special function: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(org-add-agenda-custom-command + '("b" todo "PROJECT" + ((org-agenda-skip-function '(org-agenda-skip-subtree-if + 'regexp ":waiting:")) + (org-agenda-overriding-header "Projects waiting for something: ")))) +#+end_src + +** Extracting agenda information + :PROPERTIES: + :DESCRIPTION: Post-processing agenda information + :END: +#+cindex: agenda, pipe +#+cindex: Scripts, for agenda processing +#+vindex: org-agenda-custom-commands + +Org provides commands to access agenda information for the command +line in Emacs batch mode. This extracted information can be sent +directly to a printer, or it can be read by a program that does +further processing of the data. The first of these commands is the +function ~org-batch-agenda~, that produces an agenda view and sends it +as ASCII text to STDOUT. The command takes a single string as +parameter. If the string has length 1, it is used as a key to one of +the commands you have configured in ~org-agenda-custom-commands~, +basically any key you can use after {{{kbd(C-c a)}}}. For example, to +directly print the current TODO list, you could use: + +#+header: :eval no +#+header: :exports code +#+begin_src sh +emacs -batch -l ~/.emacs -eval '(org-batch-agenda "t")' | lpr +#+end_src + +If the parameter is a string with 2 or more characters, it is used as +a tags/TODO match string. For example, to print your local shopping +list (all items with the tag {{{samp(shop)}}}, but excluding the tag +{{{samp(NewYork)}}}), you could use: + +#+header: :eval no +#+header: :exports code +#+begin_src sh +emacs -batch -l ~/.emacs \ + -eval '(org-batch-agenda "+shop-NewYork")' | lpr +#+end_src + +{{{noindent}}} You may also modify parameters on the fly like this: + +#+header: :eval no +#+header: :exports code +#+begin_src sh +emacs -batch -l ~/.emacs \ + -eval '(org-batch-agenda "a" \ + org-agenda-span (quote month) \ + org-agenda-include-diary nil \ + org-agenda-files (quote ("~/org/project.org")))' \ + | lpr +#+end_src + +{{{noindent}}} which will produce a 30-day agenda, fully restricted to +the Org file {{{file(~/org/projects.org)}}}, not even including the +diary. + +If you want to process the agenda data in more sophisticated ways, you +can use the command ~org-batch-agenda-csv~ to get a comma-separated +list of values for each agenda item. Each line in the output will +contain a number of fields separated by commas. The fields in a line +are: + +#+attr_texinfo: :table-type table :indic @code +- category :: The category of the item +- head :: The headline, without TODO keyword, TAGS and PRIORITY +- type :: The type of the agenda entry, can be: + - todo :: selected in TODO match + - tagsmatch :: selected in tags match + - diary :: imported from diary + - deadline :: a deadline + - scheduled :: scheduled + - timestamp :: appointment, selected by timestamp + - closed :: entry was closed on date + - upcoming-deadline :: warning about nearing deadline + - past-scheduled :: forwarded scheduled item + - block :: entry has date block including date +- todo :: The TODO keyword, if any +- tags :: All tags including inherited ones, separated by colons +- date :: The relevant date, like 2007-2-14 +- time :: The time, like 15:00-16:50 +- extra :: String with extra planning info +- priority-l :: The priority letter if any was given +- priority-n :: The computed numerical priority + +{{{noindent}}} Time and date will only be given if a timestamp (or +deadline/scheduled) led to the selection of the item. + +A CSV list like this is very easy to use in a post-processing script. +For example, here is a Perl program that gets the TODO list from +Emacs/Org and prints all the items, preceded by a checkbox: + +#+header: :eval no +#+header: :exports code +#+begin_src perl +#!/usr/bin/perl + +# define the Emacs command to run +$cmd = "emacs -batch -l ~/.emacs -eval '(org-batch-agenda-csv \"t\")'"; + +# run it and capture the output +$agenda = qx@{$cmd 2>/dev/null@}; + +# loop over all lines +foreach $line (split(/\n/,$agenda)) @{ + # get the individual values + ($category,$head,$type,$todo,$tags,$date,$time,$extra, + $priority_l,$priority_n) = split(/,/,$line); + # process and print + print "[ ] $head\n"; +@} +#+end_src + +** Using the property API + :PROPERTIES: + :DESCRIPTION: Writing programs that use entry properties + :END: +#+cindex: API, for properties +#+cindex: properties, API + +Here is a description of the functions that can be used to work with +properties. + +#+attr_texinfo: :options org-entry-properties &optional pom which +#+begin_defun +Get all properties of the entry at point-or-marker POM. +This includes the TODO keyword, the tags, time strings for deadline, +scheduled, and clocking, and any additional properties defined in the +entry. The return value is an alist. Keys may occur multiple times +if the property key was used several times.@* +POM may also be nil, in which case the current entry is used. +If WHICH is nil or `all', get all properties. If WHICH is +`special' or `standard', only get that subclass. +#+end_defun + +#+vindex: org-use-property-inheritance +#+findex: org-insert-property-drawer +#+attr_texinfo: :options org-entry-get pom property &optional inherit +#+begin_defun +Get value of PROPERTY for entry at point-or-marker POM. By default, +this only looks at properties defined locally in the entry. If INHERIT +is non-nil and the entry does not have the property, then also check +higher levels of the hierarchy. If INHERIT is the symbol +~selective~, use inheritance if and only if the setting of +~org-use-property-inheritance~ selects PROPERTY for inheritance. +#+end_defun + +#+attr_texinfo: :options org-entry-delete pom property +#+begin_defun +Delete the property PROPERTY from entry at point-or-marker POM. +#+end_defun + +#+attr_texinfo: :options org-entry-put pom property value +#+begin_defun +Set PROPERTY to VALUE for entry at point-or-marker POM. +#+end_defun + +#+attr_texinfo: :options org-buffer-property-keys &optional include-specials +#+begin_defun +Get all property keys in the current buffer. +#+end_defun +#+attr_texinfo: :options org-insert-property-drawer +#+begin_defun +Insert a property drawer for the current entry. Also +#+end_defun + +#+attr_texinfo: :options org-entry-put-multivalued-property pom property &rest values +#+begin_defun +Set PROPERTY at point-or-marker POM to VALUES. VALUES should be a list of +strings. They will be concatenated, with spaces as separators. +#+end_defun + +#+attr_texinfo: :options org-entry-get-multivalued-property pom property +#+begin_defun +Treat the value of the property PROPERTY as a whitespace-separated list of +values and return the values as a list of strings. +#+end_defun + +#+attr_texinfo: :options org-entry-add-to-multivalued-property pom property value +#+begin_defun +Treat the value of the property PROPERTY as a whitespace-separated list of +values and make sure that VALUE is in this list. +#+end_defun + +#+attr_texinfo: :options org-entry-remove-from-multivalued-property pom property value +#+begin_defun +Treat the value of the property PROPERTY as a whitespace-separated list of +values and make sure that VALUE is /not/ in this list. +#+end_defun + +#+attr_texinfo: :options org-entry-member-in-multivalued-property pom property value +#+begin_defun +Treat the value of the property PROPERTY as a whitespace-separated list of +values and check if VALUE is in this list. +#+end_defun + +#+attr_texinfo: :options org-property-allowed-value-functions +#+begin_defopt +Hook for functions supplying allowed values for a specific property. +The functions must take a single argument, the name of the property, and +return a flat list of allowed values. If {{{samp(:ETC)}}} is one of +the values, use the values as completion help, but allow also other values +to be entered. The functions must return ~nil~ if they are not +responsible for this property. +#+end_defopt + +** Using the mapping API + :PROPERTIES: + :DESCRIPTION: Mapping over all or selected entries + :END: +#+cindex: API, for mapping +#+cindex: mapping entries, API + +Org has sophisticated mapping capabilities to find all entries satisfying +certain criteria. Internally, this functionality is used to produce agenda +views, but there is also an API that can be used to execute arbitrary +functions for each or selected entries. The main entry point for this API +is: + +#+attr_texinfo: :options org-map-entries func &optional match scope &rest skip +#+begin_defun +Call FUNC at each headline selected by MATCH in SCOPE. + +FUNC is a function or a Lisp form. The function will be called without +arguments, with the cursor positioned at the beginning of the headline. +The return values of all calls to the function will be collected and +returned as a list. + +The call to FUNC will be wrapped into a save-excursion form, so FUNC +does not need to preserve point. After evaluation, the cursor will be +moved to the end of the line (presumably of the headline of the +processed entry) and search continues from there. Under some +circumstances, this may not produce the wanted results. For example, +if you have removed (e.g., archived) the current (sub)tree it could +mean that the next entry will be skipped entirely. In such cases, you +can specify the position from where search should continue by making +FUNC set the variable `org-map-continue-from' to the desired buffer +position. + +MATCH is a tags/property/todo match as it is used in the agenda match view. +Only headlines that are matched by this query will be considered during +the iteration. When MATCH is nil or t, all headlines will be +visited by the iteration. + +SCOPE determines the scope of this command. It can be any of: + +#+attr_texinfo: :table-type table :indic @code +- nil :: + + The current buffer, respecting the restriction, if any. + +- tree :: + + The subtree started with the entry at point. + +- region :: + + The entries within the active region, if any. + +- file :: + + The current buffer, without restriction. + +- file-with-archives :: + + The current buffer, and any archives associated with it. + +- agenda :: + + All agenda files. + +- agenda-with-archives :: + + All agenda files with any archive files associated with them. + +- (file1 file2 ...) :: + + If this is a list, all files in the list will be scanned. + + +{{{noindent}}} The remaining args are treated as settings for the +skipping facilities of the scanner. The following items can be given +here: + +#+vindex: org-agenda-skip-function +#+attr_texinfo: :table-type table :indic @asis +- ~archive~ :: + + Skip trees with the archive tag. + +- ~comment~ :: + + Skip trees with the COMMENT keyword. + +- function or Lisp form :: + + Will be used as value for ~org-agenda-skip-function~, so whenever the + function returns t, FUNC will not be called for that entry and search + will continue from the point where the function leaves it. +#+end_defun + +The function given to that mapping routine can really do anything you like. +It can use the property API (see [[Using the property API]]) to gather more +information about the entry, or in order to change metadata in the entry. +Here are a few functions that might be handy: + +#+attr_texinfo: :options org-todo &optional arg +#+begin_defun +Change the TODO state of the entry. See the docstring of the functions for +the many possible values for the argument ARG. +#+end_defun + +#+attr_texinfo: :options org-priority &optional action +#+begin_defun +Change the priority of the entry. See the docstring of this function for the +possible values for ACTION. +#+end_defun + +#+attr_texinfo: :options org-toggle-tag tag &optional onoff +#+begin_defun +Toggle the tag TAG in the current entry. Setting ONOFF to either ~on~ +or ~off~ will not toggle tag, but ensure that it is either on or off. +#+end_defun + +#+attr_texinfo: :options org-promote +#+begin_defun +Promote the current entry. +#+end_defun + +#+attr_texinfo: :options org-demote +#+begin_defun +Demote the current entry. +#+end_defun + +The following simple example will turn all entries in the current file +with a tag ~TOMORROW~ into TODO entries with the keyword ~UPCOMING~. +Entries in comment trees and in archive trees will be ignored. + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(org-map-entries + '(org-todo "UPCOMING") + "+TOMORROW" 'file 'archive 'comment) +#+end_src + +The following example counts the number of entries with TODO keyword +~WAITING~, in all agenda files. + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(length (org-map-entries t "/+WAITING" 'agenda)) +#+end_src + +* MobileOrg + :PROPERTIES: + :DESCRIPTION: Viewing and capture on a mobile device + :APPENDIX: Appendix + :END: +#+cindex: iPhone +#+cindex: MobileOrg +#+cindex: Moreland, Richard +#+cindex: Jones, Matt + +MobileOrg is the name of the mobile companion app for Org mode, +currently available for iOS and for Android. MobileOrg offers +offline viewing and capture support for an Org mode system rooted on a +``real'' computer. It does also allow you to record changes to +existing entries. The [[http://mobileorg.ncogni.to/][iOS implementation]] for the iPhone/iPod +Touch/iPad series of devices, was developed by Richard Moreland. +Android users should check out [[http://wiki.github.com/matburt/mobileorg-android/][MobileOrg Android]] by Matt Jones. The +two implementations are not identical but offer similar features. + +This appendix describes the support Org has for creating agenda views +in a format that can be displayed by MobileOrg, and for integrating +notes captured and changes made by MobileOrg into the main system. + +For changing tags and TODO states in MobileOrg, you should have set up +the customization variables ~org-todo-keywords~ and ~org-tags-alist~ +to cover all important tags and TODO keywords, even if individual +files use only part of these. MobileOrg will also offer you states and +tags set up with in-buffer settings, but it will understand the +logistics of TODO state /sets/ (see [[Per-file keywords]]) and /mutually +exclusive/ tags (see [[Setting tags]]) only for those set in these +variables. + +** Setting up the staging area + :PROPERTIES: + :DESCRIPTION: Where to interact with the mobile device + :END: + +MobileOrg needs to interact with Emacs through a directory on a +server. If you are using a public server, you should consider to +encrypt the files that are uploaded to the server. This can be done +with Org mode 7.02 and with MobileOrg 1.5 (iPhone version), and you +need an {{{file(openssl)}}} installation on your system. To turn on +encryption, set a password in MobileOrg and, on the Emacs side, +configure the variable ~org-mobile-use-encryption~.[fn:164] + +The easiest way to create that directory is to use a free [[http://dropbox.com][Dropbox]] +account.[fn:165] When MobileOrg first connects to your Dropbox, it +will create a directory MobileOrg inside the Dropbox. After the +directory has been created, tell Emacs about it: + +#+header: :eval no +#+header: :exports code +#+begin_src emacs-lisp +(setq org-mobile-directory "~/Dropbox/MobileOrg") +#+end_src + +Org mode has commands to put files for MobileOrg into that +directory, and to read captured notes from there. + +** Pushing to MobileOrg + :PROPERTIES: + :DESCRIPTION: Uploading Org files and agendas + :END: + +This operation copies all files currently listed in ~org-mobile-files~ +to the directory ~org-mobile-directory~. By default this list contains +all agenda files (as listed in ~org-agenda-files~), but additional +files can be included by customizing ~org-mobile-files~. File names +will be staged with paths relative to ~org-directory~, so all files +should be inside this directory.[fn:184] + +The push operation also creates a special Org file +{{{file(agendas.org)}}} with all custom agenda view defined by the +user.[fn:166] + +Finally, Org writes the file {{{file(index.org)}}}, containing links +to all other files. MobileOrg first reads this file from the server, +and then downloads all agendas and Org files listed in it. To speed up +the download, MobileOrg will only read files whose checksums have +changed.[fn:167] + +** Pulling from MobileOrg + :PROPERTIES: + :DESCRIPTION: Integrating captured and flagged items + :END: + +When MobileOrg synchronizes with the server, it not only pulls the +Org files for viewing. It also appends captured entries and pointers +to flagged and changed entries to the file {{{file(mobileorg.org)}}} +on the server. Org has a /pull/ operation that integrates this +information into an inbox file and operates on the pointers to flagged +entries. Here is how it works: + +1. Org moves all entries found in {{{file(mobileorg.org)}}} and + appends them to the file pointed to by the variable + ~org-mobile-inbox-for-pull~.[fn:168] Each captured entry and each + editing event will be a top-level entry in the inbox file. + +2. After moving the entries, Org will attempt to implement the changes + made in MobileOrg. Some changes are applied directly and without + user interaction. Examples are all changes to tags, TODO state, + headline and body text that can be cleanly applied. Entries that + have been flagged for further action will receive a tag + ~:FLAGGED:~, so that they can be easily found again. When there is + a problem finding an entry or applying the change, the pointer + entry will remain in the inbox and will be marked with an error + message. You need to later resolve these issues by hand. + +3. Org will then generate an agenda view with all flagged entries. The + user should then go through these entries and do whatever actions + are necessary. If a note has been stored while flagging an entry in + MobileOrg, that note will be displayed in the echo area when the + cursor is on the corresponding agenda line. + + #+attr_texinfo: :table-type table :indic @asis + - {{{kbd(?)}}} :: + #+kindex: ? + + Pressing {{{kbd(?)}}} in that special agenda will display the full + flagging note in another window and also push it onto the kill ring. + So you could use {{{kbd(? z C-y C-c C-c)}}} to store that flagging + note as a normal note in the entry. Pressing {{{kbd(?)}}} twice in + succession will offer to remove the ~:FLAGGED:~ tag along with the + recorded flagging note (which is stored in a property). In this way + you indicate that the intended processing for this flagged entry is + finished. + + +#+kindex: C-c a ? + +If you are not able to process all flagged entries directly, you can always +return to this agenda view using {{{kbd(C-c a ?)}}}.[fn:169] + +* History and acknowledgments + :PROPERTIES: + :DESCRIPTION: How Org came into being + :ALT_TITLE: History and Acknowledgments + :APPENDIX: Appendix + :END: +** From Carsten + +Org was born in 2003, out of frustration over the user interface of +the Emacs Outline mode. I was trying to organize my notes and +projects, and using Emacs seemed to be the natural way to go. However, +having to remember eleven different commands with two or three keys +per command, only to hide and show parts of the outline tree, that +seemed entirely unacceptable to me. Also, when using outlines to take +notes, I constantly wanted to restructure the tree, organizing it +parallel to my thoughts and plans. /Visibility cycling/ and /structure +editing/ were originally implemented in the package +{{{file(outline-magic.el)}}}, but quickly moved to the more general +{{{file(org.el)}}}. As this environment became comfortable for project +planning, the next step was adding /TODO entries/, basic /timestamps/, +and /table support/. These areas highlighted the two main goals that +Org still has today: to be a new, outline-based, plain text mode with +innovative and intuitive editing features, and to incorporate project +planning functionality directly into a notes file. + +Since the first release, literally thousands of emails to me or to the +[[mailto:emacs-orgmode@gnu.org][mailing list]] have provided a constant stream of bug reports, feedback, +new ideas, and sometimes patches and add-on code. Many thanks to +everyone who has helped to improve this package. I am trying to keep +here a list of the people who had significant influence in shaping one +or more aspects of Org. The list may not be complete, if I have +forgotten someone, please accept my apologies and let me know. + +Before I get to this list, a few special mentions are in order: + +#+attr_texinfo: :table-type table :indic @asis +- Bastien Guerry :: + + Bastien has written a large number of extensions to Org (most of them + integrated into the core by now), including the LaTeX exporter and + the plain list parser. His support during the early days, when he + basically acted as co-maintainer, was central to the success of this + project. Bastien also invented Worg, helped establishing the Web + presence of Org, and sponsored hosting costs for the ~orgmode.org~ + website. + +- Eric Schulte and Dan Davison :: + + Eric and Dan are jointly responsible for the Org-babel system, which + turns Org into a multi-language environment for evaluating code and + doing literate programming and reproducible research. + +- John Wiegley :: + + John has contributed a number of great ideas and patches directly to + Org, including the attachment system ({{{file(org-attach.el)}}}), + integration with Apple Mail ({{{file(org-mac-message.el)}}}), + hierarchical dependencies of TODO items, habit tracking + ({{{file(org-habits.el)}}}), and encryption + ({{{file(org-crypt.el)}}}). Also, the capture system is really an + extended copy of his great {{{file(remember.el)}}}. + +- Sebastian Rose :: + + Without Sebastian, the HTML/XHTML publishing of Org would be the + pitiful work of an ignorant amateur. Sebastian has pushed this part of + Org onto a much higher level. He also wrote {{{file(org-info.js)}}}, a + Java script for displaying webpages derived from Org using an + Info-like or a folding interface with single-key navigation. + + +{{{noindent}}} See [[List of contributions][below]] for the full list of contributions! Again, +please let me know what I am missing here! + +** From Bastien + +I (Bastien) have been maintaining Org since January 2011. This +appendix would not be complete without adding a few more +acknowledgements and thanks to Carsten's ones above. + +I am first grateful to Carsten for his trust while handing me over the +maintainership of Org. His support as been great since day one of this +new adventure, and it helped a lot. + +When I took over maintainership, I knew I would have to make Org more +collaborative than ever, as I would have to rely on people that are +more knowledgeable than I am on many parts of the code. Here is a list +of the persons I could rely on, they should really be considered +co-maintainers, either of the code or the community: + +#+attr_texinfo: :table-type table :indic @asis +- Eric Schulte :: + + Eric is maintaining the Babel parts of Org. His reactivity here kept + me away from worrying about possible bugs here and let me focus on + other parts. + +- Nicolas Goaziou :: + + Nicolas is maintaining the consistency of the deepest parts of Org. + His work on {{{file(org-element.el)}}} and {{{file(org-export.el)}}} + has been outstanding, and opened the doors for many new ideas and + features. + +- Jambunathan K :: + + Jambunathan contributed the ODT exporter, definitly a killer feature + of Org mode. He also contributed the new HTML exporter, which is + another core feature of Org. Here too, I knew I could rely on him to + fix bugs in these areas and to patiently explain the users what was + the problems and solutions. + +- Achim Gratz :: + + Achim rewrote the building process of Org, turning some /ad hoc/ tools + into a flexible and conceptually clean process. He patiently coped + with the many hicups that such a change can create for users. + +- Nick Dokos :: + + The Org mode mailing list would not be such a nice place without Nick, + who patiently helped users so many times. It is impossible to + overestimate such a great help, and the list would not be so active + without him. + + +I received support from so many users that it is clearly impossible to be +fair when shortlisting a few of them---but Org's history would not be +complete if the ones above were not mentioned in this manual. + +** List of contributions + +- Russel Adams came up with the idea for drawers. + +- Thomas Baumann wrote {{{file(org-bbdb.el)}}} and {{{file(org-mhe.el)}}}. + +- Christophe Bataillon created the great unicorn logo that we use on + the Org mode website. + +- Alex Bochannek provided a patch for rounding timestamps. + +- Jan Böcker wrote {{{file(org-docview.el)}}}. + +- Brad Bozarth showed how to pull RSS feed data into Org mode files. + +- Tom Breton wrote {{{file(org-choose.el)}}}. + +- Charles Cave's suggestion sparked the implementation of templates + for Remember, which are now templates for capture. + +- Pavel Chalmoviansky influenced the agenda treatment of items with + specified time. + +- Gregory Chernov patched support for Lisp forms into table + calculations and improved XEmacs compatibility, in particular by + porting {{{file(nouline.el)}}} to XEmacs. + +- Sacha Chua suggested copying some linking code from Planner. + +- Baoqiu Cui contributed the DocBook exporter. + +- Eddward DeVilla proposed and tested checkbox statistics. He also + came up with the idea of properties, and that there should be an API + for them. + +- Nick Dokos tracked down several nasty bugs. + +- Kees Dullemond used to edit projects lists directly in HTML and so + inspired some of the early development, including HTML export. He + also asked for a way to narrow wide table columns. + +- Thomas S. Dye contributed documentation on Worg and helped + integrating the Org-Babel documentation into the manual. + +- Christian Egli converted the documentation into Texinfo format, + inspired the agenda, patched CSS formatting into the HTML exporter, + and wrote {{{file(org-taskjuggler.el)}}}. + +- David Emery provided a patch for custom CSS support in exported + HTML agendas. + +- Nic Ferrier contributed mailcap and XOXO support. + +- Miguel A. Figueroa-Villanueva implemented hierarchical checkboxes. + +- John Foerch figured out how to make incremental search show + context around a match in a hidden outline tree. + +- Raimar Finken wrote {{{file(org-git-line.el)}}}. + +- Mikael Fornius works as a mailing list moderator. + +- Austin Frank works as a mailing list moderator. + +- Eric Fraga drove the development of BEAMER export with ideas and + testing. + +- Barry Gidden did proofreading the manual in preparation for the + book publication through Network Theory Ltd. + +- Niels Giesen had the idea to automatically archive DONE trees. + +- Nicolas Goaziou rewrote much of the plain list code. + +- Kai Grossjohann pointed out key-binding conflicts with other packages. + +- Brian Gough of Network Theory Ltd publishes the Org mode manual as + a book. + +- Bernt Hansen has driven much of the support for auto-repeating + tasks, task state change logging, and the clocktable. His clear + explanations have been critical when we started to adopt the Git + version control system. + +- Manuel Hermenegildo has contributed various ideas, small fixes + and patches. + +- Phil Jackson wrote {{{file(org-irc.el)}}}. + +- Scott Jaderholm proposed footnotes, control over whitespace + between folded entries, and column view for properties. + +- Matt Jones wrote /MobileOrg Android/. + +- Tokuya Kameshima wrote {{{file(org-wl.el)}}} and {{{file(org-mew.el)}}}. + +- Shidai Liu ("Leo") asked for embedded LaTeX and tested it. He + also provided frequent feedback and some patches. + +- Matt Lundin has proposed last-row references for table formulas + and named invisible anchors. He has also worked a lot on the FAQ. + +- David Maus wrote {{{file(org-atom.el)}}}, maintains the issues + file for Org, and is a prolific contributor on the mailing list with + competent replies, small fixes and patches. + +- Jason F. McBrayer suggested agenda export to CSV format. + +- Max Mikhanosha came up with the idea of refiling. + +- Dmitri Minaev sent a patch to set priority limits on a per-file + basis. + +- Stefan Monnier provided a patch to keep the Emacs-Lisp compiler + happy. + +- Richard Moreland wrote /MobileOrg/ for the iPhone. + +- Rick Moynihan proposed allowing multiple TODO sequences in a file + and being able to quickly restrict the agenda to a subtree. + +- Todd Neal provided patches for links to Info files and Elisp forms. + +- Greg Newman refreshed the unicorn logo into its current form. + +- Tim O'Callaghan suggested in-file links, search options for + general file links, and TAGS. + +- Osamu Okano wrote {{{file(orgcard2ref.pl)}}}, a Perl program to + create a text version of the reference card. + +- Takeshi Okano translated the manual and David O'Toole's tutorial + into Japanese. + +- Oliver Oppitz suggested multi-state TODO items. + +- Scott Otterson sparked the introduction of descriptive text for + links, among other things. + +- Pete Phillips helped during the development of the TAGS feature, + and provided frequent feedback. + +- Martin Pohlack provided the code snippet to bundle character + insertion into bundles of 20 for undo. + +- T.V. Raman reported bugs and suggested improvements. + +- Matthias Rempe (Oelde) provided ideas, Windows support, and + quality control. + +- Paul Rivier provided the basic implementation of named footnotes. + He also acted as mailing list moderator for some time. + +- Kevin Rogers contributed code to access VM files on remote hosts. + +- Frank Ruell solved the mystery of the ~keymapp nil~ bug, a + conflict with {{{file(allout.el)}}}. + +- Jason Riedy generalized the send-receive mechanism for Orgtbl + tables with extensive patches. + +- Philip Rooke created the Org reference card, provided lots of + feedback, developed and applied standards to the Org documentation. + +- Christian Schlauer proposed angular brackets around links, among + other things. + +- Paul Sexton wrote {{{file(org-ctags.el)}}}. + +- Tom Shannon's {{{file(organizer-mode.el)}}} inspired linking to VM/BBDB/Gnus. + +- Ilya Shlyakhter proposed the Archive Sibling, line numbering in + literal examples, and remote highlighting for referenced code lines. + +- Stathis Sideris wrote the {{{file(ditaa.jar)}}} ASCII to PNG + converter that is now packaged into Org's {{{file(contrib)}}} + directory. + +- Daniel Sinder came up with the idea of internal archiving by + locking subtrees. + +- Dale Smith proposed link abbreviations. + +- James TD Smith has contributed a large number of patches for + useful tweaks and features. + +- Adam Spiers asked for global linking commands, inspired the link + extension system, added support for mairix, and proposed the mapping + API. + +- Ulf Stegemann created the table to translate special symbols to + HTML, LaTeX, UTF-8, Latin-1 and ASCII. + +- Andy Stewart contributed code to {{{file(org-w3m.el)}}}, to copy + HTML content with links transformation to Org syntax. + +- David O'Toole wrote {{{file(org-publish.el)}}} and drafted the + manual chapter about publishing. + +- Jambunathan K contributed the ODT exporter. + +- Sebastien Vauban reported many issues with LaTeX and BEAMER + export and enabled source code highlighting in Gnus. + +- Stefan Vollmar organized a video-recorded talk at the + Max-Planck-Institute for Neurology. He also inspired the creation + of a concept index for HTML export. + +- J\"urgen Vollmer contributed code generating the table of contents + in HTML output. + +- Samuel Wales has provided important feedback and bug reports. + +- Chris Wallace provided a patch implementing the {{{samp(QUOTE)}}} + keyword. + +- David Wainberg suggested archiving, and improvements to the + linking system. + +- Carsten Wimmer suggested some changes and helped fix a bug in + linking to Gnus. + +- Roland Winkler requested additional key bindings to make Org work + on a tty. + +- Piotr Zielinski wrote {{{file(org-mouse.el)}}}, proposed agenda + blocks and contributed various ideas and code snippets. + +* GNU Free Documentation License +:PROPERTIES: +:APPENDIX: t +:DESCRIPTION: The license for this documentation. +:END: + +#+TEXINFO: @include ../doc/doclicense.texi + +* Concept index +:PROPERTIES: +:ALT_TITLE: Main Index +:INDEX: cp +:DESCRIPTION: Org's concepts and features +:END: + +* Key index + :PROPERTIES: + :DESCRIPTION: Key bindings and where they are described + :ALT_TITLE: Key Index + :INDEX: ky + :END: + +* Command and function index + :PROPERTIES: + :DESCRIPTION: Command names and some internal functions + :ALT_TITLE: Command and Function Index + :INDEX: fn + :END: + +* Variable index + :PROPERTIES: + :DESCRIPTION: Variables mentioned in the manual + :ALT_TITLE: Variable Index + :INDEX: vr + :END: + +This is not a complete index of variables and faces, only the ones +that are mentioned in the manual. For a more complete list, use +{{{kbdspckey(M-x org-customize,RET)}}} and then click yourself through +the tree. + +* Copying + :PROPERTIES: + :copying: t + :END: + +This manual is for Org version {{{version}}}. + +Copyright (C) 2004-2013 Free Software Foundation, Inc. + +#+BEGIN_QUOTE +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover texts being ``A GNU Manual,'' +and with the Back-Cover Texts as in (a) below. A copy of the license +is included in the section entitled ``GNU Free Documentation License.'' + +(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom.'' + +This document is part of a collection distributed under the GNU Free +Documentation License. If you want to distribute this document +separately from the collection, you can do so by adding a copy of the +license to the document, as described in section 6 of the license. +#+END_QUOTE + +* Macro definitions :noexport: + +# Version macro, with commit hash +#+MACRO: version (eval (pcase (split-string (org-version nil t) "[ (_]" t) (`(,_ ,_ ,n ,_ ,r . ,_) (format "%s (release_%s)" n r)))) + +# Markup macros. In texinfo export they will be marked up, otherwise +# they will be inserted verbatim. markup is the generic form that can +# be used to insert any @-command with the second variable being the +# text to mark up. +#+MACRO: markup @@info:@$1{@@$2@@info:}@@ +#+MACRO: kbd {{{markup(kbd,$1)}}} +#+MACRO: key {{{markup(key,$1)}}} +#+MACRO: samp {{{markup(samp,$1)}}} +#+MACRO: command {{{markup(command,$1)}}} +#+MACRO: file {{{markup(file,$1)}}} +#+MACRO: var {{{markup(var,$1)}}} +#+MACRO: cite {{{markup(cite,$1)}}} +#+MACRO: value {{{markup(value,$1)}}} + +#+MACRO: kbdkey {{{kbd($1{{{key($2)}}})}}} +#+MACRO: kbdspckey {{{kbd($1 {{{key($2)}}})}}} +#+MACRO: ksksksk {{{kbd($1 {{{key($2)}}} $3 {{{key($4)}}})}}} +#+MACRO: ksksksksk {{{kbd($1 {{{key($2)}}} $3 {{{key($4)}}} {{{key($5)}}})}}} +#+MACRO: kbdkeys {{{kbd($1{{{key($2)}}}{{{key($3)}}})}}} + +# Plain macros. +#+MACRO: noindent @@info:@noindent@@ +#+MACRO: result @@info:@result{}@@ +#+MACRO: page @@info:@page@@ + +* Instructions for use :noexport: +- [ ] Tangle the makefile, `C-c C-v t' +- [ ] Execute [[Editing setup][this source code block]] +- [ ] Asynchronously generate the info file, `C-e i i' + +* Improvements and fixes [10/12] :noexport: +- [X] Jon will fix detailed node listing +- [X] Jon will fix :INDEX: property +- [ ] New link type to generate pxref? (asked on ML) +- [X] New macro for kbdkey that preserves space, e.g., `C-c <RET>' +- [X] Indent examples one more space to match indentation of footnotes +- [X] How to generate @kbd{\}? +- [X] How to generate @kbd{~}? +- [X] How to include GNU Free Documentation License as Appendix D? +- [X] Straighten out footnotes +- [X] Truncated footnote (asked on ML) +- [ ] Resolve macros with XXX arguments +- [X] Get @appendix instead of @chapter? + +* Nicolas Goaziou's instructions for v.8 :noexport: + +** Global Changes +All occurrences of "#+LABEL:" should be replaced with "#+NAME:". + +*** TODO Replace #+LABEL with #+NAME + +** Chapter 2, Document Structure + :PROPERTIES: + :CATEGORY: Ch. 2 + :END: +In "2. Document Structure", one section could be added about +cross-referencing, which would point to "Internal links". There, targets +in comments can be removed. Also most back-ends will turn links to +targets into proper cross-reference number (see `org-export-get-ordinal' +docstring for cases handled). + +*** TODO Add section about cross-referencing + +** Chapter 4, Hyperlinks + :PROPERTIES: + :CATEGORY: Ch. 4 + :END: +"Internal links". There, targets +in comments can be removed. Also most back-ends will turn links to +targets into proper cross-reference number (see `org-export-get-ordinal' +docstring for cases handled). + +*** TODO Remove targets in comments + +** Chapter 11, Markup for Rich Export + :PROPERTIES: + :CATEGORY: Ch. 11 + :END: +*** Include Keyword +The "#+INCLUDE:" keyword syntax and effect is slightly different. You +may want to look at `org-export-expand-include-keyword'. + +**** TODO Revise Include keyword +** Chapter 12, Exporting + :PROPERTIES: + :CATEGORY: Ch. 12 + :END: +*** Export Options +In "12. Exporting", "Export options" section need an overhaul. See +`org-export-options-alist' for the default list of export options. Other +options are back-end specific and should be introduced in their own +section. Also "#+KEYWORD:" renaming into ":EXPORT_KEYWORD:" property is +systematic. + +**** TODO Overhaul Export options section + +**** TODO KEYWORD now EXPORT_KEYWORD + +*** Macros +There should also be a section about macros (and move it out of "11 +Markup for rich export"), general, hard-coded ({{{time(...)}}}, +{{{property(...)}}}, {{{input-file}}} and {{{modification-time(...)}}}) +and specific ({{{date}}}, {{{author}}}, {{{title}}} and {{{email}}}). It +should be specified that macros are recursive and only apply to one +line. Therefore, they are appropriate for small replacements. For more +complex ones, one may use Babel instead. + +**** TODO Write macros section +Subsections: General, Hard-coded, Specific + +*** Filters +There should also be a section about filters used to customize export +output and another one about `org-export-define-derived-backend' which +allow someone to tweak a back-end. + +**** TODO Write filters section + +*** Define derived back-end +and another one about `org-export-define-derived-backend' which +allow someone to tweak a back-end. + +**** TODO Write derived back-end section + +*** Export Snippets +A section can be added about export snippets, i.e. + + @@ob-latex:\something{...}@@ + +They are a generalization for @<html> tags. + +**** TODO Write export snippets section +*** Captions +There may be a section about captions and their syntax. A note should +specify that export back-ends may or may not respect a caption. On the +other hand "11.2 Images and Tables" focuses on captions. Since these are +not specific to Images and Tables, it may be removed. + +**** TODO Write captions section +*** Back-ends +I would also regroup every back-end into a sub-section to not clutter +main section. + +Other options are back-end specific and should be introduced in their +own section. + +Also most back-ends will turn links to +targets into proper cross-reference number (see `org-export-get-ordinal' +docstring for cases handled). + + +**** Old back-ends + +"DocBook export" (though texinfo back-end can export to DocBook) and +"XOXO export" sections can be removed as the back-ends are discontinued. +There is no equivalent to "Taskjuggler export" yet, so it can be removed +too. + +***** TODO Remove DocBook backend + +***** TODO Remove XOXO backend + +***** TODO Remove Taskjuggler backend + +**** Back-end template +These are only suggestion. There is also probably many more things to +do. But I think that the hardest part is to start writing it. If you +come up with a good organization for e-latex back-end documentation, we +can use it for other back-ends thereafter. + +***** TODO Write back-end template + +****** TODO Does back-end turn links to targets? + +**** LaTeX Back-end +About the latex back-end, you know certainly a lot. It should be +specified that it introduces 3 new keywords, namely "LATEX_CLASS", +"LATEX_CLASS_OPTIONS" and "LATEX_HEADER". It also introduces +"BEGIN_LATEX" and "BEGIN_TEX" blocks (the latter being just a synonym +for the former). It would be worth to add that it handles footnotes in +item tags and footnotes within footnotes. It also handles booktabs, +paralist types, automatic babel language selection with #+LANGUAGE: in +addition to already present features (minted/listings package handling). + +***** TODO Write LaTeX back-end +**** Beamer Back-end +The BEAMER export back-end deserves, IMO, its own section. + +***** TODO Write Beamer back-end +**** TexInfo Back-end +> BTW, it would be great to have a texinfo exporter so the Org +> documentation could be written in Org-mode :) + +There is one, albeit barely tested: (require 'org-e-texinfo). + +though texinfo back-end can export to DocBook + +***** TODO Write texinfo backend +*** Export dispatcher +I think that the export dispatcher doesn't deserve its own section. The +introduction to Export subsystem can talk about "M-x +org-export-dispatch" (bound to C-c C-e) instead. +**** TODO Remove export dispatcher section + +*** Smart quotes +There should be a section about smart-quotes too. + +**** TODO Add smart quotes section + +* Org-mode setup :noexport: +** Editing setup +#+name: setup-editing +#+header: :results silent +#+header: :noweb yes +#+header: :eval no-export +#+begin_src emacs-lisp +(require 'ox-texinfo) +(define-key org-mode-map (kbd "C-c e") 'org-export-dispatch) +(setq org-src-preserve-indentation t) +(setq org-export-in-background t) +(setq org-export-async-debug t) +(setq org-export-async-init-file (expand-file-name "init.el")) +(setq org-pretty-entities nil) +(setq org-footnote-auto-adjust nil) +(setq org-confirm-babel-evaluate nil) +(org-babel-do-load-languages + 'org-babel-load-languages + '((emacs-lisp . t) + (sh . t))) +(org-add-link-type + "pxref" nil + (lambda (path desc format) + (cond + ((eq format 'html) + (format "<span class=\"pxref\">%s</span>" path)) + ((eq format 'latex) + (format "\\ref{%s}" path)) + ((eq format 'texinfo) + (format "@pxref{%s,%s}" path desc))))) +(add-to-list 'org-export-snippet-translation-alist + '("info" . "texinfo")) +#+end_src + +** init.el file +This source code block requires paths to your Org mode installation. +Modify accordingly. + +#+name: emacs-init +#+header: :tangle init.el +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(setq load-path (cons "~/.emacs.d/src/org-mode/lisp" load-path)) +; (setq load-path (cons "~/.emacs.d/src/org-mode/contrib/lisp" load-path)) +(require 'ox-texinfo) +(setq org-src-preserve-indentation t) +(setq org-confirm-babel-evaluate nil) +(setq org-footnote-auto-adjust nil) +(org-babel-do-load-languages + 'org-babel-load-languages + '((emacs-lisp . t) + (makefile . t) + (sh . t))) +(add-to-list 'org-export-snippet-translation-alist + '("info" . "texinfo")) +#+end_src + +** Texi -> Org helpers :noexport: +This section contains source code blocks that help translate from +=texinfo= to =Org=. + +#+name: tsd-helpers +#+header: :noweb yes +#+header: :eval no-export +#+begin_src emacs-lisp +<<tsd-index-to-macro>> +<<tsd-samp-to-macro>> +<<tsd-kbdkey-to-macro>> +<<tsd-kbd-to-macro>> +<<tsd-key-to-macro>> +<<tsd-command-to-macro>> +<<tsd-file-to-macro>> +<<tsd-noindent>> +<<tsd-example-block-begin>> +<<tsd-example-block-end>> +<<tsd-table-begin>> +<<tsd-table-end>> +<<tsd-pxref>> +<<tsd-xref>> +<<tsd-ref>> +<<tsd-orgcmd>> +<<tsd-orgkey>> +<<tsd-code-to-markup>> +<<tsd-emph-to-markup>> +<<tsd-i-to-markup>> +<<tsd-lisp-begin>> +<<tsd-lisp-end>> +#+end_src + +#+results: tsd-helpers +: tsd-lisp-end + +#+name: tsd-index-to-macro +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-index-to-macro () + "Make macros out of @[cpfvk]index commands. Doesn't handle commas." + (interactive) + (query-replace-regexp "@\\([cpfvk]\\)index\\ \\(.*\\)$" "{{{\\1index(\\2)}}}" nil)) +#+end_src + +#+name: tsd-samp-to-macro +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-samp-to-macro () + "Make macros out of @samp commands." + (interactive) + (query-replace-regexp "@samp{\\([^}]*\\)}" "{{{samp(\\1)}}}" nil)) +#+end_src + +#+name: tsd-kbdkey-to-macro +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-kbdkey-to-macro () + "Make macros out of @kbd,@key commands." + (interactive) + (query-replace-regexp "@kbd{\\([^@]*\\)@key{\\([^}]*\\)}}" "{{{kbdkey(\\1,\\2)}}}" nil)) +#+end_src + +#+name: tsd-kbd-to-macro +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-kbd-to-macro () + "Make macros out of @kbd commands." + (interactive) + (query-replace-regexp "@kbd{\\([^}]*\\)}" "{{{kbd(\\1)}}}" nil)) +#+end_src + +#+name: tsd-key-to-macro +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-key-to-macro () + "Make macros out of @key commands." + (interactive) + (query-replace-regexp "@key{\\([^}]*\\)}" "{{{key(\\1)}}}" nil)) +#+end_src + +#+name: tsd-command-to-macro +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-command-to-macro () + "Make macros out of @command commands." + (interactive) + (query-replace-regexp "@command{\\([^}]*\\)}" "{{{command(\\1)}}}" nil)) +#+end_src + +#+name: tsd-file-to-macro +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-file-to-macro () + "Make macros out of @file commands." + (interactive) + (query-replace-regexp "@file{\\([^}]*\\)}" "{{{file(\\1)}}}" nil)) +#+end_src + +#+name: tsd-noindent +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-noindent () + "Make macros out of @noindent commands." + (interactive) + (query-replace "@noindent" "{{{noindent}}}" t)) +#+end_src + +#+name: tsd-example-block-begin +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-example-block-begin () + "Convert example blocks." + (interactive) + (query-replace "@example" "#+begin_example" t)) +#+end_src + +#+name: tsd-example-block-end +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-example-block-end () + "Convert example blocks." + (interactive) + (query-replace "@end example" "#+end_example" nil)) +#+end_src + +#+name: tsd-table-begin +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-table-begin () + "Convert table blocks." + (interactive) + (query-replace-regexp "@table\\ \\([@a-z]*\\)" "#+attr_texinfo: :table-type table :indic \\1 t)) +#+end_src + +#+name: tsd-table-end +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-table-end () + "Convert table blocks." + (interactive) + (query-replace "@end table" "" nil)) +#+end_src + +#+name: tsd-pxref +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-pxref () + "Convert @pxref to links." + (interactive) + (query-replace-regexp "@pxref{\\([^}]*\\)}" "see \[\[\\1\]\]" nil)) +#+end_src + +#+name: tsd-xref +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-xref () + "Convert @xref to links." + (interactive) + (query-replace-regexp "@xref{\\([^}]*\\)}" "See \[\[\\1\]\]" nil)) +#+end_src + +#+name: tsd-ref +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-ref () + "Convert @ref to links." + (interactive) + (query-replace-regexp "@ref{\\([^}]*\\)}" "\[\[\\1\]\]" nil)) +#+end_src + +#+name: tsd-orgcmd +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-orgcmd () + "Convert @orgcmd to list entry." + (interactive) + (query-replace-regexp "@orgcmd{\\([^,]*\\),\\([^}]*\\)}" "- {{{kbd(\\1)}}}, ~\\2~ ::" nil)) +#+end_src + +#+name: tsd-orgkey +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-orgkey () + "Convert @orgkey to list entry." + (interactive) + (query-replace-regexp "@orgkey{\\([^}]*\\)}" "- {{{kbd(\\1)}}} ::" nil)) +#+end_src + +#+name: tsd-code-to-markup +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-code-to-markup () + "Convert @code to markup." + (interactive) + (query-replace-regexp "@code{\\([^}]*\\)}" "~\\1~" nil)) +#+end_src + +#+name: tsd-emph-to-markup +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-emph-to-markup () + "Convert @emph to markup." + (interactive) + (query-replace-regexp "@emph{\\([^}]*\\)}" "/\\1/" nil)) +#+end_src + +#+name: tsd-i-to-markup +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-i-to-markup () + "Convert @i to markup." + (interactive) + (query-replace-regexp "@i{\\([^}]*\\)}" "/\\1/" nil)) +#+end_src + +#+name: tsd-b-to-markup +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-b-to-markup () + "Convert @b to markup." + (interactive) + (query-replace-regexp "@b{\\([^}]*\\)}" "*\\1*" nil)) +#+end_src + +#+name: tsd-lisp-begin +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-lisp-begin () + "Convert @lisp blocks." + (interactive) + (query-replace "@lisp" "#+begin_src emacs-lisp" t)) +#+end_src + +#+name: tsd-lisp-end +#+header: :results silent +#+header: :eval no-export +#+begin_src emacs-lisp +(defun tsd-lisp-end () + "Convert @lisp blocks." + (interactive) + (query-replace "@end lisp" "#+end_src" nil)) +#+end_src + +* Footnotes + +[fn:1] The iCalendar file will contain TODO and agenda items only. + +[fn:2] If your Emacs distribution does not come with Org, +the function ~org-version~ will not be defined. + +[fn:3] The ~master~ branch is where development takes place. + +[fn:4] The output from install-info (if any) is system dependent. In +particular, Debian and its derivatives use two different versions of +install-info. You may safely ignore the message: +#+begin_example + This is not dpkg install-info anymore, but GNU install-info + See the man page for ginstall-info for command line arguments +#+end_example +returned by install-info. + +[fn:5] If you don't use font-lock globally, turn it on in an Org +buffer with ~(add-hook 'org-mode-hook 'turn-on-font-lock)~. + +[fn:6] Please consider subscribing to the mailing list in order to +minimize the work the mailing list moderators have to do. + +[fn:7] Easy templates insert lowercase keywords and Babel dynamically +inserts ~#+results~. + +[fn:8] See the variables ~org-special-ctrl-a/e~, ~org-special-ctrl-k~, +and ~org-ctrl-k-protect-subtree~ to configure special behavior of +{{{kbd(C-a)}}}, {{{kbd(C-e)}}}, and {{{kbd(C-k)}}} in headlines. Note +also that clocking only works with headings indented less than 30 +stars. + +[fn:9] See the option ~org-cycle-global-at-bob~. + +[fn:10] The indirect buffer will contain the entire buffer, but will +be narrowed to the current tree. Editing the indirect buffer will also +change the original buffer, but without affecting visibility in that +buffer. For more information about indirect buffers, +[[info:emacs:Indirect Buffers][GNU Emacs Manual]]. + +[fn:11] If you do not want the line to be split, customize the +variable ~org-M-RET-may-split-line~. + +[fn:12] See also the variables ~org-show-hierarchy-above~, +~org-show-following-heading~, ~org-show-siblings~, and +~org-show-entry-below~ for detailed control on how much context is +shown around each match. + +[fn:13] This depends on the option ~org-remove-highlights-with-change~. + +[fn:14] This does not work under XEmacs, because XEmacs uses selective +display for outlining, not text properties. + +[fn:15] When using ~*~ as a bullet, lines must be indented or they will +be seen as top-level headlines. Also, when you are hiding leading +stars to get a clean outline view, plain list items starting with a +star may be hard to distinguish from true headlines. In short: even +though ~*~ is supported, it may be better to not use it for plain list +items. + +[fn:16] You can filter out any of them by configuring +~org-plain-list-ordered-item-terminator~. + +[fn:17] If there's a checkbox in the item, the cookie must be put +_before_ the checkbox. If you have activated alphabetical lists, you +can also use counters like ~[@b]~. + +[fn:18] Org only changes the filling settings for Emacs. For XEmacs, +you should use Kyle E. Jones' {{{file(filladapt.el)}}}. + +[fn:19] If you do not want the item to be split, customize the +variable ~org-M-RET-may-split-line~. + +[fn:20] If you want to cycle around items that way, you may customize +~org-list-use-circular-motion~. + +[fn:21] See ~org-list-use-circular-motion~ for a cyclic behavior. + +[fn:24] Centering does not work inside Emacs, but it does have an +effect when exporting to HTML. + +[fn:26] For backward compatibility you can also use special names like +~$LR5~ and ~$LR12~ to refer in a stable way to the fifth and twelfth +field in the last row of the table. However, this syntax is +deprecated, it should not be used for new documents. Use ~@>$~ +instead. + +[fn:25] Org will understand references typed by the user as +{{{samp(B4)}}}, but it will not use this syntax when offering a +formula for editing. You can customize this behavior using the +variable ~org-table-use-standard-references~. + +[fn:22] To insert a vertical bar into a table field, use ~\vert~ or, +inside a word ~abc\vert{}def~. + +[fn:23] This feature does not work on XEmacs. + +[fn:27] The computation time scales as O(N^2) because table FOO is +parsed for each field to be copied. + +[fn:28] The {{{file(calc)}}} package has the non-standard +convention that ~/~ has lower precedence than ~*~, so that ~a/b*c~ is +interpreted as ~a/(b*c)~. + +[fn:29] The ~printf~ reformatting is limited in precision because the +value passed to it is converted into an ~integer~ or ~double~. The +~integer~ is limited in size by truncating the signed value to 32 +bits. The ~double~ is limited in precision to 64 bits overall which +leaves approximately 16 significant decimal digits. + +[fn:30] Such names must start with an alphabetic character and use +only alphanumeric/underscore characters. + +[fn:31] Note that text before the first headline is usually not +exported, so the first such target should be after the first headline, +or in the line directly before the first headline. + +[fn:32] To insert a link targeting a headline, in-buffer completion +can be used. Just type a star followed by a few optional letters into +the buffer and press {{{kbdkey(M-,TAB)}}}. All headlines in the +current buffer will be offered as completions. + +[fn:33] The actual behavior of the search will depend on the value of +the variable ~org-link-search-must-match-exact-headline~. If its value +is ~nil~, then a fuzzy text search will be done. If it is ~t~, then +only the exact headline will be matched. If the value is +{{{samp('query-to-create)}}}, then an exact headline will be searched; +if it is not found, then the user will be queried to create it. + +[fn:34] If the headline contains a timestamp, it will be removed from +the link and result in a wrong link -- you should avoid putting a +timestamp in the headline. + +[fn:35] Note that you don't have to use this command to insert a link. +Links in Org are plain text, and you can type or paste them straight +into the buffer. By using this command, the links are automatically +enclosed in double brackets, and you will be asked for the optional +descriptive text. + +[fn:36] After insertion of a stored link, the link will be removed +from the list of stored links. To keep it in the list later use, use a +triple {{{kbd(C-u)}}} prefix argument to {{{kbd(C-c C-l)}}}, or +configure the option ~org-keep-stored-link-after-insertion~. + +[fn:37] This works if a function has been defined in the ~:complete~ +property of a link in ~org-link-parameters~. + +[fn:38] See the variable ~org-display-internal-link-with-indirect-buffer~. + +[fn:44] Check also the variable ~org-fast-tag-selection-include-todo~, +it allows you to change the TODO state through the tags interface +([[Setting tags]]), in case you like to mingle the two concepts. Note that +this means you need to come up with unique keys across both sets of +keywords. + +[fn:39] For backward compatibility, line numbers can also follow a +single colon. + +[fn:40] Of course, you can make a document that contains only long +lists of TODO items, but this is not required. + +[fn:41] Changing the variable ~org-todo-keywords~ only becomes +effective after restarting Org mode in a buffer. + +[fn:42] This is also true for the {{{kbd(t)}}} command in the timeline +and agenda buffers. + +[fn:43] All characters are allowed except ~@^!~, which have a special +meaning here. + +[fn:45] Org mode parses these lines only when Org mode is activated +after visiting a file. {{{kbd(C-c C-c)}}} with the cursor in a line +starting with {{{samp(#+)}}} is simply restarting Org mode for the +current buffer. + +[fn:46] The corresponding in-buffer setting is: ~#+STARTUP: logdone~. + +[fn:47] The corresponding in-buffer setting is: ~#+STARTUP: lognotedone~. + +[fn:48] See the variable ~org-log-states-order-reversed~. + +[fn:54] {{{kbd(C-u C-c C-c)}}} on the /first/ item of a list with no +checkbox will add checkboxes to the rest of the list. + +[fn:49] It is possible that Org mode will record two timestamps when +you are using both ~org-log-done~ and state change logging. However, +it will never prompt for two notes---if you have configured both, the +state change recording note will take precedence and cancel the +{{{samp(Closing Note)}}}. + +[fn:50] See also the option ~org-priority-start-cycle-with-default~. + +[fn:51] To keep subtasks out of the global TODO list, see the +~org-agenda-todo-list-sublevels~. + +[fn:52] With the exception of description lists. But you can allow it +by modifying ~org-list-automatic-rules~ accordingly. + +[fn:53] Set the variable ~org-hierarchical-checkbox-statistics~ if you +want such cookies to count all checkboxes below the cookie, not just +those belonging to direct children. + +[fn:55] As with all these in-buffer settings, pressing +{{{kbd(C-c C-c)}}} activates any changes in the line. + +[fn:56] This is only true if the search does not involve more complex +tests including properties (see [[Property searches]]). + +[fn:57] Keys will automatically be assigned to tags that have no +configured keys. + +[fn:58] Please note that the COLUMNS definition must be on a single +line---it is wrapped here only because of formatting constraints. + +[fn:59] Contributed packages are not part of Emacs, but are +distributed with the main distribution of Org (visit +[[http://orgmode.org]]). + +[fn:60] The Org date format is inspired by the standard ISO 8601 +date/time format. To use an alternative format, see [[Custom time +format]]. The day name is optional when you type the date yourself. +However, any dates inserted or modified by Org will add that day name, +for reading convenience. + +[fn:61] When working with the standard diary sexp functions, you need +to be very careful with the order of the arguments. That order depends +evilly on the variable ~calendar-date-style~ (or, for older Emacs +versions, ~european-calendar-style~). For example, to specify a date +December 12, 2005, the call might look like ~(diary-date 12 1 2005)~ +or ~(diary-date 1 12 2005)~ or ~(diary-date 2005 12 1)~, depending on +the settings. This has been the source of much confusion. Org mode +users can resort to special versions of these functions like +~org-date~ or ~org-anniversary~. These work just like the +corresponding ~diary-~ functions, but with stable ISO order of +arguments (year, month, day) wherever applicable, independent of the +value of ~calendar-date-style~. + +[fn:62] See the variable ~org-read-date-prefer-future~. You may +set that variable to the symbol ~time~ to even make a time before now +shift the date to tomorrow. + +[fn:63] If you don't need/want the calendar, configure the variable +~org-popup-calendar-for-date-prompt~. + +[fn:64] If you find this distracting, turn off the display with +~org-read-date-display-live~. + +[fn:65] It will still be listed on that date after it has been marked +DONE. If you don't like this, set the variable +~org-agenda-skip-scheduled-if-done~. + +[fn:66] The {{{samp(SCHEDULED)}}} and {{{samp(DEADLINE)}}} dates are +inserted on the line right below the headline. Don't put any text +between this line and the headline. + +[fn:67] Note the corresponding ~#+STARTUP~ keywords ~logredeadline~, +~lognoteredeadline~, and ~nologredeadline~. + +[fn:68] Note the corresponding ~#+STARTUP~ keywords ~logreschedule~, +~lognotereschedule~, and ~nologreschedule~. + +[fn:69] In fact, the target state is taken from, in this sequence, the +~REPEAT_TO_STATE~ property or the variable ~org-todo-repeat-to-state~. +If neither of these is specified, the target state defaults to the +first state of the TODO state sequence. + +[fn:70] You can change this using the option ~org-log-repeat~, or the +~#+STARTUP~ options ~logrepeat~, ~lognoterepeat~, and ~nologrepeat~. +With ~lognoterepeat~, you will also be prompted for a note. + +[fn:71] Clocking only works if all headings are indented with less +than 30 stars. This is a hardcoded limitation of ~lmax~ in +~org-clock-sum~. + +[fn:72] To resume the clock under the assumption that you have worked +on this task while outside Emacs, use ~(setq org-clock-persist t)~. + +[fn:73] To add an effort estimate ``on the fly'', hook a function +doing this to ~org-clock-in-prepare-hook~. + +[fn:74] The last reset of the task is recorded by the ~LAST_REPEAT~ +property. + +[fn:75] See also the variable ~org-clock-modeline-total~. + +[fn:76] The corresponding in-buffer setting is: +~#+STARTUP: lognoteclock-out~. + +[fn:77] Language terms can be set through the variable +~org-clock-clocktable-language-setup~. + +[fn:78] Note that all parameters must be specified in a single +line---the line is broken here only to fit it into the manual. + +[fn:79] On computers using Mac OS X, idleness is based on actual user +idleness, not just Emacs' idle time. For X11, you can install a +utility program {{{file(x11idle.c)}}}, available in the +~contrib/scripts~ directory of the Org git distribution, to get the +same general treatment of idleness. On other systems, idle time refers +to Emacs idle time only. + +[fn:80] You may change the property being used with the variable +~org-effort-property~. + +[fn:86] Note the corresponding ~#+STARTUP~ keywords ~logrefile~, +~lognoterefile~, and ~nologrefile~. + +[fn:81] Please select your own key, {{{kbd(C-c c)}}} is only a +suggestion. + +[fn:82] If you need one of these sequences literally, escape the +{{{kbd(%)}}} with a backslash. + +[fn:83] If you define your own link types (see [[Adding hyperlink +types]]), any property you store with ~org-store-link-props~ can be +accessed in capture templates in a similar way. + +[fn:84] This will always be the other, not the user. See the variable +~org-from-is-user-regexp~. + +[fn:85] If you move entries or Org files from one directory to +another, you may want to configure ~org-attach-directory~ to contain +an absolute path. + +[fn:87] For backward compatibility, the following also works: If there +are several such lines in a file, each specifies the archive location +for the text below it. The first such line also applies to any text +before its definition. However, using this method is /strongly/ +deprecated as it is incompatible with the outline structure of the +document. The correct method for setting multiple archive locations in +a buffer is using properties. + +[fn:94] Only tags filtering will be respected here, effort filtering +is ignored. + +[fn:88] When using the dispatcher, pressing {{{kbd(<)}}} before +selecting a command will actually limit the command to the current +file, and ignore ~org-agenda-files~ until the next dispatcher command. + +[fn:89] For backward compatibility, you can also press {{{kbd(1)}}} to +restrict to the current buffer. + +[fn:90] For backward compatibility, you can also press {{{kbd(0)}}} to +restrict to the current region/subtree. + +[fn:91] For backward compatibility, the universal prefix +{{{kbd(C-u)}}} causes all TODO entries to be listed before the agenda. +This feature is deprecated, use the dedicated TODO list, or a block +agenda instead (see [[Block agenda]]). + +[fn:92] But see [[x-agenda-skip-entry-regexp][skipping entries based on regexp]]. + +[fn:93] For backward compatibility, the following also works: if +there are several such lines in a file, each specifies the category +for the text below it. The first category also applies to any text +before the first CATEGORY line. However, using this method is +/strongly/ deprecated as it is incompatible with the outline structure +of the document. The correct method for setting multiple categories in +a buffer is using a property. + +[fn:95] Custom commands can preset a filter by binding the variable +~org-agenda-tag-filter-preset~ as an option. This filter will then be +applied to the view and persist as a basic filter through refreshes +and more secondary filtering. The filter is a global property of the +entire agenda view---in a block agenda, you should only set this in +the global options section, not in the section of an individual block. + +[fn:96] You can also create persistent custom functions through +~org-agenda-bulk-custom-functions~. + +[fn:97] The Emacs diary file is parsed for the agenda when +~org-agenda-include-diary~ is set. + +[fn:98] You can provide a description for a prefix key by inserting a +cons cell with the prefix and the description. + +[fn:99] For HTML you need to install Hrvoje Niksic's +{{{file(htmlize.el)}}}. To create PDF output, the ghostscript +{{{file(ps2pdf)}}} utility must be installed on the system. Selecting +a PDF file will also create the postscript file. + +[fn:100] If you want to store standard views like the weekly agenda or +the global TODO list as well, you need to define custom commands for +them in order to be able to specify file names. + +[fn:101] Quoting depends on the system you use, please check the FAQ +for examples. + +[fn:102] This works automatically for the HTML backend (it requires +version 1.34 of the {{{file(htmlize.el)}}} package, which is +distributed with Org). Fontified code chunks in LaTeX can be +achieved using either the listings package or the [[http://code.google.com/p/minted][minted]] package. +Refer to ~org-export-latex-listings~ documentation for details. + +[fn:103] Code in {{{samp(src)}}} blocks may also be evaluated either +interactively or on export. See [[Working with source code]] for more +information on evaluating code blocks. + +[fn:104] Adding ~-k~ to ~-n -r~ will /keep/ the labels in the source +code while using line numbers for the links, which might be useful to +explain those in an Org mode example code. + +[fn:105] Upon exit, lines starting with {{{samp(*)}}}, {{{samp(\,*)}}}, +{{{samp(#+)}}} and {{{samp(\,#+)}}} will get a comma prepended, to keep +them from being interpreted by Org as outline nodes or special syntax. +These commas will be stripped for editing with {{{kbd(C-c ')}}}, and +also for export. + +[fn:106] You may select a different-mode with the variable +~org-edit-fixed-width-region-mode~. + +[fn:107] LaTeX is a macro system based on Donald\nbsp{}E.\nbsp{}Knuth's TeX +system. Many of the features described here as LaTeX are really +from TeX, but for simplicity I am blurring this distinction. + +[fn:108] You can turn this on by default by setting the variable +~org-pretty-entities~, or on a per-file base with the ~#+STARTUP~ +option ~entitiespretty~. + +[fn:109] If you plan to use this regularly or on pages with +significant page views, you should install {{{file(MathJax)}}} on your +own server in order to limit the load of our server. + +[fn:110] For this to work you need to be on a system with a working +LaTeX installation. You also need the {{{file(dvipng)}}} program or +the {{{file(convert)}}}, respectively available at +[[http://sourceforge.net/projects/dvipng/]] and from the +{{{file(ImageMagick)}}} suite. The LaTeX header that will be used +when processing a fragment can be configured with the variable +~org-format-latex-header~. + +[fn:111] When {{{file(MathJax)}}} is used, only the environment +recognized by {{{file(MathJax)}}} will be processed. When +{{{file(dvipng)}}} is used to create images, any LaTeX environments +will be handled. + +[fn:112] Org mode has a method to test if the cursor is inside such a +fragment, see the documentation of the function +~org-inside-LaTeX-fragment-p~. + +[fn:113] The variable ~org-export-date-timestamp-format~ defines how +this timestamp will be exported. + +[fn:114] If you want to configure many options this way, you can use +several ~#+OPTIONS~ lines. + +[fn:115] To make this behavior the default, customize the variable +~org-export-run-in-background~. + +[fn:116] This requires ~transient-mark-mode~ be turned on. + +[fn:117] To select the current subtree, use {{{kbd(C-c @)}}}. + +[fn:118] This requires ~transient-mark-mode~ be turned on. + +[fn:119] To select the current subtree, use {{{kbd(C-c @)}}}. + +[fn:120] But see the variable ~org-export-html-inline-images~. + +[fn:121] If you plan to use this regularly or on pages with +significant page views, you should install MathJax on your own server +in order to limit the load of our server. Installation instructions +can be found on the MathJax website, see +[[http://www.mathjax.org/resources/docs/?installation.html]]. + +[fn:122] If the classes on TODO keywords and tags lead to conflicts, +use the variables ~org-export-html-todo-kwd-class-prefix~ and +~org-export-html-tag-class-prefix~ to make them unique. + +[fn:123] This style is defined in the constant +~org-export-html-style-default~, which you should not modify. To turn +inclusion of these defaults off, customize +~org-export-html-style-include-default~. + +[fn:124] The default LaTeX output is designed for processing with +~pdftex~ or LaTeX. It includes packages that are not compatible +with ~xetex~ and possibly ~luatex~. See the variables +~org-export-latex-default-packages-alist~ and +~org-export-latex-packages-alist~. + +[fn:125] This requires ~transient-mark-mode~ be turned on. + +[fn:126] To select the current subtree, use {{{kbd(C-c @)}}}. + +[fn:127] Into which the values of +~org-export-latex-default-packages-alist~ and +~org-export-latex-packages-alist~ are spliced. + +[fn:128] One can also take advantage of this option to pass other, +unrelated options into the figure or table environment. For an example +see the section ``Exporting org files'' in +[[http://orgmode.org/worg/org-hacks.html]]. + +[fn:129] This requires ~transient-mark-mode~ to be turned on. + +[fn:130] To select the current subtree, use {{{kbd(C-c @)}}}. + +[fn:131] ODT export was added in Org mode version 7.8. + +[fn:132] See [[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open Document Format for Office Applications (OpenDocument) +Version 1.2]]. + +[fn:133] This requires ~transient-mark-mode~ to be turned on. + +[fn:134] To select the current subtree, use {{{kbd(C-c @)}}}. + +[fn:135] The column widths are interpreted as weighted ratios with the +default weight being 1. + +[fn:136] Use of {{{file(ImageMagick)}}} is only desirable. However, if +you routinely produce documents that have large images or you export +your Org files that has images using a Emacs batch script, then the +use of {{{file(ImageMagick)}}} is mandatory. + +[fn:137] See [[http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl][MathToWeb]]. + +[fn:138] Your {{{file(htmlfontify.el)}}} library must at least be at +Emacs 24.1 levels for fontification to be turned on. + +[fn:139] See [[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][OpenDocument-v1.2 Specification]]. + +[fn:140] See the ~<table:table-template>~ element of the +OpenDocument-v1.2 specification. + +[fn:141] See the attributes ~table:template-name~, +~table:use-first-row-styles~, ~table:use-last-row-styles~, +~table:use-first-column-styles~, ~table:use-last-column-styles~, +~table:use-banding-rows-styles~, and ~table:use-banding-column-styles~ +of the ~<table:table>~ element in the OpenDocument-v1.2 specification. + +[fn:142] Note that {{{file(.odt)}}} files are {{{samp(zip)}}} +archives. + +[fn:143] See the variables ~org-icalendar-use-deadline~ and +~org-icalendar-use-scheduled~. + +[fn:144] To add inherited tags or the TODO state, configure the +variable ~org-icalendar-categories~. + +[fn:145] The LOCATION property can be inherited from higher in the +hierarchy if you configure ~org-use-property-inheritance~ accordingly. + +[fn:146] The files {{{file(file-source.org)}}} and +{{{file(file-source.org.html)}}} if source and publishing directories +are equal. Note that with this kind of setup, you need to add +~:exclude "-source\\.org"~ to the project definition in +~org-publish-project-alist~ to prevent the published source files from +being considered as new org files the next time the project is +published. + +[fn:147] Note that {{{samp(src)}}} blocks may be inserted using Org +mode's [[Easy templates]] system. + +[fn:148] Whenever code is evaluated there is a potential for that code +to do harm. Org mode provides safeguards to ensure that code is only +evaluated after explicit confirmation from the user. For information +on these safeguards (and on how to disable them) see [[Code evaluation +security]]. + +[fn:149] The ~org-babel-no-eval-on-ctrl-c-ctrl-c~ variable can be used +to remove code evaluation from the {{{kbd(C-c C-c)}}} key binding. + +[fn:150] Note that evaluation of header arguments is guaranteed to +take place in the original Org mode file, while there is no such +guarantee for evaluation of the code block body. + +[fn:151] The example requires that property inheritance be turned on +for the ~noweb-ref~ property, see [[Property inheritance]]. + +[fn:152] In certain languages this also contains the error output +stream; this is an area for future work. + +[fn:153] The last evaluation performed by the interpreter is obtained +in a language-specific manner: the value of the variable ~_~ in Python +and Ruby, and the value of ~.Last.value~ in R. + +[fn:161] If the {{{samp(#+TBLFM)}}} line contains an odd number of +dollar characters, this may cause problems with font-lock in LaTeX +mode. As shown in the example you can fix this by adding an extra line +inside the ~comment~ environment that is used to balance the dollar +expressions. If you are using AUCTeX with the font-latex library, a +much better solution is to add the ~comment~ environment to the +variable ~LaTeX-verbatim-environments~. + +[fn:162] The HTML translator uses the same code that produces tables +during HTML export. + +[fn:154] Note that ~org-indent-mode~ also sets the ~wrap-prefix~ +property, such that ~visual-line-mode~ (or purely setting ~word-wrap~) +wraps long lines (including headlines) correctly indented. + +[fn:155] See the variable ~org-indent-indentation-per-level~. + +[fn:156] Turning on ~org-indent-mode~ sets ~org-hide-leading-stars~ to +~t~ and ~org-adapt-indentation~ to ~nil~. + +[fn:157] See also the variable ~org-adapt-indentation~. + +[fn:158] When you need to specify a level for a property search or +refile targets, ~LEVEL=2~ will correspond to 3 stars, etc. + +[fn:159] The {{{file(org-R.el)}}} package has been replaced by the +Org mode functionality described in [[Working with source code]] and is +now obsolete. + +[fn:160] By default this works only for LaTeX, HTML, and Texinfo. +Configure the variable ~orgtbl-radio-tables~ to install templates for +other modes. + +[fn:163] Note that, when using ~org-odd-levels-only~, a level number +corresponds to order in the hierarchy, not to the number of stars. + +[fn:164] If you can safely store the password in your Emacs setup, you +might also want to configure `org-mobile-encryption-password'. Please +read the docstring of that variable. Note that encryption will apply +only to the contents of the `.org' files. The file names themselves +will remain visible. + +[fn:165] If you cannot use Dropbox, or if your version of MobileOrg +does not support it, you can use a webdav server. For more +information, check out the documentation of MobileOrg and also this +[[http://orgmode.org/worg/org-faq.html#mobileorg_webdav][FAQ entry]]. + +[fn:166] While creating the agendas, Org mode will force ID properties +on all referenced entries, so that these entries can be uniquely +identified if /MobileOrg/ flags them for further action. If you do not +want to get these properties in so many entries, you can set the +variable ~org-mobile-force-id-on-agenda-items~ to ~nil~. Org mode will +then rely on outline paths, in the hope that these will be unique +enough. + +[fn:167] Checksums are stored automatically in the file +{{{file(checksums.dat)}}}. + +[fn:168] The file {{{file(mobileorg.org)}}} will be empty after this +operation. + +[fn:169] Note, however, that there is a subtle difference. The view +created automatically by {{{kbdspckey(M-x org-mobile-pull,RET)}}} is +guaranteed to search all files that have been addressed by the last +pull. This might include a file that is not currently in your list of +agenda files. If you later use {{{kbd(C-c a ?)}}} to regenerate the +view, only the current agenda files will be searched. + +[fn:170] You can also get `a.', `A.', `a)' and `A)' by configuring +`org-alphabetical-lists'. To minimize confusion with normal text, +those are limited to one character only. Beyond that limit, bullets +will automatically fallback to numbers. + +[fn:171] See also ~org-empty-line-terminates-plain-lists~. + +[fn:172] You can define additional drawers on a per-file basis with a +line like ~#+DRAWERS: HIDDEN STATE~. + +[fn:173] The corresponding in-buffer setting is: ~#+STARTUP: fninline~ or +~#+STARTUP: nofninline~. + +[fn:174] The corresponding in-buffer options are ~#+STARTUP: fnadjust~ and +~#+STARTUP: nofnadjust~. + +[fn:175] The file {{{file(constants.el)}}} can supply the values of constants in two +different unit systems, ~SI~ and ~cgs~. Which one is used depends on +the value of the variable ~constants-unit-system~. You can use the +~#+STARTUP:~ options ~constSI~ and ~constcgs~ to set this value for the +current buffer. + +[fn:176] The library {{{file(org-id)}}} must first be loaded, either through +~org-customize~ by enabling ~id~ in ~org-modules~, or by adding +~(require 'org-id)~ in your {{{file(.emacs)}}}. + +[fn:177] The variable ~org-startup-with-inline-images~ can be set +within a buffer with the ~#+STARTUP:~ keywords ~inlineimages~ and +~noinlineimages~. + +[fn:178] Note that the ~LOGBOOK~ drawer is unfolded when pressing +{{{key(SPC)}}} in the agenda to show an entry---use +{{{kbdspckey(C-u,SPC)}}} to keep it folded here. + +[fn:179] Please note the pitfalls of summing hierarchical data in a flat +list ([[Agenda column view]]). + +[fn:180] If the value of that variable is not a list, but a single file +name, then the list of agenda files will be maintained in that external +file. + +[fn:181] The variable ~org-anniversary~ used in the example +is just like ~diary-anniversary~, but the argument order is +always according to ISO and therefore independent of the value of +~calendar-date-style~. + +[fn:182] Emacs 23 and Org mode 6.29 are required. + +[fn:183] Emacs 23.1 can actually crash with ~org-indent-mode~. + +[fn:184] Symbolic links in ~org-directory~ need to have the same name +as their targets. + + +# Local Variables: +# sentence-end-double-space: t +# End: diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 37911c6..dd332a4 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -6,7 +6,688 @@ ORG NEWS -- history of user-visible changes. -*- org -*- Copyright (C) 2012-2016 Free Software Foundation, Inc. See the end of the file for license conditions. -Please send Org bug reports to emacs-orgmode@gnu.org. +Please send Org bug reports to mailto:emacs-orgmode@gnu.org. + +* Version 9.0 + +** Incompatible changes + +*** Emacs 23 support has been dropped + +From now on, Org expects at least Emacs 24.3, although Emacs 24.4 or +above is suggested. + +*** XEmacs support has been dropped + +Incomplete compatibility layer with XEmacs has been removed. If you +want to take over maintainance of this compatibility, please contact +our mailing list. + +*** New syntax for export blocks + +Export blocks are explicitly marked as such at the syntax level to +disambiguate their parsing from special blocks. The new syntax is + +#+BEGIN_SRC org +,#+BEGIN_EXPORT backend +... +,#+END_EXPORT +#+END_SRC + +instead of + +#+BEGIN_SRC org +,#+BEGIN_backend +... +,#+END_backend +#+END_SRC + +As a consequence, =INCLUDE= keywords syntax is modified, e.g., + +#+BEGIN_SRC org +,#+INCLUDE: "file.org" HTML +#+END_SRC + +becomes + +#+BEGIN_SRC org +,#+INCLUDE: "file.org" export html +#+END_SRC + +The following function repairs export blocks and =INCLUDE= keywords +using previous syntax: + +#+BEGIN_SRC emacs-lisp +(defun org-repair-export-blocks () + "Repair export blocks and INCLUDE keywords in current buffer." + (interactive) + (when (eq major-mode 'org-mode) + (let ((case-fold-search t) + (back-end-re (regexp-opt + '("HTML" "ASCII" "LATEX" "ODT" "MARKDOWN" "MD" "ORG" + "MAN" "BEAMER" "TEXINFO" "GROFF" "KOMA-LETTER") + t))) + (org-with-wide-buffer + (goto-char (point-min)) + (let ((block-re (concat "^[ \t]*#\\+BEGIN_" back-end-re))) + (save-excursion + (while (re-search-forward block-re nil t) + (let ((element (save-match-data (org-element-at-point)))) + (when (eq (org-element-type element) 'special-block) + (save-excursion + (goto-char (org-element-property :end element)) + (save-match-data (search-backward "_")) + (forward-char) + (insert "EXPORT") + (delete-region (point) (line-end-position))) + (replace-match "EXPORT \\1" nil nil nil 1)))))) + (let ((include-re + (format "^[ \t]*#\\+INCLUDE: .*?%s[ \t]*$" back-end-re))) + (while (re-search-forward include-re nil t) + (let ((element (save-match-data (org-element-at-point)))) + (when (and (eq (org-element-type element) 'keyword) + (string= (org-element-property :key element) "INCLUDE")) + (replace-match "EXPORT \\1" nil nil nil 1))))))))) +#+END_SRC + +Moreover, ~:export-block~ keyword used in ~org-export-define-backend~ and +~org-export-define-derived-backend~ is no longer used and needs to be +removed. + +*** Footnotes + +**** [1]-like constructs are not valid footnotes + +Using =[1]= as a footnote was already discouraged in the manual, since +it introduced too many false-positives in many Org documents. These +constructs are now unsupported. + +If you used =[N]= in some of your documents, consider turning them into +=[fn:N]=. + +**** /Org Footnote/ library doesn't handle non-Org buffers + +Commands for footnotes in an Org document no longer try to do +something in non-Org ones. If you need to have footnotes there, +consider using the =footnote.el= library, shipped with Emacs. + +In particular, ~org-footnote-tag-for-non-org-mode-files~ no longer +exists. + +*** ~org-file-apps~ no longer accepts S-expressions as commands + +The variable now accepts functions of two arguments instead of plain +S-expressions. Replacing a S-expresion with an appropriate function +is straightforward. For example + +: ("pdf" . (foo)) + +becomes + +: ("pdf" . (lambda (file link) (foo))) + +*** The ~{{{modification-time}}}~ macro can get time via =vc= + +The modification time will be determined via =vc.el= if the second +argument is non-nil. See the manual for details. + +*** Preparation and completion functions in publishing projects change signature + +Preparation and completion functions are now called with an argument, +which is the project property list. It used to be dynamically scoped +through the ~project-plist~ variable. + +*** Old Babel header properties are no longer supported + +Using header arguments as property names is no longer possible. As +such, the following + +#+BEGIN_EXAMPLE +,* Headline +:PROPERTIES: +:exports: code +:var: a=1 b=2 +:var+: c=3 +:END: +#+END_EXAMPLE + +should be written instead + +#+BEGIN_EXAMPLE +,* Headline +:PROPERTIES: +:header-args: :exports code +:header-args: :var a=1 b=2 +:header-args+: :var c=3 +:END: +#+END_EXAMPLE + +Please note that, however, old properties were defined at the source +block definition. Current ones are defined where the block is called. + +** New features + +*** ~org-eww~ has been moved into core +*** New org-protocol key=value syntax + +Org-protocol can now handle query-style parameters such as: + +#+begin_example +org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title +org-protocol://capture?template=x&title=Hello&body=World&url=http:%2F%2Fexample.com +#+end_example + +Old-style links such as +: org-protocol://store-link:/http:%2F%2Flocalhost%2Findex.html/The%20title +continue to be supported. + +If you have defined your own handler functions for +~org-protocol-protocol-alist~, change them to accept either a property +list (for new-style links) or a string (for old-style links). Use +~org-protocol-parse-parameters~ to convert old-style links into property +lists. + +*** New Org linter library + +~org-lint~ can check syntax and report common issues in Org documents. + +*** New option ~date-tree-last~ for ~org-agenda-insert-diary-strategy~ + +When ~org-agenda-insert-diary-strategy~ is set to ~date-tree-last~, diary +entries are added to last in the date tree. + +*** New ~vbar~ entity + +~\vbar~ or ~\vbar{}~ will be exported unconditionnally as a =|=, +unlike to existing ~\vert~, which is expanded as ~|~ when using +a HTML derived export back-end. + +*** Export + +**** New =#+latex_compiler= keyword to set LaTeX compiler. + +PDFLaTeX, XeLaTeX, and LuaLaTeX are supported. See the manual for +details. + +**** New option ~org-export-with-broken-links~ + +This option tells the export process how to behave when encountering +a broken internal link. See its docstring for more information. + +**** Attributes support in custom language environments for LaTeX export + +Custom language environments for LaTeX export can now define the +string to be inserted during export, using attributes to indicate the +position of the elements. See variable ~org-latex-custom-lang-environments~ +for more details. + +**** New Texinfo ~options~ attribute on special blocks + +Using ~:options~ as a Texinfo attribute, it is possible to add +information to custom environments. See manual for details. + +**** New HTML ~id~ attributes on special, example and quote blocks + +If the block has a =#+NAME:= attribute assigned, then the HTML element +will have an ~id~ attribute with that name in the HTML export. This +enables one to create links to these elements in other places, e.g., +~<a href="#name">text</a>~. + +**** Listings with captions are now numbered in HTML export + +The class associated to the numbering is "listing-number". If you +don't want these blocks to be numbered, as it was the case until now, +You may want to add ~.listing-number { display: none; }~ to the CSS +used. + +**** Line Numbering in SRC/EXAMPLE blocks support arbitrary start number + +The ~-n~ option to ~SRC~ and ~EXAMPLE~ blocks can now take a numeric +argument to specify the staring line number for the source or example +block. The ~+n~ option can now take a numeric argument that will be +added to the last line number from the previous block as the starting +point for the SRC/EXAMPLE block. + +#+BEGIN_SRC org +,#+BEGIN_SRC emacs-lisp -n 20 +;; this will export with line number 20 +(message "This is line 21") +,#+END_SRC +,#+BEGIN_SRC emacs-lisp +n 10 +;; This will be listed as line 31 +(message "This is line 32") +,#+END_SRC +#+END_SRC + +**** Allow toggling center for images in LaTeX export + +With the global variable ~org-latex-images-centered~ or the local +attribute ~:center~ it is now possible to center an image in LaTeX +export. + +**** Default CSS class ~org-svg~ for SVG images in HTML export + +SVG images exported in HTML are now by default assigned a CSS class +~org-svg~ if no CSS class is specified with the ~:class~ attribute. By +default, the CSS styling of class ~org-svg~ specifies an image width of +90\thinsp{}% of the container the image. + +**** Markdown footnote export customization + +Variables ~org-md-footnotes-section~ and ~org-md-footnote-format~ +introduced for =ox-md.el=. Both new variables define template strings +which can be used to customize the format of the exported footnotes +section and individual footnotes, respectively. + +*** Babel + +**** Blocks with coderefs labels can now be evaluated + +The labels are removed prior to evaluating the block. + +**** Support for Lua language +**** Support for SLY in Lisp blocks + +See ~org-babel-lisp-eval-fn~ to activate it. + +**** Support for Stan language + +New ob-stan.el library. + +Evaluating a Stan block can produce two different results. + +1. Dump the source code contents to a file. + + This file can then be used as a variable in other blocks, which + allows interfaces like RStan to use the model. + +2. Compile the contents to a model file. + + This provides access to the CmdStan interface. To use this, set + ~org-babel-stan-cmdstan-directory~ and provide a ~:file~ argument + that does not end in ".stan". + +For more information and usage examples, visit +http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html + +**** Support for Oracle databases via ~sqlplus~ + +=ob-sql= library supports running SQL blocks against an Oracle +database using ~sqlplus~. Use with properties like this (all +mandatory): + +#+BEGIN_EXAMPLE +:engine oracle +:dbhost <host.com> +:dbport <1521> +:dbuser <username> +:database <database> +:dbpassword <secret> +#+END_EXAMPLE + +**** Improved support to Microsoft SQL Server via ~sqlcmd~ + +=ob-sql= library removes support to the ~msosql~ engine which uses the +deprecated ~osql~ command line tool, and replaces it with ~mssql~ +engine which uses the ~sqlcmd~ command line tool. Use with properties +like this: + +#+BEGIN_EXAMPLE +:engine mssql +:dbhost <host.com> +:dbuser <username> +:dbpassword <secret> +:database <database> +#+END_EXAMPLE + +If you want to use the *trusted connection* feature, omit *both* the +=dbuser= and =dbpassword= properties and add =cmdline -E= to the properties. + +If your Emacs is running in a Cygwin environment, the =ob-sql= library +can pass the converted path to the =sqlcmd= tool. + +**** Improved support of header arguments for postgresql + +The postgresql engine in a sql code block supports now ~:dbport~ nd +~:dbpassword~ as header arguments. + +**** Support for additional plantuml output formats + +The support for output formats of [[http://plantuml.com/][plantuml]] has been extended to now +include: + +All Diagrams: +- png :: +- svg :: +- eps :: +- pdf :: +- vdx :: +- txt :: ASCII art +- utxt :: ASCII art using unicode characters + +Class Diagrams: +- xmi :: +- html :: + +State Diagrams: +- scxml :: + +The output formats are determined by the file extension specified +using the :file property, e.g.: + +#+begin_src plantuml :file diagram.png +@startuml +Alice -> Bob: Authentication Request +Bob --> Alice: Authentication Response + +Alice -> Bob: Another authentication Request +Alice <-- Bob: another authentication Response +@enduml +#+end_src + +Please note that *pdf* *does not work out of the box* and needs additional +setup in addition to plantuml. See [[http://plantuml.com/pdf.html]] for +details and setup information. + +*** Rewrite of radio lists + +Radio lists, i.e, Org plain lists in foreign buffers, have been +rewritten to be on par with Radio tables. You can use a large set of +parameters to control how a given list should be rendered. See manual +for details. + +*** org-bbdb-anniversaries-future + +Used like ~org-bbdb-anniversaries~, it provides a few days warning for +upcoming anniversaries (default: 7 days). + +*** Clear non-repeated SCHEDULED upon repeating a task + +If the task is repeated, and therefore done at least one, scheduling +information is no longer relevant. It is therefore removed. + +See [[git:481719fbd5751aaa9c672b762cb43aea8ee986b0][commit message]] for more information. + +*** Support for ISO week trees + +ISO week trees are an alternative date tree format that orders entries +by ISO week and not by month. + +For example: + +: * 2015 +: ** 2015-W35 +: ** 2015-W36 +: *** 2015-08-31 Monday + +They are supported in org-capture via ~file+weektree~ and +~file+weektree+prompt~ target specifications. + +*** Accept ~:indent~ parameter when capturing column view + +When defining a "columnview" dynamic block, it is now possible to add +an :indent parameter, much like the one in the clock table. + +On the other hand, stars no longer appear in an ITEM field. + +*** Columns view + +**** ~org-columns~ accepts a prefix argument + +When called with a prefix argument, ~org-columns~ apply to the whole +buffer unconditionally. + +**** New variable : ~org-agenda-view-columns-initially~ + +The variable used to be a ~defvar~, it is now a ~defcustom~. + +**** Allow custom summaries + +It is now possible to add new summary types, or override those +provided by Org by customizing ~org-columns-summary-types~, which see. + +**** Allow multiple summaries for any property + +Columns can now summarize the same property using different summary +types. + +*** Preview LaTeX snippets in buffers not visiting files +*** New option ~org-attach-commit~ + +When non-nil, commit attachments with git, assuming the document is in +a git repository. + +*** Allow conditional case-fold searches in ~org-occur~ + +When set to ~smart~, the new variable ~org-occur-case-fold-search~ allows +to mimic =isearch.el=: if the regexp searched contains any upper case +character (or character class), the search is case sensitive. +Otherwise, it is case insensitive. + +*** More robust repeated =ox-latex= footnote handling + +Repeated footnotes are now numbered by referring to a label in the +first footnote. + +*** The ~org-block~ face is inherited by ~src-blocks~ + +This works also when =org-src-fontify-natively= is non-nil. It is also +possible to specify per-languages faces. See =org-src-block-faces= and +the manual for details. + +*** Links are now customizable + +Links can now have custom colors, tooltips, keymaps, display behavior, +etc. Links are now centralized in ~org-link-parameters~. + +** New functions + +*** ~org-next-line-empty-p~ + +It replaces the deprecated ~next~ argument to ~org-previous-line-empty-p~. + +*** ~org-show-children~ + +It is a faster implementation of ~outline-show-children~. + +** Removed functions + +*** ~org-agenda-filter-by-tag-refine~ has been removed. + +Use ~org-agenda-filter-by-tag~ instead. + +*** ~org-agenda-todayp~ is deprecated. + +Use ~org-agenda-today-p~ instead. + +*** ~org-babel-get-header~ is removed. + +Use ~org-babel--get-vars~ or ~assq~ instead, as applicable. + +*** ~org-babel-trim~ is deprecated. + +Use ~org-trim~ instead. + +*** ~org-element-remove-indentation~ is deprecated. + +Use ~org-remove-indentation~ instead. + +*** ~org-image-file-name-regexp~ is deprecated + +Use ~image-file-name-regexp~ instead. +The never-used-in-core ~extensions~ argument has been dropped. + +*** ~org-list-parse-list~ is deprecated + +Use ~org-list-to-lisp~ instead. + +*** ~org-on-heading-p~ is deprecated + +A comment to this effect was in the source code since 7.8.03, but +now a byte-compiler warning will be generated as well. + +*** ~org-table-p~ is deprecated + +Use ~org-at-table-p~ instead. + +*** ~org-table-recognize-table.el~ is deprecated + +It was not called by any org code since 2010. + +*** Various reimplementations of cl-lib functions are deprecated + +The affected functions are: +- ~org-count~ +- ~org-remove-if~ +- ~org-remove-if-not~ +- ~org-reduce~ +- ~org-every~ +- ~org-some~ + +Additionally, ~org-sublist~ is deprecated in favor of ~cl-subseq~. Note +the differences in indexing conventions: ~org-sublist~ is 1-based and +end-inclusive; ~cl-subseq~ is 0-based and end-exclusive. + +** Removed options + +*** Remove all options related to ~ido~ or ~iswitchb~ + +This includes ~org-completion-use-iswitchb~ and ~org-completion-use-ido~. +Instead Org uses regular functions, e.g., ~completion-read~ so as to +let those libraries operate. + +*** Remove ~org-list-empty-line-terminates-plain-lists~ + +Two consecutive blank lines always terminate all levels of current +plain list. + +*** ~fixltx2e~ is removed from ~org-latex-default-packages-alist~ + +fixltx2e is obsolete, see LaTeX News 22. + +** Miscellaneous +*** Add Icelandic smart quotes +*** Allow multiple receiver locations in radio tables and lists +*** Allow angular links within link descriptions + +It is now allowed to write, e.g., +~[[http:orgmode.org][<file:unicorn.png>]]~ as an equivalent to +~[[http:orgmode.org][file:unicorn.png]]~. The advantage of the former +is that spaces are allowed within the path. + +*** Beamer export back-ends uses ~org-latex-prefer-user-labels~ +*** ~:preparation-function~ called earlier during publishing + +Functions in this list are called before any file is associated to the +current projet. Thus, they can be used to generate to be published +Org files. + +*** Function ~org-remove-indentation~ changes. + +The new algorithm doesn't remove TAB characters not used for +indentation. + +*** Secure placeholders in capture templates + +Placeholders in capture templates are no longer expanded recursively. +However, ~%(...)~ constructs are expanded very late, so you can fill +the contents of the S-exp with the replacement text of non-interactive +placeholders. As before, interactive ones are still expanded as the +very last step, so the previous statement doesn't apply to them. + +Note that only ~%(...)~ placeholders initially present in the +template, or introduced using a file placeholder, i.e., ~%[...]~ are +expanded. This prevents evaluating potentially malicious code when +another placeholder, e.g., ~%i~ expands to a S-exp. + +*** Links stored by ~org-gnus-store-link~ in nnir groups + +Since gnus nnir groups are temporary, ~org-gnus-store-link~ now refers +to the article's original group. + +*** ~org-babel-check-confirm-evaluate~ is now a function instead of a macro + +The calling convention has changed. + +*** HTML export table row customization changes + +Variable ~org-html-table-row-tags~ has been split into +~org-html-table-row-open-tag~ and ~org-html-table-row-close-tag~. +Both new variables can be either a string or a function which will be +called with 6 parameters. + +*** =ITEM= special property returns headline without stars +*** Rename ~org-insert-columns-dblock~ into ~org-columns-insert-dblock~ + +The previous name is, for the time being, kept as an obsolete alias. + +*** ~org-trim~ can preserve leading indentation. + +When setting a new optional argument to a non-nil value, ~org-trim~ +preserves leading indentation while removing blank lines at the +beginning of the string. The behavior is identical for white space at +the end of the string. + +*** Function ~org-info-export~ changes. + +HTML links created from certain info links now point to =gnu.org= URL's rather +than just to local files. For example info links such as =info:emacs#List +Buffers= used to be converted to HTML links like this: + +: <a href="emacs.html#List-Buffers">emacs#List Buffers</a> + +where local file =emacs.html= is referenced. +For most folks this file does not exist. +Thus the new behavior is to generate this HTML link instead: + +: <a href="http://www.gnu.org/software/emacs/manual/html_mono/emacs.html#List-Buffers">emacs#List Buffers</a> + +All emacs related info links are similarly translated plus few other +=gnu.org= manuals. + +*** Repeaters with a ~++~ interval and a time can be shifted to later today + +Previously, if a recurring task had a timestamp of +~<2016-01-01 Fri 20:00 ++1d>~ and was completed on =2016-01-02= at +=08:00=, the task would skip =2016-01-02= and would be rescheduled for +=2016-01-03=. Timestamps with ~++~ cookies and a specific time will +now shift to the first possible future occurrence, even if the +occurrence is later the same day the task is completed. (Timestamps +already in the future are still shifted one time further into the +future.) + +*** ~org-mobile-action-alist~ is now a defconst + +It used to be a defcustom, with a warning that it shouldn't be +modified anyway. + +*** ~file+emacs~ and ~file+sys~ link types are deprecated + +They are still supported in Org 9.0 but will eventually be removed in +a later release. Use ~file~ link type along with universal arguments +to force opening it in either Emacs or with system application. + +*** New defcustom ~org-babel-J-command~ stores the j command +*** New defalias ~org-babel-execute:j~ + +Allows J source blocks be indicated by letter j. Previously the +indication letter was solely J. + +*** ~org-open-line~ ignores tables at the very beginning of the buffer + +When ~org-special-ctrl-o~ is non-nil, it is impractical to create +a blank line above a table at the beginning of the document. Now, as +a special case, ~org-open-line~ behaves normally in this situation. + +*** ~org-babel-hash-show-time~ is now customizable + +The experimental variable used to be more or less confidential, as +a ~defvar~. + +*** New ~:format~ property to parsed links + +It defines the format of the original link. Possible values are: +~plain~, ~bracket~ and ~angle~. * Version 8.3 @@ -102,10 +783,10 @@ buffer name, as the title. Instead, simply ignore the title. *** Default bindings of =C-c C-n= and =C-c C-p= changed The key sequences =C-c C-n= and =C-c C-p= are now bound to -~org-next-visible-heading~ and ~org-next-visible-heading~ respectively, -rather than the =outline-mode= versions of these functions. The Org -version of these functions skips over inline tasks (and even-level -headlines when ~org-odd-levels-only~ is set). +~org-next-visible-heading~ and ~org-previous-visible-heading~ +respectively, rather than the =outline-mode= versions of these +functions. The Org version of these functions skips over inline tasks +(and even-level headlines when ~org-odd-levels-only~ is set). *** ~org-element-context~ no longer return objects in keywords @@ -129,19 +810,36 @@ docstring for more information. - ~org-latex-format-headline-function~ - ~org-latex-format-inlinetask-function~ - ~org-link-search~ + ** New features +*** Default lexical evaluation of emacs-lisp src blocks + +Emacs-lisp src blocks in babel are now evaluated using lexical +scoping. There is a new header to control this behavior. + +The default results in an eval with lexical scoping. +:lexical yes + +This turns lexical scoping off in the eval (the former behavior). +:lexical no + +This uses the lexical environment with x=42 in the eval. +:lexical '((x . 42)) + *** Behavior of ~org-return~ changed If point is before or after the headline title, insert a new line without changing the headline. *** Hierarchies of tags + The functionality of nesting tags in hierarchies is added to org-mode. This is the generalization of what was previously called "Tag groups" in the manual. That term is now changed to "Tag hierarchy". The following in-buffer definition: + #+BEGIN_SRC org ,#+TAGS: [ Group : SubOne SubTwo ] ,#+TAGS: [ SubOne : SubOne1 SubOne2 ] @@ -149,6 +847,7 @@ The following in-buffer definition: #+END_SRC Should be seen as the following tree of tags: + - Group - SubOne - SubOne1 @@ -163,25 +862,27 @@ on SubOne filters also it's sub-tags. Etc. There is no limit on the depth for the tag hierarchy. *** Additional syntax for non-unique grouptags + Additional syntax is defined for grouptags if the tags in the group don't have to be distinct on a heading. Grouptags had to previously be defined with { }. This syntax is already used for exclusive tags and Grouptags need their own, -non-exclusive syntax. This behaviour is achieved with [ ]. Note: { -} can still be used also for Grouptags but then only one of the -given tags can be used on the headline at the same time. Example: +non-exclusive syntax. This behaviour is achieved with [ ]. Note: { } +can still be used also for Grouptags but then only one of the given +tags can be used on the headline at the same time. Example: [ group : sub1 sub2 ] #+BEGIN_SRC org - ,* Test :sub1:sub2: +,* Test :sub1:sub2: #+END_SRC This is a more general case than the already existing syntax for grouptags; { }. *** Define regular expression patterns as tags + Tags can be defined as grouptags with regular expressions as "sub-tags". @@ -191,13 +892,13 @@ Example use: : #+TAGS: [ Project : {P@.+} ] Searching for the tag Project will now list all tags also including -regular expression matches for P@.+. Good for example if tags for a -certain project is tagged with a common project-identifier, -i.e. P@2014_OrgTags. +regular expression matches for P@.+. This is good for example for +projects tagged with a common identifier, i.e. P@2014_OrgTags. *** Filtering in the agenda on grouptags (Tag hierarchies) -Filtering in the agenda on grouptags filter all of the related tags. -Exception if filter is applied with a (double) prefix-argument. + +Filtering in the agenda on grouptags filters all of the related tags. +Except if a filter is applied with a (double) prefix-argument. Filtering in the agenda on subcategories does not filter the "above" levels anymore. @@ -206,9 +907,10 @@ If a grouptag contains a regular expression the regular expression is also used as a filter. *** Minor refactoring of ~org-agenda-filter-by-tag~ -Now uses the argument arg and optional argument exclude instead of + +Now uses the argument ARG and optional argument exclude instead of strip and narrow. ARG because the argument has multiple purposes and -makes more sense than strip now. The term narrowing is changed to +makes more sense than strip now. The term "narrowing" is changed to exclude. The main purpose is for the function to make more logical sense when @@ -226,16 +928,17 @@ This library implements necessary functions for implementing editing of Processing code blocks, viewing the resulting sketches in an external viewer, and HTML export of the sketches. -Check the documentation for more. +Check the documentation for more details. Thanks to Jarmo Hurri for this feature. -*** New behaviour for `org-toggle-latex-fragment' +*** New behaviour for ~org-toggle-latex-fragment~ + The new behaviour is the following: -- With a double prefix argument or with a single prefix argument - when point is before the first headline, toggle overlays in the - whole buffer; +- With a double prefix argument or with a single prefix argument when + point is before the first headline, toggle overlays in the whole + buffer; - With a single prefix argument, toggle overlays in the current subtree; @@ -277,18 +980,18 @@ default is =hline=. *** Markdown export supports switches in source blocks -For example, it is now possible to number lines using the =-n= switch -in a source block. +For example, it is now possible to number lines using the =-n= switch in +a source block. *** New option in ASCII export -Plain lists can have an extra margin by setting -~org-ascii-list-margin~ variable to an appopriate integer. +Plain lists can have an extra margin by setting ~org-ascii-list-margin~ +variable to an appopriate integer. *** New blocks in ASCII export -ASCII export now supports =#+BEGIN_JUSTIFYRIGHT= and -=#+BEGIN_JUSTIFYLEFT= blocks. See documentation for details. +ASCII export now supports =#+BEGIN_JUSTIFYRIGHT= and =#+BEGIN_JUSTIFYLEFT= +blocks. See documentation for details. *** More back-end specific publishing options @@ -334,23 +1037,23 @@ will be exported using =@samp(myverbatim)= instead of =@samp(verbatim)=. Radio tables feature now relies on Org's export framework ("ox.el"). ~:no-escape~ parameter no longer exists, but additional global -parameters are now supported: ~:raw~, ~:backend~. Moreover, there are -new parameters specific to some pre-defined translators, e.g., +parameters are now supported: ~:raw~, ~:backend~. Moreover, there are new +parameters specific to some pre-defined translators, e.g., ~:environment~ and ~:booktabs~ for ~orgtbl-to-latex~. See translators docstrings (including ~orgtbl-to-generic~) for details. *** Non-floating minted listings in Latex export -It is not possible to specify =#+attr_latex: :float nil= in conjunction with -source blocks exported by the minted package. +It is not possible to specify =#+attr_latex: :float nil= in conjunction +with source blocks exported by the minted package. *** Field formulas can now create columns as needed Previously, evaluating formulas that referenced out-of-bounds columns -would throw an error. A new variable -~org-table-formula-create-columns~ was added to adjust this -behavior. It is now possible to silently add new columns, to do so -with a warning or to explicitly ask the user each time. +would throw an error. A new variable ~org-table-formula-create-columns~ +was added to adjust this behavior. It is now possible to silently add +new columns, to do so with a warning or to explicitly ask the user +each time. *** ASCII plot @@ -368,13 +1071,13 @@ When non-nil, attachments from archived subtrees are removed. *** New option: ~org-latex-caption-above~ -This variable generalizes ~org-latex-table-caption-above~, which is -now deprecated. In addition to tables, it applies to source blocks, +This variable generalizes ~org-latex-table-caption-above~, which is now +deprecated. In addition to tables, it applies to source blocks, special blocks and images. See docstring for more information. *** New option: ~org-latex-prefer-user-labels~ -See docstring for more information. +See the docstring for more information. *** Export unnumbered headlines @@ -385,13 +1088,13 @@ property is inherited by children. *** Tables can be sorted with an arbitrary function It is now possible to specify a function, both programatically, -through a new optional argument, and interactively with ~f~ or ~F~ -keys, to sort a table. +through a new optional argument, and interactively with ~f~ or ~F~ keys, +to sort a table. *** Table of contents can be local to a section -The ~TOC~ keywords now accepts an optional ~local~ parameter. See -manual for details. +The ~TOC~ keywords now accepts an optional ~local~ parameter. See manual +for details. *** Countdown timers can now be paused @@ -454,8 +1157,8 @@ for details. *** Remotely edit a footnote definition Calling ~org-edit-footnote-reference~ (C-c ') on a footnote reference -allows to edit its definition, as long as it is not anonymous, in -a dedicated buffer. It works even if buffer is currently narrowed. +allows to edit its definition, as long as it is not anonymous, in a +dedicated buffer. It works even if buffer is currently narrowed. *** New function ~org-delete-indentation~ bound to ~M-^~ @@ -464,7 +1167,7 @@ added to headline text. *** Support for images in Texinfo export -~Texinfo~ back-end now handles images. See manual for details. +~Texinfo~ back-end now handles images. See the manual for details. *** Support for captions in Texinfo export @@ -479,9 +1182,9 @@ set using the hh:mm:ss format. *** Extend ~org-clone-subtree-with-time-shift~ -~org-clone-subtree-with-time-shift~ now accepts 0 as an argument for -the number of clones, which removes the repeater from the original -subtree and creates one shifted, repeating clone. +~org-clone-subtree-with-time-shift~ now accepts 0 as an argument for the +number of clones, which removes the repeater from the original subtree +and creates one shifted, repeating clone. *** New time block for clock tables: ~untilnow~ @@ -527,6 +1230,7 @@ optional argument. These functions were left-over from pre 8.0 era. They are not correct anymore. Since they are not needed, they have no replacement. + ** Removed options *** ~org-list-empty-line-terminates-plain-lists~ is deprecated @@ -550,11 +1254,11 @@ everywhere in the buffer, possibly corrupting URLs. *** Removed option =org-babel-sh-command= -This undocumented option defaulted to the value of =shell-file-name= -at the time of loading =ob-shell=. The new behaviour is to use the -value of =shell-file-name= directly when the shell langage is =shell=. -To chose a different shell, either customize =shell-file-name= or bind -this variable locally. +This undocumented option defaulted to the value of =shell-file-name= at +the time of loading =ob-shell=. The new behaviour is to use the value +of =shell-file-name= directly when the shell langage is =shell=. To chose +a different shell, either customize =shell-file-name= or bind this +variable locally. *** Removed option =org-babel-sh-var-quote-fmt= @@ -594,6 +1298,7 @@ end-users browser. You may force initial usage of MathML via ~org-export-filter-comment-functions~ and ~org-export-filter-comment-block-functions~ variables do not exist anymore. + ** Miscellaneous *** Strip all meta data from ITEM special property @@ -630,9 +1335,9 @@ particular test failure was introduced. *** Exact heading search for external links ignore spaces and cookies Exact heading search for links now ignore spaces and cookies. This is -the case for links of the form ~file:projects.org::*task title~, as -well as links of the form ~file:projects.org::some words~ -when ~org-link-search-must-match-exact-headline~ is not nil. +the case for links of the form ~file:projects.org::*task title~, as well +as links of the form ~file:projects.org::some words~ when +~org-link-search-must-match-exact-headline~ is not nil. *** ~org-latex-hyperref-template~, ~org-latex-title-command~ formatting @@ -642,12 +1347,12 @@ Note, ~org-latex-hyperref-template~ has a new default value. *** ~float, wasysym, marvosym~ are removed from ~org-latex-default-packages-alist~ If you require any of these package add them to your preamble via -~org-latex-packages-alist~. Org also uses default LaTeX ~\tolerance~ -now. +~org-latex-packages-alist~. Org also uses default LaTeX ~\tolerance~ now. *** When exporting, throw an error on unresolved id/fuzzy links and code refs This helps spotting wrong links. + * Version 8.2 ** Incompatible changes diff --git a/lisp/ob-C.el b/lisp/ob-C.el index a6d4d5e..0bd911e 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -1,4 +1,4 @@ -;;; ob-C.el --- org-babel functions for C and similar languages +;;; ob-C.el --- Babel Functions for C and Similar Languages -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -31,12 +31,14 @@ ;; - not much in the way of error feedback ;;; Code: -(require 'ob) + (require 'cc-mode) +(require 'ob) + -(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-remove-indentation "org" (code &optional n)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp")) @@ -120,39 +122,47 @@ header arguments." or `org-babel-execute:C++' or `org-babel-execute:D'." (let* ((tmp-src-file (org-babel-temp-file "C-src-" - (case org-babel-c-variant - (c ".c" ) - (cpp ".cpp") - (d ".d" )))) - (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext)) ;; not used for D - (cmdline (cdr (assoc :cmdline params))) + (pcase org-babel-c-variant + (`c ".c") (`cpp ".cpp") (`d ".d")))) + (tmp-bin-file ;not used for D + (org-babel-temp-file "C-bin-" org-babel-exeext)) + (cmdline (cdr (assq :cmdline params))) (cmdline (if cmdline (concat " " cmdline) "")) - (flags (cdr (assoc :flags params))) + (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)) + " ")) (full-body - (case org-babel-c-variant - (c (org-babel-C-expand-C body params)) - (cpp (org-babel-C-expand-C++ body params)) - (d (org-babel-C-expand-D body params))))) + (pcase org-babel-c-variant + (`c (org-babel-C-expand-C body params)) + (`cpp (org-babel-C-expand-C++ body params)) + (`d (org-babel-C-expand-D body params))))) (with-temp-file tmp-src-file (insert full-body)) - (case org-babel-c-variant - ((c cpp) + (pcase org-babel-c-variant + ((or `c `cpp) (org-babel-eval - (format "%s -o %s %s %s" - (case org-babel-c-variant - (c org-babel-C-compiler) - (cpp org-babel-C++-compiler)) + (format "%s -o %s %s %s %s" + (pcase org-babel-c-variant + (`c org-babel-C-compiler) + (`cpp org-babel-C++-compiler)) (org-babel-process-file-name tmp-bin-file) flags - (org-babel-process-file-name tmp-src-file)) "")) - (d nil)) ;; no separate compilation for D + (org-babel-process-file-name tmp-src-file) + libs) + "")) + (`d nil)) ;; no separate compilation for D (let ((results (org-babel-eval - (case org-babel-c-variant - ((c cpp) + (pcase org-babel-c-variant + ((or `c `cpp) (concat tmp-bin-file cmdline)) - (d + (`d (format "%s %s %s %s" org-babel-D-compiler flags @@ -160,17 +170,17 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." cmdline))) ""))) (when results - (setq results (org-babel-trim (org-remove-indentation results))) + (setq results (org-trim (org-remove-indentation results))) (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-result-cond (cdr (assq :result-params params)) (org-babel-read results t) (let ((tmp-file (org-babel-temp-file "c-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file))) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))) ))) (defun org-babel-C-expand-C++ (body params) @@ -181,15 +191,15 @@ its header arguments." (defun org-babel-C-expand-C (body params) "Expand a block of C or C++ code with org-babel according to its header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (colnames (cdar (org-babel-get-header params :colname-names))) - (main-p (not (string= (cdr (assoc :main params)) "no"))) + (let ((vars (org-babel--get-vars params)) + (colnames (cdr (assq :colname-names params))) + (main-p (not (string= (cdr (assq :main params)) "no"))) (includes (org-babel-read - (or (cdr (assoc :includes params)) + (or (cdr (assq :includes params)) (org-entry-get nil "includes" t)) nil)) (defines (org-babel-read - (or (cdr (assoc :defines params)) + (or (cdr (assq :defines params)) (org-entry-get nil "defines" t)) nil))) (when (stringp includes) @@ -230,10 +240,10 @@ its header arguments." (defun org-babel-C-expand-D (body params) "Expand a block of D code with org-babel according to its header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (colnames (cdar (org-babel-get-header params :colname-names))) - (main-p (not (string= (cdr (assoc :main params)) "no"))) - (imports (or (cdr (assoc :imports params)) + (let ((vars (org-babel--get-vars params)) + (colnames (cdr (assq :colname-names params))) + (main-p (not (string= (cdr (assq :main params)) "no"))) + (imports (or (cdr (assq :imports params)) (org-babel-read (org-entry-get nil "imports" t))))) (when (stringp imports) (setq imports (split-string imports))) @@ -265,12 +275,12 @@ its header arguments." body (format "int main() {\n%s\nreturn 0;\n}\n" body))) -(defun org-babel-prep-session:C (session params) +(defun org-babel-prep-session:C (_session _params) "This function does nothing as C is a compiled language with no support for sessions" (error "C is a compiled languages -- no support for sessions")) -(defun org-babel-load-session:C (session body params) +(defun org-babel-load-session:C (_session _body _params) "This function does nothing as C is a compiled language with no support for sessions" (error "C is a compiled languages -- no support for sessions")) @@ -290,14 +300,14 @@ Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type. FORMAT can be either a format string or a function which is called with VAL." (let* ((basetype (org-babel-C-val-to-base-type val)) (type - (case basetype - (integerp '("int" "%d")) - (floatp '("double" "%f")) - (stringp + (pcase basetype + (`integerp '("int" "%d")) + (`floatp '("double" "%f")) + (`stringp (list - (if (equal org-babel-c-variant 'd) "string" "const char*") + (if (eq org-babel-c-variant 'd) "string" "const char*") "\"%s\"")) - (t (error "unknown type %S" basetype))))) + (_ (error "unknown type %S" basetype))))) (cond ((integerp val) type) ;; an integer declared in the #+begin_src line ((floatp val) type) ;; a numeric declared in the #+begin_src line @@ -307,25 +317,25 @@ FORMAT can be either a format string or a function which is called with VAL." (cons (format "[%d][%d]" (length val) (length (car val))) (concat - (if (equal org-babel-c-variant 'd) "[\n" "{\n") + (if (eq org-babel-c-variant 'd) "[\n" "{\n") (mapconcat (lambda (v) (concat - (if (equal org-babel-c-variant 'd) " [" " {") + (if (eq org-babel-c-variant 'd) " [" " {") (mapconcat (lambda (w) (format ,(cadr type) w)) v ",") - (if (equal org-babel-c-variant 'd) "]" "}"))) + (if (eq org-babel-c-variant 'd) "]" "}"))) val ",\n") - (if (equal org-babel-c-variant 'd) "\n]" "\n}")))))) + (if (eq org-babel-c-variant 'd) "\n]" "\n}")))))) ((or (listp val) (vectorp val)) ;; a list declared in the #+begin_src line `(,(car type) (lambda (val) (cons (format "[%d]" (length val)) (concat - (if (equal org-babel-c-variant 'd) "[" "{") + (if (eq org-babel-c-variant 'd) "[" "{") (mapconcat (lambda (v) (format ,(cadr type) v)) val ",") - (if (equal org-babel-c-variant 'd) "]" "}")))))) + (if (eq org-babel-c-variant 'd) "]" "}")))))) (t ;; treat unknown types as string type)))) @@ -340,12 +350,12 @@ FORMAT can be either a format string or a function which is called with VAL." ((or (listp val) (vectorp val)) (let ((type nil)) (mapc (lambda (v) - (case (org-babel-C-val-to-base-type v) - (stringp (setq type 'stringp)) - (floatp + (pcase (org-babel-C-val-to-base-type v) + (`stringp (setq type 'stringp)) + (`floatp (if (or (not type) (eq type 'integerp)) (setq type 'floatp))) - (integerp + (`integerp (unless type (setq type 'integerp))))) val) type)) @@ -387,8 +397,8 @@ of the same value." (defun org-babel-C-utility-header-to-C () "Generate a utility function to convert a column name into a column number." - (case org-babel-c-variant - ((c cpp) + (pcase org-babel-c-variant + ((or `c `cpp) "int get_column_num (int nbcols, const char** header, const char* column) { int c; @@ -397,9 +407,8 @@ into a column number." return c; return -1; } -" - ) - (d +") + (`d "int get_column_num (string[] header, string column) { foreach (c, h; header) @@ -407,8 +416,7 @@ into a column number." return to!int(c); return -1; } -" - ))) +"))) (defun org-babel-C-header-to-C (head) "Convert an elisp list of header table into a C or D vector @@ -417,21 +425,21 @@ specifying a variable with the name of the table." (headers (cdr head))) (concat (format - (case org-babel-c-variant - ((c cpp) "const char* %s_header[%d] = {%s};") - (d "string %s_header[%d] = [%s];")) + (pcase org-babel-c-variant + ((or `c `cpp) "const char* %s_header[%d] = {%s};") + (`d "string %s_header[%d] = [%s];")) table (length headers) (mapconcat (lambda (h) (format "%S" h)) headers ",")) "\n" - (case org-babel-c-variant - ((c cpp) + (pcase org-babel-c-variant + ((or `c `cpp) (format "const char* %s_h (int row, const char* col) { return %s[row][get_column_num(%d,%s_header,col)]; }" table table (length headers) table)) - (d + (`d (format - "string %s_h (ulong row, string col) { return %s[row][get_column_num(%s_header,col)]; }" + "string %s_h (size_t row, string col) { return %s[row][get_column_num(%s_header,col)]; }" table table table)))))) (provide 'ob-C) diff --git a/lisp/ob-J.el b/lisp/ob-J.el index dcdad03..572149b 100644 --- a/lisp/ob-J.el +++ b/lisp/ob-J.el @@ -1,4 +1,4 @@ -;;; ob-J.el --- org-babel functions for J evaluation +;;; ob-J.el --- Babel Functions for J -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -29,12 +29,20 @@ ;; (available in MELPA). ;;; Code: + (require 'ob) -(declare-function org-trim "org" (S)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function j-console-ensure-session "ext:j-console" ()) -(defun org-babel-expand-body:J (body params &optional processed-params) +(defcustom org-babel-J-command "jconsole" + "Command to call J." + :group 'org-babel + :version "25.2" + :package-version '(Org . "9.0") + :type 'string) + +(defun org-babel-expand-body:J (body _params &optional _processed-params) "Expand BODY according to PARAMS, return the expanded body. PROCESSED-PARAMS isn't used yet." (org-babel-J-interleave-echos-except-functions body)) @@ -59,26 +67,25 @@ PROCESSED-PARAMS isn't used yet." (org-babel-J-interleave-echos-except-functions s3))) (org-babel-J-interleave-echos body))) +(defalias 'org-babel-execute:j 'org-babel-execute:J) + (defun org-babel-execute:J (body params) "Execute a block of J code BODY. PARAMS are given by org-babel. This function is called by `org-babel-execute-src-block'" (message "executing J source code block") (let* ((processed-params (org-babel-process-params params)) - (sessionp (cdr (assoc :session params))) - (session (org-babel-j-initiate-session sessionp)) - (vars (nth 2 processed-params)) - (result-params (nth 3 processed-params)) - (result-type (nth 4 processed-params)) + (sessionp (cdr (assq :session params))) (full-body (org-babel-expand-body:J body params processed-params)) (tmp-script-file (org-babel-temp-file "J-src"))) + (org-babel-j-initiate-session sessionp) (org-babel-J-strip-whitespace (if (string= sessionp "none") (progn (with-temp-file tmp-script-file (insert full-body)) - (org-babel-eval (format "jconsole < %s" tmp-script-file) "")) + (org-babel-eval (format "%s < %s" org-babel-J-command tmp-script-file) "")) (org-babel-J-eval-string full-body))))) (defun org-babel-J-eval-string (str) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 4b37c18..2993b09 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -1,4 +1,4 @@ -;;; ob-R.el --- org-babel functions for R code evaluation +;;; ob-R.el --- Babel Functions for R -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -27,8 +27,9 @@ ;; Org-Babel support for evaluating R code ;;; Code: + +(require 'cl-lib) (require 'ob) -(eval-when-compile (require 'cl)) (declare-function orgtbl-to-tsv "org-table" (table params)) (declare-function R "ext:essd-r" (&optional start-args)) @@ -36,10 +37,7 @@ (declare-function ess-make-buffer-current "ext:ess-inf" ()) (declare-function ess-eval-buffer "ext:ess-inf" (vis)) (declare-function ess-wait-for-process "ext:ess-inf" - (proc &optional sec-prompt wait force-redisplay)) -(declare-function org-number-sequence "org-compat" (from &optional to inc)) -(declare-function org-remove-if-not "org" (predicate seq)) -(declare-function org-every "org" (pred seq)) + (&optional proc sec-prompt wait force-redisplay)) (defconst org-babel-header-args:R '((width . :any) @@ -92,9 +90,11 @@ this variable.") (defvar ess-current-process-name) ; dynamically scoped (defvar ess-local-process-name) ; dynamically scoped (defun org-babel-edit-prep:R (info) - (let ((session (cdr (assoc :session (nth 2 info))))) - (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) - (save-match-data (org-babel-R-initiate-session session nil))))) + (let ((session (cdr (assq :session (nth 2 info))))) + (when (and session + (string-prefix-p "*" session) + (string-suffix-p "*" session)) + (org-babel-R-initiate-session session nil)))) ;; The usage of utils::read.table() ensures that the command ;; read.table() can be found even in circumstances when the utils @@ -139,28 +139,28 @@ This function is used when the table contains a header.") This function is used when the table does not contain a header.") -(defun org-babel-expand-body:R (body params &optional graphics-file) +(defun org-babel-expand-body:R (body params &optional _graphics-file) "Expand BODY according to PARAMS, return the expanded body." (mapconcat 'identity (append - (when (cdr (assoc :prologue params)) - (list (cdr (assoc :prologue params)))) + (when (cdr (assq :prologue params)) + (list (cdr (assq :prologue params)))) (org-babel-variable-assignments:R params) (list body) - (when (cdr (assoc :epilogue params)) - (list (cdr (assoc :epilogue params))))) + (when (cdr (assq :epilogue params)) + (list (cdr (assq :epilogue params))))) "\n")) (defun org-babel-execute:R (body params) "Execute a block of R code. This function is called by `org-babel-execute-src-block'." (save-excursion - (let* ((result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (let* ((result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (session (org-babel-R-initiate-session - (cdr (assoc :session params)) params)) - (colnames-p (cdr (assoc :colnames params))) - (rownames-p (cdr (assoc :rownames params))) + (cdr (assq :session params)) params)) + (colnames-p (cdr (assq :colnames params))) + (rownames-p (cdr (assq :rownames params))) (graphics-file (and (member "graphics" (assq :result-params params)) (org-babel-graphical-output-file params))) (full-body @@ -180,10 +180,10 @@ This function is called by `org-babel-execute-src-block'." session full-body result-type result-params (or (equal "yes" colnames-p) (org-babel-pick-name - (cdr (assoc :colname-names params)) colnames-p)) + (cdr (assq :colname-names params)) colnames-p)) (or (equal "yes" rownames-p) (org-babel-pick-name - (cdr (assoc :rowname-names params)) rownames-p))))) + (cdr (assq :rowname-names params)) rownames-p))))) (if graphics-file nil result)))) (defun org-babel-prep-session:R (session params) @@ -209,21 +209,21 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-variable-assignments:R (params) "Return list of R statements assigning the block's variables." - (let ((vars (mapcar 'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapcar (lambda (pair) (org-babel-R-assign-elisp (car pair) (cdr pair) - (equal "yes" (cdr (assoc :colnames params))) - (equal "yes" (cdr (assoc :rownames params))))) + (equal "yes" (cdr (assq :colnames params))) + (equal "yes" (cdr (assq :rownames params))))) (mapcar (lambda (i) (cons (car (nth i vars)) (org-babel-reassemble-table (cdr (nth i vars)) - (cdr (nth i (cdr (assoc :colname-names params)))) - (cdr (nth i (cdr (assoc :rowname-names params))))))) - (org-number-sequence 0 (1- (length vars))))))) + (cdr (nth i (cdr (assq :colname-names params)))) + (cdr (nth i (cdr (assq :rowname-names params))))))) + (number-sequence 0 (1- (length vars))))))) (defun org-babel-R-quote-tsv-field (s) "Quote field S for export to R." @@ -234,7 +234,7 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-R-assign-elisp (name value colnames-p rownames-p) "Construct R code assigning the elisp VALUE to a variable named NAME." (if (listp value) - (let* ((lengths (mapcar 'length (org-remove-if-not 'sequencep value))) + (let* ((lengths (mapcar 'length (cl-remove-if-not 'sequencep value))) (max (if lengths (apply 'max lengths) 0)) (min (if lengths (apply 'min lengths) 0))) ;; Ensure VALUE has an orgtbl structure (depth of at least 2). @@ -262,7 +262,7 @@ This function is called by `org-babel-execute-src-block'." (ess-ask-for-ess-directory (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory - (not (cdr (assoc :dir params)))))) + (not (cdr (assq :dir params)))))) (if (org-babel-comint-buffer-livep session) session (save-window-excursion @@ -316,8 +316,7 @@ Each member of this list is a list with three members: :type :family :title :fonts :version :paper :encoding :pagecentre :colormodel :useDingbats :horizontal)) - (device (and (string-match ".+\\.\\([^.]+\\)" out-file) - (match-string 1 out-file))) + (device (file-name-extension out-file)) (device-info (or (assq (intern (concat ":" device)) org-babel-R-graphics-devices) (assq :png org-babel-R-graphics-devices))) @@ -379,12 +378,12 @@ Has four %s escapes to be filled in: body result-type result-params column-names-p row-names-p))) (defun org-babel-R-evaluate-external-process - (body result-type result-params column-names-p row-names-p) + (body result-type result-params column-names-p row-names-p) "Evaluate BODY in external R process. If RESULT-TYPE equals `output' then return standard output as a string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." - (case result-type + (cl-case result-type (value (let ((tmp-file (org-babel-temp-file "R-"))) (org-babel-eval org-babel-R-command @@ -399,7 +398,7 @@ last statement in BODY, as elisp." (org-babel-result-cond result-params (with-temp-buffer (insert-file-contents tmp-file) - (buffer-string)) + (org-babel-chomp (buffer-string) "\n")) (org-babel-import-elisp-from-file tmp-file '(16))) column-names-p))) (output (org-babel-eval org-babel-R-command body)))) @@ -407,12 +406,12 @@ last statement in BODY, as elisp." (defvar ess-eval-visibly-p) (defun org-babel-R-evaluate-session - (session body result-type result-params column-names-p row-names-p) + (session body result-type result-params column-names-p row-names-p) "Evaluate BODY in SESSION. If RESULT-TYPE equals `output' then return standard output as a string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." - (case result-type + (cl-case result-type (value (with-temp-buffer (insert (org-babel-chomp body)) @@ -433,7 +432,7 @@ last statement in BODY, as elisp." (org-babel-result-cond result-params (with-temp-buffer (insert-file-contents tmp-file) - (buffer-string)) + (org-babel-chomp (buffer-string) "\n")) (org-babel-import-elisp-from-file tmp-file '(16))) column-names-p))) (output @@ -446,7 +445,8 @@ last statement in BODY, as elisp." (mapcar (lambda (line) ;; cleanup extra prompts left in output (if (string-match - "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line) + "^\\([>+.]\\([ ][>.+]\\)*[ ]\\)" + (car (split-string line "\n"))) (substring line (match-end 1)) line)) (org-babel-comint-with-output (session org-babel-R-eoe-output) diff --git a/lisp/ob-abc.el b/lisp/ob-abc.el index 36ad55d..6872b1c 100644 --- a/lisp/ob-abc.el +++ b/lisp/ob-abc.el @@ -1,4 +1,4 @@ -;;; ob-abc.el --- org-babel functions for template evaluation +;;; ob-abc.el --- Org Babel Functions for ABC -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. @@ -42,7 +42,7 @@ (defun org-babel-expand-body:abc (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapc (lambda (pair) (let ((name (symbol-name (car pair))) @@ -59,12 +59,10 @@ "Execute a block of ABC code with org-babel. This function is called by `org-babel-execute-src-block'" (message "executing Abc source code block") - (let* ((result-params (split-string (or (cdr (assoc :results params))))) - (cmdline (cdr (assoc :cmdline params))) - (out-file ((lambda (el) - (or el - (error "abc code block requires :file header argument"))) - (replace-regexp-in-string "\.pdf$" ".ps" (cdr (assoc :file params))))) + (let* ((cmdline (cdr (assq :cmdline params))) + (out-file (let ((file (cdr (assq :file params)))) + (if file (replace-regexp-in-string "\.pdf$" ".ps" file) + (error "abc code block requires :file header argument")))) (in-file (org-babel-temp-file "abc-")) (render (concat "abcm2ps" " " cmdline " -O " (org-babel-process-file-name out-file) @@ -79,14 +77,14 @@ (file-name-extension out-file)) out-file t)) ;;; if we were asked for a pdf... - (when (string= (file-name-extension (cdr (assoc :file params))) "pdf") - (org-babel-eval (concat "ps2pdf" " " out-file " " (cdr (assoc :file params))) "")) + (when (string= (file-name-extension (cdr (assq :file params))) "pdf") + (org-babel-eval (concat "ps2pdf" " " out-file " " (cdr (assq :file params))) "")) ;;; indicate that the file has been written nil)) ;; This function should be used to assign any variables in params in ;; the context of the session environment. -(defun org-babel-prep-session:abc (session params) +(defun org-babel-prep-session:abc (_session _params) "Return an error because abc does not support sessions." (error "ABC does not support sessions")) diff --git a/lisp/ob-asymptote.el b/lisp/ob-asymptote.el index f6492ae..e69afc4 100644 --- a/lisp/ob-asymptote.el +++ b/lisp/ob-asymptote.el @@ -1,4 +1,4 @@ -;;; ob-asymptote.el --- org-babel functions for asymptote evaluation +;;; ob-asymptote.el --- Babel Functions for Asymptote -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -43,7 +43,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy")) @@ -55,13 +54,10 @@ (defun org-babel-execute:asymptote (body params) "Execute a block of Asymptote code. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (cdr (assoc :file params))) - (format (or (and out-file - (string-match ".+\\.\\(.+\\)" out-file) - (match-string 1 out-file)) + (let* ((out-file (cdr (assq :file params))) + (format (or (file-name-extension out-file) "pdf")) - (cmdline (cdr (assoc :cmdline params))) + (cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "asymptote-")) (cmd (concat "asy " @@ -79,7 +75,7 @@ This function is called by `org-babel-execute-src-block'." (message cmd) (shell-command cmd) nil)) ;; signal that output has already been written to file -(defun org-babel-prep-session:asymptote (session params) +(defun org-babel-prep-session:asymptote (_session _params) "Return an error if the :session header argument is set. Asymptote does not support sessions" (error "Asymptote does not support sessions")) @@ -87,7 +83,7 @@ Asymptote does not support sessions" (defun org-babel-variable-assignments:asymptote (params) "Return list of asymptote statements assigning the block's variables." (mapcar #'org-babel-asymptote-var-to-asymptote - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-asymptote-var-to-asymptote (pair) "Convert an elisp value into an Asymptote variable. @@ -124,21 +120,17 @@ a variable of the same value." DATA is a list. Return type as a symbol. -The type is `string' if any element in DATA is -a string. Otherwise, it is either `real', if some elements are -floats, or `int'." - (let* ((type 'int) - find-type ; for byte-compiler - (find-type - (function - (lambda (row) - (catch 'exit - (mapc (lambda (el) - (cond ((listp el) (funcall find-type el)) - ((stringp el) (throw 'exit (setq type 'string))) - ((floatp el) (setq type 'real)))) - row)))))) - (funcall find-type data) type)) +The type is `string' if any element in DATA is a string. +Otherwise, it is either `real', if some elements are floats, or +`int'." + (letrec ((type 'int) + (find-type + (lambda (row) + (dolist (e row type) + (cond ((listp e) (setq type (funcall find-type e))) + ((stringp e) (throw 'exit 'string)) + ((floatp e) (setq type 'real))))))) + (catch 'exit (funcall find-type data)) type)) (provide 'ob-asymptote) diff --git a/lisp/ob-awk.el b/lisp/ob-awk.el index 021dd78..90cfe79 100644 --- a/lisp/ob-awk.el +++ b/lisp/ob-awk.el @@ -1,4 +1,4 @@ -;;; ob-awk.el --- org-babel functions for awk evaluation +;;; ob-awk.el --- Babel Functions for Awk -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -27,13 +27,12 @@ ;; ;; - :in-file takes a path to a file of data to be processed by awk ;; -;; - :stdin takes an Org-mode data or code block reference, the value -;; of which will be passed to the awk process through STDIN +;; - :stdin takes an Org data or code block reference, the value of +;; which will be passed to the awk process through STDIN ;;; Code: (require 'ob) (require 'org-compat) -(eval-when-compile (require 'cl)) (declare-function org-babel-ref-resolve "ob-ref" (ref)) (declare-function orgtbl-to-generic "org-table" (table params)) @@ -44,7 +43,7 @@ (defvar org-babel-awk-command "awk" "Name of the awk executable command.") -(defun org-babel-expand-body:awk (body params) +(defun org-babel-expand-body:awk (body _params) "Expand BODY according to PARAMS, return the expanded body." body) @@ -52,13 +51,13 @@ "Execute a block of Awk code with org-babel. This function is called by `org-babel-execute-src-block'" (message "executing Awk source code block") - (let* ((result-params (cdr (assoc :result-params params))) - (cmd-line (cdr (assoc :cmd-line params))) - (in-file (cdr (assoc :in-file params))) + (let* ((result-params (cdr (assq :result-params params))) + (cmd-line (cdr (assq :cmd-line params))) + (in-file (cdr (assq :in-file params))) (full-body (org-babel-expand-body:awk body params)) (code-file (let ((file (org-babel-temp-file "awk-"))) (with-temp-file file (insert full-body)) file)) - (stdin (let ((stdin (cdr (assoc :stdin params)))) + (stdin (let ((stdin (cdr (assq :stdin params)))) (when stdin (let ((tmp (org-babel-temp-file "awk-stdin-")) (res (org-babel-ref-resolve stdin))) @@ -71,10 +70,10 @@ called by `org-babel-execute-src-block'" "-f" code-file cmd-line) (mapcar (lambda (pair) (format "-v %s='%s'" - (cadr pair) + (car pair) (org-babel-awk-var-to-awk - (cddr pair)))) - (org-babel-get-header params :var)) + (cdr pair)))) + (org-babel--get-vars params)) (list in-file)) " "))) (org-babel-reassemble-table @@ -91,9 +90,9 @@ called by `org-babel-execute-src-block'" (with-temp-file tmp (insert results)) (org-babel-import-elisp-from-file tmp))))) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (defun org-babel-awk-var-to-awk (var &optional sep) "Return a printed value of VAR suitable for parsing with awk." diff --git a/lisp/ob-calc.el b/lisp/ob-calc.el index f5e70de..415cab1 100644 --- a/lisp/ob-calc.el +++ b/lisp/ob-calc.el @@ -1,4 +1,4 @@ -;;; ob-calc.el --- org-babel functions for calc code evaluation +;;; ob-calc.el --- Babel Functions for Calc -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -28,18 +28,18 @@ ;;; Code: (require 'ob) (require 'calc) -(unless (featurep 'xemacs) - (require 'calc-trail) - (require 'calc-store)) +(require 'calc-trail) +(require 'calc-store) (declare-function calc-store-into "calc-store" (&optional var)) (declare-function calc-recall "calc-store" (&optional var)) (declare-function math-evaluate-expr "calc-ext" (x)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-default-header-args:calc nil "Default arguments for evaluating an calc source block.") -(defun org-babel-expand-body:calc (body params) +(defun org-babel-expand-body:calc (body _params) "Expand BODY according to PARAMS, return the expanded body." body) (defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc @@ -48,7 +48,7 @@ "Execute a block of calc code with Babel." (unless (get-buffer "*Calculator*") (save-window-excursion (calc) (calc-quit))) - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (let* ((vars (org-babel--get-vars params)) (org--var-syms (mapcar #'car vars)) (var-names (mapcar #'symbol-name org--var-syms))) (mapc @@ -85,15 +85,17 @@ ;; parse line into calc objects (car (math-read-exprs line))))))))) )))))) - (mapcar #'org-babel-trim + (mapcar #'org-trim (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) (save-excursion (with-current-buffer (get-buffer "*Calculator*") - (calc-eval (calc-top 1))))) + (prog1 + (calc-eval (calc-top 1)) + (calc-pop 1))))) (defun org-babel-calc-maybe-resolve-var (el) (if (consp el) - (if (and (equal 'var (car el)) (member (cadr el) org--var-syms)) + (if (and (eq 'var (car el)) (member (cadr el) org--var-syms)) (progn (calc-recall (cadr el)) (prog1 (calc-top 1) diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index 5b023e6..72ea77d 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -1,4 +1,4 @@ -;;; ob-clojure.el --- org-babel functions for clojure evaluation +;;; ob-clojure.el --- Babel Functions for Clojure -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -39,15 +39,15 @@ ;; web page: http://technomancy.us/126 ;;; Code: +(require 'cl-lib) (require 'ob) -(eval-when-compile - (require 'cl)) (declare-function cider-current-connection "ext:cider-client" (&optional type)) (declare-function cider-current-session "ext:cider-client" ()) (declare-function nrepl-dict-get "ext:nrepl-client" (dict key)) (declare-function nrepl-sync-request:eval "ext:nrepl-client" (input connection session &optional ns)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function slime-eval "ext:slime" (sexp &optional package)) (defvar org-babel-tangle-lang-exts) @@ -67,18 +67,17 @@ (defun org-babel-expand-body:clojure (body params) "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) + (let* ((vars (org-babel--get-vars params)) + (result-params (cdr (assq :result-params params))) (print-level nil) (print-length nil) - (body (org-babel-trim - (if (> (length vars) 0) - (concat "(let [" - (mapconcat - (lambda (var) - (format "%S (quote %S)" (car var) (cdr var))) - vars "\n ") - "]\n" body ")") - body)))) + (body (org-trim + (if (null vars) (org-trim body) + (concat "(let [" + (mapconcat + (lambda (var) + (format "%S (quote %S)" (car var) (cdr var))) + vars "\n ") + "]\n" body ")"))))) (if (or (member "code" result-params) (member "pp" result-params)) (format "(clojure.pprint/pprint (do %s))" body) @@ -88,10 +87,10 @@ "Execute a block of Clojure code with Babel." (let ((expanded (org-babel-expand-body:clojure body params)) result) - (case org-babel-clojure-backend + (cl-case org-babel-clojure-backend (cider (require 'cider) - (let ((result-params (cdr (assoc :result-params params)))) + (let ((result-params (cdr (assq :result-params params)))) (setq result (nrepl-dict-get (nrepl-sync-request:eval @@ -108,8 +107,8 @@ (slime-eval `(swank:eval-and-grab-output ,(buffer-substring-no-properties (point-min) (point-max))) - (cdr (assoc :package params))))))) - (org-babel-result-cond (cdr (assoc :result-params params)) + (cdr (assq :package params))))))) + (org-babel-result-cond (cdr (assq :result-params params)) result (condition-case nil (org-babel-script-escape result) (error result))))) diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index 8145d2c..dd696c2 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -1,4 +1,4 @@ -;;; ob-comint.el --- org-babel functions for interaction with comint buffers +;;; ob-comint.el --- Babel Functions for Interaction with Comint Buffers -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -33,9 +33,7 @@ (require 'ob-core) (require 'org-compat) (require 'comint) -(eval-when-compile (require 'cl)) -(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) -(declare-function tramp-flush-directory-property "tramp" (vec directory)) +(require 'tramp) (defun org-babel-comint-buffer-livep (buffer) "Check if BUFFER is a comint buffer with a live process." @@ -53,8 +51,9 @@ executed inside the protection of `save-excursion' and (error "Buffer %s does not exist or has no process" ,buffer)) (save-match-data (with-current-buffer ,buffer - (let ((comint-input-filter (lambda (input) nil))) - ,@body))))) + (save-excursion + (let ((comint-input-filter (lambda (_input) nil))) + ,@body)))))) (def-edebug-spec org-babel-comint-in-buffer (form body)) (defmacro org-babel-comint-with-output (meta &rest body) @@ -79,7 +78,7 @@ or user `keyboard-quit' during execution of body." (comint-output-filter-functions (cons (lambda (text) (setq string-buffer (concat string-buffer text))) comint-output-filter-functions)) - dangling-text raw) + dangling-text) ;; got located, and save dangling text (goto-char (process-mark (get-buffer-process (current-buffer)))) (let ((start (point)) @@ -107,12 +106,12 @@ or user `keyboard-quit' during execution of body." (insert dangling-text) ;; remove echo'd FULL-BODY from input - (if (and ,remove-echo ,full-body - (string-match - (replace-regexp-in-string - "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) - string-buffer)) - (setq raw (substring string-buffer (match-end 0)))) + (when (and ,remove-echo ,full-body + (string-match + (replace-regexp-in-string + "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) + string-buffer)) + (setq string-buffer (substring string-buffer (match-end 0)))) (split-string string-buffer comint-prompt-regexp))))) (def-edebug-spec org-babel-comint-with-output (sexp body)) @@ -145,15 +144,14 @@ Don't return until FILE exists. Code in STRING must ensure that FILE exists at end of evaluation." (unless (org-babel-comint-buffer-livep buffer) (error "Buffer %s does not exist or has no process" buffer)) - (if (file-exists-p file) (delete-file file)) + (when (file-exists-p file) (delete-file file)) (process-send-string (get-buffer-process buffer) (if (= (aref string (1- (length string))) ?\n) string (concat string "\n"))) ;; From Tramp 2.1.19 the following cache flush is not necessary - (if (file-remote-p default-directory) - (let (v) - (with-parsed-tramp-file-name default-directory nil - (tramp-flush-directory-property v "")))) + (when (file-remote-p default-directory) + (with-parsed-tramp-file-name default-directory nil + (tramp-flush-directory-property v ""))) (while (not (file-exists-p file)) (sit-for (or period 0.25)))) (provide 'ob-comint) diff --git a/lisp/ob-coq.el b/lisp/ob-coq.el index 210f1a2..7aea5a6 100644 --- a/lisp/ob-coq.el +++ b/lisp/ob-coq.el @@ -1,4 +1,4 @@ -;;; ob-coq.el --- org-babel functions for Coq +;;; ob-coq.el --- Babel Functions for Coq -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -35,11 +35,12 @@ (declare-function run-coq "ext:coq-inferior.el" (cmd)) (declare-function coq-proc "ext:coq-inferior.el" ()) +(defvar coq-program-name "coqtop" + "Name of the coq toplevel to run.") + (defvar org-babel-coq-buffer "*coq*" "Buffer in which to evaluate coq code blocks.") -(defvar org-babel-coq-eoe "org-babel-coq-eoe") - (defun org-babel-coq-clean-prompt (string) (if (string-match "^[^[:space:]]+ < " string) (substring string 0 (match-beginning 0)) @@ -70,7 +71,7 @@ If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session." (unless (fboundp 'run-coq) (error "`run-coq' not defined, load coq-inferior.el")) - (save-window-excursion (run-coq "coqtop")) + (save-window-excursion (run-coq coq-program-name)) (sit-for 0.1) (get-buffer org-babel-coq-buffer)) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index fcd15c4..3cfe726 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -1,4 +1,4 @@ -;;; ob-core.el --- working with code blocks in org-mode +;;; ob-core.el --- Working with Code Blocks -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -23,8 +23,7 @@ ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'ob-eval) (require 'org-macs) (require 'org-compat) @@ -34,79 +33,69 @@ ".exe" nil)) -;; dynamically scoped for tramp -(defvar org-babel-call-process-region-original nil) (defvar org-babel-library-of-babel) (defvar org-edit-src-content-indentation) (defvar org-src-lang-modes) +(defvar org-src-preserve-indentation) -(declare-function outline-show-all "outline" ()) -(declare-function org-every "org" (pred seq)) -(declare-function org-get-indentation "org" (&optional line)) -(declare-function org-remove-indentation "org" (code &optional n)) -(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) -(declare-function org-mark-ring-push "org" (&optional pos buffer)) -(declare-function tramp-compat-make-temp-file "tramp-compat" - (filename &optional dir-flag)) -(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) -(declare-function tramp-file-name-user "tramp" (vec)) -(declare-function tramp-file-name-host "tramp" (vec)) -(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) -(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-at-item-p "org-list" ()) +(declare-function org-at-table-p "org" (&optional table-type)) +(declare-function org-babel-lob-execute-maybe "ob-lob" ()) +(declare-function org-babel-ref-goto-headline-id "ob-ref" (id)) +(declare-function org-babel-ref-headline-body "ob-ref" ()) +(declare-function org-babel-ref-parse "ob-ref" (assignment)) +(declare-function org-babel-ref-resolve "ob-ref" (ref)) +(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) +(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) +(declare-function org-completing-read "org" (&rest args)) +(declare-function org-current-level "org" ()) +(declare-function org-cycle "org" (&optional arg)) +(declare-function org-do-remove-indentation "org" (&optional n)) (declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name)) (declare-function org-edit-src-exit "org-src" ()) -(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) -(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body)) -(declare-function org-outline-overlay-data "org" (&optional use-markers)) -(declare-function org-set-outline-overlay-data "org" (data)) -(declare-function org-narrow-to-subtree "org" ()) -(declare-function org-split-string "org" (string &optional separators)) -(declare-function org-entry-get "org" - (pom property &optional inherit literal-nil)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-normalize-string "org-element" (s)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-escape-code-in-region "org-src" (beg end)) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-in-regexp "org" (regexp &optional nlines visually)) +(declare-function org-indent-line "org" ()) +(declare-function org-list-get-list-end "org-list" (item struct prevs)) +(declare-function org-list-prevs-alist "org-list" (struct)) +(declare-function org-list-struct "org-list" ()) +(declare-function org-list-to-generic "org-list" (LIST PARAMS)) +(declare-function org-list-to-lisp "org-list" (&optional delete)) +(declare-function org-macro-escape-arguments "org-macro" (&rest args)) (declare-function org-make-options-regexp "org" (kwds &optional extra)) -(declare-function org-do-remove-indentation "org" (&optional n)) +(declare-function org-mark-ring-push "org" (&optional pos buffer)) +(declare-function org-narrow-to-subtree "org" ()) (declare-function org-next-block "org" (arg &optional backward block-regexp)) +(declare-function org-number-sequence "org-compat" (from &optional to inc)) +(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) +(declare-function org-outline-overlay-data "org" (&optional use-markers)) (declare-function org-previous-block "org" (arg &optional block-regexp)) +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-reverse-string "org" (string)) +(declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-show-context "org" (&optional key)) -(declare-function org-at-table-p "org" (&optional table-type)) -(declare-function org-cycle "org" (&optional arg)) -(declare-function org-uniquify "org" (list)) -(declare-function org-current-level "org" ()) -(declare-function org-table-import "org-table" (file arg)) -(declare-function org-add-hook "org-compat" - (hook function &optional append local)) +(declare-function org-split-string "org" (string &optional separators)) +(declare-function org-src-coderef-format "org-src" (element)) +(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-table-align "org-table" ()) (declare-function org-table-end "org-table" (&optional table-type)) +(declare-function org-table-import "org-table" (file arg)) +(declare-function org-table-to-lisp "org-table" (&optional txt)) +(declare-function org-trim "org" (s &optional keep-lead)) +(declare-function org-unescape-code-in-string "org-src" (s)) +(declare-function org-uniquify "org" (list)) (declare-function orgtbl-to-generic "org-table" (table params)) (declare-function orgtbl-to-orgtbl "org-table" (table params)) -(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) -(declare-function org-babel-lob-get-info "ob-lob" nil) -(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) -(declare-function org-babel-ref-parse "ob-ref" (assignment)) -(declare-function org-babel-ref-resolve "ob-ref" (ref)) -(declare-function org-babel-ref-goto-headline-id "ob-ref" (id)) -(declare-function org-babel-ref-headline-body "ob-ref" ()) -(declare-function org-babel-lob-execute-maybe "ob-lob" ()) -(declare-function org-number-sequence "org-compat" (from &optional to inc)) -(declare-function org-at-item-p "org-list" ()) -(declare-function org-list-parse-list "org-list" (&optional delete)) -(declare-function org-list-to-generic "org-list" (LIST PARAMS)) -(declare-function org-list-struct "org-list" ()) -(declare-function org-list-prevs-alist "org-list" (struct)) -(declare-function org-list-get-list-end "org-list" (item struct prevs)) -(declare-function org-remove-if "org" (predicate seq)) -(declare-function org-completing-read "org" (&rest args)) -(declare-function org-escape-code-in-region "org-src" (beg end)) -(declare-function org-unescape-code-in-string "org-src" (s)) -(declare-function org-table-to-lisp "org-table" (&optional txt)) -(declare-function org-reverse-string "org" (string)) -(declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-type "org-element" (element)) -(declare-function org-element-at-point "org-element" ()) -(declare-function org-element-normalize-string "org-element" (s)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-every "org" (pred seq)) -(declare-function org-macro-escape-arguments "org-macro" (&rest args)) +(declare-function outline-show-all "outline" ()) +(declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -117,10 +106,10 @@ "Confirm before evaluation. \\<org-mode-map>\ Require confirmation before interactively evaluating code -blocks in Org-mode buffers. The default value of this variable -is t, meaning confirmation is required for any code block -evaluation. This variable can be set to nil to inhibit any -future confirmation requests. This variable can also be set to a +blocks in Org buffers. The default value of this variable is t, +meaning confirmation is required for any code block evaluation. +This variable can be set to nil to inhibit any future +confirmation requests. This variable can also be set to a function which takes two arguments the language of the code block and the body of the code block. Such a function should then return a non-nil value if the user should be prompted for @@ -128,11 +117,11 @@ execution or nil if no prompt is required. Warning: Disabling confirmation may result in accidental evaluation of potentially harmful code. It may be advisable -remove code block execution from \\[org-ctrl-c-ctrl-c] \ +remove code block execution from `\\[org-ctrl-c-ctrl-c]' \ as further protection against accidental code block evaluation. The `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to -remove code block execution from the \\[org-ctrl-c-ctrl-c] keybinding." +remove code block execution from the `\\[org-ctrl-c-ctrl-c]' keybinding." :group 'org-babel :version "24.1" :type '(choice boolean function)) @@ -141,7 +130,7 @@ remove code block execution from the \\[org-ctrl-c-ctrl-c] keybinding." (defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil "\\<org-mode-map>\ -Remove code block evaluation from the \\[org-ctrl-c-ctrl-c] key binding." +Remove code block evaluation from the `\\[org-ctrl-c-ctrl-c]' key binding." :group 'org-babel :version "24.1" :type 'boolean) @@ -182,6 +171,14 @@ This string must include a \"%s\" which will be replaced by the results." (and (stringp value) (string-match-p "%s" value)))) +(defcustom org-babel-hash-show-time nil + "Non-nil means show the time the code block was evaluated in the result hash." + :group 'org-babel + :type 'boolean + :version "25.2" + :package-version '(Org . "9.0") + :safe #'booleanp) + (defun org-babel-noweb-wrap (&optional regexp) (concat org-babel-noweb-wrap-start (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") @@ -207,167 +204,100 @@ This string must include a \"%s\" which will be replaced by the results." "\\([^\000]*?\n\\)??[ \t]*#\\+end_src") "Regexp used to identify code blocks.") -(defvar org-babel-inline-src-block-regexp - (concat - ;; (1) replacement target (2) lang - "\\(?:^\\|[^-[:alnum:]]?\\)\\(src_\\([^ \f\t\n\r\v[]+\\)" - ;; (3,4) (unused, headers) - "\\(\\|\\[[ \t]*\\(.*?\\)\\]\\)" - ;; (5) body - "{\\([^\f\n\r\v]+?\\)}\\)") - "Regexp used to identify inline src-blocks.") - -(defun org-babel-get-header (params key &optional others) - "Select only header argument of type KEY from a list. -Optional argument OTHERS indicates that only the header that do -not match KEY should be returned." - (delq nil - (mapcar - (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p)) - params))) - -(defun org-babel-get-inline-src-block-matches () - "Set match data if within body of an inline source block. -Returns non-nil if match-data set" - (save-excursion - (let ((datum (org-element-context))) - (when (eq (org-element-type datum) 'inline-src-block) - (goto-char (org-element-property :begin datum)) - (when (looking-at org-babel-inline-src-block-regexp) - t ))))) - -(defvar org-babel-inline-lob-one-liner-regexp) -(defun org-babel-get-lob-one-liner-matches () - "Set match data if on line of an lob one liner. -Returns non-nil if match-data set" - (save-excursion - (let ((datum (org-element-context))) - (when (eq (org-element-type datum) 'inline-babel-call) - (goto-char (org-element-property :begin datum)))) - (if (looking-at org-babel-inline-lob-one-liner-regexp) - t - nil))) +(defun org-babel--get-vars (params) + "Return the babel variable assignments in PARAMS. -(defun org-babel-get-src-block-info (&optional light) - "Get information on the current source block. - -Optional argument LIGHT does not resolve remote variable -references; a process which could likely result in the execution -of other code blocks. - -Returns a list - (language body header-arguments-alist switches name indent block-head)." - (let ((case-fold-search t) head info name indent) - ;; full code block - (if (setq head (org-babel-where-is-src-block-head)) - (save-excursion - (goto-char head) - (setq info (org-babel-parse-src-block-match)) - (setq indent (car (last info))) - (setq info (butlast info)) - (while (and (= 0 (forward-line -1)) - (looking-at org-babel-multi-line-header-regexp)) - (setf (nth 2 info) - (org-babel-merge-params - (nth 2 info) - (org-babel-parse-header-arguments (match-string 1))))) - (when (looking-at (org-babel-named-src-block-regexp-for-name)) - (setq name (org-match-string-no-properties 9)))) - ;; inline source block - (when (org-babel-get-inline-src-block-matches) - (setq head (match-beginning 0)) - (setq info (org-babel-parse-inline-src-block-match)))) - ;; resolve variable references and add summary parameters - (when (and info (not light)) - (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) - (when info - (setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info)))) - (when info (append info (list name indent head))))) +PARAMS is a quasi-alist of header args, whcih may contain +multiple entries for the key `:var'. This function returns a +list of the cdr of all the `:var' entries." + (mapcar #'cdr + (cl-remove-if-not (lambda (x) (eq (car x) :var)) params))) (defvar org-babel-exp-reference-buffer nil "Buffer containing original contents of the exported buffer. This is used by Babel to resolve references in source blocks. Its value is dynamically bound during export.") -(defmacro org-babel-check-confirm-evaluate (info &rest body) - "Evaluate BODY with special execution confirmation variables set. - -Specifically; NOEVAL will indicate if evaluation is allowed, -QUERY will indicate if a user query is required, CODE-BLOCK will -hold the language of the code block, and BLOCK-NAME will hold the -name of the code block." - (declare (indent defun)) - (org-with-gensyms - (lang block-body headers name head eval eval-no export eval-no-export) - `(let* ((,lang (nth 0 ,info)) - (,block-body (nth 1 ,info)) - (,headers (nth 2 ,info)) - (,name (nth 4 ,info)) - (,head (nth 6 ,info)) - (,eval (or (cdr (assoc :eval ,headers)) - (when (assoc :noeval ,headers) "no"))) - (,eval-no (or (equal ,eval "no") - (equal ,eval "never"))) - (,export org-babel-exp-reference-buffer) - (,eval-no-export (and ,export (or (equal ,eval "no-export") - (equal ,eval "never-export")))) - (noeval (or ,eval-no ,eval-no-export)) - (query (or (equal ,eval "query") - (and ,export (equal ,eval "query-export")) - (if (functionp org-confirm-babel-evaluate) - (save-excursion - (goto-char ,head) - (funcall org-confirm-babel-evaluate - ,lang ,block-body)) - org-confirm-babel-evaluate))) - (code-block (if ,info (format " %s " ,lang) " ")) - (block-name (if ,name (format " (%s) " ,name) " "))) - ;; Silence byte-compiler if `body' doesn't use those vars. - (ignore noeval query) - ,@body))) - -(defsubst org-babel-check-evaluate (info) +(defun org-babel-check-confirm-evaluate (info) + "Check whether INFO allows code block evaluation. + +Returns nil if evaluation is disallowed, t if it is +unconditionally allowed, and the symbol `query' if the user +should be asked whether to allow evaluation." + (let* ((headers (nth 2 info)) + (eval (or (cdr (assq :eval headers)) + (when (assq :noeval headers) "no"))) + (eval-no (member eval '("no" "never"))) + (export org-babel-exp-reference-buffer) + (eval-no-export (and export (member eval '("no-export" "never-export")))) + (noeval (or eval-no eval-no-export)) + (query (or (equal eval "query") + (and export (equal eval "query-export")) + (if (functionp org-confirm-babel-evaluate) + (save-excursion + (goto-char (nth 5 info)) + (funcall org-confirm-babel-evaluate + ;; language, code block body + (nth 0 info) (nth 1 info))) + org-confirm-babel-evaluate)))) + (cond + (noeval nil) + (query 'query) + (t t)))) + +(defun org-babel-check-evaluate (info) "Check if code block INFO should be evaluated. -Do not query the user." - (org-babel-check-confirm-evaluate info - (not (when noeval - (message "Evaluation of this%scode-block%sis disabled." - code-block block-name))))) - ;; dynamically scoped for asynchronous export +Do not query the user, but do display an informative message if +evaluation is blocked. Returns non-nil if evaluation is not blocked." + (let ((evalp (org-babel-check-confirm-evaluate info))) + (when (null evalp) + (message "Evaluation of this %s code-block%sis disabled." + (nth 0 info) + (let ((name (nth 4 info))) (if name (format " (%s) " name) "")))) + evalp)) + +;; Dynamically scoped for asynchronous export. (defvar org-babel-confirm-evaluate-answer-no) -(defsubst org-babel-confirm-evaluate (info) +(defun org-babel-confirm-evaluate (info) "Confirm evaluation of the code block INFO. -If the variable `org-babel-confirm-evaluate-answer-no' is bound -to a non-nil value, auto-answer with \"no\". - This query can also be suppressed by setting the value of `org-confirm-babel-evaluate' to nil, in which case all future interactive code block evaluations will proceed without any confirmation from the user. Note disabling confirmation may result in accidental evaluation -of potentially harmful code." - (org-babel-check-confirm-evaluate info - (not (when query - (unless - (and (not (org-bound-and-true-p +of potentially harmful code. + +The variable `org-babel-confirm-evaluate-answer-no' is used by +the async export process, which requires a non-interactive +environment, to override this check." + (let* ((evalp (org-babel-check-confirm-evaluate info)) + (lang (nth 0 info)) + (name (nth 4 info)) + (name-string (if name (format " (%s) " name) " "))) + (pcase evalp + (`nil nil) + (`t t) + (`query (or + (and (not (bound-and-true-p org-babel-confirm-evaluate-answer-no)) (yes-or-no-p - (format "Evaluate this%scode block%son your system? " - code-block block-name))) - (message "Evaluation of this%scode-block%sis aborted." - code-block block-name)))))) + (format "Evaluate this %s code block%son your system? " + lang name-string))) + (progn + (message "Evaluation of this %s code-block%sis aborted." + lang name-string) + nil))) + (x (error "Unexpected value `%s' from `org-babel-check-confirm-evaluate'" x))))) ;;;###autoload (defun org-babel-execute-safely-maybe () (unless org-babel-no-eval-on-ctrl-c-ctrl-c (org-babel-execute-maybe))) -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe) - ;;;###autoload (defun org-babel-execute-maybe () (interactive) @@ -378,8 +308,8 @@ of potentially harmful code." "Execute BODY if point is in a source block and return t. Otherwise do nothing and return nil." - `(if (or (org-babel-where-is-src-block-head) - (org-babel-get-inline-src-block-matches)) + `(if (memq (org-element-type (org-element-context)) + '(inline-src-block src-block)) (progn ,@body t) @@ -530,7 +460,7 @@ their `org-babel-default-header-args:foo' variable. For the format of SAFE-LIST, see `org-babel-safe-header-args'." `(lambda (value) (and (listp value) - (org-every + (cl-every (lambda (pair) (and (consp pair) (org-babel-one-header-arg-safe-p pair ,safe-list))) @@ -550,22 +480,26 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'." (put 'org-babel-default-inline-header-args 'safe-local-variable (org-babel-header-args-safe-fn org-babel-safe-header-args)) -(defvar org-babel-data-names '("tblname" "results" "name")) - -(defvar org-babel-result-regexp - (concat "^[ \t]*#\\+" - (regexp-opt org-babel-data-names t) - "\\(\\[\\(" - ;; FIXME The string below is `org-ts-regexp' - "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" - " \\)?\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*") +(defconst org-babel-name-regexp + (format "^[ \t]*#\\+%s:[ \t]*" + ;; FIXME: TBLNAME is for backward compatibility. + (regexp-opt '("NAME" "TBLNAME"))) + "Regexp matching a NAME keyword.") + +(defconst org-babel-result-regexp + (format "^[ \t]*#\\+%s\\(?:\\[\\(?:%s \\)?\\([[:alnum:]]+\\)\\]\\)?:[ \t]*" + org-babel-results-keyword + ;; <%Y-%m-%d %H:%M:%S> + "<\\(?:[0-9]\\{4\\}-[0-1][0-9]-[0-3][0-9] \ +[0-2][0-9]\\(?::[0-5][0-9]\\)\\{2\\}\\)>") "Regular expression used to match result lines. If the results are associated with a hash key then the hash will -be saved in the second match data.") +be saved in match group 1.") -(defvar org-babel-result-w-name-regexp - (concat org-babel-result-regexp - "\\([^ ()\f\t\n\r\v]+\\)\\((\\(.*\\))\\|\\)")) +(defconst org-babel-result-w-name-regexp + (concat org-babel-result-regexp "\\(?9:[^ \t\n\r\v\f]+\\)") + "Regexp matching a RESULTS keyword with a name. +Name is saved in match group 9.") (defvar org-babel-min-lines-for-block-output 10 "The minimum number of lines for block output. @@ -590,9 +524,6 @@ to raise errors for all languages.") (defvar org-babel-hash-show 4 "Number of initial characters to show of a hidden results hash.") -(defvar org-babel-hash-show-time nil - "Non-nil means show the time the code block was evaluated in the result hash.") - (defvar org-babel-after-execute-hook nil "Hook for functions to be called after `org-babel-execute-src-block'") @@ -609,10 +540,27 @@ match group 9. Other match groups are defined in (defun org-babel-named-data-regexp-for-name (name) "This generates a regexp used to match data named NAME." - (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)")) + (concat org-babel-name-regexp (regexp-quote name) "[ \t]*$")) + +(defun org-babel--normalize-body (datum) + "Normalize body for element or object DATUM. +DATUM is a source block element or an inline source block object. +Remove final newline character and spurious indentation." + (let* ((value (org-element-property :value datum)) + (body (if (string-suffix-p "\n" value) + (substring value 0 -1) + value))) + (cond ((eq (org-element-type datum) 'inline-src-block) + ;; Newline characters and indentation in an inline + ;; src-block are not meaningful, since they could come from + ;; some paragraph filling. Treat them as a white space. + (replace-regexp-in-string "\n[ \t]*" " " body)) + ((or org-src-preserve-indentation + (org-element-property :preserve-indent datum)) + body) + (t (org-remove-indentation body))))) ;;; functions -(defvar call-process-region) (defvar org-babel-current-src-block-location nil "Marker pointing to the src block currently being executed. This may also point to a call line or an inline code block. If @@ -622,6 +570,56 @@ the outer-most code block.") (defvar *this*) +(defun org-babel-get-src-block-info (&optional light datum) + "Extract information from a source block or inline source block. + +Optional argument LIGHT does not resolve remote variable +references; a process which could likely result in the execution +of other code blocks. + +By default, consider the block at point. However, when optional +argument DATUM is provided, extract information from that parsed +object instead. + +Return nil if point is not on a source block. Otherwise, return +a list with the following pattern: + + (language body arguments switches name start coderef)" + (let* ((datum (or datum (org-element-context))) + (type (org-element-type datum)) + (inline (eq type 'inline-src-block))) + (when (memq type '(inline-src-block src-block)) + (let* ((lang (org-element-property :language datum)) + (lang-headers (intern + (concat "org-babel-default-header-args:" lang))) + (name (org-element-property :name datum)) + (info + (list + lang + (org-babel--normalize-body datum) + (apply #'org-babel-merge-params + (if inline org-babel-default-inline-header-args + org-babel-default-header-args) + (and (boundp lang-headers) (eval lang-headers t)) + (append + ;; If DATUM is provided, make sure we get node + ;; properties applicable to its location within + ;; the document. + (org-with-point-at (org-element-property :begin datum) + (org-babel-params-from-properties lang)) + (mapcar #'org-babel-parse-header-arguments + (cons (org-element-property :parameters datum) + (org-element-property :header datum))))) + (or (org-element-property :switches datum) "") + name + (org-element-property (if inline :begin :post-affiliated) + datum) + (and (not inline) (org-src-coderef-format datum))))) + (unless light + (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) + (setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info))) + info)))) + ;;;###autoload (defun org-babel-execute-src-block (&optional arg info params) "Execute the current source code block. @@ -641,114 +639,91 @@ block." (interactive) (let* ((org-babel-current-src-block-location (or org-babel-current-src-block-location - (nth 6 info) - (org-babel-where-is-src-block-head) - ;; inline src block - (and (org-babel-get-inline-src-block-matches) - (match-beginning 0)))) - (info (if info - (copy-tree info) - (org-babel-get-src-block-info))) - (merged-params (org-babel-merge-params (nth 2 info) params))) - (when (org-babel-check-evaluate - (let ((i info)) (setf (nth 2 i) merged-params) i)) - (let* ((params (if params - (org-babel-process-params merged-params) - (nth 2 info))) - (cachep (and (not arg) (cdr (assoc :cache params)) - (string= "yes" (cdr (assoc :cache params))))) - (new-hash (when cachep (org-babel-sha1-hash info))) - (old-hash (when cachep (org-babel-current-result-hash))) - (cache-current-p (and (not arg) new-hash - (equal new-hash old-hash)))) + (nth 5 info) + (org-babel-where-is-src-block-head))) + (info (if info (copy-tree info) (org-babel-get-src-block-info)))) + ;; Merge PARAMS with INFO before considering source block + ;; evaluation since both could disagree. + (cl-callf org-babel-merge-params (nth 2 info) params) + (when (org-babel-check-evaluate info) + (cl-callf org-babel-process-params (nth 2 info)) + (let* ((params (nth 2 info)) + (cache (let ((c (cdr (assq :cache params)))) + (and (not arg) c (string= "yes" c)))) + (new-hash (and cache (org-babel-sha1-hash info))) + (old-hash (and cache (org-babel-current-result-hash))) + (current-cache (and new-hash (equal new-hash old-hash)))) (cond - (cache-current-p - (save-excursion ;; return cached result + (current-cache + (save-excursion ;Return cached result. (goto-char (org-babel-where-is-src-block-result nil info)) (forward-line) (skip-chars-forward " \t") (let ((result (org-babel-read-result))) - (message (replace-regexp-in-string - "%" "%%" (format "%S" result))) + (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result))) - ((org-babel-confirm-evaluate - (let ((i info)) (setf (nth 2 i) merged-params) i)) + ((org-babel-confirm-evaluate info) (let* ((lang (nth 0 info)) - (result-params (cdr (assoc :result-params params))) - (body (setf (nth 1 info) - (if (org-babel-noweb-p params :eval) - (org-babel-expand-noweb-references info) - (nth 1 info)))) - (dir (cdr (assoc :dir params))) + (result-params (cdr (assq :result-params params))) + ;; Expand noweb references in BODY and remove any + ;; coderef. + (body + (let ((coderef (nth 6 info)) + (expand + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (if (not coderef) expand + (replace-regexp-in-string + (org-src-coderef-regexp coderef) "" expand nil nil 1)))) + (dir (cdr (assq :dir params))) (default-directory (or (and dir (file-name-as-directory (expand-file-name dir))) default-directory)) - (org-babel-call-process-region-original ;; for tramp handler - (or (org-bound-and-true-p - org-babel-call-process-region-original) - (symbol-function 'call-process-region))) - (indent (nth 5 info)) - result cmd) - (unwind-protect - (let ((call-process-region - (lambda (&rest args) - (apply 'org-babel-tramp-handle-call-process-region - args)))) - (let ((lang-check - (lambda (f) - (let ((f (intern (concat "org-babel-execute:" f)))) - (when (fboundp f) f))))) - (setq cmd - (or (funcall lang-check lang) - (funcall lang-check - (symbol-name - (cdr (assoc lang org-src-lang-modes)))) - (error "No org-babel-execute function for %s!" - lang)))) - (message "executing %s code block%s..." - (capitalize lang) - (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) - (if (member "none" result-params) - (progn - (funcall cmd body params) - (message "result silenced") - (setq result nil)) - (setq result - (let ((result (funcall cmd body params))) - (if (and (eq (cdr (assoc :result-type params)) - 'value) - (or (member "vector" result-params) - (member "table" result-params)) - (not (listp result))) - (list (list result)) result))) - ;; If non-empty result and :file then write to :file. - (when (cdr (assoc :file params)) - (when result - (with-temp-file (cdr (assoc :file params)) - (insert - (org-babel-format-result - result (cdr (assoc :sep (nth 2 info))))))) - (setq result (cdr (assoc :file params)))) - ;; Possibly perform post process provided its appropriate. - (when (cdr (assoc :post params)) - (let ((*this* (if (cdr (assoc :file params)) - (org-babel-result-to-file - (cdr (assoc :file params)) - (when (assoc :file-desc params) - (or (cdr (assoc :file-desc params)) - result))) - result))) - (setq result (org-babel-ref-resolve - (cdr (assoc :post params)))) - (when (cdr (assoc :file params)) - (setq result-params - (remove "file" result-params))))) - (org-babel-insert-result - result result-params info new-hash indent lang)) - (run-hooks 'org-babel-after-execute-hook) - result) - (setq call-process-region - 'org-babel-call-process-region-original))))))))) + (cmd (intern (concat "org-babel-execute:" lang))) + result) + (unless (fboundp cmd) + (error "No org-babel-execute function for %s!" lang)) + (message "executing %s code block%s..." + (capitalize lang) + (let ((name (nth 4 info))) + (if name (format " (%s)" name) ""))) + (if (member "none" result-params) + (progn (funcall cmd body params) + (message "result silenced")) + (setq result + (let ((r (funcall cmd body params))) + (if (and (eq (cdr (assq :result-type params)) 'value) + (or (member "vector" result-params) + (member "table" result-params)) + (not (listp r))) + (list (list r)) + r))) + (let ((file (cdr (assq :file params)))) + ;; If non-empty result and :file then write to :file. + (when file + (when result + (with-temp-file file + (insert (org-babel-format-result + result (cdr (assq :sep params)))))) + (setq result file)) + ;; Possibly perform post process provided its + ;; appropriate. Dynamically bind "*this*" to the + ;; actual results of the block. + (let ((post (cdr (assq :post params)))) + (when post + (let ((*this* (if (not file) result + (org-babel-result-to-file + file + (let ((desc (assq :file-desc params))) + (and desc (or (cdr desc) result))))))) + (setq result (org-babel-ref-resolve post)) + (when file + (setq result-params (remove "file" result-params)))))) + (org-babel-insert-result + result result-params info new-hash lang))) + (run-hooks 'org-babel-after-execute-hook) + result))))))) (defun org-babel-expand-body:generic (body params &optional var-lines) "Expand BODY with PARAMS. @@ -756,8 +731,8 @@ Expand a block of code with org-babel according to its header arguments. This generic implementation of body expansion is called for languages which have not defined their own specific org-babel-expand-body:lang function." - (let ((pro (cdr (assoc :prologue params))) - (epi (cdr (assoc :epilogue params)))) + (let ((pro (cdr (assq :prologue params))) + (epi (cdr (assq :epilogue params)))) (mapconcat #'identity (append (when pro (list pro)) var-lines @@ -788,7 +763,7 @@ arguments and pop open the results in a preview buffer." (org-babel-expand-body:generic body params (and (fboundp assignments-cmd) (funcall assignments-cmd params)))))) - (if (org-called-interactively-p 'any) + (if (called-interactively-p 'any) (org-edit-src-code expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")) expanded))) @@ -821,7 +796,7 @@ arguments and pop open the results in a preview buffer." (dolist (arg-pair new-list) (let ((header (car arg-pair))) (setq results - (cons arg-pair (org-remove-if + (cons arg-pair (cl-remove-if (lambda (pair) (equal header (car pair))) results)))))) results)) @@ -854,13 +829,13 @@ arguments and pop open the results in a preview buffer." (interactive) (let* ((info (org-babel-get-src-block-info 'light)) (lang (car info)) - (begin (nth 6 info)) + (begin (nth 5 info)) (lang-headers (intern (concat "org-babel-header-args:" lang))) (headers (org-babel-combine-header-arg-lists org-babel-common-header-args-w-values - (when (boundp lang-headers) (eval lang-headers)))) + (when (boundp lang-headers) (eval lang-headers t)))) (header-arg (or header-arg - (org-icompleting-read + (completing-read "Header Arg: " (mapcar (lambda (header-spec) (symbol-name (car header-spec))) @@ -873,7 +848,7 @@ arguments and pop open the results in a preview buffer." ((listp vals) (mapconcat (lambda (group) - (let ((arg (org-icompleting-read + (let ((arg (completing-read "Value: " (cons "default" (mapcar #'symbol-name group))))) @@ -896,7 +871,7 @@ arguments and pop open the results in a preview buffer." (defun org-babel-enter-header-arg-w-completion (&optional lang) "Insert header argument appropriate for LANG with completion." (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang))) - (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var))) + (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var t))) (headers-w-values (org-babel-combine-header-arg-lists org-babel-common-header-args-w-values lang-headers)) (headers (mapcar #'symbol-name (mapcar #'car headers-w-values))) @@ -927,8 +902,8 @@ session." (if (org-babel-noweb-p params :eval) (org-babel-expand-noweb-references info) (nth 1 info))))) - (session (cdr (assoc :session params))) - (dir (cdr (assoc :dir params))) + (session (cdr (assq :session params))) + (dir (cdr (assq :dir params))) (default-directory (or (and dir (file-name-as-directory dir)) default-directory)) (cmd (intern (concat "org-babel-load-session:" lang)))) @@ -948,17 +923,17 @@ the session. Copy the body of the code block to the kill ring." (lang (nth 0 info)) (body (nth 1 info)) (params (nth 2 info)) - (session (cdr (assoc :session params))) - (dir (cdr (assoc :dir params))) + (session (cdr (assq :session params))) + (dir (cdr (assq :dir params))) (default-directory (or (and dir (file-name-as-directory dir)) default-directory)) (init-cmd (intern (format "org-babel-%s-initiate-session" lang))) (prep-cmd (intern (concat "org-babel-prep-session:" lang)))) - (if (and (stringp session) (string= session "none")) - (error "This block is not using a session!")) + (when (and (stringp session) (string= session "none")) + (error "This block is not using a session!")) (unless (fboundp init-cmd) (error "No org-babel-initiate-session function for %s!" lang)) - (with-temp-buffer (insert (org-babel-trim body)) + (with-temp-buffer (insert (org-trim body)) (copy-region-as-kill (point-min) (point-max))) (when arg (unless (fboundp prep-cmd) @@ -1013,10 +988,10 @@ Return t if a code block was found at point, nil otherwise." "Read key sequence and execute the command in edit buffer. Enter a key sequence to be executed in the language major-mode edit buffer. For example, TAB will alter the contents of the -Org-mode code block according to the effect of TAB in the -language major-mode buffer. For languages that support -interactive sessions, this can be used to send code from the Org -buffer to the session for evaluation using the native major-mode +Org code block according to the effect of TAB in the language +major mode buffer. For languages that support interactive +sessions, this can be used to send code from the Org buffer +to the session for evaluation using the native major mode evaluation mechanisms." (interactive "kEnter key-sequence to execute in edit buffer: ") (org-babel-do-in-edit-buffer @@ -1050,7 +1025,7 @@ results already exist." ;; file results (org-open-at-point) (let ((r (org-babel-format-result - (org-babel-read-result) (cdr (assoc :sep (nth 2 info)))))) + (org-babel-read-result) (cdr (assq :sep (nth 2 info)))))) (pop-to-buffer (get-buffer-create "*Org-Babel Results*")) (delete-region (point-min) (point-max)) (insert r))) @@ -1121,81 +1096,91 @@ end-body --------- point at the end of the body" ;;;###autoload (defmacro org-babel-map-inline-src-blocks (file &rest body) - "Evaluate BODY forms on each inline source-block in FILE. + "Evaluate BODY forms on each inline source block in FILE. If FILE is nil evaluate BODY forms on source blocks in current buffer." - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) + (declare (indent 1) (debug (form body))) + (org-with-gensyms (datum end point tempvar to-be-removed visitedp) `(let* ((case-fold-search t) (,tempvar ,file) - (visited-p (or (null ,tempvar) + (,visitedp (or (null ,tempvar) (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) + (,point (point)) + ,to-be-removed) (save-window-excursion (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) + (setq ,to-be-removed (current-buffer)) (goto-char (point-min)) - (while (re-search-forward org-babel-inline-src-block-regexp nil t) - (when (org-babel-active-location-p) - (goto-char (match-beginning 1)) - (save-match-data ,@body)) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-inline-src-blocks (form body)) - -(defvar org-babel-lob-one-liner-regexp) + (while (re-search-forward "src_\\S-" nil t) + (let ((,datum (save-match-data (org-element-context)))) + (when (eq (org-element-type ,datum) 'inline-src-block) + (goto-char (match-beginning 0)) + (let ((,end (copy-marker (org-element-property :end ,datum)))) + ,@body + (goto-char ,end) + (set-marker ,end nil)))))) + (unless ,visitedp (kill-buffer ,to-be-removed)) + (goto-char ,point)))) ;;;###autoload (defmacro org-babel-map-call-lines (file &rest body) "Evaluate BODY forms on each call line in FILE. If FILE is nil evaluate BODY forms on source blocks in current buffer." - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) - (visited-p (or (null ,tempvar) + (declare (indent 1) (debug (form body))) + (org-with-gensyms (datum end point tempvar to-be-removed visitedp) + `(let* ((case-fold-search t) + (,tempvar ,file) + (,visitedp (or (null ,tempvar) (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) + (,point (point)) + ,to-be-removed) (save-window-excursion (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) + (setq ,to-be-removed (current-buffer)) (goto-char (point-min)) - (while (re-search-forward org-babel-lob-one-liner-regexp nil t) - (when (org-babel-active-location-p) - (goto-char (match-beginning 1)) - (save-match-data ,@body)) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-call-lines (form body)) + (while (re-search-forward "call_\\S-\\|^[ \t]*#\\+CALL:" nil t) + (let ((,datum (save-match-data (org-element-context)))) + (when (memq (org-element-type ,datum) + '(babel-call inline-babel-call)) + (goto-char (match-beginning 0)) + (let ((,end (copy-marker (org-element-property :end ,datum)))) + ,@body + (goto-char ,end) + (set-marker ,end nil)))))) + (unless ,visitedp (kill-buffer ,to-be-removed)) + (goto-char ,point)))) ;;;###autoload (defmacro org-babel-map-executables (file &rest body) - (declare (indent 1)) - (let ((tempvar (make-symbol "file")) - (rx (make-symbol "rx"))) - `(let* ((,tempvar ,file) - (,rx (concat "\\(" org-babel-src-block-regexp - "\\|" org-babel-inline-src-block-regexp - "\\|" org-babel-lob-one-liner-regexp "\\)")) - (visited-p (or (null ,tempvar) + "Evaluate BODY forms on each active Babel code in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer." + (declare (indent 1) (debug (form body))) + (org-with-gensyms (datum end point tempvar to-be-removed visitedp) + `(let* ((case-fold-search t) + (,tempvar ,file) + (,visitedp (or (null ,tempvar) (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) + (,point (point)) + ,to-be-removed) (save-window-excursion (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) + (setq ,to-be-removed (current-buffer)) (goto-char (point-min)) - (while (re-search-forward ,rx nil t) - (when (org-babel-active-location-p) - (goto-char (match-beginning 1)) - (when (looking-at org-babel-inline-src-block-regexp) - (forward-char 1)) - (save-match-data ,@body)) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-executables (form body)) + (while (re-search-forward + "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)" nil t) + (let ((,datum (save-match-data (org-element-context)))) + (when (memq (org-element-type ,datum) + '(babel-call inline-babel-call inline-src-block + src-block)) + (goto-char (match-beginning 0)) + (let ((,end (copy-marker (org-element-property :end ,datum)))) + ,@body + (goto-char ,end) + (set-marker ,end nil)))))) + (unless ,visitedp (kill-buffer ,to-be-removed)) + (goto-char ,point)))) ;;;###autoload (defun org-babel-execute-buffer (&optional arg) @@ -1206,7 +1191,8 @@ the current buffer." (org-babel-eval-wipe-error-buffer) (org-save-outline-visibility t (org-babel-map-executables nil - (if (looking-at org-babel-lob-one-liner-regexp) + (if (memq (org-element-type (org-element-context)) + '(babel-call inline-babel-call)) (org-babel-lob-execute-maybe) (org-babel-execute-src-block arg))))) @@ -1275,24 +1261,30 @@ the current subtree." (nth 2 info))) ":") expanded)) (hash (sha1 it))) - (when (org-called-interactively-p 'interactive) (message hash)) + (when (called-interactively-p 'interactive) (message hash)) hash)))) (defun org-babel-current-result-hash (&optional info) "Return the current in-buffer hash." - (org-babel-where-is-src-block-result nil info) - (org-no-properties (match-string 5))) + (let ((result (org-babel-where-is-src-block-result nil info))) + (when result + (org-with-wide-buffer + (goto-char result) + (looking-at org-babel-result-regexp) + (match-string-no-properties 1))))) (defun org-babel-set-current-result-hash (hash info) "Set the current in-buffer hash to HASH." - (org-babel-where-is-src-block-result nil info) - (save-excursion (goto-char (match-beginning 5)) - (mapc #'delete-overlay (overlays-at (point))) - (forward-char org-babel-hash-show) - (mapc #'delete-overlay (overlays-at (point))) - (replace-match hash nil nil nil 5) - (goto-char (point-at-bol)) - (org-babel-hide-hash))) + (org-with-wide-buffer + (goto-char (org-babel-where-is-src-block-result nil info)) + (looking-at org-babel-result-regexp) + (goto-char (match-beginning 1)) + (mapc #'delete-overlay (overlays-at (point))) + (forward-char org-babel-hash-show) + (mapc #'delete-overlay (overlays-at (point))) + (replace-match hash nil nil nil 1) + (beginning-of-line) + (org-babel-hide-hash))) (defun org-babel-hide-hash () "Hide the hash in the current results line. @@ -1301,11 +1293,11 @@ will remain visible." (add-to-invisibility-spec '(org-babel-hide-hash . t)) (save-excursion (when (and (re-search-forward org-babel-result-regexp nil t) - (match-string 5)) - (let* ((start (match-beginning 5)) + (match-string 1)) + (let* ((start (match-beginning 1)) (hide-start (+ org-babel-hash-show start)) - (end (match-end 5)) - (hash (match-string 5)) + (end (match-end 1)) + (hash (match-string 1)) ov1 ov2) (setq ov1 (make-overlay start hide-start)) (setq ov2 (make-overlay hide-start end)) @@ -1329,13 +1321,12 @@ the `org-mode-hook'." "Return the value of the hash at POINT. \\<org-mode-map>\ The hash is also added as the last element of the kill ring. -This can be called with \\[org-ctrl-c-ctrl-c]." +This can be called with `\\[org-ctrl-c-ctrl-c]'." (interactive) (let ((hash (car (delq nil (mapcar (lambda (ol) (overlay-get ol 'babel-hash)) (overlays-at (or point (point)))))))) (when hash (kill-new hash) (message hash)))) -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point) (defun org-babel-result-hide-spec () "Hide portions of results lines. @@ -1389,15 +1380,15 @@ portions of results lines." (eq (overlay-get overlay 'invisible) 'org-babel-hide-result)) (overlays-at start))) - (if (or (not force) (eq force 'off)) - (mapc (lambda (ov) - (when (member ov org-babel-hide-result-overlays) - (setq org-babel-hide-result-overlays - (delq ov org-babel-hide-result-overlays))) - (when (eq (overlay-get ov 'invisible) - 'org-babel-hide-result) - (delete-overlay ov))) - (overlays-at start))) + (when (or (not force) (eq force 'off)) + (mapc (lambda (ov) + (when (member ov org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays + (delq ov org-babel-hide-result-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-babel-hide-result) + (delete-overlay ov))) + (overlays-at start))) (setq ov (make-overlay start end)) (overlay-put ov 'invisible 'org-babel-hide-result) ;; make the block accessible to isearch @@ -1417,8 +1408,8 @@ portions of results lines." (add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) ;; Remove overlays when changing major mode (add-hook 'org-mode-hook - (lambda () (org-add-hook 'change-major-mode-hook - 'org-babel-show-result-all 'append 'local))) + (lambda () (add-hook 'change-major-mode-hook + 'org-babel-show-result-all 'append 'local))) (defvar org-file-properties) (defun org-babel-params-from-properties (&optional lang) @@ -1427,21 +1418,6 @@ Return a list of association lists of source block params specified in the properties of the current outline entry." (save-match-data (list - ;; DEPRECATED header arguments specified as separate property at - ;; point of definition. - (org-babel-parse-multiple-vars - (delq nil - (mapcar - (lambda (header) - (let* ((arg (symbol-name (car header))) - (val (org-entry-get (point) arg t))) - (and val - (cons (intern (concat ":" arg)) - (org-babel-read val))))) - (org-babel-combine-header-arg-lists - org-babel-common-header-args-w-values - (let ((sym (intern (concat "org-babel-header-args:" lang)))) - (and (boundp sym) (symbol-value sym))))))) ;; header arguments specified with the header-args property at ;; point of call. (org-babel-parse-header-arguments @@ -1454,54 +1430,6 @@ specified in the properties of the current outline entry." (concat "header-args:" lang) 'inherit)))))) -(defvar org-src-preserve-indentation) ;; declare defcustom from org-src -(defun org-babel-parse-src-block-match () - "Parse the results from a match of the `org-babel-src-block-regexp'." - (let* ((block-indentation (string-width (match-string 1))) - (lang (org-match-string-no-properties 2)) - (lang-headers (intern (concat "org-babel-default-header-args:" lang))) - (switches (match-string 3)) - (body (let* ((body (org-match-string-no-properties 5)) - (sub-length (- (length body) 1))) - (if (and (> sub-length 0) - (string= "\n" (substring body sub-length))) - (substring body 0 sub-length) - (or body "")))) - (preserve-indentation (or org-src-preserve-indentation - (save-match-data - (string-match "-i\\>" switches))))) - (list lang - ;; get block body less properties, protective commas, and indentation - (with-temp-buffer - (save-match-data - (insert (org-unescape-code-in-string body)) - (unless preserve-indentation (org-do-remove-indentation)) - (buffer-string))) - (apply #'org-babel-merge-params - org-babel-default-header-args - (when (boundp lang-headers) (eval lang-headers)) - (append - (org-babel-params-from-properties lang) - (list (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) "")))))) - switches - block-indentation))) - -(defun org-babel-parse-inline-src-block-match () - "Parse the results from a match of the `org-babel-inline-src-block-regexp'." - (let* ((lang (org-no-properties (match-string 2))) - (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) - (list lang - (org-unescape-code-in-string (org-no-properties (match-string 5))) - (apply #'org-babel-merge-params - org-babel-default-inline-header-args - (if (boundp lang-headers) (eval lang-headers) nil) - (append - (org-babel-params-from-properties lang) - (list (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) "")))))) - nil))) - (defun org-babel-balanced-split (string alts) "Split STRING on instances of ALTS. ALTS is a cons of two character options where each option may be @@ -1540,7 +1468,7 @@ instances of \"[ \t]:\" set ALTS to ((32 9) . 58)." (let ((last= (lambda (str) (= ch (aref str (1- (length str)))))) (first= (lambda (str) (= ch (aref str 0))))) (reverse - (org-reduce (lambda (acc el) + (cl-reduce (lambda (acc el) (let ((head (car acc))) (if (and head (or (funcall last= head) (funcall first= el))) (cons (concat head el) (cdr acc)) @@ -1573,7 +1501,7 @@ shown below. (let (results) (mapc (lambda (pair) (if (eq (car pair) :var) - (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results)) + (mapcar (lambda (v) (push (cons :var (org-trim v)) results)) (org-babel-join-splits-near-ch 61 (org-babel-balanced-split (cdr pair) 32))) (push pair results))) @@ -1583,38 +1511,39 @@ shown below. (defun org-babel-process-params (params) "Expand variables in PARAMS and add summary parameters." (let* ((processed-vars (mapcar (lambda (el) - (if (consp (cdr el)) - (cdr el) - (org-babel-ref-parse (cdr el)))) - (org-babel-get-header params :var))) - (vars-and-names (if (and (assoc :colname-names params) - (assoc :rowname-names params)) + (if (consp el) + el + (org-babel-ref-parse el))) + (org-babel--get-vars params))) + (vars-and-names (if (and (assq :colname-names params) + (assq :rowname-names params)) (list processed-vars) (org-babel-disassemble-tables processed-vars - (cdr (assoc :hlines params)) - (cdr (assoc :colnames params)) - (cdr (assoc :rownames params))))) - (raw-result (or (cdr (assoc :results params)) "")) - (result-params (append - (split-string (if (stringp raw-result) - raw-result - (eval raw-result))) - (cdr (assoc :result-params params))))) + (cdr (assq :hlines params)) + (cdr (assq :colnames params)) + (cdr (assq :rownames params))))) + (raw-result (or (cdr (assq :results params)) "")) + (result-params (delete-dups + (append + (split-string (if (stringp raw-result) + raw-result + (eval raw-result t))) + (cdr (assq :result-params params)))))) (append (mapcar (lambda (var) (cons :var var)) (car vars-and-names)) (list - (cons :colname-names (or (cdr (assoc :colname-names params)) + (cons :colname-names (or (cdr (assq :colname-names params)) (cadr vars-and-names))) - (cons :rowname-names (or (cdr (assoc :rowname-names params)) - (caddr vars-and-names))) + (cons :rowname-names (or (cdr (assq :rowname-names params)) + (cl-caddr vars-and-names))) (cons :result-params result-params) (cons :result-type (cond ((member "output" result-params) 'output) ((member "value" result-params) 'value) (t 'value)))) - (org-remove-if + (cl-remove-if (lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params - :result-type :var))) + :result-type :var))) params)))) ;; row and column names @@ -1627,7 +1556,7 @@ shown below. Return a cons cell, the `car' of which contains the TABLE less colnames, and the `cdr' of which contains a list of the column names." - (if (equal 'hline (nth 1 table)) + (if (eq 'hline (nth 1 table)) (cons (cddr table) (car table)) (cons (cdr table) (car table)))) @@ -1685,7 +1614,7 @@ of the vars, cnames and rnames." (lambda (var) (when (listp (cdr var)) (when (and (not (equal colnames "no")) - (or colnames (and (equal (nth 1 (cdr var)) 'hline) + (or colnames (and (eq (nth 1 (cdr var)) 'hline) (not (member 'hline (cddr (cdr var))))))) (let ((both (org-babel-get-colnames (cdr var)))) (setq cnames (cons (cons (car var) (cdr both)) @@ -1748,33 +1677,30 @@ If the point is not on a source block then return nil." (interactive (let ((completion-ignore-case t) (case-fold-search t) - (under-point (thing-at-point 'line))) - (list (org-icompleting-read - "source-block name: " (org-babel-src-block-names) nil t - (cond - ;; noweb - ((string-match (org-babel-noweb-wrap) under-point) - (let ((block-name (match-string 1 under-point))) - (string-match "[^(]*" block-name) - (match-string 0 block-name))) - ;; #+call: - ((string-match org-babel-lob-one-liner-regexp under-point) - (let ((source-info (car (org-babel-lob-get-info)))) - (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info) - (let ((source-name (match-string 1 source-info))) - source-name)))) - ;; #+results: - ((string-match (concat "#\\+" org-babel-results-keyword - "\\:\s+\\([^\\(]*\\)") under-point) - (match-string 1 under-point)) - ;; symbol-at-point - ((and (thing-at-point 'symbol)) - (org-babel-find-named-block (thing-at-point 'symbol)) - (thing-at-point 'symbol)) - ("")))))) + (all-block-names (org-babel-src-block-names))) + (list (completing-read + "source-block name: " all-block-names nil t + (let* ((context (org-element-context)) + (type (org-element-type context)) + (noweb-ref + (and (memq type '(inline-src-block src-block)) + (org-in-regexp (org-babel-noweb-wrap))))) + (cond + (noweb-ref + (buffer-substring + (+ (car noweb-ref) (length org-babel-noweb-wrap-start)) + (- (cdr noweb-ref) (length org-babel-noweb-wrap-end)))) + ((memq type '(babel-call inline-babel-call)) ;#+CALL: + (org-element-property :call context)) + ((car (org-element-property :results context))) ;#+RESULTS: + ((let ((symbol (thing-at-point 'symbol))) ;Symbol. + (and symbol + (member-ignore-case symbol all-block-names) + symbol))) + (t ""))))))) (let ((point (org-babel-find-named-block name))) (if point - ;; taken from `org-open-at-point' + ;; Taken from `org-open-at-point'. (progn (org-mark-ring-push) (goto-char point) (org-show-context)) (message "source-code block `%s' not found in this buffer" name)))) @@ -1796,7 +1722,7 @@ to `org-babel-named-src-block-regexp'." (let ((re (org-babel-named-src-block-regexp-for-name)) names) (while (ignore-errors (org-next-block 1 nil re)) - (push (org-match-string-no-properties 9) names)) + (push (match-string-no-properties 9) names)) names))) ;;;###autoload @@ -1804,33 +1730,31 @@ to `org-babel-named-src-block-regexp'." "Go to a named result." (interactive (let ((completion-ignore-case t)) - (list (org-icompleting-read "source-block name: " - (org-babel-result-names) nil t)))) + (list (completing-read "Source-block name: " + (org-babel-result-names) nil t)))) (let ((point (org-babel-find-named-result name))) (if point ;; taken from `org-open-at-point' (progn (goto-char point) (org-show-context)) (message "result `%s' not found in this buffer" name)))) -(defun org-babel-find-named-result (name &optional point) +(defun org-babel-find-named-result (name) "Find a named result. Return the location of the result named NAME in the current buffer or nil if no such result exists." (save-excursion - (let ((case-fold-search t)) - (goto-char (or point (point-min))) - (catch 'is-a-code-block - (when (re-search-forward - (concat org-babel-result-regexp - "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") - nil t) - (when (and (string= "name" (downcase (match-string 1))) - (or (beginning-of-line 1) - (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp) - (looking-at org-babel-lob-one-liner-regexp))) - (throw 'is-a-code-block (org-babel-find-named-result name (point)))) - (beginning-of-line 0) (point)))))) + (goto-char (point-min)) + (let ((case-fold-search t) + (re (format "^[ \t]*#\\+%s.*?:[ \t]*%s[ \t]*$" + org-babel-results-keyword + (regexp-quote name)))) + (catch :found + (while (re-search-forward re nil t) + (let ((element (org-element-at-point))) + (when (or (eq (org-element-type element) 'keyword) + (< (point) + (org-element-property :post-affiliated element))) + (throw :found (line-beginning-position))))))))) (defun org-babel-result-names (&optional file) "Returns the names of results in FILE or the current buffer." @@ -1838,7 +1762,7 @@ buffer or nil if no such result exists." (when file (find-file file)) (goto-char (point-min)) (let ((case-fold-search t) names) (while (re-search-forward org-babel-result-w-name-regexp nil t) - (setq names (cons (match-string 4) names))) + (setq names (cons (match-string-no-properties 9) names))) names))) ;;;###autoload @@ -1883,14 +1807,14 @@ region is not active then the point is demarcated." (stars (concat (make-string (or (org-current-level) 1) ?*) " ")) (lower-case-p (and block (let (case-fold-search) - (org-string-match-p "#\\+begin_src" block))))) + (string-match-p "#\\+begin_src" block))))) (if info (mapc (lambda (place) (save-excursion (goto-char place) (let ((lang (nth 0 info)) - (indent (make-string (nth 5 info) ? ))) + (indent (make-string (org-get-indentation) ?\s))) (when (string-match "^[[:space:]]*$" (buffer-substring (point-at-bol) (point-at-eol))) @@ -1909,7 +1833,7 @@ region is not active then the point is demarcated." (move-end-of-line 2)) (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>)) (let ((start (point)) - (lang (org-icompleting-read + (lang (completing-read "Lang: " (mapcar #'symbol-name (delete-dups @@ -1924,135 +1848,218 @@ region is not active then the point is demarcated." lang "\n" body (if (or (= (length body) 0) - (string-match "[\r\n]$" body)) "" "\n") + (string-suffix-p "\r" body) + (string-suffix-p "\n" body)) "" "\n") (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n"))) (goto-char start) (move-end-of-line 1))))) -(defvar org-babel-lob-one-liner-regexp) -(defun org-babel-where-is-src-block-result (&optional insert info hash indent) +(defun org-babel--insert-results-keyword (name hash) + "Insert RESULTS keyword with NAME value at point. +If NAME is nil, results are anonymous. HASH is a string used as +the results hash, or nil. Leave point before the keyword." + (save-excursion (insert "\n")) ;open line to indent. + (org-indent-line) + (delete-char 1) + (insert (concat "#+" org-babel-results-keyword + (cond ((not hash) nil) + (org-babel-hash-show-time + (format "[%s %s]" + (format-time-string "<%F %T>") + hash)) + (t (format "[%s]" hash))) + ":" + (when name (concat " " name)) + "\n")) + ;; Make sure results are going to be followed by at least one blank + ;; line so they do not get merged with the next element, e.g., + ;; + ;; #+results: + ;; : 1 + ;; + ;; : fixed-width area, unrelated to the above. + (unless (looking-at "^[ \t]*$") (save-excursion (insert "\n"))) + (beginning-of-line 0) + (when hash (org-babel-hide-hash))) + +(defun org-babel--clear-results-maybe (hash) + "Clear results when hash doesn't match HASH. + +When results hash does not match HASH, remove RESULTS keyword at +point, along with related contents. Do nothing if HASH is nil. + +Return a non-nil value if results were cleared. In this case, +leave point where new results should be inserted." + (when hash + (looking-at org-babel-result-regexp) + (unless (string= (match-string 1) hash) + (let* ((e (org-element-at-point)) + (post (copy-marker (org-element-property :post-affiliated e)))) + ;; Delete contents. + (delete-region post + (save-excursion + (goto-char (org-element-property :end e)) + (skip-chars-backward " \t\n") + (line-beginning-position 2))) + ;; Delete RESULT keyword. However, if RESULTS keyword is + ;; orphaned, ignore this part. The deletion above already + ;; took care of it. + (unless (= (point) post) + (delete-region (line-beginning-position) + (line-beginning-position 2))) + (goto-char post) + (set-marker post nil) + t)))) + +(defun org-babel-where-is-src-block-result (&optional insert _info hash) "Find where the current source block results begin. + Return the point at the beginning of the result of the current -source block. Specifically at the beginning of the results line. -If no result exists for this block then create a results line -following the source block." - (save-excursion - (let* ((case-fold-search t) - (on-lob-line (save-excursion - (beginning-of-line 1) - (looking-at org-babel-lob-one-liner-regexp))) - (inlinep (when (org-babel-get-inline-src-block-matches) - (match-end 0))) - (name (nth 4 (or info (org-babel-get-src-block-info 'light)))) - (head (unless on-lob-line (org-babel-where-is-src-block-head))) - found beg end) - (when head (goto-char head)) +source block, specifically at the beginning of the results line. + +If no result exists for this block return nil, unless optional +argument INSERT is non-nil. In this case, create a results line +following the source block and return the position at its +beginning. In the case of inline code, remove the results part +instead. + +If optional argument HASH is a string, remove contents related to +RESULTS keyword if its hash is different. Then update the latter +to HASH." + (let ((context (org-element-context))) + (catch :found (org-with-wide-buffer - (setq - found ;; was there a result (before we potentially insert one) - (or - inlinep - (and - ;; named results: - ;; - return t if it is found, else return nil - ;; - if it does not need to be rebuilt, then don't set end - ;; - if it does need to be rebuilt then do set end - name (setq beg (org-babel-find-named-result name)) - (prog1 beg - (when (and hash (not (string= hash (match-string 5)))) - (goto-char beg) (setq end beg) ;; beginning of result - (forward-line 1) - (delete-region end (org-babel-result-end)) nil))) - (and - ;; unnamed results: - ;; - return t if it is found, else return nil - ;; - if it is found, and the hash doesn't match, delete and set end - (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t)) - (progn (end-of-line 1) - (if (eobp) (insert "\n") (forward-char 1)) - (setq end (point)) - (and - (not name) - (progn ;; unnamed results line already exists - (catch 'non-comment - (while (re-search-forward "[^ \f\t\n\r\v]" nil t) - (beginning-of-line 1) - (cond - ((looking-at (concat org-babel-result-regexp "\n")) - (throw 'non-comment t)) - ((and (looking-at "^[ \t]*#") - (not (looking-at - org-babel-lob-one-liner-regexp))) - (end-of-line 1)) - (t (throw 'non-comment nil)))))) - (let ((this-hash (match-string 5))) - (prog1 (point) - ;; must remove and rebuild if hash!=old-hash - (if (and hash (not (string= hash this-hash))) - (progn - (setq end (point-at-bol)) - (forward-line 1) - (delete-region end (org-babel-result-end)) - (setq beg end)) - (setq end nil)))))))))) - (if (not (and insert end)) found - (goto-char end) - (unless beg - (if (looking-at "[\n\r]") (forward-char 1) (insert "\n"))) - (when (wholenump indent) (indent-to indent)) - (insert (concat - "#+" org-babel-results-keyword - (when hash - (if org-babel-hash-show-time - (concat - "["(format-time-string "<%Y-%m-%d %H:%M:%S>")" "hash"]") - (concat "["hash"]"))) - ":" - (when name (concat " " name)) "\n")) - (unless beg (insert "\n") (backward-char)) - (beginning-of-line 0) - (when hash (org-babel-hide-hash)) - (point))))) - -(defvar org-block-regexp) + (pcase (org-element-type context) + ((or `inline-babel-call `inline-src-block) + ;; Results for inline objects are located right after them. + ;; There is no RESULTS line to insert either. + (let ((limit (org-element-property + :contents-end (org-element-property :parent context)))) + (goto-char (org-element-property :end context)) + (skip-chars-forward " \t\n" limit) + (throw :found + (and + (< (point) limit) + (let ((result (org-element-context))) + (and (eq (org-element-type result) 'macro) + (string= (org-element-property :key result) + "results") + (if (not insert) (point) + (delete-region + (point) + (progn + (goto-char (org-element-property :end result)) + (skip-chars-backward " \t") + (point))) + (point)))))))) + ((or `babel-call `src-block) + (let* ((name (org-element-property :name context)) + (named-results (and name (org-babel-find-named-result name)))) + (goto-char (or named-results (org-element-property :end context))) + (cond + ;; Existing results named after the current source. + (named-results + (when (org-babel--clear-results-maybe hash) + (org-babel--insert-results-keyword name hash)) + (throw :found (point))) + ;; Named results expect but none to be found. + (name) + ;; No possible anonymous results at the very end of + ;; buffer or outside CONTEXT parent. + ((eq (point) + (or (org-element-property + :contents-end (org-element-property :parent context)) + (point-max)))) + ;; Check if next element is an anonymous result below + ;; the current block. + ((let* ((next (org-element-at-point)) + (end (save-excursion + (goto-char + (org-element-property :post-affiliated next)) + (line-end-position))) + (empty-result-re (concat org-babel-result-regexp "$")) + (case-fold-search t)) + (re-search-forward empty-result-re end t)) + (beginning-of-line) + (when (org-babel--clear-results-maybe hash) + (org-babel--insert-results-keyword nil hash)) + (throw :found (point)))))) + ;; Ignore other elements. + (_ (throw :found nil)))) + ;; No result found. Insert a RESULTS keyword below element, if + ;; appropriate. In this case, ensure there is an empty line + ;; after the previous element. + (when insert + (save-excursion + (goto-char (min (org-element-property :end context) (point-max))) + (skip-chars-backward " \t\n") + (forward-line) + (unless (bolp) (insert "\n")) + (insert "\n") + (org-babel--insert-results-keyword + (org-element-property :name context) hash) + (point)))))) + +(defun org-babel-read-element (element) + "Read ELEMENT into emacs-lisp. +Return nil if ELEMENT cannot be read." + (org-with-wide-buffer + (goto-char (org-element-property :post-affiliated element)) + (pcase (org-element-type element) + (`fixed-width + (let ((v (org-trim (org-element-property :value element)))) + (or (org-babel--string-to-number v) v))) + (`table (org-babel-read-table)) + (`plain-list (org-babel-read-list)) + (`example-block + (let ((v (org-element-property :value element))) + (if (or org-src-preserve-indentation + (org-element-property :preserve-indent element)) + v + (org-remove-indentation v)))) + (`export-block + (org-remove-indentation (org-element-property :value element))) + (`paragraph + ;; Treat paragraphs containing a single link specially. + (skip-chars-forward " \t") + (if (and (looking-at org-bracket-link-regexp) + (save-excursion + (goto-char (match-end 0)) + (skip-chars-forward " \r\t\n") + (<= (org-element-property :end element) + (point)))) + (org-babel-read-link) + (buffer-substring-no-properties + (org-element-property :contents-begin element) + (org-element-property :contents-end element)))) + ((or `center-block `quote-block `verse-block `special-block) + (org-remove-indentation + (buffer-substring-no-properties + (org-element-property :contents-begin element) + (org-element-property :contents-end element)))) + (_ nil)))) + (defun org-babel-read-result () - "Read the result at `point' into emacs-lisp." - (let ((case-fold-search t) result-string) - (cond - ((org-at-table-p) (org-babel-read-table)) - ((org-at-item-p) (org-babel-read-list)) - ((looking-at org-bracket-link-regexp) (org-babel-read-link)) - ((looking-at org-block-regexp) (org-remove-indentation (match-string 4))) - ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$")) - (setq result-string - (org-babel-trim - (mapconcat (lambda (line) - (or (and (> (length line) 1) - (string-match "^[ \t]*: ?\\(.+\\)" line) - (match-string 1 line)) - "")) - (split-string - (buffer-substring - (point) (org-babel-result-end)) "[\r\n]+") - "\n"))) - (or (org-babel-number-p result-string) result-string)) - ((looking-at org-babel-result-regexp) - (save-excursion (forward-line 1) (org-babel-read-result)))))) + "Read the result at point into emacs-lisp." + (and (not (save-excursion + (beginning-of-line) + (looking-at-p "[ \t]*$"))) + (org-babel-read-element (org-element-at-point)))) (defun org-babel-read-table () - "Read the table at `point' into emacs-lisp." + "Read the table at point into emacs-lisp." (mapcar (lambda (row) (if (and (symbolp row) (equal row 'hline)) row (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row))) (org-table-to-lisp))) (defun org-babel-read-list () - "Read the list at `point' into emacs-lisp." + "Read the list at point into emacs-lisp." (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) - (mapcar #'cadr (cdr (org-list-parse-list))))) + (cdr (org-list-to-lisp)))) (defvar org-link-types-re) (defun org-babel-read-link () - "Read the link at `point' into emacs-lisp. + "Read the link at point into emacs-lisp. If the path of the link is a file path it is expanded using `expand-file-name'." (let* ((case-fold-search t) @@ -2077,8 +2084,7 @@ If the path of the link is a file path it is expanded using ;; scalar result (funcall echo-res result)))) -(defun org-babel-insert-result - (result &optional result-params info hash indent lang) +(defun org-babel-insert-result (result &optional result-params info hash lang) "Insert RESULT into the current buffer. By default RESULT is inserted after the end of the current source @@ -2094,21 +2100,21 @@ replace - (default option) insert results after the source block or inline source block replacing any previously inserted results. -silent -- no results are inserted into the Org-mode buffer but +silent -- no results are inserted into the Org buffer but the results are echoed to the minibuffer and are ingested by Emacs (a potentially time consuming process). file ---- the results are interpreted as a file path, and are - inserted into the buffer using the Org-mode file syntax. + inserted into the buffer using the Org file syntax. -list ---- the results are interpreted as an Org-mode list. +list ---- the results are interpreted as an Org list. -raw ----- results are added directly to the Org-mode file. This - is a good option if you code block will output org-mode +raw ----- results are added directly to the Org file. This is + a good option if you code block will output Org formatted text. -drawer -- results are added directly to the Org-mode file as with +drawer -- results are added directly to the Org file as with \"raw\", but are wrapped in a RESULTS drawer or results macro, allowing them to later be replaced or removed automatically. @@ -2119,15 +2125,16 @@ org ----- results are added inside of a \"src_org{}\" or \"#+BEGIN_SRC but Org syntax here will be discarded when exporting the file. -html ---- results are added inside of a #+BEGIN_HTML block or - html export snippet depending on whether the current +html ---- results are added inside of a #+BEGIN_EXPORT HTML block + or html export snippet depending on whether the current source block is inline or not. This is a good option if your code block will output html formatted text. -latex --- results are added inside of a #+BEGIN_LATEX block or - latex export snippet depending on whether the current - source block is inline or not. This is a good option - if your code block will output latex formatted text. +latex --- results are added inside of a #+BEGIN_EXPORT LATEX + block or latex export snippet depending on whether the + current source block is inline or not. This is a good + option if your code block will output latex formatted + text. code ---- the results are extracted in the syntax of the source code of the language being evaluated and are added @@ -2151,203 +2158,201 @@ INFO may provide the values of these header arguments (in the :wrap --- the effect is similar to `latex' in RESULT-PARAMS but using the argument supplied to specify the export block or snippet type." - - (if (stringp result) - (progn - (setq result (org-no-properties result)) - (when (member "file" result-params) - (setq result (org-babel-result-to-file - result (when (assoc :file-desc (nth 2 info)) - (or (cdr (assoc :file-desc (nth 2 info))) - result)))))) - (unless (listp result) (setq result (format "%S" result)))) + (cond ((stringp result) + (setq result (org-no-properties result)) + (when (member "file" result-params) + (setq result (org-babel-result-to-file + result (when (assq :file-desc (nth 2 info)) + (or (cdr (assq :file-desc (nth 2 info))) + result)))))) + ((listp result)) + (t (setq result (format "%S" result)))) (if (and result-params (member "silent" result-params)) - (progn - (message (replace-regexp-in-string "%" "%%" (format "%S" result))) - result) - (save-excursion - (let* ((inlinep - (save-excursion - (when (or (org-babel-get-inline-src-block-matches) - (org-babel-get-lob-one-liner-matches)) - (goto-char (match-end 0)) - (org-babel-remove-inline-result) - (insert " ") - (point)))) - (existing-result - (unless inlinep - (org-babel-where-is-src-block-result t info hash indent))) - (bad-inline-p - (when inlinep - (or - (and (member "table" result-params) "`:results table'") - (and (listp result) "list result") - (and (org-string-match-p "\n." result) "multiline result") - (and (member "list" result-params) "`:results list'")))) - (results-switches - (cdr (assoc :results_switches (nth 2 info)))) - (visible-beg (point-min-marker)) - (visible-end (point-max-marker)) - ;; When results exist outside of the current visible - ;; region of the buffer, be sure to widen buffer to - ;; update them. - (outside-scope-p (and existing-result + (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result))) + result) + (let ((inline (let ((context (org-element-context))) + (and (memq (org-element-type context) + '(inline-babel-call inline-src-block)) + context)))) + (when inline + (let ((warning + (or (and (member "table" result-params) "`:results table'") + (and (listp result) "list result") + (and (string-match-p "\n." result) "multiline result") + (and (member "list" result-params) "`:results list'")))) + (when warning + (user-error "Inline error: %s cannot be used" warning)))) + (save-excursion + (let* ((visible-beg (point-min-marker)) + (visible-end (copy-marker (point-max) t)) + (inline (let ((context (org-element-context))) + (and (memq (org-element-type context) + '(inline-babel-call inline-src-block)) + context))) + (existing-result (org-babel-where-is-src-block-result t nil hash)) + (results-switches (cdr (assq :results_switches (nth 2 info)))) + ;; When results exist outside of the current visible + ;; region of the buffer, be sure to widen buffer to + ;; update them. + (outside-scope (and existing-result + (buffer-narrowed-p) (or (> visible-beg existing-result) (<= visible-end existing-result)))) - beg end) - (when (and (stringp result) ; ensure results end in a newline - (not inlinep) - (> (length result) 0) - (not (or (string-equal (substring result -1) "\n") - (string-equal (substring result -1) "\r")))) - (setq result (concat result "\n"))) - (unwind-protect - (progn - (when outside-scope-p (widen)) - (if (not existing-result) - (setq beg (or inlinep (point))) - (goto-char existing-result) - (save-excursion - (re-search-forward "#" nil t) - (setq indent (- (current-column) 1))) - (forward-line 1) + beg end indent) + ;; Ensure non-inline results end in a newline. + (when (and (org-string-nw-p result) + (not inline) + (not (string-equal (substring result -1) "\n"))) + (setq result (concat result "\n"))) + (unwind-protect + (progn + (when outside-scope (widen)) + (if existing-result (goto-char existing-result) + (goto-char (org-element-property :end inline)) + (skip-chars-backward " \t")) + (unless inline + (setq indent (org-get-indentation)) + (forward-line 1)) (setq beg (point)) (cond + (inline + ;; Make sure new results are separated from the + ;; source code by one space. + (unless existing-result + (insert " ") + (setq beg (point)))) ((member "replace" result-params) (delete-region (point) (org-babel-result-end))) ((member "append" result-params) (goto-char (org-babel-result-end)) (setq beg (point-marker))) - ((member "prepend" result-params)))) ; already there - (setq results-switches - (if results-switches (concat " " results-switches) "")) - (let ((wrap (lambda (start finish &optional no-escape no-newlines - inline-start inline-finish) - (when inlinep - (setq start inline-start) - (setq finish inline-finish) - (setq no-newlines t)) - (goto-char end) - (insert (concat finish (unless no-newlines "\n"))) - (goto-char beg) - (insert (concat start (unless no-newlines "\n"))) - (unless no-escape - (org-escape-code-in-region (min (point) end) end)) - (goto-char end) - (unless no-newlines (goto-char (point-at-eol))) - (setq end (point-marker)))) - (tabulablep - (lambda (r) - ;; Non-nil when result R can be turned into - ;; a table. - (and (listp r) - (null (cdr (last r))) - (org-every - (lambda (e) (or (atom e) (null (cdr (last e))))) - result))))) - ;; insert results based on type - (cond - ;; Do nothing for an empty result. - ((null result)) - ;; Illegal inline result or params. - (bad-inline-p - (error "Inline error: %s cannot be used" bad-inline-p)) - ;; insert a list if preferred - ((member "list" result-params) - (insert - (org-babel-trim - (org-list-to-generic - (cons 'unordered - (mapcar - (lambda (el) (list nil (if (stringp el) el (format "%S" el)))) - (if (listp result) result (split-string result "\n" t)))) - '(:splicep nil :istart "- " :iend "\n"))) - "\n")) - ;; Try hard to print RESULT as a table. Give up if - ;; it contains an improper list. - ((funcall tabulablep result) - (goto-char beg) - (insert (concat (orgtbl-to-orgtbl - (if (org-every - (lambda (e) - (or (eq e 'hline) (listp e))) - result) - result - (list result)) - nil) - "\n")) - (goto-char beg) - (when (org-at-table-p) (org-table-align)) - (goto-char (org-table-end))) - ;; Print verbatim a list that cannot be turned into - ;; a table. - ((listp result) (insert (format "%s\n" result))) - ((member "file" result-params) - (when inlinep - (goto-char inlinep) - (setq result (org-macro-escape-arguments result))) - (insert result)) - ((and inlinep - (not (member "raw" result-params))) - (goto-char inlinep) - (insert (org-macro-escape-arguments - (org-babel-chomp result "\n")))) - (t (goto-char beg) (insert result))) - (setq end (point-marker)) - ;; possibly wrap result - (cond - (bad-inline-p) ; Do nothing. - ((assoc :wrap (nth 2 info)) - (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS"))) - (funcall wrap (concat "#+BEGIN_" name) - (concat "#+END_" (car (org-split-string name))) - nil nil (concat "{{{results(@@" name ":") "@@)}}}"))) - ((member "html" result-params) - (funcall wrap "#+BEGIN_HTML" "#+END_HTML" nil nil - "{{{results(@@html:" "@@)}}}")) - ((member "latex" result-params) - (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX" nil nil - "{{{results(@@latex:" "@@)}}}")) - ((member "org" result-params) - (goto-char beg) (if (org-at-table-p) (org-cycle)) - (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" nil nil - "{{{results(src_org{" "})}}}")) - ((member "code" result-params) - (let ((lang (or lang "none"))) - (funcall wrap (format "#+BEGIN_SRC %s%s" lang results-switches) - "#+END_SRC" nil nil - (format "{{{results(src_%s[%s]{" lang results-switches) - "})}}}"))) - ((member "raw" result-params) - (goto-char beg) (if (org-at-table-p) (org-cycle))) - ((or (member "drawer" result-params) - ;; Stay backward compatible with <7.9.2 - (member "wrap" result-params)) - (goto-char beg) (if (org-at-table-p) (org-cycle)) - (funcall wrap ":RESULTS:" ":END:" 'no-escape nil - "{{{results(" ")}}}")) - ((and inlinep (member "file" result-params)) - (funcall wrap nil nil nil nil "{{{results(" ")}}}")) - ((and (not (funcall tabulablep result)) - (not (member "file" result-params))) - (let ((org-babel-inline-result-wrap - ;; Hard code {{{results(...)}}} on top of customization. - (format "{{{results(%s)}}}" org-babel-inline-result-wrap))) - (org-babel-examplify-region beg end results-switches) - (setq end (point)))))) - ;; possibly indent the results to match the #+results line - (when (and (not inlinep) (numberp indent) indent (> indent 0) - ;; in this case `table-align' does the work for us - (not (and (listp result) - (member "append" result-params)))) - (indent-rigidly beg end indent)) - (if (null result) - (if (member "value" result-params) - (message "Code block returned no value.") - (message "Code block produced no output.")) - (message "Code block evaluation complete."))) - (when outside-scope-p (narrow-to-region visible-beg visible-end)) - (set-marker visible-beg nil) - (set-marker visible-end nil)))))) + ((member "prepend" result-params))) ; already there + (setq results-switches + (if results-switches (concat " " results-switches) "")) + (let ((wrap (lambda (start finish &optional no-escape no-newlines + inline-start inline-finish) + (when inline + (setq start inline-start) + (setq finish inline-finish) + (setq no-newlines t)) + (goto-char end) + (insert (concat finish (unless no-newlines "\n"))) + (goto-char beg) + (insert (concat start (unless no-newlines "\n"))) + (unless no-escape + (org-escape-code-in-region (min (point) end) end)) + (goto-char end) + (unless no-newlines (goto-char (point-at-eol))) + (setq end (point-marker)))) + (tabulablep + (lambda (r) + ;; Non-nil when result R can be turned into + ;; a table. + (and (listp r) + (null (cdr (last r))) + (cl-every + (lambda (e) (or (atom e) (null (cdr (last e))))) + result))))) + ;; insert results based on type + (cond + ;; Do nothing for an empty result. + ((null result)) + ;; Insert a list if preferred. + ((member "list" result-params) + (insert + (org-trim + (org-list-to-generic + (cons 'unordered + (mapcar + (lambda (e) + (list (if (stringp e) e (format "%S" e)))) + (if (listp result) result + (split-string result "\n" t)))) + '(:splicep nil :istart "- " :iend "\n"))) + "\n")) + ;; Try hard to print RESULT as a table. Give up if + ;; it contains an improper list. + ((funcall tabulablep result) + (goto-char beg) + (insert (concat (orgtbl-to-orgtbl + (if (cl-every + (lambda (e) + (or (eq e 'hline) (listp e))) + result) + result + (list result)) + nil) + "\n")) + (goto-char beg) + (when (org-at-table-p) (org-table-align)) + (goto-char (org-table-end))) + ;; Print verbatim a list that cannot be turned into + ;; a table. + ((listp result) (insert (format "%s\n" result))) + ((member "file" result-params) + (when inline + (setq result (org-macro-escape-arguments result))) + (insert result)) + ((and inline (not (member "raw" result-params))) + (insert (org-macro-escape-arguments + (org-babel-chomp result "\n")))) + (t (goto-char beg) (insert result))) + (setq end (point-marker)) + ;; possibly wrap result + (cond + ((assq :wrap (nth 2 info)) + (let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS"))) + (funcall wrap (concat "#+BEGIN_" name) + (concat "#+END_" (car (org-split-string name))) + nil nil (concat "{{{results(@@" name ":") "@@)}}}"))) + ((member "html" result-params) + (funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil + "{{{results(@@html:" "@@)}}}")) + ((member "latex" result-params) + (funcall wrap "#+BEGIN_EXPORT latex" "#+END_EXPORT" nil nil + "{{{results(@@latex:" "@@)}}}")) + ((member "org" result-params) + (goto-char beg) (when (org-at-table-p) (org-cycle)) + (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" nil nil + "{{{results(src_org{" "})}}}")) + ((member "code" result-params) + (let ((lang (or lang "none"))) + (funcall wrap (format "#+BEGIN_SRC %s%s" lang results-switches) + "#+END_SRC" nil nil + (format "{{{results(src_%s[%s]{" lang results-switches) + "})}}}"))) + ((member "raw" result-params) + (goto-char beg) (when (org-at-table-p) (org-cycle))) + ((or (member "drawer" result-params) + ;; Stay backward compatible with <7.9.2 + (member "wrap" result-params)) + (goto-char beg) (when (org-at-table-p) (org-cycle)) + (funcall wrap ":RESULTS:" ":END:" 'no-escape nil + "{{{results(" ")}}}")) + ((and inline (member "file" result-params)) + (funcall wrap nil nil nil nil "{{{results(" ")}}}")) + ((and (not (funcall tabulablep result)) + (not (member "file" result-params))) + (let ((org-babel-inline-result-wrap + ;; Hard code {{{results(...)}}} on top of customization. + (format "{{{results(%s)}}}" + org-babel-inline-result-wrap))) + (org-babel-examplify-region beg end results-switches inline) + (setq end (point)))))) + ;; Possibly indent results in par with #+results line. + (when (and (not inline) (numberp indent) (> indent 0) + ;; In this case `table-align' does the work + ;; for us. + (not (and (listp result) + (member "append" result-params)))) + (indent-rigidly beg end indent)) + (if (null result) + (if (member "value" result-params) + (message "Code block returned no value.") + (message "Code block produced no output.")) + (message "Code block evaluation complete."))) + (when outside-scope (narrow-to-region visible-beg visible-end)) + (set-marker visible-beg nil) + (set-marker visible-end nil))))))) (defun org-babel-remove-result (&optional info keep-keyword) "Remove the result of the current source block." @@ -2361,23 +2366,29 @@ INFO may provide the values of these header arguments (in the (if keep-keyword (1+ (match-end 0)) (1- (match-beginning 0))) (progn (forward-line 1) (org-babel-result-end)))))))) -(defun org-babel-remove-inline-result () +(defun org-babel-remove-inline-result (&optional datum) "Remove the result of the current inline-src-block or babel call. The result must be wrapped in a `results' macro to be removed. -Leading whitespace is trimmed." +Leading white space is trimmed." (interactive) - (let* ((el (org-element-context)) - (post-blank (org-element-property :post-blank el))) + (let* ((el (or datum (org-element-context)))) (when (memq (org-element-type el) '(inline-src-block inline-babel-call)) (org-with-wide-buffer - (goto-char (org-element-property :end el)) - (let ((el (org-element-context))) - (when (and (eq (org-element-type el) 'macro) - (string= (org-element-property :key el) "results")) - (delete-region ; And leading whitespace. - (- (org-element-property :begin el) post-blank) - (- (org-element-property :end el) - (org-element-property :post-blank el))))))))) + (goto-char (org-element-property :end el)) + (skip-chars-backward " \t") + (let ((result (save-excursion + (skip-chars-forward + " \t\n" + (org-element-property + :contents-end (org-element-property :parent el))) + (org-element-context)))) + (when (and (eq (org-element-type result) 'macro) + (string= (org-element-property :key result) "results")) + (delete-region ; And leading whitespace. + (point) + (progn (goto-char (org-element-property :end result)) + (skip-chars-backward " \t\n") + (point))))))))) (defun org-babel-remove-result-one-or-many (x) "Remove the result of the current source block. @@ -2427,35 +2438,23 @@ file's directory then expand relative links." (defvar org-babel-capitalize-example-region-markers nil "Make true to capitalize begin/end example markers inserted by code blocks.") -(define-obsolete-function-alias - 'org-babel-examplize-region - 'org-babel-examplify-region "25.1") - -(defun org-babel-examplify-region (beg end &optional results-switches) +(defun org-babel-examplify-region (beg end &optional results-switches inline) "Comment out region using the inline `==' or `: ' org example quote." (interactive "*r") - (let ((chars-between (lambda (b e) - (not (string-match "^[\\s]*$" - (buffer-substring b e))))) - (maybe-cap (lambda (str) (if org-babel-capitalize-example-region-markers - (upcase str) str))) - (beg-bol (save-excursion (goto-char beg) (point-at-bol))) - (end-bol (save-excursion (goto-char end) (point-at-bol))) - (end-eol (save-excursion (goto-char end) (point-at-eol)))) - (if (and (not (= end end-bol)) - (or (funcall chars-between beg-bol beg) - (funcall chars-between end end-eol))) + (let ((maybe-cap + (lambda (str) + (if org-babel-capitalize-example-region-markers (upcase str) str)))) + (if inline (save-excursion (goto-char beg) (insert (format org-babel-inline-result-wrap - (prog1 (buffer-substring beg end) - (delete-region beg end))))) + (delete-and-extract-region beg end)))) (let ((size (count-lines beg end))) (save-excursion (cond ((= size 0)) ; do nothing for an empty result ((< size org-babel-min-lines-for-block-output) (goto-char beg) - (dotimes (n size) + (dotimes (_ size) (beginning-of-line 1) (insert ": ") (forward-line 1))) (t (goto-char beg) @@ -2501,144 +2500,103 @@ This takes into account some special considerations for certain parameters when merging lists." (let* ((results-exclusive-groups (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'results org-babel-common-header-args-w-values)))) + (cdr (assq 'results org-babel-common-header-args-w-values)))) (exports-exclusive-groups (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'exports org-babel-common-header-args-w-values)))) - (variable-index 0) - (e-merge (lambda (exclusive-groups &rest result-params) - ;; maintain exclusivity of mutually exclusive parameters - (let (output) - (mapc (lambda (new-params) - (mapc (lambda (new-param) - (mapc (lambda (exclusive-group) - (when (member new-param exclusive-group) - (mapcar (lambda (excluded-param) - (setq output - (delete - excluded-param - output))) - exclusive-group))) - exclusive-groups) - (setq output (org-uniquify - (cons new-param output)))) - new-params)) - result-params) - output))) - params results exports tangle noweb cache vars shebang comments padline - clearnames) - - (mapc - (lambda (plist) - (mapc - (lambda (pair) - (case (car pair) - (:var - (let ((name (if (listp (cdr pair)) - (cadr pair) - (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" - (cdr pair)) - (intern (match-string 1 (cdr pair))))))) - (if name - (setq vars - (append - (if (member name (mapcar #'car vars)) - (progn - (push name clearnames) - (delq nil - (mapcar - (lambda (p) - (unless (equal (car p) name) p)) - vars))) - vars) - (list (cons name pair)))) - ;; if no name is given and we already have named variables - ;; then assign to named variables in order - (if (and vars (nth variable-index vars)) - (let ((name (car (nth variable-index vars)))) - (push name clearnames) ; clear out colnames - ; and rownames - ; for replace vars - (prog1 (setf (cddr (nth variable-index vars)) - (concat (symbol-name name) "=" (cdr pair))) - (incf variable-index))) - (error "Variable \"%s\" must be assigned a default value" - (cdr pair)))))) - (:results - (setq results (funcall e-merge results-exclusive-groups - results - (split-string - (let ((r (cdr pair))) - (if (stringp r) r (eval r))))))) - (:file - (when (cdr pair) - (setq results (funcall e-merge results-exclusive-groups - results '("file"))) - (unless (or (member "both" exports) - (member "none" exports) - (member "code" exports)) - (setq exports (funcall e-merge exports-exclusive-groups - exports '("results")))) - (setq params (cons pair (assq-delete-all (car pair) params))))) - (:file-ext - (when (cdr pair) - (setq results (funcall e-merge results-exclusive-groups - results '("file"))) - (unless (or (member "both" exports) - (member "none" exports) - (member "code" exports)) - (setq exports (funcall e-merge exports-exclusive-groups - exports '("results")))) - (setq params (cons pair (assq-delete-all (car pair) params))))) - (:exports - (setq exports (funcall e-merge exports-exclusive-groups - exports - (split-string (or (cdr pair) ""))))) - (:tangle ;; take the latest -- always overwrite - (setq tangle (or (list (cdr pair)) tangle))) - (:noweb - (setq noweb (funcall e-merge - '(("yes" "no" "tangle" "no-export" - "strip-export" "eval")) - noweb - (split-string (or (cdr pair) ""))))) - (:cache - (setq cache (funcall e-merge '(("yes" "no")) cache - (split-string (or (cdr pair) ""))))) - (:padline - (setq padline (funcall e-merge '(("yes" "no")) padline - (split-string (or (cdr pair) ""))))) - (:shebang ;; take the latest -- always overwrite - (setq shebang (or (list (cdr pair)) shebang))) - (:comments - (setq comments (funcall e-merge '(("yes" "no")) comments - (split-string (or (cdr pair) ""))))) - (t ;; replace: this covers e.g. :session - (setq params (cons pair (assq-delete-all (car pair) params)))))) - plist)) - plists) - (setq vars (reverse vars)) - (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) - ;; clear out col-names and row-names for replaced variables - (mapc - (lambda (name) - (mapc - (lambda (param) - (when (assoc param params) - (setf (cdr (assoc param params)) - (org-remove-if (lambda (pair) (equal (car pair) name)) - (cdr (assoc param params)))) - (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param) - (null (cdr pair)))) - params)))) - (list :colname-names :rowname-names))) - clearnames) - (mapc - (lambda (hd) - (let ((key (intern (concat ":" (symbol-name hd)))) - (val (eval hd))) - (setf params (cons (cons key (mapconcat 'identity val " ")) params)))) - '(results exports tangle noweb padline cache shebang comments)) + (cdr (assq 'exports org-babel-common-header-args-w-values)))) + (merge + (lambda (exclusive-groups &rest result-params) + ;; Maintain exclusivity of mutually exclusive parameters, + ;; as defined in EXCLUSIVE-GROUPS while merging lists in + ;; RESULT-PARAMS. + (let (output) + (dolist (new-params result-params (delete-dups output)) + (dolist (new-param new-params) + (dolist (exclusive-group exclusive-groups) + (when (member new-param exclusive-group) + (setq output (cl-remove-if + (lambda (o) (member o exclusive-group)) + output)))) + (push new-param output)))))) + (variable-index 0) ;Handle positional arguments. + clearnames + params ;Final parameters list. + ;; Some keywords accept multiple values. We need to treat + ;; them specially. + vars results exports) + (dolist (plist plists) + (dolist (pair plist) + (pcase pair + (`(:var . ,value) + (let ((name (cond + ((listp value) (car value)) + ((string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" value) + (intern (match-string 1 value))) + (t nil)))) + (cond + (name + (setq vars + (append (if (not (assoc name vars)) vars + (push name clearnames) + (cl-remove-if (lambda (p) (equal name (car p))) + vars)) + (list (cons name pair))))) + ((and vars (nth variable-index vars)) + ;; If no name is given and we already have named + ;; variables then assign to named variables in order. + (let ((name (car (nth variable-index vars)))) + ;; Clear out colnames and rownames for replace vars. + (push name clearnames) + (setf (cddr (nth variable-index vars)) + (concat (symbol-name name) "=" value)) + (cl-incf variable-index))) + (t (error "Variable \"%s\" must be assigned a default value" + (cdr pair)))))) + (`(:results . ,value) + (setq results (funcall merge + results-exclusive-groups + results + (split-string + (if (stringp value) value (eval value t)))))) + (`(,(or :file :file-ext) . ,value) + ;; `:file' and `:file-ext' are regular keywords but they + ;; imply a "file" `:results' and a "results" `:exports'. + (when value + (setq results + (funcall merge results-exclusive-groups results '("file"))) + (unless (or (member "both" exports) + (member "none" exports) + (member "code" exports)) + (setq exports + (funcall merge + exports-exclusive-groups exports '("results")))) + (push pair params))) + (`(:exports . ,value) + (setq exports (funcall merge + exports-exclusive-groups + exports + (split-string (or value ""))))) + ;; Regular keywords: any value overwrites the previous one. + (_ (setq params (cons pair (assq-delete-all (car pair) params))))))) + ;; Handle `:var' and clear out colnames and rownames for replaced + ;; variables. + (setq params (nconc (mapcar (lambda (v) (cons :var (cddr v))) vars) + params)) + (dolist (name clearnames) + (dolist (param '(:colname-names :rowname-names)) + (when (assq param params) + (setf (cdr (assq param params)) + (cl-remove-if (lambda (pair) (equal name (car pair))) + (cdr (assq param params)))) + (setq params + (cl-remove-if (lambda (pair) (and (equal (car pair) param) + (null (cdr pair)))) + params))))) + ;; Handle other special keywords, which accept multiple values. + (setq params (nconc (list (cons :results (mapconcat #'identity results " ")) + (cons :exports (mapconcat #'identity exports " "))) + params)) + ;; Return merged params. params)) (defvar org-babel-use-quick-and-dirty-noweb-expansion nil @@ -2650,17 +2608,12 @@ header argument from buffer or subtree wide properties.") (defun org-babel-noweb-p (params context) "Check if PARAMS require expansion in CONTEXT. CONTEXT may be one of :tangle, :export or :eval." - (let* (intersect - (intersect (lambda (as bs) - (when as - (if (member (car as) bs) - (car as) - (funcall intersect (cdr as) bs)))))) - (funcall intersect (case context - (:tangle '("yes" "tangle" "no-export" "strip-export")) - (:eval '("yes" "no-export" "strip-export" "eval")) - (:export '("yes"))) - (split-string (or (cdr (assoc :noweb params)) ""))))) + (let ((allowed-values (cl-case context + (:tangle '("yes" "tangle" "no-export" "strip-export")) + (:eval '("yes" "no-export" "strip-export" "eval")) + (:export '("yes"))))) + (cl-some (lambda (v) (member v allowed-values)) + (split-string (or (cdr (assq :noweb params)) ""))))) (defun org-babel-expand-noweb-references (&optional info parent-buffer) "Expand Noweb references in the body of the current source code block. @@ -2698,7 +2651,7 @@ block but are passed literally to the \"example-block\"." (body (nth 1 info)) (ob-nww-start org-babel-noweb-wrap-start) (ob-nww-end org-babel-noweb-wrap-end) - (comment (string= "noweb" (cdr (assoc :comments (nth 2 info))))) + (comment (string= "noweb" (cdr (assq :comments (nth 2 info))))) (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|" ":noweb-ref[ \t]+" "\\)")) (new-body "") @@ -2707,11 +2660,11 @@ block but are passed literally to the \"example-block\"." (with-temp-buffer (funcall (intern (concat lang "-mode"))) (comment-region (point) (progn (insert text) (point))) - (org-babel-trim (buffer-string))))) + (org-trim (buffer-string))))) index source-name evaluate prefix) (with-temp-buffer - (org-set-local 'org-babel-noweb-wrap-start ob-nww-start) - (org-set-local 'org-babel-noweb-wrap-end ob-nww-end) + (setq-local org-babel-noweb-wrap-start ob-nww-start) + (setq-local org-babel-noweb-wrap-end ob-nww-end) (insert body) (goto-char (point-min)) (setq index (point)) (while (and (re-search-forward (org-babel-noweb-wrap) nil t)) @@ -2755,7 +2708,7 @@ block but are passed literally to the \"example-block\"." (while (re-search-forward rx nil t) (let* ((i (org-babel-get-src-block-info 'light)) (body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + (sep (or (cdr (assq :noweb-sep (nth 2 i))) "\n")) (full (if comment (let ((cs (org-babel-tangle-comment-links i))) @@ -2766,11 +2719,11 @@ block but are passed literally to the \"example-block\"." (setq expansion (cons sep (cons full expansion))))) (org-babel-map-src-blocks nil (let ((i (org-babel-get-src-block-info 'light))) - (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) + (when (equal (or (cdr (assq :noweb-ref (nth 2 i))) (nth 4 i)) source-name) (let* ((body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + (sep (or (cdr (assq :noweb-sep (nth 2 i))) "\n")) (full (if comment (let ((cs (org-babel-tangle-comment-links i))) @@ -2827,7 +2780,7 @@ block but are passed literally to the \"example-block\"." ;; the character was (because one layer of quoting will ;; be stripped by `org-babel-read'). (t (append (list ch ?\\ ?\\) out)))) - (case ch + (cl-case ch (?\[ (if (or in-double in-single) (cons ?\[ out) (cons ?\( out))) @@ -2895,24 +2848,23 @@ lisp, otherwise return it unmodified as a string. Optional argument INHIBIT-LISP-EVAL inhibits lisp evaluation for situations in which is it not appropriate." (if (and (stringp cell) (not (equal cell ""))) - (or (org-babel-number-p cell) + (or (org-babel--string-to-number cell) (if (and (not inhibit-lisp-eval) (or (member (substring cell 0 1) '("(" "'" "`" "[")) (string= cell "*this*"))) - (eval (read cell)) + (eval (read cell) t) (if (string= (substring cell 0 1) "\"") (read cell) (progn (set-text-properties 0 (length cell) nil cell) cell)))) cell)) -(defun org-babel-number-p (string) - "If STRING represents a number return its value." - (if (and (string-match "[0-9]+" string) - (string-match "^-?[0-9]*\\.?[0-9]*$" string) - (= (length (substring string (match-beginning 0) - (match-end 0))) - (length string))) - (string-to-number string))) +(defun org-babel--string-to-number (string) + "If STRING represents a number return its value. + +Otherwise return nil." + (when (string-match "\\`-?[0-9]*\\.?[0-9]*\\'" string) + (string-to-number string))) +(define-obsolete-function-alias 'org-babel-number-p 'org-babel--string-to-number "Org 9.0") (defun org-babel-import-elisp-from-file (file-name &optional separator) "Read the results located at FILE-NAME into an elisp table. @@ -2953,33 +2905,6 @@ can be specified as the REGEXP argument." (setq string (substring string 0 -1))) string)) -(defun org-babel-trim (string &optional regexp) - "Strip a leading and trailing space or carriage return from STRING. -Like `org-babel-chomp', but run on both the first and last -character of the string." - (org-babel-chomp - (org-reverse-string - (org-babel-chomp (org-reverse-string string) regexp)) regexp)) - -(defun org-babel-tramp-handle-call-process-region - (start end program &optional delete buffer display &rest args) - "Use Tramp to handle `call-process-region'. -Fixes a bug in `tramp-handle-call-process-region'." - (if (and (featurep 'tramp) (file-remote-p default-directory)) - (let ((tmpfile (tramp-compat-make-temp-file ""))) - (write-region start end tmpfile) - (when delete (delete-region start end)) - (unwind-protect - ;; (apply 'call-process program tmpfile buffer display args) - ;; bug in tramp - (apply 'process-file program tmpfile buffer display args) - (delete-file tmpfile))) - ;; org-babel-call-process-region-original is the original emacs - ;; definition. It is in scope from the let binding in - ;; org-babel-execute-src-block - (apply org-babel-call-process-region-original - start end program delete buffer display args))) - (defun org-babel-local-file-name (file) "Return the local name component of FILE." (or (file-remote-p file 'localname) file)) @@ -3129,15 +3054,42 @@ plus the parameter value." (setq params (cons (cons :file fname) params)))) params)) -;;; Used by backends: R, Maxima, Octave. (defun org-babel-graphical-output-file (params) - "File where a babel block should send graphical output, per PARAMS." - (unless (assq :file params) - (if (assq :file-ext params) - (user-error ":file-ext given but no :file generated; did you forget to give a block a #+NAME?") - (user-error "No :file header argument given; cannot create graphical result."))) - (and (member "graphics" (cdr (assq :result-params params))) - (cdr (assq :file params)))) + "File where a babel block should send graphical output, per PARAMS. +Return nil if no graphical output is expected. Raise an error if +the output file is ill-defined." + (let ((file (cdr (assq :file params)))) + (cond (file (and (member "graphics" (cdr (assq :result-params params))) + file)) + ((assq :file-ext params) + (user-error ":file-ext given but no :file generated; did you forget \ +to name a block?")) + (t (user-error "No :file header argument given; cannot create \ +graphical result"))))) + +(defun org-babel-make-language-alias (new old) + "Make source blocks of type NEW aliases for those of type OLD. + +NEW and OLD should be strings. This function should be called +after the babel API for OLD-type source blocks is fully defined. + +Callers of this function will probably want to add an entry to +`org-src-lang-modes' as well." + (dolist (fn '("execute" "expand-body" "prep-session" + "variable-assignments" "load-session")) + (let ((sym (intern-soft (concat "org-babel-" fn ":" old)))) + (when (and sym (fboundp sym)) + (defalias (intern (concat "org-babel-" fn ":" new)) sym)))) + ;; Technically we don't need a `dolist' for just one variable, but + ;; we keep it for symmetry/ease of future expansion. + (dolist (var '("default-header-args")) + (let ((sym (intern-soft (concat "org-babel-" var ":" old)))) + (when (and sym (boundp sym)) + (defvaralias (intern (concat "org-babel-" var ":" new)) sym))))) + +(defun org-babel-strip-quotes (string) + "Strip \\\"s from around a string, if applicable." + (org-unbracket-string "\"" "\"" string)) (provide 'ob-core) diff --git a/lisp/ob-css.el b/lisp/ob-css.el index 7f3d81a..5734373 100644 --- a/lisp/ob-css.el +++ b/lisp/ob-css.el @@ -1,4 +1,4 @@ -;;; ob-css.el --- org-babel functions for css evaluation +;;; ob-css.el --- Babel Functions for CSS -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -24,19 +24,19 @@ ;;; Commentary: ;; Since CSS can't be executed, this file exists solely for tangling -;; CSS from org-mode files. +;; CSS from Org files. ;;; Code: (require 'ob) (defvar org-babel-default-header-args:css '()) -(defun org-babel-execute:css (body params) +(defun org-babel-execute:css (body _params) "Execute a block of CSS code. This function is called by `org-babel-execute-src-block'." body) -(defun org-babel-prep-session:css (session params) +(defun org-babel-prep-session:css (_session _params) "Return an error if the :session header argument is set. CSS does not support sessions." (error "CSS sessions are nonsensical")) diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el index 54238f3..1fa96aa 100644 --- a/lisp/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -1,4 +1,4 @@ -;;; ob-ditaa.el --- org-babel functions for ditaa evaluation +;;; ob-ditaa.el --- Babel Functions for ditaa -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -81,19 +81,17 @@ Do not leave leading or trailing spaces in this string." (defun org-babel-execute:ditaa (body params) "Execute a block of Ditaa code with org-babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (let ((el (cdr (assoc :file params)))) - (or el - (error - "ditaa code block requires :file header argument")))) - (cmdline (cdr (assoc :cmdline params))) - (java (cdr (assoc :java params))) + (let* ((out-file (or (cdr (assq :file params)) + (error + "ditaa code block requires :file header argument"))) + (cmdline (cdr (assq :cmdline params))) + (java (cdr (assq :java params))) (in-file (org-babel-temp-file "ditaa-")) - (eps (cdr (assoc :eps params))) + (eps (cdr (assq :eps params))) (eps-file (when eps (org-babel-process-file-name (concat in-file ".eps")))) (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf") - (cdr (assoc :pdf params)))) + (cdr (assq :pdf params)))) (concat "epstopdf" " " eps-file @@ -115,7 +113,7 @@ This function is called by `org-babel-execute-src-block'." (when pdf-cmd (message pdf-cmd) (shell-command pdf-cmd)) nil)) ;; signal that output has already been written to file -(defun org-babel-prep-session:ditaa (session params) +(defun org-babel-prep-session:ditaa (_session _params) "Return an error because ditaa does not support sessions." (error "Ditaa does not support sessions")) diff --git a/lisp/ob-dot.el b/lisp/ob-dot.el index e2e8857..8cc1c74 100644 --- a/lisp/ob-dot.el +++ b/lisp/ob-dot.el @@ -1,4 +1,4 @@ -;;; ob-dot.el --- org-babel functions for dot evaluation +;;; ob-dot.el --- Babel Functions for dot -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -46,7 +46,7 @@ (defun org-babel-expand-body:dot (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapc (lambda (pair) (let ((name (symbol-name (car pair))) @@ -64,12 +64,11 @@ (defun org-babel-execute:dot (body params) "Execute a block of Dot code with org-babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (cdr (assoc :result-params params))) - (out-file (cdr (or (assoc :file params) + (let* ((out-file (cdr (or (assq :file params) (error "You need to specify a :file parameter")))) - (cmdline (or (cdr (assoc :cmdline params)) + (cmdline (or (cdr (assq :cmdline params)) (format "-T%s" (file-name-extension out-file)))) - (cmd (or (cdr (assoc :cmd params)) "dot")) + (cmd (or (cdr (assq :cmd params)) "dot")) (in-file (org-babel-temp-file "dot-"))) (with-temp-file in-file (insert (org-babel-expand-body:dot body params))) @@ -80,7 +79,7 @@ This function is called by `org-babel-execute-src-block'." " -o " (org-babel-process-file-name out-file)) "") nil)) ;; signal that output has already been written to file -(defun org-babel-prep-session:dot (session params) +(defun org-babel-prep-session:dot (_session _params) "Return an error because Dot does not support sessions." (error "Dot does not support sessions")) diff --git a/lisp/ob-ebnf.el b/lisp/ob-ebnf.el index 9a78f6a..36f2c38 100644 --- a/lisp/ob-ebnf.el +++ b/lisp/ob-ebnf.el @@ -1,4 +1,4 @@ -;;; ob-ebnf.el --- org-babel functions for ebnf evaluation +;;; ob-ebnf.el --- Babel Functions for EBNF -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. @@ -54,13 +54,11 @@ "Execute a block of Ebnf code with org-babel. This function is called by `org-babel-execute-src-block'" (save-excursion - (let* ((dest-file (cdr (assoc :file params))) + (let* ((dest-file (cdr (assq :file params))) (dest-dir (file-name-directory dest-file)) (dest-root (file-name-sans-extension (file-name-nondirectory dest-file))) - (dest-ext (file-name-extension dest-file)) - (style (cdr (assoc :style params))) - (current-dir default-directory) + (style (cdr (assq :style params))) (result nil)) (with-temp-buffer (when style (ebnf-push-style style)) diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el index eaa1124..c42034d 100644 --- a/lisp/ob-emacs-lisp.el +++ b/lisp/ob-emacs-lisp.el @@ -1,4 +1,4 @@ -;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation +;;; ob-emacs-lisp.el --- Babel Functions for Emacs-lisp Code -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -28,13 +28,21 @@ ;;; Code: (require 'ob) -(defvar org-babel-default-header-args:emacs-lisp nil - "Default arguments for evaluating an emacs-lisp source block.") +(defconst org-babel-header-args:emacs-lisp '((lexical . :any)) + "Emacs-lisp specific header arguments.") + +(defvar org-babel-default-header-args:emacs-lisp '((:lexical . "no")) + "Default arguments for evaluating an emacs-lisp source block. + +A value of \"yes\" or t causes src blocks to be eval'd using +lexical scoping. It can also be an alist mapping symbols to +their value. It is used as the optional LEXICAL argument to +`eval', which see.") (defun org-babel-expand-body:emacs-lisp (body params) "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) + (let* ((vars (org-babel--get-vars params)) + (result-params (cdr (assq :result-params params))) (print-level nil) (print-length nil) (body (if (> (length vars) 0) (concat "(let (" @@ -51,26 +59,33 @@ (defun org-babel-execute:emacs-lisp (body params) "Execute a block of emacs-lisp code with Babel." (save-window-excursion - (let ((result - (eval (read (format (if (member "output" - (cdr (assoc :result-params params))) - "(with-output-to-string %s)" - "(progn %s)") - (org-babel-expand-body:emacs-lisp - body params)))))) - (org-babel-result-cond (cdr (assoc :result-params params)) + (let* ((lexical (cdr (assq :lexical params))) + (result + (eval (read (format (if (member "output" + (cdr (assq :result-params params))) + "(with-output-to-string %s)" + "(progn %s)") + (org-babel-expand-body:emacs-lisp + body params))) + + (if (listp lexical) + lexical + (member lexical '("yes" "t")))))) + (org-babel-result-cond (cdr (assq :result-params params)) (let ((print-level nil) (print-length nil)) - (if (or (member "scalar" (cdr (assoc :result-params params))) - (member "verbatim" (cdr (assoc :result-params params)))) + (if (or (member "scalar" (cdr (assq :result-params params))) + (member "verbatim" (cdr (assq :result-params params)))) (format "%S" result) (format "%s" result))) (org-babel-reassemble-table result - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))))) + (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)))))))) + +(org-babel-make-language-alias "elisp" "emacs-lisp") (provide 'ob-emacs-lisp) diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el index e3ac383..4a368b7 100644 --- a/lisp/ob-eval.el +++ b/lisp/ob-eval.el @@ -1,4 +1,4 @@ -;;; ob-eval.el --- org-babel functions for external code evaluation +;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -28,7 +28,6 @@ ;;; Code: (require 'org-macs) -(eval-when-compile (require 'cl)) (defvar org-babel-error-buffer-name "*Org-Babel Error Output*") (declare-function org-babel-temp-file "ob-core" (prefix &optional suffix)) @@ -121,18 +120,18 @@ function in various versions of Emacs. (delete-file input-file)) (when (and error-file (file-exists-p error-file)) - (if (< 0 (nth 7 (file-attributes error-file))) - (with-current-buffer (get-buffer-create error-buffer) - (let ((pos-from-end (- (point-max) (point)))) - (or (bobp) - (insert "\f\n")) - ;; Do no formatting while reading error file, - ;; because that can run a shell command, and we - ;; don't want that to cause an infinite recursion. - (format-insert-file error-file nil) - ;; Put point after the inserted errors. - (goto-char (- (point-max) pos-from-end))) - (current-buffer))) + (when (< 0 (nth 7 (file-attributes error-file))) + (with-current-buffer (get-buffer-create error-buffer) + (let ((pos-from-end (- (point-max) (point)))) + (or (bobp) + (insert "\f\n")) + ;; Do no formatting while reading error file, + ;; because that can run a shell command, and we + ;; don't want that to cause an infinite recursion. + (format-insert-file error-file nil) + ;; Put point after the inserted errors. + (goto-char (- (point-max) pos-from-end))) + (current-buffer))) (delete-file error-file)) exit-status)) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 983d53c..6aebcd5 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -1,4 +1,4 @@ -;;; ob-exp.el --- Exportation of org-babel source blocks +;;; ob-exp.el --- Exportation of Babel Source Blocks -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -24,82 +24,49 @@ ;;; Code: (require 'ob-core) -(require 'org-src) -(eval-when-compile - (require 'cl)) - -(defvar org-babel-lob-one-liner-regexp) -(defvar org-babel-ref-split-regexp) -(defvar org-list-forbidden-blocks) - -(declare-function org-babel-lob-get-info "ob-lob" ()) -(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) -(declare-function org-between-regexps-p "org" - (start-re end-re &optional lim-up lim-down)) -(declare-function org-get-indentation "org" (&optional line)) -(declare-function org-heading-components "org" ()) -(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) -(declare-function org-in-block-p "org" (names)) -(declare-function org-in-verbatim-emphasis "org" ()) -(declare-function org-link-search "org" (s &optional avoid-pos stealth)) -(declare-function org-fill-template "org" (template alist)) -(declare-function org-split-string "org" (string &optional separators)) + +(declare-function org-babel-lob-get-info "ob-lob" (&optional datum)) (declare-function org-element-at-point "org-element" ()) -(declare-function org-element-context "org-element" ()) +(declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) -(declare-function org-id-get "org-id" (&optional pom create prefix)) (declare-function org-escape-code-in-string "org-src" (s)) +(declare-function org-export-copy-buffer "ox" ()) +(declare-function org-fill-template "org" (template alist)) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) + +(defvar org-src-preserve-indentation) (defcustom org-export-babel-evaluate t "Switch controlling code evaluation during export. When set to nil no code will be evaluated as part of the export -process. When set to `inline-only', only inline code blocks will -be executed." +process and no header argumentss will be obeyed. When set to +`inline-only', only inline code blocks will be executed. Users +who wish to avoid evaluating code on export should use the header +argument `:eval never-export'." :group 'org-babel :version "24.1" :type '(choice (const :tag "Never" nil) (const :tag "Only inline code" inline-only) (const :tag "Always" t))) -(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) - -(defvar org-link-search-inhibit-query) -(defmacro org-babel-exp-in-export-file (lang &rest body) - (declare (indent 1)) - `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang))) - (heading-query (or (org-id-get) - ;; CUSTOM_IDs don't work, maybe they are - ;; stripped, or maybe they resolve too - ;; late in `org-link-search'. - ;; (org-entry-get nil "CUSTOM_ID") - (nth 4 (ignore-errors (org-heading-components))))) - (export-buffer (current-buffer)) - results) - (when org-babel-exp-reference-buffer - ;; Resolve parameters in the original file so that headline and - ;; file-wide parameters are included, attempt to go to the same - ;; heading in the original file - (set-buffer org-babel-exp-reference-buffer) - (save-restriction - (when heading-query - (condition-case nil - (let ((org-link-search-inhibit-query t)) - ;; TODO: When multiple headings have the same title, - ;; this returns the first, which is not always - ;; the right heading. Consider a better way to - ;; find the proper heading. - (org-link-search heading-query)) - (error (when heading-query - (goto-char (point-min)) - (re-search-forward (regexp-quote heading-query) nil t))))) - (setq results ,@body)) - (set-buffer export-buffer) - results))) -(def-edebug-spec org-babel-exp-in-export-file (form body)) - -(defun org-babel-exp-src-block (&rest headers) +(put 'org-export-babel-evaluate 'safe-local-variable #'null) + +(defmacro org-babel-exp--at-source (&rest body) + "Evaluate BODY at the source of the Babel block at point. +Source is located in `org-babel-exp-reference-buffer'. The value +returned is the value of the last form in BODY. Assume that +point is at the beginning of the Babel block." + (declare (indent 1) (debug body)) + `(let ((source (get-text-property (point) 'org-reference))) + (with-current-buffer org-babel-exp-reference-buffer + (org-with-wide-buffer + (goto-char source) + ,@body)))) + +(defun org-babel-exp-src-block () "Process source block for export. -Depending on the `export' headers argument, replace the source +Depending on the \":export\" header argument, replace the source code block like this: both ---- display the code and the results @@ -108,31 +75,36 @@ code ---- the default, display the code inside the block but do not process results - just like none only the block is run on export ensuring - that its results are present in the org-mode buffer + that its results are present in the Org mode buffer none ---- do not display either code or results upon export -Assume point is at the beginning of block's starting line." +Assume point is at block opening line." (interactive) (save-excursion (let* ((info (org-babel-get-src-block-info 'light)) - (line (org-current-line)) (lang (nth 0 info)) - (raw-params (nth 2 info)) hash) + (raw-params (nth 2 info)) + hash) ;; bail if we couldn't get any info from the block (unless noninteractive - (message "org-babel-exp process %s at line %d..." lang line)) + (message "org-babel-exp process %s at position %d..." + lang + (line-beginning-position))) (when info ;; if we're actually going to need the parameters - (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results")) - (org-babel-exp-in-export-file lang - (setf (nth 2 info) - (org-babel-process-params - (apply #'org-babel-merge-params - org-babel-default-header-args - (if (boundp lang-headers) (eval lang-headers) nil) - (append (org-babel-params-from-properties lang) - (list raw-params)))))) + (when (member (cdr (assq :exports (nth 2 info))) '("both" "results")) + (let ((lang-headers (intern (concat "org-babel-default-header-args:" + lang)))) + (org-babel-exp--at-source + (setf (nth 2 info) + (org-babel-process-params + (apply #'org-babel-merge-params + org-babel-default-header-args + (and (boundp lang-headers) + (symbol-value lang-headers)) + (append (org-babel-params-from-properties lang) + (list raw-params))))))) (setf hash (org-babel-sha1-hash info))) (org-babel-exp-do-export info 'block hash))))) @@ -153,182 +125,164 @@ this template." :group 'org-babel :type 'string) -(defvar org-babel-default-lob-header-args) -(defun org-babel-exp-process-buffer (reference-buffer) - "Execute all Babel blocks in current buffer. -REFERENCE-BUFFER is the buffer containing a pristine copy of the -buffer being processed. It is used to properly resolve -references in source blocks, as modifications in current buffer -may make them unreachable." +(defun org-babel-exp-process-buffer () + "Execute all Babel blocks in current buffer." (interactive) - (save-window-excursion - (save-excursion + (when org-export-babel-evaluate + (save-window-excursion (let ((case-fold-search t) - (org-babel-exp-reference-buffer reference-buffer) - (regexp (concat org-babel-inline-src-block-regexp "\\|" - org-babel-lob-one-liner-regexp "\\|" - "^[ \t]*#\\+BEGIN_SRC"))) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (unless (save-match-data (org-in-commented-heading-p)) - (let* ((element (save-excursion - ;; If match is inline, point is at its - ;; end. Move backward so - ;; `org-element-context' can get the - ;; object, not the following one. - (backward-char) - (save-match-data (org-element-context)))) - (type (org-element-type element)) - (begin (copy-marker (org-element-property :begin element))) - (end (copy-marker - (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (point))))) - (case type - (inline-src-block - (let* ((head (match-beginning 0)) - (info (append (org-babel-parse-inline-src-block-match) - (list nil nil head))) - (params (nth 2 info))) - (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) - (org-babel-expand-noweb-references - info org-babel-exp-reference-buffer) - (nth 1 info))) - (goto-char begin) - (let ((replacement (org-babel-exp-do-export info 'inline))) - (if (equal replacement "") - ;; Replacement code is empty: remove inline - ;; source block, including extra white space - ;; that might have been created when - ;; inserting results. - (delete-region begin - (progn (goto-char end) - (skip-chars-forward " \t") - (point))) - ;; Otherwise: remove inline src block but - ;; preserve following white spaces. Then - ;; insert value. - (delete-region begin end) - (insert replacement))))) - ((babel-call inline-babel-call) - (let* ((lob-info (org-babel-lob-get-info)) - (results - (org-babel-exp-do-export - (list "emacs-lisp" "results" - (apply #'org-babel-merge-params - org-babel-default-header-args - org-babel-default-lob-header-args - (append - (org-babel-params-from-properties) - (list - (org-babel-parse-header-arguments - (org-no-properties - (concat - ":var results=" - (mapconcat 'identity - (butlast lob-info 2) - " "))))))) - "" (nth 3 lob-info) (nth 2 lob-info)) - 'lob)) - (rep (org-fill-template - org-babel-exp-call-line-template - `(("line" . ,(nth 0 lob-info)))))) - ;; If replacement is empty, completely remove the - ;; object/element, including any extra white space - ;; that might have been created when including - ;; results. - (if (equal rep "") - (delete-region - begin - (progn (goto-char end) - (if (not (eq type 'babel-call)) - (progn (skip-chars-forward " \t") (point)) - (skip-chars-forward " \r\t\n") - (line-beginning-position)))) - ;; Otherwise, preserve following white - ;; spaces/newlines and then, insert replacement - ;; string. - (goto-char begin) - (delete-region begin end) - (insert rep)))) - (src-block - (let* ((match-start (copy-marker (match-beginning 0))) - (ind (org-get-indentation)) - (lang (or (org-element-property :language element) - (user-error - "No language for src block: %s" - (or (org-element-property :name element) - "(unnamed)")))) - (headers - (cons lang - (let ((params - (org-element-property - :parameters element))) - (and params (org-split-string params)))))) - ;; Take care of matched block: compute replacement - ;; string. In particular, a nil REPLACEMENT means - ;; the block should be left as-is while an empty - ;; string should remove the block. - (let ((replacement - (progn (goto-char match-start) - (org-babel-exp-src-block headers)))) - (cond ((not replacement) (goto-char end)) - ((equal replacement "") - (goto-char end) - (skip-chars-forward " \r\t\n") - (beginning-of-line) - (delete-region begin (point))) - (t - (goto-char match-start) - (delete-region (point) - (save-excursion (goto-char end) - (line-end-position))) - (insert replacement) - (if (or org-src-preserve-indentation - (org-element-property :preserve-indent - element)) - ;; Indent only the code block markers. - (save-excursion (skip-chars-backward " \r\t\n") - (indent-line-to ind) - (goto-char match-start) - (indent-line-to ind)) - ;; Indent everything. - (indent-rigidly match-start (point) ind))))) - (set-marker match-start nil)))) - (set-marker begin nil) - (set-marker end nil)))))))) - -(defun org-babel-in-example-or-verbatim () - "Return true if point is in example or verbatim code. -Example and verbatim code include escaped portions of -an org-mode buffer code that should be treated as normal -org-mode text." - (or (save-match-data - (save-excursion - (goto-char (point-at-bol)) - (looking-at "[ \t]*:[ \t]"))) - (org-in-verbatim-emphasis) - (org-in-block-p org-list-forbidden-blocks) - (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src"))) + (regexp (if (eq org-export-babel-evaluate 'inline-only) + "\\(call\\|src\\)_" + "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")) + ;; Get a pristine copy of current buffer so Babel + ;; references are properly resolved and source block + ;; context is preserved. + (org-babel-exp-reference-buffer (org-export-copy-buffer))) + (unwind-protect + (save-excursion + ;; First attach to every source block their original + ;; position, so that they can be retrieved within + ;; `org-babel-exp-reference-buffer', even after heavy + ;; modifications on current buffer. + ;; + ;; False positives are harmless, so we don't check if + ;; we're really at some Babel object. Moreover, + ;; `line-end-position' ensures that we propertize + ;; a noticeable part of the object, without affecting + ;; multiple objects on the same line. + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let ((s (match-beginning 0))) + (put-text-property s (line-end-position) 'org-reference s))) + ;; Evaluate from top to bottom every Babel block + ;; encountered. + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (unless (save-match-data (org-in-commented-heading-p)) + (let* ((element (save-match-data (org-element-context))) + (type (org-element-type element)) + (begin + (copy-marker (org-element-property :begin element))) + (end + (copy-marker + (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (point))))) + (pcase type + (`inline-src-block + (let* ((info + (org-babel-get-src-block-info nil element)) + (params (nth 2 info))) + (setf (nth 1 info) + (if (and (cdr (assq :noweb params)) + (string= "yes" + (cdr (assq :noweb params)))) + (org-babel-expand-noweb-references + info org-babel-exp-reference-buffer) + (nth 1 info))) + (goto-char begin) + (let ((replacement + (org-babel-exp-do-export info 'inline))) + (if (equal replacement "") + ;; Replacement code is empty: remove + ;; inline source block, including extra + ;; white space that might have been + ;; created when inserting results. + (delete-region begin + (progn (goto-char end) + (skip-chars-forward " \t") + (point))) + ;; Otherwise: remove inline src block but + ;; preserve following white spaces. Then + ;; insert value. + (delete-region begin end) + (insert replacement))))) + ((or `babel-call `inline-babel-call) + (org-babel-exp-do-export (org-babel-lob-get-info element) + 'lob) + (let ((rep + (org-fill-template + org-babel-exp-call-line-template + `(("line" . + ,(org-element-property :value element)))))) + ;; If replacement is empty, completely remove + ;; the object/element, including any extra + ;; white space that might have been created + ;; when including results. + (if (equal rep "") + (delete-region + begin + (progn (goto-char end) + (if (not (eq type 'babel-call)) + (progn (skip-chars-forward " \t") + (point)) + (skip-chars-forward " \r\t\n") + (line-beginning-position)))) + ;; Otherwise, preserve trailing + ;; spaces/newlines and then, insert + ;; replacement string. + (goto-char begin) + (delete-region begin end) + (insert rep)))) + (`src-block + (let ((match-start (copy-marker (match-beginning 0))) + (ind (org-get-indentation))) + ;; Take care of matched block: compute + ;; replacement string. In particular, a nil + ;; REPLACEMENT means the block is left as-is + ;; while an empty string removes the block. + (let ((replacement + (progn (goto-char match-start) + (org-babel-exp-src-block)))) + (cond ((not replacement) (goto-char end)) + ((equal replacement "") + (goto-char end) + (skip-chars-forward " \r\t\n") + (beginning-of-line) + (delete-region begin (point))) + (t + (goto-char match-start) + (delete-region (point) + (save-excursion + (goto-char end) + (line-end-position))) + (insert replacement) + (if (or org-src-preserve-indentation + (org-element-property + :preserve-indent element)) + ;; Indent only code block + ;; markers. + (save-excursion + (skip-chars-backward " \r\t\n") + (indent-line-to ind) + (goto-char match-start) + (indent-line-to ind)) + ;; Indent everything. + (indent-rigidly + match-start (point) ind))))) + (set-marker match-start nil)))) + (set-marker begin nil) + (set-marker end nil))))) + (kill-buffer org-babel-exp-reference-buffer) + (remove-text-properties (point-min) (point-max) '(org-reference))))))) (defun org-babel-exp-do-export (info type &optional hash) "Return a string with the exported content of a code block. The function respects the value of the :exports header argument." - (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info))))) - (when (not (and session (equal "none" session))) - (org-babel-exp-results info type 'silent))))) + (let ((silently (lambda () (let ((session (cdr (assq :session (nth 2 info))))) + (unless (equal "none" session) + (org-babel-exp-results info type 'silent))))) (clean (lambda () (if (eq type 'inline) - (org-babel-remove-inline-result) - (org-babel-remove-result info))))) - (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) - ('none (funcall silently) (funcall clean) "") - ('code (funcall silently) (funcall clean) (org-babel-exp-code info type)) - ('results (org-babel-exp-results info type nil hash) "") - ('both (org-babel-exp-results info type nil hash) - (org-babel-exp-code info type))))) + (org-babel-remove-inline-result) + (org-babel-remove-result info))))) + (pcase (or (cdr (assq :exports (nth 2 info))) "code") + ("none" (funcall silently) (funcall clean) "") + ("code" (funcall silently) (funcall clean) (org-babel-exp-code info type)) + ("results" (org-babel-exp-results info type nil hash) "") + ("both" + (org-babel-exp-results info type nil hash) + (org-babel-exp-code info type))))) (defcustom org-babel-exp-code-template "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC" @@ -369,13 +323,13 @@ defined for the code block may be used as a key and will be replaced with its value." :group 'org-babel :type 'string - :version "25.1" + :version "25.2" :package-version '(Org . "8.3")) (defun org-babel-exp-code (info type) "Return the original code block formatted for export." (setf (nth 1 info) - (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info)))) + (if (string= "strip-export" (cdr (assq :noweb (nth 2 info)))) (replace-regexp-in-string (org-babel-noweb-wrap) "" (nth 1 info)) (if (org-babel-noweb-p (nth 2 info) :export) @@ -400,14 +354,11 @@ replaced with its value." (defun org-babel-exp-results (info type &optional silent hash) "Evaluate and return the results of the current code block for export. -Results are prepared in a manner suitable for export by org-mode. +Results are prepared in a manner suitable for export by Org mode. This function is called by `org-babel-exp-do-export'. The code block will be evaluated. Optional argument SILENT can be used to inhibit insertion of results into the buffer." - (when (and (or (eq org-export-babel-evaluate t) - (and (eq type 'inline) - (eq org-export-babel-evaluate 'inline-only))) - (not (and hash (equal hash (org-babel-current-result-hash))))) + (unless (and hash (equal hash (org-babel-current-result-hash))) (let ((lang (nth 0 info)) (body (if (org-babel-noweb-p (nth 2 info) :eval) (org-babel-expand-noweb-references @@ -415,33 +366,29 @@ inhibit insertion of results into the buffer." (nth 1 info))) (info (copy-sequence info)) (org-babel-current-src-block-location (point-marker))) - ;; skip code blocks which we can't evaluate + ;; Skip code blocks which we can't evaluate. (when (fboundp (intern (concat "org-babel-execute:" lang))) (org-babel-eval-wipe-error-buffer) - (prog1 nil - (setf (nth 1 info) body) - (setf (nth 2 info) - (org-babel-exp-in-export-file lang - (org-babel-process-params - (org-babel-merge-params - (nth 2 info) - `((:results . ,(if silent "silent" "replace"))))))) - (cond - ((equal type 'block) + (setf (nth 1 info) body) + (setf (nth 2 info) + (org-babel-exp--at-source + (org-babel-process-params + (org-babel-merge-params + (nth 2 info) + `((:results . ,(if silent "silent" "replace"))))))) + (pcase type + (`block (org-babel-execute-src-block nil info)) + (`inline + ;; Position the point on the inline source block + ;; allowing `org-babel-insert-result' to check that the + ;; block is inline. + (goto-char (nth 5 info)) (org-babel-execute-src-block nil info)) - ((equal type 'inline) - ;; position the point on the inline source block allowing - ;; `org-babel-insert-result' to check that the block is - ;; inline - (re-search-backward "[ \f\t\n\r\v]" nil t) - (re-search-forward org-babel-inline-src-block-regexp nil t) - (re-search-backward "src_" nil t) - (org-babel-execute-src-block nil info)) - ((equal type 'lob) - (save-excursion - (re-search-backward org-babel-lob-one-liner-regexp nil t) - (let (org-confirm-babel-evaluate) - (org-babel-execute-src-block nil info)))))))))) + (`lob + (save-excursion + (goto-char (nth 5 info)) + (let (org-confirm-babel-evaluate) + (org-babel-execute-src-block nil info))))))))) (provide 'ob-exp) diff --git a/lisp/ob-forth.el b/lisp/ob-forth.el index 5a46d36..e487931 100644 --- a/lisp/ob-forth.el +++ b/lisp/ob-forth.el @@ -1,4 +1,4 @@ -;;; ob-forth.el --- org-babel functions for Forth +;;; ob-forth.el --- Babel Functions for Forth -*- lexical-binding: t; -*- ;; Copyright (C) 2014-2016 Free Software Foundation, Inc. @@ -35,6 +35,7 @@ (require 'ob) (declare-function forth-proc "ext:gforth" ()) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-default-header-args:forth '((:session . "yes")) "Default header arguments for forth code blocks.") @@ -42,10 +43,10 @@ (defun org-babel-execute:forth (body params) "Execute a block of Forth code with org-babel. This function is called by `org-babel-execute-src-block'" - (if (string= "none" (cdr (assoc :session params))) + (if (string= "none" (cdr (assq :session params))) (error "Non-session evaluation not supported for Forth code blocks") (let ((all-results (org-babel-forth-session-execute body params))) - (if (member "output" (cdr (assoc :result-params params))) + (if (member "output" (cdr (assq :result-params params))) (mapconcat #'identity all-results "\n") (car (last all-results)))))) @@ -76,10 +77,10 @@ This function is called by `org-babel-execute-src-block'" (org-babel-eval-error-notify 1 (buffer-substring (+ (match-beginning 0) 1) (point-max))) nil)))) - (split-string (org-babel-trim - (org-babel-expand-body:generic - body params)) - "\n" 'omit-nulls))))) + (split-string (org-trim + (org-babel-expand-body:generic body params)) + "\n" + 'omit-nulls))))) (provide 'ob-forth) diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el index ed5d2dc..6241c65 100644 --- a/lisp/ob-fortran.el +++ b/lisp/ob-fortran.el @@ -1,4 +1,4 @@ -;;; ob-fortran.el --- org-babel functions for fortran +;;; ob-fortran.el --- Babel Functions for Fortran -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -29,11 +29,12 @@ ;;; Code: (require 'ob) (require 'cc-mode) +(require 'cl-lib) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) -(declare-function org-every "org" (pred seq)) (declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90")) @@ -48,44 +49,42 @@ "This function should only be called by `org-babel-execute:fortran'" (let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90")) (tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext)) - (cmdline (cdr (assoc :cmdline params))) - (flags (cdr (assoc :flags params))) - (full-body (org-babel-expand-body:fortran body params)) - (compile - (progn - (with-temp-file tmp-src-file (insert full-body)) - (org-babel-eval - (format "%s -o %s %s %s" - org-babel-fortran-compiler - (org-babel-process-file-name tmp-bin-file) - (mapconcat 'identity - (if (listp flags) flags (list flags)) " ") - (org-babel-process-file-name tmp-src-file)) "")))) + (cmdline (cdr (assq :cmdline params))) + (flags (cdr (assq :flags params))) + (full-body (org-babel-expand-body:fortran body params))) + (with-temp-file tmp-src-file (insert full-body)) + (org-babel-eval + (format "%s -o %s %s %s" + org-babel-fortran-compiler + (org-babel-process-file-name tmp-bin-file) + (mapconcat 'identity + (if (listp flags) flags (list flags)) " ") + (org-babel-process-file-name tmp-src-file)) "") (let ((results - (org-babel-trim + (org-trim (org-remove-indentation (org-babel-eval (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-result-cond (cdr (assq :result-params params)) (org-babel-read results) (let ((tmp-file (org-babel-temp-file "f-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file))) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))) (defun org-babel-expand-body:fortran (body params) "Expand a block of fortran or fortran code with org-babel according to its header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (main-p (not (string= (cdr (assoc :main params)) "no"))) - (includes (or (cdr (assoc :includes params)) + (let ((vars (org-babel--get-vars params)) + (main-p (not (string= (cdr (assq :main params)) "no"))) + (includes (or (cdr (assq :includes params)) (org-babel-read (org-entry-get nil "includes" t)))) (defines (org-babel-read - (or (cdr (assoc :defines params)) + (or (cdr (assq :defines params)) (org-babel-read (org-entry-get nil "defines" t)))))) (mapconcat 'identity (list @@ -109,17 +108,17 @@ its header arguments." (defun org-babel-fortran-ensure-main-wrap (body params) "Wrap body in a \"program ... end program\" block if none exists." (if (string-match "^[ \t]*program[ \t]*.*" (capitalize body)) - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (if vars (error "Cannot use :vars if `program' statement is present")) body) (format "program main\n%s\nend program main\n" body))) -(defun org-babel-prep-session:fortran (session params) +(defun org-babel-prep-session:fortran (_session _params) "This function does nothing as fortran is a compiled language with no support for sessions" (error "Fortran is a compiled languages -- no support for sessions")) -(defun org-babel-load-session:fortran (session body params) +(defun org-babel-load-session:fortran (_session _body _params) "This function does nothing as fortran is a compiled language with no support for sessions" (error "Fortran is a compiled languages -- no support for sessions")) @@ -147,7 +146,7 @@ of the same value." (format "character(len=%d), parameter :: %S = '%s'\n" (length val) var val)) ;; val is a matrix - ((and (listp val) (org-every #'listp val)) + ((and (listp val) (cl-every #'listp val)) (format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n" var (length val) (length (car val)) (org-babel-fortran-transform-list val) diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el index 237ecec..e91e05a 100644 --- a/lisp/ob-gnuplot.el +++ b/lisp/ob-gnuplot.el @@ -1,4 +1,4 @@ -;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation +;;; ob-gnuplot.el --- Babel Functions for Gnuplot -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -39,9 +39,8 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) -(declare-function org-time-string-to-time "org" (s)) +(declare-function org-time-string-to-time "org" (s &optional buffer pos)) (declare-function org-combine-plists "org" (&rest plists)) (declare-function orgtbl-to-generic "org-table" (table params)) (declare-function gnuplot-mode "ext:gnuplot-mode" ()) @@ -80,7 +79,7 @@ Dumps all vectors into files and returns an association list of variable names and the related value to be used in the gnuplot code." - (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params)))) + (let ((*org-babel-gnuplot-missing* (cdr (assq :missing params)))) (mapcar (lambda (pair) (cons @@ -94,32 +93,30 @@ code." (if tablep val (mapcar 'list val))) (org-babel-temp-file "gnuplot-") params) val)))) - (mapcar #'cdr (org-babel-get-header params :var))))) + (org-babel--get-vars params)))) (defun org-babel-expand-body:gnuplot (body params) "Expand BODY according to PARAMS, return the expanded body." (save-window-excursion (let* ((vars (org-babel-gnuplot-process-vars params)) - (out-file (cdr (assoc :file params))) - (prologue (cdr (assoc :prologue params))) - (epilogue (cdr (assoc :epilogue params))) - (term (or (cdr (assoc :term params)) + (out-file (cdr (assq :file params))) + (prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params))) + (term (or (cdr (assq :term params)) (when out-file (let ((ext (file-name-extension out-file))) (or (cdr (assoc (intern (downcase ext)) *org-babel-gnuplot-terms*)) ext))))) - (cmdline (cdr (assoc :cmdline params))) - (title (cdr (assoc :title params))) - (lines (cdr (assoc :line params))) - (sets (cdr (assoc :set params))) - (x-labels (cdr (assoc :xlabels params))) - (y-labels (cdr (assoc :ylabels params))) - (timefmt (cdr (assoc :timefmt params))) - (time-ind (or (cdr (assoc :timeind params)) + (title (cdr (assq :title params))) + (lines (cdr (assq :line params))) + (sets (cdr (assq :set params))) + (x-labels (cdr (assq :xlabels params))) + (y-labels (cdr (assq :ylabels params))) + (timefmt (cdr (assq :timefmt params))) + (time-ind (or (cdr (assq :timeind params)) (when timefmt 1))) - (add-to-body (lambda (text) (setq body (concat text "\n" body)))) - output) + (add-to-body (lambda (text) (setq body (concat text "\n" body))))) ;; append header argument settings to body (when title (funcall add-to-body (format "set title '%s'" title))) (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) @@ -171,9 +168,8 @@ code." "Execute a block of Gnuplot code. This function is called by `org-babel-execute-src-block'." (require 'gnuplot) - (let ((session (cdr (assoc :session params))) - (result-type (cdr (assoc :results params))) - (out-file (cdr (assoc :file params))) + (let ((session (cdr (assq :session params))) + (result-type (cdr (assq :results params))) (body (org-babel-expand-body:gnuplot body params)) output) (save-window-excursion @@ -206,10 +202,12 @@ This function is called by `org-babel-execute-src-block'." (var-lines (org-babel-variable-assignments:gnuplot params))) (message "%S" session) (org-babel-comint-in-buffer session - (mapc (lambda (var-line) - (insert var-line) (comint-send-input nil t) - (org-babel-comint-wait-for-output session) - (sit-for .1) (goto-char (point-max))) var-lines)) + (dolist (var-line var-lines) + (insert var-line) + (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) + (goto-char (point-max)))) session)) (defun org-babel-load-session:gnuplot (session body params) @@ -228,7 +226,7 @@ This function is called by `org-babel-execute-src-block'." (org-babel-gnuplot-process-vars params))) (defvar gnuplot-buffer) -(defun org-babel-gnuplot-initiate-session (&optional session params) +(defun org-babel-gnuplot-initiate-session (&optional session _params) "Initiate a gnuplot session. If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session. The current diff --git a/lisp/ob-groovy.el b/lisp/ob-groovy.el index 14f644c..9578c70 100644 --- a/lisp/ob-groovy.el +++ b/lisp/ob-groovy.el @@ -1,4 +1,4 @@ -;;; ob-groovy.el --- org-babel functions for Groovy evaluation +;;; ob-groovy.el --- Babel Functions for Groovy -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. @@ -31,7 +31,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) ;; Autoloaded (add-to-list 'org-babel-tangle-lang-exts '("groovy" . "groovy")) @@ -51,9 +50,8 @@ called by `org-babel-execute-src-block'" (message "executing Groovy source code block") (let* ((processed-params (org-babel-process-params params)) (session (org-babel-groovy-initiate-session (nth 0 processed-params))) - (vars (nth 1 processed-params)) (result-params (nth 2 processed-params)) - (result-type (cdr (assoc :result-type params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params)) (result (org-babel-groovy-evaluate @@ -62,9 +60,9 @@ called by `org-babel-execute-src-block'" (org-babel-reassemble-table result (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (defvar org-babel-groovy-wrapper-method @@ -78,19 +76,19 @@ println(new Runner().run()) (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. If RESULT-TYPE equals `output' then return standard output as a string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY as elisp." (when session (error "Sessions are not (yet) supported for Groovy")) - (case result-type - (output + (pcase result-type + (`output (let ((src-file (org-babel-temp-file "groovy-"))) (progn (with-temp-file src-file (insert body)) (org-babel-eval (concat org-babel-groovy-command " " src-file) "")))) - (value + (`value (let* ((src-file (org-babel-temp-file "groovy-")) (wrapper (format org-babel-groovy-wrapper-method body))) (with-temp-file src-file (insert wrapper)) @@ -101,11 +99,11 @@ in BODY as elisp." (org-babel-script-escape raw))))))) -(defun org-babel-prep-session:groovy (session params) +(defun org-babel-prep-session:groovy (_session _params) "Prepare SESSION according to the header arguments specified in PARAMS." (error "Sessions are not (yet) supported for Groovy")) -(defun org-babel-groovy-initiate-session (&optional session) +(defun org-babel-groovy-initiate-session (&optional _session) "If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session. Sessions are not supported in Groovy." diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el index e9cb3cc..5dcb516 100644 --- a/lisp/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -1,4 +1,4 @@ -;;; ob-haskell.el --- org-babel functions for haskell evaluation +;;; ob-haskell.el --- Babel Functions for Haskell -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -41,9 +41,9 @@ ;;; Code: (require 'ob) (require 'comint) -(eval-when-compile (require 'cl)) (declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function haskell-mode "ext:haskell-mode" ()) (declare-function run-haskell "ext:inf-haskell" (&optional arg)) (declare-function inferior-haskell-load-file @@ -61,42 +61,35 @@ (defun org-babel-execute:haskell (body params) "Execute a block of Haskell code." - (let* ((session (cdr (assoc :session params))) - (vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-type (cdr (assoc :result-type params))) + (let* ((session (cdr (assq :session params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:haskell params))) (session (org-babel-haskell-initiate-session session params)) (raw (org-babel-comint-with-output (session org-babel-haskell-eoe t full-body) - (insert (org-babel-trim full-body)) + (insert (org-trim full-body)) (comint-send-input nil t) (insert org-babel-haskell-eoe) (comint-send-input nil t))) (results (mapcar - #'org-babel-haskell-read-string + #'org-babel-strip-quotes (cdr (member org-babel-haskell-eoe - (reverse (mapcar #'org-babel-trim raw))))))) + (reverse (mapcar #'org-trim raw))))))) (org-babel-reassemble-table (let ((result - (case result-type - (output (mapconcat #'identity (reverse (cdr results)) "\n")) - (value (car results))))) - (org-babel-result-cond (cdr (assoc :result-params params)) + (pcase result-type + (`output (mapconcat #'identity (reverse (cdr results)) "\n")) + (`value (car results))))) + (org-babel-result-cond (cdr (assq :result-params params)) result (org-babel-script-escape result))) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colname-names params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rowname-names params)))))) - -(defun org-babel-haskell-read-string (string) - "Strip \\\"s from around a haskell string." - (if (string-match "^\"\\([^\000]+\\)\"$" string) - (match-string 1 string) - string)) - -(defun org-babel-haskell-initiate-session (&optional session params) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colname-names params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rowname-names params)))))) + +(defun org-babel-haskell-initiate-session (&optional _session _params) "Initiate a haskell session. If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session." @@ -131,7 +124,7 @@ then create one. Return the initialized session." (format "let %s = %s" (car pair) (org-babel-haskell-var-to-haskell (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-haskell-var-to-haskell (var) "Convert an elisp value VAR into a haskell variable. @@ -144,13 +137,14 @@ specifying a variable of the same value." (defvar org-export-copy-to-kill-ring) (declare-function org-export-to-file "ox" (backend file - &optional async subtreep visible-only body-only ext-plist)) + &optional async subtreep visible-only body-only + ext-plist post-process)) (defun org-babel-haskell-export-to-lhs (&optional arg) "Export to a .lhs file with all haskell code blocks escaped. When called with a prefix argument the resulting .lhs file will be exported to a .tex file. This function will create two new files, base-name.lhs and base-name.tex where -base-name is the name of the current org-mode file. +base-name is the name of the current Org file. Note that all standard Babel literate programming constructs (header arguments, no-web syntax etc...) are ignored." @@ -178,12 +172,12 @@ constructs (header arguments, no-web syntax etc...) are ignored." (save-match-data (setq indentation (length (match-string 1)))) (replace-match (save-match-data (concat - "#+begin_latex\n\\begin{code}\n" + "#+begin_export latex\n\\begin{code}\n" (if (or preserve-indentp (string-match "-i" (match-string 2))) (match-string 3) (org-remove-indentation (match-string 3))) - "\n\\end{code}\n#+end_latex\n")) + "\n\\end{code}\n#+end_export\n")) t t) (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) (save-excursion diff --git a/lisp/ob-io.el b/lisp/ob-io.el index ec2cd02..186b1b2 100644 --- a/lisp/ob-io.el +++ b/lisp/ob-io.el @@ -1,4 +1,4 @@ -;;; ob-io.el --- org-babel functions for Io evaluation +;;; ob-io.el --- Babel Functions for Io -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2016 Free Software Foundation, Inc. @@ -33,7 +33,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) ;; Autoloaded (add-to-list 'org-babel-tangle-lang-exts '("io" . "io")) @@ -47,9 +46,8 @@ called by `org-babel-execute-src-block'" (message "executing Io source code block") (let* ((processed-params (org-babel-process-params params)) (session (org-babel-io-initiate-session (nth 0 processed-params))) - (vars (nth 1 processed-params)) (result-params (nth 2 processed-params)) - (result-type (cdr (assoc :result-type params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params)) (result (org-babel-io-evaluate @@ -58,9 +56,9 @@ called by `org-babel-execute-src-block'" (org-babel-reassemble-table result (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (defvar org-babel-io-wrapper-method "( @@ -75,29 +73,29 @@ If RESULT-TYPE equals `output' then return standard output as a string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY as elisp." (when session (error "Sessions are not (yet) supported for Io")) - (case result-type - (output + (pcase result-type + (`output (if (member "repl" result-params) (org-babel-eval org-babel-io-command body) (let ((src-file (org-babel-temp-file "io-"))) (progn (with-temp-file src-file (insert body)) (org-babel-eval (concat org-babel-io-command " " src-file) ""))))) - (value (let* ((src-file (org-babel-temp-file "io-")) - (wrapper (format org-babel-io-wrapper-method body))) - (with-temp-file src-file (insert wrapper)) - (let ((raw (org-babel-eval - (concat org-babel-io-command " " src-file) ""))) - (org-babel-result-cond result-params - raw - (org-babel-script-escape raw))))))) + (`value (let* ((src-file (org-babel-temp-file "io-")) + (wrapper (format org-babel-io-wrapper-method body))) + (with-temp-file src-file (insert wrapper)) + (let ((raw (org-babel-eval + (concat org-babel-io-command " " src-file) ""))) + (org-babel-result-cond result-params + 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." (error "Sessions are not (yet) supported for Io")) -(defun org-babel-io-initiate-session (&optional session) +(defun org-babel-io-initiate-session (&optional _session) "If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session. Sessions are not supported in Io." diff --git a/lisp/ob-java.el b/lisp/ob-java.el index 5856c65..ccae020 100644 --- a/lisp/ob-java.el +++ b/lisp/ob-java.el @@ -1,4 +1,4 @@ -;;; ob-java.el --- org-babel functions for java evaluation +;;; ob-java.el --- Babel Functions for Java -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -51,34 +51,32 @@ parameters may be used, like javac -verbose" :type 'string) (defun org-babel-execute:java (body params) - (let* ((classname (or (cdr (assoc :classname params)) + (let* ((classname (or (cdr (assq :classname params)) (error "Can't compile a java block without a classname"))) (packagename (file-name-directory classname)) (src-file (concat classname ".java")) - (cmpflag (or (cdr (assoc :cmpflag params)) "")) - (cmdline (or (cdr (assoc :cmdline params)) "")) - (full-body (org-babel-expand-body:generic body params)) - (compile - (progn (with-temp-file src-file (insert full-body)) - (org-babel-eval - (concat org-babel-java-compiler - " " cmpflag " " src-file) "")))) + (cmpflag (or (cdr (assq :cmpflag params)) "")) + (cmdline (or (cdr (assq :cmdline params)) "")) + (full-body (org-babel-expand-body:generic body params))) + (with-temp-file src-file (insert full-body)) + (org-babel-eval + (concat org-babel-java-compiler " " cmpflag " " src-file) "") ;; created package-name directories if missing (unless (or (not packagename) (file-exists-p packagename)) (make-directory packagename 'parents)) (let ((results (org-babel-eval (concat org-babel-java-command " " cmdline " " classname) ""))) (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-result-cond (cdr (assq :result-params params)) (org-babel-read results) (let ((tmp-file (org-babel-temp-file "c-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file))) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))) (provide 'ob-java) diff --git a/lisp/ob-js.el b/lisp/ob-js.el index 9440aa9..1a20d7e 100644 --- a/lisp/ob-js.el +++ b/lisp/ob-js.el @@ -1,4 +1,4 @@ -;;; ob-js.el --- org-babel functions for Javascript +;;; ob-js.el --- Babel Functions for Javascript -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -39,7 +39,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (declare-function run-mozilla "ext:moz" (arg)) @@ -62,14 +61,14 @@ (defun org-babel-execute:js (body params) "Execute a block of Javascript code with org-babel. This function is called by `org-babel-execute-src-block'" - (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd)) - (result-type (cdr (assoc :result-type params))) + (let* ((org-babel-js-cmd (or (cdr (assq :cmd params)) org-babel-js-cmd)) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:js params))) - (result (if (not (string= (cdr (assoc :session params)) "none")) + (result (if (not (string= (cdr (assq :session params)) "none")) ;; session evaluation (let ((session (org-babel-prep-session:js - (cdr (assoc :session params)) params))) + (cdr (assq :session params)) params))) (nth 1 (org-babel-comint-with-output (session (format "%S" org-babel-js-eoe) t body) @@ -89,7 +88,7 @@ This function is called by `org-babel-execute-src-block'" (org-babel-eval (format "%s %s" org-babel-js-cmd (org-babel-process-file-name script-file)) ""))))) - (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-result-cond (cdr (assq :result-params params)) result (org-babel-js-read result)))) (defun org-babel-js-read (results) @@ -97,7 +96,9 @@ This function is called by `org-babel-execute-src-block'" If RESULTS look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." (org-babel-read - (if (and (stringp results) (string-match "^\\[[^\000]+\\]$" results)) + (if (and (stringp results) + (string-prefix-p "[" results) + (string-suffix-p "]" results)) (org-babel-read (concat "'" (replace-regexp-in-string @@ -134,7 +135,7 @@ specifying a variable of the same value." (mapcar (lambda (pair) (format "var %s=%s;" (car pair) (org-babel-js-var-to-js (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-js-initiate-session (&optional session) "If there is not a current inferior-process-buffer in SESSION diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el index 6a63456..318f549 100644 --- a/lisp/ob-keys.el +++ b/lisp/ob-keys.el @@ -1,4 +1,4 @@ -;;; ob-keys.el --- key bindings for org-babel +;;; ob-keys.el --- Key Bindings for Babel -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -23,8 +23,8 @@ ;;; Commentary: -;; Add org-babel keybindings to the org-mode keymap for exposing -;; org-babel functions. These will all share a common prefix. See +;; Add Org Babel keybindings to the Org mode keymap for exposing +;; Org Babel functions. These will all share a common prefix. See ;; the value of `org-babel-key-bindings' for a list of interactive ;; functions and their associated keys. diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index 681e229..8fc0493 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -1,4 +1,4 @@ -;;; ob-latex.el --- org-babel functions for latex "evaluation" +;;; ob-latex.el --- Babel Functions for LaTeX -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -32,11 +32,11 @@ ;;; Code: (require 'ob) -(declare-function org-create-formula-image "org" (string tofile options buffer)) -(declare-function org-splice-latex-header "org" - (tpl def-pkg pkg snippets-p &optional extra)) +(declare-function org-create-formula-image "org" (string tofile options buffer &optional type)) +(declare-function org-latex-compile "ox-latex" (texfile &optional snippet)) (declare-function org-latex-guess-inputenc "ox-latex" (header)) -(declare-function org-latex-compile "ox-latex" (file)) +(declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) @@ -53,12 +53,16 @@ (defconst org-babel-header-args:latex '((border . :any) (fit . :any) + (imagemagick . ((nil t))) (iminoptions . :any) (imoutoptions . :any) (packages . :any) (pdfheight . :any) (pdfpng . :any) - (pdfwidth . :any)) + (pdfwidth . :any) + (headers . :any) + (packages . :any) + (buffer . ((yes no)))) "LaTeX-specific header arguments.") (defcustom org-babel-latex-htlatex "htlatex" @@ -80,38 +84,38 @@ (regexp-quote (format "%S" (car pair))) (if (stringp (cdr pair)) (cdr pair) (format "%S" (cdr pair))) - body))) (mapcar #'cdr (org-babel-get-header params :var))) - (org-babel-trim body)) + body))) (org-babel--get-vars params)) + (org-trim body)) (defun org-babel-execute:latex (body params) "Execute a block of Latex code with Babel. This function is called by `org-babel-execute-src-block'." (setq body (org-babel-expand-body:latex body params)) - (if (cdr (assoc :file params)) - (let* ((out-file (cdr (assoc :file params))) + (if (cdr (assq :file params)) + (let* ((out-file (cdr (assq :file params))) + (extension (file-name-extension out-file)) (tex-file (org-babel-temp-file "latex-" ".tex")) - (border (cdr (assoc :border params))) - (imagemagick (cdr (assoc :imagemagick params))) - (im-in-options (cdr (assoc :iminoptions params))) - (im-out-options (cdr (assoc :imoutoptions params))) - (pdfpng (cdr (assoc :pdfpng params))) - (fit (or (cdr (assoc :fit params)) border)) - (height (and fit (cdr (assoc :pdfheight params)))) - (width (and fit (cdr (assoc :pdfwidth params)))) - (headers (cdr (assoc :headers params))) - (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) + (border (cdr (assq :border params))) + (imagemagick (cdr (assq :imagemagick params))) + (im-in-options (cdr (assq :iminoptions params))) + (im-out-options (cdr (assq :imoutoptions params))) + (fit (or (cdr (assq :fit params)) border)) + (height (and fit (cdr (assq :pdfheight params)))) + (width (and fit (cdr (assq :pdfwidth params)))) + (headers (cdr (assq :headers params))) + (in-buffer (not (string= "no" (cdr (assq :buffer params))))) (org-latex-packages-alist - (append (cdr (assoc :packages params)) org-latex-packages-alist))) + (append (cdr (assq :packages params)) org-latex-packages-alist))) (cond - ((and (string-match "\\.png$" out-file) (not imagemagick)) + ((and (string-suffix-p ".png" out-file) (not imagemagick)) (org-create-formula-image body out-file org-format-latex-options in-buffer)) - ((string-match "\\.tikz$" out-file) + ((string-suffix-p ".tikz" out-file) (when (file-exists-p out-file) (delete-file out-file)) (with-temp-file out-file (insert body))) - ((and (or (string-match "\\.svg$" out-file) - (string-match "\\.html$" out-file)) + ((and (or (string= "svg" extension) + (string= "html" extension)) (executable-find org-babel-latex-htlatex)) ;; TODO: this is a very different way of generating the ;; frame latex document than in the pdf case. Ideally, both @@ -141,7 +145,7 @@ This function is called by `org-babel-execute-src-block'." (shell-command (format "%s %s" org-babel-latex-htlatex tex-file))) (cond ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg")) - (if (string-match "\\.svg$" out-file) + (if (string-suffix-p ".svg" out-file) (progn (shell-command "pwd") (shell-command (format "mv %s %s" @@ -149,13 +153,13 @@ This function is called by `org-babel-execute-src-block'." out-file))) (error "SVG file produced but HTML file requested"))) ((file-exists-p (concat (file-name-sans-extension tex-file) ".html")) - (if (string-match "\\.html$" out-file) + (if (string-suffix-p ".html" out-file) (shell-command "mv %s %s" (concat (file-name-sans-extension tex-file) ".html") out-file) (error "HTML file produced but SVG file requested"))))) - ((or (string-match "\\.pdf$" out-file) imagemagick) + ((or (string= "pdf" extension) imagemagick) (with-temp-file tex-file (require 'ox-latex) (insert @@ -188,16 +192,16 @@ This function is called by `org-babel-execute-src-block'." (when (file-exists-p out-file) (delete-file out-file)) (let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file))) (cond - ((string-match "\\.pdf$" out-file) + ((string= "pdf" extension) (rename-file transient-pdf-file out-file)) (imagemagick (org-babel-latex-convert-pdf transient-pdf-file out-file im-in-options im-out-options) (when (file-exists-p transient-pdf-file) - (delete-file transient-pdf-file)))))) - ((string-match "\\.\\([^\\.]+\\)$" out-file) - (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" - (match-string 1 out-file)))) + (delete-file transient-pdf-file))) + (t + (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" + extension)))))) nil) ;; signal that output has already been written to file body)) @@ -213,7 +217,7 @@ This function is called by `org-babel-execute-src-block'." (require 'ox-latex) (org-latex-compile file)) -(defun org-babel-prep-session:latex (session params) +(defun org-babel-prep-session:latex (_session _params) "Return an error because LaTeX doesn't support sessions." (error "LaTeX does not support sessions")) diff --git a/lisp/ob-ledger.el b/lisp/ob-ledger.el index d07f257..ee2ce0a 100644 --- a/lisp/ob-ledger.el +++ b/lisp/ob-ledger.el @@ -1,4 +1,4 @@ -;;; ob-ledger.el --- org-babel functions for ledger evaluation +;;; ob-ledger.el --- Babel Functions for Ledger -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -46,8 +46,7 @@ "Execute a block of Ledger entries with org-babel. This function is called by `org-babel-execute-src-block'." (message "executing Ledger source code block") - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (cmdline (cdr (assoc :cmdline params))) + (let ((cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "ledger-")) (out-file (org-babel-temp-file "ledger-output-"))) (with-temp-file in-file (insert body)) @@ -61,7 +60,7 @@ called by `org-babel-execute-src-block'." " > " (org-babel-process-file-name out-file)))) (with-temp-buffer (insert-file-contents out-file) (buffer-string)))) -(defun org-babel-prep-session:ledger (session params) +(defun org-babel-prep-session:ledger (_session _params) (error "Ledger does not support sessions")) (provide 'ob-ledger) diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el index bfbace5..3d2e50f 100644 --- a/lisp/ob-lilypond.el +++ b/lisp/ob-lilypond.el @@ -1,4 +1,4 @@ -;;; ob-lilypond.el --- org-babel functions for lilypond evaluation +;;; ob-lilypond.el --- Babel Functions for Lilypond -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -92,7 +92,7 @@ you can leave the string empty on this case." :version "24.3" :package-version '(Org . "8.2.7") :set - (lambda (symbol value) + (lambda (_symbol value) (setq org-babel-lilypond-ly-command (nth 0 value) org-babel-lilypond-pdf-command (nth 1 value) @@ -123,7 +123,7 @@ blocks.") (defun org-babel-expand-body:lilypond (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapc (lambda (pair) (let ((name (symbol-name (car pair))) @@ -157,9 +157,8 @@ specific arguments to =org-babel-tangle=" (defun org-babel-lilypond-process-basic (body params) "Execute a lilypond block in basic mode." - (let* ((result-params (cdr (assoc :result-params params))) - (out-file (cdr (assoc :file params))) - (cmdline (or (cdr (assoc :cmdline params)) + (let* ((out-file (cdr (assq :file params))) + (cmdline (or (cdr (assq :cmdline params)) "")) (in-file (org-babel-temp-file "lilypond-"))) @@ -182,7 +181,7 @@ specific arguments to =org-babel-tangle=" cmdline in-file) "")) nil) -(defun org-babel-prep-session:lilypond (session params) +(defun org-babel-prep-session:lilypond (_session _params) "Return an error because LilyPond exporter does not support sessions." (error "Sorry, LilyPond does not currently support sessions!")) @@ -272,25 +271,19 @@ LINE is the erroneous line" (defun org-babel-lilypond-parse-line-num (&optional buffer) "Extract error line number." - (when buffer - (set-buffer buffer)) + (when buffer (set-buffer buffer)) (let ((start (and (search-backward ":" nil t) (search-backward ":" nil t) (search-backward ":" nil t) - (search-backward ":" nil t))) - (num nil)) - (if start - (progn - (forward-char) - (let ((num (buffer-substring - (+ 1 start) - (- (search-forward ":" nil t) 1)))) - (setq num (string-to-number num)) - (if (numberp num) - num - nil))) - nil))) + (search-backward ":" nil t)))) + (when start + (forward-char) + (let ((num (string-to-number + (buffer-substring + (+ 1 start) + (- (search-forward ":" nil t) 1))))) + (and (numberp num) num))))) (defun org-babel-lilypond-parse-error-line (file-name lineNo) "Extract the erroneous line from the tangled .ly file diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el index 04df7fb..da7e4f4 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -1,4 +1,4 @@ -;;; ob-lisp.el --- org-babel functions for common lisp evaluation +;;; ob-lisp.el --- Babel Functions for Common Lisp -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -25,17 +25,22 @@ ;;; Commentary: -;;; support for evaluating common lisp code, relies on slime for all eval +;;; Support for evaluating Common Lisp code, relies on SLY or SLIME +;;; for all eval. ;;; Requirements: -;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.) -;; See http://common-lisp.net/project/slime/ +;; Requires SLY (Sylvester the Cat's Common Lisp IDE) or SLIME +;; (Superior Lisp Interaction Mode for Emacs). See: +;; - https://github.com/capitaomorte/sly +;; - http://common-lisp.net/project/slime/ ;;; Code: (require 'ob) +(declare-function sly-eval "ext:sly" (sexp &optional package)) (declare-function slime-eval "ext:slime" (sexp &optional package)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp")) @@ -43,6 +48,14 @@ (defvar org-babel-default-header-args:lisp '()) (defvar org-babel-header-args:lisp '((package . :any))) +(defcustom org-babel-lisp-eval-fn #'slime-eval + "The function to be called to evaluate code on the Lisp side. +Valid values include `slime-eval' and `sly-eval'." + :group 'org-babel + :version "25.2" + :package-version '(Org . "9.0") + :type 'function) + (defcustom org-babel-lisp-dir-fmt "(let ((*default-pathname-defaults* #P%S\n)) %%s\n)" "Format string used to wrap code bodies to set the current directory. @@ -54,51 +67,54 @@ current directory string." (defun org-babel-expand-body:lisp (body params) "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) + (let* ((vars (org-babel--get-vars params)) + (result-params (cdr (assq :result-params params))) (print-level nil) (print-length nil) - (body (org-babel-trim - (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) - (format "(%S (quote %S))" (car var) (cdr var))) - vars "\n ") - ")\n" body ")") - body)))) + (body (if (null vars) (org-trim body) + (concat "(let (" + (mapconcat + (lambda (var) + (format "(%S (quote %S))" (car var) (cdr var))) + vars "\n ") + ")\n" body ")")))) (if (or (member "code" result-params) (member "pp" result-params)) (format "(pprint %s)" body) body))) (defun org-babel-execute:lisp (body params) - "Execute a block of Common Lisp code with Babel." - (require 'slime) + "Execute a block of Common Lisp code with Babel. +BODY is the contents of the block, as a string. PARAMS is +a property list containing the parameters of the block." + (require (pcase org-babel-lisp-eval-fn + (`slime-eval 'slime) + (`sly-eval 'sly))) (org-babel-reassemble-table (let ((result - (funcall (if (member "output" (cdr (assoc :result-params params))) - #'car #'cadr) - (with-temp-buffer - (insert (org-babel-expand-body:lisp body params)) - (slime-eval `(swank:eval-and-grab-output - ,(let ((dir (if (assoc :dir params) - (cdr (assoc :dir params)) - default-directory))) - (format - (if dir (format org-babel-lisp-dir-fmt dir) - "(progn %s\n)") - (buffer-substring-no-properties - (point-min) (point-max))))) - (cdr (assoc :package params))))))) - (org-babel-result-cond (cdr (assoc :result-params params)) + (funcall (if (member "output" (cdr (assq :result-params params))) + #'car #'cadr) + (with-temp-buffer + (insert (org-babel-expand-body:lisp body params)) + (funcall org-babel-lisp-eval-fn + `(swank:eval-and-grab-output + ,(let ((dir (if (assq :dir params) + (cdr (assq :dir params)) + default-directory))) + (format + (if dir (format org-babel-lisp-dir-fmt dir) + "(progn %s\n)") + (buffer-substring-no-properties + (point-min) (point-max))))) + (cdr (assq :package params))))))) + (org-babel-result-cond (cdr (assq :result-params params)) result (condition-case nil (read (org-babel-lisp-vector-to-list result)) (error result)))) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params))))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params))))) (defun org-babel-lisp-vector-to-list (results) ;; TODO: better would be to replace #(...) with [...] diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el index cf5cb4e..1c4123b 100644 --- a/lisp/ob-lob.el +++ b/lisp/ob-lob.el @@ -1,4 +1,4 @@ -;;; ob-lob.el --- functions supporting the Library of Babel +;;; ob-lob.el --- Functions Supporting the Library of Babel -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -23,27 +23,27 @@ ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'ob-core) (require 'ob-table) -(declare-function org-babel-in-example-or-verbatim "ob-exp" nil) +(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) (defvar org-babel-library-of-babel nil "Library of source-code blocks. -This is an association list. Populate the library by adding -files to `org-babel-lob-files'.") - -(defcustom org-babel-lob-files nil - "Files used to populate the `org-babel-library-of-babel'. -To add files to this list use the `org-babel-lob-ingest' command." - :group 'org-babel - :version "24.1" - :type '(repeat file)) +This is an association list. Populate the library by calling +`org-babel-lob-ingest' on files containing source blocks.") (defvar org-babel-default-lob-header-args '((:exports . "results")) - "Default header arguments to use when exporting #+lob/call lines.") + "Default header arguments to use when exporting Babel calls. +By default, a Babel call inherits its arguments from the source +block being called. Header arguments defined in this variable +take precedence over these. It is useful for properties that +should not be inherited from a source block.") (defun org-babel-lob-ingest (&optional file) "Add all named source blocks defined in FILE to `org-babel-library-of-babel'." @@ -62,24 +62,7 @@ To add files to this list use the `org-babel-lob-ingest' command." lob-ingest-count (if (> lob-ingest-count 1) "s" "")) lob-ingest-count)) -(defconst org-babel-block-lob-one-liner-regexp - (concat - "^\\([ \t]*?\\)#\\+call:[ \t]+\\([^()\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)" - "(\\([^\n]*?\\))\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?") - "Regexp to match non-inline calls to predefined source block functions.") - -(defconst org-babel-inline-lob-one-liner-regexp - (concat - "\\([^\n]*?\\)call_\\([^()[:space:]\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)" - "(\\(.*?\\))\\(\\[\\(.*?\\)\\]\\)?") - "Regexp to match inline calls to predefined source block functions.") - -(defconst org-babel-lob-one-liner-regexp - (concat "\\(" org-babel-block-lob-one-liner-regexp - "\\|" org-babel-inline-lob-one-liner-regexp "\\)") - "Regexp to match calls to predefined source block functions.") - -;; functions for executing lob one-liners +;; Functions for executing lob one-liners. ;;;###autoload (defun org-babel-lob-execute-maybe () @@ -88,87 +71,76 @@ Detect if this is context for a Library Of Babel source block and if so then run the appropriate source block from the Library." (interactive) (let ((info (org-babel-lob-get-info))) - (if (and (nth 0 info) (not (org-babel-in-example-or-verbatim))) - (progn (org-babel-lob-execute info) t) - nil))) + (when info + (org-babel-execute-src-block nil info) + t))) + +(defun org-babel-lob--src-info (name) + "Return internal representation for Babel data named NAME. +NAME is a string. This function looks into the current document +for a Babel call or source block. If none is found, it looks +after NAME in the Library of Babel. Eventually, if that also +fails, it returns nil." + ;; During export, look into the pristine copy of the document being + ;; exported instead of the current one, which could miss some data. + (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer)) + (org-with-wide-buffer + (goto-char (point-min)) + (catch :found + (let ((case-fold-search t) + (regexp (org-babel-named-data-regexp-for-name name))) + (while (re-search-forward regexp nil t) + (let ((element (org-element-at-point))) + (when (equal name (org-element-property :name element)) + (throw :found + (pcase (org-element-type element) + (`src-block (org-babel-get-src-block-info t element)) + (`babel-call (org-babel-lob-get-info element)) + ;; Non-executable data found. Since names are + ;; supposed to be unique throughout a document, + ;; bail out. + (_ nil)))))) + ;; No element named NAME in buffer. Try Library of Babel. + (cdr (assoc-string name org-babel-library-of-babel))))))) ;;;###autoload -(defun org-babel-lob-get-info () - "Return a Library of Babel function call as a string." - (let ((case-fold-search t) - (nonempty (lambda (a b) - (let ((it (match-string a))) - (if (= (length it) 0) (match-string b) it))))) - (save-excursion - (beginning-of-line 1) - (when (looking-at org-babel-lob-one-liner-regexp) - (append - (mapcar #'org-no-properties - (list - (format "%s%s(%s)%s" - (funcall nonempty 3 12) - (if (not (= 0 (length (funcall nonempty 5 14)))) - (concat "[" (funcall nonempty 5 14) "]") "") - (or (funcall nonempty 7 16) "") - (or (funcall nonempty 8 19) "")) - (funcall nonempty 9 18))) - (list (length (if (= (length (match-string 12)) 0) - (match-string 2) (match-string 11))) - (save-excursion - (forward-line -1) - (save-match-data - (and (looking-at (concat org-babel-src-name-regexp - "\\([^\n]*\\)$")) - (org-no-properties (match-string 1))))))))))) - -(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el -(defun org-babel-lob-execute (info) - "Execute the lob call specified by INFO." - (let* ((mkinfo (lambda (p) - (list "emacs-lisp" "results" p nil - (nth 3 info) ;; name - (nth 2 info)))) - (pre-params (apply #'org-babel-merge-params - org-babel-default-header-args - org-babel-default-header-args:emacs-lisp - (append - (org-babel-params-from-properties) - (list - (org-babel-parse-header-arguments - (org-no-properties - (concat - ":var results=" - (mapconcat #'identity (butlast info 2) - " ")))))))) - (pre-info (funcall mkinfo pre-params)) - (cache-p (and (cdr (assoc :cache pre-params)) - (string= "yes" (cdr (assoc :cache pre-params))))) - (new-hash (when cache-p - (org-babel-sha1-hash - ;; Do *not* pre-process params for call line - ;; hash evaluation, since for a call line :var - ;; extension *is* execution. - (let* ((params (nth 2 pre-info)) - (sha1-nth2 (list - (cons - (cons :c-var (cdr (assoc :var params))) - (assq-delete-all :var (copy-tree params))))) - (sha1-info (copy-tree pre-info))) - (prog1 sha1-info - (setcar (cddr sha1-info) sha1-nth2)))))) - (old-hash (when cache-p (org-babel-current-result-hash pre-info))) - (org-babel-current-src-block-location (point-marker))) - (if (and cache-p (equal new-hash old-hash)) - (save-excursion (goto-char (org-babel-where-is-src-block-result - nil pre-info)) - (forward-line 1) - (message "%S" (org-babel-read-result))) - (prog1 (let* ((proc-params (org-babel-process-params pre-params)) - org-confirm-babel-evaluate) - (org-babel-execute-src-block nil (funcall mkinfo proc-params))) - ;; update the hash - (when new-hash - (org-babel-set-current-result-hash new-hash pre-info)))))) +(defun org-babel-lob-get-info (&optional datum) + "Return internal representation for Library of Babel function call. +Consider DATUM, when provided, or element at point. Return nil +when not on an appropriate location. Otherwise return a list +compatible with `org-babel-get-src-block-info', which see." + (let* ((context (or datum (org-element-context))) + (type (org-element-type context))) + (when (memq type '(babel-call inline-babel-call)) + (pcase (org-babel-lob--src-info (org-element-property :call context)) + (`(,language ,body ,header ,_ ,_ ,_ ,coderef) + (let ((begin (org-element-property (if (eq type 'inline-babel-call) + :begin + :post-affiliated) + context))) + (list language + body + (apply #'org-babel-merge-params + header + org-babel-default-lob-header-args + (append + (org-with-wide-buffer + (goto-char begin) + (org-babel-params-from-properties language)) + (list + (org-babel-parse-header-arguments + (org-element-property :inside-header context)) + (let ((args (org-element-property :arguments context))) + (and args + (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args args)))) + (org-babel-parse-header-arguments + (org-element-property :end-header context))))) + nil + (org-element-property :name context) + begin + coderef))) + (_ nil))))) (provide 'ob-lob) diff --git a/lisp/ob-lua.el b/lisp/ob-lua.el new file mode 100644 index 0000000..afb5c45 --- /dev/null +++ b/lisp/ob-lua.el @@ -0,0 +1,403 @@ +;;; ob-lua.el --- Org Babel functions for Lua evaluation -*- lexical-binding: t; -*- + +;; Copyright (C) 2014, 2016 Free Software Foundation, Inc. + +;; Authors: Dieter Schoen +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;; Requirements: +;; for session support, lua-mode is needed. +;; lua-mode is not part of GNU Emacs/orgmode, but can be obtained +;; from marmalade or melpa. +;; The source respository is here: +;; https://github.com/immerrr/lua-mode + +;; However, sessions are not yet working. + +;; Org-Babel support for evaluating lua source code. + +;;; Code: +(require 'ob) +(require 'cl-lib) + +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-trim "org" (s &optional keep-lead)) +(declare-function lua-shell "ext:lua-mode" (&optional argprompt)) +(declare-function lua-toggle-shells "ext:lua-mode" (arg)) +(declare-function run-lua "ext:lua" (cmd &optional dedicated show)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("lua" . "lua")) + +(defvar org-babel-default-header-args:lua '()) + +(defcustom org-babel-lua-command "lua" + "Name of the command for executing Lua code." + :version "24.5" + :package-version '(Org . "8.3") + :group 'org-babel + :type 'string) + +(defcustom org-babel-lua-mode 'lua-mode + "Preferred lua mode for use in running lua interactively. +This will typically be 'lua-mode." + :group 'org-babel + :version "24.5" + :package-version '(Org . "8.3") + :type 'symbol) + +(defcustom org-babel-lua-hline-to "None" + "Replace hlines in incoming tables with this when translating to lua." + :group 'org-babel + :version "24.5" + :package-version '(Org . "8.3") + :type 'string) + +(defcustom org-babel-lua-None-to 'hline + "Replace 'None' in lua tables with this before returning." + :group 'org-babel + :version "24.5" + :package-version '(Org . "8.3") + :type 'symbol) + +(defun org-babel-execute:lua (body params) + "Execute a block of Lua code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (org-babel-lua-initiate-session + (cdr (assq :session params)))) + (result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) + (return-val (when (and (eq result-type 'value) (not session)) + (cdr (assq :return params)))) + (preamble (cdr (assq :preamble params))) + (full-body + (org-babel-expand-body:generic + (concat body (if return-val (format "\nreturn %s" return-val) "")) + params (org-babel-variable-assignments:lua params))) + (result (org-babel-lua-evaluate + session full-body result-type result-params preamble))) + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params)))))) + +(defun org-babel-prep-session:lua (session params) + "Prepare SESSION according to the header arguments in PARAMS. +VARS contains resolved variable references" + (let* ((session (org-babel-lua-initiate-session session)) + (var-lines + (org-babel-variable-assignments:lua params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:lua (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:lua session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:lua (params) + "Return a list of Lua statements assigning the block's variables." + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-lua-var-to-lua (cdr pair)))) + (org-babel--get-vars params))) + +(defun org-babel-lua-var-to-lua (var) + "Convert an elisp value to a lua variable. +Convert an elisp value, VAR, into a string of lua source code +specifying a variable of the same value." + (if (listp var) + (if (and (= 1 (length var)) (not (listp (car var)))) + (org-babel-lua-var-to-lua (car var)) + (if (and + (= 2 (length var)) + (not (listp (car var)))) + (concat + (substring-no-properties (car var)) + "=" + (org-babel-lua-var-to-lua (cdr var))) + (concat "{" (mapconcat #'org-babel-lua-var-to-lua var ", ") "}"))) + (if (eq var 'hline) + org-babel-lua-hline-to + (format + (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S") + (if (stringp var) (substring-no-properties var) var))))) + +(defun org-babel-lua-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If the results look like a list or tuple, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (let ((res (org-babel-script-escape results))) + (if (listp res) + (mapcar (lambda (el) (if (eq el 'None) + org-babel-lua-None-to el)) + res) + res))) + +(defvar org-babel-lua-buffers '((:default . "*Lua*"))) + +(defun org-babel-lua-session-buffer (session) + "Return the buffer associated with SESSION." + (cdr (assoc session org-babel-lua-buffers))) + +(defun org-babel-lua-with-earmuffs (session) + (let ((name (if (stringp session) session (format "%s" session)))) + (if (and (string= "*" (substring name 0 1)) + (string= "*" (substring name (- (length name) 1)))) + name + (format "*%s*" name)))) + +(defun org-babel-lua-without-earmuffs (session) + (let ((name (if (stringp session) session (format "%s" session)))) + (if (and (string= "*" (substring name 0 1)) + (string= "*" (substring name (- (length name) 1)))) + (substring name 1 (- (length name) 1)) + name))) + +(defvar lua-default-interpreter) +(defvar lua-which-bufname) +(defvar lua-shell-buffer-name) +(defun org-babel-lua-initiate-session-by-key (&optional session) + "Initiate a lua session. +If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + ;; (require org-babel-lua-mode) + (save-window-excursion + (let* ((session (if session (intern session) :default)) + (lua-buffer (org-babel-lua-session-buffer session)) + ;; (cmd (if (member system-type '(cygwin windows-nt ms-dos)) + ;; (concat org-babel-lua-command " -i") + ;; org-babel-lua-command)) + ) + (cond + ((and (eq 'lua-mode org-babel-lua-mode) + (fboundp 'lua-start-process)) ; lua-mode.el + ;; Make sure that lua-which-bufname is initialized, as otherwise + ;; it will be overwritten the first time a Lua buffer is + ;; created. + ;;(lua-toggle-shells lua-default-interpreter) + ;; `lua-shell' creates a buffer whose name is the value of + ;; `lua-which-bufname' with '*'s at the beginning and end + (let* ((bufname (if (and lua-buffer (buffer-live-p lua-buffer)) + (replace-regexp-in-string ;; zap surrounding * + "^\\*\\([^*]+\\)\\*$" "\\1" (buffer-name lua-buffer)) + (concat "Lua-" (symbol-name session)))) + (lua-which-bufname bufname)) + (lua-start-process) + (setq lua-buffer (org-babel-lua-with-earmuffs bufname)))) + (t + (error "No function available for running an inferior Lua"))) + (setq org-babel-lua-buffers + (cons (cons session lua-buffer) + (assq-delete-all session org-babel-lua-buffers))) + session))) + +(defun org-babel-lua-initiate-session (&optional session _params) + "Create a session named SESSION according to PARAMS." + (unless (string= session "none") + (error "Sessions currently not supported, work in progress") + (org-babel-lua-session-buffer + (org-babel-lua-initiate-session-by-key session)))) + +(defvar org-babel-lua-eoe-indicator "--eoe" + "A string to indicate that evaluation has completed.") + +(defvar org-babel-lua-wrapper-method + " +function main() +%s +end + +fd=io.open(\"%s\", \"w\") +fd:write( main() ) +fd:close()") +(defvar org-babel-lua-pp-wrapper-method + " +-- table to string +function t2s(t, indent) + if indent == nil then + indent = \"\" + end + if type(t) == \"table\" then + ts = \"\" + for k,v in pairs(t) do + if type(v) == \"table\" then + ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \\n\" .. + t2s(v, indent .. \" \") + else + ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \" .. + t2s(v, indent .. \" \") .. \"\\n\" + end + end + return ts + else + return tostring(t) + end +end + + +function main() +%s +end + +fd=io.open(\"%s\", \"w\") +fd:write(t2s(main())) +fd:close()") + +(defun org-babel-lua-evaluate + (session body &optional result-type result-params preamble) + "Evaluate BODY as Lua code." + (if session + (org-babel-lua-evaluate-session + session body result-type result-params) + (org-babel-lua-evaluate-external-process + body result-type result-params preamble))) + +(defun org-babel-lua-evaluate-external-process + (body &optional result-type result-params preamble) + "Evaluate BODY in external lua process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (let ((raw + (pcase result-type + (`output (org-babel-eval org-babel-lua-command + (concat (if preamble (concat preamble "\n")) + body))) + (`value (let ((tmp-file (org-babel-temp-file "lua-"))) + (org-babel-eval + org-babel-lua-command + (concat + (if preamble (concat preamble "\n") "") + (format + (if (member "pp" result-params) + org-babel-lua-pp-wrapper-method + org-babel-lua-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-trim body)) + "[\r\n]") "\n") + (org-babel-process-file-name tmp-file 'noquote)))) + (org-babel-eval-read-file tmp-file)))))) + (org-babel-result-cond result-params + raw + (org-babel-lua-table-or-string (org-trim raw))))) + +(defun org-babel-lua-evaluate-session + (session body &optional result-type result-params) + "Pass BODY to the Lua process in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5))) + (dump-last-value + (lambda + (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (funcall send-wait)) + (if pp + (list + "-- table to string +function t2s(t, indent) + if indent == nil then + indent = \"\" + end + if type(t) == \"table\" then + ts = \"\" + for k,v in pairs(t) do + if type(v) == \"table\" then + ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \\n\" .. + t2s(v, indent .. \" \") + else + ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \" .. + t2s(v, indent .. \" \") .. \"\\n\" + end + end + return ts + else + return tostring(t) + end +end +" + (concat "fd:write(_)) +fd:close()" + (org-babel-process-file-name tmp-file 'noquote))) + (list (format "fd=io.open(\"%s\", \"w\") +fd:write( _ ) +fd:close()" + (org-babel-process-file-name tmp-file + 'noquote))))))) + (input-body (lambda (body) + (mapc (lambda (line) (insert line) (funcall send-wait)) + (split-string body "[\r\n]")) + (funcall send-wait))) + (results + (pcase result-type + (`output + (mapconcat + #'org-trim + (butlast + (org-babel-comint-with-output + (session org-babel-lua-eoe-indicator t body) + (funcall input-body body) + (funcall send-wait) (funcall send-wait) + (insert org-babel-lua-eoe-indicator) + (funcall send-wait)) + 2) "\n")) + (`value + (let ((tmp-file (org-babel-temp-file "lua-"))) + (org-babel-comint-with-output + (session org-babel-lua-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-lua-eoe-indicator) + (funcall send-wait))) + (org-babel-eval-read-file tmp-file)))))) + (unless (string= (substring org-babel-lua-eoe-indicator 1 -1) results) + (org-babel-result-cond result-params + results + (org-babel-lua-table-or-string results))))) + +(defun org-babel-lua-read-string (string) + "Strip 's from around Lua string." + (org-unbracket-string "'" "'" string)) + +(provide 'ob-lua) + + + +;;; ob-lua.el ends here diff --git a/lisp/ob-makefile.el b/lisp/ob-makefile.el index 8f33773..69c6e51 100644 --- a/lisp/ob-makefile.el +++ b/lisp/ob-makefile.el @@ -1,4 +1,4 @@ -;;; ob-makefile.el --- org-babel functions for makefile evaluation +;;; ob-makefile.el --- Babel Functions for Makefile -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -24,19 +24,19 @@ ;;; Commentary: -;; This file exists solely for tangling a Makefile from org-mode files. +;; This file exists solely for tangling a Makefile from Org files. ;;; Code: (require 'ob) (defvar org-babel-default-header-args:makefile '()) -(defun org-babel-execute:makefile (body params) +(defun org-babel-execute:makefile (body _params) "Execute a block of makefile code. This function is called by `org-babel-execute-src-block'." body) -(defun org-babel-prep-session:makefile (session params) +(defun org-babel-prep-session:makefile (_session _params) "Return an error if the :session header argument is set. Make does not support sessions." (error "Makefile sessions are nonsensical")) diff --git a/lisp/ob-matlab.el b/lisp/ob-matlab.el index 69b4c45..0d3909d 100644 --- a/lisp/ob-matlab.el +++ b/lisp/ob-matlab.el @@ -1,4 +1,4 @@ -;;; ob-matlab.el --- org-babel support for matlab evaluation +;;; ob-matlab.el --- Babel support for Matlab -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. diff --git a/lisp/ob-maxima.el b/lisp/ob-maxima.el index 9b6cee6..4d16156 100644 --- a/lisp/ob-maxima.el +++ b/lisp/ob-maxima.el @@ -1,4 +1,4 @@ -;;; ob-maxima.el --- org-babel functions for maxima evaluation +;;; ob-maxima.el --- Babel Functions for Maxima -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -48,7 +48,7 @@ (defun org-babel-maxima-expand (body params) "Expand a block of Maxima code according to its header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapconcat 'identity (list ;; graphic output @@ -69,9 +69,9 @@ "Execute a block of Maxima entries with org-babel. This function is called by `org-babel-execute-src-block'." (message "executing Maxima source code block") - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (let ((result-params (split-string (or (cdr (assq :results params)) ""))) (result - (let* ((cmdline (or (cdr (assoc :cmdline params)) "")) + (let* ((cmdline (or (cdr (assq :cmdline params)) "")) (in-file (org-babel-temp-file "maxima-" ".max")) (cmd (format "%s --very-quiet -r 'batchload(%S)$' %s" org-babel-maxima-command in-file cmdline))) @@ -98,7 +98,7 @@ This function is called by `org-babel-execute-src-block'." (org-babel-import-elisp-from-file tmp-file)))))) -(defun org-babel-prep-session:maxima (session params) +(defun org-babel-prep-session:maxima (_session _params) (error "Maxima does not support sessions")) (defun org-babel-maxima-var-to-maxima (pair) diff --git a/lisp/ob-mscgen.el b/lisp/ob-mscgen.el index dae4c65..f53b09f 100644 --- a/lisp/ob-mscgen.el +++ b/lisp/ob-mscgen.el @@ -1,4 +1,4 @@ -;;; ob-msc.el --- org-babel functions for mscgen evaluation +;;; ob-msc.el --- Babel Functions for Mscgen -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -65,15 +65,15 @@ This function is called by `org-babel-execute-src-block'. Default filetype is png. Modify by setting :filetype parameter to mscgen supported formats." - (let* ((out-file (or (cdr (assoc :file params)) "output.png" )) - (filetype (or (cdr (assoc :filetype params)) "png" ))) - (unless (cdr (assoc :file params)) + (let* ((out-file (or (cdr (assq :file params)) "output.png" )) + (filetype (or (cdr (assq :filetype params)) "png" ))) + (unless (cdr (assq :file params)) (error " ERROR: no output file specified. Add \":file name.png\" to the src header")) (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) nil)) ;; signal that output has already been written to file -(defun org-babel-prep-session:mscgen (session params) +(defun org-babel-prep-session:mscgen (_session _params) "Raise an error because Mscgen doesn't support sessions." (error "Mscgen does not support sessions")) diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el index eadc388..4c9d295 100644 --- a/lisp/ob-ocaml.el +++ b/lisp/ob-ocaml.el @@ -1,4 +1,4 @@ -;;; ob-ocaml.el --- org-babel functions for ocaml evaluation +;;; ob-ocaml.el --- Babel Functions for Ocaml -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -37,11 +37,11 @@ ;;; Code: (require 'ob) (require 'comint) -(eval-when-compile (require 'cl)) (declare-function tuareg-run-caml "ext:tuareg" ()) (declare-function tuareg-run-ocaml "ext:tuareg" ()) (declare-function tuareg-interactive-send-input "ext:tuareg" ()) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml")) @@ -60,14 +60,13 @@ (defun org-babel-execute:ocaml (body params) "Execute a block of Ocaml code with Babel." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (full-body (org-babel-expand-body:generic + (let* ((full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:ocaml params))) (session (org-babel-prep-session:ocaml - (cdr (assoc :session params)) params)) + (cdr (assq :session params)) params)) (raw (org-babel-comint-with-output - (session org-babel-ocaml-eoe-output t full-body) + (session org-babel-ocaml-eoe-output nil full-body) (insert (concat (org-babel-chomp full-body) ";;\n" @@ -80,32 +79,31 @@ (progn (setq out nil) line) (when (string-match re line) (progn (setq out t) nil)))) - (mapcar #'org-babel-trim (reverse raw))))))) - (raw (org-babel-trim clean)) - (result-params (cdr (assoc :result-params params))) - (parsed - (string-match - "\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$" + (mapcar #'org-trim (reverse raw))))))) + (raw (org-trim clean)) + (result-params (cdr (assq :result-params params)))) + (string-match + "\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$" + raw) + (let ((output (match-string 1 raw)) + (type (match-string 3 raw)) + (value (match-string 5 raw))) + (org-babel-reassemble-table + (org-babel-result-cond result-params + (cond + ((member "verbatim" result-params) raw) + ((member "output" result-params) output) + (t raw)) + (if (and value type) + (org-babel-ocaml-parse-output value type) raw)) - (output (match-string 1 raw)) - (type (match-string 3 raw)) - (value (match-string 5 raw))) - (org-babel-reassemble-table - (org-babel-result-cond result-params - (cond - ((member "verbatim" result-params) raw) - ((member "output" result-params) output) - (t raw)) - (if (and value type) - (org-babel-ocaml-parse-output value type) - raw)) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (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))))))) (defvar tuareg-interactive-buffer-name) -(defun org-babel-prep-session:ocaml (session params) +(defun org-babel-prep-session:ocaml (session _params) "Prepare SESSION according to the header arguments in PARAMS." (require 'tuareg) (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none")) @@ -123,7 +121,7 @@ (mapcar (lambda (pair) (format "let %s = %s;;" (car pair) (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-ocaml-elisp-to-ocaml (val) "Return a string of ocaml code which evaluates to VAL." diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el index fba5a01..09b4092 100644 --- a/lisp/ob-octave.el +++ b/lisp/ob-octave.el @@ -1,4 +1,4 @@ -;;; ob-octave.el --- org-babel functions for octave and matlab evaluation +;;; ob-octave.el --- Babel Functions for Octave and Matlab -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -30,10 +30,10 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (declare-function matlab-shell "ext:matlab-mode") (declare-function matlab-shell-run-region "ext:matlab-mode") +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-default-header-args:matlab '()) (defvar org-babel-default-header-args:octave '()) @@ -74,11 +74,8 @@ end") (let* ((session (funcall (intern (format "org-babel-%s-initiate-session" (if matlabp "matlab" "octave"))) - (cdr (assoc :session params)) params)) - (vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) - (out-file (cdr (assoc :file params))) + (cdr (assq :session params)) params)) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:octave params))) @@ -99,9 +96,9 @@ end") (org-babel-reassemble-table result (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))) (defun org-babel-prep-session:matlab (session params) "Prepare SESSION according to PARAMS." @@ -114,7 +111,7 @@ end") (format "%s=%s;" (car pair) (org-babel-octave-var-to-octave (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defalias 'org-babel-variable-assignments:matlab 'org-babel-variable-assignments:octave) @@ -148,7 +145,7 @@ If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." (org-babel-octave-initiate-session session params 'matlab)) -(defun org-babel-octave-initiate-session (&optional session params matlabp) +(defun org-babel-octave-initiate-session (&optional session _params matlabp) "Create an octave inferior process buffer. If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." @@ -180,9 +177,9 @@ value of the last statement in BODY, as elisp." (let ((cmd (if matlabp org-babel-matlab-shell-command org-babel-octave-shell-command))) - (case result-type - (output (org-babel-eval cmd body)) - (value (let ((tmp-file (org-babel-temp-file "octave-"))) + (pcase result-type + (`output (org-babel-eval cmd body)) + (`value (let ((tmp-file (org-babel-temp-file "octave-"))) (org-babel-eval cmd (format org-babel-octave-wrapper-method body @@ -191,17 +188,17 @@ value of the last statement in BODY, as elisp." (org-babel-octave-import-elisp-from-file tmp-file)))))) (defun org-babel-octave-evaluate-session - (session body result-type &optional matlabp) + (session body result-type &optional matlabp) "Evaluate BODY in SESSION." (let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-"))) (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-")) (full-body - (case result-type - (output + (pcase result-type + (`output (mapconcat #'org-babel-chomp (list body org-babel-octave-eoe-indicator) "\n")) - (value + (`value (if (and matlabp org-babel-matlab-with-emacs-link) (concat (format org-babel-matlab-emacs-link-wrapper-method @@ -234,21 +231,20 @@ value of the last statement in BODY, as elisp." org-babel-octave-eoe-output) t full-body) (insert full-body) (comint-send-input nil t)))) results) - (case result-type - (value + (pcase result-type + (`value (org-babel-octave-import-elisp-from-file tmp-file)) - (output - (progn - (setq results - (if matlabp - (cdr (reverse (delq "" (mapcar - #'org-babel-octave-read-string - (mapcar #'org-babel-trim raw))))) - (cdr (member org-babel-octave-eoe-output - (reverse (mapcar - #'org-babel-octave-read-string - (mapcar #'org-babel-trim raw))))))) - (mapconcat #'identity (reverse results) "\n")))))) + (`output + (setq results + (if matlabp + (cdr (reverse (delq "" (mapcar + #'org-babel-strip-quotes + (mapcar #'org-trim raw))))) + (cdr (member org-babel-octave-eoe-output + (reverse (mapcar + #'org-babel-strip-quotes + (mapcar #'org-trim raw))))))) + (mapconcat #'identity (reverse results) "\n"))))) (defun org-babel-octave-import-elisp-from-file (file-name) "Import data from FILE-NAME. @@ -263,12 +259,6 @@ This removes initial blank and comment lines and then calls (delete-region beg end))) (org-babel-import-elisp-from-file temp-file '(16)))) -(defun org-babel-octave-read-string (string) - "Strip \\\"s from around octave string." - (if (string-match "^\"\\([^\000]+\\)\"$" string) - (match-string 1 string) - string)) - (provide 'ob-octave) diff --git a/lisp/ob-org.el b/lisp/ob-org.el index af5b548..580d2b0 100644 --- a/lisp/ob-org.el +++ b/lisp/ob-org.el @@ -1,4 +1,4 @@ -;;; ob-org.el --- org-babel functions for org code block evaluation +;;; ob-org.el --- Babel Functions for Org Code Blocks -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -41,7 +41,7 @@ "Default header inserted during export of org blocks.") (defun org-babel-expand-body:org (body params) - (dolist (var (mapcar #'cdr (org-babel-get-header params :var))) + (dolist (var (org-babel--get-vars params)) (setq body (replace-regexp-in-string (regexp-quote (format "$%s" (car var))) (format "%s" (cdr var)) @@ -51,7 +51,7 @@ (defun org-babel-execute:org (body params) "Execute a block of Org code with. This function is called by `org-babel-execute-src-block'." - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (let ((result-params (split-string (or (cdr (assq :results params)) ""))) (body (org-babel-expand-body:org (replace-regexp-in-string "^," "" body) params))) (cond @@ -61,7 +61,7 @@ This function is called by `org-babel-execute-src-block'." ((member "ascii" result-params) (org-export-string-as body 'ascii t)) (t body)))) -(defun org-babel-prep-session:org (session params) +(defun org-babel-prep-session:org (_session _params) "Return an error because org does not support sessions." (error "Org does not support sessions")) diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el index 3a63837..a1aadbb 100644 --- a/lisp/ob-perl.el +++ b/lisp/ob-perl.el @@ -1,4 +1,4 @@ -;;; ob-perl.el --- org-babel functions for perl evaluation +;;; ob-perl.el --- Babel Functions for Perl -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -28,7 +28,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl")) @@ -41,20 +40,20 @@ (defun org-babel-execute:perl (body params) "Execute a block of Perl code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((session (cdr (assoc :session params))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (let* ((session (cdr (assq :session params))) + (result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:perl params))) (session (org-babel-perl-initiate-session session))) (org-babel-reassemble-table (org-babel-perl-evaluate session full-body result-type result-params) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) -(defun org-babel-prep-session:perl (session params) +(defun org-babel-prep-session:perl (_session _params) "Prepare SESSION according to the header arguments in PARAMS." (error "Sessions are not supported for Perl")) @@ -63,7 +62,7 @@ This function is called by `org-babel-execute-src-block'." (mapcar (lambda (pair) (org-babel-perl--var-to-perl (cdr pair) (car pair))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) ;; helper functions @@ -76,7 +75,7 @@ This function is called by `org-babel-execute-src-block'." The elisp value, VAR, is converted to a string of perl source code specifying a var of the same value." (if varn - (let ((org-babel-perl--lvl 0) (lvar (listp var)) prefix) + (let ((org-babel-perl--lvl 0) (lvar (listp var))) (concat "my $" (symbol-name varn) "=" (when lvar "\n") (org-babel-perl--var-to-perl var) ";\n")) @@ -92,7 +91,7 @@ specifying a var of the same value." (defvar org-babel-perl-buffers '(:default . nil)) -(defun org-babel-perl-initiate-session (&optional session params) +(defun org-babel-perl-initiate-session (&optional _session _params) "Return nil because sessions are not supported by perl." nil) @@ -136,13 +135,13 @@ return the value of the last statement in BODY, as elisp." (tmp-babel-file (org-babel-process-file-name tmp-file 'noquote))) (let ((results - (case result-type - (output + (pcase result-type + (`output (with-temp-file tmp-file (insert (org-babel-eval org-babel-perl-command body)) (buffer-string))) - (value + (`value (org-babel-eval org-babel-perl-command (format org-babel-perl-wrapper-method body tmp-babel-file)))))) diff --git a/lisp/ob-picolisp.el b/lisp/ob-picolisp.el index 2a4ddc0..348b1f6 100644 --- a/lisp/ob-picolisp.el +++ b/lisp/ob-picolisp.el @@ -1,4 +1,4 @@ -;;; ob-picolisp.el --- org-babel functions for picolisp evaluation +;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -55,7 +55,6 @@ ;;; Code: (require 'ob) (require 'comint) -(eval-when-compile (require 'cl)) (declare-function run-picolisp "ext:inferior-picolisp" (cmd)) (defvar org-babel-tangle-lang-exts) ;; Autoloaded @@ -80,9 +79,9 @@ (defun org-babel-expand-body:picolisp (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) - (print-level nil) (print-length nil)) + (let ((vars (org-babel--get-vars params)) + (print-level nil) + (print-length nil)) (if (> (length vars) 0) (concat "(prog (let (" (mapconcat @@ -100,12 +99,11 @@ (message "executing Picolisp source code block") (let* ( ;; Name of the session or "none". - (session-name (cdr (assoc :session params))) + (session-name (cdr (assq :session params))) ;; Set the session if the session variable is non-nil. (session (org-babel-picolisp-initiate-session session-name)) ;; Either OUTPUT or VALUE which should behave as described above. - (result-type (cdr (assoc :result-type params))) - (result-params (cdr (assoc :result-params params))) + (result-params (cdr (assq :result-params params))) ;; Expand the body with `org-babel-expand-body:picolisp'. (full-body (org-babel-expand-body:picolisp body params)) ;; Wrap body appropriately for the type of evaluation and results. diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index 9a0604c..9ce65a9 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -1,4 +1,4 @@ -;;; ob-plantuml.el --- org-babel functions for plantuml evaluation +;;; ob-plantuml.el --- Babel Functions for Plantuml -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -49,21 +49,36 @@ (defun org-babel-execute:plantuml (body params) "Execute a block of plantuml code with org-babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (or (cdr (assoc :file params)) + (let* ((out-file (or (cdr (assq :file params)) (error "PlantUML requires a \":file\" header argument"))) - (cmdline (cdr (assoc :cmdline params))) + (cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "plantuml-")) - (java (or (cdr (assoc :java params)) "")) + (java (or (cdr (assq :java params)) "")) (cmd (if (string= "" org-plantuml-jar-path) (error "`org-plantuml-jar-path' is not set") (concat "java " java " -jar " (shell-quote-argument (expand-file-name org-plantuml-jar-path)) + (if (string= (file-name-extension out-file) "png") + " -tpng" "") (if (string= (file-name-extension out-file) "svg") " -tsvg" "") (if (string= (file-name-extension out-file) "eps") " -teps" "") + (if (string= (file-name-extension out-file) "pdf") + " -tpdf" "") + (if (string= (file-name-extension out-file) "vdx") + " -tvdx" "") + (if (string= (file-name-extension out-file) "xmi") + " -txmi" "") + (if (string= (file-name-extension out-file) "scxml") + " -tscxml" "") + (if (string= (file-name-extension out-file) "html") + " -thtml" "") + (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) " > " @@ -74,7 +89,7 @@ This function is called by `org-babel-execute-src-block'." (message "%s" cmd) (org-babel-eval cmd "") nil)) ;; signal that output has already been written to file -(defun org-babel-prep-session:plantuml (session params) +(defun org-babel-prep-session:plantuml (_session _params) "Return an error because plantuml does not support sessions." (error "Plantuml does not support sessions")) diff --git a/lisp/ob-processing.el b/lisp/ob-processing.el index 2410402..e1801e2 100644 --- a/lisp/ob-processing.el +++ b/lisp/ob-processing.el @@ -1,4 +1,4 @@ -;;; ob-processing.el --- Babel functions for evaluation of processing +;;; ob-processing.el --- Babel functions for processing -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2016 Free Software Foundation, Inc. @@ -52,7 +52,6 @@ ;;; Code: (require 'ob) (require 'sha1) -(eval-when-compile (require 'cl)) (declare-function processing-sketch-run "ext:processing-mode" ()) @@ -96,7 +95,7 @@ (progn (setq sketch-dir-candidate (make-temp-file "processing" t)) - (when (org-string-match-p + (when (string-match-p "-" (file-name-nondirectory sketch-dir-candidate)) (delete-directory sketch-dir-candidate) @@ -134,7 +133,7 @@ This function is called by `org-babel-execute-src-block'." sketch-canvas-id "\"></canvas>")))) -(defun org-babel-prep-session:processing (session params) +(defun org-babel-prep-session:processing (_session _params) "Return an error if the :session header argument is set. Processing does not support sessions" (error "Processing does not support sessions")) @@ -142,7 +141,7 @@ Processing does not support sessions" (defun org-babel-variable-assignments:processing (params) "Return list of processing statements assigning the block's variables." (mapcar #'org-babel-processing-var-to-processing - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-processing-var-to-processing (pair) "Convert an elisp value into a Processing variable. @@ -179,17 +178,16 @@ a variable of the same value." DATA is a list. Return type as a symbol. -The type is `String' if any element in DATA is -a string. Otherwise, it is either `float', if some elements are -floats, or `int'." - (let* ((type 'int) - find-type ; For byte-compiler. - (find-type - (lambda (row) - (dolist (e row type) - (cond ((listp e) (setq type (funcall find-type e))) - ((stringp e) (throw 'exit 'String)) - ((floatp e) (setq type 'float))))))) +The type is `String' if any element in DATA is a string. +Otherwise, it is either `float', if some elements are floats, or +`int'." + (letrec ((type 'int) + (find-type + (lambda (row) + (dolist (e row type) + (cond ((listp e) (setq type (funcall find-type e))) + ((stringp e) (throw 'exit 'String)) + ((floatp e) (setq type 'float))))))) (catch 'exit (funcall find-type data)))) (provide 'ob-processing) diff --git a/lisp/ob-python.el b/lisp/ob-python.el index 1932e61..05f2dbb 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -1,4 +1,4 @@ -;;; ob-python.el --- org-babel functions for python evaluation +;;; ob-python.el --- Babel Functions for Python -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -28,12 +28,12 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (declare-function org-remove-indentation "org" ) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function py-shell "ext:python-mode" (&optional argprompt)) (declare-function py-toggle-shells "ext:python-mode" (arg)) -(declare-function run-python "ext:python" (cmd &optional dedicated show)) +(declare-function run-python "ext:python" (&optional cmd dedicated show)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) @@ -48,7 +48,7 @@ :type 'string) (defcustom org-babel-python-mode - (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python) + (if (featurep 'python-mode) 'python-mode 'python) "Preferred python mode for use in running python interactively. This will typically be either `python' or `python-mode'." :group 'org-babel @@ -74,14 +74,14 @@ This will typically be either `python' or `python-mode'." "Execute a block of Python code with Babel. This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-python-initiate-session - (cdr (assoc :session params)))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (cdr (assq :session params)))) + (result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (return-val (when (and (eq result-type 'value) (not session)) - (cdr (assoc :return params)))) - (preamble (cdr (assoc :preamble params))) + (cdr (assq :return params)))) + (preamble (cdr (assq :preamble params))) (org-babel-python-command - (or (cdr (assoc :python params)) org-babel-python-command)) + (or (cdr (assq :python params)) org-babel-python-command)) (full-body (org-babel-expand-body:generic (concat body (if return-val (format "\nreturn %s" return-val) "")) @@ -90,10 +90,10 @@ This function is called by `org-babel-execute-src-block'." session full-body result-type result-params preamble))) (org-babel-reassemble-table result - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))) + (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-prep-session:python (session params) "Prepare SESSION according to the header arguments in PARAMS. @@ -125,7 +125,7 @@ VARS contains resolved variable references" (format "%s=%s" (car pair) (org-babel-python-var-to-python (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-python-var-to-python (var) "Convert an elisp value to a python variable. @@ -133,7 +133,7 @@ Convert an elisp value, VAR, into a string of python source code specifying a variable of the same value." (if (listp var) (concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]") - (if (equal var 'hline) + (if (eq var 'hline) org-babel-python-hline-to (format (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S") @@ -145,7 +145,7 @@ If the results look like a list or tuple, then convert them into an Emacs-lisp table, otherwise return the results as a string." (let ((res (org-babel-script-escape results))) (if (listp res) - (mapcar (lambda (el) (if (equal el 'None) + (mapcar (lambda (el) (if (eq el 'None) org-babel-python-None-to el)) res) res))) @@ -216,7 +216,7 @@ then create. Return the initialized session." (assq-delete-all session org-babel-python-buffers))) session))) -(defun org-babel-python-initiate-session (&optional session params) +(defun org-babel-python-initiate-session (&optional session _params) "Create a session named SESSION according to PARAMS." (unless (string= session "none") (org-babel-python-session-buffer @@ -248,36 +248,35 @@ open('%s', 'w').write( pprint.pformat(main()) )") body result-type result-params preamble))) (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. If RESULT-TYPE equals `output' then return standard output as a string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (let ((raw - (case result-type - (output (org-babel-eval org-babel-python-command - (concat (if preamble (concat preamble "\n")) - body))) - (value (let ((tmp-file (org-babel-temp-file "python-"))) - (org-babel-eval - org-babel-python-command - (concat - (if preamble (concat preamble "\n") "") - (format - (if (member "pp" result-params) - org-babel-python-pp-wrapper-method - org-babel-python-wrapper-method) - (mapconcat - (lambda (line) (format "\t%s" line)) - (split-string - (org-remove-indentation - (org-babel-trim body)) - "[\r\n]") "\n") - (org-babel-process-file-name tmp-file 'noquote)))) - (org-babel-eval-read-file tmp-file)))))) + (pcase result-type + (`output (org-babel-eval org-babel-python-command + (concat (if preamble (concat preamble "\n")) + body))) + (`value (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-eval + org-babel-python-command + (concat + (if preamble (concat preamble "\n") "") + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (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-eval-read-file tmp-file)))))) (org-babel-result-cond result-params raw - (org-babel-python-table-or-string (org-babel-trim raw))))) + (org-babel-python-table-or-string (org-trim raw))))) (defun org-babel-python-evaluate-session (session body &optional result-type result-params) @@ -304,10 +303,10 @@ last statement in BODY, as elisp." (split-string body "[\r\n]")) (funcall send-wait))) (results - (case result-type - (output + (pcase result-type + (`output (mapconcat - #'org-babel-trim + #'org-trim (butlast (org-babel-comint-with-output (session org-babel-python-eoe-indicator t body) @@ -316,7 +315,7 @@ last statement in BODY, as elisp." (insert org-babel-python-eoe-indicator) (funcall send-wait)) 2) "\n")) - (value + (`value (let ((tmp-file (org-babel-temp-file "python-"))) (org-babel-comint-with-output (session org-babel-python-eoe-indicator nil body) @@ -335,8 +334,9 @@ last statement in BODY, as elisp." (defun org-babel-python-read-string (string) "Strip \\='s from around Python string." - (if (string-match "^'\\([^\000]+\\)'$" string) - (match-string 1 string) + (if (and (string-prefix-p "'" string) + (string-suffix-p "'" string)) + (substring string 1 -1) string)) (provide 'ob-python) diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index 95eb114..c109d89 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -1,4 +1,4 @@ -;;; ob-ref.el --- org-babel functions for referencing external data +;;; ob-ref.el --- Babel Functions for Referencing External Data -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -50,23 +50,20 @@ ;;; Code: (require 'ob-core) -(eval-when-compile - (require 'cl)) +(require 'cl-lib) +(declare-function org-babel-lob-get-info "ob-lob" (&optional datum)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) (declare-function org-end-of-meta-data "org" (&optional full)) (declare-function org-find-property "org" (property &optional value)) -(declare-function org-remove-if-not "org" (predicate seq)) -(declare-function org-at-table-p "org" (&optional table-type)) -(declare-function org-count "org" (CL-ITEM CL-SEQ)) -(declare-function org-at-item-p "org-list" ()) -(declare-function org-narrow-to-subtree "org" ()) -(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) (declare-function org-id-find-id-file "org-id" (id)) +(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) +(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) +(declare-function org-narrow-to-subtree "org" ()) (declare-function org-show-context "org" (&optional key)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) -(declare-function org-babel-lob-execute "ob-lob" (info)) -(declare-function org-babel-lob-get-info "ob-lob" nil) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-ref-split-regexp "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*") @@ -94,7 +91,8 @@ the variable." org-babel-current-src-block-location))) (org-babel-read ref)))) (if (equal out ref) - (if (string-match "^\".*\"$" ref) + (if (and (string-prefix-p "\"" ref) + (string-suffix-p "\"" ref)) (read ref) (org-babel-ref-resolve ref)) out)))))) @@ -106,7 +104,7 @@ the variable." (m (when file (org-id-find-id-in-file id file 'marker)))) (when (and file m) (message "file:%S" file) - (org-pop-to-buffer-same-window (marker-buffer m)) + (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) (move-marker m nil) (org-show-context) @@ -121,7 +119,6 @@ the variable." (point)) (point-max)))) -(defvar org-babel-lob-one-liner-regexp) (defvar org-babel-library-of-babel) (defun org-babel-ref-resolve (ref) "Resolve the reference REF and return its value." @@ -129,12 +126,12 @@ the variable." (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer)) (save-excursion (let ((case-fold-search t) - type args new-refere new-header-args new-referent result - lob-info split-file split-ref index index-row index-col id) + args new-refere new-header-args new-referent split-file split-ref + index) ;; if ref is indexed grab the indices -- beware nested indices (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) (let ((str (substring ref 0 (match-beginning 0)))) - (= (org-count ?( str) (org-count ?) str)))) + (= (cl-count ?( str) (cl-count ?) str)))) (setq index (match-string 1 ref)) (setq ref (substring ref 0 (match-beginning 0)))) ;; assign any arguments to pass to source block @@ -154,71 +151,54 @@ the variable." (when (string-match "^\\(.+\\):\\(.+\\)$" ref) (setq split-file (match-string 1 ref)) (setq split-ref (match-string 2 ref)) - (find-file split-file) (setq ref split-ref)) - (save-restriction - (widen) - (goto-char (point-min)) - (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref)) - (res-rx (org-babel-named-data-regexp-for-name ref))) - ;; goto ref in the current buffer - (or - ;; check for code blocks - (re-search-forward src-rx nil t) - ;; check for named data - (re-search-forward res-rx nil t) - ;; check for local or global headlines by id - (setq id (org-babel-ref-goto-headline-id ref)) - ;; check the Library of Babel - (setq lob-info (cdr (assoc (intern ref) - org-babel-library-of-babel))))) - (unless (or lob-info id) (goto-char (match-beginning 0))) - ;; ;; TODO: allow searching for names in other buffers - ;; (setq id-loc (org-id-find ref 'marker) - ;; buffer (marker-buffer id-loc) - ;; loc (marker-position id-loc)) - ;; (move-marker id-loc nil) - (error "Reference `%s' not found in this buffer" ref)) - (cond - (lob-info (setq type 'lob)) - (id (setq type 'id)) - ((and (looking-at org-babel-src-name-regexp) - (save-excursion - (forward-line 1) - (or (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp)))) - (setq type 'source-block)) - ((and (looking-at org-babel-src-name-regexp) - (save-excursion - (forward-line 1) - (looking-at org-babel-lob-one-liner-regexp))) - (setq type 'call-line)) - (t (while (not (setq type (org-babel-ref-at-ref-p))) - (forward-line 1) - (beginning-of-line) - (if (or (= (point) (point-min)) (= (point) (point-max))) - (error "Reference not found"))))) - (let ((params (append args '((:results . "silent"))))) - (setq result - (case type - (results-line (org-babel-read-result)) - (table (org-babel-read-table)) - (list (org-babel-read-list)) - (file (org-babel-read-link)) - (source-block (org-babel-execute-src-block - nil nil (if org-babel-update-intermediate - nil params))) - (call-line (save-excursion - (forward-line 1) - (org-babel-lob-execute - (org-babel-lob-get-info)))) - (lob (org-babel-execute-src-block - nil lob-info params)) - (id (org-babel-ref-headline-body))))) - (if (symbolp result) - (format "%S" result) - (if (and index (listp result)) - (org-babel-ref-index-list index result) - result)))))))) + (find-file split-file) + (setq ref split-ref)) + (org-with-wide-buffer + (goto-char (point-min)) + (let* ((params (append args '((:results . "silent")))) + (regexp (org-babel-named-data-regexp-for-name ref)) + (result + (catch :found + ;; Check for code blocks or named data. + (while (re-search-forward regexp nil t) + ;; Ignore COMMENTed headings and orphaned + ;; affiliated keywords. + (unless (org-in-commented-heading-p) + (let ((e (org-element-at-point))) + (when (equal (org-element-property :name e) ref) + (goto-char + (org-element-property :post-affiliated e)) + (pcase (org-element-type e) + (`babel-call + (throw :found + (org-babel-execute-src-block + nil (org-babel-lob-get-info e) params))) + (`src-block + (throw :found + (org-babel-execute-src-block + nil nil + (and + (not org-babel-update-intermediate) + params)))) + ((and (let v (org-babel-read-element e)) + (guard v)) + (throw :found v)) + (_ (error "Reference not found"))))))) + ;; Check for local or global headlines by ID. + (when (org-babel-ref-goto-headline-id ref) + (throw :found (org-babel-ref-headline-body))) + ;; Check the Library of Babel. + (let ((info (cdr (assq (intern ref) + org-babel-library-of-babel)))) + (when info + (throw :found + (org-babel-execute-src-block nil info params)))) + (error "Reference `%s' not found in this buffer" ref)))) + (cond + ((symbolp result) (format "%S" result)) + ((and index (listp result)) + (org-babel-ref-index-list index result)) + (t result))))))))) (defun org-babel-ref-index-list (index lis) "Return the subset of LIS indexed by INDEX. @@ -261,21 +241,9 @@ to \"0:-1\"." (defun org-babel-ref-split-args (arg-string) "Split ARG-STRING into top-level arguments of balanced parenthesis." - (mapcar #'org-babel-trim (org-babel-balanced-split arg-string 44))) + (mapcar #'org-trim (org-babel-balanced-split arg-string 44))) -(defvar org-bracket-link-regexp) -(defun org-babel-ref-at-ref-p () - "Return the type of reference located at point. -Return nil if none of the supported reference types are found. -Supported reference types are tables and source blocks." - (cond ((org-at-table-p) 'table) - ((org-at-item-p) 'list) - ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block) - ((looking-at org-bracket-link-regexp) 'file) - ((looking-at org-babel-result-regexp) 'results-line))) (provide 'ob-ref) - - ;;; ob-ref.el ends here diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index 0cc665d..6415f35 100644 --- a/lisp/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -1,4 +1,4 @@ -;;; ob-ruby.el --- org-babel functions for ruby evaluation +;;; ob-ruby.el --- Babel Functions for Ruby -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -37,8 +37,8 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function run-ruby "ext:inf-ruby" (&optional command name)) (declare-function xmp "ext:rcodetools" (&optional option)) @@ -68,16 +68,16 @@ "Execute a block of Ruby code with Babel. This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-ruby-initiate-session - (cdr (assoc :session params)))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (cdr (assq :session params)))) + (result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:ruby params))) (result (if (member "xmp" result-params) (with-temp-buffer (require 'rcodetools) (insert full-body) - (xmp (cdr (assoc :xmp-option params))) + (xmp (cdr (assq :xmp-option params))) (buffer-string)) (org-babel-ruby-evaluate session full-body result-type result-params)))) @@ -85,10 +85,10 @@ This function is called by `org-babel-execute-src-block'." (org-babel-result-cond result-params result (org-babel-ruby-table-or-string result)) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))) + (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-prep-session:ruby (session params) "Prepare SESSION according to the header arguments specified in PARAMS." @@ -121,7 +121,7 @@ This function is called by `org-babel-execute-src-block'." (format "%s=%s" (car pair) (org-babel-ruby-var-to-ruby (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-ruby-var-to-ruby (var) "Convert VAR into a ruby variable. @@ -129,7 +129,7 @@ Convert an elisp value into a string of ruby source code specifying a variable of the same value." (if (listp var) (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]") - (if (equal var 'hline) + (if (eq var 'hline) org-babel-ruby-hline-to (format "%S" var)))) @@ -139,12 +139,12 @@ If RESULTS look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." (let ((res (org-babel-script-escape results))) (if (listp res) - (mapcar (lambda (el) (if (equal el 'nil) - org-babel-ruby-nil-to el)) + (mapcar (lambda (el) (if (not el) + org-babel-ruby-nil-to el)) res) res))) -(defun org-babel-ruby-initiate-session (&optional session params) +(defun org-babel-ruby-initiate-session (&optional session _params) "Initiate a ruby session. If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session." @@ -185,26 +185,26 @@ end ") (defun org-babel-ruby-evaluate - (buffer body &optional result-type result-params) + (buffer body &optional result-type result-params) "Pass BODY to the Ruby process in BUFFER. If RESULT-TYPE equals `output' then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (if (not buffer) ;; external process evaluation - (case result-type - (output (org-babel-eval org-babel-ruby-command body)) - (value (let ((tmp-file (org-babel-temp-file "ruby-"))) - (org-babel-eval - org-babel-ruby-command - (format (if (member "pp" result-params) - org-babel-ruby-pp-wrapper-method - org-babel-ruby-wrapper-method) - body (org-babel-process-file-name tmp-file 'noquote))) - (org-babel-eval-read-file tmp-file)))) + (pcase result-type + (`output (org-babel-eval org-babel-ruby-command body)) + (`value (let ((tmp-file (org-babel-temp-file "ruby-"))) + (org-babel-eval + org-babel-ruby-command + (format (if (member "pp" result-params) + org-babel-ruby-pp-wrapper-method + org-babel-ruby-wrapper-method) + body (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-eval-read-file tmp-file)))) ;; comint session evaluation - (case result-type - (output + (pcase result-type + (`output (let ((eoe-string (format "puts \"%s\"" org-babel-ruby-eoe-indicator))) ;; Force the session to be ready before the actual session ;; code is run. There is some problem in comint that will @@ -220,7 +220,7 @@ return the value of the last statement in BODY, as elisp." (butlast (split-string (mapconcat - #'org-babel-trim + #'org-trim (org-babel-comint-with-output (buffer org-babel-ruby-eoe-indicator t body) (mapc @@ -231,7 +231,7 @@ return the value of the last statement in BODY, as elisp." "conf.prompt_mode=_org_prompt_mode;conf.echo=true" eoe-string))) "\n") "[\r\n]") 4) "\n"))) - (value + (`value (let* ((tmp-file (org-babel-temp-file "ruby-")) (ppp (or (member "code" result-params) (member "pp" result-params)))) @@ -254,12 +254,6 @@ return the value of the last statement in BODY, as elisp." (comint-send-input nil t)) (org-babel-eval-read-file tmp-file)))))) -(defun org-babel-ruby-read-string (string) - "Strip \\\"s from around a ruby string." - (if (string-match "^\"\\([^\000]+\\)\"$" string) - (match-string 1 string) - string)) - (provide 'ob-ruby) diff --git a/lisp/ob-sass.el b/lisp/ob-sass.el index f675914..53fb45e 100644 --- a/lisp/ob-sass.el +++ b/lisp/ob-sass.el @@ -1,4 +1,4 @@ -;;; ob-sass.el --- org-babel functions for the sass css generation language +;;; ob-sass.el --- Babel Functions for the Sass CSS generation language -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -45,10 +45,9 @@ (defun org-babel-execute:sass (body params) "Execute a block of Sass code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (file (cdr (assoc :file params))) + (let* ((file (cdr (assq :file params))) (out-file (or file (org-babel-temp-file "sass-out-"))) - (cmdline (cdr (assoc :cmdline params))) + (cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "sass-in-")) (cmd (concat "sass " (or cmdline "") " " (org-babel-process-file-name in-file) @@ -60,7 +59,7 @@ This function is called by `org-babel-execute-src-block'." nil ;; signal that output has already been written to file (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) -(defun org-babel-prep-session:sass (session params) +(defun org-babel-prep-session:sass (_session _params) "Raise an error because sass does not support sessions." (error "Sass does not support sessions")) diff --git a/lisp/ob-scala.el b/lisp/ob-scala.el index 7df8da8..8cdf2c0 100644 --- a/lisp/ob-scala.el +++ b/lisp/ob-scala.el @@ -1,4 +1,4 @@ -;;; ob-scala.el --- org-babel functions for Scala evaluation +;;; ob-scala.el --- Babel Functions for Scala -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2016 Free Software Foundation, Inc. @@ -31,7 +31,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) ;; Autoloaded (add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala")) @@ -45,9 +44,8 @@ called by `org-babel-execute-src-block'" (message "executing Scala source code block") (let* ((processed-params (org-babel-process-params params)) (session (org-babel-scala-initiate-session (nth 0 processed-params))) - (vars (nth 1 processed-params)) (result-params (nth 2 processed-params)) - (result-type (cdr (assoc :result-type params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params)) (result (org-babel-scala-evaluate @@ -56,9 +54,9 @@ called by `org-babel-execute-src-block'" (org-babel-reassemble-table result (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (defvar org-babel-scala-wrapper-method @@ -76,19 +74,19 @@ print(str_result) (defun org-babel-scala-evaluate - (session body &optional result-type result-params) + (session body &optional result-type result-params) "Evaluate BODY in external Scala process. If RESULT-TYPE equals `output' then return standard output as a string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY as elisp." (when session (error "Sessions are not (yet) supported for Scala")) - (case result-type - (output + (pcase result-type + (`output (let ((src-file (org-babel-temp-file "scala-"))) - (progn (with-temp-file src-file (insert body)) - (org-babel-eval - (concat org-babel-scala-command " " src-file) "")))) - (value + (with-temp-file src-file (insert body)) + (org-babel-eval + (concat org-babel-scala-command " " src-file) ""))) + (`value (let* ((src-file (org-babel-temp-file "scala-")) (wrapper (format org-babel-scala-wrapper-method body))) (with-temp-file src-file (insert wrapper)) @@ -99,11 +97,11 @@ in BODY as elisp." (org-babel-script-escape raw))))))) -(defun org-babel-prep-session:scala (session params) +(defun org-babel-prep-session:scala (_session _params) "Prepare SESSION according to the header arguments specified in PARAMS." (error "Sessions are not (yet) supported for Scala")) -(defun org-babel-scala-initiate-session (&optional session) +(defun org-babel-scala-initiate-session (&optional _session) "If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session. Sessions are not supported in Scala." diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el index 0473138..c1d5462 100644 --- a/lisp/ob-scheme.el +++ b/lisp/ob-scheme.el @@ -1,4 +1,4 @@ -;;; ob-scheme.el --- org-babel functions for Scheme +;;; ob-scheme.el --- Babel Functions for Scheme -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -45,17 +45,18 @@ (defvar geiser-default-implementation) ; Defined in geiser-impl.el (defvar geiser-active-implementations) ; Defined in geiser-impl.el -(declare-function run-geiser "geiser-repl" (impl)) -(declare-function geiser-mode "geiser-mode" ()) -(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg)) -(declare-function geiser-repl-exit "geiser-repl" (&optional arg)) +(declare-function run-geiser "ext:geiser-repl" (impl)) +(declare-function geiser-mode "ext:geiser-mode" ()) +(declare-function geiser-eval-region "ext:geiser-mode" + (start end &optional and-go raw nomsg)) +(declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg)) (defvar org-babel-default-header-args:scheme '() "Default header arguments for scheme code blocks.") (defun org-babel-expand-body:scheme (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (if (> (length vars) 0) (concat "(let (" (mapconcat @@ -172,7 +173,7 @@ is true; otherwise returns the last value." (setq result (if (or (string= result "#<void>") (string= result "#<unspecified>")) nil - (read result))))) + result)))) result)) (defun org-babel-execute:scheme (body params) @@ -184,23 +185,23 @@ This function is called by `org-babel-execute-src-block'" (buffer-name source-buffer)))) (save-excursion (org-babel-reassemble-table - (let* ((result-type (cdr (assoc :result-type params))) - (impl (or (when (cdr (assoc :scheme params)) - (intern (cdr (assoc :scheme params)))) + (let* ((result-type (cdr (assq :result-type params))) + (impl (or (when (cdr (assq :scheme params)) + (intern (cdr (assq :scheme params)))) geiser-default-implementation (car geiser-active-implementations))) (session (org-babel-scheme-make-session-name - source-buffer-name (cdr (assoc :session params)) impl)) + source-buffer-name (cdr (assq :session params)) impl)) (full-body (org-babel-expand-body:scheme body params))) (org-babel-scheme-execute-with-geiser full-body ; code (string= result-type "output") ; output? impl ; implementation (and (not (string= session "none")) session))) ; session - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params))))))) + (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))))))) (provide 'ob-scheme) diff --git a/lisp/ob-screen.el b/lisp/ob-screen.el index db89733..c4c9528 100644 --- a/lisp/ob-screen.el +++ b/lisp/ob-screen.el @@ -1,4 +1,4 @@ -;;; ob-screen.el --- org-babel support for interactive terminal +;;; ob-screen.el --- Babel Support for Interactive Terminal -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -48,18 +48,17 @@ In case you want to use a different screen than one selected by your $PATH") \"default\" session is used when none is specified." (message "Sending source code block to interactive terminal session...") (save-window-excursion - (let* ((session (cdr (assoc :session params))) + (let* ((session (cdr (assq :session params))) (socket (org-babel-screen-session-socketname session))) (unless socket (org-babel-prep-session:screen session params)) (org-babel-screen-session-execute-string session (org-babel-expand-body:generic body params))))) -(defun org-babel-prep-session:screen (session params) +(defun org-babel-prep-session:screen (_session params) "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((session (cdr (assoc :session params))) - (socket (org-babel-screen-session-socketname session)) - (cmd (cdr (assoc :cmd params))) - (terminal (cdr (assoc :terminal params))) + (let* ((session (cdr (assq :session params))) + (cmd (cdr (assq :cmd params))) + (terminal (cdr (assq :terminal params))) (process-name (concat "org-babel: terminal (" session ")"))) (apply 'start-process process-name "*Messages*" terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location @@ -104,7 +103,7 @@ In case you want to use a different screen than one selected by your $PATH") sockets))))) (when match-socket (car (split-string match-socket))))) -(defun org-babel-screen-session-write-temp-file (session body) +(defun org-babel-screen-session-write-temp-file (_session body) "Save BODY in a temp file that is named after SESSION." (let ((tmpfile (org-babel-temp-file "screen-"))) (with-temp-file tmpfile @@ -119,11 +118,10 @@ In case you want to use a different screen than one selected by your $PATH") "Test if the default setup works. The terminal should shortly flicker." (interactive) - (let* ((session "org-babel-testing") - (random-string (format "%s" (random 99999))) + (let* ((random-string (format "%s" (random 99999))) (tmpfile (org-babel-temp-file "ob-screen-test-")) (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) - process tmp-string) + tmp-string) (org-babel-execute:screen body org-babel-default-header-args:screen) ;; XXX: need to find a better way to do the following (while (not (file-readable-p tmpfile)) diff --git a/lisp/ob-sed.el b/lisp/ob-sed.el index f68bb14..dd8a17b 100644 --- a/lisp/ob-sed.el +++ b/lisp/ob-sed.el @@ -1,4 +1,4 @@ -;;; ob-sed.el --- org-babel functions for sed scripts +;;; ob-sed.el --- Babel Functions for Sed Scripts -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2016 Free Software Foundation, Inc. diff --git a/lisp/ob-shell.el b/lisp/ob-shell.el index 527e6f5..74b6c7e 100644 --- a/lisp/ob-shell.el +++ b/lisp/ob-shell.el @@ -1,4 +1,4 @@ -;;; ob-shell.el --- org-babel functions for shell evaluation +;;; ob-shell.el --- Babel Functions for Shell Evaluation -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -28,49 +28,60 @@ ;;; Code: (require 'ob) (require 'shell) -(eval-when-compile (require 'cl)) +(require 'cl-lib) -(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) +(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body) + t) (declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) (declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) -(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)) +(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body) + t) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function orgtbl-to-generic "org-table" (table params)) (defvar org-babel-default-header-args:shell '()) +(defvar org-babel-shell-names) + +(defun org-babel-shell-initialize () + "Define execution functions associated to shell names. +This function has to be called whenever `org-babel-shell-names' +is modified outside the Customize interface." + (interactive) + (dolist (name org-babel-shell-names) + (eval `(defun ,(intern (concat "org-babel-execute:" name)) + (body params) + ,(format "Execute a block of %s commands with Babel." name) + (let ((shell-file-name ,name)) + (org-babel-execute:shell body params)))))) (defcustom org-babel-shell-names '("sh" "bash" "csh" "ash" "dash" "ksh" "mksh" "posh") - "List of names of shell supported by babel shell code blocks." + "List of names of shell supported by babel shell code blocks. +Call `org-babel-shell-initialize' when modifying this variable +outside the Customize interface." :group 'org-babel - :type 'string - :initialize - (lambda (symbol value) - (set-default symbol (second value)) - (mapc - (lambda (name) - (eval `(defun ,(intern (concat "org-babel-execute:" name)) (body params) - ,(format "Execute a block of %s commands with Babel." name) - (let ((shell-file-name ,name)) - (org-babel-execute:shell body params))))) - (second value)))) + :type '(repeat (string :tag "Shell name: ")) + :set (lambda (symbol value) + (set-default symbol value) + (org-babel-shell-initialize))) (defun org-babel-execute:shell (body params) "Execute a block of Shell commands with Babel. This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-sh-initiate-session - (cdr (assoc :session params)))) - (stdin (let ((stdin (cdr (assoc :stdin params)))) + (cdr (assq :session params)))) + (stdin (let ((stdin (cdr (assq :stdin params)))) (when stdin (org-babel-sh-var-to-string (org-babel-ref-resolve stdin))))) - (cmdline (cdr (assoc :cmdline params))) + (cmdline (cdr (assq :cmdline params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:shell params)))) (org-babel-reassemble-table (org-babel-sh-evaluate session full-body params stdin cmdline) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (defun org-babel-prep-session:shell (session params) "Prepare SESSION according to the header arguments specified in PARAMS." @@ -131,18 +142,18 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-variable-assignments:shell (params) "Return list of shell statements assigning the block's variables." - (let ((sep (cdr (assoc :separator params))) - (hline (when (string= "yes" (cdr (assoc :hlines params))) - (or (cdr (assoc :hline-string params)) + (let ((sep (cdr (assq :separator params))) + (hline (when (string= "yes" (cdr (assq :hlines params))) + (or (cdr (assq :hline-string params)) "hline")))) (mapcar (lambda (pair) - (if (string-match "bash$" shell-file-name) + (if (string-suffix-p "bash" shell-file-name) (org-babel-variable-assignments:bash (car pair) (cdr pair) sep hline) (org-babel-variable-assignments:sh-generic (car pair) (cdr pair) sep hline))) - (mapcar #'cdr (org-babel-get-header params :var))))) + (org-babel--get-vars params)))) (defun org-babel-sh-var-to-sh (var &optional sep hline) "Convert an elisp value to a shell variable. @@ -157,14 +168,14 @@ var of the same value." "Convert an elisp value to a string." (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) (cond - ((and (listp var) (or (listp (car var)) (equal (car var) 'hline))) + ((and (listp var) (or (listp (car var)) (eq (car var) 'hline))) (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var :hline hline))) ((listp var) (mapconcat echo-var var "\n")) (t (funcall echo-var var))))) -(defun org-babel-sh-initiate-session (&optional session params) +(defun org-babel-sh-initiate-session (&optional session _params) "Initiate a session named SESSION according to PARAMS." (when (and session (not (string= session "none"))) (save-window-excursion @@ -192,8 +203,8 @@ return the value of the last statement in BODY." ((or stdin cmdline) ; external shell script w/STDIN (let ((script-file (org-babel-temp-file "sh-script-")) (stdin-file (org-babel-temp-file "sh-stdin-")) - (shebang (cdr (assoc :shebang params))) - (padline (not (string= "no" (cdr (assoc :padline params)))))) + (shebang (cdr (assq :shebang params))) + (padline (not (string= "no" (cdr (assq :padline params)))))) (with-temp-file script-file (when shebang (insert (concat shebang "\n"))) (when padline (insert "\n")) @@ -212,7 +223,7 @@ return the value of the last statement in BODY." (mapconcat #'org-babel-sh-strip-weird-long-prompt (mapcar - #'org-babel-trim + #'org-trim (butlast (org-babel-comint-with-output (session org-babel-sh-eoe-output t body) @@ -227,24 +238,24 @@ return the value of the last statement in BODY." (accept-process-output (get-buffer-process (current-buffer))))) (append - (split-string (org-babel-trim body) "\n") + (split-string (org-trim body) "\n") (list org-babel-sh-eoe-indicator)))) 2)) "\n")) ('otherwise ; external shell script - (if (and (cdr (assoc :shebang params)) - (> (length (cdr (assoc :shebang params))) 0)) + (if (and (cdr (assq :shebang params)) + (> (length (cdr (assq :shebang params))) 0)) (let ((script-file (org-babel-temp-file "sh-script-")) - (shebang (cdr (assoc :shebang params))) - (padline (not (equal "no" (cdr (assoc :padline params)))))) + (shebang (cdr (assq :shebang params))) + (padline (not (equal "no" (cdr (assq :padline params)))))) (with-temp-file script-file (when shebang (insert (concat shebang "\n"))) (when padline (insert "\n")) (insert body)) (set-file-modes script-file #o755) (org-babel-eval script-file "")) - (org-babel-eval shell-file-name (org-babel-trim body))))))) + (org-babel-eval shell-file-name (org-trim body))))))) (when results - (let ((result-params (cdr (assoc :result-params params)))) + (let ((result-params (cdr (assq :result-params params)))) (org-babel-result-cond result-params results (let ((tmp-file (org-babel-temp-file "sh-"))) diff --git a/lisp/ob-shen.el b/lisp/ob-shen.el index 413fe0d..f502d43 100644 --- a/lisp/ob-shen.el +++ b/lisp/ob-shen.el @@ -1,4 +1,4 @@ -;;; ob-shen.el --- org-babel functions for Shen +;;; ob-shen.el --- Babel Functions for Shen -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -43,7 +43,7 @@ (defun org-babel-expand-body:shen (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (if (> (length vars) 0) (concat "(let " (mapconcat (lambda (var) @@ -63,14 +63,13 @@ "Execute a block of Shen code with org-babel. This function is called by `org-babel-execute-src-block'" (require 'inf-shen) - (let* ((result-type (cdr (assoc :result-type params))) - (result-params (cdr (assoc :result-params params))) + (let* ((result-params (cdr (assq :result-params params))) (full-body (org-babel-expand-body:shen body params))) (let ((results (with-temp-buffer (insert full-body) (call-interactively #'shen-eval-defun)))) - (org-babel-result-cond result-params + (org-babel-result-cond result-params results (condition-case nil (org-babel-script-escape results) (error results)))))) diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index f096572..ec94c35 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -1,4 +1,4 @@ -;;; ob-sql.el --- org-babel functions for sql evaluation +;;; ob-sql.el --- Babel Functions for SQL -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -57,11 +57,11 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (declare-function org-table-import "org-table" (file arg)) (declare-function orgtbl-to-csv "org-table" (table params)) (declare-function org-table-to-lisp "org-table" (&optional txt)) +(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p)) (defvar org-babel-default-header-args:sql '()) @@ -78,7 +78,7 @@ (defun org-babel-expand-body:sql (body params) "Expand BODY according to the values of PARAMS." (org-babel-sql-expand-vars - body (mapcar #'cdr (org-babel-get-header params :var)))) + body (org-babel--get-vars params))) (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." @@ -90,100 +90,155 @@ (when password (concat "-p" password)) (when database (concat "-D" database)))))) -(defun org-babel-sql-dbstring-postgresql (host user database) +(defun org-babel-sql-dbstring-postgresql (host port user database) "Make PostgreSQL command line args for database connection. Pass nil to omit that arg." (combine-and-quote-strings (delq nil (list (when host (concat "-h" host)) + (when port (format "-p%d" port)) (when user (concat "-U" user)) (when database (concat "-d" database)))))) +(defun org-babel-sql-dbstring-oracle (host port user password database) + "Make Oracle command line args for database connection." + (format "%s/%s@%s:%s/%s" user password host port database)) + +(defun org-babel-sql-dbstring-mssql (host user password database) + "Make sqlcmd commmand line args for database connection. +`sqlcmd' is the preferred command line tool to access Microsoft +SQL Server on Windows and Linux platform." + (mapconcat #'identity + (delq nil + (list (when host (format "-S \"%s\"" host)) + (when user (format "-U \"%s\"" user)) + (when password (format "-P \"%s\"" password)) + (when database (format "-d \"%s\"" database)))) + " ")) + +(defun org-babel-sql-convert-standard-filename (file) + "Convert the file name to OS standard. +If in Cygwin environment, uses Cygwin specific function to +convert the file name. Otherwise, uses Emacs' standard conversion +function." + (format "\"%s\"" + (if (fboundp 'cygwin-convert-file-name-to-windows) + (cygwin-convert-file-name-to-windows file) + (convert-standard-filename file)))) + (defun org-babel-execute:sql (body params) "Execute a block of Sql code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (cdr (assoc :result-params params))) - (cmdline (cdr (assoc :cmdline params))) - (dbhost (cdr (assoc :dbhost params))) + (let* ((result-params (cdr (assq :result-params params))) + (cmdline (cdr (assq :cmdline params))) + (dbhost (cdr (assq :dbhost params))) (dbport (cdr (assq :dbport params))) - (dbuser (cdr (assoc :dbuser params))) - (dbpassword (cdr (assoc :dbpassword params))) - (database (cdr (assoc :database params))) - (engine (cdr (assoc :engine params))) - (colnames-p (not (equal "no" (cdr (assoc :colnames params))))) + (dbuser (cdr (assq :dbuser params))) + (dbpassword (cdr (assq :dbpassword params))) + (database (cdr (assq :database params))) + (engine (cdr (assq :engine params))) + (colnames-p (not (equal "no" (cdr (assq :colnames params))))) (in-file (org-babel-temp-file "sql-in-")) - (out-file (or (cdr (assoc :out-file params)) + (out-file (or (cdr (assq :out-file params)) (org-babel-temp-file "sql-out-"))) (header-delim "") - (command (case (intern engine) - ('dbi (format "dbish --batch %s < %s | sed '%s' > %s" + (command (pcase (intern engine) + (`dbi (format "dbish --batch %s < %s | sed '%s' > %s" (or cmdline "") (org-babel-process-file-name in-file) "/^+/d;s/^|//;s/(NULL)/ /g;$d" (org-babel-process-file-name out-file))) - ('monetdb (format "mclient -f tab %s < %s > %s" - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - ('msosql (format "osql %s -s \"\t\" -i %s -o %s" - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - ('mysql (format "mysql %s %s %s < %s > %s" + (`monetdb (format "mclient -f tab %s < %s > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + (`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 "") + (or cmdline "") (org-babel-process-file-name in-file) (org-babel-process-file-name out-file))) - ('postgresql (format - "psql --set=\"ON_ERROR_STOP=1\" %s -A -P footer=off -F \"\t\" %s -f %s -o %s %s" + (`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 dbuser database) + (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 ""))) - (t (error "No support for the %s SQL engine" engine))))) + (`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))) + (_ (error "No support for the %s SQL engine" engine))))) (with-temp-file in-file (insert - (case (intern engine) - ('dbi "/format partbox\n") - (t "")) + (pcase (intern engine) + (`dbi "/format partbox\n") + (`oracle "SET PAGESIZE 50000 +SET NEWPAGE 0 +SET TAB OFF +SET SPACE 0 +SET LINESIZE 9999 +SET ECHO OFF +SET FEEDBACK OFF +SET VERIFY OFF +SET HEADING ON +SET MARKUP HTML OFF SPOOL OFF +SET COLSEP '|' + +") + (`mssql "SET NOCOUNT ON + +") + (_ "")) (org-babel-expand-body:sql body params))) - (message command) (org-babel-eval command "") (org-babel-result-cond result-params (with-temp-buffer - (progn (insert-file-contents-literally out-file) (buffer-string))) + (progn (insert-file-contents-literally out-file) (buffer-string))) (with-temp-buffer (cond - ((or (eq (intern engine) 'mysql) - (eq (intern engine) 'dbi) - (eq (intern engine) 'postgresql)) - ;; Add header row delimiter after column-names header in first line - (cond - (colnames-p - (with-temp-buffer - (insert-file-contents out-file) - (goto-char (point-min)) - (forward-line 1) - (insert "-\n") - (setq header-delim "-") - (write-file out-file))))) - (t - ;; Need to figure out the delimiter for the header row - (with-temp-buffer - (insert-file-contents out-file) - (goto-char (point-min)) - (when (re-search-forward "^\\(-+\\)[^-]" nil t) - (setq header-delim (match-string-no-properties 1))) - (goto-char (point-max)) - (forward-char -1) - (while (looking-at "\n") - (delete-char 1) - (goto-char (point-max)) - (forward-char -1)) - (write-file out-file)))) + ((memq (intern engine) '(dbi mysql postgresql)) + ;; Add header row delimiter after column-names header in first line + (cond + (colnames-p + (with-temp-buffer + (insert-file-contents out-file) + (goto-char (point-min)) + (forward-line 1) + (insert "-\n") + (setq header-delim "-") + (write-file out-file))))) + (t + ;; Need to figure out the delimiter for the header row + (with-temp-buffer + (insert-file-contents out-file) + (goto-char (point-min)) + (when (re-search-forward "^\\(-+\\)[^-]" nil t) + (setq header-delim (match-string-no-properties 1))) + (goto-char (point-max)) + (forward-char -1) + (while (looking-at "\n") + (delete-char 1) + (goto-char (point-max)) + (forward-char -1)) + (write-file out-file)))) (org-table-import out-file '(16)) (org-babel-reassemble-table (mapcar (lambda (x) @@ -191,10 +246,10 @@ This function is called by `org-babel-execute-src-block'." 'hline x)) (org-table-to-lisp)) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))))) + (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-sql-expand-vars (body vars) "Expand the variables held in VARS in BODY." @@ -217,7 +272,7 @@ This function is called by `org-babel-execute-src-block'." vars) body) -(defun org-babel-prep-session:sql (session params) +(defun org-babel-prep-session:sql (_session _params) "Raise an error because Sql sessions aren't implemented." (error "SQL sessions not yet implemented")) diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el index 705d7ce..0d954a4 100644 --- a/lisp/ob-sqlite.el +++ b/lisp/ob-sqlite.el @@ -1,4 +1,4 @@ -;;; ob-sqlite.el --- org-babel functions for sqlite database interaction +;;; ob-sqlite.el --- Babel Functions for SQLite Databases -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -53,23 +53,22 @@ (defun org-babel-expand-body:sqlite (body params) "Expand BODY according to the values of PARAMS." (org-babel-sqlite-expand-vars - body (mapcar #'cdr (org-babel-get-header params :var)))) + body (org-babel--get-vars params))) (defvar org-babel-sqlite3-command "sqlite3") (defun org-babel-execute:sqlite (body params) "Execute a block of Sqlite code with Babel. This function is called by `org-babel-execute-src-block'." - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (db (cdr (assoc :db params))) - (separator (cdr (assoc :separator params))) - (nullvalue (cdr (assoc :nullvalue params))) - (headers-p (equal "yes" (cdr (assoc :colnames params)))) + (let ((result-params (split-string (or (cdr (assq :results params)) ""))) + (db (cdr (assq :db params))) + (separator (cdr (assq :separator params))) + (nullvalue (cdr (assq :nullvalue params))) + (headers-p (equal "yes" (cdr (assq :colnames params)))) (others (delq nil (mapcar - (lambda (arg) (car (assoc arg params))) + (lambda (arg) (car (assq arg params))) (list :header :echo :bail :column - :csv :html :line :list)))) - exit-code) + :csv :html :line :list))))) (unless db (error "ob-sqlite: can't evaluate without a database")) (with-temp-buffer (insert @@ -140,7 +139,7 @@ This function is called by `org-babel-execute-src-block'." (equal 1 (length (car result)))) (org-babel-read (caar result)) (mapcar (lambda (row) - (if (equal 'hline row) + (if (eq 'hline row) 'hline (mapcar #'org-babel-string-read row))) result))) @@ -150,7 +149,7 @@ This function is called by `org-babel-execute-src-block'." (cons (car table) (cons 'hline (cdr table))) table)) -(defun org-babel-prep-session:sqlite (session params) +(defun org-babel-prep-session:sqlite (_session _params) "Raise an error because support for SQLite sessions isn't implemented. Prepare SESSION according to the header arguments specified in PARAMS." (error "SQLite sessions not yet implemented")) diff --git a/lisp/ob-stan.el b/lisp/ob-stan.el index e69de29..bf4e394 100644 --- a/lisp/ob-stan.el +++ b/lisp/ob-stan.el @@ -0,0 +1,84 @@ +;;; ob-stan.el --- Babel Functions for Stan -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2016 Free Software Foundation, Inc. + +;; Author: Kyle Meyer +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating Stan [1] source code. +;; +;; Evaluating a Stan block can produce two different results. +;; +;; 1) Dump the source code contents to a file. +;; +;; This file can then be used as a variable in other blocks, which +;; allows interfaces like RStan to use the model. +;; +;; 2) Compile the contents to a model file. +;; +;; This provides access to the CmdStan interface. To use this, set +;; `org-babel-stan-cmdstan-directory' and provide a :file argument +;; that does not end in ".stan". +;; +;; For more information and usage examples, visit +;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html +;; +;; [1] http://mc-stan.org/ + +;;; Code: +(require 'ob) +(require 'org-compat) + +(defcustom org-babel-stan-cmdstan-directory nil + "CmdStan source directory. +'make' will be called from this directory to compile the Stan +block. When nil, executing Stan blocks dumps the content to a +plain text file." + :group 'org-babel + :type 'string) + +(defvar org-babel-default-header-args:stan + '((:results . "file"))) + +(defun org-babel-execute:stan (body params) + "Generate Stan file from BODY according to PARAMS. +A :file header argument must be given. If +`org-babel-stan-cmdstan-directory' is non-nil and the file name +does not have a \".stan\" extension, save an intermediate +\".stan\" file and compile the block to the named file. +Otherwise, write the Stan code directly to the named file." + (let ((file (expand-file-name + (or (cdr (assq :file params)) + (user-error "Set :file argument to execute Stan blocks"))))) + (if (or (not org-babel-stan-cmdstan-directory) + (string-match-p "\\.stan\\'" file)) + (with-temp-file file (insert body)) + (with-temp-file (concat file ".stan") (insert body)) + (let ((default-directory org-babel-stan-cmdstan-directory)) + (call-process-shell-command (concat "make " file)))) + nil)) ; Signal that output has been written to file. + +(defun org-babel-prep-session:stan (_session _params) + "Return an error because Stan does not support sessions." + (user-error "Stan does not support sessions")) + +(provide 'ob-stan) +;;; ob-stan.el ends here diff --git a/lisp/ob-table.el b/lisp/ob-table.el index 6e6d7ac..efee5b7 100644 --- a/lisp/ob-table.el +++ b/lisp/ob-table.el @@ -1,4 +1,4 @@ -;;; ob-table.el --- support for calling org-babel functions from tables +;;; ob-table.el --- Support for Calling Babel Functions from Tables -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -23,8 +23,8 @@ ;;; Commentary: -;; Should allow calling functions from org-mode tables using the -;; function `org-sbe' as so... +;; Should allow calling functions from Org tables using the function +;; `org-sbe' as so... ;; #+begin_src emacs-lisp :results silent ;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2))))) @@ -55,13 +55,15 @@ ;;; Code: (require 'ob-core) +(declare-function org-trim "org" (s &optional keep-lead)) + (defun org-babel-table-truncate-at-newline (string) "Replace newline character with ellipses. If STRING ends in a newline character, then remove the newline character and replace it with ellipses." (if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string)) (concat (substring string 0 (match-beginning 0)) - (if (match-string 1 string) "...")) string)) + (when (match-string 1 string) "...")) string)) (defmacro org-sbe (source-block &rest variables) "Return the results of calling SOURCE-BLOCK with VARIABLES. @@ -142,7 +144,7 @@ as shown in the example below. nil (list "emacs-lisp" "results" params) '((:results . "silent")))) ""))) - (org-babel-trim (if (stringp result) result (format "%S" result))))))) + (org-trim (if (stringp result) result (format "%S" result))))))) (provide 'ob-table) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index a42dd1d..5e1b953 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -1,4 +1,4 @@ -;;; ob-tangle.el --- extract source code from org-mode files +;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -26,12 +26,14 @@ ;; Extract the code from source blocks out into raw source-code files. ;;; Code: + +(require 'cl-lib) (require 'org-src) (declare-function make-directory "files" (dir &optional parents)) (declare-function org-at-heading-p "org" (&optional ignored)) -(declare-function org-babel-update-block-body "org" (new-body)) -(declare-function org-back-to-heading "org" (invisible-ok)) +(declare-function org-babel-update-block-body "ob-core" (new-body)) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-before-first-heading-p "org" ()) (declare-function org-edit-special "org" (&optional arg)) (declare-function org-element-at-point "org-element" ()) @@ -39,11 +41,14 @@ (declare-function org-fill-template "org" (template alist)) (declare-function org-heading-components "org" ()) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) -(declare-function org-link-escape "org" (text &optional table)) +(declare-function org-link-escape "org" (text &optional table merge)) (declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) +(declare-function org-remove-indentation "org" (code &optional n)) (declare-function org-store-link "org" (arg)) -(declare-function org-string-nw-p "org" (s)) +(declare-function org-string-nw-p "org-macs" (s)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function outline-previous-heading "outline" ()) +(declare-function org-id-find "org-id" (id &optional markerp)) (defvar org-link-types-re) @@ -63,7 +68,7 @@ then the name of the language is used." (string "File Extension")))) (defcustom org-babel-tangle-use-relative-file-links t - "Use relative path names in links from tangled source back the Org-mode file." + "Use relative path names in links from tangled source back the Org file." :group 'org-babel-tangle :type 'boolean) @@ -91,7 +96,7 @@ The following format strings can be used to insert special information into the output using `org-fill-template'. %start-line --- the line number at the start of the code block %file --------- the file from which the code block was tangled -%link --------- Org-mode style link to the code block +%link --------- Org style link to the code block %source-name -- name of the code block Upon insertion the formatted comment will be commented out, and @@ -111,7 +116,7 @@ The following format strings can be used to insert special information into the output using `org-fill-template'. %start-line --- the line number at the start of the code block %file --------- the file from which the code block was tangled -%link --------- Org-mode style link to the code block +%link --------- Org style link to the code block %source-name -- name of the code block Upon insertion the formatted comment will be commented out, and @@ -133,8 +138,8 @@ of tangled comments." :group 'org-babel :type 'boolean) -(defcustom org-babel-process-comment-text #'org-remove-indentation - "Function called to process raw Org-mode text collected to be +(defcustom org-babel-process-comment-text 'org-remove-indentation + "Function called to process raw Org text collected to be inserted as comments in tangled source-code files. The function should take a single string argument and return a string result. The default value is `org-remove-indentation'." @@ -223,7 +228,7 @@ used to limit the exported source code blocks by language." org-babel-default-header-args)) (tangle-file (when (equal arg '(16)) - (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light)))) + (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light)))) (user-error "Point is not in a source code block")))) path-collector) (mapc ;; map over all languages @@ -276,11 +281,11 @@ used to limit the exported source code blocks by language." ;; We avoid append-to-file as it does not work with tramp. (let ((content (buffer-string))) (with-temp-buffer - (if (file-exists-p file-name) - (insert-file-contents file-name)) + (when (file-exists-p file-name) + (insert-file-contents file-name)) (goto-char (point-max)) ;; Handle :padlines unless first line in file - (unless (or (string= "no" (cdr (assoc :padline (nth 4 spec)))) + (unless (or (string= "no" (cdr (assq :padline (nth 4 spec)))) (= (point) (point-min))) (insert "\n")) (insert content) @@ -290,10 +295,8 @@ used to limit the exported source code blocks by language." (unless tangle-mode (setq tangle-mode #o755))) ;; update counter (setq block-counter (+ 1 block-counter)) - (add-to-list 'path-collector - (cons file-name tangle-mode) - nil - (lambda (a b) (equal (car a) (car b)))))))) + (unless (assoc file-name path-collector) + (push (cons file-name tangle-mode) path-collector)))))) specs))) (if (equal arg '(4)) (org-babel-tangle-single-block 1 t) @@ -321,7 +324,7 @@ used to limit the exported source code blocks by language." Call this function inside of a source-code file generated by `org-babel-tangle' to remove all comments inserted automatically by `org-babel-tangle'. Warning, this comment removes any lines -containing constructs which resemble org-mode file links or noweb +containing constructs which resemble Org file links or noweb references." (interactive) (goto-char (point-min)) @@ -362,11 +365,10 @@ that the appropriate major-mode is set. SPEC has the form: (comments (cdr (assq :comments info))) (link-p (or (string= comments "both") (string= comments "link") (string= comments "yes") (string= comments "noweb"))) - (link-data (mapcar (lambda (el) - (cons (symbol-name el) - (let ((le (eval el))) - (if (stringp le) le (format "%S" le))))) - '(start-line file link source-name))) + (link-data `(("start-line" . ,(number-to-string start-line)) + ("file" . ,file) + ("link" . ,link) + ("source-name" . ,source-name))) (insert-comment (lambda (text) (when (and comments (not (string= comments "no")) @@ -390,10 +392,10 @@ that the appropriate major-mode is set. SPEC has the form: insert-comment (org-fill-template org-babel-tangle-comment-format-beg link-data))) (insert - (format - "%s\n" - (org-unescape-code-in-string - (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) + (org-unescape-code-in-string + (if org-src-preserve-indentation (org-trim body t) + (org-trim (org-remove-indentation body)))) + "\n") (when link-p (funcall insert-comment @@ -411,7 +413,7 @@ can be used to limit the collected code blocks by target file." (let ((current-heading-pos (org-with-wide-buffer (org-with-limited-levels (outline-previous-heading))))) - (if (eq last-heading-pos current-heading-pos) (incf counter) + (if (eq last-heading-pos current-heading-pos) (cl-incf counter) (setq counter 1) (setq last-heading-pos current-heading-pos))) (unless (org-in-commented-heading-p) @@ -453,11 +455,11 @@ list to be used by `org-babel-tangle' directly." (and (string-match org-bracket-link-regexp link) (match-string 1 link)))) (source-name - (intern (or (nth 4 info) - (format "%s:%d" - (or (ignore-errors (nth 4 (org-heading-components))) - "No heading") - block-counter)))) + (or (nth 4 info) + (format "%s:%d" + (or (ignore-errors (nth 4 (org-heading-components))) + "No heading") + block-counter))) (expand-cmd (intern (concat "org-babel-expand-body:" src-lang))) (assignments-cmd @@ -469,7 +471,7 @@ list to be used by `org-babel-tangle' directly." (org-babel-expand-noweb-references info) (nth 1 info))) (body - (if (assoc :no-expand params) + (if (assq :no-expand params) body (if (fboundp expand-cmd) (funcall expand-cmd body params) @@ -487,8 +489,8 @@ list to be used by `org-babel-tangle' directly." (run-hooks 'org-babel-tangle-body-hook) (buffer-string)))) (comment - (when (or (string= "both" (cdr (assoc :comments params))) - (string= "org" (cdr (assoc :comments params)))) + (when (or (string= "both" (cdr (assq :comments params))) + (string= "org" (cdr (assq :comments params)))) ;; From the previous heading or code-block end (funcall org-babel-process-comment-text @@ -510,26 +512,25 @@ list to be used by `org-babel-tangle' directly." (list (cons src-lang (list result))) result))) -(defun org-babel-tangle-comment-links ( &optional info) +(defun org-babel-tangle-comment-links (&optional info) "Return a list of begin and end link comments for the code block at point." - (let* ((start-line (org-babel-where-is-src-block-head)) - (file (buffer-file-name)) - (link (org-link-escape (progn (call-interactively 'org-store-link) - (org-no-properties - (car (pop org-stored-links)))))) - (source-name (nth 4 (or info (org-babel-get-src-block-info 'light)))) - (link-data (mapcar (lambda (el) - (cons (symbol-name el) - (let ((le (eval el))) - (if (stringp le) le (format "%S" le))))) - '(start-line file link source-name)))) + (let ((link-data + `(("start-line" . ,(number-to-string + (org-babel-where-is-src-block-head))) + ("file" . ,(buffer-file-name)) + ("link" . ,(org-link-escape + (progn + (call-interactively #'org-store-link) + (org-no-properties (car (pop org-stored-links)))))) + ("source-name" . + ,(nth 4 (or info (org-babel-get-src-block-info 'light))))))) (list (org-fill-template org-babel-tangle-comment-format-beg link-data) (org-fill-template org-babel-tangle-comment-format-end link-data)))) ;; de-tangling functions (defvar org-bracket-link-analytic-regexp) (defun org-babel-detangle (&optional source-code-file) - "Propagate changes in source file back original to Org-mode file. + "Propagate changes in source file back original to Org file. This requires that code blocks were tangled with link comments which enable the original code blocks to be found." (interactive) @@ -553,7 +554,7 @@ which enable the original code blocks to be found." "Jump from a tangled code file to the related Org mode file." (interactive) (let ((mid (point)) - start body-start end done + start body-start end target-buffer target-char link path block-name body) (save-window-excursion (save-excursion @@ -575,7 +576,7 @@ which enable the original code blocks to be found." (setq body (buffer-substring body-start end))) (when (string-match "::" path) (setq path (substring path 0 (match-beginning 0)))) - (find-file path) + (find-file (or (car (org-id-find path)) path)) (setq target-buffer (current-buffer)) ;; Go to the beginning of the relative block in Org file. (org-open-link-from-string link) @@ -598,7 +599,8 @@ which enable the original code blocks to be found." (forward-char (- mid body-start)) (setq target-char (point))) (org-src-switch-to-buffer target-buffer t) - (prog1 body (goto-char target-char)))) + (goto-char target-char) + body)) (provide 'ob-tangle) @@ -1,4 +1,4 @@ -;;; ob.el --- working with code blocks in org-mode +;;; ob.el --- Working with Code Blocks in Org -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 19a4095..7ee721a 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -24,7 +24,7 @@ ;; ;;; Commentary: -;; This file contains the code for creating and using the Agenda for Org-mode. +;; This file contains the code for creating and using the Agenda for Org. ;; ;; The functions `org-batch-agenda', `org-batch-agenda-csv', and ;; `org-batch-store-agenda-views' are implemented as macros to provide @@ -45,10 +45,9 @@ ;;; Code: +(require 'cl-lib) (require 'org) (require 'org-macs) -(eval-when-compile - (require 'cl)) (declare-function diary-add-to-list "diary-lib" (date string specifier &optional marker globcolor literal)) @@ -80,16 +79,15 @@ (declare-function org-is-habit-p "org-habit" (&optional pom)) (declare-function org-habit-parse-todo "org-habit" (&optional pom)) (declare-function org-habit-get-priority "org-habit" (habit &optional moment)) -(declare-function org-pop-to-buffer-same-window "org-compat" - (&optional buffer-or-name norecord label)) (declare-function org-agenda-columns "org-colview" ()) (declare-function org-add-archive-files "org-archive" (files)) (declare-function org-capture "org-capture" (&optional goto keys)) -(defvar calendar-mode-map) ; defined in calendar.el -(defvar org-clock-current-task nil) ; defined in org-clock.el -(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el -(defvar org-habit-show-habits) ; defined in org-habit.el +(defvar calendar-mode-map) +(defvar org-clock-current-task) +(defvar org-current-tag-alist) +(defvar org-mobile-force-id-on-agenda-items) +(defvar org-habit-show-habits) (defvar org-habit-show-habits-only-for-today) (defvar org-habit-show-all-today) @@ -97,8 +95,8 @@ (defvar org-agenda-buffer-name "*Org Agenda*") (defvar org-agenda-overriding-header nil) (defvar org-agenda-title-append nil) -(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el +(with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el +(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el (defvar original-date) ; dynamically scoped, calendar.el does scope this (defvar org-agenda-undo-list nil @@ -136,7 +134,7 @@ addresses the separator between the current and the previous block." (string))) (defgroup org-agenda-export nil - "Options concerning exporting agenda views in Org-mode." + "Options concerning exporting agenda views in Org mode." :tag "Org Agenda Export" :group 'org-agenda) @@ -238,7 +236,7 @@ you can \"misuse\" it to also add other text to the header." :type 'boolean) (defgroup org-agenda-custom-commands nil - "Options concerning agenda views in Org-mode." + "Options concerning agenda views in Org mode." :tag "Org Agenda Custom Commands" :group 'org-agenda) @@ -262,8 +260,8 @@ you can \"misuse\" it to also add other text to the header." ;; Keep custom values for `org-agenda-filter-preset' compatible with ;; the new variable `org-agenda-tag-filter-preset'. -(org-defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) -(org-defvaralias 'org-agenda-filter 'org-agenda-tag-filter) +(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) +(defvaralias 'org-agenda-filter 'org-agenda-tag-filter) (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) "List of types searched for when creating the daily/weekly agenda. @@ -442,8 +440,9 @@ This will be spliced into the custom type of (defcustom org-agenda-custom-commands '(("n" "Agenda and all TODOs" ((agenda "") (alltodo "")))) "Custom commands for the agenda. +\\<org-mode-map> These commands will be offered on the splash screen displayed by the -agenda dispatcher \\[org-agenda]. Each entry is a list like this: +agenda dispatcher `\\[org-agenda]'. Each entry is a list like this: (key desc type match settings files) @@ -608,14 +607,17 @@ subtree to see if any of the subtasks have project status. See also the variable `org-tags-match-list-sublevels' which applies to projects matched by this search as well. -After defining this variable, you may use \\[org-agenda-list-stuck-projects] -or `C-c a #' to produce the list." +After defining this variable, you may use `\\[org-agenda-list-stuck-projects]' +\(bound to `C-c a #') to produce the list." :group 'org-agenda-custom-commands :type '(list (string :tag "Tags/TODO match to identify a project") - (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) - (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) - (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree"))) + (repeat :tag "Projects are *not* stuck if they have an entry with \ +TODO keyword any of" (string)) + (repeat :tag "Projects are *not* stuck if they have an entry with \ +TAG being any of" (string)) + (regexp :tag "Projects are *not* stuck if this regexp matches inside \ +the subtree"))) (defgroup org-agenda-skip nil "Options concerning skipping parts of agenda files." @@ -999,8 +1001,6 @@ you want to use two-columns display (see `org-agenda-menu-two-columns')." :version "24.1" :type 'boolean) -(define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3") - (defcustom org-agenda-menu-two-columns nil "Non-nil means, use two columns to show custom commands in the dispatcher. If you use this, you probably want to set `org-agenda-menu-show-matcher' @@ -1009,7 +1009,6 @@ to nil." :version "24.1" :type 'boolean) -(define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3") (defcustom org-agenda-finalize-hook nil "Hook run just before displaying an agenda buffer. The buffer is still writable when the hook is called. @@ -1022,8 +1021,8 @@ headlines as the agenda display heavily relies on them." (defcustom org-agenda-mouse-1-follows-link nil "Non-nil means mouse-1 on a link will follow the link in the agenda. -A longer mouse click will still set point. Does not work on XEmacs. -Needs to be set before org.el is loaded." +A longer mouse click will still set point. Needs to be set +before org.el is loaded." :group 'org-agenda-startup :type 'boolean) @@ -1052,9 +1051,9 @@ current item's tree, in an indirect buffer." (defcustom org-agenda-entry-text-maxlines 5 "Number of text lines to be added when `E' is pressed in the agenda. -Note that this variable only used during agenda display. Add add entry text +Note that this variable only used during agenda display. To add entry text when exporting the agenda, configure the variable -`org-agenda-add-entry-ext-maxlines'." +`org-agenda-add-entry-text-maxlines'." :group 'org-agenda :type 'integer) @@ -1126,16 +1125,6 @@ option will be ignored." :group 'org-agenda-windows :type 'boolean) -(defcustom org-agenda-ndays nil - "Number of days to include in overview display. -Should be 1 or 7. -Obsolete, see `org-agenda-span'." - :group 'org-agenda-daily/weekly - :type '(choice (const nil) - (integer))) - -(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1") - (defcustom org-agenda-span 'week "Number of days to include in overview display. Can be day, week, month, year, or any number of days. @@ -1284,9 +1273,9 @@ shown, either today or the nearest into the future." (defcustom org-scheduled-past-days 10000 "Number of days to continue listing scheduled items not marked DONE. -When an item is scheduled on a date, it shows up in the agenda on this -day and will be listed until it is marked done for the number of days -given here." +When an item is scheduled on a date, it shows up in the agenda on +this day and will be listed until it is marked done or for the +number of days given here." :group 'org-agenda-daily/weekly :type 'integer) @@ -1415,7 +1404,7 @@ boolean search." :version "24.1" :type 'boolean) -(org-defvaralias 'org-agenda-search-view-search-words-only +(defvaralias 'org-agenda-search-view-search-words-only 'org-agenda-search-view-always-boolean) (defcustom org-agenda-search-view-force-full-words nil @@ -1436,7 +1425,7 @@ value, don't limit agenda view by outline level." :type 'integer) (defgroup org-agenda-time-grid nil - "Options concerning the time grid in the Org-mode Agenda." + "Options concerning the time grid in the Org Agenda." :tag "Org Agenda Time Grid" :group 'org-agenda) @@ -1508,7 +1497,7 @@ a grid line." :type 'string) (defgroup org-agenda-sorting nil - "Options concerning sorting in the Org-mode Agenda." + "Options concerning sorting in the Org Agenda." :tag "Org Agenda Sorting" :group 'org-agenda) @@ -1614,7 +1603,7 @@ When nil, such items are sorted as 0 minutes effort." :type 'boolean) (defgroup org-agenda-line-format nil - "Options concerning the entry prefix in the Org-mode agenda display." + "Options concerning the entry prefix in the Org agenda display." :tag "Org Agenda Line Format" :group 'org-agenda) @@ -1860,10 +1849,10 @@ When this is the symbol `prefix', only remove tags when (const :tag "Never" nil) (const :tag "When prefix format contains %T" prefix))) -(org-defvaralias 'org-agenda-remove-tags-when-in-prefix +(defvaralias 'org-agenda-remove-tags-when-in-prefix 'org-agenda-remove-tags) -(defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80) +(defcustom org-agenda-tags-column -80 "Shift tags in agenda items to this column. If this number is positive, it specifies the column. If it is negative, it means that the tags should be flushright to that column. For example, @@ -1871,7 +1860,7 @@ it means that the tags should be flushright to that column. For example, :group 'org-agenda-line-format :type 'integer) -(org-defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) +(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) (defcustom org-agenda-fontify-priorities 'cookies "Non-nil means highlight low and high priorities in agenda. @@ -1950,6 +1939,14 @@ category, you can use: :tag "Org Agenda Column View" :group 'org-agenda) +(defcustom org-agenda-view-columns-initially nil + "When non-nil, switch to columns view right after creating the agenda." + :group 'org-agenda-column-view + :type 'boolean + :version "25.2" + :package-version '(Org . "9.0") + :safe #'booleanp) + (defcustom org-agenda-columns-show-summaries t "Non-nil means show summaries for columns displayed in the agenda view." :group 'org-agenda-column-view @@ -1999,7 +1996,7 @@ For example, this value makes those two functions available: With selected entries in an agenda buffer, `B R' will call the custom function `set-category' on the selected entries. Note that functions in this alist don't need to be quoted." - :type 'alist + :type '(alist :key-type character :value-type (group function)) :version "24.1" :group 'org-agenda) @@ -2030,7 +2027,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvar org-agenda-mode-map (make-sparse-keymap) "Keymap for `org-agenda-mode'.") -(org-defvaralias 'org-agenda-keymap 'org-agenda-mode-map) +(defvaralias 'org-agenda-keymap 'org-agenda-mode-map) (defvar org-agenda-menu) ; defined later in this file. (defvar org-agenda-restrict nil) ; defined later in this file. @@ -2047,6 +2044,8 @@ The buffer is still writable when this hook is called.") (defvar org-agenda-force-single-file nil) (defvar org-agenda-bulk-marked-entries nil "List of markers that refer to marked entries in the agenda.") +(defvar org-agenda-current-date nil + "Active date when building the agenda.") ;;; Multiple agenda buffers support @@ -2067,12 +2066,12 @@ When nil, `q' will kill the single agenda buffer." (> (prefix-numeric-value arg) 0) (not org-agenda-sticky)))) (if (equal new-value org-agenda-sticky) - (and (org-called-interactively-p 'interactive) + (and (called-interactively-p 'interactive) (message "Sticky agenda was already %s" (if org-agenda-sticky "enabled" "disabled"))) (setq org-agenda-sticky new-value) (org-agenda-kill-all-agenda-buffers) - (and (org-called-interactively-p 'interactive) + (and (called-interactively-p 'interactive) (message "Sticky agenda %s" (if org-agenda-sticky "enabled" "disabled")))))) @@ -2117,7 +2116,7 @@ When nil, `q' will kill the single agenda buffer." "Variables that must be local in agenda buffers to allow multiple buffers.") (defun org-agenda-mode () - "Mode for time-sorted view on action items in Org-mode files. + "Mode for time-sorted view on action items in Org files. The following commands are available: @@ -2137,32 +2136,32 @@ The following commands are available: (when (and val (member var org-agenda-local-vars)) (set var val))))) - (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) + (setq-local org-agenda-this-buffer-is-sticky t)) (org-agenda-sticky ;; Creating a sticky Agenda buffer for the first time (kill-all-local-variables) (mapc 'make-local-variable org-agenda-local-vars) - (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) + (setq-local org-agenda-this-buffer-is-sticky t)) (t ;; Creating a non-sticky agenda buffer (kill-all-local-variables) - (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil))) + (setq-local org-agenda-this-buffer-is-sticky nil))) (setq org-agenda-undo-list nil org-agenda-pending-undo-list nil org-agenda-bulk-marked-entries nil) (setq major-mode 'org-agenda-mode) ;; Keep global-font-lock-mode from turning on font-lock-mode - (org-set-local 'font-lock-global-modes (list 'not major-mode)) + (setq-local font-lock-global-modes (list 'not major-mode)) (setq mode-name "Org-Agenda") (setq indent-tabs-mode nil) (use-local-map org-agenda-mode-map) (easy-menu-add org-agenda-menu) (if org-startup-truncated (setq truncate-lines t)) - (org-set-local 'line-move-visual nil) - (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) - (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) + (setq-local line-move-visual nil) + (add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) + (add-hook 'pre-command-hook 'org-unhighlight nil 'local) ;; Make sure properties are removed when copying text - (org-add-hook 'filter-buffer-substring-functions + (add-hook 'filter-buffer-substring-functions (lambda (fun start end delete) (substring-no-properties (funcall fun start end delete))) nil t) @@ -2319,7 +2318,6 @@ The following commands are available: (org-defkey org-agenda-mode-map "_" 'org-agenda-filter-by-effort) (org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp) (org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all) -(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) (org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively) (org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category) (org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline) @@ -2399,7 +2397,7 @@ The following commands are available: ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) ["Write view to file" org-agenda-write t] ["Rebuild buffer" org-agenda-redo t] - ["Save all Org-mode Buffers" org-save-all-org-buffers t] + ["Save all Org buffers" org-save-all-org-buffers t] "--" ["Show original entry" org-agenda-show t] ["Go To (other window)" org-agenda-goto t] @@ -2668,6 +2666,7 @@ to limit entries to in this type." (const timeline)) (integer :tag "Max number of minutes"))))) +(defvar org-agenda-keep-restricted-file-list nil) (defvar org-keys nil) (defvar org-match nil) ;;;###autoload @@ -2700,9 +2699,9 @@ More commands can be added by configuring the variable `org-agenda-custom-commands'. In particular, specific tags and TODO keyword searches can be pre-defined in this way. -If the current buffer is in Org-mode and visiting a file, you can also +If the current buffer is in Org mode and visiting a file, you can also first press `<' once to indicate that the agenda should be temporarily -\(until the next use of \\[org-agenda]) restricted to the current file. +\(until the next use of `\\[org-agenda]') restricted to the current file. Pressing `<' twice means to restrict to the current subtree or region \(if active)." (interactive "P") @@ -2734,7 +2733,7 @@ Pressing `<' twice means to restrict to the current subtree or region entry key type org-match lprops ans) ;; Turn off restriction unless there is an overriding one, (unless org-agenda-overriding-restriction - (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list) + (unless org-agenda-keep-restricted-file-list ;; There is a request to keep the file list in place (put 'org-agenda-files 'org-restrict nil)) (setq org-agenda-restrict nil) @@ -2831,7 +2830,7 @@ Pressing `<' twice means to restrict to the current subtree or region ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) ((equal org-keys "e") (call-interactively 'org-store-agenda-views)) ((equal org-keys "?") (org-tags-view nil "+FLAGGED") - (org-add-hook + (add-hook 'post-command-hook (lambda () (unless (current-message) @@ -2848,7 +2847,7 @@ Pressing `<' twice means to restrict to the current subtree or region t t)) ((equal org-keys "L") (unless (derived-mode-p 'org-mode) - (user-error "This is not an Org-mode file")) + (user-error "This is not an Org file")) (unless restriction (put 'org-agenda-files 'org-restrict (list bfn)) (org-call-with-arg 'org-timeline arg))) @@ -3046,7 +3045,7 @@ L Timeline for current buffer # List stuck projects (!=configure) (call-interactively 'org-toggle-sticky-agenda) (sit-for 2)) ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) - (message "Restriction is only possible in Org-mode buffers") + (message "Restriction is only possible in Org buffers") (ding) (sit-for 1)) ((eq c ?1) (org-agenda-remove-restriction-lock 'noupdate) @@ -3104,9 +3103,9 @@ L Timeline for current buffer # List stuck projects (!=configure) match ;; The byte compiler incorrectly complains about this. Keep it! org-cmd type lprops) (while (setq org-cmd (pop cmds)) - (setq type (car org-cmd) - match (eval (nth 1 org-cmd)) - lprops (nth 2 org-cmd)) + (setq type (car org-cmd)) + (setq match (eval (nth 1 org-cmd))) + (setq lprops (nth 2 org-cmd)) (let ((org-agenda-overriding-arguments (if (eq org-agenda-overriding-cmd org-cmd) (or org-agenda-overriding-arguments @@ -3159,7 +3158,7 @@ Parameters are alternating variable names and values that will be bound before running the agenda command." (org-eval-in-environment (org-make-parameter-alist parameters) (let (org-agenda-sticky) - (if (> (length cmd-key) 2) + (if (> (length cmd-key) 1) (org-tags-view nil cmd-key) (org-agenda nil cmd-key)))) (set-buffer org-agenda-buffer-name) @@ -3260,9 +3259,7 @@ This ensures the export commands can easily use it." ((not res) "") ((stringp res) res) (t (prin1-to-string res)))) - (while (string-match "," res) - (setq res (replace-match ";" t t res))) - (org-trim res))) + (org-trim (replace-regexp-in-string "," ";" res nil t)))) ;;;###autoload (defun org-store-agenda-views (&rest parameters) @@ -3338,13 +3335,15 @@ the agenda to write." (interactive "FWrite agenda to file: \nP") (if (or (not (file-writable-p file)) (and (file-exists-p file) - (if (org-called-interactively-p 'any) + (if (called-interactively-p 'any) (not (y-or-n-p (format "Overwrite existing file %s? " file)))))) (user-error "Cannot write agenda to file %s" file)) (org-let (if nosettings nil org-agenda-exporter-settings) '(save-excursion (save-window-excursion - (let ((bs (copy-sequence (buffer-string))) beg content) + (let ((bs (copy-sequence (buffer-string))) + (extension (file-name-extension file)) + beg content) (with-temp-buffer (rename-buffer org-agenda-write-buffer-name t) (set-buffer-modified-p nil) @@ -3352,9 +3351,9 @@ the agenda to write." (org-agenda-remove-marked-text 'invisible 'org-filtered) (run-hooks 'org-agenda-before-write-hook) (cond - ((org-bound-and-true-p org-mobile-creating-agendas) + ((bound-and-true-p org-mobile-creating-agendas) (org-mobile-write-agenda-for-mobile file)) - ((string-match "\\.org\\'" file) + ((string= "org" extension) (let (content p m message-log-max) (goto-char (point-min)) (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) @@ -3373,7 +3372,7 @@ the agenda to write." (write-file file) (kill-buffer (current-buffer)) (message "Org file written to %s" file))) - ((string-match "\\.html?\\'" file) + ((member extension '("html" "htm")) (require 'htmlize) (set-buffer (htmlize-buffer (current-buffer))) (when org-agenda-export-html-style @@ -3385,11 +3384,11 @@ the agenda to write." (write-file file) (kill-buffer (current-buffer)) (message "HTML written to %s" file)) - ((string-match "\\.ps\\'" file) + ((string= "ps" extension) (require 'ps-print) (ps-print-buffer-with-faces file) (message "Postscript written to %s" file)) - ((string-match "\\.pdf\\'" file) + ((string= "pdf" extension) (require 'ps-print) (ps-print-buffer-with-faces (concat (file-name-sans-extension file) ".ps")) @@ -3399,7 +3398,7 @@ the agenda to write." (expand-file-name file)) (delete-file (concat (file-name-sans-extension file) ".ps")) (message "PDF written to %s" file)) - ((string-match "\\.ics\\'" file) + ((string= "ics" extension) (require 'ox-icalendar) (org-icalendar-export-current-agenda (expand-file-name file))) (t @@ -3411,7 +3410,7 @@ the agenda to write." (kill-buffer (current-buffer)) (message "Plain text written to %s" file)))))))) (set-buffer (or agenda-bufname - (and (org-called-interactively-p 'any) (buffer-name)) + (and (called-interactively-p 'any) (buffer-name)) org-agenda-buffer-name))) (when open (org-open-file file))) @@ -3432,7 +3431,7 @@ This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the entry text following headings shown in the agenda. Drawers will be excluded, also the line with scheduling/deadline info." (when (and (> org-agenda-add-entry-text-maxlines 0) - (not (org-bound-and-true-p org-mobile-creating-agendas))) + (not (bound-and-true-p org-mobile-creating-agendas))) (let (m txt) (goto-char (point-min)) (while (not (eobp)) @@ -3457,85 +3456,83 @@ removed from the entry content. Currently only `planning' is allowed here." (with-current-buffer (marker-buffer marker) (if (not (derived-mode-p 'org-mode)) (setq txt "") - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (end-of-line 1) - (setq txt (buffer-substring - (min (1+ (point)) (point-max)) - (progn (outline-next-heading) (point))) - drawer-re org-drawer-regexp - kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp - ".*\n?")) - (with-temp-buffer - (insert txt) - (when org-agenda-add-entry-text-descriptive-links - (goto-char (point-min)) - (while (org-activate-bracket-links (point-max)) - (add-text-properties (match-beginning 0) (match-end 0) - '(face org-link)))) - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp (point-max) t) - (set-text-properties (match-beginning 0) (match-end 0) - nil)) - (goto-char (point-min)) - (while (re-search-forward drawer-re nil t) - (delete-region - (match-beginning 0) - (progn (re-search-forward - "^[ \t]*:END:.*\n?" nil 'move) - (point)))) - (unless (member 'planning keep) - (goto-char (point-min)) - (while (re-search-forward kwd-time-re nil t) - (replace-match ""))) - (goto-char (point-min)) - (when org-agenda-entry-text-exclude-regexps - (let ((re-list org-agenda-entry-text-exclude-regexps) re) - (while (setq re (pop re-list)) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (replace-match ""))))) - (goto-char (point-max)) - (skip-chars-backward " \t\n") - (if (looking-at "[ \t\n]+\\'") (replace-match "")) - - ;; find and remove min common indentation - (goto-char (point-min)) - (untabify (point-min) (point-max)) - (setq ind (org-get-indentation)) - (while (not (eobp)) - (unless (looking-at "[ \t]*$") - (setq ind (min ind (org-get-indentation)))) - (beginning-of-line 2)) - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "[ \t]*$") - (move-to-column ind) - (delete-region (point-at-bol) (point))) - (beginning-of-line 2)) - - (run-hooks 'org-agenda-entry-text-cleanup-hook) - - (goto-char (point-min)) - (when indent - (while (and (not (eobp)) (re-search-forward "^" nil t)) - (replace-match indent t t))) - (goto-char (point-min)) - (while (looking-at "[ \t]*\n") (replace-match "")) - (goto-char (point-max)) - (when (> (org-current-line) - n-lines) - (org-goto-line (1+ n-lines)) - (backward-char 1)) - (setq txt (buffer-substring (point-min) (point))))))))) + (org-with-wide-buffer + (goto-char marker) + (end-of-line 1) + (setq txt (buffer-substring + (min (1+ (point)) (point-max)) + (progn (outline-next-heading) (point))) + drawer-re org-drawer-regexp + kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp + ".*\n?")) + (with-temp-buffer + (insert txt) + (when org-agenda-add-entry-text-descriptive-links + (goto-char (point-min)) + (while (org-activate-bracket-links (point-max)) + (add-text-properties (match-beginning 0) (match-end 0) + '(face org-link)))) + (goto-char (point-min)) + (while (re-search-forward org-bracket-link-regexp (point-max) t) + (set-text-properties (match-beginning 0) (match-end 0) + nil)) + (goto-char (point-min)) + (while (re-search-forward drawer-re nil t) + (delete-region + (match-beginning 0) + (progn (re-search-forward + "^[ \t]*:END:.*\n?" nil 'move) + (point)))) + (unless (member 'planning keep) + (goto-char (point-min)) + (while (re-search-forward kwd-time-re nil t) + (replace-match ""))) + (goto-char (point-min)) + (when org-agenda-entry-text-exclude-regexps + (let ((re-list org-agenda-entry-text-exclude-regexps) re) + (while (setq re (pop re-list)) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (replace-match ""))))) + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (if (looking-at "[ \t\n]+\\'") (replace-match "")) + + ;; find and remove min common indentation + (goto-char (point-min)) + (untabify (point-min) (point-max)) + (setq ind (org-get-indentation)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (setq ind (min ind (org-get-indentation)))) + (beginning-of-line 2)) + (goto-char (point-min)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (move-to-column ind) + (delete-region (point-at-bol) (point))) + (beginning-of-line 2)) + + (run-hooks 'org-agenda-entry-text-cleanup-hook) + + (goto-char (point-min)) + (when indent + (while (and (not (eobp)) (re-search-forward "^" nil t)) + (replace-match indent t t))) + (goto-char (point-min)) + (while (looking-at "[ \t]*\n") (replace-match "")) + (goto-char (point-max)) + (when (> (org-current-line) + n-lines) + (org-goto-line (1+ n-lines)) + (backward-char 1)) + (setq txt (buffer-substring (point-min) (point)))))))) txt)) (defun org-check-for-org-mode () "Make sure current buffer is in org-mode. Error if not." (or (derived-mode-p 'org-mode) - (error "Cannot execute org-mode agenda command on buffer in %s" + (error "Cannot execute Org agenda command on buffer in %s" major-mode))) ;;; Agenda prepare and finalize @@ -3620,26 +3617,26 @@ FILTER-ALIST is an alist of filters we need to apply when ((equal (current-buffer) abuf) nil) (awin (select-window awin)) ((not (setq wconf (current-window-configuration)))) - ((equal org-agenda-window-setup 'current-window) - (org-pop-to-buffer-same-window abuf)) - ((equal org-agenda-window-setup 'other-window) + ((eq org-agenda-window-setup 'current-window) + (pop-to-buffer-same-window abuf)) + ((eq org-agenda-window-setup 'other-window) (org-switch-to-buffer-other-window abuf)) - ((equal org-agenda-window-setup 'other-frame) + ((eq org-agenda-window-setup 'other-frame) (switch-to-buffer-other-frame abuf)) ((eq org-agenda-window-setup 'only-window) (delete-other-windows) - (org-pop-to-buffer-same-window abuf)) - ((equal org-agenda-window-setup 'reorganize-frame) + (pop-to-buffer-same-window abuf)) + ((eq org-agenda-window-setup 'reorganize-frame) (delete-other-windows) (org-switch-to-buffer-other-window abuf))) - (setq org-agenda-tag-filter (cdr (assoc 'tag filter-alist))) - (setq org-agenda-category-filter (cdr (assoc 'cat filter-alist))) - (setq org-agenda-effort-filter (cdr (assoc 'effort filter-alist))) - (setq org-agenda-regexp-filter (cdr (assoc 're filter-alist))) + (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist))) + (setq org-agenda-category-filter (cdr (assq 'cat filter-alist))) + (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist))) + (setq org-agenda-regexp-filter (cdr (assq 're filter-alist))) ;; Additional test in case agenda is invoked from within agenda ;; buffer via elisp link. (unless (equal (current-buffer) abuf) - (org-pop-to-buffer-same-window abuf)) + (pop-to-buffer-same-window abuf)) (setq org-agenda-pre-window-conf (or wconf org-agenda-pre-window-conf)))) @@ -3703,7 +3700,7 @@ FILTER-ALIST is an alist of filters we need to apply when (setq org-agenda-last-prefix-arg current-prefix-arg) (setq org-agenda-this-buffer-name org-agenda-buffer-name) (and name (not org-agenda-name) - (org-set-local 'org-agenda-name name))) + (setq-local org-agenda-name name))) (setq buffer-read-only nil)))) (defvar org-agenda-overriding-columns-format) ; From org-colview.el @@ -3727,8 +3724,8 @@ FILTER-ALIST is an alist of filters we need to apply when (remove-text-properties (point-min) (point-max) '(face nil))) (if (and (boundp 'org-agenda-overriding-columns-format) org-agenda-overriding-columns-format) - (org-set-local 'org-agenda-overriding-columns-format - org-agenda-overriding-columns-format)) + (setq-local org-agenda-overriding-columns-format + org-agenda-overriding-columns-format)) (if (and (boundp 'org-agenda-view-columns-initially) org-agenda-view-columns-initially) (org-agenda-columns)) @@ -3785,13 +3782,13 @@ FILTER-ALIST is an alist of filters we need to apply when (when (get 'org-agenda-effort-filter :preset-filter) (org-agenda-filter-apply (get 'org-agenda-effort-filter :preset-filter) 'effort)) - (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))))) + (add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))))) (defun org-agenda-mark-clocking-task () "Mark the current clock entry in the agenda if it is present." ;; We need to widen when `org-agenda-finalize' is called from ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in') - (when org-clock-current-task + (when (bound-and-true-p org-clock-current-task) (save-restriction (widen) (org-agenda-unmark-clocking-task) @@ -3858,7 +3855,7 @@ FILTER-ALIST is an alist of filters we need to apply when When INVISIBLE is non-nil, hide currently blocked TODO instead of dimming them." (interactive "P") - (when (org-called-interactively-p 'interactive) + (when (called-interactively-p 'interactive) (message "Dim or hide blocked tasks...")) (dolist (o (overlays-in (point-min) (point-max))) (when (eq (overlay-get o 'org-type) 'org-blocked-todo) @@ -3890,7 +3887,7 @@ dimming them." (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) (overlay-put ov 'org-type 'org-blocked-todo)))) (forward-line)))) - (when (org-called-interactively-p 'interactive) + (when (called-interactively-p 'interactive) (message "Dim or hide blocked tasks...done"))) (defvar org-agenda-skip-function nil @@ -3942,7 +3939,7 @@ functions do." (defvar org-agenda-markers nil "List of all currently active markers created by `org-agenda'.") -(defvar org-agenda-last-marker-time (org-float-time) +(defvar org-agenda-last-marker-time (float-time) "Creation time of the last agenda marker.") (defun org-agenda-new-marker (&optional pos) @@ -3950,7 +3947,7 @@ functions do." Maker is at point, or at POS if non-nil. Org mode keeps a list of these markers and resets them when they are no longer in use." (let ((m (copy-marker (or pos (point)) t))) - (setq org-agenda-last-marker-time (org-float-time)) + (setq org-agenda-last-marker-time (float-time)) (if org-agenda-buffer (with-current-buffer org-agenda-buffer (push m org-agenda-markers)) @@ -4011,13 +4008,12 @@ This check for agenda markers in all agenda buffers currently active." (defun org-agenda-get-day-face (date) "Return the face DATE should be displayed with." - (or (and (functionp org-agenda-day-face-function) - (funcall org-agenda-day-face-function date)) - (cond ((org-agenda-todayp date) - 'org-agenda-date-today) - ((member (calendar-day-of-week date) org-agenda-weekend-days) - 'org-agenda-date-weekend) - (t 'org-agenda-date)))) + (cond ((and (functionp org-agenda-day-face-function) + (funcall org-agenda-day-face-function date))) + ((org-agenda-today-p date) 'org-agenda-date-today) + ((memq (calendar-day-of-week date) org-agenda-weekend-days) + 'org-agenda-date-weekend) + (t 'org-agenda-date))) ;;; Agenda timeline @@ -4025,12 +4021,16 @@ This check for agenda markers in all agenda buffers currently active." (defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list' (defun org-timeline (&optional dotodo) - "Show a time-sorted view of the entries in the current org file. -Only entries with a time stamp of today or later will be listed. With -\\[universal-argument] prefix, all unfinished TODO items will also be shown, + "Show a time-sorted view of the entries in the current Org file. + +Only entries with a time stamp of today or later will be listed. + +With `\\[universal-argument]' prefix, all unfinished TODO items will also be \ +shown, under the current date. -If the buffer contains an active region, only check the region for -dates." + +If the buffer contains an active region, only check the region +for dates." (interactive "P") (let* ((dopast t) (org-agenda-show-log-scoped org-agenda-show-log) @@ -4213,8 +4213,7 @@ items if they have an hour specification like [h]h:mm." (setq start-day (time-to-days (org-read-date nil t start-day)))) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) - (let* ((span (org-agenda-ndays-to-span - (or span org-agenda-ndays org-agenda-span))) + (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span))) (today (org-today)) (sd (or start-day today)) (ndays (org-agenda-span-to-ndays span sd)) @@ -4244,9 +4243,9 @@ items if they have an hour specification like [h]h:mm." (setq day-numbers (nreverse day-numbers)) (setq clocktable-start (car day-numbers) clocktable-end (1+ (or (org-last day-numbers) 0))) - (org-set-local 'org-starting-day (car day-numbers)) - (org-set-local 'org-arg-loc arg) - (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) + (setq-local org-starting-day (car day-numbers)) + (setq-local org-arg-loc arg) + (setq-local org-agenda-current-span (org-agenda-ndays-to-span span)) (unless org-agenda-compact-blocks (let* ((d1 (car day-numbers)) (d2 (org-last day-numbers)) @@ -4392,10 +4391,10 @@ START-DAY is an absolute time value." ((eq span 'fortnight) 14) ((eq span 'month) (let ((date (calendar-gregorian-from-absolute start-day))) - (calendar-last-day-of-month (car date) (caddr date)))) + (calendar-last-day-of-month (car date) (cl-caddr date)))) ((eq span 'year) (let ((date (calendar-gregorian-from-absolute start-day))) - (if (calendar-leap-year-p (caddr date)) 366 365))))) + (if (calendar-leap-year-p (cl-caddr date)) 366 365))))) (defun org-agenda-span-name (span) "Return a SPAN name." @@ -4410,7 +4409,7 @@ START-DAY is an absolute time value." (defvar org-agenda-search-history nil) (defvar org-search-syntax-table nil - "Special syntax table for org-mode search. + "Special syntax table for Org search. In this table, we have single quotes not as word constituents, to that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") @@ -4727,7 +4726,7 @@ Press `\\[org-agenda-manipulate-query-add]', \ (defun org-todo-list (&optional arg) "Show all (not done) TODO entries from all agenda file in a single list. The prefix arg can be used to select a specific TODO keyword and limit -the list to these. When using \\[universal-argument], you will be prompted +the list to these. When using `\\[universal-argument]', you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'." (interactive "P") @@ -4745,8 +4744,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in rtn rtnall files file pos) (when (equal arg '(4)) (setq org-select-this-todo-keyword - (org-icompleting-read "Keyword (or KWD1|K2D2|...): " - (mapcar 'list kwds) nil nil))) + (completing-read "Keyword (or KWD1|K2D2|...): " + (mapcar #'list kwds) nil nil))) (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) (catch 'exit (if org-agenda-sticky @@ -4835,14 +4834,17 @@ The prefix arg TODO-ONLY limits the search to TODO entries." ;; Prepare agendas (and `org-tag-alist-for-agenda') before ;; expanding tags within `org-make-tags-matcher' (org-agenda-prepare (concat "TAGS " match)) - (setq matcher (org-make-tags-matcher match) - match (car matcher) matcher (cdr matcher)) + (setq org--matcher-tags-todo-only todo-only + matcher (org-make-tags-matcher match) + match (car matcher) + matcher (cdr matcher)) (org-compile-prefix-format 'tags) (org-set-sorting-strategy 'tags) (setq org-agenda-query-string match) (setq org-agenda-redo-command - (list 'org-tags-view `(quote ,todo-only) - (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string)))) + (list 'org-tags-view + `(quote ,org--matcher-tags-todo-only) + `(if current-prefix-arg nil ,org-agenda-query-string))) (setq files (org-agenda-files nil 'ifmode) rtnall nil) (while (setq file (pop files)) @@ -4865,7 +4867,9 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end) (widen)) - (setq rtn (org-scan-tags 'agenda matcher todo-only)) + (setq rtn (org-scan-tags 'agenda + matcher + org--matcher-tags-todo-only)) (setq rtnall (append rtnall rtn)))))))) (if org-agenda-overriding-header (insert (org-add-props (copy-sequence org-agenda-overriding-header) @@ -4883,17 +4887,19 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (insert (substitute-command-keys "Press `\\[universal-argument] \\[org-agenda-redo]' \ to search again with new search string\n"))) - (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) + (add-text-properties pos (1- (point)) + (list 'face 'org-agenda-structure))) (org-agenda-mark-header-line (point-min)) (when rtnall (insert (org-agenda-finalize-entries rtnall 'tags) "\n")) (goto-char (point-min)) (or org-agenda-multi (org-agenda-fit-window-to-buffer)) - (add-text-properties (point-min) (point-max) - `(org-agenda-type tags - org-last-args (,todo-only ,match) - org-redo-cmd ,org-agenda-redo-command - org-series-cmd ,org-cmd)) + (add-text-properties + (point-min) (point-max) + `(org-agenda-type tags + org-last-args (,org--matcher-tags-todo-only ,match) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) (org-agenda-finalize) (setq buffer-read-only t)))) @@ -5102,12 +5108,12 @@ of what a project is and how to check if it stuck, customize the variable (tags (nth 2 org-stuck-projects)) (tags-re (if (member "*" tags) (concat org-outline-regexp-bol - (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$")) + ".*:[[:alnum:]_@#%]+:[ \t]*$") (if tags (concat org-outline-regexp-bol ".*:\\(" - (mapconcat 'identity tags "\\|") - (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$"))))) + (mapconcat #'identity tags "\\|") + "\\):[[:alnum:]_@#%:]*[ \t]*$")))) (gen-re (nth 3 org-stuck-projects)) (re-list (delq nil @@ -5202,7 +5208,7 @@ date. It also removes lines that contain only whitespace." (while (re-search-forward "^ +\n" nil t) (replace-match "")) (goto-char (point-min)) - (if (re-search-forward "^Org-mode dummy\n?" nil t) + (if (re-search-forward "^Org mode dummy\n?" nil t) (replace-match "")) (run-hooks 'org-agenda-cleanup-fancy-diary-hook)) @@ -5220,7 +5226,7 @@ date. It also removes lines that contain only whitespace." (setq string (org-modify-diary-entry-string string)))))) (defun org-modify-diary-entry-string (string) - "Add text properties to string, allowing org-mode to act on it." + "Add text properties to string, allowing Org to act on it." (org-add-props string nil 'mouse-face 'highlight 'help-echo (if buffer-file-name @@ -5236,9 +5242,9 @@ Needed to avoid empty dates which mess up holiday display." ;; Catch the error if dealing with the new add-to-diary-alist (when org-disable-agenda-to-diary (condition-case nil - (org-add-to-diary-list original-date "Org-mode dummy" "") + (org-add-to-diary-list original-date "Org mode dummy" "") (error - (org-add-to-diary-list original-date "Org-mode dummy" "" nil))))) + (org-add-to-diary-list original-date "Org mode dummy" "" nil))))) (defun org-add-to-diary-list (&rest args) (if (fboundp 'diary-add-to-list) @@ -5274,7 +5280,7 @@ So the example above may also be written as The function expects the lisp variables `entry' and `date' to be provided by the caller, because this is how the calendar works. Don't use this function from a program - use `org-agenda-get-day-entries' instead." - (when (> (- (org-float-time) + (when (> (- (float-time) org-agenda-last-marker-time) 5) ;; I am not sure if this works with sticky agendas, because the marker @@ -5286,7 +5292,7 @@ function from a program - use `org-agenda-get-day-entries' instead." (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) (list entry) (org-agenda-files t))) - (time (org-float-time)) + (time (float-time)) file rtn results) (when (or (not org-diary-last-run-time) (> (- time @@ -5308,67 +5314,77 @@ function from a program - use `org-agenda-get-day-entries' instead." ;;; Agenda entry finders +(defun org-agenda--timestamp-to-absolute (&rest args) + "Call `org-time-string-to-absolute' with ARGS. +However, throw `:skip' whenever an error is raised." + (condition-case e + (apply #'org-time-string-to-absolute args) + (org-diary-sexp-no-match (throw :skip nil)) + (error + (message "%s; Skipping entry" (error-message-string e)) + (throw :skip nil)))) + (defun org-agenda-get-day-entries (file date &rest args) "Does the work for `org-diary' and `org-agenda'. FILE is the path to a file to be checked for entries. DATE is date like the one returned by `calendar-current-date'. ARGS are symbols indicating which kind of entries should be extracted. For details about these, see the documentation of `org-diary'." - (setq args (or args org-agenda-entry-types)) (let* ((org-startup-folded nil) (org-startup-align-all-tables nil) - (buffer (if (file-exists-p file) - (org-get-agenda-file-buffer file) - (error "No such file %s" file))) - arg results rtn deadline-results) + (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file) + (error "No such file %s" file)))) (if (not buffer) - ;; If file does not exist, make sure an error message ends up in diary + ;; If file does not exist, signal it in diary nonetheless. (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) (with-current-buffer buffer (unless (derived-mode-p 'org-mode) (error "Agenda file %s is not in `org-mode'" file)) (setq org-agenda-buffer (or org-agenda-buffer buffer)) - (let ((case-fold-search nil)) - (save-excursion - (save-restriction - (if (eq buffer org-agenda-restrict) - (narrow-to-region org-agenda-restrict-begin - org-agenda-restrict-end) - (widen)) - ;; The way we repeatedly append to `results' makes it O(n^2) :-( - (while (setq arg (pop args)) - (cond - ((and (eq arg :todo) - (equal date (calendar-gregorian-from-absolute - (org-today)))) - (setq rtn (org-agenda-get-todos)) - (setq results (append results rtn))) - ((eq arg :timestamp) - (setq rtn (org-agenda-get-blocks)) - (setq results (append results rtn)) - (setq rtn (org-agenda-get-timestamps deadline-results)) - (setq results (append results rtn))) - ((eq arg :sexp) - (setq rtn (org-agenda-get-sexps)) - (setq results (append results rtn))) - ((eq arg :scheduled) - (setq rtn (org-agenda-get-scheduled deadline-results)) - (setq results (append results rtn))) - ((eq arg :scheduled*) - (setq rtn (org-agenda-get-scheduled deadline-results t)) - (setq results (append results rtn))) - ((eq arg :closed) - (setq rtn (org-agenda-get-progress)) - (setq results (append results rtn))) - ((eq arg :deadline) - (setq rtn (org-agenda-get-deadlines)) - (setq deadline-results (copy-sequence rtn)) - (setq results (append results rtn))) - ((eq arg :deadline*) - (setq rtn (org-agenda-get-deadlines t)) - (setq deadline-results (copy-sequence rtn)) - (setq results (append results rtn)))))))) - results)))) + (setf org-agenda-current-date date) + (save-excursion + (save-restriction + (if (eq buffer org-agenda-restrict) + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + ;; Rationalize ARGS. Also make sure `:deadline' comes + ;; first in order to populate DEADLINES before passing it. + ;; + ;; We use `delq' since `org-uniquify' duplicates ARGS, + ;; guarding us from modifying `org-agenda-entry-types'. + (setf args (org-uniquify (or args org-agenda-entry-types))) + (when (and (memq :scheduled args) (memq :scheduled* args)) + (setf args (delq :scheduled* args))) + (cond + ((memq :deadline args) + (setf args (cons :deadline + (delq :deadline (delq :deadline* args))))) + ((memq :deadline* args) + (setf args (cons :deadline* (delq :deadline* args))))) + ;; Collect list of headlines. Return them flattened. + (let ((case-fold-search nil) results deadlines) + (dolist (arg args (apply #'nconc (nreverse results))) + (pcase arg + ((and :todo (guard (org-agenda-today-p date))) + (push (org-agenda-get-todos) results)) + (:timestamp + (push (org-agenda-get-blocks) results) + (push (org-agenda-get-timestamps deadlines) results)) + (:sexp + (push (org-agenda-get-sexps) results)) + (:scheduled + (push (org-agenda-get-scheduled deadlines) results)) + (:scheduled* + (push (org-agenda-get-scheduled deadlines t) results)) + (:closed + (push (org-agenda-get-progress) results)) + (:deadline + (setf deadlines (org-agenda-get-deadlines)) + (push deadlines results)) + (:deadline* + (setf deadlines (org-agenda-get-deadlines t)) + (push deadlines results))))))))))) (defsubst org-em (x y list) "Is X or Y a member of LIST?" @@ -5524,7 +5540,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (cond ((memq org-agenda-todo-ignore-deadlines '(t all)) t) ((eq org-agenda-todo-ignore-deadlines 'far) - (not (org-deadline-close (match-string 1)))) + (not (org-deadline-close-p (match-string 1)))) ((eq org-agenda-todo-ignore-deadlines 'future) (> (org-time-stamp-to-now (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) @@ -5534,7 +5550,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', ((numberp org-agenda-todo-ignore-deadlines) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-deadlines)) - (t (org-deadline-close (match-string 1))))) + (t (org-deadline-close-p (match-string 1))))) (and org-agenda-todo-ignore-timestamp (let ((buffer (current-buffer)) (regexp @@ -5610,7 +5626,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (and (org-at-date-range-p) (throw :skip nil)) (org-agenda-skip) (if (and (match-end 1) - (not (= d1 (org-time-string-to-absolute + (not (= d1 (org-agenda--timestamp-to-absolute (match-string 1) d1 nil show-all (current-buffer) b0)))) (throw :skip nil)) @@ -5656,8 +5672,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (memq 'agenda org-agenda-use-tag-inheritance)))) tags (org-get-tags-at nil (not inherited-tags)) level (make-string (org-reduced-level (org-outline-level)) ? )) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq head (or (match-string 1) "")) + (looking-at "\\*+[ \t]+\\(.*\\)") + (setq head (match-string 1)) (setq txt (org-agenda-format-item (if inactivep org-agenda-inactive-leader nil) head level category tags timestr @@ -5737,29 +5753,26 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', ;; Calendar sanity: define some functions that are independent of ;; `calendar-date-style'. -;; Normally I would like to use ISO format when calling the diary functions, -;; but to make sure we still have Emacs 22 compatibility we bind -;; also `european-calendar-style' and use european format (defun org-anniversary (year month day &optional mark) "Like `diary-anniversary', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-anniversary day month year mark)))) + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-anniversary year month day mark)))) (defun org-cyclic (N year month day &optional mark) "Like `diary-cyclic', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-cyclic N day month year mark)))) + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-cyclic N year month day mark)))) (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark) "Like `diary-block', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-block D1 M1 Y1 D2 M2 Y2 mark)))) + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-block Y1 M1 D1 Y2 M2 D2 mark)))) (defun org-date (year month day &optional mark) "Like `diary-date', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-date day month year mark)))) + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-date year month day mark)))) ;; Define the `org-class' function (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks) @@ -5786,26 +5799,6 @@ then those holidays will be skipped." (delq nil (mapcar (lambda(g) (member g skip-weeks)) h)))) entry))) -(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) - "Like `org-class', but honor `calendar-date-style'. -The order of the first 2 times 3 arguments depends on the variable -`calendar-date-style' or, if that is not defined, on `european-calendar-style'. -So for American calendars, give this as MONTH DAY YEAR, for European as -DAY MONTH YEAR, and for ISO as YEAR MONTH DAY. -DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS -is any number of ISO weeks in the block period for which the item should -be skipped. - -This function is here only for backward compatibility and it is deprecated, -please use `org-class' instead." - (let* ((date1 (org-order-calendar-date-args m1 d1 y1)) - (date2 (org-order-calendar-date-args m2 d2 y2))) - (org-class - (nth 2 date1) (car date1) (nth 1 date1) - (nth 2 date2) (car date2) (nth 1 date2) - dayname skip-weeks))) -(make-obsolete 'org-diary-class 'org-class "") - (defalias 'org-get-closed 'org-agenda-get-progress) (defun org-agenda-get-progress () "Return the logged TODO entries for agenda display." @@ -5919,7 +5912,7 @@ See also the user option `org-agenda-clock-consistency-checks'." (re (concat "^[ \t]*" org-clock-string "[ \t]+" - "\\(\\[.*?\\]\\)" ; group 1 is first stamp + "\\(\\[.*?\\]\\)" ; group 1 is first stamp "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second (tlstart 0.) (tlend 0.) @@ -5955,10 +5948,10 @@ See also the user option `org-agenda-clock-consistency-checks'." (throw 'next t)) (setq ts (match-string 1) te (match-string 3) - ts (org-float-time - (apply 'encode-time (org-parse-time-string ts))) - te (org-float-time - (apply 'encode-time (org-parse-time-string te))) + ts (float-time + (apply #'encode-time (org-parse-time-string ts))) + te (float-time + (apply #'encode-time (org-parse-time-string te))) dt (- te ts)))) (cond ((> dt (* 60 maxtime)) @@ -6044,123 +6037,124 @@ specification like [h]h:mm." (regexp (if with-hour org-deadline-time-hour-regexp org-deadline-time-regexp)) - (todayp (org-agenda-todayp date)) ; DATE bound by calendar - (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar - (dl0 (car org-agenda-deadline-leaders)) - (dl1 (nth 1 org-agenda-deadline-leaders)) - (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1)) - d2 diff dfrac wdays pos pos1 category level - tags suppress-prewarning ee txt head face s todo-state - show-all upcomingp donep timestr warntime inherited-tags ts-date) + (todayp (org-agenda-today-p date)) ; DATE bound by calendar. + (current (calendar-absolute-from-gregorian date)) + deadline-items) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip + (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) (org-agenda-skip) - (setq s (match-string 1) - txt nil - pos (1- (match-beginning 1)) - todo-state (save-match-data (org-get-todo-state)) - show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all)) - d2 (org-time-string-to-absolute - s d1 'past show-all (current-buffer) pos) - diff (- d2 d1)) - (setq suppress-prewarning - (let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled - (let ((item (buffer-substring (point-at-bol) - (point-at-eol)))) - (save-match-data - (and (string-match - org-scheduled-time-regexp item) - (match-string 1 item))))))) - (cond - ((not ds) nil) - ;; The current item has a scheduled date (in ds), so - ;; evaluate its prewarning lead time. - ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) - ;; Use global prewarning-restart lead time. - org-agenda-skip-deadline-prewarning-if-scheduled) - ((eq org-agenda-skip-deadline-prewarning-if-scheduled - 'pre-scheduled) - ;; Set prewarning to no earlier than scheduled. - (min (- d2 (org-time-string-to-absolute - ds d1 'past show-all (current-buffer) pos)) - org-deadline-warning-days)) - ;; Set prewarning to deadline. - (t 0)))) - (setq wdays (if suppress-prewarning - (let ((org-deadline-warning-days suppress-prewarning)) - (org-get-wdays s)) - (org-get-wdays s)) - dfrac (- 1 (/ (* 1.0 diff) (max wdays 1))) - upcomingp (and todayp (> diff 0))) - ;; When to show a deadline in the calendar: - ;; If the expiration is within wdays warning time. - ;; Past-due deadlines are only shown on the current date - (if (and (or (and (<= diff wdays) - (and todayp (not org-agenda-only-exact-dates))) - (= diff 0))) - (save-excursion - ;; (setq todo-state (org-get-todo-state)) - (setq donep (member todo-state org-done-keywords)) - (if (and donep - (or org-agenda-skip-deadline-if-done - (not (= diff 0)))) - (setq txt nil) - (setq category (org-get-category) - warntime (get-text-property (point) 'org-appt-warntime)) - (if (not (re-search-backward "^\\*+[ \t]+" nil t)) - (throw :skip nil) - (goto-char (match-end 0)) - (setq pos1 (match-beginning 0)) - (setq level (make-string (org-reduced-level (org-outline-level)) ? )) - (setq inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at pos1 (not inherited-tags))) - (setq head (buffer-substring - (point) - (progn (skip-chars-forward "^\r\n") - (point)))) - (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (setq timestr - (concat (substring s (match-beginning 1)) " ")) - (setq timestr 'time)) - (setq txt (org-agenda-format-item - (cond ((= diff 0) dl0) - ((> diff 0) - (if (functionp dl1) - (funcall dl1 diff date) - (format dl1 diff))) - (t - (if (functionp dl2) - (funcall dl2 diff date) - (format dl2 (if (string= dl2 dl1) - diff (abs diff)))))) - head level category tags - (if (not (= diff 0)) nil timestr))))) - (when txt - (setq face (org-agenda-deadline-face dfrac)) - (org-add-props txt props - 'org-marker (org-agenda-new-marker pos) - 'warntime warntime - 'level level - 'ts-date d2 - 'org-hd-marker (org-agenda-new-marker pos1) - 'priority (+ (- diff) - (org-get-priority txt)) - 'todo-state todo-state - 'type (if upcomingp "upcoming-deadline" "deadline") - 'date (if upcomingp date d2) - 'face (if donep 'org-agenda-done face) - 'undone-face face 'done-face 'org-agenda-done) - (push txt ee)))))) - (nreverse ee))) + (let* ((s (match-string 1)) + (pos (1- (match-beginning 1))) + (todo-state (save-match-data (org-get-todo-state))) + (donep (member todo-state org-done-keywords)) + (show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all))) + ;; DEADLINE is the current scheduled date. When it + ;; contains a repeater and SHOW-ALL is non-nil, + ;; LAST-REPEAT is the repeat closest to CURRENT. + ;; Otherwise, LAST-REPEAT is equal to DEADLINE. + (last-repeat (org-agenda--timestamp-to-absolute + s current 'past show-all (current-buffer) pos)) + (deadline (org-agenda--timestamp-to-absolute s current)) + (diff (- last-repeat current)) + (suppress-prewarning + (let ((scheduled + (and org-agenda-skip-deadline-prewarning-if-scheduled + (org-entry-get nil "SCHEDULED")))) + (cond + ((not scheduled) nil) + ;; The current item has a scheduled date, so + ;; evaluate its prewarning lead time. + ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) + ;; Use global prewarning-restart lead time. + org-agenda-skip-deadline-prewarning-if-scheduled) + ((eq org-agenda-skip-deadline-prewarning-if-scheduled + 'pre-scheduled) + ;; Set pre-warning to no earlier than SCHEDULED. + (min (- last-repeat + (org-agenda--timestamp-to-absolute + scheduled current 'past show-all + (current-buffer) + (save-excursion + (beginning-of-line) + (1+ (search-forward org-deadline-string))))) + org-deadline-warning-days)) + ;; Set pre-warning to deadline. + (t 0)))) + (wdays (if suppress-prewarning + (let ((org-deadline-warning-days suppress-prewarning)) + (org-get-wdays s)) + (org-get-wdays s)))) + ;; When to show a deadline in the calendar: if the + ;; expiration is within WDAYS warning time. Past-due + ;; deadlines are only shown on the current date + (unless (or (and (<= diff wdays) + (and todayp (not org-agenda-only-exact-dates))) + (= diff 0)) + (throw :skip nil)) + ;; Skip done tasks if `org-agenda-skip-deadline-if-done' is + ;; non-nil or if it isn't applicable to CURRENT deadline. + (when (and donep + (or org-agenda-skip-deadline-if-done + (/= deadline current))) + (throw :skip nil)) + (save-excursion + (re-search-backward "^\\*+[ \t]+" nil t) + (goto-char (match-end 0)) + (let* ((category (org-get-category)) + (level + (make-string (org-reduced-level (org-outline-level)) ?\s)) + (head (buffer-substring (point) (line-end-position))) + (inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda + org-agenda-use-tag-inheritance))))) + (tags (org-get-tags-at nil (not inherited-tags))) + (timestr + (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (concat (substring s (match-beginning 1)) " ") + 'time)) + (item + (org-agenda-format-item + ;; For past deadlines, make sure to report time + ;; difference since date S, not since closest + ;; repeater. + (let ((diff (if (< (org-today) current) diff + (- deadline current)))) + (if (= diff 0) (car org-agenda-deadline-leaders) + (let ((future (nth 1 org-agenda-deadline-leaders)) + (past (nth 2 org-agenda-deadline-leaders))) + (cond ((> diff 0) (format future diff)) + ((string= future past) (format past diff)) + (t (format past (abs diff))))))) + head level category tags + (and (= diff 0) timestr))) + (face (org-agenda-deadline-face + (- 1 (/ (float (- deadline current)) (max wdays 1))))) + (upcomingp (and todayp (> diff 0))) + (warntime (get-text-property (point) 'org-appt-warntime))) + (org-add-props item props + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) + 'warntime warntime + 'level level + 'ts-date deadline + 'priority (- (org-get-priority item) diff) + 'todo-state todo-state + 'type (if upcomingp "upcoming-deadline" "deadline") + 'date (if upcomingp date deadline) + 'face (if donep 'org-agenda-done face) + 'undone-face face + 'done-face 'org-agenda-done) + (push item deadline-items)))))) + (nreverse deadline-items))) (defun org-agenda-deadline-face (fraction) "Return the face to displaying a deadline item. @@ -6170,10 +6164,11 @@ FRACTION is what fraction of the head-warning time has passed." (while (setq f (pop faces)) (if (>= fraction (car f)) (throw 'exit (cdr f))))))) -(defun org-agenda-get-scheduled (&optional deadline-results with-hour) +(defun org-agenda-get-scheduled (&optional deadlines with-hour) "Return the scheduled information for agenda display. -When WITH-HOUR is non-nil, only return scheduled items with -an hour specification like [h]h:mm." +Optional argument DEADLINES is a list of deadline items to be +displayed in agenda view. When WITH-HOUR is non-nil, only return +scheduled items with an hour specification like [h]h:mm." (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp @@ -6185,165 +6180,167 @@ an hour specification like [h]h:mm." (regexp (if with-hour org-scheduled-time-hour-regexp org-scheduled-time-regexp)) - (todayp (org-agenda-todayp date)) ; DATE bound by calendar - (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar - mm - (deadline-position-alist - (mapcar (lambda (a) (and (setq mm (get-text-property - 0 'org-hd-marker a)) - (cons (marker-position mm) a))) - deadline-results)) - d2 diff pos pos1 category level tags donep - ee txt head pastschedp todo-state face timestr s habitp show-all - did-habit-check-p warntime inherited-tags ts-date suppress-delay - ddays) + (todayp (org-agenda-today-p date)) ; DATE bound by calendar. + (current (calendar-absolute-from-gregorian date)) + (deadline-pos + (mapcar (lambda (d) + (let ((m (get-text-property 0 'org-hd-marker d))) + (and m (marker-position m)))) + deadlines)) + scheduled-items) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip + (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) (org-agenda-skip) - (setq s (match-string 1) - txt nil - pos (1- (match-beginning 1)) - todo-state (save-match-data (org-get-todo-state)) - show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all)) - d2 (org-time-string-to-absolute - s d1 'past show-all (current-buffer) pos) - diff (- d2 d1) - warntime (get-text-property (point) 'org-appt-warntime)) - (setq pastschedp (and todayp (< diff 0))) - (setq did-habit-check-p nil) - (setq suppress-delay - (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline - (let ((item (buffer-substring (point-at-bol) (point-at-eol)))) - (save-match-data - (and (string-match - org-deadline-time-regexp item) - (match-string 1 item))))))) + (let* ((s (match-string 1)) + (pos (1- (match-beginning 1))) + (todo-state (save-match-data (org-get-todo-state))) + (donep (member todo-state org-done-keywords)) + (show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all))) + ;; SCHEDULE is the current scheduled date. When it + ;; contains a repeater and SHOW-ALL is non-nil, + ;; LAST-REPEAT is the repeat closest to CURRENT. + ;; Otherwise, LAST-REPEAT is equal to SCHEDULE. + (last-repeat (org-agenda--timestamp-to-absolute + s current 'past show-all (current-buffer) pos)) + (schedule (org-agenda--timestamp-to-absolute s current)) + (diff (- last-repeat current)) + (warntime (get-text-property (point) 'org-appt-warntime)) + (pastschedp (< schedule (org-today))) + (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p))) + (suppress-delay + (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline + (org-entry-get nil "DEADLINE")))) + (cond + ((not deadline) nil) + ;; The current item has a deadline date, so + ;; evaluate its delay time. + ((integerp org-agenda-skip-scheduled-delay-if-deadline) + ;; Use global delay time. + (- org-agenda-skip-scheduled-delay-if-deadline)) + ((eq org-agenda-skip-scheduled-delay-if-deadline + 'post-deadline) + ;; Set delay to no later than DEADLINE. If + ;; DEADLINE has a repeater, compare last schedule + ;; repeat and last deadline repeat. + (min (- last-repeat + (org-agenda--timestamp-to-absolute + deadline current 'past show-all + (current-buffer) + (save-excursion + (beginning-of-line) + (1+ (search-forward org-deadline-string))))) + org-scheduled-delay-days)) + (t 0)))) + (ddays (cond - ((not ds) nil) - ;; The current item has a deadline date (in ds), so - ;; evaluate its delay time. - ((integerp org-agenda-skip-scheduled-delay-if-deadline) - ;; Use global delay time. - (- org-agenda-skip-scheduled-delay-if-deadline)) - ((eq org-agenda-skip-scheduled-delay-if-deadline - 'post-deadline) - ;; Set delay to no later than deadline. - (min (- d2 (org-time-string-to-absolute - ds d1 'past show-all (current-buffer) pos)) - org-scheduled-delay-days)) - (t 0)))) - (setq ddays (if suppress-delay - (let ((org-scheduled-delay-days suppress-delay)) - (org-get-wdays s t t)) - (org-get-wdays s t))) - ;; Use a delay of 0 when there is a repeater and the delay is - ;; of the form --3d - (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s)) - (< (org-time-string-to-absolute s) - (org-time-string-to-absolute - s d2 'past nil (current-buffer) pos))) - (setq ddays 0)) - ;; When to show a scheduled item in the calendar: - ;; If it is on or past the date. - (when (or (and (> ddays 0) (= diff (- ddays))) - (and (zerop ddays) (= diff 0)) - (and (< (+ diff ddays) 0) - (< (abs diff) org-scheduled-past-days) - (and todayp (not org-agenda-only-exact-dates))) - ;; org-is-habit-p uses org-entry-get, which is expansive - ;; so we go extra mile to only call it once - (and todayp - (boundp 'org-habit-show-all-today) - org-habit-show-all-today - (setq did-habit-check-p t) - (setq habitp (and (functionp 'org-is-habit-p) - (org-is-habit-p))))) - (save-excursion - (setq donep (member todo-state org-done-keywords)) - (if (and donep + ;; Nullify delay when a repeater triggered already + ;; and the delay is of the form --Xd. + ((and (string-match-p "--[0-9]+[hdwmy]" s) + (/= schedule last-repeat)) + 0) + (suppress-delay + (let ((org-scheduled-delay-days suppress-delay)) + (org-get-wdays s t t))) + (t (org-get-wdays s t))))) + ;; Only show a scheduled item in the calendar if it is on or + ;; past the current date. Skip it if it has been displayed + ;; for more than `org-scheduled-past-days'. + (unless (or (and (>= ddays 0) (= diff (- ddays))) + (and (< (+ diff ddays) 0) + (< (abs diff) org-scheduled-past-days) + (and todayp (not org-agenda-only-exact-dates))) + (and todayp + habitp + (bound-and-true-p org-habit-show-all-today))) + (throw :skip nil)) + ;; Skip done habits, or tasks if + ;; `org-agenda-skip-deadline-if-done' is non-nil or if it + ;; was scheduled in the past anyway. + (when (and donep (or org-agenda-skip-scheduled-if-done - (not (= diff 0)) - (and (functionp 'org-is-habit-p) - (org-is-habit-p)))) - (setq txt nil) - (setq habitp (if did-habit-check-p habitp - (and (functionp 'org-is-habit-p) - (org-is-habit-p)))) - (setq category (org-get-category)) - (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown - 'repeated-after-deadline) - (org-get-deadline-time (point)) - (<= 0 (- d2 (time-to-days (org-get-deadline-time (point)))))) - (throw :skip nil)) - (if (not (re-search-backward "^\\*+[ \t]+" nil t)) - (throw :skip nil) - (goto-char (match-end 0)) - (setq pos1 (match-beginning 0)) - (if habitp - (if (or (not org-habit-show-habits) - (and (not todayp) - (boundp 'org-habit-show-habits-only-for-today) - org-habit-show-habits-only-for-today)) - (throw :skip nil)) - (if (and - (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown) - (and (eq org-agenda-skip-scheduled-if-deadline-is-shown 'not-today) - pastschedp)) - (setq mm (assoc pos1 deadline-position-alist))) - (throw :skip nil))) - (setq inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda org-agenda-use-tag-inheritance)))) - - tags (org-get-tags-at nil (not inherited-tags))) - (setq level (make-string (org-reduced-level (org-outline-level)) ? )) - (setq head (buffer-substring - (point) - (progn (skip-chars-forward "^\r\n") (point)))) - (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (setq timestr - (concat (substring s (match-beginning 1)) " ")) - (setq timestr 'time)) - (setq txt (org-agenda-format-item - (if (= diff 0) - (car org-agenda-scheduled-leaders) - (format (nth 1 org-agenda-scheduled-leaders) - (- 1 diff))) - head level category tags - (if (not (= diff 0)) nil timestr) - nil habitp)))) - (when txt - (setq face - (cond - ((and (not habitp) pastschedp) - 'org-scheduled-previously) - (todayp 'org-scheduled-today) - (t 'org-scheduled)) - habitp (and habitp (org-habit-parse-todo))) - (org-add-props txt props + (/= schedule current) + habitp)) + (throw :skip nil)) + ;; Skip entry if it already appears as a deadline, per + ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This + ;; doesn't apply to habits. + (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown + ((guard + (or (not (memq (line-beginning-position 0) deadline-pos)) + habitp)) + nil) + (`repeated-after-deadline + (>= last-repeat + (time-to-days (org-get-deadline-time (point))))) + (`not-today pastschedp) + (`t t) + (_ nil)) + (throw :skip nil)) + ;; Skip habits if `org-habit-show-habits' is nil, or if we + ;; only show them for today. + (when (and habitp + (or (not (bound-and-true-p org-habit-show-habits)) + (and (not todayp) + (bound-and-true-p + org-habit-show-habits-only-for-today)))) + (throw :skip nil)) + (save-excursion + (re-search-backward "^\\*+[ \t]+" nil t) + (goto-char (match-end 0)) + (let* ((category (org-get-category)) + (inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda + org-agenda-use-tag-inheritance))))) + (tags (org-get-tags-at nil (not inherited-tags))) + (level + (make-string (org-reduced-level (org-outline-level)) ?\s)) + (head (buffer-substring (point) (line-end-position))) + (timestr + (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (concat (substring s (match-beginning 1)) " ") + 'time)) + (item (org-agenda-format-item + ;; For past scheduled dates, make sure to + ;; report time difference since SCHEDULE, + ;; not since closest repeater. + (let ((diff (if (< (org-today) current) diff + (- schedule current)))) + (if (= diff 0) (car org-agenda-scheduled-leaders) + (format (nth 1 org-agenda-scheduled-leaders) + (- 1 diff)))) + head level category tags + (and (= diff 0) timestr) + nil habitp)) + (face (cond ((and (not habitp) pastschedp) + 'org-scheduled-previously) + (todayp 'org-scheduled-today) + (t 'org-scheduled))) + (habitp (and habitp (org-habit-parse-todo)))) + (org-add-props item props 'undone-face face 'face (if donep 'org-agenda-done face) 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker pos1) + 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) 'type (if pastschedp "past-scheduled" "scheduled") - 'date (if pastschedp d2 date) - 'ts-date d2 + 'date (if pastschedp schedule date) + 'ts-date schedule 'warntime warntime 'level level - 'priority (if habitp - (org-habit-get-priority habitp) - (+ 94 (- 5 diff) (org-get-priority txt))) + 'priority (if habitp (org-habit-get-priority habitp) + (+ 94 (- 5 diff) (org-get-priority item))) 'org-habit-p habitp 'todo-state todo-state) - (push txt ee)))))) - (nreverse ee))) + (push item scheduled-items)))))) + (nreverse scheduled-items))) (defun org-agenda-get-blocks () "Return the date-range information for agenda display." @@ -6394,7 +6391,7 @@ an hour specification like [h]h:mm." tags (org-get-tags-at nil (not inherited-tags))) (setq level (make-string (org-reduced-level (org-outline-level)) ? )) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (looking-at "\\*+[ \t]+\\(.*\\)") (setq head (match-string 1)) (let ((remove-re (if org-agenda-remove-timeranges-from-blocks @@ -6449,10 +6446,10 @@ The flag is set if the currently compiled format contains a `%b'.") (defun org-agenda-get-category-icon (category) "Return an image for CATEGORY according to `org-agenda-category-icon-alist'." (dolist (entry org-agenda-category-icon-alist) - (when (org-string-match-p (car entry) category) + (when (string-match-p (car entry) category) (if (listp (cadr entry)) - (return (cadr entry)) - (return (apply 'create-image (cdr entry))))))) + (cl-return (cadr entry)) + (cl-return (apply #'create-image (cdr entry))))))) (defun org-agenda-format-item (extra txt &optional level category tags dotime remove-re habitp) @@ -6479,8 +6476,8 @@ Any match of REMOVE-RE will be removed from TXT." ;; buffer (let* ((bindings (car org-prefix-format-compiled)) (formatter (cadr org-prefix-format-compiled))) - (loop for (var value) in bindings - do (set var value)) + (cl-loop for (var value) in bindings + do (set var value)) (save-match-data ;; Diary entries sometimes have extra whitespace at the beginning (setq txt (org-trim txt)) @@ -6550,8 +6547,7 @@ Any match of REMOVE-RE will be removed from TXT." (setq duration (- (org-hh:mm-string-to-minutes s2) (org-hh:mm-string-to-minutes s1))))) - (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") - txt) + (when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt) ;; Tags are in the string (if (or (eq org-agenda-remove-tags t) (and org-agenda-remove-tags @@ -6626,7 +6622,7 @@ Any match of REMOVE-RE will be removed from TXT." The modified list may contain inherited tags, and tags matched by `org-agenda-hide-tags-regexp' will be removed." (when (or add-inherited hide-re) - (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) + (if (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt) (setq txt (substring txt 0 (match-beginning 0)))) (setq tags (delq nil @@ -6731,12 +6727,12 @@ and stored in the variable `org-prefix-format-compiled'." c (or (match-string 3 s) "") opt (match-beginning 1) start (1+ (match-beginning 0))) - (if (equal var 'time) (setq org-prefix-has-time t)) - (if (equal var 'tag) (setq org-prefix-has-tag t)) - (if (equal var 'effort) (setq org-prefix-has-effort t)) - (if (equal var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t)) + (if (eq var 'time) (setq org-prefix-has-time t)) + (if (eq var 'tag) (setq org-prefix-has-tag t)) + (if (eq var 'effort) (setq org-prefix-has-effort t)) + (if (eq var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t)) (setq f (concat "%" (match-string 2 s) "s")) - (when (equal var 'category) + (when (eq var 'category) (setq org-prefix-category-length (floor (abs (string-to-number (match-string 2 s))))) (setq org-prefix-category-max-length @@ -6959,8 +6955,14 @@ The optional argument TYPE tells the agenda type." (defsubst org-cmp-effort (a b) "Compare the effort values of string A and B." (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1)) - (ea (or (get-text-property (1- (length a)) 'effort-minutes a) def)) - (eb (or (get-text-property (1- (length b)) 'effort-minutes b) def))) + ;; `effort-minutes' property is not directly accessible from + ;; the strings, but is stored as a property in `txt'. + (ea (or (get-text-property + 0 'effort-minutes (get-text-property 0 'txt a)) + def)) + (eb (or (get-text-property + 0 'effort-minutes (get-text-property 0 'txt b)) + def))) (cond ((> ea eb) +1) ((< ea eb) -1)))) @@ -7122,7 +7124,7 @@ their type." 'face 'org-agenda-restriction-lock) (overlay-put org-agenda-restriction-lock-overlay 'help-echo "Agendas are currently limited to this subtree.") -(org-detach-overlay org-agenda-restriction-lock-overlay) +(delete-overlay org-agenda-restriction-lock-overlay) ;;;###autoload (defun org-agenda-set-restriction-lock (&optional type) @@ -7168,8 +7170,8 @@ in the file. Otherwise, restriction will be to the current subtree." (defun org-agenda-remove-restriction-lock (&optional noupdate) "Remove the agenda restriction lock." (interactive "P") - (org-detach-overlay org-agenda-restriction-lock-overlay) - (org-detach-overlay org-speedbar-restriction-lock-overlay) + (delete-overlay org-agenda-restriction-lock-overlay) + (delete-overlay org-speedbar-restriction-lock-overlay) (setq org-agenda-overriding-restriction nil) (setq org-agenda-restrict nil) (put 'org-agenda-files 'org-restrict nil) @@ -7358,7 +7360,7 @@ in the agenda." (when effort (org-agenda-filter-apply effort 'effort)) (when re (org-agenda-filter-apply re 'regexp))) (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) - (and cols (org-called-interactively-p 'any) (org-agenda-columns)) + (and cols (called-interactively-p 'any) (org-agenda-columns)) (org-goto-line line) (recenter window-line))) @@ -7447,19 +7449,19 @@ With two prefix arguments, remove the effort filters." effort-prompt op) (while (not (member op '(?< ?> ?=))) (setq op (read-char-exclusive "Effort operator? (> = or <)"))) - (loop for i from 0 to 9 do - (setq effort-prompt - (concat - effort-prompt " [" - (if (= i 9) "0" (int-to-string (1+ i))) - "]" (nth i efforts)))) - (message "Effort %s%s" (char-to-string op) effort-prompt) - (while (or (< eff 0) (> eff 9)) - (setq eff (string-to-number (char-to-string (read-char-exclusive))))) - (setq org-agenda-effort-filter - (list (concat (if strip "-" "+") - (char-to-string op) (nth (1- eff) efforts)))) - (org-agenda-filter-apply org-agenda-effort-filter 'effort))) + (cl-loop for i from 0 to 9 do + (setq effort-prompt + (concat + effort-prompt " [" + (if (= i 9) "0" (int-to-string (1+ i))) + "]" (nth i efforts)))) + (message "Effort %s%s" (char-to-string op) effort-prompt) + (while (or (< eff 0) (> eff 9)) + (setq eff (string-to-number (char-to-string (read-char-exclusive))))) + (setq org-agenda-effort-filter + (list (concat (if strip "-" "+") + (char-to-string op) (nth (1- eff) efforts)))) + (org-agenda-filter-apply org-agenda-effort-filter 'effort))) (t (org-agenda-filter-show-all-effort) (message "Effort filter removed")))) @@ -7480,15 +7482,18 @@ With two prefix arguments, remove the effort filters." (defun org-agenda-filter-by-tag (arg &optional char exclude) "Keep only those lines in the agenda buffer that have a specific tag. -The tag is selected with its fast selection letter, as -configured. With a single \\[universal-argument] prefix ARG, -exclude the agenda search. With a double \\[universal-argument] -prefix ARG, filter the literal tag. I.e. don't filter on all its -group members. - -A lisp caller can specify CHAR. EXCLUDE means that the new tag should be -used to exclude the search - the interactive user can also press `-' or `+' -to switch between filtering and excluding." + +The tag is selected with its fast selection letter, as configured. + +With a `\\[universal-argument]' prefix, exclude the agenda search. + +With a `\\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \ +i.e. don't +filter on all its group members. + +A lisp caller can specify CHAR. EXCLUDE means that the new tag +should be used to exclude the search - the interactive user can +also press `-' or `+' to switch between filtering and excluding." (interactive "P") (let* ((alist org-tag-alist-for-agenda) (tag-chars (mapconcat @@ -7517,10 +7522,10 @@ to switch between filtering and excluding." ((eq char ?+) (setq exclude nil))))) (when (eq char ?\t) (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) - (org-set-local 'org-global-tags-completion-table - (org-global-tags-completion-table))) + (setq-local org-global-tags-completion-table + (org-global-tags-completion-table))) (let ((completion-ignore-case t)) - (setq tag (org-icompleting-read + (setq tag (completing-read "Tag: " org-global-tags-completion-table)))) (cond ((eq char ?\r) @@ -7565,12 +7570,6 @@ to switch between filtering and excluding." (get-text-property (point) 'tags)))) tags)) -(defun org-agenda-filter-by-tag-refine (arg &optional char) - "Refine the current filter. See `org-agenda-filter-by-tag'." - (interactive "P") - (org-agenda-filter-by-tag arg char)) -(make-obsolete 'org-agenda-filter-by-tag-refine - "use `org-agenda-filter-by-tag' instead." "8.3.4") (defun org-agenda-filter-make-matcher (filter type &optional expand) "Create the form that tests a line for agenda filter. Optional @@ -7623,30 +7622,22 @@ tags in the FILTER if any of the tags in FILTER are grouptags." (cons 'and (nreverse f)))) (defun org-agenda-filter-make-matcher-tag-exp (tags op) - "Create the form that tests a line for agenda filter for -tag-expressions. Return a match-expression given TAGS. OP is an -operator of type CHAR that allows the function to set the right -switches in the returned form." - (let (f f1) ;f = return expression. f1 = working-area - (dolist (x tags) + "Return a form associated to tag-expression TAGS. +Build a form testing a line for agenda filter for +tag-expressions. OP is an operator of type CHAR that allows the +function to set the right switches in the returned form." + (let (form) + ;; Any of the expressions can match if OP is +, all must match if + ;; the operator is -. + (dolist (x tags (cons (if (eq op ?-) 'and 'or) form)) (let* ((tag (substring x 1)) - (isregexp (and (equal "{" (substring tag 0 1)) - (equal "}" (substring tag -1)))) - regexp) - (cond - (isregexp - (setq regexp (substring tag 1 -1)) - (setq f1 (list 'org-match-any-p regexp 'tags))) - (t - (setq f1 (list 'member (downcase tag) 'tags)))) - (when (eq op ?-) - (setq f1 (list 'not f1)))) - (push f1 f)) - ;; Any of the expressions can match if op = + - ;; all must match if the operator is -. - (if (eq op ?-) - (cons 'and f) - (cons 'or f)))) + (f (cond + ((string= "" tag) '(not tags)) + ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag)) + ;; TAG is a regexp. + (list 'org-match-any-p (substring tag 1 -1) 'tags)) + (t (list 'member (downcase tag) 'tags))))) + (push (if (eq op ?-) (list 'not f) f) form))))) (defun org-agenda-filter-effort-form (e) "Return the form to compare the effort of the current line with what E says. @@ -7860,7 +7851,7 @@ Negative selection means regexp must not match for selection of an entry." (tdpos (goto-char tdpos)) ((eq org-agenda-type 'agenda) (let* ((sd (org-agenda-compute-starting-span - (org-today) (or curspan org-agenda-ndays org-agenda-span))) + (org-today) (or curspan org-agenda-span))) (org-agenda-overriding-arguments args)) (setf (nth 1 org-agenda-overriding-arguments) sd) (org-agenda-redo) @@ -7960,36 +7951,35 @@ With prefix ARG, go backward that many times the current span." (message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") - (let ((a (read-char-exclusive))) - (case a - (?\ (call-interactively 'org-agenda-reset-view)) - (?d (call-interactively 'org-agenda-day-view)) - (?w (call-interactively 'org-agenda-week-view)) - (?t (call-interactively 'org-agenda-fortnight-view)) - (?m (call-interactively 'org-agenda-month-view)) - (?y (call-interactively 'org-agenda-year-view)) - (?l (call-interactively 'org-agenda-log-mode)) - (?L (org-agenda-log-mode '(4))) - (?c (org-agenda-log-mode 'clockcheck)) - ((?F ?f) (call-interactively 'org-agenda-follow-mode)) - (?a (call-interactively 'org-agenda-archives-mode)) - (?A (org-agenda-archives-mode 'files)) - ((?R ?r) (call-interactively 'org-agenda-clockreport-mode)) - ((?E ?e) (call-interactively 'org-agenda-entry-text-mode)) - (?G (call-interactively 'org-agenda-toggle-time-grid)) - (?D (call-interactively 'org-agenda-toggle-diary)) - (?\! (call-interactively 'org-agenda-toggle-deadlines)) - (?\[ (let ((org-agenda-include-inactive-timestamps t)) - (org-agenda-check-type t 'timeline 'agenda) - (org-agenda-redo)) - (message "Display now includes inactive timestamps as well")) - (?q (message "Abort")) - (otherwise (error "Invalid key" ))))) + (pcase (read-char-exclusive) + (?\ (call-interactively 'org-agenda-reset-view)) + (?d (call-interactively 'org-agenda-day-view)) + (?w (call-interactively 'org-agenda-week-view)) + (?t (call-interactively 'org-agenda-fortnight-view)) + (?m (call-interactively 'org-agenda-month-view)) + (?y (call-interactively 'org-agenda-year-view)) + (?l (call-interactively 'org-agenda-log-mode)) + (?L (org-agenda-log-mode '(4))) + (?c (org-agenda-log-mode 'clockcheck)) + ((or ?F ?f) (call-interactively 'org-agenda-follow-mode)) + (?a (call-interactively 'org-agenda-archives-mode)) + (?A (org-agenda-archives-mode 'files)) + ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode)) + ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode)) + (?G (call-interactively 'org-agenda-toggle-time-grid)) + (?D (call-interactively 'org-agenda-toggle-diary)) + (?\! (call-interactively 'org-agenda-toggle-deadlines)) + (?\[ (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-check-type t 'timeline 'agenda) + (org-agenda-redo)) + (message "Display now includes inactive timestamps as well")) + (?q (message "Abort")) + (key (user-error "Invalid key: %s" key)))) (defun org-agenda-reset-view () "Switch to default view for agenda." (interactive) - (org-agenda-change-time-span (or org-agenda-ndays org-agenda-span))) + (org-agenda-change-time-span org-agenda-span)) (defun org-agenda-day-view (&optional day-of-month) "Switch to daily view for agenda. With argument DAY-OF-MONTH, switch to that day of the month." @@ -8128,7 +8118,7 @@ so that the date SD will be in that range." (defun org-unhighlight () "Detach overlay INDEX." - (org-detach-overlay org-hl)) + (delete-overlay org-hl)) (defun org-unhighlight-once () "Remove the highlight from its position, and this function from the hook." @@ -8185,9 +8175,11 @@ so that the date SD will be in that range." (defun org-agenda-log-mode (&optional special) "Toggle log mode in an agenda buffer. + With argument SPECIAL, show all possible log items, not only the ones configured in `org-agenda-log-mode-items'. -With a double \\[universal-argument] prefix arg, show *only* \ + +With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \ log items, nothing else." (interactive "P") (org-agenda-check-type t 'agenda 'timeline) @@ -8202,8 +8194,7 @@ log items, nothing else." (setq org-agenda-start-with-log-mode org-agenda-show-log) (org-agenda-set-mode-name) (org-agenda-redo) - (message "Log mode is %s" - (if org-agenda-show-log "on" "off"))) + (message "Log mode is %s" (if org-agenda-show-log "on" "off"))) (defun org-agenda-archives-mode (&optional with-files) "Toggle inclusion of items in trees marked with :ARCHIVE:. @@ -8275,7 +8266,7 @@ When called with a prefix argument, include all archive files as well." (t "")) (if (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter)) - '(:eval (org-propertize + '(:eval (propertize (concat " <" (mapconcat 'identity @@ -8288,7 +8279,7 @@ When called with a prefix argument, include all archive files as well." 'help-echo "Category used in filtering")) "") (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter)) - '(:eval (org-propertize + '(:eval (propertize (concat " {" (mapconcat 'identity @@ -8301,7 +8292,7 @@ When called with a prefix argument, include all archive files as well." 'help-echo "Tags used in filtering")) "") (if (or org-agenda-effort-filter (get 'org-agenda-effort-filter :preset-filter)) - '(:eval (org-propertize + '(:eval (propertize (concat " {" (mapconcat 'identity @@ -8314,7 +8305,7 @@ When called with a prefix argument, include all archive files as well." 'help-echo "Effort conditions used in filtering")) "") (if (or org-agenda-regexp-filter (get 'org-agenda-regexp-filter :preset-filter)) - '(:eval (org-propertize + '(:eval (propertize (concat " [" (mapconcat 'identity @@ -8333,9 +8324,6 @@ When called with a prefix argument, include all archive files as well." (if org-agenda-clockreport-mode " Clock" ""))) (force-mode-line-update)) -(define-obsolete-function-alias - 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3") - (defun org-agenda-update-agenda-type () "Update the agenda type after each command." (setq org-agenda-type @@ -8398,7 +8386,7 @@ When called with a prefix argument, include all archive files as well." (message "No tags associated with this line")))) (defun org-agenda-goto (&optional highlight) - "Go to the entry at point in the corresponding Org-mode file." + "Go to the entry at point in the corresponding Org file." (interactive) (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) @@ -8410,15 +8398,11 @@ When called with a prefix argument, include all archive files as well." (goto-char pos) (when (derived-mode-p 'org-mode) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (when (outline-invisible-p) - (outline-show-entry)) ; display invisible text (recenter (/ (window-height) 2)) (org-back-to-heading t) - (if (re-search-forward org-complex-heading-regexp nil t) - (goto-char (match-beginning 4)))) + (let ((case-fold-search nil)) + (when (re-search-forward org-complex-heading-regexp nil t) + (goto-char (match-beginning 4))))) (run-hooks 'org-agenda-after-show-hook) (and highlight (org-highlight (point-at-bol) (point-at-eol))))) @@ -8505,7 +8489,7 @@ Point is in the buffer where the item originated.") (org-remove-subtree-entries-from-agenda)) (org-back-to-heading t) (funcall cmd))) - (error "Archiving works only in Org-mode files")))))) + (error "Archiving works only in Org files")))))) (defun org-remove-subtree-entries-from-agenda (&optional buf beg end) "Remove all lines in the agenda that correspond to a given subtree. @@ -8535,11 +8519,16 @@ If this information is not given, the function uses the tree at point." (defun org-agenda-refile (&optional goto rfloc no-update) "Refile the item at point. -When GOTO is 0 or \\='(64) or a triple \\[universal-argument] prefix argument, -clear the refile cache. -When GOTO is \\='(16) or a double \\[universal-argument] prefix argument, -go to the location of the last refiled item. +When called with `\\[universal-argument] \\[universal-argument]', \ +go to the location of the last +refiled item. + +When called with `\\[universal-argument] \\[universal-argument] \ +\\[universal-argument]' prefix or when GOTO is 0, clear +the refile cache. + RFLOC can be a refile location obtained in a different way. + When NO-UPDATE is non-nil, don't redo the agenda buffer." (interactive "P") (cond @@ -8558,13 +8547,11 @@ When NO-UPDATE is non-nil, don't redo the agenda buffer." (if goto "Goto" "Refile to") buffer org-refile-allow-creating-parent-nodes)))) (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (let ((org-agenda-buffer-name buffer-orig)) - (org-remove-subtree-entries-from-agenda)) - (org-refile goto buffer rfloc))))) + (org-with-wide-buffer + (goto-char marker) + (let ((org-agenda-buffer-name buffer-orig)) + (org-remove-subtree-entries-from-agenda)) + (org-refile goto buffer rfloc)))) (unless no-update (org-agenda-redo))))) (defun org-agenda-open-link (&optional arg) @@ -8589,13 +8576,11 @@ It also looks at the text of the entry itself." (setq trg (and (string-match org-bracket-link-regexp l) (match-string 1 l))) (if (or (not trg) (string-match org-any-link-re trg)) - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (when (search-forward l nil lkend) - (goto-char (match-beginning 0)) - (org-open-at-point)))) + (org-with-wide-buffer + (goto-char marker) + (when (search-forward l nil lkend) + (goto-char (match-beginning 0)) + (org-open-at-point))) ;; This is an internal link, widen the buffer (switch-to-buffer-other-window buffer) (widen) @@ -8615,8 +8600,9 @@ It also looks at the text of the entry itself." "Get a variable from a referenced buffer and install it here." (let ((m (org-get-at-bol 'org-marker))) (when (and m (buffer-live-p (marker-buffer m))) - (org-set-local var (with-current-buffer (marker-buffer m) - (symbol-value var)))))) + (set (make-local-variable var) + (with-current-buffer (marker-buffer m) + (symbol-value var)))))) (defun org-agenda-switch-to (&optional delete-other-windows) "Go to the Org mode file which contains the item at point. @@ -8632,7 +8618,7 @@ displayed Org file fills the frame." (buffer (marker-buffer marker)) (pos (marker-position marker))) (unless buffer (user-error "Trying to switch to non-existent buffer")) - (org-pop-to-buffer-same-window buffer) + (pop-to-buffer-same-window buffer) (when delete-other-windows (delete-other-windows)) (widen) (goto-char pos) @@ -8641,13 +8627,13 @@ displayed Org file fills the frame." (run-hooks 'org-agenda-after-show-hook))))) (defun org-agenda-goto-mouse (ev) - "Go to the Org-mode file which contains the item at the mouse click." + "Go to the Org file which contains the item at the mouse click." (interactive "e") (mouse-set-point ev) (org-agenda-goto)) (defun org-agenda-show (&optional full-entry) - "Display the Org-mode file which contains the item at point. + "Display the Org file which contains the item at point. With prefix argument FULL-ENTRY, make the entire entry visible if it was hidden in the outline." (interactive "P") @@ -8658,11 +8644,13 @@ if it was hidden in the outline." (defvar org-agenda-show-window nil) (defun org-agenda-show-and-scroll-up (&optional arg) - "Display the Org-mode file which contains the item at point. + "Display the Org file which contains the item at point. + When called repeatedly, scroll the window that is displaying the buffer. -With a \\[universal-argument] prefix, use `org-show-entry' instead of -`show-subtree' to display the item, so that drawers and logbooks stay -folded." + +With a `\\[universal-argument]' prefix, use `org-show-entry' instead of \ +`outline-show-subtree' +to display the item, so that drawers and logbooks stay folded." (interactive "P") (let ((win (selected-window))) (if (and (window-live-p org-agenda-show-window) @@ -8685,7 +8673,7 @@ folded." (select-window win)))) (defun org-agenda-show-1 (&optional more) - "Display the Org-mode file which contains the item at point. + "Display the Org file which contains the item at point. The prefix arg selects the amount of information to display: 0 hide the subtree @@ -8708,11 +8696,11 @@ if it was hidden in the outline." (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'folded)) (message "Remote: FOLDED")) - ((and (org-called-interactively-p 'any) (= more 1)) + ((and (called-interactively-p 'any) (= more 1)) (message "Remote: show with default settings")) ((= more 2) (outline-show-entry) - (outline-show-children) + (org-show-children) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'children)) @@ -8760,7 +8748,7 @@ docstring of `org-agenda-show-1'." (org-agenda-show-1 org-agenda-cycle-counter)) (defun org-agenda-recenter (arg) - "Display the Org-mode file which contains the item at point and recenter." + "Display the Org file which contains the item at point and recenter." (interactive "P") (let ((win (selected-window))) (org-agenda-goto t) @@ -8768,7 +8756,7 @@ docstring of `org-agenda-show-1'." (select-window win))) (defun org-agenda-show-mouse (ev) - "Display the Org-mode file which contains the item at the mouse click." + "Display the Org file which contains the item at the mouse click." (interactive "e") (mouse-set-point ev) (org-agenda-show)) @@ -8788,8 +8776,10 @@ This calls the command `org-tree-to-indirect-buffer' from the original buffer. With a numerical prefix ARG, go up to this level and then take that tree. With a negative numeric ARG, go up by this number of levels. -With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't -use the dedicated frame)." + +With a `\\[universal-argument]' prefix, make a separate frame for this tree, \ +i.e. don't use +the dedicated frame." (interactive "P") (if current-prefix-arg (org-agenda-do-tree-to-indirect-buffer arg) @@ -8837,9 +8827,9 @@ by a remote command from the agenda.") (org-agenda-todo 'previousset)) (defun org-agenda-todo (&optional arg) - "Cycle TODO state of line at point, also in Org-mode file. + "Cycle TODO state of line at point, also in Org file. This changes the line at point, all other lines in the agenda referring to -the same tree node, and the headline of the tree node in the Org-mode file." +the same tree node, and the headline of the tree node in the Org file." (interactive "P") (org-agenda-check-no-diary) (let* ((col (current-column)) @@ -8848,7 +8838,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (buffer (marker-buffer marker)) (pos (marker-position marker)) (hdmarker (org-get-at-bol 'org-hd-marker)) - (todayp (org-agenda-todayp (org-get-at-bol 'day))) + (todayp (org-agenda-today-p (org-get-at-bol 'day))) (inhibit-read-only t) org-agenda-headline-snapshot-before-repeat newhead just-one) (org-with-remote-undo buffer @@ -8856,14 +8846,11 @@ the same tree node, and the headline of the tree node in the Org-mode file." (widen) (goto-char pos) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading (let ((current-prefix-arg arg)) (call-interactively 'org-todo)) (and (bolp) (forward-char 1)) (setq newhead (org-get-heading)) - (when (and (org-bound-and-true-p + (when (and (bound-and-true-p org-agenda-headline-snapshot-before-repeat) (not (equal org-agenda-headline-snapshot-before-repeat newhead)) @@ -8876,7 +8863,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (beginning-of-line 1) (save-window-excursion (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) - (when (org-bound-and-true-p org-clock-out-when-done) + (when (bound-and-true-p org-clock-out-when-done) (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda)) newhead) (org-agenda-unmark-clocking-task)) @@ -8897,9 +8884,6 @@ the same tree node, and the headline of the tree node in the Org-mode file." (widen) (goto-char pos) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading (org-add-note)))) (defun org-agenda-change-all-lines (newhead hdmarker @@ -8916,9 +8900,9 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (line (org-current-line)) (org-agenda-buffer (current-buffer)) (thetags (with-current-buffer (marker-buffer hdmarker) - (save-excursion (save-restriction (widen) - (goto-char hdmarker) - (org-get-tags-at))))) + (org-with-wide-buffer + (goto-char hdmarker) + (org-get-tags-at)))) props m pl undone-face done-face finish new dotime level cat tags) (save-excursion (goto-char (point-max)) @@ -8939,20 +8923,25 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." org-prefix-format-compiled)) (extra (org-get-at-bol 'extra))) (with-current-buffer (marker-buffer hdmarker) - (save-excursion - (save-restriction - (widen) - (org-agenda-format-item extra newhead level cat tags dotime))))) + (org-with-wide-buffer + (org-agenda-format-item extra newhead level cat tags dotime)))) pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) undone-face (org-get-at-bol 'undone-face) done-face (org-get-at-bol 'done-face)) (beginning-of-line 1) (cond - ((equal new "") - (and (looking-at ".*\n?") (replace-match ""))) + ((equal new "") (delete-region (point) (line-beginning-position 2))) ((looking-at ".*") - (replace-match new t t) - (beginning-of-line 1) + ;; When replacing the whole line, preserve bulk mark + ;; overlay, if any. + (let ((mark (catch :overlay + (dolist (o (overlays-in (point) (+ 2 (point)))) + (when (eq (overlay-get o 'type) + 'org-marked-entry-overlay) + (throw :overlay o)))))) + (replace-match new t t) + (beginning-of-line) + (when mark (move-overlay mark (point) (+ 2 (point))))) (add-text-properties (point-at-bol) (point-at-eol) props) (when fixface (add-text-properties @@ -8973,7 +8962,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (let ((inhibit-read-only t) l c) (save-excursion (goto-char (if line (point-at-bol) (point-min))) - (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + (while (re-search-forward "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" (if line (point-at-eol) nil) t) (add-text-properties (match-beginning 2) (match-end 2) @@ -8997,19 +8986,19 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (org-font-lock-add-tag-faces (point-max))))) (defun org-agenda-priority-up () - "Increase the priority of line at point, also in Org-mode file." + "Increase the priority of line at point, also in Org file." (interactive) (org-agenda-priority 'up)) (defun org-agenda-priority-down () - "Decrease the priority of line at point, also in Org-mode file." + "Decrease the priority of line at point, also in Org file." (interactive) (org-agenda-priority 'down)) (defun org-agenda-priority (&optional force-direction) - "Set the priority of line at point, also in Org-mode file. + "Set the priority of line at point, also in Org file. This changes the line at point, all other lines in the agenda referring to -the same tree node, and the headline of the tree node in the Org-mode file. +the same tree node, and the headline of the tree node in the Org file. Called with a universal prefix arg, show the priority instead of setting it." (interactive "P") (if (equal force-direction '(4)) @@ -9030,9 +9019,6 @@ Called with a universal prefix arg, show the priority instead of setting it." (widen) (goto-char pos) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading (funcall 'org-priority force-direction) (end-of-line 1) (setq newhead (org-get-heading))) @@ -9044,7 +9030,7 @@ Called with a universal prefix arg, show the priority instead of setting it." "Set tags for the current headline." (interactive) (org-agenda-check-no-diary) - (if (and (org-region-active-p) (org-called-interactively-p 'any)) + (if (and (org-region-active-p) (called-interactively-p 'any)) (call-interactively 'org-change-tag-in-region) (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) (org-agenda-error))) @@ -9056,12 +9042,7 @@ Called with a universal prefix arg, show the priority instead of setting it." (with-current-buffer buffer (widen) (goto-char pos) - (save-excursion - (org-show-context 'agenda)) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (goto-char pos) + (org-show-context 'agenda) (if tag (org-toggle-tag tag onoff) (call-interactively 'org-set-tags)) @@ -9084,12 +9065,7 @@ Called with a universal prefix arg, show the priority instead of setting it." (with-current-buffer buffer (widen) (goto-char pos) - (save-excursion - (org-show-context 'agenda)) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (goto-char pos) + (org-show-context 'agenda) (call-interactively 'org-set-property))))) (defun org-agenda-set-effort () @@ -9106,12 +9082,7 @@ Called with a universal prefix arg, show the priority instead of setting it." (with-current-buffer buffer (widen) (goto-char pos) - (save-excursion - (org-show-context 'agenda)) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (goto-char pos) + (org-show-context 'agenda) (call-interactively 'org-set-effort) (end-of-line 1) (setq newhead (org-get-heading))) @@ -9132,9 +9103,6 @@ Called with a universal prefix arg, show the priority instead of setting it." (widen) (goto-char pos) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading (call-interactively 'org-toggle-archive-tag) (end-of-line 1) (setq newhead (org-get-heading))) @@ -9248,18 +9216,10 @@ Called with a universal prefix arg, show the priority instead of setting it." (when (equal marker (org-get-at-bol 'org-marker)) (remove-text-properties (point-at-bol) (point-at-eol) '(display)) (org-move-to-column (- (window-width) (length stamp)) t) - (if (featurep 'xemacs) - ;; Use `duplicable' property to trigger undo recording - (let ((ex (make-extent nil nil)) - (gl (make-glyph stamp))) - (set-glyph-face gl 'secondary-selection) - (set-extent-properties - ex (list 'invisible t 'end-glyph gl 'duplicable t)) - (insert-extent ex (1- (point)) (point-at-eol))) - (add-text-properties - (1- (point)) (point-at-eol) - (list 'display (org-add-props stamp nil - 'face '(secondary-selection default))))) + (add-text-properties + (1- (point)) (point-at-eol) + (list 'display (org-add-props stamp nil + 'face '(secondary-selection default)))) (beginning-of-line 1)) (beginning-of-line 0))))) @@ -9341,7 +9301,6 @@ ARG is passed through to `org-deadline'." (widen) (goto-char pos) (org-show-context 'agenda) - (org-show-entry) (org-cycle-hide-drawers 'children) (org-clock-in arg) (setq newhead (org-get-heading))) @@ -9356,14 +9315,12 @@ ARG is passed through to `org-deadline'." (let ((marker (make-marker)) (col (current-column)) newhead) (org-with-remote-undo (marker-buffer org-clock-marker) (with-current-buffer (marker-buffer org-clock-marker) - (save-excursion - (save-restriction - (widen) - (goto-char org-clock-marker) - (org-back-to-heading t) - (move-marker marker (point)) - (org-clock-out) - (setq newhead (org-get-heading)))))) + (org-with-wide-buffer + (goto-char org-clock-marker) + (org-back-to-heading t) + (move-marker marker (point)) + (org-clock-out) + (setq newhead (org-get-heading))))) (org-agenda-change-all-lines newhead marker) (move-marker marker nil) (org-move-to-column col) @@ -9390,7 +9347,7 @@ buffer, display it in another window." (cond (pos (goto-char pos)) ;; If the currently clocked entry is not in the agenda ;; buffer, we visit it in another window: - (org-clock-current-task + ((bound-and-true-p org-clock-current-task) (org-switch-to-buffer-other-window (org-clock-goto))) (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) @@ -9440,11 +9397,13 @@ buffer, display it in another window." "Where in `org-agenda-diary-file' should new entries be added? Valid values: -date-tree in the date tree, as child of the date -top-level as top-level entries at the end of the file." +date-tree in the date tree, as first child of the date +date-tree-last in the date tree, as last child of the date +top-level as top-level entries at the end of the file." :group 'org-agenda :type '(choice - (const :tag "in a date tree" date-tree) + (const :tag "first in a date tree" date-tree) + (const :tag "last in a date tree" date-tree-last) (const :tag "as top level at end of file" top-level))) (defcustom org-agenda-insert-diary-extract-time nil @@ -9545,24 +9504,30 @@ a timestamp can be added there." (insert text) (org-end-of-meta-data) (unless (bolp) (insert "\n")) - (when org-adapt-indentation (org-indent-to-column 2))) + (when org-adapt-indentation (indent-to-column 2))) (defun org-agenda-insert-diary-make-new-entry (text) - "Make a new entry with TEXT as the first child of the current subtree. + "Make a new entry with TEXT as a child of the current subtree. Position the point in the heading's first body line so that a timestamp can be added there." - (outline-next-heading) - (org-back-over-empty-lines) - (unless (looking-at "[ \t]*$") (save-excursion (insert "\n"))) - (org-insert-heading nil t) - (org-do-demote) + (cond + ((eq org-agenda-insert-diary-strategy 'date-tree-last) + (end-of-line) + (org-insert-heading '(4) t) + (org-do-demote)) + (t + (outline-next-heading) + (org-back-over-empty-lines) + (unless (looking-at "[ \t]*$") (save-excursion (insert "\n"))) + (org-insert-heading nil t) + (org-do-demote))) (let ((col (current-column))) (insert text) (org-end-of-meta-data) ;; Ensure point is left on a blank line, at proper indentation. (unless (bolp) (insert "\n")) - (unless (org-looking-at-p "^[ \t]*$") (save-excursion (insert "\n"))) - (when org-adapt-indentation (org-indent-to-column col))) + (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n"))) + (when org-adapt-indentation (indent-to-column col))) (org-show-set-visibility 'lineage)) (defun org-agenda-diary-entry () @@ -9570,7 +9535,7 @@ a timestamp can be added there." All the standard commands work: block, weekly etc. When `org-agenda-diary-file' points to a file, `org-agenda-diary-entry-in-org-file' is called instead to create -entries in that Org-mode file." +entries in that Org file." (interactive) (if (not (eq org-agenda-diary-file 'diary-file)) (org-agenda-diary-entry-in-org-file) @@ -9675,7 +9640,7 @@ argument, latitude and longitude will be prompted for." ;;;###autoload (defun org-calendar-goto-agenda () - "Compute the Org-mode agenda for the calendar date displayed at the cursor. + "Compute the Org agenda for the calendar date displayed at the cursor. This is a command that has to be installed in `calendar-mode-map'." (interactive) ;; Temporarily disable sticky agenda since user clearly wants to @@ -9717,6 +9682,7 @@ This is a command that has to be installed in `calendar-mode-map'." ;;; Bulk commands (defun org-agenda-bulk-marked-p () + "Non-nil when current entry is marked for bulk action." (eq (get-char-property (point-at-bol) 'type) 'org-marked-entry-overlay)) @@ -9758,9 +9724,12 @@ This is a command that has to be installed in `calendar-mode-map'." (goto-char (next-single-property-change (point) 'org-hd-marker)) (while (and (re-search-forward regexp nil t) (setq txt-at-point (get-text-property (point) 'txt))) - (when (string-match regexp txt-at-point) - (setq entries-marked (1+ entries-marked)) - (call-interactively 'org-agenda-bulk-mark)))) + (if (get-char-property (point) 'invisible) + (beginning-of-line 2) + (when (string-match regexp txt-at-point) + (setq entries-marked (1+ entries-marked)) + (call-interactively 'org-agenda-bulk-mark))))) + (if (not entries-marked) (message "No entry matching this regexp.")))) @@ -9893,21 +9862,21 @@ The prefix arg is passed through to the command if possible." redo-at-end t)) ((equal action ?t) - (setq state (org-icompleting-read + (setq state (completing-read "Todo state: " (with-current-buffer (marker-buffer (car entries)) - (mapcar 'list org-todo-keywords-1)))) + (mapcar #'list org-todo-keywords-1)))) (setq cmd `(let ((org-inhibit-blocking t) (org-inhibit-logging 'note)) (org-agenda-todo ,state)))) ((memq action '(?- ?+)) - (setq tag (org-icompleting-read + (setq tag (completing-read (format "Tag to %s: " (if (eq action ?+) "add" "remove")) (with-current-buffer (marker-buffer (car entries)) (delq nil - (mapcar (lambda (x) - (if (stringp (car x)) x)) org-tag-alist))))) + (mapcar (lambda (x) (and (stringp (car x)) x)) + org-current-tag-alist))))) (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) ((memq action '(?s ?d)) @@ -9917,8 +9886,15 @@ The prefix arg is passed through to the command if possible." nil nil nil (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to") org-overriding-default-time))) - (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) - (setq cmd `(eval '(,c1 arg ,time))))) + (c1 (if (eq action ?s) 'org-agenda-schedule + 'org-agenda-deadline))) + ;; Make sure to not prompt for a note when bulk + ;; rescheduling as Org cannot cope with simultaneous Org. + ;; Besides, it could be annoying depending on the number + ;; of items re-scheduled. + (setq cmd `(eval '(let ((org-log-reschedule + (and org-log-reschedule 'time))) + (,c1 arg ,time)))))) ((equal action ?S) (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) @@ -9935,13 +9911,13 @@ The prefix arg is passed through to the command if possible." (calendar-gregorian-from-absolute (org-today))))) (dotimes (i (1+ dist)) (while (member day-of-week org-agenda-weekend-days) - (incf distance) - (incf day-of-week) - (if (= day-of-week 7) - (setq day-of-week 0))) - (incf day-of-week) - (if (= day-of-week 7) - (setq day-of-week 0))))) + (cl-incf distance) + (cl-incf day-of-week) + (when (= day-of-week 7) + (setq day-of-week 0))) + (cl-incf day-of-week) + (when (= day-of-week 7) + (setq day-of-week 0))))) ;; silently fail when try to replan a sexp entry (condition-case nil (let* ((date (calendar-gregorian-from-absolute @@ -9957,8 +9933,8 @@ The prefix arg is passed through to the command if possible." ((equal action ?f) (setq cmd (list (intern - (org-icompleting-read "Function: " - obarray 'fboundp t nil nil))))) + (completing-read "Function: " + obarray 'fboundp t nil nil))))) (t (user-error "Invalid bulk action"))) @@ -10083,8 +10059,9 @@ tag and (if present) the flagging note." (replace-match "\n" t t)) (goto-char (point-min)) (select-window win) - (message (substitute-command-keys "Flagging note pushed to kill ring. \ -Press \\[org-agenda-show-the-flagging-note] again to remove tag and note"))))) + (message "%s" (substitute-command-keys "Flagging note pushed to \ +kill ring. Press `\\[org-agenda-show-the-flagging-note]' again to remove \ +tag and note"))))) (defun org-agenda-remove-flag (marker) "Remove the FLAGGED tag and any flagging note in the entry." @@ -10107,7 +10084,8 @@ Press \\[org-agenda-show-the-flagging-note] again to remove tag and note"))))) ;;;###autoload (defun org-agenda-to-appt (&optional refresh filter &rest args) "Activate appointments found in `org-agenda-files'. -With a \\[universal-argument] prefix, refresh the list of + +With a `\\[universal-argument]' prefix, refresh the list of \ appointments. If FILTER is t, interactively prompt the user for a regular @@ -10141,76 +10119,78 @@ to override `appt-message-warning-time'." (if refresh (setq appt-time-msg-list nil)) (if (eq filter t) (setq filter (read-from-minibuffer "Regexp filter: "))) - (let* ((cnt 0) ; count added events - (scope (or args '(:deadline* :scheduled* :timestamp))) - (org-agenda-new-buffers nil) - (org-deadline-warning-days 0) - ;; Do not use `org-today' here because appt only takes - ;; time and without date as argument, so it may pass wrong - ;; information otherwise - (today (org-date-to-gregorian - (time-to-days (current-time)))) - (org-agenda-restrict nil) - (files (org-agenda-files 'unrestricted)) entries file - (org-agenda-buffer nil)) + (let* ((cnt 0) ; count added events + (scope (or args '(:deadline* :scheduled* :timestamp))) + (org-agenda-new-buffers nil) + (org-deadline-warning-days 0) + ;; Do not use `org-today' here because appt only takes + ;; time and without date as argument, so it may pass wrong + ;; information otherwise + (today (org-date-to-gregorian + (time-to-days (current-time)))) + (org-agenda-restrict nil) + (files (org-agenda-files 'unrestricted)) entries file + (org-agenda-buffer nil)) ;; Get all entries which may contain an appt (org-agenda-prepare-buffers files) (while (setq file (pop files)) (setq entries - (delq nil - (append entries - (apply 'org-agenda-get-day-entries - file today scope))))) + (delq nil + (append entries + (apply 'org-agenda-get-day-entries + file today scope))))) ;; Map thru entries and find if we should filter them out (mapc - (lambda(x) + (lambda (x) (let* ((evt (org-trim - (replace-regexp-in-string - org-bracket-link-regexp "\\3" - (or (get-text-property 1 'txt x) "")))) - (cat (get-text-property (1- (length x)) 'org-category x)) - (tod (get-text-property 1 'time-of-day x)) - (ok (or (null filter) - (and (stringp filter) (string-match filter evt)) - (and (functionp filter) (funcall filter x)) - (and (listp filter) - (let ((cat-filter (cadr (assoc 'category filter))) - (evt-filter (cadr (assoc 'headline filter)))) - (or (and (stringp cat-filter) - (string-match cat-filter cat)) - (and (stringp evt-filter) - (string-match evt-filter evt))))))) - (wrn (get-text-property 1 'warntime x))) - ;; FIXME: Shall we remove text-properties for the appt text? - ;; (setq evt (set-text-properties 0 (length evt) nil evt)) - (when (and ok tod) - (setq tod (concat "00" (number-to-string tod)) - tod (when (string-match - "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) - (concat (match-string 1 tod) ":" - (match-string 2 tod)))) - (if (version< emacs-version "23.3") - (appt-add tod evt) - (appt-add tod evt wrn)) - (setq cnt (1+ cnt))))) entries) + (replace-regexp-in-string + org-bracket-link-regexp "\\3" + (or (get-text-property 1 'txt x) "")))) + (cat (get-text-property (1- (length x)) 'org-category x)) + (tod (get-text-property 1 'time-of-day x)) + (ok (or (null filter) + (and (stringp filter) (string-match filter evt)) + (and (functionp filter) (funcall filter x)) + (and (listp filter) + (let ((cat-filter (cadr (assq 'category filter))) + (evt-filter (cadr (assq 'headline filter)))) + (or (and (stringp cat-filter) + (string-match cat-filter cat)) + (and (stringp evt-filter) + (string-match evt-filter evt))))))) + (wrn (get-text-property 1 'warntime x))) + ;; FIXME: Shall we remove text-properties for the appt text? + ;; (setq evt (set-text-properties 0 (length evt) nil evt)) + (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt))) + (setq tod (concat "00" (number-to-string tod))) + (setq tod (when (string-match + "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) + (concat (match-string 1 tod) ":" + (match-string 2 tod)))) + (when (if (version< emacs-version "23.3") + (appt-add tod evt) + (appt-add tod evt wrn)) + (setq cnt (1+ cnt)))))) + entries) (org-release-buffers org-agenda-new-buffers) (if (eq cnt 0) - (message "No event to add") + (message "No event to add") (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))) -(defun org-agenda-todayp (date) - "Does DATE mean today, when considering `org-extend-today-until'?" - (let ((today (org-today)) - (date (if (and date (listp date)) (calendar-absolute-from-gregorian date) - date))) - (eq date today))) +(defun org-agenda-today-p (date) + "Non nil when DATE means today. +DATE is either a list of the form (month day year) or a number of +days as returned by `calendar-absolute-from-gregorian' or +`org-today'. This function considers `org-extend-today-until' +when defining today." + (eq (org-today) + (if (consp date) (calendar-absolute-from-gregorian date) date))) (defun org-agenda-todo-yesterday (&optional arg) "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday." (interactive "P") (let* ((org-use-effective-time t) - (hour (third (decode-time - (org-current-time)))) + (hour (nth 2 (decode-time (org-current-time)))) (org-extend-today-until (1+ hour))) (org-agenda-todo arg))) diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 4c6a8c3..6daed74 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -1,4 +1,4 @@ -;;; org-archive.el --- Archiving for Org-mode +;;; org-archive.el --- Archiving for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -30,8 +30,9 @@ (require 'org) -(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-element-type "org-element" (element)) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) +(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) (defcustom org-archive-default-command 'org-archive-subtree "The default archiving command." @@ -56,7 +57,7 @@ See `org-archive-to-archive-sibling' for more information." (defcustom org-archive-mark-done nil "Non-nil means mark entries as DONE when they are moved to the archive file. -This can be a string to set the keyword to use. When t, Org-mode will +This can be a string to set the keyword to use. When non-nil, Org will use the first keyword in its list that means done." :group 'org-archive :type '(choice @@ -159,21 +160,24 @@ archive file is." (defun org-all-archive-files () "Get a list of all archive files used in the current buffer." - (let (file files) - (save-excursion - (save-restriction - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)" - nil t) - (setq file (org-extract-archive-file - (org-match-string-no-properties 2))) - (and file (> (length file) 0) (file-exists-p file) - (add-to-list 'files file))))) + (let ((case-fold-search t) + files) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)" + nil t) + (when (save-match-data + (if (eq (match-string 1) ":") (org-at-property-p) + (eq (org-element-type (org-element-at-point)) 'keyword))) + (let ((file (org-extract-archive-file + (match-string-no-properties 2)))) + (when (and (org-string-nw-p file) (file-exists-p file)) + (push file files)))))) (setq files (nreverse files)) - (setq file (org-extract-archive-file)) - (and file (> (length file) 0) (file-exists-p file) - (add-to-list 'files file)) + (let ((file (org-extract-archive-file))) + (when (and (org-string-nw-p file) (file-exists-p file)) + (push file files))) files)) (defun org-extract-archive-file (&optional location) @@ -226,42 +230,30 @@ this heading." ((equal find-done '(16)) (org-archive-all-old)) (t ;; Save all relevant TODO keyword-relatex variables - (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler - (tr-org-todo-keywords-1 org-todo-keywords-1) - (tr-org-todo-kwd-alist org-todo-kwd-alist) - (tr-org-done-keywords org-done-keywords) - (tr-org-todo-regexp org-todo-regexp) - (tr-org-todo-line-regexp org-todo-line-regexp) - (tr-org-odd-levels-only org-odd-levels-only) - (this-buffer (current-buffer)) - ;; start of variables that will be used for saving context - ;; The compiler complains about them - keep them anyway! - (file (abbreviate-file-name - (or (buffer-file-name (buffer-base-buffer)) - (error "No file associated to buffer")))) - (olpath (mapconcat 'identity (org-get-outline-path) "/")) - (time (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1))) - category todo priority ltags itags atags - ;; end of variables that will be used for saving context - location afile heading buffer level newfile-p infile-p visiting - datetree-date datetree-subheading-p) - - ;; Find the local archive location - (setq location (org-get-local-archive-location) - afile (org-extract-archive-file location) - heading (org-extract-archive-heading location) - infile-p (equal file (abbreviate-file-name (or afile "")))) - (unless afile - (error "Invalid `org-archive-location'")) - - (if (> (length afile) 0) - (setq newfile-p (not (file-exists-p afile)) - visiting (find-buffer-visiting afile) - buffer (or visiting (find-file-noselect afile))) - (setq buffer (current-buffer))) - (unless buffer - (error "Cannot access file \"%s\"" afile)) + (let* ((tr-org-todo-keywords-1 org-todo-keywords-1) + (tr-org-todo-kwd-alist org-todo-kwd-alist) + (tr-org-done-keywords org-done-keywords) + (tr-org-todo-regexp org-todo-regexp) + (tr-org-todo-line-regexp org-todo-line-regexp) + (tr-org-odd-levels-only org-odd-levels-only) + (this-buffer (current-buffer)) + (time (format-time-string + (substring (cdr org-time-stamp-formats) 1 -1))) + (file (abbreviate-file-name + (or (buffer-file-name (buffer-base-buffer)) + (error "No file associated to buffer")))) + (location (org-get-local-archive-location)) + (afile (or (org-extract-archive-file location) + (error "Invalid `org-archive-location'"))) + (heading (org-extract-archive-heading location)) + (infile-p (equal file (abbreviate-file-name (or afile "")))) + (newfile-p (and (org-string-nw-p afile) + (not (file-exists-p afile)))) + (buffer (cond ((not (org-string-nw-p afile)) this-buffer) + ((find-buffer-visiting afile)) + ((find-file-noselect afile)) + (t (error "Cannot access file \"%s\"" afile)))) + level datetree-date datetree-subheading-p) (when (string-match "\\`datetree/" heading) ;; Replace with ***, to represent the 3 levels of headings the ;; datetree has. @@ -275,106 +267,115 @@ this heading." (setq heading nil level 0)) (save-excursion (org-back-to-heading t) - ;; Get context information that will be lost by moving the tree - (setq category (org-get-category nil 'force-refresh) - todo (and (looking-at org-todo-line-regexp) - (match-string 2)) - priority (org-get-priority - (if (match-end 3) (match-string 3) "")) - ltags (org-get-tags) - itags (org-delete-all ltags (org-get-tags-at)) - atags (org-get-tags-at)) - (setq ltags (mapconcat 'identity ltags " ") - itags (mapconcat 'identity itags " ")) - ;; We first only copy, in case something goes wrong - ;; we need to protect `this-command', to avoid kill-region sets it, - ;; which would lead to duplication of subtrees - (let (this-command) (org-copy-subtree 1 nil t)) - (set-buffer buffer) - ;; Enforce org-mode for the archive buffer - (if (not (derived-mode-p 'org-mode)) - ;; Force the mode for future visits. - (let ((org-insert-mode-line-in-empty-file t) - (org-inhibit-startup t)) - (call-interactively 'org-mode))) - (when (and newfile-p org-archive-file-header-format) - (goto-char (point-max)) - (insert (format org-archive-file-header-format - (buffer-file-name this-buffer)))) - (when datetree-date - (require 'org-datetree) - (org-datetree-find-date-create datetree-date) - (org-narrow-to-subtree)) - ;; Force the TODO keywords of the original buffer - (let ((org-todo-line-regexp tr-org-todo-line-regexp) - (org-todo-keywords-1 tr-org-todo-keywords-1) - (org-todo-kwd-alist tr-org-todo-kwd-alist) - (org-done-keywords tr-org-done-keywords) - (org-todo-regexp tr-org-todo-regexp) - (org-todo-line-regexp tr-org-todo-line-regexp) - (org-odd-levels-only - (if (local-variable-p 'org-odd-levels-only (current-buffer)) - org-odd-levels-only - tr-org-odd-levels-only))) - (goto-char (point-min)) - (outline-show-all) - (if (and heading (not (and datetree-date (not datetree-subheading-p)))) - (progn - (if (re-search-forward - (concat "^" (regexp-quote heading) - (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")) - nil t) - (goto-char (match-end 0)) - ;; Heading not found, just insert it at the end - (goto-char (point-max)) - (or (bolp) (insert "\n")) - ;; datetrees don't need too much spacing - (insert (if datetree-date "" "\n") heading "\n") - (end-of-line 0)) - ;; Make the subtree visible - (outline-show-subtree) - (if org-archive-reversed-order - (progn - (org-back-to-heading t) - (outline-next-heading)) - (org-end-of-subtree t)) - (skip-chars-backward " \t\r\n") - (and (looking-at "[ \t\r\n]*") - ;; datetree archives don't need so much spacing. - (replace-match (if datetree-date "\n" "\n\n")))) - ;; No specific heading, just go to end of file. - (goto-char (point-max)) (unless datetree-date (insert "\n"))) - ;; Paste - (org-paste-subtree (org-get-valid-level level (and heading 1))) - ;; Shall we append inherited tags? - (and itags - (or (and (eq org-archive-subtree-add-inherited-tags 'infile) - infile-p) - (eq org-archive-subtree-add-inherited-tags t)) - (org-set-tags-to atags)) - ;; Mark the entry as done - (when (and org-archive-mark-done - (looking-at org-todo-line-regexp) - (or (not (match-end 2)) - (not (member (match-string 2) org-done-keywords)))) - (let (org-log-done org-todo-log-states) - (org-todo - (car (or (member org-archive-mark-done org-done-keywords) - org-done-keywords))))) - - ;; Add the context info - (when org-archive-save-context-info - (let ((l org-archive-save-context-info) e n v) - (while (setq e (pop l)) - (when (and (setq v (symbol-value e)) - (stringp v) (string-match "\\S-" v)) - (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) - (org-entry-put (point) n v))))) - - (widen) - ;; Save and kill the buffer, if it is not the same buffer. - (when (not (eq this-buffer buffer)) - (save-buffer)))) + ;; Get context information that will be lost by moving the + ;; tree. See `org-archive-save-context-info'. + (let* ((all-tags (org-get-tags-at)) + (local-tags (org-get-tags)) + (inherited-tags (org-delete-all local-tags all-tags)) + (context + `((category . ,(org-get-category nil 'force-refresh)) + (file . ,file) + (itags . ,(mapconcat #'identity inherited-tags " ")) + (ltags . ,(mapconcat #'identity local-tags " ")) + (olpath . ,(mapconcat #'identity + (org-get-outline-path) + "/")) + (time . ,time) + (todo . ,(org-entry-get (point) "TODO"))))) + ;; We first only copy, in case something goes wrong + ;; we need to protect `this-command', to avoid kill-region sets it, + ;; which would lead to duplication of subtrees + (let (this-command) (org-copy-subtree 1 nil t)) + (set-buffer buffer) + ;; Enforce Org mode for the archive buffer + (if (not (derived-mode-p 'org-mode)) + ;; Force the mode for future visits. + (let ((org-insert-mode-line-in-empty-file t) + (org-inhibit-startup t)) + (call-interactively 'org-mode))) + (when (and newfile-p org-archive-file-header-format) + (goto-char (point-max)) + (insert (format org-archive-file-header-format + (buffer-file-name this-buffer)))) + (when datetree-date + (require 'org-datetree) + (org-datetree-find-date-create datetree-date) + (org-narrow-to-subtree)) + ;; Force the TODO keywords of the original buffer + (let ((org-todo-line-regexp tr-org-todo-line-regexp) + (org-todo-keywords-1 tr-org-todo-keywords-1) + (org-todo-kwd-alist tr-org-todo-kwd-alist) + (org-done-keywords tr-org-done-keywords) + (org-todo-regexp tr-org-todo-regexp) + (org-todo-line-regexp tr-org-todo-line-regexp) + (org-odd-levels-only + (if (local-variable-p 'org-odd-levels-only (current-buffer)) + org-odd-levels-only + tr-org-odd-levels-only))) + (goto-char (point-min)) + (outline-show-all) + (if (and heading (not (and datetree-date (not datetree-subheading-p)))) + (progn + (if (re-search-forward + (concat "^" (regexp-quote heading) + "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)") + nil t) + (goto-char (match-end 0)) + ;; Heading not found, just insert it at the end + (goto-char (point-max)) + (or (bolp) (insert "\n")) + ;; datetrees don't need too much spacing + (insert (if datetree-date "" "\n") heading "\n") + (end-of-line 0)) + ;; Make the subtree visible + (outline-show-subtree) + (if org-archive-reversed-order + (progn + (org-back-to-heading t) + (outline-next-heading)) + (org-end-of-subtree t)) + (skip-chars-backward " \t\r\n") + (and (looking-at "[ \t\r\n]*") + ;; datetree archives don't need so much spacing. + (replace-match (if datetree-date "\n" "\n\n")))) + ;; No specific heading, just go to end of file. + (goto-char (point-max)) + ;; Subtree narrowing can let the buffer end on + ;; a headline. `org-paste-subtree' then deletes it. + ;; To prevent this, make sure visible part of buffer + ;; always terminates on a new line, while limiting + ;; number of blank lines in a date tree. + (unless (and datetree-date (bolp)) (insert "\n"))) + ;; Paste + (org-paste-subtree (org-get-valid-level level (and heading 1))) + ;; Shall we append inherited tags? + (and inherited-tags + (or (and (eq org-archive-subtree-add-inherited-tags 'infile) + infile-p) + (eq org-archive-subtree-add-inherited-tags t)) + (org-set-tags-to all-tags)) + ;; Mark the entry as done + (when (and org-archive-mark-done + (looking-at org-todo-line-regexp) + (or (not (match-end 2)) + (not (member (match-string 2) org-done-keywords)))) + (let (org-log-done org-todo-log-states) + (org-todo + (car (or (member org-archive-mark-done org-done-keywords) + org-done-keywords))))) + + ;; Add the context info. + (dolist (item org-archive-save-context-info) + (let ((value (cdr (assq item context)))) + (when (org-string-nw-p value) + (org-entry-put + (point) + (concat "ARCHIVE_" (upcase (symbol-name item))) + value)))) + (widen) + ;; Save and kill the buffer, if it is not the same + ;; buffer. + (unless (eq this-buffer buffer) (save-buffer))))) ;; Here we are back in the original buffer. Everything seems ;; to have worked. So now run hooks, cut the tree and finish ;; up. @@ -467,7 +468,7 @@ If the cursor is not on a headline, try all level 1 trees. If it is on a headline, try all direct children. When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." (org-archive-all-matches - (lambda (beg end) + (lambda (_beg end) (unless (re-search-forward org-not-done-heading-regexp end t) "no open TODO items")) tag)) @@ -478,7 +479,7 @@ If the cursor is not on a headline, try all level 1 trees. If it is on a headline, try all direct children. When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." (org-archive-all-matches - (lambda (beg end) + (lambda (_beg end) (let (ts) (and (re-search-forward org-ts-regexp end t) (setq ts (match-string 0)) diff --git a/lisp/org-attach.el b/lisp/org-attach.el index e237b2c..d6e587d 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -1,4 +1,4 @@ -;;; org-attach.el --- Manage file attachments to org-mode tasks +;;; org-attach.el --- Manage file attachments to Org tasks -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. @@ -22,7 +22,7 @@ ;;; Commentary: -;; See the Org-mode manual for information on how to use it. +;; See the Org manual for information on how to use it. ;; ;; Attachments are managed in a special directory called "data", which ;; lives in the same directory as the org file itself. If this data @@ -37,14 +37,13 @@ ;;; Code: -(eval-when-compile - (require 'cl)) -(require 'org-id) +(require 'cl-lib) (require 'org) +(require 'org-id) (require 'vc-git) (defgroup org-attach nil - "Options concerning entry attachments in Org-mode." + "Options concerning entry attachments in Org mode." :tag "Org Attach" :group 'org) @@ -55,6 +54,14 @@ where the Org file lives." :group 'org-attach :type 'directory) +(defcustom org-attach-commit t + "If non-nil commit attachments with git. +This is only done if the Org file is in a git repository." + :group 'org-attach + :type 'boolean + :version "25.2" + :package-version '(Org . "9.0")) + (defcustom org-attach-git-annex-cutoff (* 32 1024) "If non-nil, files larger than this will be annexed instead of stored." :group 'org-attach @@ -124,13 +131,24 @@ lns create a symbol link. Note that this is not supported "Non-nil means attachments are deleted upon archiving a subtree. When set to `query', ask the user instead." :group 'org-attach - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(choice (const :tag "Never delete attachments" nil) (const :tag "Always delete attachments" t) (const :tag "Query the user" query))) +(defcustom org-attach-annex-auto-get 'ask + "Confirmation preference for automatically getting annex files. +If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get." + :group 'org-attach + :package-version '(Org . "9") + :version "25.2" + :type '(choice + (const :tag "confirm with `y-or-n-p'" ask) + (const :tag "always get from annex if necessary" t) + (const :tag "never get from annex" nil))) + ;;;###autoload (defun org-attach () "The dispatcher for attachment commands. @@ -208,25 +226,23 @@ using the entry ID will be invoked to access the unique directory for the current entry. If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil, the directory and (if necessary) the corresponding ID will be created." - (let (attach-dir uuid inherit) + (let (attach-dir uuid) (setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT")) (cond ((setq attach-dir (org-entry-get nil "ATTACH_DIR")) (org-attach-check-absolute-path attach-dir)) ((and org-attach-allow-inheritance - (setq inherit (org-entry-get nil "ATTACH_DIR_INHERIT" t))) + (org-entry-get nil "ATTACH_DIR_INHERIT" t)) (setq attach-dir - (save-excursion - (save-restriction - (widen) - (if (marker-position org-entry-property-inherited-from) - (goto-char org-entry-property-inherited-from) - (org-back-to-heading t)) - (let (org-attach-allow-inheritance) - (org-attach-dir create-if-not-exists-p))))) + (org-with-wide-buffer + (if (marker-position org-entry-property-inherited-from) + (goto-char org-entry-property-inherited-from) + (org-back-to-heading t)) + (let (org-attach-allow-inheritance) + (org-attach-dir create-if-not-exists-p)))) (org-attach-check-absolute-path attach-dir) (setq org-attach-inherited t)) - (t ; use the ID + (t ; use the ID (org-attach-check-absolute-path nil) (setq uuid (org-id-get (point) create-if-not-exists-p)) (when (or uuid create-if-not-exists-p) @@ -272,34 +288,59 @@ the ATTACH_DIR property) their own attachment directory." (org-entry-put nil "ATTACH_DIR_INHERIT" "t") (message "Children will inherit attachment directory")) +(defun org-attach-use-annex () + "Return non-nil if git annex can be used." + (let ((git-dir (vc-git-root (expand-file-name org-attach-directory)))) + (and org-attach-git-annex-cutoff + (or (file-exists-p (expand-file-name "annex" git-dir)) + (file-exists-p (expand-file-name ".git/annex" git-dir)))))) + +(defun org-attach-annex-get-maybe (path) + "Call git annex get PATH (via shell) if using git annex. +Signals an error if the file content is not available and it was not retrieved." + (let ((path-relative (file-relative-name path))) + (when (and (org-attach-use-annex) + (not + (string-equal + "found" + (shell-command-to-string + (format "git annex find --format=found --in=here %s" + (shell-quote-argument path-relative)))))) + (let ((should-get + (if (eq org-attach-annex-auto-get 'ask) + (y-or-n-p (format "Run git annex get %s? " path-relative)) + org-attach-annex-auto-get))) + (if should-get + (progn (message "Running git annex get \"%s\"." path-relative) + (call-process "git" nil nil nil "annex" "get" path-relative)) + (error "File %s stored in git annex but it is not available, and was not retrieved" + path)))))) + (defun org-attach-commit () "Commit changes to git if `org-attach-directory' is properly initialized. This checks for the existence of a \".git\" directory in that directory." (let* ((dir (expand-file-name org-attach-directory)) (git-dir (vc-git-root dir)) + (use-annex (org-attach-use-annex)) (changes 0)) (when (and git-dir (executable-find "git")) (with-temp-buffer (cd dir) - (let ((have-annex - (and org-attach-git-annex-cutoff - (or (file-exists-p (expand-file-name "annex" git-dir)) - (file-exists-p (expand-file-name ".git/annex" git-dir)))))) - (dolist (new-or-modified - (split-string - (shell-command-to-string - "git ls-files -zmo --exclude-standard") "\0" t)) - (if (and have-annex - (>= (nth 7 (file-attributes new-or-modified)) - org-attach-git-annex-cutoff)) - (call-process "git" nil nil nil "annex" "add" new-or-modified) - (call-process "git" nil nil nil "add" new-or-modified)) - (incf changes))) + (dolist (new-or-modified + (split-string + (shell-command-to-string + "git ls-files -zmo --exclude-standard") "\0" t)) + (if (and use-annex + (>= (nth 7 (file-attributes new-or-modified)) + org-attach-git-annex-cutoff)) + (call-process "git" nil nil nil "annex" "add" new-or-modified) + (call-process "git" nil nil nil "add" new-or-modified)) + (cl-incf changes)) (dolist (deleted (split-string (shell-command-to-string "git ls-files -z --deleted") "\0" t)) (call-process "git" nil nil nil "rm" deleted) - (incf changes)) + (cl-incf changes)) (when (> changes 0) (shell-command "git commit -m 'Synchronized attachments'")))))) @@ -340,7 +381,8 @@ METHOD may be `cp', `mv', `ln', or `lns' default taken from ((eq method 'cp) (copy-file file fname)) ((eq method 'ln) (add-name-to-file file fname)) ((eq method 'lns) (make-symbolic-link file fname))) - (org-attach-commit) + (when org-attach-commit + (org-attach-commit)) (org-attach-tag) (cond ((eq org-attach-store-link-p 'attached) (org-attach-store-link fname)) @@ -390,7 +432,7 @@ The attachment is created as an Emacs buffer." (let* ((attach-dir (org-attach-dir t)) (files (org-attach-file-list attach-dir)) (file (or file - (org-icompleting-read + (completing-read "Delete attachment: " (mapcar (lambda (f) (list (file-name-nondirectory f))) @@ -466,9 +508,11 @@ If IN-EMACS is non-nil, force opening in Emacs." (files (org-attach-file-list attach-dir)) (file (if (= (length files) 1) (car files) - (org-icompleting-read "Open attachment: " - (mapcar 'list files) nil t)))) - (org-open-file (expand-file-name file attach-dir) in-emacs))) + (completing-read "Open attachment: " + (mapcar #'list files) nil t))) + (path (expand-file-name file attach-dir))) + (org-attach-annex-get-maybe path) + (org-open-file path in-emacs))) (defun org-attach-open-in-emacs () "Open attachment, force opening in Emacs. diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el index aeee35f..dd9ef26 100644 --- a/lisp/org-bbdb.el +++ b/lisp/org-bbdb.el @@ -1,4 +1,4 @@ -;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode +;;; org-bbdb.el --- Support for links to BBDB entries -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -25,12 +25,12 @@ ;; ;;; Commentary: -;; This file implements links to BBDB database entries from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; This file implements links to BBDB database entries from within Org. +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;; It also implements an interface (based on Ivar Rummelhoff's -;; bbdb-anniv.el) for those org-mode users, who do not use the diary +;; bbdb-anniv.el) for those Org users, who do not use the diary ;; but who do want to include the anniversaries stored in the BBDB ;; into the org-agenda. If you already include the `diary' into the ;; agenda, you might want to prefer to include the anniversaries in @@ -94,8 +94,7 @@ ;;; Code: (require 'org) -(eval-when-compile - (require 'cl)) +(require 'cl-lib) ;; Declare external functions and variables @@ -106,6 +105,7 @@ (declare-function bbdb-name "ext:bbdb-com" (string elidep)) (declare-function bbdb-completing-read-record "ext:bbdb-com" (prompt &optional omit-records)) +(declare-function bbdb-record-field "ext:bbdb" (recond field)) (declare-function bbdb-record-getprop "ext:bbdb" (record property)) (declare-function bbdb-record-name "ext:bbdb" (record)) (declare-function bbdb-records "ext:bbdb" @@ -124,7 +124,7 @@ (declare-function calendar-leap-year-p "calendar" (year)) (declare-function diary-ordinal-suffix "diary-lib" (n)) -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el +(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el ;; Customization @@ -194,10 +194,12 @@ date year)." :group 'org-bbdb-anniversaries :require 'bbdb) - ;; Install the link type -(org-add-link-type "bbdb" 'org-bbdb-open 'org-bbdb-export) -(add-hook 'org-store-link-functions 'org-bbdb-store-link) +(org-link-set-parameters "bbdb" + :follow #'org-bbdb-open + :export #'org-bbdb-export + :complete #'org-bbdb-complete-link + :store #'org-bbdb-store-link) ;; Implementation (defun org-bbdb-store-link () @@ -208,7 +210,7 @@ date year)." (name (bbdb-record-name rec)) (company (if (fboundp 'bbdb-record-getprop) (bbdb-record-getprop rec 'company) - (car (bbdb-record-get-field rec 'organization)))) + (car (bbdb-record-field rec 'organization)))) (link (concat "bbdb:" name))) (org-store-link-props :type "bbdb" :name name :company company :link link :description name) @@ -230,10 +232,9 @@ italicized, in all other cases it is left unchanged." (defun org-bbdb-open (name) "Follow a BBDB link to NAME." (require 'bbdb-com) - (let ((inhibit-redisplay (not debug-on-error)) - (bbdb-electric-p nil)) + (let ((inhibit-redisplay (not debug-on-error))) (if (fboundp 'bbdb-name) - (org-bbdb-open-old name) + (org-bbdb-open-old name) (org-bbdb-open-new name)))) (defun org-bbdb-open-old (name) @@ -280,14 +281,11 @@ italicized, in all other cases it is left unchanged." "Convert YYYY-MM-DD to (month date year). Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted it will be considered unknown." - (multiple-value-bind (a b c) (values-list (org-split-string time-str "-")) - (if (eq c nil) - (list (string-to-number a) - (string-to-number b) - nil) - (list (string-to-number b) - (string-to-number c) - (string-to-number a))))) + (pcase (org-split-string time-str "-") + (`(,a ,b nil) (list (string-to-number a) (string-to-number b) nil)) + (`(,a ,b ,c) (list (string-to-number b) + (string-to-number c) + (string-to-number a))))) (defun org-bbdb-anniv-split (str) "Split multiple entries in the BBDB anniversary field. @@ -325,9 +323,9 @@ The anniversaries are assumed to be stored `org-bbdb-anniversary-field'." (bbdb-split "\n" annivs))) (while annivs (setq split (org-bbdb-anniv-split (pop annivs))) - (multiple-value-bind (m d y) - (values-list (funcall org-bbdb-extract-date-fun (car split))) - (setq tmp (gethash (list m d) org-bbdb-anniv-hash)) + (pcase-let ((`(,m ,d ,y) (funcall org-bbdb-extract-date-fun + (car split)))) + (setq tmp (gethash (list m d) org-bbdb-anniv-hash)) (puthash (list m d) (cons (list y (bbdb-record-name rec) (cadr split)) @@ -335,7 +333,7 @@ The anniversaries are assumed to be stored `org-bbdb-anniversary-field'." org-bbdb-anniv-hash)))))) (setq org-bbdb-updated-p nil)) -(defun org-bbdb-updated (rec) +(defun org-bbdb-updated (_rec) "Record the fact that BBDB has been updated. This is used by Org to re-create the anniversary hash table." (setq org-bbdb-updated-p t)) @@ -397,6 +395,66 @@ This is used by Org to re-create the anniversary hash table." )) text)) +;;; Return list of anniversaries for today and the next n-1 (default: n=7) days. +;;; This is meant to be used in an org file instead of org-bbdb-anniversaries: +;;; +;;; %%(org-bbdb-anniversaries-future) +;;; +;;; or +;;; +;;; %%(org-bbdb-anniversaries-future 3) +;;; +;;; to override the 7-day default. + +(defun org-bbdb-date-list (d n) + "Return a list of dates in (m d y) format from the given date D to n-1 days hence." + (let ((abs (calendar-absolute-from-gregorian d))) + (mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i))) + (number-sequence 0 (1- n))))) + +;;;###autoload +(defun org-bbdb-anniversaries-future (&optional n) + "Return list of anniversaries for today and the next n-1 days (default n=7)." + (let ((n (or n 7))) + (when (<= n 0) + (error "The (optional) argument of `org-bbdb-anniversaries-future' \ +must be positive")) + (let ( + ;; List of relevant dates. + (dates (org-bbdb-date-list date n)) + ;; Function to annotate text of each element of l with the + ;; anniversary date d. + (annotate-descriptions + (lambda (d l) + (mapcar (lambda (x) + ;; The assumption here is that x is a bbdb link + ;; of the form [[bbdb:name][description]]. + ;; This function rather arbitrarily modifies + ;; the description by adding the date to it in + ;; a fixed format. + (string-match "]]" x) + (replace-match (format " -- %d-%02d-%02d\\&" + (nth 2 d) + (nth 0 d) + (nth 1 d)) + nil nil x)) + l)))) + ;; Map a function that generates anniversaries for each date + ;; over the dates and nconc the results into a single list. When + ;; it is no longer necessary to support older versions of Emacs, + ;; this can be done with a cl-mapcan; for now, we use the (apply + ;; #'nconc ...) method for compatibility. + (apply #'nconc + (mapcar + (lambda (d) + (let ((date d)) + ;; Rebind 'date' so that org-bbdb-anniversaries will + ;; be fooled into giving us the list for the given + ;; date and then annotate the descriptions for that + ;; date. + (funcall annotate-descriptions d (org-bbdb-anniversaries)))) + dates))))) + (defun org-bbdb-complete-link () "Read a bbdb link with name completion." (require 'bbdb-com) diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el index a1cd8b0..db5d97b 100644 --- a/lisp/org-bibtex.el +++ b/lisp/org-bibtex.el @@ -1,4 +1,4 @@ -;;; org-bibtex.el --- Org links to BibTeX entries +;;; org-bibtex.el --- Org links to BibTeX entries -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2007-2016 Free Software Foundation, Inc. ;; @@ -73,7 +73,7 @@ ;; ===================================================================== ;; ;; Additionally, the following functions are now available for storing -;; bibtex entries within Org-mode documents. +;; bibtex entries within Org documents. ;; ;; - Run `org-bibtex' to export the current file to a .bib. ;; @@ -92,27 +92,28 @@ ;; ;;; History: ;; -;; The link creation part has been part of Org-mode for a long time. +;; The link creation part has been part of Org for a long time. ;; ;; Creating better capture template information was inspired by a request ;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112 ;; and then implemented by Bastien Guerry. ;; ;; Eric Schulte eventually added the functions for translating between -;; Org-mode headlines and Bibtex entries, and for fleshing out the Bibtex -;; fields of existing Org-mode headlines. +;; Org headlines and Bibtex entries, and for fleshing out the Bibtex +;; fields of existing Org headlines. ;; -;; Org-mode loads this module by default - if this is not what you want, +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;;; Code: (require 'org) (require 'bibtex) -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'org-compat) +(defvar org-agenda-overriding-header) +(defvar org-agenda-search-view-always-boolean) (defvar org-bibtex-description nil) ; dynamically scoped from org.el (defvar org-id-locations) @@ -120,7 +121,6 @@ (declare-function bibtex-generate-autokey "bibtex" ()) (declare-function bibtex-parse-entry "bibtex" (&optional content)) (declare-function bibtex-url "bibtex" (&optional pos no-browse)) -(declare-function org-babel-trim "ob" (string &optional regexp)) ;;; Bibtex data @@ -293,7 +293,7 @@ It is relevant only if `org-bibtex-tags-are-keywords' is non-nil. Tag inheritence itself is controlled by `org-use-tag-inheritence' and `org-exclude-tags-from-inheritence'." :group 'org-bibtex - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type 'boolean) @@ -312,7 +312,7 @@ and `org-exclude-tags-from-inheritence'." (org-entry-get (point) (upcase property)) (org-entry-get (point) (concat org-bibtex-prefix (upcase property))))))) - (when it (org-babel-trim it)))) + (when it (org-trim it)))) (defun org-bibtex-put (property value) (let ((prop (upcase (if (keywordp property) @@ -325,29 +325,27 @@ and `org-exclude-tags-from-inheritence'." (defun org-bibtex-headline () "Return a bibtex entry of the given headline as a string." - (let* ((val (lambda (key lst) (cdr (assoc key lst)))) - (to (lambda (string) (intern (concat ":" string)))) - (from (lambda (key) (substring (symbol-name key) 1))) - flatten ; silent compiler warning - (flatten (lambda (&rest lsts) - (apply #'append (mapcar - (lambda (e) - (if (listp e) (apply flatten e) (list e))) - lsts)))) - (notes (buffer-string)) - (id (org-bibtex-get org-bibtex-key-property)) - (type (org-bibtex-get org-bibtex-type-property-name)) - (tags (when org-bibtex-tags-are-keywords - (delq nil - (mapcar - (lambda (tag) - (unless (member tag - (append org-bibtex-tags - org-bibtex-no-export-tags)) - tag)) - (if org-bibtex-inherit-tags - (org-get-tags-at) - (org-get-local-tags-at))))))) + (letrec ((val (lambda (key lst) (cdr (assoc key lst)))) + (to (lambda (string) (intern (concat ":" string)))) + (from (lambda (key) (substring (symbol-name key) 1))) + (flatten (lambda (&rest lsts) + (apply #'append (mapcar + (lambda (e) + (if (listp e) (apply flatten e) (list e))) + lsts)))) + (id (org-bibtex-get org-bibtex-key-property)) + (type (org-bibtex-get org-bibtex-type-property-name)) + (tags (when org-bibtex-tags-are-keywords + (delq nil + (mapcar + (lambda (tag) + (unless (member tag + (append org-bibtex-tags + org-bibtex-no-export-tags)) + tag)) + (if org-bibtex-inherit-tags + (org-get-tags-at) + (org-get-local-tags-at))))))) (when type (let ((entry (format "@%s{%s,\n%s\n}\n" type id @@ -373,7 +371,7 @@ and `org-exclude-tags-from-inheritence'." (mapcar (lambda (field) (let ((value (or (org-bibtex-get (funcall from field)) - (and (equal :title field) + (and (eq :title field) (nth 4 (org-heading-components)))))) (when value (cons (funcall from field) value)))) (funcall flatten @@ -436,13 +434,14 @@ With optional argument OPTIONAL, also prompt for optional fields." (funcall val :required (funcall val type org-bibtex-types))) (when optional (funcall val :optional (funcall val type org-bibtex-types))))) (when (consp field) ; or'd pair of fields e.g., (:editor :author) - (let ((present (first (remove + (let ((present (nth 0 (remove nil (mapcar - (lambda (f) (when (org-bibtex-get (funcall name f)) f)) + (lambda (f) + (when (org-bibtex-get (funcall name f)) f)) field))))) (setf field (or present (funcall keyword - (org-icompleting-read + (completing-read "Field: " (mapcar name field))))))) (let ((name (funcall name field))) (unless (org-bibtex-get name) @@ -454,8 +453,9 @@ With optional argument OPTIONAL, also prompt for optional fields." ;;; Bibtex link functions -(org-add-link-type "bibtex" 'org-bibtex-open) -(add-hook 'org-store-link-functions 'org-bibtex-store-link) +(org-link-set-parameters "bibtex" + :follow #'org-bibtex-open + :store #'org-bibtex-store-link) (defun org-bibtex-open (path) "Visit the bibliography entry on PATH." @@ -548,7 +548,7 @@ With optional argument OPTIONAL, also prompt for optional fields." (add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex) -;;; Bibtex <-> Org-mode headline translation functions +;;; Bibtex <-> Org headline translation functions (defun org-bibtex (filename) "Export each headline in the current file to a bibtex entry. Headlines are exported using `org-bibtex-headline'." @@ -564,7 +564,7 @@ Headlines are exported using `org-bibtex-headline'." (let ((bibtex-entries (remove nil (org-map-entries (lambda () - (condition-case foo + (condition-case nil (org-bibtex-headline) (error (throw 'bib (point))))))))) (with-temp-file filename @@ -595,7 +595,7 @@ With prefix argument OPTIONAL also prompt for optional fields." With a prefix arg, query for optional fields as well. If nonew is t, add data to the headline of the entry at point." (interactive "P") - (let* ((type (org-icompleting-read + (let* ((type (completing-read "Type: " (mapcar (lambda (type) (substring (symbol-name (car type)) 1)) org-bibtex-types) @@ -614,7 +614,7 @@ If nonew is t, add data to the headline of the entry at point." (org-bibtex-put org-bibtex-type-property-name (substring (symbol-name type) 1)) (org-bibtex-fleshout type arg) - (mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags))) + (dolist (tag org-bibtex-tags) (org-toggle-tag tag 'on)))) (defun org-bibtex-create-in-current-entry (&optional arg) "Add bibliographical data to the current entry. @@ -628,10 +628,10 @@ This uses `bibtex-parse-entry'." (interactive) (let ((keyword (lambda (str) (intern (concat ":" (downcase str))))) (clean-space (lambda (str) (replace-regexp-in-string - "[[:space:]\n\r]+" " " str))) + "[[:space:]\n\r]+" " " str))) (strip-delim - (lambda (str) ; strip enclosing "..." and {...} - (dolist (pair '((34 . 34) (123 . 125) (123 . 125))) + (lambda (str) ; strip enclosing "..." and {...} + (dolist (pair '((34 . 34) (123 . 125))) (when (and (> (length str) 1) (= (aref str 0) (car pair)) (= (aref str (1- (length str))) (cdr pair))) @@ -639,10 +639,10 @@ This uses `bibtex-parse-entry'." (push (mapcar (lambda (pair) (cons (let ((field (funcall keyword (car pair)))) - (case field + (pcase field (:=type= :type) (:=key= :key) - (otherwise field))) + (_ field))) (funcall clean-space (funcall strip-delim (cdr pair))))) (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry))) org-bibtex-entries))) @@ -683,25 +683,23 @@ Return the number of saved entries." (org-bibtex-put org-bibtex-type-property-name (downcase (funcall val :type))) (dolist (pair entry) - (case (car pair) + (pcase (car pair) (:title nil) (:type nil) (:key (org-bibtex-put org-bibtex-key-property (cdr pair))) (:keywords (if org-bibtex-tags-are-keywords - (mapc - (lambda (kw) - (funcall - togtag - (replace-regexp-in-string - "[^[:alnum:]_@#%]" "" - (replace-regexp-in-string "[ \t]+" "_" kw)))) - (split-string (cdr pair) ", *")) + (dolist (kw (split-string (cdr pair) ", *")) + (funcall + togtag + (replace-regexp-in-string + "[^[:alnum:]_@#%]" "" + (replace-regexp-in-string "[ \t]+" "_" kw)))) (org-bibtex-put (car pair) (cdr pair)))) - (otherwise (org-bibtex-put (car pair) (cdr pair))))) + (_ (org-bibtex-put (car pair) (cdr pair))))) (mapc togtag org-bibtex-tags))) (defun org-bibtex-yank () - "If kill ring holds a bibtex entry yank it as an Org-mode headline." + "If kill ring holds a bibtex entry yank it as an Org headline." (interactive) (let (entry) (with-temp-buffer (yank 1) (setf entry (org-bibtex-read))) @@ -710,7 +708,7 @@ Return the number of saved entries." (error "Yanked text does not appear to contain a BibTeX entry")))) (defun org-bibtex-import-from-file (file) - "Read bibtex entries from FILE and insert as Org-mode headlines after point." + "Read bibtex entries from FILE and insert as Org headlines after point." (interactive "fFile: ") (dotimes (_ (org-bibtex-read-file file)) (save-excursion (org-bibtex-write)) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 5052ad8..ced8399 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -1,4 +1,4 @@ -;;; org-capture.el --- Fast note taking in Org-mode +;;; org-capture.el --- Fast note taking in Org -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -47,20 +47,18 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'org) +(declare-function org-at-encrypted-entry-p "org-crypt" ()) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) +(declare-function org-decrypt-entry "org-crypt" ()) +(declare-function org-encrypt-entry "org-crypt" ()) (declare-function org-table-analyze "org-table" ()) (declare-function org-table-goto-line "org-table" (N)) -(declare-function org-pop-to-buffer-same-window "org-compat" - (&optional buffer-or-name norecord label)) -(declare-function org-at-encrypted-entry-p "org-crypt" ()) -(declare-function org-encrypt-entry "org-crypt" ()) -(declare-function org-decrypt-entry "org-crypt" ()) +(defvar org-end-time-was-given) (defvar org-remember-default-headline) (defvar org-remember-templates) (defvar org-table-hlines) @@ -77,6 +75,9 @@ ;; to indicate that the link properties have already been stored (defvar org-capture-link-is-already-stored nil) +(defvar org-capture-is-refiling nil + "Non-nil when capture process is refiling an entry.") + (defgroup org-capture nil "Options concerning capturing new entries." :tag "Org Capture" @@ -104,9 +105,9 @@ description A short string describing the template, will be shown during selection. type The type of entry. Valid types are: - entry an Org-mode node, with a headline. Will be - filed as the child of the target entry or as - a top-level entry. + entry an Org node, with a headline. Will be filed + as the child of the target entry or as a + top-level entry. item a plain list item, will be placed in the first plain list at the target location. @@ -117,7 +118,7 @@ type The type of entry. Valid types are: plain text to be inserted as it is. target Specification of where the captured item should be placed. - In Org-mode files, targets usually define a node. Entries will + In Org files, targets usually define a node. Entries will become children of this node, other types will be added to the table or list in the body of this node. @@ -150,6 +151,12 @@ target Specification of where the captured item should be placed. (file+datetree+prompt \"path/to/file\") Will create a heading in a date tree, prompts for date + (file+weektree \"path/to/file\") + Will create a heading in a week tree for today's date + + (file+weektree+prompt \"path/to/file\") + Will create a heading in a week tree, prompts for date + (file+function \"path/to/file\" function-finding-location) A function to find the right location in the file @@ -157,8 +164,8 @@ target Specification of where the captured item should be placed. File to the entry that is currently being clocked (function function-finding-location) - Most general way, write your own function to find both - file and location + Most general way: write your own function which both visits + the file and moves point to the right location template The template for creating the capture item. If you leave this empty, an appropriate default template will be used. See below @@ -220,15 +227,20 @@ properties are: is finalized. The template defines the text to be inserted. Often this is an -org-mode entry (so the first line should start with a star) that +Org mode entry (so the first line should start with a star) that will be filed as a child of the target headline. It can also be freely formatted text. Furthermore, the following %-escapes will -be replaced with content and expanded in this order: +be replaced with content and expanded: - %[pathname] Insert the contents of the file given by `pathname'. + %[pathname] Insert the contents of the file given by + `pathname'. These placeholders are expanded at the very + beginning of the process so they can be used to extend the + current template. %(sexp) Evaluate elisp `(sexp)' and replace it with the results. - For convenience, %:keyword (see below) placeholders within - the expression will be expanded prior to this. + Only placeholders pre-existing within the template, or + introduced with %[pathname] are expanded this way. Since this + happens after expanding non-interactive %-escapes, those can + be used to fill the expression. %<...> The result of format-time-string on the ... format specification. %t Time stamp, date only. %T Time stamp with date and time. @@ -257,8 +269,8 @@ be replaced with content and expanded in this order: A default value and a completion table ca be specified like this: %^{prompt|default|completion2|completion3|...}. %? After completing the template, position cursor here. - %\\n Insert the text entered at the nth %^{prompt}, where `n' is - a number, starting from 1. + %\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N + is a number, starting from 1. Apart from these general escapes, you can access information specific to the link type that is created. For example, calling `org-capture' in emails @@ -276,13 +288,21 @@ gnus | %:from %:fromname %:fromaddress | %:date %:date-timestamp (as active timestamp) | %:date-timestamp-inactive (as inactive timestamp) gnus | %:group, for messages also all email fields -w3, w3m | %:type %:url +eww, w3, w3m | %:type %:url info | %:type %:file %:node -calendar | %:type %:date" +calendar | %:type %:date + +When you need to insert a literal percent sign in the template, +you can escape ambiguous cases with a backward slash, e.g., \\%i." :group 'org-capture :version "24.1" :type - '(repeat + (let ((file-variants '(choice :tag "Filename " + (file :tag "Literal") + (function :tag "Function") + (variable :tag "Variable") + (sexp :tag "Form")))) + `(repeat (choice :value ("" "" entry (file "~/org/notes.org") "") (list :tag "Multikey description" (string :tag "Keys ") @@ -299,39 +319,45 @@ calendar | %:type %:date" (choice :tag "Target location" (list :tag "File" (const :format "" file) - (file :tag " File")) + ,file-variants) (list :tag "ID" (const :format "" id) (string :tag " ID")) (list :tag "File & Headline" (const :format "" file+headline) - (file :tag " File ") + ,file-variants (string :tag " Headline")) (list :tag "File & Outline path" (const :format "" file+olp) - (file :tag " File ") + ,file-variants (repeat :tag "Outline path" :inline t (string :tag "Headline"))) (list :tag "File & Regexp" (const :format "" file+regexp) - (file :tag " File ") + ,file-variants (regexp :tag " Regexp")) (list :tag "File & Date tree" (const :format "" file+datetree) - (file :tag " File")) + ,file-variants) (list :tag "File & Date tree, prompt for date" (const :format "" file+datetree+prompt) - (file :tag " File")) + ,file-variants) + (list :tag "File & Week tree" + (const :format "" file+weektree) + ,file-variants) + (list :tag "File & Week tree, prompt for date" + (const :format "" file+weektree+prompt) + ,file-variants) (list :tag "File & function" (const :format "" file+function) - (file :tag " File ") + ,file-variants (sexp :tag " Function")) (list :tag "Current clocking task" (const :format "" clock)) (list :tag "Function" (const :format "" function) (sexp :tag " Function"))) - (choice :tag "Template" + (choice :tag "Template " (string) (list :tag "File" (const :format "" file) @@ -352,7 +378,7 @@ calendar | %:type %:date" ((const :format "%v " :clock-resume) (const t)) ((const :format "%v " :unnarrowed) (const t)) ((const :format "%v " :table-line-pos) (const t)) - ((const :format "%v " :kill-buffer) (const t)))))))) + ((const :format "%v " :kill-buffer) (const t))))))))) (defcustom org-capture-before-finalize-hook nil "Hook that is run right before a capture process is finalized. @@ -423,7 +449,7 @@ to avoid conflicts with other active capture processes." (defvar org-capture-mode-map (make-sparse-keymap) "Keymap for `org-capture-mode', a minor mode. -Use this map to set additional keybindings for when Org-mode is used +Use this map to set additional keybindings for when Org mode is used for a capture buffer.") (defvar org-capture-mode-hook nil @@ -434,11 +460,12 @@ for a capture buffer.") Turning on this mode runs the normal hook `org-capture-mode-hook'." nil " Rem" org-capture-mode-map - (org-set-local - 'header-line-format + (setq-local + header-line-format (substitute-command-keys - "\\<org-capture-mode-map>Capture buffer. Finish \\[org-capture-finalize], \ -refile \\[org-capture-refile], abort \\[org-capture-kill]."))) + "\\<org-capture-mode-map>Capture buffer. Finish \ +`\\[org-capture-finalize]', refile `\\[org-capture-refile]', \ +abort `\\[org-capture-kill]'."))) (define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) (define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) (define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) @@ -507,7 +534,8 @@ to avoid duplicates.)" (defcustom org-capture-use-agenda-date nil "Non-nil means use the date at point when capturing from agendas. -When nil, you can still capture using the date at point with \\[org-agenda-capture]." +When nil, you can still capture using the date at point with +`\\[org-agenda-capture]'." :group 'org-capture :version "24.3" :type 'boolean) @@ -516,17 +544,20 @@ When nil, you can still capture using the date at point with \\[org-agenda-captu (defun org-capture (&optional goto keys) "Capture something. \\<org-capture-mode-map> -This will let you select a template from `org-capture-templates', and then -file the newly captured information. The text is immediately inserted -at the target location, and an indirect buffer is shown where you can -edit it. Pressing \\[org-capture-finalize] brings you back to the previous state -of Emacs, so that you can continue your work. - -When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture -anything, just go to the file/headline where the selected template -stores its notes. With a double prefix argument \ -\\[universal-argument] \\[universal-argument], go to the last note -stored. +This will let you select a template from `org-capture-templates', and +then file the newly captured information. The text is immediately +inserted at the target location, and an indirect buffer is shown where +you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the \ +previous +state of Emacs, so that you can continue your work. + +When called interactively with a `\\[universal-argument]' prefix argument \ +GOTO, don't +capture anything, just go to the file/headline where the selected +template stores its notes. + +With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to \ +the last note stored. When called with a `C-0' (zero) prefix, insert a template at point. @@ -567,7 +598,7 @@ of the day at point (if any) or the current HH:MM time." ((equal entry "C") (customize-variable 'org-capture-templates)) ((equal entry "q") - (error "Abort")) + (user-error "Abort")) (t (org-capture-set-plist entry) (org-capture-get-template) @@ -599,10 +630,10 @@ of the day at point (if any) or the current HH:MM time." (org-capture-insert-template-here) (condition-case error (org-capture-place-template - (equal (car (org-capture-get :target)) 'function)) + (eq (car (org-capture-get :target)) 'function)) ((error quit) (if (and (buffer-base-buffer (current-buffer)) - (string-match "\\`CAPTURE-" (buffer-name))) + (string-prefix-p "CAPTURE-" (buffer-name))) (kill-buffer (current-buffer))) (set-window-configuration (org-capture-get :return-to-wconf)) (error "Capture template `%s': %s" @@ -616,7 +647,7 @@ of the day at point (if any) or the current HH:MM time." (org-capture-put :interrupted-clock (copy-marker org-clock-marker))) (org-clock-in) - (org-set-local 'org-capture-clock-was-started t)) + (setq-local org-capture-clock-was-started t)) (error "Could not start the clock in this capture buffer"))) (if (org-capture-get :immediate-finish) @@ -649,7 +680,7 @@ captured item after finalizing." (setq stay-with-capture t)) (unless (and org-capture-mode (buffer-base-buffer (current-buffer))) - (error "This does not seem to be a capture buffer for Org-mode")) + (error "This does not seem to be a capture buffer for Org mode")) (run-hooks 'org-capture-prepare-finalize-hook) @@ -685,7 +716,7 @@ captured item after finalizing." (m2 (org-capture-get :end-marker 'local))) (if (and m1 m2 (= m1 beg) (= m2 end)) (progn - (setq m2 (if (cdr (assoc 'heading org-blank-before-new-entry)) + (setq m2 (if (cdr (assq 'heading org-blank-before-new-entry)) m2 (1+ m2)) m2 (if (< (point-max) m2) (point-max) m2)) (setq abort-note 'clean) @@ -773,11 +804,12 @@ captured item after finalizing." ;; Special cases (cond (abort-note - (cond - ((equal abort-note 'clean) - (message "Capture process aborted and target buffer cleaned up")) - ((equal abort-note 'dirty) - (error "Capture process aborted, but target buffer could not be cleaned up correctly")))) + (cl-case abort-note + (clean + (message "Capture process aborted and target buffer cleaned up")) + (dirty + (error "Capture process aborted, but target buffer could not be \ +cleaned up correctly")))) (stay-with-capture (org-capture-goto-last-stored))) ;; Return if we did store something @@ -793,17 +825,15 @@ already gone. Any prefix argument will be passed to the refile command." "Refiling from a capture buffer makes only sense for `entry'-type templates")) (let ((pos (point)) (base (buffer-base-buffer (current-buffer))) - (org-refile-for-capture t) + (org-capture-is-refiling t) (kill-buffer (org-capture-get :kill-buffer 'local))) (org-capture-put :kill-buffer nil) (org-capture-finalize) (save-window-excursion (with-current-buffer (or base (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (call-interactively 'org-refile))))) + (org-with-wide-buffer + (goto-char pos) + (call-interactively 'org-refile)))) (when kill-buffer (kill-buffer base)))) (defun org-capture-kill () @@ -899,21 +929,25 @@ Store them in the capture property list." (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) (error "No match for target regexp in file %s" (nth 1 target)))) - ((memq (car target) '(file+datetree file+datetree+prompt)) + ((memq (car target) '(file+datetree file+datetree+prompt file+weektree file+weektree+prompt)) (require 'org-datetree) (set-buffer (org-capture-target-buffer (nth 1 target))) (org-capture-put-target-region-and-position) (widen) - ;; Make a date tree entry, with the current date (or yesterday, - ;; if we are extending dates for a couple of hours) - (org-datetree-find-date-create + ;; Make a date/week tree entry, with the current date (or + ;; yesterday, if we are extending dates for a couple of hours) + (funcall + (cond + ((memq (car target) '(file+weektree file+weektree+prompt)) + #'org-datetree-find-iso-week-create) + (t #'org-datetree-find-date-create)) (calendar-gregorian-from-absolute (cond (org-overriding-default-time ;; use the overriding default time (time-to-days org-overriding-default-time)) - ((eq (car target) 'file+datetree+prompt) + ((memq (car target) '(file+datetree+prompt file+weektree+prompt)) ;; prompt for date (let ((prompt-time (org-read-date nil t nil "Date for tree entry:" @@ -924,7 +958,9 @@ Store them in the capture property list." (not org-time-was-given)) (not (= (time-to-days prompt-time) (org-today)))) ;; Use 00:00 when no time is given for another date than today? - (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time))))) + (apply #'encode-time + (append '(0 0 0) + (cl-cdddr (decode-time prompt-time))))) ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer) ;; Replace any time range by its start (apply 'encode-time @@ -972,16 +1008,13 @@ Store them in the capture property list." (defun org-capture-expand-file (file) "Expand functions and symbols for FILE. -When FILE is a function, call it. When it is a form, evaluate -it. When it is a variable, retrieve the value. When it is -a string, return it. However, if it is the empty string, return -`org-default-notes-file' instead." +When FILE is a function, call it. When it is a variable, +retrieve its value. When it is the empty string, return +`org-default-notes-file'. In any other case, return FILE as-is." (cond ((equal file "") org-default-notes-file) - ((org-string-nw-p file) file) ((functionp file) (funcall file)) ((and (symbolp file) (boundp file)) (symbol-value file)) - ((consp file) (eval file)) (t file))) (defun org-capture-target-buffer (file) @@ -994,12 +1027,6 @@ a string, return it. However, if it is the empty string, return (progn (org-capture-put :new-buffer t) (find-file-noselect (expand-file-name file org-directory))))) -(defun org-capture-steal-local-variables (buffer) - "Install Org-mode local variables of BUFFER." - (mapc (lambda (v) - (ignore-errors (org-set-local (car v) (cdr v)))) - (buffer-local-variables buffer))) - (defun org-capture-place-template (&optional inhibit-wconf-store) "Insert the template at the target location, and display the buffer. When `inhibit-wconf-store', don't store the window configuration, as it @@ -1012,32 +1039,29 @@ may have been stored before." (widen) (outline-show-all) (goto-char (org-capture-get :pos)) - (org-set-local 'org-capture-target-marker - (point-marker)) - (org-set-local 'outline-level 'org-outline-level) - (let* ((template (org-capture-get :template)) - (type (org-capture-get :type))) - (case type - ((nil entry) (org-capture-place-entry)) - (table-line (org-capture-place-table-line)) - (plain (org-capture-place-plain-text)) - (item (org-capture-place-item)) - (checkitem (org-capture-place-item)))) + (setq-local outline-level 'org-outline-level) + (pcase (org-capture-get :type) + ((or `nil `entry) (org-capture-place-entry)) + (`table-line (org-capture-place-table-line)) + (`plain (org-capture-place-plain-text)) + (`item (org-capture-place-item)) + (`checkitem (org-capture-place-item))) (org-capture-mode 1) - (org-set-local 'org-capture-current-plist org-capture-plist)) + (setq-local org-capture-current-plist org-capture-plist)) (defun org-capture-place-entry () "Place the template as a new Org entry." (let* ((txt (org-capture-get :template)) (reversed (org-capture-get :prepend)) (target-entry-p (org-capture-get :target-entry-p)) - level beg end file) + level beg end) (and (org-capture-get :exact-position) (goto-char (org-capture-get :exact-position))) (cond ((not target-entry-p) - ;; Insert as top-level entry, either at beginning or at end of file + ;; Insert as top-level entry, either at beginning or at end of + ;; file. (setq level 1) (if reversed (progn (goto-char (point-min)) @@ -1136,7 +1160,7 @@ may have been stored before." (let* ((txt (org-capture-get :template)) (target-entry-p (org-capture-get :target-entry-p)) (table-line-pos (org-capture-get :table-line-pos)) - ind beg end) + beg end) (cond ((org-capture-get :exact-position) (goto-char (org-capture-get :exact-position))) @@ -1167,6 +1191,7 @@ may have been stored before." (cond ((and table-line-pos (string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos)) + (goto-char (point-min)) ;; we have a complex line specification (let ((ll (ignore-errors (save-match-data (org-table-analyze)) @@ -1284,16 +1309,14 @@ Of course, if exact position has been required, just put it there." (point-at-bol)) (point)))))) (with-current-buffer (buffer-base-buffer (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-capture))) - (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) - (move-marker org-capture-last-stored-marker (point))))))) + (org-with-wide-buffer + (goto-char pos) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-capture))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) + (move-marker org-capture-last-stored-marker (point)))))) (defun org-capture-narrow (beg end) "Narrow, unless configuration says not to narrow." @@ -1379,13 +1402,11 @@ Point will remain at the first line after the inserted text." "Go to the target location of a capture template. The user is queried for the template." (interactive) - (let* (org-select-template-temp-major-mode - (entry (org-capture-select-template template-key))) - (unless entry - (error "No capture template selected")) + (let ((entry (org-capture-select-template template-key))) + (unless entry (error "No capture template selected")) (org-capture-set-plist entry) (org-capture-set-target-location) - (org-pop-to-buffer-same-window (org-capture-get :buffer)) + (pop-to-buffer-same-window (org-capture-get :buffer)) (goto-char (org-capture-get :pos)))) (defun org-capture-get-indirect-buffer (&optional buffer prefix) @@ -1395,7 +1416,7 @@ Use PREFIX as a prefix for the name of the indirect buffer." (let ((n 1) (base (buffer-name buffer)) bname) (setq bname (concat prefix "-" base)) (while (buffer-live-p (get-buffer bname)) - (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base))) + (setq bname (concat prefix "-" (number-to-string (cl-incf n)) "-" base))) (condition-case nil (make-indirect-buffer buffer bname 'clone) (error @@ -1450,7 +1471,7 @@ only the bare key is returned." (cond ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) ;; This is a description on this level - (setq dkey (caar tbl) ddesc (cadar tbl)) + (setq dkey (caar tbl) ddesc (cl-cadar tbl)) (pop tbl) (push dkey des-keys) (push dkey allowed-keys) @@ -1487,7 +1508,7 @@ only the bare key is returned." (setq pressed (char-to-string (read-char-exclusive)))) (when (equal pressed "\C-g") (kill-buffer buffer) - (error "Abort")) + (user-error "Abort")) (when (and (not (assoc pressed table)) (not (member pressed des-keys)) (assoc pressed specials)) @@ -1528,43 +1549,35 @@ Lisp programs can force the template by setting KEYS to a string." (defun org-capture-fill-template (&optional template initial annotation) "Fill a template and return the filled template as a string. The template may still contain \"%?\" for cursor positioning." - (setq template (or template (org-capture-get :template))) - (when (stringp initial) - (setq initial (org-no-properties initial))) - (let* ((buffer (org-capture-get :buffer)) + (let* ((template (or template (org-capture-get :template))) + (buffer (org-capture-get :buffer)) (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) - (ct (org-capture-get :default-time)) - (dct (decode-time ct)) - (ct1 - (if (< (nth 2 dct) org-extend-today-until) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) - ct)) - (plist-p (if org-store-link-plist t nil)) - (v-c (and (> (length kill-ring) 0) (current-kill 0))) + (time (let* ((c (or (org-capture-get :default-time) (current-time))) + (d (decode-time c))) + (if (< (nth 2 d) org-extend-today-until) + (encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d)) + c))) + (v-t (format-time-string (org-time-stamp-format nil) time)) + (v-T (format-time-string (org-time-stamp-format t) time)) + (v-u (format-time-string (org-time-stamp-format nil t) time)) + (v-U (format-time-string (org-time-stamp-format t t) time)) + (v-c (and kill-ring (current-kill 0))) (v-x (or (org-get-x-clipboard 'PRIMARY) (org-get-x-clipboard 'CLIPBOARD) (org-get-x-clipboard 'SECONDARY))) - (v-t (format-time-string (car org-time-stamp-formats) ct1)) - (v-T (format-time-string (cdr org-time-stamp-formats) ct1)) - (v-u (concat "[" (substring v-t 1 -1) "]")) - (v-U (concat "[" (substring v-T 1 -1) "]")) - ;; `initial' and `annotation' might habe been passed. - ;; But if the property list has them, we prefer those values + ;; `initial' and `annotation' might have been passed. But if + ;; the property list has them, we prefer those values. (v-i (or (plist-get org-store-link-plist :initial) - initial + (and (stringp initial) (org-no-properties initial)) (org-capture-get :initial) "")) - (v-a (or (plist-get org-store-link-plist :annotation) - annotation - (org-capture-get :annotation) - "")) - ;; Is the link empty? Then we do not want it... - (v-a (if (equal v-a "[[]]") "" v-a)) - (clipboards (remove nil (list v-i - (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY) - v-c))) + (v-a + (let ((a (or (plist-get org-store-link-plist :annotation) + annotation + (org-capture-get :annotation) + ""))) + ;; Is the link empty? Then we do not want it... + (if (equal a "[[]]") "" a))) (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]") (v-A (if (and v-a (string-match l-re v-a)) (replace-match "[[\\1][%^{Link description}]]" nil nil v-a) @@ -1573,203 +1586,256 @@ The template may still contain \"%?\" for cursor positioning." (replace-match "\\1" nil nil v-a) v-a)) (v-n user-full-name) - (v-k (if (marker-buffer org-clock-marker) - (org-no-properties org-clock-heading))) + (v-k (and (marker-buffer org-clock-marker) + (org-no-properties org-clock-heading))) (v-K (if (marker-buffer org-clock-marker) (org-make-link-string (buffer-file-name (marker-buffer org-clock-marker)) org-clock-heading))) (v-f (or (org-capture-get :original-file-nondirectory) "")) (v-F (or (org-capture-get :original-file) "")) - v-I - (org-startup-folded nil) - (org-inhibit-startup t) - org-time-was-given org-end-time-was-given x - prompt completions char time pos default histvar strings) - - (setq org-store-link-plist - (plist-put org-store-link-plist :annotation v-a) - org-store-link-plist - (plist-put org-store-link-plist :initial v-i)) - (setq initial v-i) - - (unless template (setq template "") (message "No template") (ding) - (sit-for 1)) + (clipboards (delq nil + (list v-i + (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY) + v-c)))) + + (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a)) + (setq org-store-link-plist (plist-put org-store-link-plist :initial v-i)) + + (unless template + (setq template "") + (message "no template") (ding) + (sit-for 1)) (save-window-excursion (org-switch-to-buffer-other-window (get-buffer-create "*Capture*")) (erase-buffer) + (setq buffer-file-name nil) + (setq mark-active nil) (insert template) (goto-char (point-min)) - (org-capture-steal-local-variables buffer) - (setq buffer-file-name nil mark-active nil) - ;; %[] Insert contents of a file. - (goto-char (point-min)) - (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) - (unless (org-capture-escaped-%) - (let ((start (match-beginning 0)) - (end (match-end 0)) - (filename (expand-file-name (match-string 1)))) - (goto-char start) - (delete-region start end) - (condition-case error - (insert-file-contents filename) - (error (insert (format "%%![Couldn not insert %s: %s]" - filename error))))))) - - ;; The current time - (goto-char (point-min)) - (while (re-search-forward "%<\\([^>\n]+\\)>" nil t) - (replace-match (format-time-string (match-string 1)) t t)) + ;; %[] insert contents of a file. + (save-excursion + (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) + (let ((filename (expand-file-name (match-string 1))) + (beg (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0)))) + (unless (org-capture-escaped-%) + (delete-region beg end) + (set-marker beg nil) + (set-marker end nil) + (condition-case error + (insert-file-contents filename) + (error + (insert (format "%%![couldn not insert %s: %s]" + filename + error)))))))) - ;; Simple %-escapes - (goto-char (point-min)) - (while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t) - (unless (org-capture-escaped-%) - (when (and initial (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity - (org-split-string initial "\n") - (concat "\n" lead)))))) - (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "") - t t))) - - ;; From the property list - (when plist-p - (goto-char (point-min)) - (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) - (unless (org-capture-escaped-%) - (and (setq x (or (plist-get org-store-link-plist - (intern (match-string 1))) "")) - (replace-match x t t))))) + ;; Mark %() embedded elisp for later evaluation. + (org-capture-expand-embedded-elisp 'mark) - ;; %() embedded elisp - (goto-char (point-min)) + ;; Expand non-interactive templates. + (let ((regexp "%\\(:[-a-za-z]+\\|<\\([^>\n]+\\)>\\|[aAcfFikKlntTuUx]\\)")) + (save-excursion + (while (re-search-forward regexp nil t) + ;; `org-capture-escaped-%' may modify buffer and cripple + ;; match-data. Use markers instead. Ditto for other + ;; templates. + (let ((pos (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0))) + (value (match-string 1)) + (time-string (match-string 2))) + (unless (org-capture-escaped-%) + (delete-region pos end) + (set-marker pos nil) + (set-marker end nil) + (let ((replacement + (pcase (string-to-char value) + (?< (format-time-string time-string)) + (?: + (or (plist-get org-store-link-plist (intern value)) + "")) + (?i (let ((lead (buffer-substring-no-properties + (line-beginning-position) (point)))) + (mapconcat #'identity + (split-string v-i "\n") + (concat "\n" lead)))) + (?a v-a) + (?A v-A) + (?c v-c) + (?f v-f) + (?F v-F) + (?k v-k) + (?K v-K) + (?l v-l) + (?n v-n) + (?t v-t) + (?T v-T) + (?u v-u) + (?U v-U) + (?x v-x)))) + (insert + (if (org-capture-inside-embedded-elisp-p) + (replace-regexp-in-string "\"" "\\\\\"" replacement) + replacement)))))))) + + ;; Expand %() embedded Elisp. Limit to Sexp originally marked. (org-capture-expand-embedded-elisp) - ;; Turn on org-mode in temp buffer, set local variables - ;; This is to support completion in interactive prompts + ;; Expand interactive templates. This is the last step so that + ;; template is mostly expanded when prompting happens. Turn on + ;; Org mode and set local variables. This is to support + ;; completion in interactive prompts. (let ((org-inhibit-startup t)) (org-mode)) - ;; Interactive template entries - (goto-char (point-min)) - (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) - (unless (org-capture-escaped-%) - (setq char (if (match-end 3) (match-string-no-properties 3)) - prompt (if (match-end 2) (match-string-no-properties 2))) - (goto-char (match-beginning 0)) - (replace-match "") - (setq completions nil default nil) - (when prompt - (setq completions (org-split-string prompt "|") - prompt (pop completions) - default (car completions) - histvar (intern (concat - "org-capture-template-prompt-history::" - (or prompt ""))) - completions (mapcar 'list completions))) - (unless (boundp histvar) (set histvar nil)) - (cond - ((member char '("G" "g")) - (let* ((org-last-tags-completion-table - (org-global-tags-completion-table - (if (equal char "G") - (org-agenda-files) - (and file (list file))))) - (org-add-colon-after-tag-completion t) - (ins (org-icompleting-read - (if prompt (concat prompt ": ") "Tags: ") - 'org-tags-completion-function nil nil nil - 'org-tags-history))) - (setq ins (mapconcat 'identity - (org-split-string - ins (org-re "[^[:alnum:]_@#%]+")) - ":")) - (when (string-match "\\S-" ins) - (or (equal (char-before) ?:) (insert ":")) - (insert ins) - (or (equal (char-after) ?:) (insert ":")) - (and (org-at-heading-p) - (let ((org-ignore-region t)) - (org-set-tags nil 'align)))))) - ((equal char "C") - (cond ((= (length clipboards) 1) (insert (car clipboards))) - ((> (length clipboards) 1) - (insert (read-string "Clipboard/kill value: " - (car clipboards) '(clipboards . 1) - (car clipboards)))))) - ((equal char "L") - (cond ((= (length clipboards) 1) - (org-insert-link 0 (car clipboards))) - ((> (length clipboards) 1) - (org-insert-link 0 (read-string "Clipboard/kill value: " - (car clipboards) - '(clipboards . 1) - (car clipboards)))))) - ((equal char "p") - (org-set-property (org-no-properties prompt) nil)) - (char - ;; These are the date/time related ones - (setq org-time-was-given (equal (upcase char) char)) - (setq time (org-read-date (equal (upcase char) char) t nil - prompt)) - (if (equal (upcase char) char) (setq org-time-was-given t)) - (org-insert-time-stamp time org-time-was-given - (member char '("u" "U")) - nil nil (list org-end-time-was-given))) - (t - (let (org-completion-use-ido) - (push (org-completing-read-no-i - (concat (if prompt prompt "Enter string") - (if default (concat " [" default "]")) - ": ") - completions nil nil nil histvar default) - strings) - (insert (car strings))))))) - ;; Replace %n escapes with nth %^{...} string - (setq strings (nreverse strings)) - (goto-char (point-min)) - (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t) - (unless (org-capture-escaped-%) - (replace-match - (nth (1- (string-to-number (match-string 1))) strings) - nil t))) + (org-clone-local-variables buffer "\\`org-") + (let (strings) ; Stores interactive answers. + (save-excursion + (let ((regexp "%\\^\\(?:{\\([^}]*\\)}\\)?\\([CgGLptTuU]\\)?")) + (while (re-search-forward regexp nil t) + (let* ((items (and (match-end 1) + (save-match-data + (split-string (match-string-no-properties 1) + "|")))) + (key (match-string 2)) + (beg (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0))) + (prompt (nth 0 items)) + (default (nth 1 items)) + (completions (nthcdr 2 items))) + (unless (org-capture-escaped-%) + (delete-region beg end) + (set-marker beg nil) + (set-marker end nil) + (pcase key + ((or "G" "g") + (let* ((org-last-tags-completion-table + (org-global-tags-completion-table + (cond ((equal key "G") (org-agenda-files)) + (file (list file)) + (t nil)))) + (org-add-colon-after-tag-completion t) + (ins (mapconcat + #'identity + (org-split-string + (completing-read + (if prompt (concat prompt ": ") "Tags: ") + 'org-tags-completion-function nil nil nil + 'org-tags-history) + "[^[:alnum:]_@#%]+") + ":"))) + (when (org-string-nw-p ins) + (unless (eq (char-before) ?:) (insert ":")) + (insert ins) + (unless (eq (char-after) ?:) (insert ":")) + (and (org-at-heading-p) + (let ((org-ignore-region t)) + (org-set-tags nil 'align)))))) + ("C" + (cond + ((= (length clipboards) 1) (insert (car clipboards))) + ((> (length clipboards) 1) + (insert (read-string "Clipboard/kill value: " + (car clipboards) + '(clipboards . 1) + (car clipboards)))))) + ("L" + (cond ((= (length clipboards) 1) + (org-insert-link 0 (car clipboards))) + ((> (length clipboards) 1) + (org-insert-link + 0 + (read-string "Clipboard/kill value: " + (car clipboards) + '(clipboards . 1) + (car clipboards)))))) + ("p" (org-set-property prompt nil)) + ((guard key) + ;; These are the date/time related ones. + (let* ((upcase? (equal (upcase key) key)) + (org-time-was-given upcase?) + (org-end-time-was-given) + (time (org-read-date upcase? t nil prompt))) + (org-insert-time-stamp + time org-time-was-given + (member key '("u" "U")) + nil nil (list org-end-time-was-given)))) + (_ + (push (org-completing-read + (concat (or prompt "Enter string") + (and default (format " [%s]" default)) + ": ") + completions nil nil nil nil default) + strings) + (insert (car strings))))))))) + + ;; Replace %n escapes with nth %^{...} string. + (setq strings (nreverse strings)) + (save-excursion + (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t) + (unless (org-capture-escaped-%) + (replace-match + (nth (1- (string-to-number (match-string 1))) strings) + nil t))))) + ;; Make sure there are no empty lines before the text, and that - ;; it ends with a newline character - (goto-char (point-min)) - (while (looking-at "[ \t]*\n") (replace-match "")) - (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n")) - ;; Return the expanded template and kill the temporary buffer + ;; it ends with a newline character. + (skip-chars-forward " \t\n") + (delete-region (point-min) (line-beginning-position)) + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (delete-region (point) (point-max)) + (insert "\n") + + ;; Return the expanded template and kill the capture buffer. (untabify (point-min) (point-max)) (set-buffer-modified-p nil) - (prog1 (buffer-string) (kill-buffer (current-buffer)))))) + (prog1 (buffer-substring-no-properties (point-min) (point-max)) + (kill-buffer (current-buffer)))))) (defun org-capture-escaped-% () - "Check if % was escaped - if yes, unescape it now." - (if (equal (char-before (match-beginning 0)) ?\\) - (progn - (delete-region (1- (match-beginning 0)) (match-beginning 0)) - t) - nil)) - -(defun org-capture-expand-embedded-elisp () - "Evaluate embedded elisp %(sexp) and replace with the result." - (goto-char (point-min)) - (while (re-search-forward "%(" nil t) - (unless (org-capture-escaped-%) - (goto-char (match-beginning 0)) - (let ((template-start (point))) - (forward-char 1) - (let* ((sexp (read (current-buffer))) - (result (org-eval - (org-capture--expand-keyword-in-embedded-elisp sexp)))) - (delete-region template-start (point)) - (when result - (if (stringp result) - (insert result) - (error "Capture template sexp `%s' must evaluate to string or nil" - sexp)))))))) + "Non-nil if % was escaped. +If yes, unescape it now. Assume match-data contains the +placeholder to check." + (save-excursion + (goto-char (match-beginning 0)) + (let ((n (abs (skip-chars-backward "\\\\")))) + (delete-char (/ (1+ n) 2)) + (= (% n 2) 1)))) + +(defun org-capture-expand-embedded-elisp (&optional mark) + "Evaluate embedded elisp %(sexp) and replace with the result. +When optional MARK argument is non-nil, mark Sexp with a text +property (`org-embedded-elisp') for later evaluation. Only +marked Sexp are evaluated when this argument is nil." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "%(" nil t) + (cond + ((get-text-property (match-beginning 0) 'org-embedded-elisp) + (goto-char (match-beginning 0)) + (let ((template-start (point))) + (forward-char 1) + (let* ((sexp (read (current-buffer))) + (result (org-eval + (org-capture--expand-keyword-in-embedded-elisp + sexp)))) + (delete-region template-start (point)) + (cond + ((not result) nil) + ((stringp result) (insert result)) + (t (error + "Capture template sexp `%s' must evaluate to string or nil" + sexp)))))) + ((not mark) nil) + ;; Only mark valid and non-escaped sexp. + ((org-capture-escaped-%) nil) + (t + (let ((end (with-syntax-table emacs-lisp-mode-syntax-table + (ignore-errors (scan-sexps (1- (point)) 1))))) + (when end + (put-text-property (- (point) 2) end 'org-embedded-elisp t)))))))) (defun org-capture--expand-keyword-in-embedded-elisp (attr) "Recursively replace capture link keywords in ATTR sexp. @@ -1786,20 +1852,10 @@ Such keywords are prefixed with \"%:\". See (t attr))) (defun org-capture-inside-embedded-elisp-p () - "Return non-nil if point is inside of embedded elisp %(sexp)." - (let (beg end) - (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - ;; `looking-at' and `search-backward' below do not match the "%(" if - ;; point is in its middle - (when (equal (char-before) ?%) - (backward-char)) - (save-match-data - (when (or (looking-at "%(") (search-backward "%(" nil t)) - (setq beg (point)) - (setq end (progn (forward-char) (forward-sexp) (1- (point))))))) - (when (and beg end) - (and (<= (point) end) (>= (point) beg)))))) + "Non-nil if point is inside of embedded elisp %(sexp). +Assume sexps have been marked with +`org-capture-expand-embedded-elisp' beforehand." + (get-text-property (point) 'org-embedded-elisp)) ;;;###autoload (defun org-capture-import-remember-templates () @@ -1843,6 +1899,9 @@ Such keywords are prefixed with \"%:\". See (if jump-to-captured '(:jump-to-captured t))))) org-remember-templates)))) +;;; The function was made obsolete by commit 65399674d5 of +;;; 2013-02-22. This make-obsolete call was added 2016-09-01. +(make-obsolete 'org-capture-import-remember-templates "use the `org-capture-templates' variable instead." "Org 9.0") (provide 'org-capture) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 143f749..b148a08 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1,4 +1,4 @@ -;;; org-clock.el --- The time clocking code for Org-mode +;;; org-clock.el --- The time clocking code for Org mode -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -24,26 +24,28 @@ ;; ;;; Commentary: -;; This file contains the time clocking code for Org-mode +;; This file contains the time clocking code for Org mode ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'org) -(declare-function calendar-iso-to-absolute "cal-iso" (&optional date)) +(declare-function calendar-iso-to-absolute "cal-iso" (date)) (declare-function notifications-notify "notifications" (&rest params)) -(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) (declare-function org-table-goto-line "org-table" (n)) + +(defvar org-clock-stored-history nil + "Clock history, populated by `org-clock-load', which see.") +(defvar org-frame-title-format-backup frame-title-format) (defvar org-time-stamp-formats) (defvar org-ts-what) -(defvar org-frame-title-format-backup frame-title-format) + (defgroup org-clock nil - "Options concerning clocking working time in Org-mode." + "Options concerning clocking working time in Org mode." :tag "Org Clock" :group 'org-progress) @@ -65,7 +67,7 @@ Do not check directly this variable in a Lisp program. Call function `org-clock-into-drawer' instead." :group 'org-todo :group 'org-clock - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(choice (const :tag "Always" t) @@ -85,7 +87,7 @@ Return value is either a string, an integer, or nil." (cond ((equal p "nil") nil) ((equal p "t") (or (org-log-into-drawer) "LOGBOOK")) ((org-string-nw-p p) - (if (org-string-match-p "\\`[0-9]+\\'" p) (string-to-number p) p)) + (if (string-match-p "\\`[0-9]+\\'" p) (string-to-number p) p)) ((org-string-nw-p org-clock-into-drawer)) ((integerp org-clock-into-drawer) org-clock-into-drawer) ((not org-clock-into-drawer) nil) @@ -235,9 +237,6 @@ file name Play this sound file, fall back to beep" (const :tag "Standard beep" t) (file :tag "Play sound file"))) -(define-obsolete-variable-alias 'org-clock-modeline-total - 'org-clock-mode-line-total "24.3") - (defcustom org-clock-mode-line-total 'auto "Default setting for the time included for the mode line clock. This can be overruled locally using the CLOCK_MODELINE_TOTAL property. @@ -256,7 +255,7 @@ auto Automatically, either `all', or `repeat' for repeating tasks" (const :tag "All task time" all) (const :tag "Automatically, `all' or since `repeat'" auto))) -(org-defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) +(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) (defcustom org-clock-task-overrun-text nil "Extra mode line text to indicate that the clock is overrun. The can be nil to indicate that instead of adding text, the clock time @@ -280,14 +279,14 @@ string as argument." (function :tag "Function"))) (defgroup org-clocktable nil - "Options concerning the clock table in Org-mode." + "Options concerning the clock table in Org mode." :tag "Org Clock Table" :group 'org-clock) (defcustom org-clocktable-defaults (list :maxlevel 2 - :lang (or (org-bound-and-true-p org-export-default-language) "en") + :lang (or (bound-and-true-p org-export-default-language) "en") :scope 'file :block nil :wstart 1 @@ -383,7 +382,7 @@ play with them." :type 'string) (defcustom org-clock-clocked-in-display 'mode-line - "When clocked in for a task, org-mode can display the current + "When clocked in for a task, Org can display the current task and accumulated time in the mode line and/or frame title. Allowed values are: @@ -466,7 +465,7 @@ to add an effort property.") (let* ((dichotomy (lambda (min max pred) (if (funcall pred min) min - (incf min) + (cl-incf min) (while (> (- max min) 1) (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1)))) (if (funcall pred mean) (setq max mean) (setq min mean))))) @@ -554,13 +553,15 @@ of a different task.") (org-check-and-save-marker org-clock-hd-marker beg end) (org-check-and-save-marker org-clock-default-task beg end) (org-check-and-save-marker org-clock-interrupted-task beg end) - (mapc (lambda (m) (org-check-and-save-marker m beg end)) - org-clock-history)) + (dolist (m org-clock-history) + (org-check-and-save-marker m beg end))) (defun org-clock-drawer-name () "Return clock drawer's name for current entry, or nil." (let ((drawer (org-clock-into-drawer))) - (cond ((integerp drawer) (org-log-into-drawer)) + (cond ((integerp drawer) + (let ((log-drawer (org-log-into-drawer))) + (if (stringp log-drawer) log-drawer "LOGBOOK"))) ((stringp drawer) drawer) (t nil)))) @@ -580,8 +581,8 @@ of a different task.") (interactive) (let (och chl sel-list rpl (i 0) s) ;; Remove successive dups from the clock history to consider - (mapc (lambda (c) (if (not (equal c (car och))) (push c och))) - org-clock-history) + (dolist (c org-clock-history) + (unless (equal c (car och)) (push c och))) (setq och (reverse och) chl (length och)) (if (zerop chl) (user-error "No recent clock") @@ -602,17 +603,15 @@ of a different task.") (setq s (org-clock-insert-selection-line ?c org-clock-marker)) (push s sel-list)) (insert (org-add-props "Recent Tasks\n" nil 'face 'bold)) - (mapc - (lambda (m) - (when (marker-buffer m) - (setq i (1+ i) - s (org-clock-insert-selection-line - (if (< i 10) - (+ i ?0) - (+ i (- ?A 10))) m)) - (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) - (push s sel-list))) - och) + (dolist (m och) + (when (marker-buffer m) + (setq i (1+ i) + s (org-clock-insert-selection-line + (if (< i 10) + (+ i ?0) + (+ i (- ?A 10))) m)) + (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) + (push s sel-list))) (run-hooks 'org-clock-before-select-task-hook) (goto-char (point-min)) ;; Set min-height relatively to circumvent a possible but in @@ -632,25 +631,22 @@ of a different task.") And return a cons cell with the selection character integer and the marker pointing to it." (when (marker-buffer marker) - (let (file cat task heading prefix) + (let (cat task heading prefix) (with-current-buffer (org-base-buffer (marker-buffer marker)) - (save-excursion - (save-restriction - (widen) - (ignore-errors - (goto-char marker) - (setq file (buffer-file-name (marker-buffer marker)) - cat (org-get-category) - heading (org-get-heading 'notags) - prefix (save-excursion - (org-back-to-heading t) - (looking-at org-outline-regexp) - (match-string 0)) - task (substring - (org-fontify-like-in-org-mode - (concat prefix heading) - org-odd-levels-only) - (length prefix))))))) + (org-with-wide-buffer + (ignore-errors + (goto-char marker) + (setq cat (org-get-category) + heading (org-get-heading 'notags) + prefix (save-excursion + (org-back-to-heading t) + (looking-at org-outline-regexp) + (match-string 0)) + task (substring + (org-fontify-like-in-org-mode + (concat prefix heading) + org-odd-levels-only) + (length prefix)))))) (when (and cat task) (insert (format "[%c] %-12s %s\n" i cat task)) (cons i marker))))) @@ -670,19 +666,19 @@ If not, show simply the clocked time like 01:50." (let* ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort)) (work-done-str - (org-propertize + (propertize (org-minutes-to-clocksum-string clocked-time) 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text)) 'org-mode-line-clock-overrun 'org-mode-line-clock))) (effort-str (org-minutes-to-clocksum-string effort-in-minutes)) - (clockstr (org-propertize + (clockstr (propertize (concat " [%s/" effort-str "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") 'face 'org-mode-line-clock))) (format clockstr work-done-str)) - (org-propertize (concat "[" (org-minutes-to-clocksum-string clocked-time) - (format " (%s)" org-clock-heading) "]") - 'face 'org-mode-line-clock)))) + (propertize (concat "[" (org-minutes-to-clocksum-string clocked-time) + "]" (format " (%s)" org-clock-heading)) + 'face 'org-mode-line-clock)))) (defun org-clock-get-last-clock-out-time () "Get the last clock-out time for the current subtree." @@ -697,20 +693,21 @@ If not, show simply the clocked time like 01:50." (org-clock-notify-once-if-expired) (setq org-clock-task-overrun nil)) (setq org-mode-line-string - (org-propertize + (propertize (let ((clock-string (org-clock-get-clock-string)) - (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task")) + (help-text "Org mode clock is running.\nmouse-1 shows a \ +menu\nmouse-2 will jump to task")) (if (and (> org-clock-string-limit 0) (> (length clock-string) org-clock-string-limit)) - (org-propertize + (propertize (substring clock-string 0 org-clock-string-limit) 'help-echo (concat help-text ": " org-clock-heading)) - (org-propertize clock-string 'help-echo help-text))) + (propertize clock-string 'help-echo help-text))) 'local-map org-clock-mode-line-map - 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight))) + 'mouse-face 'mode-line-highlight)) (if (and org-clock-task-overrun org-clock-task-overrun-text) (setq org-mode-line-string - (concat (org-propertize + (concat (propertize org-clock-task-overrun-text 'face 'org-mode-line-clock-overrun) org-mode-line-string))) (force-mode-line-update)) @@ -720,8 +717,8 @@ If not, show simply the clocked time like 01:50." The time returned includes the time spent on this task in previous clocking intervals." (let ((currently-clocked-time - (floor (- (org-float-time) - (org-float-time org-clock-start-time)) 60))) + (floor (- (float-time) + (float-time org-clock-start-time)) 60))) (+ currently-clocked-time (or org-clock-total-time 0)))) (defun org-clock-modify-effort-estimate (&optional value) @@ -801,7 +798,7 @@ use libnotify if available, or fall back on a message." org-show-notification-handler notification)) ((fboundp 'notifications-notify) (notifications-notify - :title "Org-mode message" + :title "Org mode message" :body notification ;; FIXME how to link to the Org icon? ;; :app-icon "~/.emacs.d/icons/mail.png" @@ -856,12 +853,10 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." (defmacro org-with-clock-position (clock &rest forms) "Evaluate FORMS with CLOCK as the current active clock." `(with-current-buffer (marker-buffer (car ,clock)) - (save-excursion - (save-restriction - (widen) - (goto-char (car ,clock)) - (beginning-of-line) - ,@forms)))) + (org-with-wide-buffer + (goto-char (car ,clock)) + (beginning-of-line) + ,@forms))) (def-edebug-spec org-with-clock-position (form body)) (put 'org-with-clock-position 'lisp-indent-function 1) @@ -970,7 +965,7 @@ If necessary, clock-out of the currently active clock." (throw 'exit nil))))))))))) (defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) - "Resolve an open org-mode clock. + "Resolve an open Org clock. An open clock was found, with `dangling' possibly being non-nil. If this function was invoked with a prefix argument, non-dangling open clocks are ignored. The given clock requires some sort of @@ -988,7 +983,7 @@ The format of clock is (CONS MARKER START-TIME), where MARKER identifies the buffer and position the clock is open at (and thus, the heading it's under), and START-TIME is when the clock was started." - (assert clock) + (cl-assert clock) (let* ((ch (save-window-excursion (save-excursion @@ -1021,10 +1016,6 @@ For all these options, using uppercase makes your final state to be CLOCKED OUT.")))) (org-fit-window-to-buffer (get-buffer-window "*Org Clock*")) (let (char-pressed) - (when (featurep 'xemacs) - (message (concat (funcall prompt-fn clock) - " [jkKgGsScCiq]? ")) - (setq char-pressed (read-char-exclusive))) (while (or (null char-pressed) (and (not (memq char-pressed '(?k ?K ?g ?G ?s ?S ?C @@ -1036,7 +1027,7 @@ to be CLOCKED OUT.")))) nil 45))) (and (not (memq char-pressed '(?i ?q))) char-pressed))))) (default - (floor (/ (org-float-time + (floor (/ (float-time (time-subtract (current-time) last-valid)) 60))) (keep (and (memq ch '(?k ?K)) @@ -1045,8 +1036,8 @@ to be CLOCKED OUT.")))) (and (memq ch '(?g ?G)) (read-number "Got back how many minutes ago? " default))) (subtractp (memq ch '(?s ?S))) - (barely-started-p (< (- (org-float-time last-valid) - (org-float-time (cdr clock))) 45)) + (barely-started-p (< (- (float-time last-valid) + (float-time (cdr clock))) 45)) (start-over (and subtractp barely-started-p))) (cond ((memq ch '(?j ?J)) @@ -1086,7 +1077,7 @@ to be CLOCKED OUT.")))) ;;;###autoload (defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid) - "Resolve all currently open org-mode clocks. + "Resolve all currently open Org clocks. If `only-dangling-p' is non-nil, only ask to resolve dangling \(i.e., not currently open and valid) clocks." (interactive "P") @@ -1105,8 +1096,8 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (lambda (clock) (format "Dangling clock started %d mins ago" - (floor (- (org-float-time) - (org-float-time (cdr clock))) + (floor (- (float-time) + (float-time (cdr clock))) 60))))) (or last-valid (cdr clock))))))))))) @@ -1115,7 +1106,7 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling "Return the current Emacs idle time in seconds, or nil if not idle." (let ((idle-time (current-idle-time))) (if idle-time - (org-float-time idle-time) + (float-time idle-time) 0))) (defun org-mac-idle-seconds () @@ -1149,7 +1140,7 @@ This routine returns a floating point number." (defvar org-clock-user-idle-seconds) (defun org-resolve-clocks-if-idle () - "Resolve all currently open org-mode clocks. + "Resolve all currently open Org clocks. This is performed after `org-clock-idle-time' minutes, to check if the user really wants to stay clocked in after being idle for so long." @@ -1164,13 +1155,12 @@ so long." (org-clock-resolve (cons org-clock-marker org-clock-start-time) - (function - (lambda (clock) - (format "Clocked in & idle for %.1f mins" - (/ (org-float-time - (time-subtract (current-time) - org-clock-user-idle-start)) - 60.0)))) + (lambda (_) + (format "Clocked in & idle for %.1f mins" + (/ (float-time + (time-subtract (current-time) + org-clock-user-idle-start)) + 60.0))) org-clock-user-idle-start))))) (defvar org-clock-current-task nil "Task currently clocked in.") @@ -1180,15 +1170,22 @@ so long." ;;;###autoload (defun org-clock-in (&optional select start-time) "Start the clock on the current item. + If necessary, clock-out of the currently active clock. -With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked -tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task -and mark it as the default task, a special task that will always be offered -in the clocking selection, associated with the letter `d'. -When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \ -clock in by using the last clock-out -time as the start time \(see `org-clock-continuously' to -make this the default behavior.)" + +With a `\\[universal-argument]' prefix argument SELECT, offer a list of \ +recently clocked +tasks to clock into. + +When SELECT is `\\[universal-argument] \ \\[universal-argument]', \ +clock into the current task and mark it as +the default task, a special task that will always be offered in the +clocking selection, associated with the letter `d'. + +When SELECT is `\\[universal-argument] \\[universal-argument] \ +\\[universal-argument]', clock in by using the last clock-out +time as the start time. See `org-clock-continuously' to make this +the default behavior." (interactive "P") (setq org-clock-notification-was-shown nil) (org-refresh-properties @@ -1208,7 +1205,7 @@ make this the default behavior.)" (not org-clock-resolving-clocks)) (setq org-clock-leftover-time nil) (let ((org-clock-clocking-in t)) - (org-resolve-clocks))) ; check if any clocks are dangling + (org-resolve-clocks))) ; check if any clocks are dangling (when (equal select '(64)) ;; Set start-time to `org-clock-out-time' @@ -1261,116 +1258,116 @@ make this the default behavior.)" (set-buffer (org-base-buffer (marker-buffer selected-task))) (setq target-pos (marker-position selected-task)) (move-marker selected-task nil)) - (save-excursion - (save-restriction - (widen) - (goto-char target-pos) - (org-back-to-heading t) - (or interrupting (move-marker org-clock-interrupted-task nil)) - (run-hooks 'org-clock-in-prepare-hook) - (org-clock-history-push) - (setq org-clock-current-task (nth 4 (org-heading-components))) - (cond ((functionp org-clock-in-switch-to-state) - (looking-at org-complex-heading-regexp) - (let ((newstate (funcall org-clock-in-switch-to-state - (match-string 2)))) - (if newstate (org-todo newstate)))) - ((and org-clock-in-switch-to-state - (not (looking-at (concat org-outline-regexp "[ \t]*" - org-clock-in-switch-to-state - "\\>")))) - (org-todo org-clock-in-switch-to-state))) - (setq org-clock-heading - (cond ((and org-clock-heading-function - (functionp org-clock-heading-function)) - (funcall org-clock-heading-function)) - ((nth 4 (org-heading-components)) - (replace-regexp-in-string - "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" - (match-string-no-properties 4))) - (t "???"))) - (org-clock-find-position org-clock-in-resume) - (cond - ((and org-clock-in-resume - (looking-at - (concat "^[ \t]*" org-clock-string - " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" - " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) - (message "Matched %s" (match-string 1)) - (setq ts (concat "[" (match-string 1) "]")) - (goto-char (match-end 1)) - (setq org-clock-start-time - (apply 'encode-time - (org-parse-time-string (match-string 1)))) - (setq org-clock-effort (org-entry-get (point) org-effort-property)) - (setq org-clock-total-time (org-clock-sum-current-item - (org-clock-get-sum-start)))) - ((eq org-clock-in-resume 'auto-restart) - ;; called from org-clock-load during startup, - ;; do not interrupt, but warn! - (message "Cannot restart clock because task does not contain unfinished clock") - (ding) - (sit-for 2) - (throw 'abort nil)) - (t - (insert-before-markers "\n") - (backward-char 1) - (org-indent-line) - (when (and (save-excursion - (end-of-line 0) - (org-in-item-p))) - (beginning-of-line 1) - (org-indent-line-to (- (org-get-indentation) 2))) - (insert org-clock-string " ") - (setq org-clock-effort (org-entry-get (point) org-effort-property)) - (setq org-clock-total-time (org-clock-sum-current-item - (org-clock-get-sum-start))) - (setq org-clock-start-time - (or (and org-clock-continuously org-clock-out-time) - (and leftover - (y-or-n-p - (format - "You stopped another clock %d mins ago; start this one from then? " - (/ (- (org-float-time - (org-current-time org-clock-rounding-minutes t)) - (org-float-time leftover)) 60))) - leftover) - start-time - (org-current-time org-clock-rounding-minutes t))) - (setq ts (org-insert-time-stamp org-clock-start-time - 'with-hm 'inactive)))) - (move-marker org-clock-marker (point) (buffer-base-buffer)) - (move-marker org-clock-hd-marker - (save-excursion (org-back-to-heading t) (point)) - (buffer-base-buffer)) - (setq org-clock-has-been-used t) - ;; add to mode line - (when (or (eq org-clock-clocked-in-display 'mode-line) - (eq org-clock-clocked-in-display 'both)) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-mode-line-string))))) - ;; add to frame title - (when (or (eq org-clock-clocked-in-display 'frame-title) - (eq org-clock-clocked-in-display 'both)) - (setq frame-title-format org-clock-frame-title-format)) - (org-clock-update-mode-line) - (when org-clock-mode-line-timer - (cancel-timer org-clock-mode-line-timer) - (setq org-clock-mode-line-timer nil)) - (when org-clock-clocked-in-display - (setq org-clock-mode-line-timer - (run-with-timer org-clock-update-period - org-clock-update-period - 'org-clock-update-mode-line))) - (when org-clock-idle-timer - (cancel-timer org-clock-idle-timer) - (setq org-clock-idle-timer nil)) - (setq org-clock-idle-timer - (run-with-timer 60 60 'org-resolve-clocks-if-idle)) - (message "Clock starts at %s - %s" ts org--msg-extra) - (run-hooks 'org-clock-in-hook))))))) + (org-with-wide-buffer + (goto-char target-pos) + (org-back-to-heading t) + (or interrupting (move-marker org-clock-interrupted-task nil)) + (run-hooks 'org-clock-in-prepare-hook) + (org-clock-history-push) + (setq org-clock-current-task (nth 4 (org-heading-components))) + (cond ((functionp org-clock-in-switch-to-state) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) + (let ((newstate (funcall org-clock-in-switch-to-state + (match-string 2)))) + (when newstate (org-todo newstate)))) + ((and org-clock-in-switch-to-state + (not (looking-at (concat org-outline-regexp "[ \t]*" + org-clock-in-switch-to-state + "\\>")))) + (org-todo org-clock-in-switch-to-state))) + (setq org-clock-heading + (cond ((and org-clock-heading-function + (functionp org-clock-heading-function)) + (funcall org-clock-heading-function)) + ((nth 4 (org-heading-components)) + (replace-regexp-in-string + "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" + (match-string-no-properties 4))) + (t "???"))) + (org-clock-find-position org-clock-in-resume) + (cond + ((and org-clock-in-resume + (looking-at + (concat "^[ \t]*" org-clock-string + " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" + " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) + (message "Matched %s" (match-string 1)) + (setq ts (concat "[" (match-string 1) "]")) + (goto-char (match-end 1)) + (setq org-clock-start-time + (apply 'encode-time + (org-parse-time-string (match-string 1)))) + (setq org-clock-effort (org-entry-get (point) org-effort-property)) + (setq org-clock-total-time (org-clock-sum-current-item + (org-clock-get-sum-start)))) + ((eq org-clock-in-resume 'auto-restart) + ;; called from org-clock-load during startup, + ;; do not interrupt, but warn! + (message "Cannot restart clock because task does not contain unfinished clock") + (ding) + (sit-for 2) + (throw 'abort nil)) + (t + (insert-before-markers "\n") + (backward-char 1) + (org-indent-line) + (when (and (save-excursion + (end-of-line 0) + (org-in-item-p))) + (beginning-of-line 1) + (indent-line-to (- (org-get-indentation) 2))) + (insert org-clock-string " ") + (setq org-clock-effort (org-entry-get (point) org-effort-property)) + (setq org-clock-total-time (org-clock-sum-current-item + (org-clock-get-sum-start))) + (setq org-clock-start-time + (or (and org-clock-continuously org-clock-out-time) + (and leftover + (y-or-n-p + (format + "You stopped another clock %d mins ago; start this one from then? " + (/ (- (float-time + (org-current-time org-clock-rounding-minutes t)) + (float-time leftover)) + 60))) + leftover) + start-time + (org-current-time org-clock-rounding-minutes t))) + (setq ts (org-insert-time-stamp org-clock-start-time + 'with-hm 'inactive)))) + (move-marker org-clock-marker (point) (buffer-base-buffer)) + (move-marker org-clock-hd-marker + (save-excursion (org-back-to-heading t) (point)) + (buffer-base-buffer)) + (setq org-clock-has-been-used t) + ;; add to mode line + (when (or (eq org-clock-clocked-in-display 'mode-line) + (eq org-clock-clocked-in-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-mode-line-string))))) + ;; add to frame title + (when (or (eq org-clock-clocked-in-display 'frame-title) + (eq org-clock-clocked-in-display 'both)) + (setq frame-title-format org-clock-frame-title-format)) + (org-clock-update-mode-line) + (when org-clock-mode-line-timer + (cancel-timer org-clock-mode-line-timer) + (setq org-clock-mode-line-timer nil)) + (when org-clock-clocked-in-display + (setq org-clock-mode-line-timer + (run-with-timer org-clock-update-period + org-clock-update-period + 'org-clock-update-mode-line))) + (when org-clock-idle-timer + (cancel-timer org-clock-idle-timer) + (setq org-clock-idle-timer nil)) + (setq org-clock-idle-timer + (run-with-timer 60 60 'org-resolve-clocks-if-idle)) + (message "Clock starts at %s - %s" ts org--msg-extra) + (run-hooks 'org-clock-in-hook)))))) ;;;###autoload (defun org-clock-in-last (&optional arg) @@ -1488,7 +1485,8 @@ line and position cursor in that line." (throw 'exit t))))))) (goto-char beg) (let ((clock-re (concat "^[ \t]*" org-clock-string)) - (count 0) positions first) + (count 0) + positions) ;; Count the CLOCK lines and store their positions. (save-excursion (while (re-search-forward clock-re end t) @@ -1514,9 +1512,9 @@ line and position cursor in that line." ;; When a clock drawer needs to be created because of the ;; number of clock items or simply if it is missing, collect ;; all clocks in the section and wrap them within the drawer. - ((or drawer - (and (wholenump org-clock-into-drawer) - (>= (1+ count) org-clock-into-drawer))) + ((if (wholenump org-clock-into-drawer) + (>= (1+ count) org-clock-into-drawer) + drawer) ;; Skip planning line and property drawer, if any. (org-end-of-meta-data) (let ((beg (point))) @@ -1570,7 +1568,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." ts te s h m remove) (setq org-clock-out-time now) (save-excursion ; Do not replace this with `with-current-buffer'. - (org-no-warnings (set-buffer (org-clocking-buffer))) + (with-no-warnings (set-buffer (org-clocking-buffer))) (save-restriction (widen) (goto-char org-clock-marker) @@ -1583,8 +1581,10 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (delete-region (point) (point-at-eol)) (insert "--") (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) - (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te))) - (org-float-time (apply 'encode-time (org-parse-time-string ts)))) + (setq s (- (float-time + (apply #'encode-time (org-parse-time-string te))) + (float-time + (apply #'encode-time (org-parse-time-string ts)))) h (floor (/ s 3600)) s (- s (* 3600 h)) m (floor (/ s 60)) @@ -1599,8 +1599,9 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (move-marker org-clock-marker nil) (move-marker org-clock-hd-marker nil) (when org-log-note-clock-out - (org-add-log-setup 'clock-out nil nil nil nil - (concat "# Task: " (org-get-heading t) "\n\n"))) + (org-add-log-setup + 'clock-out nil nil nil + (concat "# Task: " (org-get-heading t) "\n\n"))) (when org-clock-mode-line-timer (cancel-timer org-clock-mode-line-timer) (setq org-clock-mode-line-timer nil)) @@ -1617,10 +1618,11 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (org-clock-out-when-done nil)) (cond ((functionp org-clock-out-switch-to-state) - (looking-at org-complex-heading-regexp) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) (let ((newstate (funcall org-clock-out-switch-to-state (match-string 2)))) - (if newstate (org-todo newstate)))) + (when newstate (org-todo newstate)))) ((and org-clock-out-switch-to-state (not (looking-at (concat org-outline-regexp "[ \t]*" org-clock-out-switch-to-state @@ -1630,18 +1632,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (message (concat "Clock stopped at %s after " (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s") te (if remove " => LINE REMOVED" "")) - (let ((h org-clock-out-hook) - (clock-drawer (org-clock-into-drawer))) - ;; If a closing note needs to be stored in the drawer - ;; where clocks are stored, let's temporarily disable - ;; `org-clock-remove-empty-clock-drawer'. - (if (and clock-drawer - (not (stringp clock-drawer)) - (org-log-into-drawer) - (eq org-log-done 'note) - org-clock-out-when-done) - (setq h (delq 'org-clock-remove-empty-clock-drawer h))) - (mapc (lambda (f) (funcall f)) h)) + (run-hooks 'org-clock-out-hook) (unless (org-clocking-p) (setq org-clock-current-task nil))))))) @@ -1698,13 +1689,13 @@ Optional argument N tells to change by that many units." (let ((ts (if updatets1 ts2 ts1)) (begts (if updatets1 begts1 begts2))) (setq tdiff - (subtract-time + (time-subtract (org-time-string-to-time org-last-changed-timestamp) (org-time-string-to-time ts))) (save-excursion (goto-char begts) (org-timestamp-change - (round (/ (org-float-time tdiff) + (round (/ (float-time tdiff) (cond ((eq org-ts-what 'minute) 60) ((eq org-ts-what 'hour) 3600) ((eq org-ts-what 'day) (* 24 3600)) @@ -1723,10 +1714,10 @@ Optional argument N tells to change by that many units." (force-mode-line-update) (error "No active clock")) (save-excursion ; Do not replace this with `with-current-buffer'. - (org-no-warnings (set-buffer (org-clocking-buffer))) + (with-no-warnings (set-buffer (org-clocking-buffer))) (goto-char org-clock-marker) - (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*") - (line-beginning-position)) + (if (looking-back (concat "^[ \t]*" org-clock-string ".*") + (line-beginning-position)) (progn (delete-region (1- (point-at-bol)) (point-at-eol)) (org-remove-empty-drawer-at (point))) (message "Clock gone, cancel the timer anyway") @@ -1757,7 +1748,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (setq recent t) (car org-clock-history)) (t (error "No active or recent clock task"))))) - (org-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)) (goto-char m) (org-show-entry) @@ -1769,9 +1760,8 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (message "No running clock, this is the most recently clocked task")) (run-hooks 'org-clock-goto-hook))) -(defvar org-clock-file-total-minutes nil +(defvar-local org-clock-file-total-minutes nil "Holds the file total time in minutes, after a call to `org-clock-sum'.") -(make-variable-buffer-local 'org-clock-file-total-minutes) (defun org-clock-sum-today (&optional headline-filter) "Sum the times for each subtree for today." @@ -1813,8 +1803,8 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." time) (if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart))) (if (stringp tend) (setq tend (org-time-string-to-seconds tend))) - (if (consp tstart) (setq tstart (org-float-time tstart))) - (if (consp tend) (setq tend (org-float-time tend))) + (if (consp tstart) (setq tstart (float-time tstart))) + (if (consp tend) (setq tend (float-time tend))) (remove-text-properties (point-min) (point-max) `(,(or propname :org-clock-minutes) t :org-clock-force-headline-inclusion t)) @@ -1826,10 +1816,10 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." ;; Two time stamps (setq ts (match-string 2) te (match-string 3) - ts (org-float-time - (apply 'encode-time (org-parse-time-string ts))) - te (org-float-time - (apply 'encode-time (org-parse-time-string te))) + ts (float-time + (apply #'encode-time (org-parse-time-string ts))) + te (float-time + (apply #'encode-time (org-parse-time-string te))) ts (if tstart (max ts tstart) ts) te (if tend (min te tend) te) dt (- te ts) @@ -1845,10 +1835,11 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (equal (marker-position org-clock-hd-marker) (point)) tstart tend - (>= (org-float-time org-clock-start-time) tstart) - (<= (org-float-time org-clock-start-time) tend)) - (let ((time (floor (- (org-float-time) - (org-float-time org-clock-start-time)) 60))) + (>= (float-time org-clock-start-time) tstart) + (<= (float-time org-clock-start-time) tend)) + (let ((time (floor (- (float-time) + (float-time org-clock-start-time)) + 60))) (setq t1 (+ t1 time)))) (let* ((headline-forced (get-text-property (point) @@ -1863,24 +1854,22 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (when (or (> t1 0) (> (aref ltimes level) 0)) (when (or headline-included headline-forced) (if headline-included - (loop for l from 0 to level do - (aset ltimes l (+ (aref ltimes l) t1)))) + (cl-loop for l from 0 to level do + (aset ltimes l (+ (aref ltimes l) t1)))) (setq time (aref ltimes level)) (goto-char (match-beginning 0)) (put-text-property (point) (point-at-eol) (or propname :org-clock-minutes) time) - (if headline-filter - (save-excursion - (save-match-data - (while - (> (funcall outline-level) 1) - (outline-up-heading 1 t) - (put-text-property - (point) (point-at-eol) - :org-clock-force-headline-inclusion t)))))) + (when headline-filter + (save-excursion + (save-match-data + (while (org-up-heading-safe) + (put-text-property + (point) (line-end-position) + :org-clock-force-headline-inclusion t)))))) (setq t1 0) - (loop for l from level to (1- lmax) do - (aset ltimes l 0))))))) + (cl-loop for l from level to (1- lmax) do + (aset ltimes l 0))))))) (setq org-clock-file-total-minutes (aref ltimes 0)))))) (defun org-clock-sum-current-item (&optional tstart) @@ -1896,15 +1885,18 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." "Show subtree times in the entire buffer. By default, show the total time for the range defined in -`org-clock-display-default-range'. With \\[universal-argument] \ +`org-clock-display-default-range'. With `\\[universal-argument]' \ prefix, show -the total time for today instead. With \\[universal-argument] \ -\\[universal-argument] prefix, use -a custom range, entered at the prompt. With \\[universal-argument] \ -\\[universal-argument] \\[universal-argument] -prefix, display the total time in the echo area. +the total time for today instead. + +With `\\[universal-argument] \\[universal-argument]' prefix, \ +use a custom range, entered at prompt. -Use \\[org-clock-remove-overlays] to remove the subtree times." +With `\\[universal-argument] \ \\[universal-argument] \ +\\[universal-argument]' prefix, display the total time in the +echo area. + +Use `\\[org-clock-remove-overlays]' to remove the subtree times." (interactive "P") (org-clock-remove-overlays) (let* ((todayp (equal arg '(4))) @@ -1936,7 +1928,7 @@ Use \\[org-clock-remove-overlays] to remove the subtree times." m (- org-clock-file-total-minutes (* 60 h))) ;; Arrange to remove the overlays upon next change. (when org-remove-highlights-with-change - (org-add-hook 'before-change-functions 'org-clock-remove-overlays + (add-hook 'before-change-functions 'org-clock-remove-overlays nil 'local)))) (message (concat (format "Total file time%s: " (cond (todayp " for today") @@ -1947,8 +1939,7 @@ Use \\[org-clock-remove-overlays] to remove the subtree times." " (%d hours and %d minutes)") h m))) -(defvar org-clock-overlays nil) -(make-variable-buffer-local 'org-clock-overlays) +(defvar-local org-clock-overlays nil) (defun org-clock-put-overlay (time) "Put an overlays on the current line, displaying TIME. @@ -1956,10 +1947,11 @@ This creates a new overlay and stores it in `org-clock-overlays', so that it will be easy to remove." (let (ov tx) (beginning-of-line) - (when (looking-at org-complex-heading-regexp) - (goto-char (match-beginning 4))) + (let ((case-fold-search nil)) + (when (looking-at org-complex-heading-regexp) + (goto-char (match-beginning 4)))) (setq ov (make-overlay (point) (point-at-eol)) - tx (concat (buffer-substring-no-properties (point) (match-end 4)) + tx (concat (buffer-substring-no-properties (point) (match-end 4)) (org-add-props (make-string (max 0 (- (- 60 (current-column)) @@ -1970,20 +1962,17 @@ will be easy to remove." (format " %9s " (org-minutes-to-clocksum-string time)) '(face org-clock-overlay)) "")) - (if (not (featurep 'xemacs)) - (overlay-put ov 'display tx) - (overlay-put ov 'invisible t) - (overlay-put ov 'end-glyph (make-glyph tx))) + (overlay-put ov 'display tx) (push ov org-clock-overlays))) ;;;###autoload -(defun org-clock-remove-overlays (&optional beg end noremove) +(defun org-clock-remove-overlays (&optional _beg _end noremove) "Remove the occur highlights from the buffer. -BEG and END are ignored. If NOREMOVE is nil, remove this function -from the `before-change-functions' in the current buffer." +If NOREMOVE is nil, remove this function from the +`before-change-functions' in the current buffer." (interactive) (unless org-inhibit-highlight-removal - (mapc 'delete-overlay org-clock-overlays) + (mapc #'delete-overlay org-clock-overlays) (setq org-clock-overlays nil) (unless noremove (remove-hook 'before-change-functions @@ -2201,22 +2190,22 @@ have priority." (when (and (memq key '(quarter thisq)) (> shift 0)) (error "Looking forward with quarters isn't implemented")))) (when (= shift 0) - (case key - (yesterday (setq key 'today shift -1)) - (lastweek (setq key 'week shift -1)) - (lastmonth (setq key 'month shift -1)) - (lastyear (setq key 'year shift -1)) - (lastq (setq key 'quarter shift -1)))) + (pcase key + (`yesterday (setq key 'today shift -1)) + (`lastweek (setq key 'week shift -1)) + (`lastmonth (setq key 'month shift -1)) + (`lastyear (setq key 'year shift -1)) + (`lastq (setq key 'quarter shift -1)))) ;; Prepare start and end times depending on KEY's type. - (case key - ((day today) (setq m 0 h 0 h1 24 d (+ d shift))) - ((week thisweek) + (pcase key + ((or `day `today) (setq m 0 h 0 h1 24 d (+ d shift))) + ((or `week `thisweek) (let* ((ws (or wstart 1)) (diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))))) (setq m 0 h 0 d (- d diff) d1 (+ 7 d)))) - ((month thismonth) + ((or `month `thismonth) (setq h 0 m 0 d (or mstart 1) month (+ month shift) month1 (1+ month))) - ((quarter thisq) + ((or `quarter `thisq) ;; Compute if this shift remains in this year. If not, compute ;; how many years and quarters we have to shift (via floor*) and ;; compute the shifted years, months and quarters. @@ -2224,7 +2213,7 @@ have priority." ((< (+ (- q 1) shift) 0) ; Shift not in this year. (let* ((interval (* -1 (+ (- q 1) shift))) ;; Set tmp to ((years to shift) (quarters to shift)). - (tmp (org-floor* interval 4))) + (tmp (cl-floor interval 4))) ;; Due to the use of floor, 0 quarters actually means 4. (if (= 0 (nth 1 tmp)) (setq shiftedy (- y (nth 0 tmp)) @@ -2239,35 +2228,35 @@ have priority." (setq shiftedy y) (let ((qshift (* 3 (1- (+ q shift))))) (setq m 0 h 0 d 1 month (+ 1 qshift) month1 (+ 4 qshift)))))) - ((year thisyear) + ((or `year `thisyear) (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) - ((interactive untilnow)) ; Special cases, ignore them. - (t (user-error "No such time block %s" key))) + ((or `interactive `untilnow)) ; Special cases, ignore them. + (_ (user-error "No such time block %s" key))) ;; Format start and end times according to AS-STRINGS. - (let* ((start (case key - (interactive (org-read-date nil t nil "Range start? ")) - (untilnow org-clock--oldest-date) - (t (encode-time 0 m h d month y)))) - (end (case key - (interactive (org-read-date nil t nil "Range end? ")) - (untilnow (current-time)) - (t (encode-time 0 + (let* ((start (pcase key + (`interactive (org-read-date nil t nil "Range start? ")) + (`untilnow org-clock--oldest-date) + (_ (encode-time 0 m h d month y)))) + (end (pcase key + (`interactive (org-read-date nil t nil "Range end? ")) + (`untilnow (current-time)) + (_ (encode-time 0 (or m1 m) (or h1 h) (or d1 d) (or month1 month) (or y1 y))))) (text - (case key - ((day today) (format-time-string "%A, %B %d, %Y" start)) - ((week thisweek) (format-time-string "week %G-W%V" start)) - ((month thismonth) (format-time-string "%B %Y" start)) - ((year thisyear) (format-time-string "the year %Y" start)) - ((quarter thisq) + (pcase key + ((or `day `today) (format-time-string "%A, %B %d, %Y" start)) + ((or `week `thisweek) (format-time-string "week %G-W%V" start)) + ((or `month `thismonth) (format-time-string "%B %Y" start)) + ((or `year `thisyear) (format-time-string "the year %Y" start)) + ((or `quarter `thisq) (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))) - (interactive "(Range interactively set)") - (untilnow "now")))) + (`interactive "(Range interactively set)") + (`untilnow "now")))) (if (not as-strings) (list start end text) (let ((f (cdr org-time-stamp-formats))) (list (format-time-string f start) @@ -2370,25 +2359,31 @@ the currently selected interval size." (setq params (org-combine-plists org-clocktable-defaults params)) (catch 'exit (let* ((scope (plist-get params :scope)) + (files (pcase scope + (`agenda + (org-agenda-files t)) + (`agenda-with-archives + (org-add-archive-files (org-agenda-files t))) + (`file-with-archives + (and buffer-file-name + (org-add-archive-files (list buffer-file-name)))) + (_ (or (buffer-file-name) (current-buffer))))) (block (plist-get params :block)) (ts (plist-get params :tstart)) (te (plist-get params :tend)) - (link (plist-get params :link)) - (maxlevel (or (plist-get params :maxlevel) 3)) (ws (plist-get params :wstart)) (ms (plist-get params :mstart)) (step (plist-get params :step)) - (timestamp (plist-get params :timestamp)) (formatter (or (plist-get params :formatter) org-clock-clocktable-formatter 'org-clocktable-write-default)) - cc range-text ipos pos one-file-with-archives - scope-is-list tbls level) + cc) ;; Check if we need to do steps (when block ;; Get the range text for the header (setq cc (org-clock-special-range block nil t ws ms) - ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) + ts (car cc) + te (nth 1 cc))) (when step ;; Write many tables, in steps (unless (or block (and ts te)) @@ -2396,65 +2391,49 @@ the currently selected interval size." (org-clocktable-steps params) (throw 'exit nil)) - (setq ipos (point)) ; remember the insertion position - - ;; Get the right scope - (setq pos (point)) - (cond - ((and scope (listp scope) (symbolp (car scope))) - (setq scope (eval scope))) - ((eq scope 'agenda) - (setq scope (org-agenda-files t))) - ((eq scope 'agenda-with-archives) - (setq scope (org-agenda-files t)) - (setq scope (org-add-archive-files scope))) - ((eq scope 'file-with-archives) - (setq scope (and buffer-file-name - (org-add-archive-files (list buffer-file-name))) - one-file-with-archives t))) - (setq scope-is-list (and scope (listp scope))) - (if scope-is-list - ;; we collect from several files - (let* ((files scope) - file) - (org-agenda-prepare-buffers files) - (while (setq file (pop files)) - (with-current-buffer (find-buffer-visiting file) - (save-excursion - (save-restriction - (push (org-clock-get-table-data file params) tbls)))))) - ;; Just from the current file - (save-restriction - ;; get the right range into the restriction - (org-agenda-prepare-buffers (list (or (buffer-file-name) - (current-buffer)))) - (cond - ((not scope)) ; use the restriction as it is now - ((eq scope 'file) (widen)) - ((eq scope 'subtree) (org-narrow-to-subtree)) - ((eq scope 'tree) - (while (org-up-heading-safe)) - (org-narrow-to-subtree)) - ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$" - (symbol-name scope))) - (setq level (string-to-number (match-string 1 (symbol-name scope)))) - (catch 'exit - (while (org-up-heading-safe) - (looking-at org-outline-regexp) - (if (<= (org-reduced-level (funcall outline-level)) level) - (throw 'exit nil)))) - (org-narrow-to-subtree))) - ;; do the table, with no file name. - (push (org-clock-get-table-data nil params) tbls))) - - ;; OK, at this point we tbls as a list of tables, one per file - (setq tbls (nreverse tbls)) - - (setq params (plist-put params :multifile scope-is-list)) - (setq params (plist-put params :one-file-with-archives - one-file-with-archives)) - - (funcall formatter ipos tbls params)))) + (org-agenda-prepare-buffers (if (consp files) files (list files))) + + (let ((origin (point)) + (tables + (if (consp files) + (mapcar (lambda (file) + (with-current-buffer (find-buffer-visiting file) + (save-excursion + (save-restriction + (org-clock-get-table-data file params))))) + files) + ;; Get the right restriction for the scope. + (cond + ((not scope)) ;use the restriction as it is now + ((eq scope 'file) (widen)) + ((eq scope 'subtree) (org-narrow-to-subtree)) + ((eq scope 'tree) + (while (org-up-heading-safe)) + (org-narrow-to-subtree)) + ((and (symbolp scope) + (string-match "\\`tree\\([0-9]+\\)\\'" + (symbol-name scope))) + (let ((level (string-to-number + (match-string 1 (symbol-name scope))))) + (catch 'exit + (while (org-up-heading-safe) + (looking-at org-outline-regexp) + (when (<= (org-reduced-level (funcall outline-level)) + level) + (throw 'exit nil)))) + (org-narrow-to-subtree)))) + (list (org-clock-get-table-data nil params)))) + (multifile + ;; Even though `file-with-archives' can consist of + ;; multiple files, we consider this is one extended file + ;; instead. + (cond ((eq scope 'file-with-archives) nil) + ((consp files))))) + + (funcall formatter + origin + tables + (org-combine-plists params `(:multifile ,multifile))))))) (defun org-clocktable-write-default (ipos tables params) "Write out a clock table at position IPOS in the current buffer. @@ -2469,14 +2448,12 @@ from the dynamic block definition." ;; well-defined number of columns... (let* ((hlchars '((1 . "*") (2 . "/"))) (lwords (assoc (or (plist-get params :lang) - (org-bound-and-true-p org-export-default-language) + (bound-and-true-p org-export-default-language) "en") org-clock-clocktable-language-setup)) (multifile (plist-get params :multifile)) (block (plist-get params :block)) (sort (plist-get params :sort)) - (ts (plist-get params :tstart)) - (te (plist-get params :tend)) (header (plist-get params :header)) (narrow (plist-get params :narrow)) (ws (or (plist-get params :wstart) 1)) @@ -2490,7 +2467,6 @@ from the dynamic block definition." (timestamp (plist-get params :timestamp)) (properties (plist-get params :properties)) (ntcol (max 1 (or (plist-get params :tcolumns) 100))) - (rm-file-column (plist-get params :one-file-with-archives)) (indent (plist-get params :indent)) (case-fold-search t) range-text total-time tbl level hlc formula pcol @@ -2695,10 +2671,6 @@ from the dynamic block definition." (org-table-goto-column pcol nil 'force) (insert "%"))) (org-table-recalculate 'all)) - (when rm-file-column - ;; The file column is actually not wanted - (forward-char 1) - (org-table-delete-column)) total-time)) (defun org-clocktable-indent-string (level) @@ -2718,26 +2690,26 @@ LEVEL is an integer. Indent by two spaces per level above 1." (step (cdr (assoc step0 '((day . 86400) (week . 604800))))) (stepskip0 (plist-get p1 :stepskip0)) (block (plist-get p1 :block)) - cc range-text step-time tsb) + cc step-time tsb) (when block (setq cc (org-clock-special-range block nil t ws ms) - ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) + ts (car cc) + te (nth 1 cc))) (cond ((numberp ts) - ;; If ts is a number, it's an absolute day number from org-agenda. - (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts) - (setq ts (org-float-time (encode-time 0 0 0 day month year))))) + ;; If ts is a number, it's an absolute day number from + ;; org-agenda. + (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute ts))) + (setq ts (float-time (encode-time 0 0 0 day month year))))) (ts - (setq ts (org-float-time - (apply 'encode-time (org-parse-time-string ts)))))) + (setq ts (float-time (apply #'encode-time (org-parse-time-string ts)))))) (cond ((numberp te) ;; Likewise for te. - (destructuring-bind (month day year) (calendar-gregorian-from-absolute te) - (setq te (org-float-time (encode-time 0 0 0 day month year))))) + (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute te))) + (setq te (float-time (encode-time 0 0 0 day month year))))) (te - (setq te (org-float-time - (apply 'encode-time (org-parse-time-string te)))))) + (setq te (float-time (apply #'encode-time (org-parse-time-string te)))))) (setq tsb (if (eq step0 'week) (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws))) @@ -2780,7 +2752,7 @@ following structure: (LEVEL HEADLINE TIMESTAMP TIME) LEVEL: The level of the headline, as an integer. This will be - the reduced leve, so 1,2,3,... even if only odd levels + the reduced level, so 1,2,3,... even if only odd levels are being used. HEADLINE: The text of the headline. Depending on PARAMS, this may already be formatted like a link. @@ -2801,14 +2773,14 @@ TIME: The sum of all time spend in this tree, in minutes. This time (tags (plist-get params :tags)) (properties (plist-get params :properties)) (inherit-property-p (plist-get params :inherit-props)) - todo-only - (matcher (if tags (cdr (org-make-tags-matcher tags)))) - cc range-text st p time level hdl props tsp tbl) + (matcher (and tags (cdr (org-make-tags-matcher tags)))) + cc st p time level hdl props tsp tbl) (setq org-clock-file-total-minutes nil) (when block (setq cc (org-clock-special-range block nil t ws ms) - ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) + ts (car cc) + te (nth 1 cc))) (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts))) (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) (when (and ts (listp ts)) @@ -2820,12 +2792,12 @@ TIME: The sum of all time spend in this tree, in minutes. This time (if te (setq te (org-matcher-time te))) (save-excursion (org-clock-sum ts te - (unless (null matcher) - (lambda () - (let* ((tags-list (org-get-tags-at)) - (org-scanner-tags tags-list) - (org-trust-scanner-tags t)) - (eval matcher))))) + (when matcher + `(lambda () + (let* ((tags-list (org-get-tags-at)) + (org-scanner-tags tags-list) + (org-trust-scanner-tags t)) + (funcall ,matcher nil tags-list nil))))) (goto-char (point-min)) (setq st t) (while (or (and (bobp) (prog1 st (setq st nil)) @@ -2837,7 +2809,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time (when (setq time (get-text-property p :org-clock-minutes)) (save-excursion (beginning-of-line 1) - (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) + (when (and (looking-at "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$") (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))) (<= level maxlevel)) @@ -2852,7 +2824,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time (replace-regexp-in-string org-bracket-link-regexp (lambda (m) (or (match-string 3 m) - (match-string 1 m))) + (match-string 1 m))) (match-string 2))))) tsp (when timestamp (setq props (org-entry-properties (point))) @@ -2930,10 +2902,10 @@ Otherwise, return nil." (end-of-line 1) (setq ts (match-string 1) te (match-string 3)) - (setq s (- (org-float-time - (apply 'encode-time (org-parse-time-string te))) - (org-float-time - (apply 'encode-time (org-parse-time-string ts)))) + (setq s (- (float-time + (apply #'encode-time (org-parse-time-string te))) + (float-time + (apply #'encode-time (org-parse-time-string ts)))) neg (< s 0) s (abs s) h (floor (/ s 3600)) @@ -2976,7 +2948,7 @@ The details of what will be saved are regulated by the variable (when (and (memq org-clock-persist '(t history)) org-clock-history) (insert - "(setq stored-clock-history '(" + "(setq org-clock-stored-history '(" (mapconcat (lambda (m) (when (and (setq b (marker-buffer m)) @@ -2995,22 +2967,20 @@ The details of what will be saved are regulated by the variable (when (and org-clock-persist (not org-clock-loaded)) (let ((filename (expand-file-name org-clock-persist-file)) (org-clock-in-resume 'auto-restart) - resume-clock stored-clock-history) + resume-clock) (if (not (file-readable-p filename)) (message "Not restoring clock data; %s not found" org-clock-persist-file) (message "%s" "Restoring clock data") (setq org-clock-loaded t) + ;; Load history. (load-file filename) - ;; load history - (when stored-clock-history - (save-window-excursion - (mapc (lambda (task) - (if (file-exists-p (car task)) - (org-clock-history-push (cdr task) - (find-file (car task))))) - stored-clock-history))) - ;; resume clock + (save-window-excursion + (dolist (task org-clock-stored-history) + (when (file-exists-p (car task)) + (org-clock-history-push (cdr task) + (find-file (car task)))))) + ;; Resume clock. (when (and resume-clock org-clock-persist (file-exists-p (car resume-clock)) (or (not org-clock-persist-query-resume) @@ -3021,8 +2991,9 @@ The details of what will be saved are regulated by the variable (save-excursion (goto-char (cdr resume-clock)) (org-back-to-heading t) - (and (looking-at org-complex-heading-regexp) - (match-string 4)))) + (let ((case-fold-search nil)) + (and (looking-at org-complex-heading-regexp) + (match-string 4))))) ") ")))) (when (file-exists-p (car resume-clock)) (with-current-buffer (find-file (car resume-clock)) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index eade725..d33f505 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -1,4 +1,4 @@ -;;; org-colview.el --- Column View in Org-mode +;;; org-colview.el --- Column View in Org -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -28,42 +28,117 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'org) -(declare-function org-agenda-redo "org-agenda" ()) +(declare-function org-agenda-redo "org-agenda" (&optional all)) (declare-function org-agenda-do-context-action "org-agenda" ()) (declare-function org-clock-sum-today "org-clock" (&optional headline-filter)) - -(when (featurep 'xemacs) - (error "Do not load this file into XEmacs, use `org-colview-xemacs.el' from the contrib/ directory")) - +(declare-function org-element-extract-element "org-element" (element)) +(declare-function org-element-interpret-data "org-element" (data)) +(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated)) +(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-restriction "org-element" (element)) +(declare-function org-element-type "org-element" (element)) + +(defvar org-agenda-columns-add-appointments-to-effort-sum) +(defvar org-agenda-columns-compute-summary-properties) +(defvar org-agenda-columns-show-summaries) +(defvar org-agenda-view-columns-initially) +(defvar org-inlinetask-min-level) + + +;;; Configuration + +(defcustom org-columns-modify-value-for-display-function nil + "Function that modifies values for display in column view. +For example, it can be used to cut out a certain part from a time stamp. +The function must take 2 arguments: + +column-title The title of the column (*not* the property name) +value The value that should be modified. + +The function should return the value that should be displayed, +or nil if the normal value should be used." + :group 'org-properties + :type '(choice (const nil) (function))) + +(defcustom org-columns-summary-types nil + "Alist between operators and summarize functions. + +Each association follows the pattern (LABEL . SUMMARIZE) where + + LABEL is a string used in #+COLUMNS definition describing the + summary type. It can contain any character but \"}\". It is + case-sensitive. + + SUMMARIZE is a function called with two arguments. The first + argument is a non-empty list of values, as non-empty strings. + The second one is a format string or nil. It has to return + a string summarizing the list of values. + +Note that the return value can become one value for an higher +order summary, so the function is expected to handle its own +output. + +Types defined in this variable take precedence over those defined +in `org-columns-summary-types-default', which see." + :group 'org-properties + :version "25.2" + :package-version '(Org . "9.0") + :type '(alist :key-type (string :tag " Label") + :value-type (function :tag "Summarize"))) + + + ;;; Column View (defvar org-columns-overlays nil "Holds the list of current column overlays.") -(defvar org-columns-current-fmt nil +(defvar org-columns--time 0.0 + "Number of seconds since the epoch, as a floating point number.") + +(defvar-local org-columns-current-fmt nil "Local variable, holds the currently active column format.") -(make-variable-buffer-local 'org-columns-current-fmt) -(defvar org-columns-current-fmt-compiled nil + +(defvar-local org-columns-current-fmt-compiled nil "Local variable, holds the currently active column format. This is the compiled version of the format.") -(make-variable-buffer-local 'org-columns-current-fmt-compiled) -(defvar org-columns-current-widths nil - "Loval variable, holds the currently widths of fields.") -(make-variable-buffer-local 'org-columns-current-widths) -(defvar org-columns-current-maxwidths nil - "Loval variable, holds the currently active maximum column widths.") -(make-variable-buffer-local 'org-columns-current-maxwidths) + +(defvar-local org-columns-current-maxwidths nil + "Currently active maximum column widths, as a vector.") + (defvar org-columns-begin-marker (make-marker) "Points to the position where last a column creation command was called.") + (defvar org-columns-top-level-marker (make-marker) "Points to the position where current columns region starts.") (defvar org-columns-map (make-sparse-keymap) "The keymap valid in column display.") +(defconst org-columns-summary-types-default + '(("+" . org-columns--summary-sum) + ("$" . org-columns--summary-currencies) + ("X" . org-columns--summary-checkbox) + ("X/" . org-columns--summary-checkbox-count) + ("X%" . org-columns--summary-checkbox-percent) + ("max" . org-columns--summary-max) + ("mean" . org-columns--summary-mean) + ("min" . org-columns--summary-min) + (":" . org-columns--summary-sum-times) + (":max" . org-columns--summary-max-time) + (":mean" . org-columns--summary-mean-time) + (":min" . org-columns--summary-min-time) + ("@max" . org-columns--summary-max-age) + ("@mean" . org-columns--summary-mean-age) + ("@min" . org-columns--summary-min-age) + ("est+" . org-columns--summary-estimate)) + "Map operators to summarize functions. +See `org-columns-summary-types' for details.") + (defun org-columns-content () "Switch to contents view while in columns view." (interactive) @@ -146,12 +221,77 @@ This is the compiled version of the format.") "--" ["Quit" org-columns-quit t])) -(defun org-columns--value (property pos) - "Return value for PROPERTY at buffer position POS." - (or (cdr (assoc-string property (get-text-property pos 'org-summaries) t)) - (org-entry-get pos property 'selective t))) +(defun org-columns--displayed-value (spec value) + "Return displayed value for specification SPEC in current entry. -(defun org-columns-new-overlay (beg end &optional string face) +SPEC is a column format specification as stored in +`org-columns-current-fmt-compiled'. VALUE is the real value to +display, as a string." + (cond + ((and (functionp org-columns-modify-value-for-display-function) + (funcall org-columns-modify-value-for-display-function + (nth 1 spec) + value))) + ((equal (car spec) "ITEM") + (concat (make-string (1- (org-current-level)) + (if org-hide-leading-stars ?\s ?*)) + "* " + (org-columns-compact-links value))) + (value))) + +(defun org-columns--collect-values (&optional agenda) + "Collect values for columns on the current line. + +When optional argument AGENDA is non-nil, assume the value is +meant for the agenda, i.e., caller is `org-agenda-columns'. + +Return a list of triplets (SPEC VALUE DISPLAYED) suitable for +`org-columns--display-here'. + +This function assumes `org-columns-current-fmt-compiled' is +initialized." + (let ((summaries (get-text-property (point) 'org-summaries))) + (mapcar + (lambda (spec) + (pcase spec + (`(,p . ,_) + (let* ((v (or (cdr (assoc spec summaries)) + (org-entry-get (point) p 'selective t) + (and agenda + ;; Effort property is not defined. Try + ;; to use appointment duration. + org-agenda-columns-add-appointments-to-effort-sum + (string= p (upcase org-effort-property)) + (get-text-property (point) 'duration) + (propertize + (org-minutes-to-clocksum-string + (get-text-property (point) 'duration)) + 'face 'org-warning)) + ""))) + (list spec v (org-columns--displayed-value spec v)))))) + org-columns-current-fmt-compiled))) + +(defun org-columns--set-widths (cache) + "Compute the maximum column widths from the format and CACHE. +This function sets `org-columns-current-maxwidths' as a vector of +integers greater than 0." + (setq org-columns-current-maxwidths + (apply #'vector + (mapcar + (lambda (spec) + (pcase spec + (`(,_ ,_ ,(and width (pred wholenump)) . ,_) width) + (`(,_ ,name . ,_) + ;; No width is specified in the columns format. + ;; Compute it by checking all possible values for + ;; PROPERTY. + (let ((width (length name))) + (dolist (entry cache width) + (let ((value (nth 2 (assoc spec (cdr entry))))) + (setq width (max (length value) width)))))))) + org-columns-current-fmt-compiled)))) + +(defun org-columns--new-overlay (beg end &optional string face) "Create a new column overlay and add it to the list." (let ((ov (make-overlay beg end))) (overlay-put ov 'face (or face 'secondary-selection)) @@ -159,9 +299,35 @@ This is the compiled version of the format.") (push ov org-columns-overlays) ov)) -(defun org-columns-display-here (&optional props dateline) - "Overlay the current line with column display." - (interactive) +(defun org-columns--summarize (operator) + "Return summary function associated to string OPERATOR." + (if (not operator) nil + (cdr (or (assoc operator org-columns-summary-types) + (assoc operator org-columns-summary-types-default) + (error "Unknown %S operator" operator))))) + +(defun org-columns--overlay-text (value fmt width property original) + "Return text " + (format fmt + (let ((v (org-columns-add-ellipses value width))) + (pcase property + ("PRIORITY" + (propertize v 'face (org-get-priority-face original))) + ("TAGS" + (if (not org-tags-special-faces-re) + (propertize v 'face 'org-tag) + (replace-regexp-in-string + org-tags-special-faces-re + (lambda (m) (propertize m 'face (org-get-tag-face m))) + v nil nil 1))) + ("TODO" (propertize v 'face (org-get-todo-face original))) + (_ v))))) + +(defun org-columns--display-here (columns &optional dateline) + "Overlay the current line with column display. +COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument +DATELINE is non-nil when the face used should be +`org-agenda-column-dateline'." (save-excursion (beginning-of-line) (let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)") @@ -174,14 +340,7 @@ This is the compiled version of the format.") (font (list :height (face-attribute 'default :height) :family (face-attribute 'default :family))) (face (list color font 'org-column ref-face)) - (face1 (list color font 'org-agenda-column-dateline ref-face)) - (pom (and (eq major-mode 'org-agenda-mode) - (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker)))) - (props (cond (props) - ((eq major-mode 'org-agenda-mode) - (and pom (org-entry-properties pom))) - (t (org-entry-properties))))) + (face1 (list color font 'org-agenda-column-dateline ref-face))) ;; Each column is an overlay on top of a character. So there has ;; to be at least as many characters available on the line as ;; columns to display. @@ -192,66 +351,34 @@ This is the compiled version of the format.") (end-of-line) (let ((inhibit-read-only t)) (insert (make-string (- columns chars) ?\s)))))) - ;; Walk the format. Create and install the overlay for the + ;; Display columns. Create and install the overlay for the ;; current column on the next character. - (dolist (column org-columns-current-fmt-compiled) - (let* ((property (car column)) - (title (nth 1 column)) - (ass (assoc-string property props t)) - (width - (or - (cdr (assoc-string property org-columns-current-maxwidths t)) - (nth 2 column) - (length property))) - (f (format "%%-%d.%ds | " width width)) - (fm (nth 4 column)) - (fc (nth 5 column)) - (calc (nth 7 column)) - (val (or (cdr ass) "")) - (modval - (cond - ((functionp org-columns-modify-value-for-display-function) - (funcall org-columns-modify-value-for-display-function - title val)) - ((equal property "ITEM") (org-columns-compact-links val)) - (fc (org-columns-number-to-string - (org-columns-string-to-number val fm) fm fc)) - ((and calc (functionp calc) - (not (string= val "")) - (not (get-text-property 0 'org-computed val))) - (org-columns-number-to-string - (funcall calc (org-columns-string-to-number val fm)) fm)))) - (string - (format f - (let ((v (org-columns-add-ellipses - (or modval val) width))) - (cond - ((equal property "PRIORITY") - (propertize v 'face (org-get-priority-face val))) - ((equal property "TAGS") - (if (not org-tags-special-faces-re) - (propertize v 'face 'org-tag) - (replace-regexp-in-string - org-tags-special-faces-re - (lambda (m) - (propertize m 'face (org-get-tag-face m))) - v nil nil 1))) - ((equal property "TODO") - (propertize v 'face (org-get-todo-face val))) - (t v))))) - (ov (org-columns-new-overlay - (point) (1+ (point)) string (if dateline face1 face)))) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'org-columns-key property) - (overlay-put ov 'org-columns-value (cdr ass)) - (overlay-put ov 'org-columns-value-modified modval) - (overlay-put ov 'org-columns-pom pom) - (overlay-put ov 'org-columns-format f) - (overlay-put ov 'line-prefix "") - (overlay-put ov 'wrap-prefix "") - (forward-char))) + (let ((i 0) + (last (1- (length columns)))) + (dolist (column columns) + (pcase column + (`(,spec ,original ,value) + (let* ((property (car spec)) + (width (aref org-columns-current-maxwidths i)) + (fmt (format (if (= i last) "%%-%d.%ds |" + "%%-%d.%ds | ") + width width)) + (ov (org-columns--new-overlay + (point) (1+ (point)) + (org-columns--overlay-text + value fmt width property original) + (if dateline face1 face)))) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'org-columns-key property) + (overlay-put ov 'org-columns-value original) + (overlay-put ov 'org-columns-value-modified value) + (overlay-put ov 'org-columns-format fmt) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "") + (forward-char)))) + (cl-incf i))) ;; Make the rest of the line disappear. - (let ((ov (org-columns-new-overlay (point) (line-end-position)))) + (let ((ov (org-columns--new-overlay (point) (line-end-position)))) (overlay-put ov 'invisible t) (overlay-put ov 'keymap org-columns-map) (overlay-put ov 'line-prefix "") @@ -267,7 +394,7 @@ This is the compiled version of the format.") (line-beginning-position 2) 'read-only (substitute-command-keys - "Type \\<org-columns-map>\\[org-columns-edit-value] \ + "Type \\<org-columns-map>`\\[org-columns-edit-value]' \ to edit property"))))))) (defun org-columns-add-ellipses (string width) @@ -293,36 +420,27 @@ for the duration of the command.") (defvar header-line-format) (defvar org-columns-previous-hscroll 0) -(defun org-columns-display-here-title () +(defun org-columns--display-here-title () "Overlay the newline before the current line with the table title." (interactive) - (let ((fmt org-columns-current-fmt-compiled) - string (title "") - property width f column str widths) - (while (setq column (pop fmt)) - (setq property (car column) - str (or (nth 1 column) property) - width (or (cdr (assoc-string property - org-columns-current-maxwidths - t)) - (nth 2 column) - (length str)) - widths (push width widths) - f (format "%%-%d.%ds | " width width) - string (format f str) - title (concat title string))) - (setq title (concat - (org-add-props " " nil 'display '(space :align-to 0)) - ;;(org-add-props title nil 'face '(:weight bold :underline t :inherit default)))) - (org-add-props title nil 'face 'org-column-title))) - (org-set-local 'org-previous-header-line-format header-line-format) - (org-set-local 'org-columns-current-widths (nreverse widths)) - (setq org-columns-full-header-line-format title) + (let ((title "") + (i 0)) + (dolist (column org-columns-current-fmt-compiled) + (pcase column + (`(,property ,name . ,_) + (let* ((width (aref org-columns-current-maxwidths i)) + (fmt (format "%%-%d.%ds | " width width))) + (setq title (concat title (format fmt (or name property))))))) + (cl-incf i)) + (setq-local org-previous-header-line-format header-line-format) + (setq org-columns-full-header-line-format + (concat + (org-add-props " " nil 'display '(space :align-to 0)) + (org-add-props (substring title 0 -1) nil 'face 'org-column-title))) (setq org-columns-previous-hscroll -1) - ; (org-columns-hscoll-title) - (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))) + (add-hook 'post-command-hook 'org-columns-hscroll-title nil 'local))) -(defun org-columns-hscoll-title () +(defun org-columns-hscroll-title () "Set the `header-line-format' so that it scrolls along with the table." (sit-for .0001) ; need to force a redisplay to update window-hscroll (when (not (= (window-hscroll) org-columns-previous-hscroll)) @@ -345,7 +463,7 @@ for the duration of the command.") (when (local-variable-p 'org-previous-header-line-format) (setq header-line-format org-previous-header-line-format) (kill-local-variable 'org-previous-header-line-format) - (remove-hook 'post-command-hook 'org-columns-hscoll-title 'local)) + (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local)) (move-marker org-columns-begin-marker nil) (move-marker org-columns-top-level-marker nil) (org-with-silent-modifications @@ -381,25 +499,26 @@ for the duration of the command.") (org-columns-remove-overlays) (let ((inhibit-read-only t)) (remove-text-properties (point-min) (point-max) '(read-only t)))) - (when (eq major-mode 'org-agenda-mode) + (if (not (eq major-mode 'org-agenda-mode)) + (setq org-columns-current-fmt nil) (setq org-agenda-columns-active nil) (message "Modification not yet reflected in Agenda buffer, use `r' to refresh"))) (defun org-columns-check-computed () - "Check if this column value is computed. -If yes, throw an error indicating that changing it does not make sense." - (let ((val (get-char-property (point) 'org-columns-value))) - (when (and (stringp val) - (get-char-property 0 'org-computed val)) - (error "This value is computed from the entry's children")))) - -(defun org-columns-todo (&optional arg) + "Throw an error if current column value is computed." + (let ((spec (nth (current-column) org-columns-current-fmt-compiled))) + (and + (nth 3 spec) + (assoc spec (get-text-property (line-beginning-position) 'org-summaries)) + (error "This value is computed from the entry's children")))) + +(defun org-columns-todo (&optional _arg) "Change the TODO state during column view." (interactive "P") (org-columns-edit-value "TODO")) -(defun org-columns-set-tags-or-toggle (&optional arg) +(defun org-columns-set-tags-or-toggle (&optional _arg) "Toggle checkbox at point, or set tags for current headline." (interactive "P") (if (string-match "\\`\\[[ xX-]\\]\\'" @@ -417,107 +536,76 @@ Where possible, use the standard interface for changing this line." (interactive) (org-columns-check-computed) (let* ((col (current-column)) + (bol (line-beginning-position)) + (eol (line-end-position)) + (pom (or (get-text-property bol 'org-hd-marker) (point))) (key (or key (get-char-property (point) 'org-columns-key))) - (value (get-char-property (point) 'org-columns-value)) - (bol (point-at-bol)) (eol (point-at-eol)) - (pom (or (get-text-property bol 'org-hd-marker) - (point))) ; keep despite of compiler waring - (line-overlays - (delq nil (mapcar (lambda (x) - (and (eq (overlay-buffer x) (current-buffer)) - (>= (overlay-start x) bol) - (<= (overlay-start x) eol) - x)) - org-columns-overlays))) - (org-columns-time (time-to-number-of-days (current-time))) - nval eval allowed) + (org-columns--time (float-time (current-time))) + (action + (pcase key + ("CLOCKSUM" + (error "This special column cannot be edited")) + ("ITEM" + (lambda () (org-with-point-at pom (org-edit-headline)))) + ("TODO" + (lambda () + (org-with-point-at pom (call-interactively #'org-todo)))) + ("PRIORITY" + (lambda () + (org-with-point-at pom + (call-interactively #'org-priority)))) + ("TAGS" + (lambda () + (org-with-point-at pom + (let ((org-fast-tag-selection-single-key + (if (eq org-fast-tag-selection-single-key 'expert) + t + org-fast-tag-selection-single-key))) + (call-interactively #'org-set-tags))))) + ("DEADLINE" + (lambda () + (org-with-point-at pom (call-interactively #'org-deadline)))) + ("SCHEDULED" + (lambda () + (org-with-point-at pom (call-interactively #'org-schedule)))) + ("BEAMER_ENV" + (lambda () + (org-with-point-at pom + (call-interactively #'org-beamer-select-environment)))) + (_ + (let* ((allowed (org-property-get-allowed-values pom key 'table)) + (value (get-char-property (point) 'org-columns-value)) + (nval (org-trim + (if (null allowed) (read-string "Edit: " value) + (completing-read + "Value: " allowed nil + (not (get-text-property + 0 'org-unrestricted (caar allowed)))))))) + (and (not (equal nval value)) + (lambda () (org-entry-put pom key nval)))))))) (cond - ((equal key "CLOCKSUM") - (error "This special column cannot be edited")) - ((equal key "ITEM") - (setq eval '(org-with-point-at pom - (org-edit-headline)))) - ((equal key "TODO") - (setq eval '(org-with-point-at - pom - (call-interactively 'org-todo)))) - ((equal key "PRIORITY") - (setq eval '(org-with-point-at pom - (call-interactively 'org-priority)))) - ((equal key "TAGS") - (setq eval '(org-with-point-at pom - (let ((org-fast-tag-selection-single-key - (if (eq org-fast-tag-selection-single-key 'expert) - t org-fast-tag-selection-single-key))) - (call-interactively 'org-set-tags))))) - ((equal key "DEADLINE") - (setq eval '(org-with-point-at pom - (call-interactively 'org-deadline)))) - ((equal key "SCHEDULED") - (setq eval '(org-with-point-at pom - (call-interactively 'org-schedule)))) - ((equal key "BEAMER_env") - (setq eval '(org-with-point-at pom - (call-interactively 'org-beamer-select-environment)))) + ((null action)) + ((eq major-mode 'org-agenda-mode) + (org-columns--call action) + ;; The following let preserves the current format, and makes + ;; sure that in only a single file things need to be updated. + (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) + (buffer (marker-buffer pom)) + (org-agenda-contributing-files + (list (with-current-buffer buffer + (buffer-file-name (buffer-base-buffer)))))) + (org-agenda-columns))) (t - (setq allowed (org-property-get-allowed-values pom key 'table)) - (if allowed - (setq nval (org-icompleting-read - "Value: " allowed nil - (not (get-text-property 0 'org-unrestricted - (caar allowed))))) - (setq nval (read-string "Edit: " value))) - (setq nval (org-trim nval)) - (when (not (equal nval value)) - (setq eval '(org-entry-put pom key nval))))) - (when eval - - (cond - ((equal major-mode 'org-agenda-mode) - (org-columns-eval eval) - ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be updated. - (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) - (buffer (marker-buffer pom)) - (org-agenda-contributing-files - (list (with-current-buffer buffer - (buffer-file-name (buffer-base-buffer)))))) - (org-agenda-columns))) - (t - (let ((inhibit-read-only t)) - (org-with-silent-modifications - (remove-text-properties - (max (point-min) (1- bol)) eol '(read-only t))) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'delete-overlay line-overlays) - (org-columns-eval eval)) - (org-columns-display-here))) - (org-move-to-column col) - (if (and (derived-mode-p 'org-mode) - (nth 3 (assoc-string key org-columns-current-fmt-compiled t))) - (org-columns-update key))))))) - -(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda???? - "Edit the current headline, the part without TODO keyword, TAGS." - (org-back-to-heading) - (when (looking-at org-todo-line-regexp) - (let ((pos (point)) - (pre (buffer-substring (match-beginning 0) (match-beginning 3))) - (txt (match-string 3)) - (post "") - txt2) - (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt) - (setq post (match-string 0 txt) - txt (substring txt 0 (match-beginning 0)))) - (setq txt2 (read-string "Edit: " txt)) - (when (not (equal txt txt2)) - (goto-char pos) - (insert pre txt2 post) - (delete-region (point) (point-at-eol)) - (org-set-tags nil t))))) + (let ((inhibit-read-only t)) + (org-with-silent-modifications + (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))) + (org-columns--call action)) + ;; Some properties can modify headline (e.g., "TODO"), and + ;; possible shuffle overlays. Make sure they are still all at + ;; the right place on the current line. + (let ((org-columns-inhibit-recalculation)) (org-columns-redo)) + (org-columns-update key) + (org-move-to-column col))))) (defun org-columns-edit-allowed () "Edit the list of allowed values for the current property." @@ -540,15 +628,15 @@ Where possible, use the standard interface for changing this line." (t pom)) key1 nval))) -(defun org-columns-eval (form) - (let (hidep) - (save-excursion - (beginning-of-line 1) - ;; `next-line' is needed here, because it skips invisible line. - (condition-case nil (org-no-warnings (next-line 1)) (error nil)) - (setq hidep (org-at-heading-p 1))) - (eval form) - (and hidep (outline-hide-entry)))) +(defun org-columns--call (fun) + "Call function FUN while preserving heading visibility. +FUN is a function called with no argument." + (let ((hide-body (and (/= (line-end-position) (point-max)) + (save-excursion + (move-beginning-of-line 2) + (org-at-heading-p t))))) + (unwind-protect (funcall fun) + (when hide-body (outline-hide-entry))))) (defun org-columns-previous-allowed-value () "Switch to the previous allowed value for this column." @@ -561,74 +649,57 @@ When PREVIOUS is set, go to the previous value. When NTH is an integer, select that value." (interactive) (org-columns-check-computed) - (let* ((col (current-column)) + (let* ((column (current-column)) (key (get-char-property (point) 'org-columns-key)) (value (get-char-property (point) 'org-columns-value)) - (bol (point-at-bol)) (eol (point-at-eol)) - (pom (or (get-text-property bol 'org-hd-marker) - (point))) ; keep despite of compiler waring - (line-overlays - (delq nil (mapcar (lambda (x) - (and (eq (overlay-buffer x) (current-buffer)) - (>= (overlay-start x) bol) - (<= (overlay-start x) eol) - x)) - org-columns-overlays))) - (allowed (or (org-property-get-allowed-values pom key) - (and (memq - (nth 4 (assoc-string key - org-columns-current-fmt-compiled - t)) - '(checkbox checkbox-n-of-m checkbox-percent)) - '("[ ]" "[X]")) - (org-colview-construct-allowed-dates value))) - nval) - (when (integerp nth) - (setq nth (1- nth)) - (if (= nth -1) (setq nth 9))) - (when (equal key "ITEM") - (error "Cannot edit item headline from here")) + (pom (or (get-text-property (line-beginning-position) 'org-hd-marker) + (point))) + (allowed + (let ((all + (or (org-property-get-allowed-values pom key) + (pcase (nth column org-columns-current-fmt-compiled) + (`(,_ ,_ ,_ ,(or "X" "X/" "X%") ,_) '("[ ]" "[X]"))) + (org-colview-construct-allowed-dates value)))) + (if previous (reverse all) all)))) + (when (equal key "ITEM") (error "Cannot edit item headline from here")) (unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))) (error "Allowed values for this property have not been defined")) - (if (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")) - (setq nval (if previous 'earlier 'later)) - (if previous (setq allowed (reverse allowed))) + (let* ((l (length allowed)) + (new + (cond + ((member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")) + (if previous 'earlier 'later)) + ((integerp nth) + (when (> (abs nth) l) + (user-error "Only %d allowed values for property `%s'" l key)) + (nth (mod (1- nth) l) allowed)) + ((member value allowed) + (when (= l 1) (error "Only one allowed value for this property")) + (or (nth 1 (member value allowed)) (car allowed))) + (t (car allowed)))) + (action (lambda () (org-entry-put pom key new)))) (cond - (nth - (setq nval (nth nth allowed)) - (if (not nval) - (error "There are only %d allowed values for property `%s'" - (length allowed) key))) - ((member value allowed) - (setq nval (or (car (cdr (member value allowed))) - (car allowed))) - (if (equal nval value) - (error "Only one allowed value for this property"))) - (t (setq nval (car allowed))))) - (cond - ((equal major-mode 'org-agenda-mode) - (org-columns-eval `(org-entry-put ,pom ,key ,nval)) - ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be updated. - (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) - (buffer (marker-buffer pom)) - (org-agenda-contributing-files - (list (with-current-buffer buffer - (buffer-file-name (buffer-base-buffer)))))) - (org-agenda-columns))) - (t - (let ((inhibit-read-only t)) - (remove-text-properties (max (1- bol) (point-min)) eol '(read-only t)) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'delete-overlay line-overlays) - (org-columns-eval `(org-entry-put ,pom ,key ,nval))) - (org-columns-display-here))) - (org-move-to-column col) - (and (nth 3 (assoc-string key org-columns-current-fmt-compiled t)) - (org-columns-update key)))))) + ((eq major-mode 'org-agenda-mode) + (org-columns--call action) + ;; The following let preserves the current format, and makes + ;; sure that in only a single file things need to be updated. + (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) + (buffer (marker-buffer pom)) + (org-agenda-contributing-files + (list (with-current-buffer buffer + (buffer-file-name (buffer-base-buffer)))))) + (org-agenda-columns))) + (t + (let ((inhibit-read-only t)) + (remove-text-properties (line-end-position 0) (line-end-position) + '(read-only t)) + (org-columns--call action)) + ;; Some properties can modify headline (e.g., "TODO"), and + ;; possible shuffle overlays. Make sure they are still all at + ;; the right place on the current line. + (let ((org-columns-inhibit-recalculation)) (org-columns-redo)) + (org-columns-update key) + (org-move-to-column column)))))) (defun org-colview-construct-allowed-dates (s) "Construct a list of three dates around the date in S. @@ -651,13 +722,6 @@ around it." (mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x))) (list time-before time time-after))))) -(defun org-verify-version (task) - (cond - ((eq task 'columns) - (if (or (featurep 'xemacs) - (< emacs-major-version 22)) - (error "Emacs 22 is required for the columns feature"))))) - (defun org-columns-open-link (&optional arg) (interactive "P") (let ((value (get-char-property (point) 'org-columns-value))) @@ -670,14 +734,28 @@ around it." fmt)) (defun org-columns-get-format (&optional fmt-string) + "Return columns format specifications. +When optional argument FMT-STRING is non-nil, use it as the +current specifications. This function also sets +`org-columns-current-fmt-compiled' and +`org-columns-current-fmt'." (interactive) - (let (fmt-as-property fmt) - (when (condition-case nil (org-back-to-heading) (error nil)) - (setq fmt-as-property (org-entry-get nil "COLUMNS" t))) - (setq fmt (or fmt-string fmt-as-property org-columns-default-format)) - (org-set-local 'org-columns-current-fmt fmt) - (org-columns-compile-format fmt) - fmt)) + (let ((format + (or fmt-string + (org-entry-get nil "COLUMNS" t) + (org-with-wide-buffer + (goto-char (point-min)) + (catch :found + (let ((case-fold-search t)) + (while (re-search-forward "^[ \t]*#\\+COLUMNS: .+$" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (throw :found (org-element-property :value element))))) + nil))) + org-columns-default-format))) + (setq org-columns-current-fmt format) + (org-columns-compile-format format) + format)) (defun org-columns-goto-top-level () "Move to the beginning of the column view area. @@ -690,162 +768,130 @@ Also sets `org-columns-top-level-marker' to the new position." (t (org-back-to-heading) (point)))))) ;;;###autoload -(defun org-columns (&optional columns-fmt-string) - "Turn on column view on an org-mode file. +(defun org-columns (&optional global columns-fmt-string) + "Turn on column view on an Org mode file. + +Column view applies to the whole buffer if point is before the +first headline. Otherwise, it applies to the first ancestor +setting \"COLUMNS\" property. If there is none, it defaults to +the current headline. With a `\\[universal-argument]' prefix \ +argument, turn on column +view for the whole buffer unconditionally. + When COLUMNS-FMT-STRING is non-nil, use it as the column format." - (interactive) - (org-verify-version 'columns) + (interactive "P") (org-columns-remove-overlays) (move-marker org-columns-begin-marker (point)) (org-columns-goto-top-level) ;; Initialize `org-columns-current-fmt' and ;; `org-columns-current-fmt-compiled'. - (let ((org-columns-time (time-to-number-of-days (current-time)))) - (org-columns-get-format columns-fmt-string)) - (unless org-columns-inhibit-recalculation (org-columns-compute-all)) - (save-excursion - (save-restriction - (narrow-to-region - (point) - (if (org-at-heading-p) (org-end-of-subtree t t) (point-max))) - (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) - (org-clock-sum)) - (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) - (org-clock-sum-today)) - (let* ((column-names (mapcar #'car org-columns-current-fmt-compiled)) - (cache - (org-map-entries - (lambda () - (cons (point) - (mapcar (lambda (p) - (cons p (org-columns--value p (point)))) - column-names))) - nil nil (and org-columns-skip-archived-trees 'archive)))) - (when cache - (org-set-local 'org-columns-current-maxwidths - (org-columns-get-autowidth-alist - org-columns-current-fmt - cache)) - (org-columns-display-here-title) - (when (org-set-local 'org-columns-flyspell-was-active - (org-bound-and-true-p flyspell-mode)) - (flyspell-mode 0)) - (unless (local-variable-p 'org-colview-initial-truncate-line-value) - (org-set-local 'org-colview-initial-truncate-line-value - truncate-lines)) - (setq truncate-lines t) - (dolist (x cache) - (goto-char (car x)) - (org-columns-display-here (cdr x)))))))) - -(eval-when-compile (defvar org-columns-time)) - -(defvar org-columns-compile-map - '(("none" none +) - (":" add_times +) - ("+" add_numbers +) - ("$" currency +) - ("X" checkbox +) - ("X/" checkbox-n-of-m +) - ("X%" checkbox-percent +) - ("max" max_numbers max) - ("min" min_numbers min) - ("mean" mean_numbers - (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - (":max" max_times max) - (":min" min_times min) - (":mean" mean_times - (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - ("@min" min_age min (lambda (x) (- org-columns-time x))) - ("@max" max_age max (lambda (x) (- org-columns-time x))) - ("@mean" mean_age - (lambda (&rest x) (/ (apply '+ x) (float (length x)))) - (lambda (x) (- org-columns-time x))) - ("est+" estimate org-estimate-combine)) - "Operator <-> format,function,calc map. -Used to compile/uncompile columns format and completing read in -interactive function `org-columns-new'. - -operator string used in #+COLUMNS definition describing the - summary type -format symbol describing summary type selected interactively in - `org-columns-new' and internally in - `org-columns-number-to-string' and - `org-columns-string-to-number' -function called with a list of values as argument to calculate - the summary value -calc function called on every element before summarizing. This is - optional and should only be specified if needed") - -(defun org-columns-new (&optional prop title width op fmt fun &rest rest) - "Insert a new column, to the left of the current column." + (let ((org-columns--time (float-time (current-time)))) + (org-columns-get-format columns-fmt-string) + (unless org-columns-inhibit-recalculation (org-columns-compute-all)) + (save-excursion + (save-restriction + (when (and (not global) (org-at-heading-p)) + (narrow-to-region (point) (org-end-of-subtree t t))) + (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) + (org-clock-sum)) + (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) + (org-clock-sum-today)) + (let ((cache + ;; Collect contents of columns ahead of time so as to + ;; compute their maximum width. + (org-map-entries + (lambda () (cons (point) (org-columns--collect-values))) + nil nil (and org-columns-skip-archived-trees 'archive)))) + (when cache + (org-columns--set-widths cache) + (org-columns--display-here-title) + (when (setq-local org-columns-flyspell-was-active + (bound-and-true-p flyspell-mode)) + (flyspell-mode 0)) + (unless (local-variable-p 'org-colview-initial-truncate-line-value) + (setq-local org-colview-initial-truncate-line-value + truncate-lines)) + (setq truncate-lines t) + (dolist (entry cache) + (goto-char (car entry)) + (org-columns--display-here (cdr entry))))))))) + +(defun org-columns-new (&optional spec &rest attributes) + "Insert a new column, to the left of the current column. +Interactively fill attributes for new column. When column format +specification SPEC is provided, edit it instead. + +When optional argument attributes can be a list of columns +specifications attributes to create the new column +non-interactively. See `org-columns-compile-format' for +details." (interactive) - (let ((editp (and prop - (assoc-string prop org-columns-current-fmt-compiled t))) - cell) - (setq prop (org-icompleting-read - "Property: " (mapcar 'list (org-buffer-property-keys t nil t)) - nil nil prop)) - (setq title (read-string (concat "Column title [" prop "]: ") (or title prop))) - (setq width (read-string "Column width: " (if width (number-to-string width)))) - (if (string-match "\\S-" width) - (setq width (string-to-number width)) - (setq width nil)) - (setq fmt (org-icompleting-read - "Summary [none]: " - (mapcar (lambda (x) (list (symbol-name (cadr x)))) - org-columns-compile-map) - nil t)) - (setq fmt (intern fmt) - fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map)))) - (if (eq fmt 'none) (setq fmt nil)) - (if editp - (progn - (setcar editp prop) - (setcdr editp (list title width nil fmt nil fun))) - (setq cell (nthcdr (1- (current-column)) - org-columns-current-fmt-compiled)) - (setcdr cell (cons (list prop title width nil fmt nil - (car fun) (cadr fun)) - (cdr cell)))) + (let ((new (or attributes + (let ((prop + (completing-read + "Property: " + (mapcar #'list (org-buffer-property-keys t nil t)) + nil nil (nth 0 spec)))) + (list prop + (read-string (format "Column title [%s]: " prop) + (nth 1 spec)) + ;; Use `read-string' instead of `read-number' + ;; to allow empty width. + (let ((w (read-string + "Column width: " + (and (nth 2 spec) + (number-to-string (nth 2 spec)))))) + (and (org-string-nw-p w) (string-to-number w))) + (org-string-nw-p + (completing-read + "Summary: " + (delete-dups + (cons '("") ;Allow empty operator. + (mapcar (lambda (x) (list (car x))) + (append + org-columns-summary-types + org-columns-summary-types-default)))) + nil t (nth 3 spec))) + (org-string-nw-p + (read-string "Format: " (nth 4 spec)))))))) + (if spec + (progn (setcar spec (car new)) + (setcdr spec (cdr new))) + (push new (nthcdr (current-column) org-columns-current-fmt-compiled))) (org-columns-store-format) (org-columns-redo))) (defun org-columns-delete () "Delete the column at point from columns view." (interactive) - (let* ((n (current-column)) - (title (nth 1 (nth n org-columns-current-fmt-compiled)))) - (when (y-or-n-p - (format "Are you sure you want to remove column \"%s\"? " title)) + (let ((spec (nth (current-column) org-columns-current-fmt-compiled))) + (when (y-or-n-p (format "Are you sure you want to remove column %S? " + (nth 1 spec))) (setq org-columns-current-fmt-compiled - (delq (nth n org-columns-current-fmt-compiled) - org-columns-current-fmt-compiled)) + (delq spec org-columns-current-fmt-compiled)) (org-columns-store-format) - (org-columns-redo) - (if (>= (current-column) (length org-columns-current-fmt-compiled)) - (backward-char 1))))) + ;; This may leave a now wrong value in a node property. However + ;; updating it may prove counter-intuitive. See comments in + ;; `org-columns-move-right' for details. + (let ((org-columns-inhibit-recalculation t)) (org-columns-redo)) + (when (>= (current-column) (length org-columns-current-fmt-compiled)) + (backward-char))))) (defun org-columns-edit-attributes () "Edit the attributes of the current column." (interactive) - (let* ((n (current-column)) - (info (nth n org-columns-current-fmt-compiled))) - (apply 'org-columns-new info))) + (org-columns-new (nth (current-column) org-columns-current-fmt-compiled))) (defun org-columns-widen (arg) "Make the column wider by ARG characters." (interactive "p") (let* ((n (current-column)) (entry (nth n org-columns-current-fmt-compiled)) - (width (or (nth 2 entry) - (cdr (assoc-string (car entry) - org-columns-current-maxwidths - t))))) + (width (aref org-columns-current-maxwidths n))) (setq width (max 1 (+ width arg))) (setcar (nthcdr 2 entry) width) (org-columns-store-format) - (org-columns-redo))) + (let ((org-columns-inhibit-recalculation t)) (org-columns-redo)))) (defun org-columns-narrow (arg) "Make the column narrower by ARG characters." @@ -864,7 +910,16 @@ calc function called on every element before summarizing. This is (setcar cell (car (cdr cell))) (setcdr cell (cons e (cdr (cdr cell)))) (org-columns-store-format) - (org-columns-redo) + ;; Do not compute again properties, since we're just moving + ;; columns around. It can put a property value a bit off when + ;; switching between an non-computed and a computed value for the + ;; same property, e.g. from "%A %A{+}" to "%A{+} %A". + ;; + ;; In this case, the value needs to be updated since the first + ;; column related to a property determines how its value is + ;; computed. However, (correctly) updating the value could be + ;; surprising, so we leave it as-is nonetheless. + (let ((org-columns-inhibit-recalculation t)) (org-columns-redo)) (forward-char 1))) (defun org-columns-move-left () @@ -878,364 +933,447 @@ calc function called on every element before summarizing. This is (backward-char 1))) (defun org-columns-store-format () - "Store the text version of the current columns format in appropriate place. -This is either in the COLUMNS property of the node starting the current column -display, or in the #+COLUMNS line of the current buffer." - (let (fmt (cnt 0)) - (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)) - (org-set-local 'org-columns-current-fmt fmt) - (if (marker-position org-columns-top-level-marker) - (save-excursion - (goto-char org-columns-top-level-marker) - (if (and (org-at-heading-p) - (org-entry-get nil "COLUMNS")) - (org-entry-put nil "COLUMNS" fmt) - (goto-char (point-min)) - ;; Overwrite all #+COLUMNS lines.... - (while (re-search-forward "^[ \t]*#\\+COLUMNS:.*" nil t) - (setq cnt (1+ cnt)) - (replace-match (concat "#+COLUMNS: " fmt) t t)) - (unless (> cnt 0) - (goto-char (point-min)) - (or (org-at-heading-p t) (outline-next-heading)) - (let ((inhibit-read-only t)) - (insert-before-markers "#+COLUMNS: " fmt "\n"))) - (org-set-local 'org-columns-default-format fmt)))))) - -(defun org-columns-get-autowidth-alist (s cache) - "Derive the maximum column widths from the format and the cache." - (let ((start 0) rtn) - (while (string-match (org-re "%\\([[:alpha:]][[:alnum:]_-]*\\)") s start) - (push (cons (match-string 1 s) 1) rtn) - (setq start (match-end 0))) - (mapc (lambda (x) - (setcdr x - (apply #'max - (let ((prop (car x))) - (mapcar - (lambda (y) - (length (or (cdr (assoc-string prop (cdr y) t)) - " "))) - cache))))) - rtn) - rtn)) - -(defun org-columns-compute-all () - "Compute all columns that have operators defined." - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) - (let ((columns org-columns-current-fmt-compiled) - (org-columns-time (time-to-number-of-days (current-time))) - col) - (while (setq col (pop columns)) - (when (nth 3 col) - (save-excursion - (org-columns-compute (car col))))))) + "Store the text version of the current columns format. +The format is stored either in the COLUMNS property of the node +starting the current column display, or in a #+COLUMNS line of +the current buffer." + (let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))) + (setq-local org-columns-current-fmt fmt) + (when (marker-position org-columns-top-level-marker) + (org-with-wide-buffer + (goto-char org-columns-top-level-marker) + (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS")) + (org-entry-put nil "COLUMNS" fmt) + (goto-char (point-min)) + (let ((case-fold-search t)) + ;; Try to replace the first COLUMNS keyword available. + (catch :found + (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t) + (let ((element (save-match-data (org-element-at-point)))) + (when (and (eq (org-element-type element) 'keyword) + (equal (org-element-property :key element) + "COLUMNS")) + (replace-match (concat " " fmt) t t nil 1) + (throw :found nil)))) + ;; No COLUMNS keyword in the buffer. Insert one at the + ;; beginning, right before the first heading, if any. + (goto-char (point-min)) + (unless (org-at-heading-p t) (outline-next-heading)) + (let ((inhibit-read-only t)) + (insert-before-markers "#+COLUMNS: " fmt "\n")))) + (setq-local org-columns-default-format fmt)))))) (defun org-columns-update (property) "Recompute PROPERTY, and update the columns display for it." (org-columns-compute property) - (let (fmt val pos) - (save-excursion - (mapc (lambda (ov) - (when (equal (overlay-get ov 'org-columns-key) property) - (setq pos (overlay-start ov)) - (goto-char pos) - (when (setq val (cdr (assoc-string - property - (get-text-property - (point-at-bol) 'org-summaries) - t))) - (setq fmt (overlay-get ov 'org-columns-format)) - (overlay-put ov 'org-columns-value val) - (overlay-put ov 'display (format fmt val))))) - org-columns-overlays)))) - -(defvar org-inlinetask-min-level - (if (featurep 'org-inlinetask) org-inlinetask-min-level 15)) - -;;;###autoload -(defun org-columns-compute (property) - "Sum the values of property PROPERTY hierarchically, for the entire buffer." - (interactive) - (let* ((re org-outline-regexp-bol) - (lmax 30) ; Does anyone use deeper levels??? - (lvals (make-vector lmax nil)) - (lflag (make-vector lmax nil)) - (level 0) - (ass (assoc-string property org-columns-current-fmt-compiled t)) - (format (nth 4 ass)) - (printf (nth 5 ass)) - (fun (nth 6 ass)) - (calc (or (nth 7 ass) 'identity)) - (beg org-columns-top-level-marker) - (inminlevel org-inlinetask-min-level) - (last-level org-inlinetask-min-level) - val valflag flag end sumpos sum-alist sum str str1 useval) - (save-excursion - ;; Find the region to compute - (goto-char beg) - (setq end (condition-case nil (org-end-of-subtree t) (error (point-max)))) - (goto-char end) - ;; Walk the tree from the back and do the computations - (while (re-search-backward re beg t) - (setq sumpos (match-beginning 0) - last-level (if (not (or (zerop level) (eq level inminlevel))) - level last-level) - level (org-outline-level) - val (org-entry-get nil property) - valflag (and val (string-match "\\S-" val))) - (cond - ((< level last-level) - ;; Put the sum of lower levels here as a property. If - ;; values are estimate, use an appropriate sum function. - (setq sum (funcall - (if (eq fun 'org-estimate-combine) #'org-estimate-combine - #'+) - (if (and (/= last-level inminlevel) - (aref lvals last-level)) - (apply fun (aref lvals last-level)) 0) - (if (aref lvals inminlevel) - (apply fun (aref lvals inminlevel)) 0)) - flag (or (aref lflag last-level) ; any valid entries from children? - (aref lflag inminlevel)) ; or inline tasks? - str (org-columns-number-to-string sum format printf) - str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) - useval (if flag str1 (if valflag val "")) - sum-alist (get-text-property sumpos 'org-summaries)) - (let ((old (assoc-string property sum-alist t))) - (if old (setcdr old useval) - (push (cons property useval) sum-alist) - (org-with-silent-modifications - (add-text-properties sumpos (1+ sumpos) - (list 'org-summaries sum-alist))))) - (when (and val (not (equal val (if flag str val)))) - (org-entry-put nil property (if flag str val))) - ;; add current to current level accumulator - (when (or flag valflag) - (push (if flag - sum - (funcall calc (org-columns-string-to-number - (if flag str val) format))) - (aref lvals level)) - (aset lflag level t)) - ;; clear accumulators for deeper levels - (loop for l from (1+ level) to (1- lmax) do - (aset lvals l nil) - (aset lflag l nil))) - ((>= level last-level) - ;; add what we have here to the accumulator for this level - (when valflag - (push (funcall calc (org-columns-string-to-number val format)) - (aref lvals level)) - (aset lflag level t))) - (t (error "This should not happen"))))))) + (org-with-wide-buffer + (let ((p (upcase property))) + (dolist (ov org-columns-overlays) + (let ((key (overlay-get ov 'org-columns-key))) + (when (and key (equal key p) (overlay-start ov)) + (goto-char (overlay-start ov)) + (let* ((spec (nth (current-column) org-columns-current-fmt-compiled)) + (value + (or (cdr (assoc spec + (get-text-property (line-beginning-position) + 'org-summaries))) + (org-entry-get (point) key)))) + (when value + (let ((displayed (org-columns--displayed-value spec value)) + (format (overlay-get ov 'org-columns-format)) + (width + (aref org-columns-current-maxwidths (current-column)))) + (overlay-put ov 'org-columns-value value) + (overlay-put ov 'org-columns-value-modified displayed) + (overlay-put ov + 'display + (org-columns--overlay-text + displayed format width property value))))))))))) (defun org-columns-redo () "Construct the column display again." (interactive) (message "Recomputing columns...") - (let ((line (org-current-line)) - (col (current-column))) - (save-excursion - (if (marker-position org-columns-begin-marker) - (goto-char org-columns-begin-marker)) - (org-columns-remove-overlays) - (if (derived-mode-p 'org-mode) - (call-interactively 'org-columns) - (org-agenda-redo) - (call-interactively 'org-agenda-columns))) - (org-goto-line line) - (move-to-column col)) + (org-with-wide-buffer + (when (marker-position org-columns-begin-marker) + (goto-char org-columns-begin-marker)) + (org-columns-remove-overlays) + (if (derived-mode-p 'org-mode) + ;; Since we already know the columns format, provide it instead + ;; of computing again. + (call-interactively #'org-columns org-columns-current-fmt) + (org-agenda-redo) + (call-interactively #'org-agenda-columns))) (message "Recomputing columns...done")) -(defun org-columns-not-in-agenda () - (if (eq major-mode 'org-agenda-mode) - (error "This command is only allowed in Org-mode buffers"))) - -(defun org-string-to-number (s) - "Convert string to number, and interpret hh:mm:ss." - (if (not (string-match ":" s)) - (string-to-number s) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum))) - -;;;###autoload -(defun org-columns-number-to-string (n fmt &optional printf) - "Convert a computed column number to a string value, according to FMT." - (cond - ((memq fmt '(estimate)) (org-estimate-print n printf)) - ((not (numberp n)) "") - ((memq fmt '(add_times max_times min_times mean_times)) - (org-hours-to-clocksum-string n)) - ((eq fmt 'checkbox) - (cond ((= n (floor n)) "[X]") - ((> n 1.) "[-]") - (t "[ ]"))) - ((memq fmt '(checkbox-n-of-m checkbox-percent)) - (let* ((n1 (floor n)) (n2 (floor (+ .5 (* 1000000 (- n n1)))))) - (org-nofm-to-completion n1 (+ n2 n1) (eq fmt 'checkbox-percent)))) - (printf (format printf n)) - ((eq fmt 'currency) - (format "%.2f" n)) - ((memq fmt '(min_age max_age mean_age)) - (org-format-time-period n)) - (t (number-to-string n)))) - -(defun org-nofm-to-completion (n m &optional percent) - (if (not percent) - (format "[%d/%d]" n m) - (format "[%d%%]" (round (* 100.0 n) m)))) - - -(defun org-columns-string-to-number (s fmt) - "Convert a column value to a number that can be used for column computing." - (if s - (cond - ((memq fmt '(min_age max_age mean_age)) - (cond ((string= s "") org-columns-time) - ((string-match - "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" - s) - (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) - (string-to-number (match-string 2 s)))) - (string-to-number (match-string 3 s)))) - (string-to-number (match-string 4 s)))) - (t (time-to-number-of-days (apply 'encode-time - (org-parse-time-string s t)))))) - ((string-match ":" s) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum)) - ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) - (if (equal s "[X]") 1. 0.000001)) - ((memq fmt '(estimate)) (org-string-to-estimate s)) - ((string-match (concat "\\([0-9.]+\\) *\\(" - (regexp-opt (mapcar 'car org-effort-durations)) - "\\)") s) - (setq s (concat "0:" (org-duration-string-to-minutes s t))) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum)) - (t (string-to-number s))))) - -(defun org-columns-uncompile-format (cfmt) - "Turn the compiled columns format back into a string representation." - (let ((rtn "") e s prop title op op-match width fmt printf fun calc ee map) - (while (setq e (pop cfmt)) - (setq prop (car e) - title (nth 1 e) - width (nth 2 e) - op (nth 3 e) - fmt (nth 4 e) - printf (nth 5 e) - fun (nth 6 e) - calc (nth 7 e)) - (setq map (copy-sequence org-columns-compile-map)) - (while (setq ee (pop map)) - (if (equal fmt (nth 1 ee)) - (setq op (car ee) map nil))) - (if (and op printf) (setq op (concat op ";" printf))) - (if (equal title prop) (setq title nil)) - (setq s (concat "%" (if width (number-to-string width)) - prop - (if title (concat "(" title ")")) - (if op (concat "{" op "}")))) - (setq rtn (concat rtn " " s))) - (org-trim rtn))) +(defun org-columns-uncompile-format (compiled) + "Turn the compiled columns format back into a string representation. +COMPILED is an alist, as returned by +`org-columns-compile-format', which see." + (mapconcat + (lambda (spec) + (pcase spec + (`(,prop ,title ,width ,op ,printf) + (concat "%" + (and width (number-to-string width)) + prop + (and title (not (equal prop title)) (format "(%s)" title)) + (cond ((not op) nil) + (printf (format "{%s;%s}" op printf)) + (t (format "{%s}" op))))))) + compiled " ")) (defun org-columns-compile-format (fmt) "Turn a column format string FMT into an alist of specifications. The alist has one entry for each column in the format. The elements of that list are: -property the property -title the title field for the columns -width the column width in characters, can be nil for automatic -operator the operator if any -format the output format for computed results, derived from operator -printf a printf format for computed values -fun the lisp function to compute summary values, derived from operator -calc function to get values from base elements +property the property name, as an upper-case string +title the title field for the columns, as a string +width the column width in characters, can be nil for automatic width +operator the summary operator, as a string, or nil +printf a printf format for computed values, as a string, or nil This function updates `org-columns-current-fmt-compiled'." - (let ((start 0) width prop title op op-match f printf fun calc) - (setq org-columns-current-fmt-compiled nil) + (setq org-columns-current-fmt-compiled nil) + (let ((start 0)) (while (string-match - (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") + "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\ +\\(?:{\\([^}]+\\)}\\)?\\s-*" fmt start) - (setq start (match-end 0) - width (match-string 1 fmt) - prop (match-string 2 fmt) - title (or (match-string 3 fmt) prop) - op (match-string 4 fmt) - f nil - printf nil - fun '+ - calc nil) - (if width (setq width (string-to-number width))) - (when (and op (string-match ";" op)) - (setq printf (substring op (match-end 0)) - op (substring op 0 (match-beginning 0)))) - (when (setq op-match (assoc op org-columns-compile-map)) - (setq f (cadr op-match) - fun (caddr op-match) - calc (cadddr op-match))) - (push (list prop title width op f printf fun calc) - org-columns-current-fmt-compiled)) + (setq start (match-end 0)) + (let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt)))) + (prop (match-string-no-properties 2 fmt)) + (title (or (match-string-no-properties 3 fmt) prop)) + (operator (match-string-no-properties 4 fmt))) + (push (if (not operator) (list (upcase prop) title width nil nil) + (let (printf) + (when (string-match ";" operator) + (setq printf (substring operator (match-end 0))) + (setq operator (substring operator 0 (match-beginning 0)))) + (list (upcase prop) title width operator printf))) + org-columns-current-fmt-compiled))) (setq org-columns-current-fmt-compiled (nreverse org-columns-current-fmt-compiled)))) + +;;;; Column View Summary +(defconst org-columns--duration-re + (concat "[0-9.]+ *" (regexp-opt (mapcar #'car org-effort-durations))) + "Regexp matching a duration.") + +(defun org-columns--time-to-seconds (s) + "Turn time string S into a number of seconds. +A time is expressed as HH:MM, HH:MM:SS, or with units defined in +`org-effort-durations'. Plain numbers are considered as hours." + (cond + ((string-match "\\([0-9]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" s) + (+ (* 3600 (string-to-number (match-string 1 s))) + (* 60 (string-to-number (match-string 2 s))) + (if (match-end 3) (string-to-number (match-string 3 s)) 0))) + ((string-match-p org-columns--duration-re s) + (* 60 (org-duration-string-to-minutes s))) + (t (* 3600 (string-to-number s))))) + +(defun org-columns--age-to-seconds (s) + "Turn age string S into a number of seconds. +An age is either computed from a given time-stamp, or indicated +as days/hours/minutes/seconds." + (cond + ((string-match-p org-ts-regexp s) + (floor + (- org-columns--time + (float-time (apply #'encode-time (org-parse-time-string s)))))) + ;; Match own output for computations in upper levels. + ((string-match "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" s) + (+ (* 86400 (string-to-number (match-string 1 s))) + (* 3600 (string-to-number (match-string 2 s))) + (* 60 (string-to-number (match-string 3 s))) + (string-to-number (match-string 4 s)))) + (t (user-error "Invalid age: %S" s)))) + +(defun org-columns--summary-apply-times (fun times) + "Apply FUN to time values TIMES. +If TIMES contains any time value expressed as a duration, return +the result as a duration. If it contains any H:M:S, use that +format instead. Otherwise, use H:M format." + (let* ((hms-flag nil) + (duration-flag nil) + (seconds + (apply fun + (mapcar + (lambda (time) + (cond + (duration-flag) + ((string-match-p org-columns--duration-re time) + (setq duration-flag t)) + (hms-flag) + ((string-match-p "\\`[0-9]+:[0-9]+:[0-9]+\\'" time) + (setq hms-flag t))) + (org-columns--time-to-seconds time)) + times)))) + (cond (duration-flag (org-minutes-to-clocksum-string (/ seconds 60.0))) + (hms-flag (format-seconds "%h:%.2m:%.2s" seconds)) + (t (format-seconds "%h:%.2m" seconds))))) + +(defun org-columns--compute-spec (spec &optional update) + "Update tree according to SPEC. +SPEC is a column format specification. When optional argument +UPDATE is non-nil, summarized values can replace existing ones in +properties drawers." + (let* ((lmax (if (bound-and-true-p org-inlinetask-min-level) + org-inlinetask-min-level + 29)) ;Hard-code deepest level. + (lvals (make-vector (1+ lmax) nil)) + (level 0) + (inminlevel lmax) + (last-level lmax) + (property (car spec)) + (printf (nth 4 spec)) + (summarize (org-columns--summarize (nth 3 spec)))) + (org-with-wide-buffer + ;; Find the region to compute. + (goto-char org-columns-top-level-marker) + (goto-char (condition-case nil (org-end-of-subtree t) (error (point-max)))) + ;; Walk the tree from the back and do the computations. + (while (re-search-backward + org-outline-regexp-bol org-columns-top-level-marker t) + (unless (or (= level 0) (eq level inminlevel)) + (setq last-level level)) + (setq level (org-reduced-level (org-outline-level))) + (let* ((pos (match-beginning 0)) + (value (org-entry-get nil property)) + (value-set (org-string-nw-p value))) + (cond + ((< level last-level) + ;; Collect values from lower levels and inline tasks here + ;; and summarize them using SUMMARIZE. Store them in text + ;; property `org-summaries', in alist whose key is SPEC. + (let* ((summary + (and summarize + (let ((values (append (and (/= last-level inminlevel) + (aref lvals last-level)) + (aref lvals inminlevel)))) + (and values (funcall summarize values printf)))))) + ;; Leaf values are not summaries: do not mark them. + (when summary + (let* ((summaries-alist (get-text-property pos 'org-summaries)) + (old (assoc spec summaries-alist))) + (if old (setcdr old summary) + (push (cons spec summary) summaries-alist) + (org-with-silent-modifications + (add-text-properties + pos (1+ pos) (list 'org-summaries summaries-alist))))) + ;; When PROPERTY exists in current node, even if empty, + ;; but its value doesn't match the one computed, use + ;; the latter instead. + (when (and update value (not (equal value summary))) + (org-entry-put (point) property summary))) + ;; Add current to current level accumulator. + (when (or summary value-set) + (push (or summary value) (aref lvals level))) + ;; Clear accumulators for deeper levels. + (cl-loop for l from (1+ level) to lmax do (aset lvals l nil)))) + (value-set (push value (aref lvals level))) + (t nil))))))) + +;;;###autoload +(defun org-columns-compute (property) + "Summarize the values of PROPERTY hierarchically. +Also update existing values for PROPERTY according to the first +column specification." + (interactive) + (let ((main-flag t) + (upcase-prop (upcase property))) + (dolist (spec org-columns-current-fmt-compiled) + (pcase spec + (`(,(pred (equal upcase-prop)) . ,_) + (org-columns--compute-spec spec main-flag) + ;; Only the first summary can update the property value. + (when main-flag (setq main-flag nil))))))) + +(defun org-columns-compute-all () + "Compute all columns that have operators defined." + (org-with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (let ((org-columns--time (float-time (current-time))) + seen) + (dolist (spec org-columns-current-fmt-compiled) + (let ((property (car spec))) + ;; Property value is updated only the first time a given + ;; property is encountered. + (org-columns--compute-spec spec (not (member property seen))) + (push property seen))))) + +(defun org-columns--summary-sum (values printf) + "Compute the sum of VALUES. +When PRINTF is non-nil, use it to format the result." + (format (or printf "%s") (apply #'+ (mapcar #'string-to-number values)))) + +(defun org-columns--summary-currencies (values _) + "Compute the sum of VALUES, with two decimals." + (format "%.2f" (apply #'+ (mapcar #'string-to-number values)))) + +(defun org-columns--summary-checkbox (check-boxes _) + "Summarize CHECK-BOXES with a check-box." + (let ((done (cl-count "[X]" check-boxes :test #'equal)) + (all (length check-boxes))) + (cond ((= done all) "[X]") + ((> done 0) "[-]") + (t "[ ]")))) + +(defun org-columns--summary-checkbox-count (check-boxes _) + "Summarize CHECK-BOXES with a check-box cookie." + (format "[%d/%d]" + (cl-count "[X]" check-boxes :test #'equal) + (length check-boxes))) + +(defun org-columns--summary-checkbox-percent (check-boxes _) + "Summarize CHECK-BOXES with a check-box percent." + (format "[%d%%]" + (round (* 100.0 (cl-count "[X]" check-boxes :test #'equal)) + (float (length check-boxes))))) + +(defun org-columns--summary-min (values printf) + "Compute the minimum of VALUES. +When PRINTF is non-nil, use it to format the result." + (format (or printf "%s") + (apply #'min (mapcar #'string-to-number values)))) + +(defun org-columns--summary-max (values printf) + "Compute the maximum of VALUES. +When PRINTF is non-nil, use it to format the result." + (format (or printf "%s") + (apply #'max (mapcar #'string-to-number values)))) + +(defun org-columns--summary-mean (values printf) + "Compute the mean of VALUES. +When PRINTF is non-nil, use it to format the result." + (format (or printf "%s") + (/ (apply #'+ (mapcar #'string-to-number values)) + (float (length values))))) + +(defun org-columns--summary-sum-times (times _) + "Sum TIMES." + (org-columns--summary-apply-times #'+ times)) + +(defun org-columns--summary-min-time (times _) + "Compute the minimum time among TIMES." + (org-columns--summary-apply-times #'min times)) + +(defun org-columns--summary-max-time (times _) + "Compute the maximum time among TIMES." + (org-columns--summary-apply-times #'max times)) + +(defun org-columns--summary-mean-time (times _) + "Compute the mean time among TIMES." + (org-columns--summary-apply-times + (lambda (&rest values) (/ (apply #'+ values) (float (length values)))) + times)) + +(defun org-columns--summary-min-age (ages _) + "Compute the minimum time among AGES." + (format-seconds + "%dd %.2hh %mm %ss" + (apply #'min (mapcar #'org-columns--age-to-seconds ages)))) + +(defun org-columns--summary-max-age (ages _) + "Compute the maximum time among AGES." + (format-seconds + "%dd %.2hh %mm %ss" + (apply #'max (mapcar #'org-columns--age-to-seconds ages)))) + +(defun org-columns--summary-mean-age (ages _) + "Compute the minimum time among AGES." + (format-seconds + "%dd %.2hh %mm %ss" + (/ (apply #'+ (mapcar #'org-columns--age-to-seconds ages)) + (float (length ages))))) + +(defun org-columns--summary-estimate (estimates printf) + "Combine a list of estimates, using mean and variance. +The mean and variance of the result will be the sum of the means +and variances (respectively) of the individual estimates." + (let ((mean 0) + (var 0)) + (dolist (e estimates) + (pcase (mapcar #'string-to-number (split-string e "-")) + (`(,low ,high) + (let ((m (/ (+ low high) 2.0))) + (cl-incf mean m) + (cl-incf var (- (/ (+ (* low low) (* high high)) 2.0) (* m m))))) + (`(,value) (cl-incf mean value)))) + (let ((sd (sqrt var))) + (format "%s-%s" + (format (or printf "%.0f") (- mean sd)) + (format (or printf "%.0f") (+ mean sd)))))) + + + ;;; Dynamic block for Column view -(defun org-columns-capture-view (&optional maxlevel skip-empty-rows) - "Get the column view of the current buffer or subtree. -The first optional argument MAXLEVEL sets the level limit. -A second optional argument SKIP-EMPTY-ROWS tells whether to skip +(defun org-columns--capture-view (maxlevel skip-empty format local) + "Get the column view of the current buffer. + +MAXLEVEL sets the level limit. SKIP-EMPTY tells whether to skip empty rows, an empty row being one where all the column view -specifiers but ITEM are empty. This function returns a list -containing the title row and all other rows. Each row is a list -of fields." - (save-excursion - (let* ((title (mapcar #'cadr org-columns-current-fmt-compiled)) - (has-item? (member "ITEM" title)) - (n (length title)) - tbl) - (goto-char (point-min)) - (while (re-search-forward org-outline-regexp-bol nil t) - (catch 'next - (when (and (or (null maxlevel) - (>= maxlevel (org-reduced-level (org-outline-level)))) - (get-char-property (match-beginning 0) 'org-columns-key)) - (when (or (org-in-commented-heading-p t) - (member org-archive-tag (org-get-tags))) - (org-end-of-subtree t) - (throw 'next t)) - (let (row) - (dotimes (i n) - (let ((col (+ (line-beginning-position) i))) - (push (org-quote-vert - (or (get-char-property col 'org-columns-value-modified) - (get-char-property col 'org-columns-value) - "")) - row))) - (unless (and skip-empty-rows - (let ((r (delete-dups (remove "" row)))) - (or (null r) (and has-item? (= (length r) 1))))) - (push (nreverse row) tbl)))))) - (append (list title 'hline) (nreverse tbl))))) +specifiers but ITEM are empty. FORMAT is a format string for +columns, or nil. When LOCAL is non-nil, only capture headings in +current subtree. + +This function returns a list containing the title row and all +other rows. Each row is a list of fields, as strings, or +`hline'." + (org-columns (not local) format) + (goto-char org-columns-top-level-marker) + (let ((columns (length org-columns-current-fmt-compiled)) + (has-item (assoc "ITEM" org-columns-current-fmt-compiled)) + table) + (org-map-entries + (lambda () + (when (get-char-property (point) 'org-columns-key) + (let (row) + (dotimes (i columns) + (let* ((col (+ (line-beginning-position) i)) + (p (get-char-property col 'org-columns-key))) + (push (org-quote-vert + (get-char-property col + (if (string= p "ITEM") + 'org-columns-value + 'org-columns-value-modified))) + row))) + (unless (and skip-empty + (let ((r (delete-dups (remove "" row)))) + (or (null r) (and has-item (= (length r) 1))))) + (push (cons (org-reduced-level (org-current-level)) (nreverse row)) + table))))) + (and maxlevel (format "LEVEL<=%d" maxlevel)) + (and local 'tree) + 'archive 'comment) + (org-columns-quit) + ;; Add column titles and a horizontal rule in front of the table. + (cons (mapcar #'cadr org-columns-current-fmt-compiled) + (cons 'hline (nreverse table))))) + +(defun org-columns--clean-item (item) + "Remove sensitive contents from string ITEM. +This includes objects that may not be duplicated within +a document, e.g., a target, or those forbidden in tables, e.g., +an inline src-block." + (let ((data (org-element-parse-secondary-string + item (org-element-restriction 'headline)))) + (org-element-map data + '(footnote-reference inline-babel-call inline-src-block target + radio-target statistics-cookie) + #'org-element-extract-element) + (org-no-properties (org-element-interpret-data data)))) ;;;###autoload (defun org-dblock-write:columnview (params) "Write the column view table. PARAMS is a property list of parameters: -:width enforce same column widths with <N> specifiers. :id the :ID: property of the entry where the columns view should be built. When the symbol `local', call locally. When `global' call column view with the cursor at the beginning @@ -1245,139 +1383,134 @@ PARAMS is a property list of parameters: using `org-id-find'. :hlines When t, insert a hline before each item. When a number, insert a hline before each level <= that number. +:indent When non-nil, indent each ITEM field according to its level. :vlines When t, make each column a colgroup to enforce vertical lines. :maxlevel When set to a number, don't capture headlines below this level. :skip-empty-rows When t, skip rows where all specifiers other than ITEM are empty. +:width apply widths specified in columns format using <N> specifiers. :format When non-nil, specify the column view format to use." - (let ((pos (point-marker)) - (hlines (plist-get params :hlines)) - (vlines (plist-get params :vlines)) - (maxlevel (plist-get params :maxlevel)) - (content-lines (org-split-string (plist-get params :content) "\n")) - (skip-empty-rows (plist-get params :skip-empty-rows)) - (columns-fmt (plist-get params :format)) - (case-fold-search t) - tbl id idpos nfields tmp recalc line - id-as-string view-file view-pos) - (when (setq id (plist-get params :id)) - (setq id-as-string (cond ((numberp id) (number-to-string id)) - ((symbolp id) (symbol-name id)) - ((stringp id) id) - (t ""))) - (cond ((not id) nil) - ((eq id 'global) (setq view-pos (point-min))) - ((eq id 'local)) - ((string-match "^file:\\(.*\\)" id-as-string) - (setq view-file (match-string 1 id-as-string) - view-pos 1) - (unless (file-exists-p view-file) - (error "No such file: \"%s\"" id-as-string))) - ((setq idpos (org-find-entry-with-id id)) - (setq view-pos idpos)) - ((setq idpos (org-id-find id)) - (setq view-file (car idpos)) - (setq view-pos (cdr idpos))) - (t (error "Cannot find entry with :ID: %s" id)))) - (with-current-buffer (if view-file - (get-file-buffer view-file) - (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char (or view-pos (point))) - (org-columns columns-fmt) - (setq tbl (org-columns-capture-view maxlevel skip-empty-rows)) - (setq nfields (length (car tbl))) - (org-columns-quit)))) - (goto-char pos) - (move-marker pos nil) - (when tbl - (when (plist-get params :hlines) - (setq tmp nil) - (while tbl - (if (eq (car tbl) 'hline) - (push (pop tbl) tmp) - (if (string-match "\\` *\\(\\*+\\)" (caar tbl)) - (if (and (not (eq (car tmp) 'hline)) - (or (eq hlines t) - (and (numberp hlines) - (<= (- (match-end 1) (match-beginning 1)) - hlines)))) - (push 'hline tmp))) - (push (pop tbl) tmp))) - (setq tbl (nreverse tmp))) - (when vlines - (setq tbl (mapcar (lambda (x) - (if (eq 'hline x) x (cons "" x))) - tbl)) - (setq tbl (append tbl (list (cons "/" (make-list nfields "<>")))))) - (when content-lines - (while (string-match "^#" (car content-lines)) - (insert (pop content-lines) "\n"))) - (setq pos (point)) - (insert (org-listtable-to-string tbl)) + (let ((table + (let ((id (plist-get params :id)) + view-file view-pos) + (pcase id + (`global nil) + ((or `local `nil) (setq view-pos (point))) + ((and (let id-string (format "%s" id)) + (guard (string-match "^file:\\(.*\\)" id-string))) + (setq view-file (match-string-no-properties 1 id-string)) + (unless (file-exists-p view-file) + (user-error "No such file: %S" id-string))) + ((and (let idpos (org-find-entry-with-id id)) (guard idpos)) + (setq view-pos idpos)) + ((let `(,filename . ,position) (org-id-find id)) + (setq view-file filename) + (setq view-pos position)) + (_ (user-error "Cannot find entry with :ID: %s" id))) + (with-current-buffer (if view-file (get-file-buffer view-file) + (current-buffer)) + (org-with-wide-buffer + (when view-pos (goto-char view-pos)) + (org-columns--capture-view (plist-get params :maxlevel) + (plist-get params :skip-empty-rows) + (plist-get params :format) + view-pos)))))) + (when table + ;; Prune level information from the table. Also normalize + ;; headings: remove stars, add indentation entities, if + ;; required, and possibly precede some of them with a horizontal + ;; rule. + (let ((item-index + (let ((p (assoc "ITEM" org-columns-current-fmt-compiled))) + (and p (cl-position p + org-columns-current-fmt-compiled + :test #'equal)))) + (hlines (plist-get params :hlines)) + (indent (plist-get params :indent)) + new-table) + ;; Copy header and first rule. + (push (pop table) new-table) + (push (pop table) new-table) + (dolist (row table (setq table (nreverse new-table))) + (let ((level (car row))) + (when (and (not (eq (car new-table) 'hline)) + (or (eq hlines t) + (and (numberp hlines) (<= level hlines)))) + (push 'hline new-table)) + (when item-index + (let ((item (org-columns--clean-item (nth item-index (cdr row))))) + (setf (nth item-index (cdr row)) + (if (and indent (> level 1)) + (concat "\\_" (make-string (* 2 (1- level)) ?\s) item) + item)))) + (push (cdr row) new-table)))) (when (plist-get params :width) - (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x))) - org-columns-current-widths "|"))) - (while (setq line (pop content-lines)) - (when (string-match "^#" line) - (insert "\n" line) - (when (string-match "^[ \t]*#\\+tblfm" line) - (setq recalc t)))) - (if recalc - (progn (goto-char pos) (org-table-recalculate 'all)) - (goto-char pos) + (setq table + (append table + (list + (mapcar (lambda (spec) + (let ((w (nth 2 spec))) + (if w (format "<%d>" (max 3 w)) ""))) + org-columns-current-fmt-compiled))))) + (when (plist-get params :vlines) + (setq table + (let ((size (length org-columns-current-fmt-compiled))) + (append (mapcar (lambda (x) (if (eq 'hline x) x (cons "" x))) + table) + (list (cons "/" (make-list size "<>"))))))) + (let ((content-lines (org-split-string (plist-get params :content) "\n")) + recalc) + ;; Insert affiliated keywords before the table. + (when content-lines + (while (string-match-p "\\`[ \t]*#\\+" (car content-lines)) + (insert (pop content-lines) "\n"))) + (save-excursion + ;; Insert table at point. + (insert + (mapconcat (lambda (row) + (if (eq row 'hline) "|-|" + (format "|%s|" (mapconcat #'identity row "|")))) + table + "\n")) + ;; Insert TBLFM lines following table. + (let ((case-fold-search t)) + (dolist (line content-lines) + (when (string-match-p "\\`[ \t]*#\\+TBLFM:" line) + (insert "\n" line) + (unless recalc (setq recalc t)))))) + (when recalc (org-table-recalculate 'all t)) (org-table-align))))) -(defun org-listtable-to-string (tbl) - "Convert a listtable TBL to a string that contains the Org-mode table. -The table still need to be aligned. The resulting string has no leading -and tailing newline characters." - (mapconcat - (lambda (x) - (cond - ((listp x) - (concat "|" (mapconcat 'identity x "|") "|")) - ((eq x 'hline) "|-|") - (t (error "Garbage in listtable: %s" x)))) - tbl "\n")) - ;;;###autoload -(defun org-insert-columns-dblock () +(defun org-columns-insert-dblock () "Create a dynamic block capturing a column view table." (interactive) - (let ((defaults '(:name "columnview" :hlines 1)) - (id (org-icompleting-read + (let ((id (completing-read "Capture columns (local, global, entry with :ID: property) [local]: " (append '(("global") ("local")) - (mapcar 'list (org-property-values "ID")))))) - (if (equal id "") (setq id 'local)) - (if (equal id "global") (setq id 'global)) - (setq defaults (append defaults (list :id id))) - (org-create-dblock defaults) - (org-update-dblock))) - -;;; Column view in the agenda + (mapcar #'list (org-property-values "ID")))))) + (org-create-dblock + (list :name "columnview" + :hlines 1 + :id (cond ((string= id "global") 'global) + ((member id '("" "local")) 'local) + (id))))) + (org-update-dblock)) -(defvar org-agenda-view-columns-initially nil - "When set, switch to columns view immediately after creating the agenda.") -(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el -(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el -(defvar org-agenda-columns-add-appointments-to-effort-sum); as well + +;;; Column view in the agenda ;;;###autoload (defun org-agenda-columns () "Turn on or update column view in the agenda." (interactive) - (org-verify-version 'columns) (org-columns-remove-overlays) (move-marker org-columns-begin-marker (point)) - (let ((org-columns-time (time-to-number-of-days (current-time))) + (let ((org-columns--time (float-time (current-time))) (fmt (cond - ((org-bound-and-true-p org-agenda-overriding-columns-format)) + ((bound-and-true-p org-agenda-overriding-columns-format)) ((let ((m (org-get-at-bol 'org-hd-marker))) (and m (or (org-entry-get m "COLUMNS" t) @@ -1392,7 +1525,7 @@ and tailing newline characters." (with-current-buffer (marker-buffer m) org-columns-default-format)))))) (t org-columns-default-format)))) - (org-set-local 'org-columns-current-fmt fmt) + (setq-local org-columns-current-fmt fmt) (org-columns-compile-format fmt) (when org-agenda-columns-compute-summary-properties (org-agenda-colview-compute org-columns-current-fmt-compiled)) @@ -1400,204 +1533,111 @@ and tailing newline characters." ;; Collect properties for each headline in current view. (goto-char (point-min)) (let (cache) - (let ((names (mapcar #'car org-columns-current-fmt-compiled)) m) - (while (not (eobp)) - (when (setq m (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker))) - (push - (cons - (line-beginning-position) - (org-with-point-at m - (mapcar - (lambda (name) - (let ((value (org-columns--value name (point)))) - (cons - name - (if (and org-agenda-columns-add-appointments-to-effort-sum - (not value) - (eq (compare-strings name nil nil - org-effort-property nil nil - t) - t) - ;; Effort property is not defined. Try - ;; to use appointment duration. - (get-text-property (point) 'duration)) - (org-propertize - (org-minutes-to-clocksum-string - (get-text-property (point) 'duration)) - 'face 'org-warning) - value)))) - names))) - cache)) - (forward-line))) + (while (not (eobp)) + (let ((m (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker)))) + (when m + (push (cons (line-beginning-position) + (org-with-point-at m + (org-columns--collect-values 'agenda))) + cache))) + (forward-line)) (when cache - (org-set-local 'org-columns-current-maxwidths - (org-columns-get-autowidth-alist fmt cache)) - (org-columns-display-here-title) - (when (org-set-local 'org-columns-flyspell-was-active - (org-bound-and-true-p flyspell-mode)) + (org-columns--set-widths cache) + (org-columns--display-here-title) + (when (setq-local org-columns-flyspell-was-active + (bound-and-true-p flyspell-mode)) (flyspell-mode 0)) - (dolist (x cache) - (goto-char (car x)) - (org-columns-display-here (cdr x))) + (dolist (entry cache) + (goto-char (car entry)) + (org-columns--display-here (cdr entry))) (when org-agenda-columns-show-summaries (org-agenda-colview-summarize cache))))))) (defun org-agenda-colview-summarize (cache) "Summarize the summarizable columns in column view in the agenda. This will add overlays to the date lines, to show the summary for each day." - (let* ((fmt (mapcar (lambda (x) - (if (string-match "CLOCKSUM.*" (car x)) - (list (match-string 0 (car x)) - (nth 1 x) (nth 2 x) ":" 'add_times - nil '+ nil) - x)) - org-columns-current-fmt-compiled)) - line c c1 stype calc sumfunc props lsum entries prop v title) - (catch 'exit - (when (delq nil (mapcar 'cadr fmt)) - ;; OK, at least one summation column, it makes sense to try this - (goto-char (point-max)) - (while t - (when (or (get-text-property (point) 'org-date-line) - (eq (get-text-property (point) 'face) - 'org-agenda-structure)) - ;; OK, this is a date line that should be used - (setq line (org-current-line)) - (setq entries nil c cache cache nil) - (while (setq c1 (pop c)) - (if (> (car c1) line) - (push c1 entries) - (push c1 cache))) - ;; now ENTRIES are the ones we want to use, CACHE is the rest - ;; Compute the summaries for the properties we want, - ;; set nil properties for the rest. - (when (setq entries (mapcar 'cdr entries)) - (setq props - (mapcar - (lambda (f) - (setq prop (car f) - title (nth 1 f) - stype (nth 4 f) - sumfunc (nth 6 f) - calc (or (nth 7 f) 'identity)) - (cond - ((equal prop "ITEM") - (cons prop (buffer-substring (point-at-bol) - (point-at-eol)))) - ((not stype) (cons prop "")) - (t ;; do the summary - (setq lsum nil) - (dolist (x entries) - (setq v (cdr (assoc-string prop x t))) - (if v - (push - (funcall - (if (not (get-text-property 0 'org-computed v)) - calc - 'identity) - (org-columns-string-to-number - v stype)) - lsum))) - (setq lsum (remove nil lsum)) - (setq lsum - (cond ((> (length lsum) 1) - (org-columns-number-to-string - (apply sumfunc lsum) stype)) - ((eq (length lsum) 1) - (org-columns-number-to-string - (car lsum) stype)) - (t ""))) - (put-text-property 0 (length lsum) 'face 'bold lsum) - (unless (eq calc 'identity) - (put-text-property 0 (length lsum) 'org-computed t lsum)) - (cons prop lsum)))) - fmt)) - (org-columns-display-here props 'dateline) - (org-set-local 'org-agenda-columns-active t))) - (if (bobp) (throw 'exit t)) - (beginning-of-line 0)))))) + (let ((fmt (mapcar + (lambda (spec) + (pcase spec + (`(,property ,title ,width . ,_) + (if (member property '("CLOCKSUM" "CLOCKSUM_T")) + (list property title width ":" nil) + spec)))) + org-columns-current-fmt-compiled)) + entries) + ;; Ensure there's at least one summation column. + (when (cl-some (lambda (spec) (nth 3 spec)) fmt) + (goto-char (point-max)) + (while (not (bobp)) + (when (or (get-text-property (point) 'org-date-line) + (eq (get-text-property (point) 'face) + 'org-agenda-structure)) + ;; OK, this is a date line that should be used. + (let (rest) + (dolist (c cache (setq cache rest)) + (if (> (car c) (point)) + (push c entries) + (push c rest)))) + ;; Now ENTRIES contains entries below the current one. + ;; CACHE is the rest. Compute the summaries for the + ;; properties we want, set nil properties for the rest. + (when (setq entries (mapcar 'cdr entries)) + (org-columns--display-here + (mapcar + (lambda (spec) + (pcase spec + (`("ITEM" . ,_) + ;; Replace ITEM with current date. Preserve + ;; properties for fontification. + (let ((date (buffer-substring + (line-beginning-position) + (line-end-position)))) + (list spec date date))) + (`(,_ ,_ ,_ nil ,_) (list spec "" "")) + (`(,_ ,_ ,_ ,operator ,printf) + (let* ((summarize (org-columns--summarize operator)) + (values + ;; Use real values for summary, not those + ;; prepared for display. + (delq nil + (mapcar + (lambda (e) + (org-string-nw-p (nth 1 (assoc spec e)))) + entries))) + (final (if values (funcall summarize values printf) + ""))) + (unless (equal final "") + (put-text-property 0 (length final) 'face 'bold final)) + (list spec final final))))) + fmt) + 'dateline) + (setq-local org-agenda-columns-active t))) + (forward-line -1))))) (defun org-agenda-colview-compute (fmt) "Compute the relevant columns in the contributing source buffers." (let ((files org-agenda-contributing-files) (org-columns-begin-marker (make-marker)) - (org-columns-top-level-marker (make-marker)) - f fm a b) - (while (setq f (pop files)) - (setq b (find-buffer-visiting f)) - (with-current-buffer (or (buffer-base-buffer b) b) - (save-excursion - (save-restriction - (widen) - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) - (goto-char (point-min)) - (org-columns-get-format-and-top-level) - (while (setq fm (pop fmt)) - (cond ((equal (car fm) "CLOCKSUM") - (org-clock-sum)) - ((equal (car fm) "CLOCKSUM_T") - (org-clock-sum-today)) - ((and (nth 4 fm) - (setq a (assoc-string (car fm) - org-columns-current-fmt-compiled - t)) - (equal (nth 4 a) (nth 4 fm))) - (org-columns-compute (car fm))))))))))) - -(defun org-format-time-period (interval) - "Convert time in fractional days to days/hours/minutes/seconds." - (if (numberp interval) - (let* ((days (floor interval)) - (frac-hours (* 24 (- interval days))) - (hours (floor frac-hours)) - (minutes (floor (* 60 (- frac-hours hours)))) - (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes))))) - (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) - "")) - -(defun org-estimate-mean-and-var (v) - "Return the mean and variance of an estimate." - (let* ((v (cond ((consp v) v) - ((numberp v) (list v v)) - (t (error "Invalid estimate type")))) - (low (float (car v))) - (high (float (cadr v))) - (mean (/ (+ low high) 2.0)) - (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0))) - (list mean var))) - -(defun org-estimate-combine (&rest el) - "Combine a list of estimates, using mean and variance. -The mean and variance of the result will be the sum of the means -and variances (respectively) of the individual estimates." - (let ((mean 0) - (var 0)) - (mapc (lambda (e) - (let ((stats (org-estimate-mean-and-var e))) - (setq mean (+ mean (car stats))) - (setq var (+ var (cadr stats))))) - el) - (let ((stdev (sqrt var))) - (list (- mean stdev) (+ mean stdev))))) - -(defun org-estimate-print (e &optional fmt) - "Prepare a string representation of an estimate. -This formats these numbers as two numbers with a \"-\" between them." - (let ((fmt (or fmt "%.0f")) - (e (cond ((consp e) e) - ((numberp e) (list e e)) - (t (error "Invalid estimate type"))))) - (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-")))) - -(defun org-string-to-estimate (s) - "Convert a string to an estimate. -The string should be two numbers joined with a \"-\"." - (if (string-match "\\(.*\\)-\\(.*\\)" s) - (list (string-to-number (match-string 1 s)) - (string-to-number(match-string 2 s))) - (list (string-to-number s) (string-to-number s)))) + (org-columns-top-level-marker (make-marker))) + (dolist (f files) + (let ((b (find-buffer-visiting f))) + (with-current-buffer (or (buffer-base-buffer b) b) + (org-with-wide-buffer + (org-with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (goto-char (point-min)) + (org-columns-get-format-and-top-level) + (dolist (spec fmt) + (let ((prop (car spec))) + (cond + ((equal prop "CLOCKSUM") (org-clock-sum)) + ((equal prop "CLOCKSUM_T") (org-clock-sum-today)) + ((and (nth 3 spec) + (let ((a (assoc prop org-columns-current-fmt-compiled))) + (equal (nth 3 a) (nth 3 spec)))) + (org-columns-compute prop))))))))))) + (provide 'org-colview) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 70e4573..202b728 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -1,4 +1,4 @@ -;;; org-compat.el --- Compatibility code for Org-mode +;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -24,62 +24,278 @@ ;; ;;; Commentary: -;; This file contains code needed for compatibility with XEmacs and older +;; This file contains code needed for compatibility with older ;; versions of GNU Emacs. ;;; Code: -(eval-when-compile - (require 'cl)) - +(require 'cl-lib) (require 'org-macs) -(declare-function w32-focus-frame "term/w32-win" (frame)) +(declare-function org-at-table.el-p "org" (&optional table-type)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-type "org-element" (element)) +(declare-function org-link-set-parameters "org" (type &rest rest)) +(declare-function org-table-end (&optional table-type)) +(declare-function table--at-cell-p "table" (position &optional object at-column)) + +(defvar org-table-any-border-regexp) +(defvar org-table-dataline-regexp) +(defvar org-table-tab-recognizes-table.el) +(defvar org-table1-hline-regexp) + +;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-' +;; prefix, `find-tag' is replaced with `xref-find-definition' and +;; `x-get-selection' with `gui-get-selection'. +(when (< emacs-major-version 25) + (defalias 'outline-hide-entry 'hide-entry) + (defalias 'outline-hide-sublevels 'hide-sublevels) + (defalias 'outline-hide-subtree 'hide-subtree) + (defalias 'outline-show-all 'show-all) + (defalias 'outline-show-branches 'show-branches) + (defalias 'outline-show-children 'show-children) + (defalias 'outline-show-entry 'show-entry) + (defalias 'outline-show-subtree 'show-subtree) + (defalias 'xref-find-definitions 'find-tag) + (defalias 'format-message 'format) + (defalias 'gui-get-selection 'x-get-selection)) + + +;;; Obsolete aliases (remove them once the next major release is released). -;; The following constant is for backward compatibility. We do not use -;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) -;; at compilation time and can therefore optimize code better. -(defconst org-xemacs-p (featurep 'xemacs)) +;;;; XEmacs compatibility, now removed. +(define-obsolete-function-alias 'org-activate-mark 'activate-mark) +(define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0") +(define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0") +(define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0") +(define-obsolete-function-alias 'org-defvaralias 'defvaralias "Org 9.0") +(define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "Org 9.0") +(define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "Org 9.0") +(define-obsolete-function-alias 'org-float-time 'float-time "Org 9.0") +(define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "Org 9.0") +(define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "Org 9.0") +(define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "Org 9.0") +(define-obsolete-function-alias 'org-looking-back 'looking-back "Org 9.0") +(define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "Org 9.0") +(define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0") +(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0") + +(defmacro org-re (s) + "Replace posix classes in regular expression S." + (declare (debug (form)) + (obsolete "you can safely remove it." "Org 9.0")) + s) + +;;;; Functions from cl-lib that Org used to have its own implementation of. +(define-obsolete-function-alias 'org-count 'cl-count "Org 9.0") +(define-obsolete-function-alias 'org-every 'cl-every "Org 9.0") +(define-obsolete-function-alias 'org-find-if 'cl-find-if "Org 9.0") +(define-obsolete-function-alias 'org-reduce 'cl-reduce "Org 9.0") +(define-obsolete-function-alias 'org-remove-if 'cl-remove-if "Org 9.0") +(define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "Org 9.0") +(define-obsolete-function-alias 'org-some 'cl-some "Org 9.0") +(define-obsolete-function-alias 'org-floor* 'cl-floor "Org 9.0") + +(defun org-sublist (list start end) + "Return a section of LIST, from START to END. +Counting starts at 1." + (cl-subseq list (1- start) end)) +(make-obsolete 'org-sublist + "use cl-subseq (note the 0-based counting)." + "Org 9.0") + + +;;;; Functions available since Emacs 24.3 +(define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "Org 9.0") +(define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "Org 9.0") +(define-obsolete-function-alias 'org-char-to-string 'char-to-string "Org 9.0") +(define-obsolete-function-alias 'org-delete-directory 'delete-directory "Org 9.0") +(define-obsolete-function-alias 'org-format-seconds 'format-seconds "Org 9.0") +(define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "Org 9.0") +(define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "Org 9.0") +(define-obsolete-function-alias 'org-number-sequence 'number-sequence "Org 9.0") +(define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "Org 9.0") +(define-obsolete-function-alias 'org-string-match-p 'string-match-p "Org 9.0") + +;;;; Functions and variables from previous releases now obsolete. +(define-obsolete-function-alias 'org-element-remove-indentation + 'org-remove-indentation "Org 9.0") +(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics + 'org-checkbox-hierarchical-statistics "Org 8.0") +(define-obsolete-variable-alias 'org-description-max-indent + 'org-list-description-max-indent "Org 8.0") +(define-obsolete-variable-alias 'org-latex-create-formula-image-program + 'org-preview-latex-default-process "Org 9.0") +(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory + 'org-preview-latex-image-directory "Org 9.0") +(define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0") +(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0") +(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3") +(define-obsolete-function-alias 'org-speed-command-default-hook + 'org-speed-command-activate "Org 8.0") +(define-obsolete-function-alias 'org-babel-speed-command-hook + 'org-babel-speed-command-activate "Org 8.0") +(define-obsolete-function-alias 'org-image-file-name-regexp + 'image-file-name-regexp "Org 9.0") +(define-obsolete-function-alias 'org-get-legal-level + 'org-get-valid-level "Org 7.8") +(define-obsolete-function-alias 'org-completing-read-no-i + 'completing-read "Org 9.0") +(define-obsolete-function-alias 'org-icompleting-read + 'completing-read "Org 9.0") +(define-obsolete-function-alias 'org-iread-file-name 'read-file-name "Org 9.0") +(define-obsolete-function-alias 'org-days-to-time + 'org-time-stamp-to-now "Org 8.2") +(define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties + 'org-agenda-ignore-properties "Org 9.0") +(define-obsolete-function-alias 'org-preview-latex-fragment + 'org-toggle-latex-fragment "Org 8.3") +(define-obsolete-function-alias 'org-display-inline-modification-hook + 'org-display-inline-remove-overlay "Org 8.0") +(define-obsolete-function-alias 'org-export-get-genealogy + 'org-element-lineage "Org 9.0") +(define-obsolete-variable-alias 'org-latex-with-hyperref + 'org-latex-hyperref-template "Org 9.0") +(define-obsolete-variable-alias 'org-link-to-org-use-id + 'org-id-link-to-org-use-id "Org 8.0") +(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0") +(define-obsolete-variable-alias 'org-clock-modeline-total + 'org-clock-mode-line-total "Org 8.0") +(define-obsolete-function-alias 'org-protocol-unhex-compound + 'org-link-unescape-compound "Org 7.8") +(define-obsolete-function-alias 'org-protocol-unhex-string + 'org-link-unescape "Org 7.8") +(define-obsolete-function-alias 'org-protocol-unhex-single-byte-sequence + 'org-link-unescape-single-byte-sequence "Org 7.8") +(define-obsolete-variable-alias 'org-export-htmlized-org-css-url + 'org-org-htmlized-css-url "Org 8.2") +(define-obsolete-variable-alias 'org-alphabetical-lists + 'org-list-allow-alphabetical "Org 8.0") +(define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0") +(define-obsolete-variable-alias 'org-agenda-menu-two-column + 'org-agenda-menu-two-columns "Org 8.0") +(define-obsolete-variable-alias 'org-finalize-agenda-hook + 'org-agenda-finalize-hook "Org 8.0") +(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "Org 7.8") +(define-obsolete-function-alias 'org-agenda-post-command-hook + 'org-agenda-update-agenda-type "Org 8.0") +(define-obsolete-function-alias 'org-agenda-todayp + 'org-agenda-today-p "Org 9.0") +(define-obsolete-function-alias 'org-babel-examplize-region + 'org-babel-examplify-region "Org 9.0") +(define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0") +(define-obsolete-variable-alias 'org-html-style-include-scripts + 'org-html-head-include-scripts "Org 8.0") +(define-obsolete-variable-alias 'org-html-style-include-default + 'org-html-head-include-default-style "Org 8.0") +(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") +(define-obsolete-function-alias 'org-insert-columns-dblock + 'org-columns-insert-dblock "Org 9.0") + +(defun org-in-fixed-width-region-p () + "Non-nil if point in a fixed-width region." + (save-match-data + (eq 'fixed-width (org-element-type (org-element-at-point))))) +(make-obsolete 'org-in-fixed-width-region-p + "use `org-element' library" + "Org 9.0") + +(defcustom org-read-date-minibuffer-setup-hook nil + "Hook to be used to set up keys for the date/time interface. +Add key definitions to `minibuffer-local-map', which will be a +temporary copy." + :group 'org-time + :type 'hook) +(make-obsolete-variable + 'org-read-date-minibuffer-setup-hook + "set `org-read-date-minibuffer-local-map' instead." "Org 8.0") (defun org-compatible-face (inherits specs) "Make a compatible face specification. -If INHERITS is an existing face and if the Emacs version supports it, -just inherit the face. If INHERITS is set and the Emacs version does -not support it, copy the face specification from the inheritance face. -If INHERITS is not given and SPECS is, use SPECS to define the face. -XEmacs and Emacs 21 do not know about the `min-colors' attribute. -For them we convert a (min-colors 8) entry to a `tty' entry and move it -to the top of the list. The `min-colors' attribute will be removed from -any other entries, and any resulting duplicates will be removed entirely." - (when (and inherits (facep inherits) (not specs)) - (setq specs (or specs - (get inherits 'saved-face) - (get inherits 'face-defface-spec)))) - (cond - ((and inherits (facep inherits) - (not (featurep 'xemacs)) - (>= emacs-major-version 22) - ;; do not inherit outline faces before Emacs 23 - (or (>= emacs-major-version 23) - (not (string-match "\\`outline-[0-9]+" - (symbol-name inherits))))) - (list (list t :inherit inherits))) - ((or (featurep 'xemacs) (< emacs-major-version 22)) - ;; These do not understand the `min-colors' attribute. - (let (r e a) - (while (setq e (pop specs)) - (cond - ((memq (car e) '(t default)) (push e r)) - ((setq a (member '(min-colors 8) (car e))) - (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) - (cdr e))))) - ((setq a (assq 'min-colors (car e))) - (setq e (cons (delq a (car e)) (cdr e))) - (or (assoc (car e) r) (push e r))) - (t (or (assoc (car e) r) (push e r))))) - (nreverse r))) - (t specs))) -(put 'org-compatible-face 'lisp-indent-function 1) +If INHERITS is an existing face and if the Emacs version supports +it, just inherit the face. If INHERITS is not given and SPECS +is, use SPECS to define the face." + (declare (indent 1)) + (if (facep inherits) + (list (list t :inherit inherits)) + specs)) +(make-obsolete 'org-compatible-face "you can remove it." "Org 9.0") + +(defun org-add-link-type (type &optional follow export) + "Add a new TYPE link. +FOLLOW and EXPORT are two functions. + +FOLLOW should take the link path as the single argument and do whatever +is necessary to follow the link, for example find a file or display +a mail message. + +EXPORT should format the link path for export to one of the export formats. +It should be a function accepting three arguments: + + path the path of the link, the text after the prefix (like \"http:\") + desc the description of the link, if any + format the export format, a symbol like `html' or `latex' or `ascii'. + +The function may use the FORMAT information to return different values +depending on the format. The return value will be put literally into +the exported file. If the return value is nil, this means Org should +do what it normally does with links which do not have EXPORT defined. + +Org mode has a built-in default for exporting links. If you are happy with +this default, there is no need to define an export function for the link +type. For a simple example of an export function, see `org-bbdb.el'. + +If TYPE already exists, update it with the arguments. +See `org-link-parameters' for documentation on the other parameters." + (org-link-set-parameters type :follow follow :export export) + (message "Created %s link." type)) + +(make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "Org 9.0") + +(defun org-table-recognize-table.el () + "If there is a table.el table nearby, recognize it and move into it." + (when (and org-table-tab-recognizes-table.el (org-at-table.el-p)) + (beginning-of-line) + (unless (or (looking-at org-table-dataline-regexp) + (not (looking-at org-table1-hline-regexp))) + (forward-line) + (when (looking-at org-table-any-border-regexp) + (forward-line -2))) + (if (re-search-forward "|" (org-table-end t) t) + (progn + (require 'table) + (if (table--at-cell-p (point)) t + (message "recognizing table.el table...") + (table-recognize-table) + (message "recognizing table.el table...done"))) + (error "This should not happen")))) + +;; Not used by Org core since commit 6d1e3082, Feb 2010. +(make-obsolete 'org-table-recognize-table.el + "please notify the org mailing list if you use this function." + "Org 9.0") + +(define-obsolete-function-alias + 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string "Org 8.0") + +(defun org-remove-angle-brackets (s) + (org-unbracket-string "<" ">" s)) +(make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "Org 9.0") + +(defun org-remove-double-quotes (s) + (org-unbracket-string "\"" "\"" s)) +(make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0") + +;;;; Obsolete link types + +(eval-after-load 'org + '(progn + (org-link-set-parameters "file+emacs") ;since Org 9.0 + (org-link-set-parameters "file+sys"))) ;since Org 9.0 + + + +;;; Miscellaneous functions (defun org-version-check (version feature level) (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) @@ -105,110 +321,19 @@ any other entries, and any resulting duplicates will be removed entirely." t)) t))) - -;;;; Emacs/XEmacs compatibility - -(eval-and-compile - (defun org-defvaralias (new-alias base-variable &optional docstring) - "Compatibility function for defvaralias. -Don't do the aliasing when `defvaralias' is not bound." - (declare (indent 1)) - (when (fboundp 'defvaralias) - (defvaralias new-alias base-variable docstring))) - - (when (and (not (boundp 'user-emacs-directory)) - (boundp 'user-init-directory)) - (org-defvaralias 'user-emacs-directory 'user-init-directory))) - -(when (featurep 'xemacs) - (defadvice custom-handle-keyword - (around org-custom-handle-keyword - activate preactivate) - "Remove custom keywords not recognized to avoid producing an error." - (cond - ((eq (ad-get-arg 1) :package-version)) - (t ad-do-it))) - (defadvice define-obsolete-variable-alias - (around org-define-obsolete-variable-alias - (obsolete-name current-name &optional when docstring) - activate preactivate) - "Declare arguments defined in later versions of Emacs." - ad-do-it) - (defadvice define-obsolete-function-alias - (around org-define-obsolete-function-alias - (obsolete-name current-name &optional when docstring) - activate preactivate) - "Declare arguments defined in later versions of Emacs." - ad-do-it) - (defvar customize-package-emacs-version-alist nil) - (defvar temporary-file-directory (temp-directory))) - -;; Keys -(defconst org-xemacs-key-equivalents - '(([mouse-1] . [button1]) - ([mouse-2] . [button2]) - ([mouse-3] . [button3]) - ([C-mouse-4] . [(control mouse-4)]) - ([C-mouse-5] . [(control mouse-5)])) - "Translation alist for a couple of keys.") - -;; Overlay compatibility functions -(defun org-detach-overlay (ovl) - (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) -(defun org-overlay-display (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'invisible t) - (set-extent-property ovl 'end-glyph gl)) - (overlay-put ovl 'display text) - (if face (overlay-put ovl 'face face)) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-before-string (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'begin-glyph gl)) - (if face (org-add-props text nil 'face face)) - (overlay-put ovl 'before-string text) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-find-overlays (prop &optional pos delete) - "Find all overlays specifying PROP at POS or point. -If DELETE is non-nil, delete all those overlays." - (let ((overlays (overlays-at (or pos (point)))) - ov found) - (while (setq ov (pop overlays)) - (if (overlay-get ov prop) - (if delete (delete-overlay ov) (push ov found)))) - found)) - (defun org-get-x-clipboard (value) - "Get the value of the x or Windows clipboard, compatible with XEmacs, and GNU Emacs 21." - (cond ((eq window-system 'x) - (let ((x (org-get-x-clipboard-compat value))) - (if x (org-no-properties x)))) + "Get the value of the X or Windows clipboard." + (cond ((and (eq window-system 'x) + (fboundp 'gui-get-selection)) ;Silence byte-compiler. + (org-no-properties + (ignore-errors + (or (gui-get-selection value 'UTF8_STRING) + (gui-get-selection value 'COMPOUND_TEXT) + (gui-get-selection value 'STRING) + (gui-get-selection value 'TEXT))))) ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) (w32-get-clipboard-data)))) -(defsubst org-decompose-region (beg end) - "Decompose from BEG to END." - (if (featurep 'xemacs) - (let ((modified-p (buffer-modified-p)) - (buffer-read-only nil)) - (remove-text-properties beg end '(composition nil)) - (set-buffer-modified-p modified-p)) - (decompose-region beg end))) - -;; Miscellaneous functions - -(defun org-add-hook (hook function &optional append local) - "Add-hook, compatible with both Emacsen." - (if (and local (featurep 'xemacs)) - (add-local-hook hook function append) - (add-hook hook function append local))) - (defun org-add-props (string plist &rest props) "Add text properties to entire string, from beginning to end. PLIST may be a list of properties, PROPS are individual properties and values @@ -235,57 +360,29 @@ ignored in this case." (shrink-window-if-larger-than-buffer window))) (or window (selected-window))) -(defun org-number-sequence (from &optional to inc) - "Call `number-sequence' or emulate it." - (if (fboundp 'number-sequence) - (number-sequence from to inc) - (if (or (not to) (= from to)) - (list from) - (or inc (setq inc 1)) - (when (zerop inc) (error "The increment can not be zero")) - (let (seq (n 0) (next from)) - (if (> inc 0) - (while (<= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc)))) - (while (>= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc))))) - (nreverse seq))))) - ;; `set-transient-map' is only in Emacs >= 24.4 (defalias 'org-set-transient-map (if (fboundp 'set-transient-map) 'set-transient-map 'set-temporary-overlay-map)) -;; Region compatibility +;;; Region compatibility (defvar org-ignore-region nil "Non-nil means temporarily disable the active region.") (defun org-region-active-p () - "Is `transient-mark-mode' on and the region active? -Works on both Emacs and XEmacs." - (if org-ignore-region - nil - (if (featurep 'xemacs) - (and zmacs-regions (region-active-p)) - (if (fboundp 'use-region-p) - (use-region-p) - (and transient-mark-mode mark-active))))) ; Emacs 22 and before + "Non-nil when the region active. +Unlike to `use-region-p', this function also checks +`org-ignore-region'." + (and (not org-ignore-region) (use-region-p))) (defun org-cursor-to-region-beginning () (when (and (org-region-active-p) (> (point) (region-beginning))) (exchange-point-and-mark))) -;; Old alias for emacs 22 compatibility, now dropped -(define-obsolete-function-alias 'org-activate-mark 'activate-mark) - -;; Invisibility compatibility +;;; Invisibility compatibility (defun org-remove-from-invisibility-spec (arg) "Remove elements from `buffer-invisibility-spec'." @@ -300,65 +397,14 @@ Works on both Emacs and XEmacs." (if (consp buffer-invisibility-spec) (member arg buffer-invisibility-spec))) -(defmacro org-xemacs-without-invisibility (&rest body) - "Turn off extents with invisibility while executing BODY." - `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property - ext 'invisible))) - (set-extent-property ext 'invisible nil))) - ,@body - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec))))) -(def-edebug-spec org-xemacs-without-invisibility (body)) - -(defun org-indent-to-column (column &optional minimum buffer) - "Work around a bug with extents with invisibility in XEmacs." - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (indent-to-column column minimum buffer)) - (indent-to-column column minimum))) - -(defun org-indent-line-to (column) - "Work around a bug with extents with invisibility in XEmacs." - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (indent-line-to column)) - (indent-line-to column))) - -(defun org-move-to-column (column &optional force buffer) +(defun org-move-to-column (column &optional force _buffer) "Move to column COLUMN. -Pass COLUMN and FORCE to `move-to-column'. -Pass BUFFER to the XEmacs version of `move-to-column'." +Pass COLUMN and FORCE to `move-to-column'." (let ((buffer-invisibility-spec (if (listp buffer-invisibility-spec) (remove '(org-filtered) buffer-invisibility-spec) buffer-invisibility-spec))) - (if (featurep 'xemacs) - (org-xemacs-without-invisibility - (move-to-column column force buffer)) - (move-to-column column force)))) - -(defun org-get-x-clipboard-compat (value) - "Get the clipboard value on XEmacs or Emacs 21." - (cond ((featurep 'xemacs) - (org-no-warnings (get-selection-no-error value))) - ((fboundp 'x-get-selection) - (condition-case nil - (or (x-get-selection value 'UTF8_STRING) - (x-get-selection value 'COMPOUND_TEXT) - (x-get-selection value 'STRING) - (x-get-selection value 'TEXT)) - (error nil))))) - -(defun org-propertize (string &rest properties) - (if (featurep 'xemacs) - (progn - (add-text-properties 0 (length string) properties string) - string) - (apply 'propertize string properties))) + (move-to-column column force))) (defmacro org-find-library-dir (library) `(file-name-directory (or (locate-library ,library) ""))) @@ -377,44 +423,12 @@ Pass BUFFER to the XEmacs version of `move-to-column'." string) (apply 'kill-new string args)) -(defun org-select-frame-set-input-focus (frame) - "Select FRAME, raise it, and set input focus, if possible." - (cond ((featurep 'xemacs) - (if (fboundp 'select-frame-set-input-focus) - (select-frame-set-input-focus frame) - (raise-frame frame) - (select-frame frame) - (focus-frame frame))) - ;; `select-frame-set-input-focus' defined in Emacs 21 will not - ;; set the input focus. - ((>= emacs-major-version 22) - (select-frame-set-input-focus frame)) - (t - (raise-frame frame) - (select-frame frame) - (cond ((memq window-system '(x ns mac)) - (x-focus-frame frame)) - ((eq window-system 'w32) - (w32-focus-frame frame))) - (when focus-follows-mouse - (set-mouse-position frame (1- (frame-width frame)) 0))))) - -(defalias 'org-float-time - (if (featurep 'xemacs) 'time-to-seconds 'float-time)) - -;; `user-error' is only available from 24.2.50 on -(unless (fboundp 'user-error) - (defalias 'user-error 'error)) - -;; ‘format-message’ is available only from 25 on -(unless (fboundp 'format-message) - (defalias 'format-message 'format)) - ;; `font-lock-ensure' is only available from 24.4.50 on (defalias 'org-font-lock-ensure (if (fboundp 'font-lock-ensure) #'font-lock-ensure - (lambda (&optional _beg _end) (font-lock-fontify-buffer)))) + (lambda (&optional _beg _end) + (with-no-warnings (font-lock-fontify-buffer))))) (defmacro org-no-popups (&rest body) "Suppress popup windows. @@ -426,88 +440,6 @@ effect, which variables to use depends on the Emacs version." `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) ,@body))) -(if (fboundp 'string-match-p) - (defalias 'org-string-match-p 'string-match-p) - (defun org-string-match-p (regexp string &optional start) - (save-match-data - (funcall 'string-match regexp string start)))) - -(if (fboundp 'looking-at-p) - (defalias 'org-looking-at-p 'looking-at-p) - (defun org-looking-at-p (&rest args) - (save-match-data - (apply 'looking-at args)))) - -;; XEmacs does not have `looking-back'. -(if (fboundp 'looking-back) - (defalias 'org-looking-back 'looking-back) - (defun org-looking-back (regexp &optional limit greedy) - "Return non-nil if text before point matches regular expression REGEXP. -Like `looking-at' except matches before point, and is slower. -LIMIT if non-nil speeds up the search by specifying a minimum -starting position, to avoid checking matches that would start -before LIMIT. - -If GREEDY is non-nil, extend the match backwards as far as -possible, stopping when a single additional previous character -cannot be part of a match for REGEXP. When the match is -extended, its starting position is allowed to occur before -LIMIT." - (let ((start (point)) - (pos - (save-excursion - (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t) - (point))))) - (if (and greedy pos) - (save-restriction - (narrow-to-region (point-min) start) - (while (and (> pos (point-min)) - (save-excursion - (goto-char pos) - (backward-char 1) - (looking-at (concat "\\(?:" regexp "\\)\\'")))) - (setq pos (1- pos))) - (save-excursion - (goto-char pos) - (looking-at (concat "\\(?:" regexp "\\)\\'"))))) - (not (null pos))))) - -(defun org-floor* (x &optional y) - "Return a list of the floor of X and the fractional part of X. -With two arguments, return floor and remainder of their quotient." - (let ((q (floor x y))) - (list q (- x (if y (* y q) q))))) - -;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1. -(defun org-pop-to-buffer-same-window - (&optional buffer-or-name norecord label) - "Pop to buffer specified by BUFFER-OR-NAME in the selected window." - (if (fboundp 'pop-to-buffer-same-window) - (funcall - 'pop-to-buffer-same-window buffer-or-name norecord) - (funcall 'switch-to-buffer buffer-or-name norecord))) - -;; RECURSIVE has been introduced with Emacs 23.2. -;; This is copying and adapted from `tramp-compat-delete-directory' -(defun org-delete-directory (directory &optional recursive) - "Compatibility function for `delete-directory'." - (if (null recursive) - (delete-directory directory) - (condition-case nil - (funcall 'delete-directory directory recursive) - ;; This Emacs version does not support the RECURSIVE flag. We - ;; use the implementation from Emacs 23.2. - (wrong-number-of-arguments - (setq directory (directory-file-name (expand-file-name directory))) - (if (not (file-symlink-p directory)) - (mapc (lambda (file) - (if (eq t (car (file-attributes file))) - (org-delete-directory file recursive) - (delete-file file))) - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) - (delete-directory directory))))) - ;;;###autoload (defmacro org-check-version () "Try very hard to provide sensible version strings." @@ -526,41 +458,33 @@ With two arguments, return floor and remainder of their quotient." (defun org-release () "N/A") (defun org-git-version () "N/A !!check installation!!")))))) -(defun org-file-equal-p (f1 f2) - "Return t if files F1 and F2 are the same. -Implements `file-equal-p' for older emacsen and XEmacs." - (if (fboundp 'file-equal-p) - (file-equal-p f1 f2) - (let (f1-attr f2-attr) - (and (setq f1-attr (file-attributes (file-truename f1))) - (setq f2-attr (file-attributes (file-truename f2))) - (equal f1-attr f2-attr))))) - -;; `buffer-narrowed-p' is available for Emacs >=24.3 -(defun org-buffer-narrowed-p () - "Compatibility function for `buffer-narrowed-p'." - (if (fboundp 'buffer-narrowed-p) - (buffer-narrowed-p) - (/= (- (point-max) (point-min)) (buffer-size)))) - -;; As of Emacs 25.1, `outline-mode` functions are under the 'outline-' -;; prefix. -(when (< emacs-major-version 25) - (defalias 'outline-show-all 'show-all) - (defalias 'outline-hide-subtree 'hide-subtree) - (defalias 'outline-show-subtree 'show-subtree) - (defalias 'outline-show-branches 'show-branches) - (defalias 'outline-show-children 'show-children) - (defalias 'outline-show-entry 'show-entry) - (defalias 'outline-hide-entry 'hide-entry) - (defalias 'outline-hide-sublevels 'hide-sublevels)) - (defmacro org-with-silent-modifications (&rest body) (if (fboundp 'with-silent-modifications) `(with-silent-modifications ,@body) `(org-unmodified ,@body))) (def-edebug-spec org-with-silent-modifications (body)) +;; Functions for Emacs < 24.4 compatibility +(defun org-define-error (name message) + "Define NAME as a new error signal. +MESSAGE is a string that will be output to the echo area if such +an error is signaled without being caught by a `condition-case'. +Implements `define-error' for older emacsen." + (if (fboundp 'define-error) (define-error name message) + (put name 'error-conditions + (copy-sequence (cons name (get 'error 'error-conditions)))))) + +(unless (fboundp 'string-suffix-p) + ;; From Emacs subr.el. + (defun string-suffix-p (suffix string &optional ignore-case) + "Return non-nil if SUFFIX is a suffix of STRING. +If IGNORE-CASE is non-nil, the comparison is done without paying +attention to case differences." + (let ((start-pos (- (length string) (length suffix)))) + (and (>= start-pos 0) + (eq t (compare-strings suffix nil nil + string start-pos nil ignore-case)))))) + (provide 'org-compat) ;;; org-compat.el ends here diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index d41e80a..1039996 100644 --- a/lisp/org-crypt.el +++ b/lisp/org-crypt.el @@ -1,5 +1,4 @@ -;;; org-crypt.el --- Public key encryption for org-mode entries - +;;; org-crypt.el --- Public Key Encryption for Org Entries -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2016 Free Software Foundation, Inc. ;; Emacs Lisp Archive Entry @@ -7,7 +6,7 @@ ;; Keywords: org-mode ;; Author: John Wiegley <johnw@gnu.org> ;; Maintainer: Peter Jones <pjones@pmade.com> -;; Description: Adds public key encryption to org-mode buffers +;; Description: Adds public key encryption to Org buffers ;; URL: http://www.newartisans.com/software/emacs.html ;; Compatibility: Emacs22 @@ -142,7 +141,7 @@ See `org-crypt-disable-auto-save'." (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage.")) ((eq org-crypt-disable-auto-save 'encrypt) (message "org-decrypt: Enabling re-encryption on auto-save.") - (org-add-hook 'auto-save-hook + (add-hook 'auto-save-hook (lambda () (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.") (org-encrypt-entries)) @@ -164,96 +163,92 @@ See `org-crypt-disable-auto-save'." (if (and (string= crypt-key (get-text-property 0 'org-crypt-key str)) (string= (sha1 str) (get-text-property 0 'org-crypt-checksum str))) (get-text-property 0 'org-crypt-text str) - (set (make-local-variable 'epg-context) (epg-make-context nil t t)) + (setq-local epg-context (epg-make-context nil t t)) (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key)))) (defun org-encrypt-entry () "Encrypt the content of the current headline." (interactive) (require 'epg) - (save-excursion - (org-back-to-heading t) - (set (make-local-variable 'epg-context) (epg-make-context nil t t)) - (let ((start-heading (point))) - (forward-line) - (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) - (let ((folded (outline-invisible-p)) - (crypt-key (org-crypt-key-for-heading)) - (beg (point)) - end encrypted-text) - (goto-char start-heading) - (org-end-of-subtree t t) - (org-back-over-empty-lines) - (setq end (point) - encrypted-text - (org-encrypt-string (buffer-substring beg end) crypt-key)) - (delete-region beg end) - (insert encrypted-text) - (when folded - (goto-char start-heading) - (outline-hide-subtree)) - nil))))) + (org-with-wide-buffer + (org-back-to-heading t) + (setq-local epg-context (epg-make-context nil t t)) + (let ((start-heading (point))) + (org-end-of-meta-data) + (unless (looking-at-p "-----BEGIN PGP MESSAGE-----") + (let ((folded (outline-invisible-p)) + (crypt-key (org-crypt-key-for-heading)) + (beg (point))) + (goto-char start-heading) + (org-end-of-subtree t t) + (org-back-over-empty-lines) + (let ((contents (delete-and-extract-region beg (point)))) + (insert (org-encrypt-string contents crypt-key))) + (when folded + (goto-char start-heading) + (outline-hide-subtree)) + nil))))) (defun org-decrypt-entry () "Decrypt the content of the current headline." (interactive) (require 'epg) (unless (org-before-first-heading-p) - (save-excursion - (org-back-to-heading t) - (let ((heading-point (point)) - (heading-was-invisible-p - (save-excursion - (outline-end-of-heading) - (outline-invisible-p)))) - (forward-line) - (when (looking-at "-----BEGIN PGP MESSAGE-----") - (org-crypt-check-auto-save) - (set (make-local-variable 'epg-context) (epg-make-context nil t t)) - (let* ((end (save-excursion - (search-forward "-----END PGP MESSAGE-----") - (forward-line) - (point))) - (encrypted-text (buffer-substring-no-properties (point) end)) - (decrypted-text - (decode-coding-string - (epg-decrypt-string - epg-context - encrypted-text) - 'utf-8))) - ;; Delete region starting just before point, because the - ;; outline property starts at the \n of the heading. - (delete-region (1- (point)) end) - ;; Store a checksum of the decrypted and the encrypted - ;; text value. This allows reusing the same encrypted text - ;; if the text does not change, and therefore avoid a - ;; re-encryption process. - (insert "\n" (propertize decrypted-text - 'org-crypt-checksum (sha1 decrypted-text) - 'org-crypt-key (org-crypt-key-for-heading) - 'org-crypt-text encrypted-text)) - (when heading-was-invisible-p - (goto-char heading-point) - (org-flag-subtree t)) - nil)))))) + (org-with-wide-buffer + (org-back-to-heading t) + (let ((heading-point (point)) + (heading-was-invisible-p + (save-excursion + (outline-end-of-heading) + (outline-invisible-p)))) + (org-end-of-meta-data) + (when (looking-at "-----BEGIN PGP MESSAGE-----") + (org-crypt-check-auto-save) + (setq-local epg-context (epg-make-context nil t t)) + (let* ((end (save-excursion + (search-forward "-----END PGP MESSAGE-----") + (forward-line) + (point))) + (encrypted-text (buffer-substring-no-properties (point) end)) + (decrypted-text + (decode-coding-string + (epg-decrypt-string + epg-context + encrypted-text) + 'utf-8))) + ;; Delete region starting just before point, because the + ;; outline property starts at the \n of the heading. + (delete-region (1- (point)) end) + ;; Store a checksum of the decrypted and the encrypted + ;; text value. This allows reusing the same encrypted text + ;; if the text does not change, and therefore avoid a + ;; re-encryption process. + (insert "\n" (propertize decrypted-text + 'org-crypt-checksum (sha1 decrypted-text) + 'org-crypt-key (org-crypt-key-for-heading) + 'org-crypt-text encrypted-text)) + (when heading-was-invisible-p + (goto-char heading-point) + (org-flag-subtree t)) + nil)))))) (defun org-encrypt-entries () "Encrypt all top-level entries in the current buffer." (interactive) - (let (todo-only) + (let ((org--matcher-tags-todo-only nil)) (org-scan-tags 'org-encrypt-entry (cdr (org-make-tags-matcher org-crypt-tag-matcher)) - todo-only))) + org--matcher-tags-todo-only))) (defun org-decrypt-entries () "Decrypt all entries in the current buffer." (interactive) - (let (todo-only) + (let ((org--matcher-tags-todo-only nil)) (org-scan-tags 'org-decrypt-entry (cdr (org-make-tags-matcher org-crypt-tag-matcher)) - todo-only))) + org--matcher-tags-todo-only))) (defun org-at-encrypted-entry-p () "Is the current entry encrypted?" @@ -267,7 +262,7 @@ See `org-crypt-disable-auto-save'." "Add a hook to automatically encrypt entries before a file is saved to disk." (add-hook 'org-mode-hook - (lambda () (org-add-hook 'before-save-hook 'org-encrypt-entries nil t)))) + (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t)))) (add-hook 'org-reveal-start-hook 'org-decrypt-entry) diff --git a/lisp/org-ctags.el b/lisp/org-ctags.el index ea4f52b..3c63af0 100644 --- a/lisp/org-ctags.el +++ b/lisp/org-ctags.el @@ -1,4 +1,4 @@ -;;; org-ctags.el - Integrate Emacs "tags" facility with org mode. +;;; org-ctags.el - Integrate Emacs "tags" Facility with Org -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2007-2016 Free Software Foundation, Inc. @@ -26,20 +26,21 @@ ;; Synopsis ;; ======== ;; -;; Allows org-mode to make use of the Emacs `etags' system. Defines tag -;; destinations in org-mode files as any text between <<double angled -;; brackets>>. This allows the tags-generation program `exuberant ctags' to -;; parse these files and create tag tables that record where these -;; destinations are found. Plain [[links]] in org mode files which do not have -;; <<matching destinations>> within the same file will then be interpreted as -;; links to these 'tagged' destinations, allowing seamless navigation between -;; multiple org-mode files. Topics can be created in any org mode file and -;; will always be found by plain links from other files. Other file types -;; recognized by ctags (source code files, latex files, etc) will also be -;; available as destinations for plain links, and similarly, org-mode links -;; will be available as tags from source files. Finally, the function -;; `org-ctags-find-tag-interactive' lets you choose any known tag, using -;; autocompletion, and quickly jump to it. +;; Allows Org mode to make use of the Emacs `etags' system. Defines +;; tag destinations in Org files as any text between <<double angled +;; brackets>>. This allows the tags-generation program `exuberant +;; ctags' to parse these files and create tag tables that record where +;; these destinations are found. Plain [[links]] in org mode files +;; which do not have <<matching destinations>> within the same file +;; will then be interpreted as links to these 'tagged' destinations, +;; allowing seamless navigation between multiple Org files. Topics +;; can be created in any org mode file and will always be found by +;; plain links from other files. Other file types recognized by ctags +;; (source code files, latex files, etc) will also be available as +;; destinations for plain links, and similarly, Org links will be +;; available as tags from source files. Finally, the function +;; `org-ctags-find-tag-interactive' lets you choose any known tag, +;; using autocompletion, and quickly jump to it. ;; ;; Installation ;; ============ @@ -110,8 +111,9 @@ ;; Keeping the TAGS file up to date ;; ================================ ;; -;; Tags mode has no way of knowing that you have created new tags by typing in -;; your org-mode buffer. New tags make it into the TAGS file in 3 ways: +;; Tags mode has no way of knowing that you have created new tags by +;; typing in your Org buffer. New tags make it into the TAGS file in +;; 3 ways: ;; ;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file. ;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in @@ -135,12 +137,8 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (require 'org) -(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) - (defgroup org-ctags nil "Options concerning use of ctags within org mode." :tag "Org-Ctags" @@ -151,7 +149,7 @@ (defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/" "Regexp expression used by ctags external program. -The regexp matches tag destinations in org-mode files. +The regexp matches tag destinations in Org files. Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/ See the ctags documentation for more information.") @@ -210,8 +208,8 @@ The following patterns are replaced in the string: (defadvice visit-tags-table (after org-ctags-load-tag-list activate compile) (when (and org-ctags-enabled-p tags-file-name) - (set (make-local-variable 'org-ctags-tag-list) - (org-ctags-all-tags-in-current-tags-table)))) + (setq-local org-ctags-tag-list + (org-ctags-all-tags-in-current-tags-table)))) (defun org-ctags-enable () @@ -273,11 +271,6 @@ Return the list." (replace-regexp-in-string (regexp-quote search) replace string t t)) -(defun y-or-n-minibuffer (prompt) - (let ((use-dialog-box nil)) - (y-or-n-p prompt))) - - ;;; Internal functions ======================================================= @@ -285,29 +278,28 @@ Return the list." "Visit or create a file called `NAME.org', and insert a new topic. The new topic will be titled NAME (or TITLE if supplied)." (interactive "sFile name: ") - (let ((filename (substitute-in-file-name (expand-file-name name)))) - (condition-case v - (progn - (org-open-file name t) - (message "Opened file OK") - (goto-char (point-max)) - (insert (org-ctags-string-search-and-replace - "%t" (capitalize (or title name)) - org-ctags-new-topic-template)) - (message "Inserted new file text OK") - (org-mode-restart)) - (error (error "Error %S in org-ctags-open-file" v))))) + (condition-case v + (progn + (org-open-file name t) + (message "Opened file OK") + (goto-char (point-max)) + (insert (org-ctags-string-search-and-replace + "%t" (capitalize (or title name)) + org-ctags-new-topic-template)) + (message "Inserted new file text OK") + (org-mode-restart)) + (error (error "Error %S in org-ctags-open-file" v)))) ;;;; Misc interoperability with etags system ================================= -(defadvice find-tag (before org-ctags-set-org-mark-before-finding-tag - activate compile) +(defadvice xref-find-definitions + (before org-ctags-set-org-mark-before-finding-tag activate compile) "Before trying to find a tag, save our current position on org mark ring." (save-excursion - (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p) - (org-mark-ring-push)))) + (when (and (derived-mode-p 'org-mode) org-ctags-enabled-p) + (org-mark-ring-push)))) @@ -359,7 +351,7 @@ visit the file and location where the tag is found." (old-pnt (point-marker)) (old-mark (copy-marker (mark-marker)))) (condition-case nil - (progn (find-tag name) + (progn (xref-find-definitions name) t) (error ;; only restore old location if find-tag raises error @@ -386,7 +378,7 @@ the new file." (cond ((get-buffer (concat name ".org")) ;; Buffer is already open - (org-pop-to-buffer-same-window (get-buffer (concat name ".org")))) + (pop-to-buffer-same-window (get-buffer (concat name ".org")))) ((file-exists-p filename) ;; File exists but is not open --> open it (message "Opening existing org file `%S'..." @@ -421,7 +413,6 @@ the heading a destination for the tag `NAME'." (insert (org-ctags-string-search-and-replace "%t" (capitalize name) org-ctags-new-topic-template)) (backward-char 4) - (org-update-radio-target-regexp) (end-of-line) (forward-line 2) (when narrowp @@ -464,10 +455,10 @@ Wrapper for org-ctags-rebuild-tags-file-then-find-tag." nil)) -(defun org-ctags-fail-silently (name) +(defun org-ctags-fail-silently (_name) "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Put as the last function in the list if you want to prevent org's default -behavior of free text search." +Put as the last function in the list if you want to prevent Org's +default behavior of free text search." t) @@ -484,7 +475,7 @@ end up in one file, called TAGS, located in the directory. This function may take several seconds to finish if the directory or its subdirectories contain large numbers of taggable files." (interactive) - (assert (buffer-file-name)) + (cl-assert (buffer-file-name)) (let ((dir-name (or directory-name (file-name-directory (buffer-file-name)))) (exitcode nil)) @@ -499,8 +490,8 @@ its subdirectories contain large numbers of taggable files." (expand-file-name (concat dir-name "/*"))))) (cond ((eql 0 exitcode) - (set (make-local-variable 'org-ctags-tag-list) - (org-ctags-all-tags-in-current-tags-table))) + (setq-local org-ctags-tag-list + (org-ctags-all-tags-in-current-tags-table))) (t ;; This seems to behave differently on Linux, so just ignore ;; error codes for now @@ -528,7 +519,7 @@ a new topic." ((member tag org-ctags-tag-list) ;; Existing tag (push tag org-ctags-find-tag-history) - (find-tag tag)) + (xref-find-definitions tag)) (t ;; New tag (run-hook-with-args-until-success diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el index 999bc24..2a921bf 100644 --- a/lisp/org-datetree.el +++ b/lisp/org-datetree.el @@ -1,4 +1,4 @@ -;;; org-datetree.el --- Create date entries in a tree +;;; org-datetree.el --- Create date entries in a tree -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -34,9 +34,10 @@ (defvar org-datetree-base-level 1 "The level at which years should be placed in the date tree. -This is normally one, but if the buffer has an entry with a DATE_TREE -property (any value), the date tree will become a subtree under that entry, -so the base level will be properly adjusted.") +This is normally one, but if the buffer has an entry with a +DATE_TREE (or WEEK_TREE for ISO week entries) property (any +value), the date tree will become a subtree under that entry, so +the base level will be properly adjusted.") (defcustom org-datetree-add-timestamp nil "When non-nil, add a time stamp matching date of entry. @@ -49,103 +50,116 @@ Added time stamp is active unless value is `inactive'." (const :tag "Add an active time stamp" active))) ;;;###autoload -(defun org-datetree-find-date-create (date &optional keep-restriction) - "Find or create an entry for DATE. +(defun org-datetree-find-date-create (d &optional keep-restriction) + "Find or create an entry for date D. If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it is nil, the buffer will be widened to make sure an existing date tree can be found." - (org-set-local 'org-datetree-base-level 1) + (setq-local org-datetree-base-level 1) (or keep-restriction (widen)) (save-restriction (let ((prop (org-find-property "DATE_TREE"))) (when prop (goto-char prop) - (org-set-local 'org-datetree-base-level - (org-get-valid-level (org-current-level) 1)) + (setq-local org-datetree-base-level + (org-get-valid-level (org-current-level) 1)) (org-narrow-to-subtree))) (goto-char (point-min)) - (let ((year (nth 2 date)) - (month (car date)) - (day (nth 1 date))) - (org-datetree-find-year-create year) - (org-datetree-find-month-create year month) - (org-datetree-find-day-create year month day)))) - -(defun org-datetree-find-year-create (year) - "Find the YEAR datetree or create it." - (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)") - match) - (goto-char (point-min)) - (while (and (setq match (re-search-forward re nil t)) - (goto-char (match-beginning 1)) - (< (string-to-number (match-string 1)) year))) - (cond - ((not match) - (goto-char (point-max)) - (or (bolp) (newline)) - (org-datetree-insert-line year)) - ((= (string-to-number (match-string 1)) year) - (goto-char (point-at-bol))) - (t - (beginning-of-line 1) - (org-datetree-insert-line year))))) + (let ((year (calendar-extract-year d)) + (month (calendar-extract-month d)) + (day (calendar-extract-day d))) + (org-datetree--find-create + "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\ +\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)" + year) + (org-datetree--find-create + "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" + year month) + (org-datetree--find-create + "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" + year month day)))) -(defun org-datetree-find-month-create (year month) - "Find the datetree for YEAR and MONTH or create it." - (org-narrow-to-subtree) - (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year)) - match) +;;;###autoload +(defun org-datetree-find-iso-week-create (d &optional keep-restriction) + "Find or create an ISO week entry for date D. +Compared to `org-datetree-find-date-create' this function creates +entries ordered by week instead of months. +If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it +is nil, the buffer will be widened to make sure an existing date +tree can be found." + (setq-local org-datetree-base-level 1) + (or keep-restriction (widen)) + (save-restriction + (let ((prop (org-find-property "WEEK_TREE"))) + (when prop + (goto-char prop) + (setq-local org-datetree-base-level + (org-get-valid-level (org-current-level) 1)) + (org-narrow-to-subtree))) (goto-char (point-min)) - (while (and (setq match (re-search-forward re nil t)) - (goto-char (match-beginning 1)) - (< (string-to-number (match-string 1)) month))) - (cond - ((not match) - (goto-char (point-max)) - (or (bolp) (newline)) - (org-datetree-insert-line year month)) - ((= (string-to-number (match-string 1)) month) - (goto-char (point-at-bol))) - (t - (beginning-of-line 1) - (org-datetree-insert-line year month))))) - -(defun org-datetree-find-day-create (year month day) - "Find the datetree for YEAR, MONTH and DAY or create it." - (org-narrow-to-subtree) - (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month)) + (require 'cal-iso) + (let* ((year (calendar-extract-year d)) + (month (calendar-extract-month d)) + (day (calendar-extract-day d)) + (time (encode-time 0 0 0 day month year)) + (iso-date (calendar-iso-from-absolute + (calendar-absolute-from-gregorian d))) + (weekyear (nth 2 iso-date)) + (week (nth 0 iso-date))) + ;; ISO 8601 week format is %G-W%V(-%u) + (org-datetree--find-create + "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\ +\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)" + weekyear nil nil + (format-time-string "%G" time)) + (org-datetree--find-create + "^\\*+[ \t]+%d-W\\([0-5][0-9]\\)$" + weekyear week nil + (format-time-string "%G-W%V" time)) + ;; For the actual day we use the regular date instead of ISO week. + (org-datetree--find-create + "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" + year month day)))) + +(defun org-datetree--find-create (regex year &optional month day insert) + "Find the datetree matched by REGEX for YEAR, MONTH, or DAY. +REGEX is passed to `format' with YEAR, MONTH, and DAY as +arguments. Match group 1 is compared against the specified date +component. If INSERT is non-nil and there is no match then it is +inserted into the buffer." + (when (or month day) + (org-narrow-to-subtree)) + (let ((re (format regex year month day)) match) (goto-char (point-min)) (while (and (setq match (re-search-forward re nil t)) (goto-char (match-beginning 1)) - (< (string-to-number (match-string 1)) day))) + (< (string-to-number (match-string 1)) (or day month year)))) (cond ((not match) (goto-char (point-max)) - (or (bolp) (newline)) - (org-datetree-insert-line year month day)) - ((= (string-to-number (match-string 1)) day) - (goto-char (point-at-bol))) + (unless (bolp) (insert "\n")) + (org-datetree-insert-line year month day insert)) + ((= (string-to-number (match-string 1)) (or day month year)) + (beginning-of-line)) (t - (beginning-of-line 1) - (org-datetree-insert-line year month day))))) + (beginning-of-line) + (org-datetree-insert-line year month day insert))))) -(defun org-datetree-insert-line (year &optional month day) +(defun org-datetree-insert-line (year &optional month day text) (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point)) (insert "\n" (make-string org-datetree-base-level ?*) " \n") (backward-char) (when month (org-do-demote)) (when day (org-do-demote)) - (insert (format "%d" year)) - (when month - (insert - (format "-%02d" month) - (if day - (format "-%02d %s" - day - (format-time-string "%A" (encode-time 0 0 0 day month year))) - (format " %s" - (format-time-string "%B" (encode-time 0 0 0 1 month year)))))) + (if text + (insert text) + (insert (format "%d" year)) + (when month + (insert + (if day + (format-time-string "-%m-%d %A" (encode-time 0 0 0 day month year)) + (format-time-string "-%m %B" (encode-time 0 0 0 1 month year)))))) (when (and day org-datetree-add-timestamp) (save-excursion (insert "\n") @@ -156,9 +170,9 @@ tree can be found." (eq org-datetree-add-timestamp 'inactive)))) (beginning-of-line)) -(defun org-datetree-file-entry-under (txt date) - "Insert a node TXT into the date tree under DATE." - (org-datetree-find-date-create date) +(defun org-datetree-file-entry-under (txt d) + "Insert a node TXT into the date tree under date D." + (org-datetree-find-date-create d) (let ((level (org-get-valid-level (funcall outline-level) 1))) (org-end-of-subtree t t) (org-back-over-empty-lines) @@ -171,44 +185,42 @@ before running this command, even though the command tries to be smart." (interactive) (goto-char (point-min)) (let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'")) - (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'")) - dct ts tmp date year month day pos hdl-pos) + (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'"))) (while (re-search-forward org-ts-regexp nil t) (catch 'next - (setq ts (match-string 0)) - (setq tmp (buffer-substring - (max (point-at-bol) (- (match-beginning 0) - org-ds-keyword-length)) - (match-beginning 0))) - (if (or (string-match "-\\'" tmp) - (string-match dre tmp) - (string-match sre tmp)) + (let ((tmp (buffer-substring + (max (line-beginning-position) + (- (match-beginning 0) org-ds-keyword-length)) + (match-beginning 0)))) + (when (or (string-suffix-p "-" tmp) + (string-match dre tmp) + (string-match sre tmp)) (throw 'next nil)) - (setq dct (decode-time (org-time-string-to-time (match-string 0))) - date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)) - year (nth 2 date) - month (car date) - day (nth 1 date) - pos (point)) - (org-back-to-heading t) - (setq hdl-pos (point)) - (unless (org-up-heading-safe) - ;; No parent, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") - ;; Parent looks wrong, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) - ;; At correct date already, do nothing - (progn (goto-char pos) (throw 'next nil))) - ;; OK, we need to refile this entry - (goto-char hdl-pos) - (org-cut-subtree) - (save-excursion - (save-restriction - (org-datetree-file-entry-under (current-kill 0) date))))))) + (let* ((dct (decode-time (org-time-string-to-time (match-string 0)))) + (date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))) + (year (nth 2 date)) + (month (car date)) + (day (nth 1 date)) + (pos (point)) + (hdl-pos (progn (org-back-to-heading t) (point)))) + (unless (org-up-heading-safe) + ;; No parent, we are not in a date tree. + (goto-char pos) + (throw 'next nil)) + (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") + ;; Parent looks wrong, we are not in a date tree. + (goto-char pos) + (throw 'next nil)) + (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) + ;; At correct date already, do nothing. + (goto-char pos) + (throw 'next nil)) + ;; OK, we need to refile this entry. + (goto-char hdl-pos) + (org-cut-subtree) + (save-excursion + (save-restriction + (org-datetree-file-entry-under (current-kill 0) date))))))))) (provide 'org-datetree) diff --git a/lisp/org-docview.el b/lisp/org-docview.el index d2a9525..0f0bdaf 100644 --- a/lisp/org-docview.el +++ b/lisp/org-docview.el @@ -1,4 +1,4 @@ -;;; org-docview.el --- support for links to doc-view-mode buffers +;;; org-docview.el --- Support for links to doc-view-mode buffers -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -25,7 +25,7 @@ ;;; Commentary: ;; This file implements links to open files in doc-view-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;; The links take the form @@ -49,8 +49,10 @@ (declare-function doc-view-goto-page "doc-view" (page)) (declare-function image-mode-window-get "image-mode" (prop &optional winprops)) -(org-add-link-type "docview" 'org-docview-open 'org-docview-export) -(add-hook 'org-store-link-functions 'org-docview-store-link) +(org-link-set-parameters "docview" + :follow #'org-docview-open + :export #'org-docview-export + :store #'org-docview-store-link) (defun org-docview-export (link description format) "Export a docview link from Org files." @@ -81,8 +83,7 @@ ;; This buffer is in doc-view-mode (let* ((path buffer-file-name) (page (image-mode-window-get 'page)) - (link (concat "docview:" path "::" (number-to-string page))) - (description "")) + (link (concat "docview:" path "::" (number-to-string page)))) (org-store-link-props :type "docview" :link link diff --git a/lisp/org-element.el b/lisp/org-element.el index 2576c3f..027eea4 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -1,4 +1,4 @@ -;;; org-element.el --- Parser And Applications for Org syntax +;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2016 Free Software Foundation, Inc. @@ -116,9 +116,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'org) (require 'avl-tree) +(require 'cl-lib) @@ -151,7 +151,7 @@ specially in `org-element--object-lex'.") ;; Headlines, inlinetasks. org-outline-regexp "\\|" ;; Footnote definitions. - "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|" + "\\[fn:[-_[:word:]]+\\]" "\\|" ;; Diary sexps. "%%(" "\\|" "[ \t]*\\(?:" @@ -177,15 +177,15 @@ specially in `org-element--object-lex'.") ;; Clock lines. (regexp-quote org-clock-string) "\\|" ;; Lists. - (let ((term (case org-plain-list-ordered-item-terminator - (?\) ")") (?. "\\.") (otherwise "[.)]"))) + (let ((term (pcase org-plain-list-ordered-item-terminator + (?\) ")") (?. "\\.") (_ "[.)]"))) (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]"))) (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" "\\(?:[ \t]\\|$\\)")) "\\)\\)") org-element--object-regexp (mapconcat #'identity - (let ((link-types (regexp-opt org-link-types))) + (let ((link-types (regexp-opt (org-link-types)))) (list ;; Sub/superscript. "\\(?:[_^][-{(*+.,[:alnum:]]\\)" @@ -199,7 +199,12 @@ specially in `org-element--object-lex'.") ;; Objects starting with "[": regular link, ;; footnote reference, statistics cookie, ;; timestamp (inactive). - "\\[\\(?:fn:\\|\\(?:[0-9]\\|\\(?:%\\|/[0-9]*\\)\\]\\)\\|\\[\\)" + (concat "\\[\\(?:" + "fn:" "\\|" + "\\[" "\\|" + "[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" "\\|" + "[0-9]*\\(?:%\\|/[0-9]*\\)\\]" + "\\)") ;; Objects starting with "@": export snippets. "@@" ;; Objects starting with "{": macro. @@ -258,17 +263,6 @@ specially in `org-element--object-lex'.") (append org-element-recursive-objects '(paragraph table-row verse-block)) "List of object or element types that can directly contain objects.") -(defvar org-element-block-name-alist - '(("CENTER" . org-element-center-block-parser) - ("COMMENT" . org-element-comment-block-parser) - ("EXAMPLE" . org-element-example-block-parser) - ("QUOTE" . org-element-quote-block-parser) - ("SRC" . org-element-src-block-parser) - ("VERSE" . org-element-verse-block-parser)) - "Alist between block names and the associated parsing function. -Names must be uppercase. Any block whose name has no association -is parsed with `org-element-special-block-parser'.") - (defconst org-element-affiliated-keywords '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" "RESULTS" "SOURCE" "SRCNAME" "TBLNAME") @@ -334,7 +328,7 @@ This list is checked after translations have been applied. See ;; Regular affiliated keywords. (format "\\(?1:%s\\)" (regexp-opt - (org-remove-if + (cl-remove-if (lambda (k) (member k org-element-dual-keywords)) org-element-affiliated-keywords))) "\\|" @@ -358,10 +352,11 @@ Don't modify it, set `org-element-affiliated-keywords' instead.") (italic ,@standard-set) (item ,@standard-set-no-line-break) (keyword ,@(remq 'footnote-reference standard-set)) - ;; Ignore all links excepted plain links in a link description. - ;; Also ignore radio-targets and line breaks. + ;; Ignore all links excepted plain links and angular links in + ;; a link description. Also ignore radio-targets and line + ;; breaks. (link bold code entity export-snippet inline-babel-call inline-src-block - italic latex-fragment macro plain-link statistics-cookie + italic latex-fragment macro simple-link statistics-cookie strike-through subscript superscript underline verbatim) (paragraph ,@standard-set) ;; Remove any variable object from radio target as it would @@ -399,6 +394,15 @@ still has an entry since one of its properties (`:title') does.") (item :tag)) "Alist between element types and locations of secondary values.") +(defconst org-element--pair-round-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) + (dolist (char '(?\{ ?\} ?\[ ?\] ?\< ?\>) table) + (modify-syntax-entry char " " table))) + "Table used internally to pair only round brackets. +Other brackets are treated as spaces.") + (defconst org-element--pair-square-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\[ "(]" table) @@ -408,6 +412,33 @@ still has an entry since one of its properties (`:title') does.") "Table used internally to pair only square brackets. Other brackets are treated as spaces.") +(defconst org-element--pair-curly-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\{ "(}" table) + (modify-syntax-entry ?\} "){" table) + (dolist (char '(?\[ ?\] ?\( ?\) ?\< ?\>) table) + (modify-syntax-entry char " " table))) + "Table used internally to pair only curly brackets. +Other brackets are treated as spaces.") + +(defun org-element--parse-paired-brackets (char) + "Parse paired brackets at point. +CHAR is the opening bracket to consider, as a character. Return +contents between brackets, as a string, or nil. Also move point +past the brackets." + (when (eq char (char-after)) + (let ((syntax-table (pcase char + (?\{ org-element--pair-curly-table) + (?\[ org-element--pair-square-table) + (?\( org-element--pair-round-table) + (_ nil))) + (pos (point))) + (when syntax-table + (with-syntax-table syntax-table + (let ((end (ignore-errors (scan-lists pos 1 0)))) + (when end + (goto-char end) + (buffer-substring-no-properties (1+ pos) (1- end))))))))) ;;; Accessors and Setters @@ -424,8 +455,10 @@ Other brackets are treated as spaces.") ;; high-level functions useful to modify a parse tree. ;; ;; `org-element-secondary-p' is a predicate used to know if a given -;; object belongs to a secondary string. `org-element-copy' returns -;; an element or object, stripping its parent property in the process. +;; object belongs to a secondary string. `org-element-class' tells if +;; some parsed data is an element or an object, handling pseudo +;; elements and objects. `org-element-copy' returns an element or +;; object, stripping its parent property in the process. (defsubst org-element-type (element) "Return type of ELEMENT. @@ -465,10 +498,11 @@ Return modified element." element)) (defsubst org-element-set-contents (element &rest contents) - "Set ELEMENT contents to CONTENTS." - (cond ((not element) (list contents)) + "Set ELEMENT's contents to CONTENTS. +Return ELEMENT." + (cond ((null element) contents) ((not (symbolp (car element))) contents) - ((cdr element) (setcdr (cdr element) contents)) + ((cdr element) (setcdr (cdr element) contents) element) (t (nconc element contents)))) (defun org-element-secondary-p (object) @@ -482,6 +516,32 @@ Return value is the property name, as a keyword, or nil." (and (memq object (org-element-property p parent)) (throw 'exit p)))))) +(defun org-element-class (datum &optional parent) + "Return class for ELEMENT, as a symbol. +Class is either `element' or `object'. Optional argument PARENT +is the element or object containing DATUM. It defaults to the +value of DATUM `:parent' property." + (let ((type (org-element-type datum)) + (parent (or parent (org-element-property :parent datum)))) + (cond + ;; Trivial cases. + ((memq type org-element-all-objects) 'object) + ((memq type org-element-all-elements) 'element) + ;; Special cases. + ((eq type 'org-data) 'element) + ((eq type 'plain-text) 'object) + ((not type) 'object) + ;; Pseudo object or elements. Make a guess about its class. + ;; Basically a pseudo object is contained within another object, + ;; a secondary string or a container element. + ((not parent) 'element) + (t + (let ((parent-type (org-element-type parent))) + (cond ((not parent-type) 'object) + ((memq parent-type org-element-object-containers) 'object) + ((org-element-secondary-p datum) 'object) + (t 'element))))))) + (defsubst org-element-adopt-elements (parent &rest children) "Append elements to the contents of another element. @@ -587,11 +647,11 @@ DATUM is an element, object, string or nil. `:parent' property is cleared and contents are removed in the process." (when datum (let ((type (org-element-type datum))) - (case type - (org-data (list 'org-data nil)) - (plain-text (substring-no-properties datum)) - ((nil) (copy-sequence datum)) - (otherwise + (pcase type + (`org-data (list 'org-data nil)) + (`plain-text (substring-no-properties datum)) + (`nil (copy-sequence datum)) + (_ (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil))))))) @@ -674,8 +734,8 @@ Assume point is at the beginning of the block." :post-affiliated post-affiliated) (cdr affiliated)))))))) -(defun org-element-center-block-interpreter (center-block contents) - "Interpret CENTER-BLOCK element as Org syntax. +(defun org-element-center-block-interpreter (_ contents) + "Interpret a center-block element as Org syntax. CONTENTS is the contents of the element." (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents)) @@ -702,7 +762,7 @@ Assume point is at beginning of drawer." (save-excursion (let* ((drawer-end-line (match-beginning 0)) (name (progn (looking-at org-drawer-regexp) - (org-match-string-no-properties 1))) + (match-string-no-properties 1))) (begin (car affiliated)) (post-affiliated (point)) ;; Empty drawers have no contents. @@ -758,8 +818,8 @@ Assume point is at beginning of dynamic block." (let ((block-end-line (match-beginning 0))) (save-excursion (let* ((name (progn (looking-at org-dblock-start-re) - (org-match-string-no-properties 1))) - (arguments (org-match-string-no-properties 3)) + (match-string-no-properties 1))) + (arguments (match-string-no-properties 3)) (begin (car affiliated)) (post-affiliated (point)) ;; Empty blocks have no contents. @@ -817,7 +877,7 @@ a plist containing `:label', `:begin' `:end', `:contents-begin', Assume point is at the beginning of the footnote definition." (save-excursion (let* ((label (progn (looking-at org-footnote-definition-re) - (org-match-string-no-properties 1))) + (match-string-no-properties 1))) (begin (car affiliated)) (post-affiliated (point)) (ending @@ -832,7 +892,7 @@ Assume point is at the beginning of the footnote definition." ;; before any affiliated keyword above. (forward-line -1) (while (and (> (point) post-affiliated) - (org-looking-at-p org-element--affiliated-re)) + (looking-at-p org-element--affiliated-re)) (forward-line -1)) (line-beginning-position 2)) (t (match-beginning 0))))) @@ -861,7 +921,7 @@ Assume point is at the beginning of the footnote definition." (defun org-element-footnote-definition-interpreter (footnote-definition contents) "Interpret FOOTNOTE-DEFINITION element as Org syntax. CONTENTS is the contents of the footnote-definition." - (concat (format "[%s]" (org-element-property :label footnote-definition)) + (concat (format "[fn:%s]" (org-element-property :label footnote-definition)) " " contents)) @@ -875,13 +935,13 @@ obtained through property drawer and default properties from the parser (e.g. `:end' and :END:). Return value is a plist." (save-excursion (forward-line) - (when (org-looking-at-p org-planning-line-re) (forward-line)) + (when (looking-at-p org-planning-line-re) (forward-line)) (when (looking-at org-property-drawer-re) (forward-line) (let ((end (match-end 0)) properties) (while (< (line-end-position) end) (looking-at org-property-re) - (push (org-match-string-no-properties 3) properties) + (push (match-string-no-properties 3) properties) (push (intern (concat ":" (upcase (match-string 2)))) properties) (forward-line)) properties)))) @@ -944,7 +1004,7 @@ Assume point is at beginning of the headline." (goto-char (match-end 0)))) (title-start (point)) (tags (when (re-search-forward - (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" (line-end-position) 'move) (goto-char (match-beginning 0)) @@ -995,17 +1055,16 @@ Assume point is at beginning of the headline." (org-element-put-property headline :title (if raw-secondary-p raw-value - (let ((title (org-element--parse-objects - (progn (goto-char title-start) - (skip-chars-forward " \t") - (point)) - (progn (goto-char title-end) - (skip-chars-backward " \t") - (point)) - nil - (org-element-restriction 'headline)))) - (dolist (datum title title) - (org-element-put-property datum :parent headline))))))))) + (org-element--parse-objects + (progn (goto-char title-start) + (skip-chars-forward " \t") + (point)) + (progn (goto-char title-end) + (skip-chars-backward " \t") + (point)) + nil + (org-element-restriction 'headline) + headline))))))) (defun org-element-headline-interpreter (headline contents) "Interpret HEADLINE element as Org syntax. @@ -1087,7 +1146,7 @@ Assume point is at beginning of the inline task." (aref (match-string 0) 2)))) (title-start (point)) (tags (when (re-search-forward - (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" (line-end-position) 'move) (goto-char (match-beginning 0)) @@ -1098,7 +1157,7 @@ Assume point is at beginning of the inline task." (task-end (save-excursion (end-of-line) (and (re-search-forward org-outline-regexp-bol limit t) - (org-looking-at-p "END[ \t]*$") + (looking-at-p "END[ \t]*$") (line-beginning-position)))) (standard-props (and task-end (org-element--get-node-properties))) (time-props (and task-end (org-element--get-time-properties))) @@ -1131,17 +1190,16 @@ Assume point is at beginning of the inline task." (org-element-put-property inlinetask :title (if raw-secondary-p raw-value - (let ((title (org-element--parse-objects - (progn (goto-char title-start) - (skip-chars-forward " \t") - (point)) - (progn (goto-char title-end) - (skip-chars-backward " \t") - (point)) - nil - (org-element-restriction 'inlinetask)))) - (dolist (datum title title) - (org-element-put-property datum :parent inlinetask)))))))) + (org-element--parse-objects + (progn (goto-char title-start) + (skip-chars-forward " \t") + (point)) + (progn (goto-char title-end) + (skip-chars-backward " \t") + (point)) + nil + (org-element-restriction 'inlinetask) + inlinetask)))))) (defun org-element-inlinetask-interpreter (inlinetask contents) "Interpret INLINETASK element as Org syntax. @@ -1183,7 +1241,7 @@ CONTENTS is the contents of inlinetask." ;;;; Item -(defun org-element-item-parser (limit struct &optional raw-secondary-p) +(defun org-element-item-parser (_ struct &optional raw-secondary-p) "Parse an item. STRUCT is the structure of the plain list. @@ -1202,7 +1260,7 @@ Assume point is at the beginning of the item." (beginning-of-line) (looking-at org-list-full-item-re) (let* ((begin (point)) - (bullet (org-match-string-no-properties 1)) + (bullet (match-string-no-properties 1)) (checkbox (let ((box (match-string 3))) (cond ((equal "[ ]" box) 'off) ((equal "[X]" box) 'on) @@ -1253,11 +1311,10 @@ Assume point is at the beginning of the item." (let ((raw (org-list-get-tag begin struct))) (when raw (if raw-secondary-p raw - (let ((tag (org-element--parse-objects - (match-beginning 4) (match-end 4) nil - (org-element-restriction 'item)))) - (dolist (datum tag tag) - (org-element-put-property datum :parent item)))))))))) + (org-element--parse-objects + (match-beginning 4) (match-end 4) nil + (org-element-restriction 'item) + item)))))))) (defun org-element-item-interpreter (item contents) "Interpret ITEM element as Org syntax. @@ -1280,10 +1337,11 @@ CONTENTS is the contents of the element." (concat bullet (and counter (format "[@%d] " counter)) - (case checkbox - (on "[X] ") - (off "[ ] ") - (trans "[-] ")) + (pcase checkbox + (`on "[X] ") + (`off "[ ] ") + (`trans "[-] ") + (_ nil)) (and tag (format "%s :: " tag)) (when contents (let ((contents (replace-regexp-in-string @@ -1351,7 +1409,7 @@ CONTENTS is the contents of the element." (forward-line) (let ((origin (point))) (when (re-search-forward inlinetask-re limit t) - (if (org-looking-at-p "END[ \t]*$") (forward-line) + (if (looking-at-p "END[ \t]*$") (forward-line) (goto-char origin))))) ;; At some text line. Check if it ends any previous item. (t @@ -1393,7 +1451,7 @@ containing `:type', `:begin', `:end', `:contents-begin' and Assume point is at the beginning of the list." (save-excursion (let* ((struct (or structure (org-element--list-struct limit))) - (type (cond ((org-looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered) + (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered) ((nth 5 (assq (point) struct)) 'descriptive) (t 'unordered))) (contents-begin (point)) @@ -1421,8 +1479,8 @@ Assume point is at the beginning of the list." :post-affiliated contents-begin) (cdr affiliated)))))) -(defun org-element-plain-list-interpreter (plain-list contents) - "Interpret PLAIN-LIST element as Org syntax. +(defun org-element-plain-list-interpreter (_ contents) + "Interpret plain-list element as Org syntax. CONTENTS is the contents of the element." (with-temp-buffer (insert contents) @@ -1461,8 +1519,8 @@ Assume point is at the beginning of the property drawer." :post-blank (count-lines before-blank end) :post-affiliated begin)))))) -(defun org-element-property-drawer-interpreter (property-drawer contents) - "Interpret PROPERTY-DRAWER element as Org syntax. +(defun org-element-property-drawer-interpreter (_ contents) + "Interpret property-drawer element as Org syntax. CONTENTS is the properties within the drawer." (format ":PROPERTIES:\n%s:END:" contents)) @@ -1511,19 +1569,17 @@ Assume point is at the beginning of the block." :post-affiliated post-affiliated) (cdr affiliated))))))))) -(defun org-element-quote-block-interpreter (quote-block contents) - "Interpret QUOTE-BLOCK element as Org syntax. +(defun org-element-quote-block-interpreter (_ contents) + "Interpret quote-block element as Org syntax. CONTENTS is the contents of the element." (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents)) ;;;; Section -(defun org-element-section-parser (limit) +(defun org-element-section-parser (_) "Parse a section. -LIMIT bounds the search. - Return a list whose CAR is `section' and CDR is a plist containing `:begin', `:end', `:contents-begin', `contents-end', `:post-blank' and `:post-affiliated' keywords." @@ -1534,8 +1590,7 @@ containing `:begin', `:end', `:contents-begin', `contents-end', (end (progn (org-with-limited-levels (outline-next-heading)) (point))) (pos-before-blank (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point)))) + (line-beginning-position 2)))) (list 'section (list :begin begin :end end @@ -1544,8 +1599,8 @@ containing `:begin', `:end', `:contents-begin', `contents-end', :post-blank (count-lines pos-before-blank end) :post-affiliated begin))))) -(defun org-element-section-interpreter (section contents) - "Interpret SECTION element as Org syntax. +(defun org-element-section-interpreter (_ contents) + "Interpret section element as Org syntax. CONTENTS is the contents of the element." contents) @@ -1616,9 +1671,6 @@ CONTENTS is the contents of the element." ;; through the following steps: implement a parser and an interpreter, ;; tweak `org-element--current-element' so that it recognizes the new ;; type and add that new type to `org-element-all-elements'. -;; -;; As a special case, when the newly defined type is a block type, -;; `org-element-block-name-alist' has to be modified accordingly. ;;;; Babel Call @@ -1665,9 +1717,8 @@ containing `:call', `:inside-header', `:arguments', :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-babel-call-interpreter (babel-call contents) - "Interpret BABEL-CALL element as Org syntax. -CONTENTS is nil." +(defun org-element-babel-call-interpreter (babel-call _) + "Interpret BABEL-CALL element as Org syntax." (concat "#+CALL: " (org-element-property :call babel-call) (let ((h (org-element-property :inside-header babel-call))) @@ -1696,7 +1747,7 @@ Return a list whose CAR is `clock' and CDR is a plist containing (duration (and (search-forward " => " (line-end-position) t) (progn (skip-chars-forward " \t") (looking-at "\\(\\S-+\\)[ \t]*$")) - (org-match-string-no-properties 1))) + (match-string-no-properties 1))) (status (if duration 'closed 'running)) (post-blank (let ((before-blank (progn (forward-line) (point)))) (skip-chars-forward " \r\t\n" limit) @@ -1713,9 +1764,8 @@ Return a list whose CAR is `clock' and CDR is a plist containing :post-blank post-blank :post-affiliated begin))))) -(defun org-element-clock-interpreter (clock contents) - "Interpret CLOCK element as Org syntax. -CONTENTS is nil." +(defun org-element-clock-interpreter (clock _) + "Interpret CLOCK element as Org syntax." (concat org-clock-string " " (org-element-timestamp-interpreter (org-element-property :value clock) nil) @@ -1774,7 +1824,7 @@ Assume point is at comment beginning." :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-comment-interpreter (comment contents) +(defun org-element-comment-interpreter (comment _) "Interpret COMMENT element as Org syntax. CONTENTS is nil." (replace-regexp-in-string "^" "# " (org-element-property :value comment))) @@ -1821,9 +1871,8 @@ Assume point is at comment block beginning." :post-affiliated post-affiliated) (cdr affiliated))))))))) -(defun org-element-comment-block-interpreter (comment-block contents) - "Interpret COMMENT-BLOCK element as Org syntax. -CONTENTS is nil." +(defun org-element-comment-block-interpreter (comment-block _) + "Interpret COMMENT-BLOCK element as Org syntax." (format "#+BEGIN_COMMENT\n%s#+END_COMMENT" (org-element-normalize-string (org-remove-indentation @@ -1847,7 +1896,7 @@ containing `:begin', `:end', `:value', `:post-blank' and (let ((begin (car affiliated)) (post-affiliated (point)) (value (progn (looking-at "\\(%%(.*\\)[ \t]*$") - (org-match-string-no-properties 1))) + (match-string-no-properties 1))) (pos-before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) @@ -1860,9 +1909,8 @@ containing `:begin', `:end', `:value', `:post-blank' and :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-diary-sexp-interpreter (diary-sexp contents) - "Interpret DIARY-SEXP as Org syntax. -CONTENTS is nil." +(defun org-element-diary-sexp-interpreter (diary-sexp _) + "Interpret DIARY-SEXP as Org syntax." (org-element-property :value diary-sexp)) @@ -1890,12 +1938,20 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', (let* ((switches (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") - (org-match-string-no-properties 1))) - ;; Switches analysis + (match-string-no-properties 1))) + ;; Switches analysis. (number-lines - (cond ((not switches) nil) - ((string-match "-n\\>" switches) 'new) - ((string-match "+n\\>" switches) 'continued))) + (and switches + (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" + switches) + (cons + (if (equal (match-string 1 switches) "-") + 'new + 'continued) + (if (not (match-end 2)) 0 + ;; Subtract 1 to give number of lines before + ;; first line. + (1- (string-to-number (match-string 2 switches))))))) (preserve-indent (and switches (string-match "-i\\>" switches))) ;; Should labels be retained in (or stripped from) example @@ -1917,13 +1973,10 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', ;; Standard block parsing. (begin (car affiliated)) (post-affiliated (point)) - (block-ind (progn (skip-chars-forward " \t") (current-column))) - (contents-begin (progn (forward-line) (point))) - (value (org-element-remove-indentation - (org-unescape-code-in-string - (buffer-substring-no-properties - contents-begin contents-end)) - block-ind)) + (contents-begin (line-beginning-position 2)) + (value (org-unescape-code-in-string + (buffer-substring-no-properties + contents-begin contents-end))) (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) @@ -1944,9 +1997,8 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', :post-affiliated post-affiliated) (cdr affiliated))))))))) -(defun org-element-example-block-interpreter (example-block contents) - "Interpret EXAMPLE-BLOCK element as Org syntax. -CONTENTS is nil." +(defun org-element-example-block-interpreter (example-block _) + "Interpret EXAMPLE-BLOCK element as Org syntax." (let ((switches (org-element-property :switches example-block)) (value (org-element-property :value example-block))) (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n" @@ -1955,7 +2007,7 @@ CONTENTS is nil." (if (or org-src-preserve-indentation (org-element-property :preserve-indent example-block)) value - (org-element-remove-indentation value)))) + (org-remove-indentation value)))) "#+END_EXAMPLE"))) @@ -1974,43 +2026,44 @@ containing `:begin', `:end', `:type', `:value', `:post-blank' and `:post-affiliated' keywords. Assume point is at export-block beginning." - (let* ((case-fold-search t) - (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") - (upcase (org-match-string-no-properties 1))))) + (let* ((case-fold-search t)) (if (not (save-excursion - (re-search-forward - (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t))) + (re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - (contents-begin (progn (forward-line) (point))) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position)))) - (value (buffer-substring-no-properties contents-begin - contents-end))) - (list 'export-block - (nconc - (list :begin begin - :end end - :type type - :value value - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (save-excursion + (let* ((contents-end (match-beginning 0)) + (backend + (progn + (looking-at + "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$") + (match-string-no-properties 1))) + (begin (car affiliated)) + (post-affiliated (point)) + (contents-begin (progn (forward-line) (point))) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position)))) + (value (org-unescape-code-in-string + (buffer-substring-no-properties contents-begin + contents-end)))) + (list 'export-block + (nconc + (list :type (and backend (upcase backend)) + :begin begin + :end end + :value value + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) -(defun org-element-export-block-interpreter (export-block contents) - "Interpret EXPORT-BLOCK element as Org syntax. -CONTENTS is nil." - (let ((type (org-element-property :type export-block))) - (concat (format "#+BEGIN_%s\n" type) - (org-element-property :value export-block) - (format "#+END_%s" type)))) +(defun org-element-export-block-interpreter (export-block _) + "Interpret EXPORT-BLOCK element as Org syntax." + (format "#+BEGIN_EXPORT %s\n%s#+END_EXPORT" + (org-element-property :type export-block) + (org-element-property :value export-block))) ;;;; Fixed-width @@ -2055,9 +2108,8 @@ Assume point is at the beginning of the fixed-width area." :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-fixed-width-interpreter (fixed-width contents) - "Interpret FIXED-WIDTH element as Org syntax. -CONTENTS is nil." +(defun org-element-fixed-width-interpreter (fixed-width _) + "Interpret FIXED-WIDTH element as Org syntax." (let ((value (org-element-property :value fixed-width))) (and value (replace-regexp-in-string @@ -2092,9 +2144,8 @@ keywords." :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-horizontal-rule-interpreter (horizontal-rule contents) - "Interpret HORIZONTAL-RULE element as Org syntax. -CONTENTS is nil." +(defun org-element-horizontal-rule-interpreter (&rest _) + "Interpret HORIZONTAL-RULE element as Org syntax." "-----") @@ -2118,7 +2169,7 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and (let ((begin (or (car affiliated) (point))) (post-affiliated (point)) (key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):") - (upcase (org-match-string-no-properties 1)))) + (upcase (match-string-no-properties 1)))) (value (org-trim (buffer-substring-no-properties (match-end 0) (point-at-eol)))) (pos-before-blank (progn (forward-line) (point))) @@ -2134,9 +2185,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-keyword-interpreter (keyword contents) - "Interpret KEYWORD element as Org syntax. -CONTENTS is nil." +(defun org-element-keyword-interpreter (keyword _) + "Interpret KEYWORD element as Org syntax." (format "#+%s: %s" (org-element-property :key keyword) (org-element-property :value keyword))) @@ -2192,9 +2242,8 @@ Assume point is at the beginning of the latex environment." :post-affiliated code-begin) (cdr affiliated)))))))) -(defun org-element-latex-environment-interpreter (latex-environment contents) - "Interpret LATEX-ENVIRONMENT element as Org syntax. -CONTENTS is nil." +(defun org-element-latex-environment-interpreter (latex-environment _) + "Interpret LATEX-ENVIRONMENT element as Org syntax." (org-element-property :value latex-environment)) @@ -2211,8 +2260,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and (looking-at org-property-re) (let ((case-fold-search t) (begin (point)) - (key (org-match-string-no-properties 2)) - (value (org-match-string-no-properties 3)) + (key (match-string-no-properties 2)) + (value (match-string-no-properties 3)) (end (save-excursion (end-of-line) (if (re-search-forward org-property-re limit t) @@ -2226,9 +2275,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and :post-blank 0 :post-affiliated begin)))) -(defun org-element-node-property-interpreter (node-property contents) - "Interpret NODE-PROPERTY element as Org syntax. -CONTENTS is nil." +(defun org-element-node-property-interpreter (node-property _) + "Interpret NODE-PROPERTY element as Org syntax." (format org-property-format (format ":%s:" (org-element-property :key node-property)) (or (org-element-property :value node-property) ""))) @@ -2303,8 +2351,8 @@ Assume point is at the beginning of the paragraph." :post-affiliated contents-begin) (cdr affiliated)))))) -(defun org-element-paragraph-interpreter (paragraph contents) - "Interpret PARAGRAPH element as Org syntax. +(defun org-element-paragraph-interpreter (_ contents) + "Interpret paragraph element as Org syntax. CONTENTS is the contents of the element." contents) @@ -2347,11 +2395,10 @@ containing `:closed', `:deadline', `:scheduled', `:begin', :post-blank post-blank :post-affiliated begin))))) -(defun org-element-planning-interpreter (planning contents) - "Interpret PLANNING element as Org syntax. -CONTENTS is nil." +(defun org-element-planning-interpreter (planning _) + "Interpret PLANNING element as Org syntax." (mapconcat - 'identity + #'identity (delq nil (list (let ((deadline (org-element-property :deadline planning))) (when deadline @@ -2398,20 +2445,28 @@ Assume point is at the beginning of the block." (language (progn (looking-at - (concat "^[ \t]*#\\+BEGIN_SRC" - "\\(?: +\\(\\S-+\\)\\)?" - "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?" - "\\(.*\\)[ \t]*$")) - (org-match-string-no-properties 1))) + "^[ \t]*#\\+BEGIN_SRC\ +\\(?: +\\(\\S-+\\)\\)?\ +\\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\ +\\(.*\\)[ \t]*$") + (match-string-no-properties 1))) ;; Get switches. - (switches (org-match-string-no-properties 2)) + (switches (match-string-no-properties 2)) ;; Get parameters. - (parameters (org-match-string-no-properties 3)) - ;; Switches analysis + (parameters (match-string-no-properties 3)) + ;; Switches analysis. (number-lines - (cond ((not switches) nil) - ((string-match "-n\\>" switches) 'new) - ((string-match "+n\\>" switches) 'continued))) + (and switches + (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" + switches) + (cons + (if (equal (match-string 1 switches) "-") + 'new + 'continued) + (if (not (match-end 2)) 0 + ;; Subtract 1 to give number of lines before + ;; first line. + (1- (string-to-number (match-string 2 switches))))))) (preserve-indent (and switches (string-match "-i\\>" switches))) (label-fmt @@ -2430,14 +2485,10 @@ Assume point is at the beginning of the block." (or (not switches) (and retain-labels (not (string-match "-k\\>" switches))))) - ;; Indentation. - (block-ind (progn (skip-chars-forward " \t") (current-column))) ;; Retrieve code. - (value (org-element-remove-indentation - (org-unescape-code-in-string - (buffer-substring-no-properties - (progn (forward-line) (point)) contents-end)) - block-ind)) + (value (org-unescape-code-in-string + (buffer-substring-no-properties + (line-beginning-position 2) contents-end))) (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) @@ -2463,9 +2514,8 @@ Assume point is at the beginning of the block." :post-affiliated post-affiliated) (cdr affiliated))))))))) -(defun org-element-src-block-interpreter (src-block contents) - "Interpret SRC-BLOCK element as Org syntax. -CONTENTS is nil." +(defun org-element-src-block-interpreter (src-block _) + "Interpret SRC-BLOCK element as Org syntax." (let ((lang (org-element-property :language src-block)) (switches (org-element-property :switches src-block)) (params (org-element-property :parameters src-block)) @@ -2475,11 +2525,12 @@ CONTENTS is nil." ((or org-src-preserve-indentation (org-element-property :preserve-indent src-block)) val) - ((zerop org-edit-src-content-indentation) val) + ((zerop org-edit-src-content-indentation) + (org-remove-indentation val)) (t (let ((ind (make-string org-edit-src-content-indentation ?\s))) (replace-regexp-in-string - "\\(^\\)[ \t]*\\S-" ind val nil nil 1))))))) + "^" ind (org-remove-indentation val)))))))) (concat (format "#+BEGIN_SRC%s\n" (concat (and lang (concat " " lang)) (and switches (concat " " switches)) @@ -2517,7 +2568,7 @@ Assume point is at the beginning of the table." (point))) (tblfm (let (acc) (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") - (push (org-match-string-no-properties 1) acc) + (push (match-string-no-properties 1) acc) (forward-line)) acc)) (pos-before-blank (point)) @@ -2556,11 +2607,9 @@ CONTENTS is a string, if table's type is `org', or nil." ;;;; Table Row -(defun org-element-table-row-parser (limit) +(defun org-element-table-row-parser (_) "Parse table row at point. -LIMIT bounds the search. - Return a list whose CAR is `table-row' and CDR is a plist containing `:begin', `:end', `:contents-begin', `:contents-end', `:type', `:post-blank' and `:post-affiliated' keywords." @@ -2569,9 +2618,7 @@ containing `:begin', `:end', `:contents-begin', `:contents-end', (begin (point)) ;; A table rule has no contents. In that case, ensure ;; CONTENTS-BEGIN matches CONTENTS-END. - (contents-begin (and (eq type 'standard) - (search-forward "|") - (point))) + (contents-begin (and (eq type 'standard) (search-forward "|"))) (contents-end (and (eq type 'standard) (progn (end-of-line) @@ -2591,7 +2638,7 @@ containing `:begin', `:end', `:contents-begin', `:contents-end', "Interpret TABLE-ROW element as Org syntax. CONTENTS is the contents of the table row." (if (eq (org-element-property :type table-row) 'rule) "|-" - (concat "| " contents))) + (concat "|" contents))) ;;;; Verse Block @@ -2634,8 +2681,8 @@ Assume point is at beginning of the block." :post-affiliated post-affiliated) (cdr affiliated))))))))) -(defun org-element-verse-block-interpreter (verse-block contents) - "Interpret VERSE-BLOCK element as Org syntax. +(defun org-element-verse-block-interpreter (_ contents) + "Interpret verse-block element as Org syntax. CONTENTS is verse block contents." (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents)) @@ -2683,8 +2730,8 @@ Assume point is at the first star marker." :contents-end contents-end :post-blank post-blank)))))) -(defun org-element-bold-interpreter (bold contents) - "Interpret BOLD object as Org syntax. +(defun org-element-bold-interpreter (_ contents) + "Interpret bold object as Org syntax. CONTENTS is the contents of the object." (format "*%s*" contents)) @@ -2703,7 +2750,7 @@ Assume point is at the first tilde marker." (unless (bolp) (backward-char 1)) (when (looking-at org-emph-re) (let ((begin (match-beginning 2)) - (value (org-match-string-no-properties 4)) + (value (match-string-no-properties 4)) (post-blank (progn (goto-char (match-end 2)) (skip-chars-forward " \t"))) (end (point))) @@ -2713,9 +2760,8 @@ Assume point is at the first tilde marker." :end end :post-blank post-blank)))))) -(defun org-element-code-interpreter (code contents) - "Interpret CODE object as Org syntax. -CONTENTS is nil." +(defun org-element-code-interpreter (code _) + "Interpret CODE object as Org syntax." (format "~%s~" (org-element-property :value code))) @@ -2754,9 +2800,8 @@ Assume point is at the beginning of the entity." :use-brackets-p bracketsp :post-blank post-blank))))))) -(defun org-element-entity-interpreter (entity contents) - "Interpret ENTITY object as Org syntax. -CONTENTS is nil." +(defun org-element-entity-interpreter (entity _) + "Interpret ENTITY object as Org syntax." (concat "\\" (org-element-property :name entity) (when (org-element-property :use-brackets-p entity) "{}"))) @@ -2781,7 +2826,7 @@ Assume point is at the beginning of the snippet." (re-search-forward "@@" nil t) (match-beginning 0)))) (let* ((begin (match-beginning 0)) - (back-end (org-match-string-no-properties 1)) + (back-end (match-string-no-properties 1)) (value (buffer-substring-no-properties (match-end 0) contents-end)) (post-blank (skip-chars-forward " \t")) @@ -2793,9 +2838,8 @@ Assume point is at the beginning of the snippet." :end end :post-blank post-blank))))))) -(defun org-element-export-snippet-interpreter (export-snippet contents) - "Interpret EXPORT-SNIPPET object as Org syntax. -CONTENTS is nil." +(defun org-element-export-snippet-interpreter (export-snippet _) + "Interpret EXPORT-SNIPPET object as Org syntax." (format "@@%s:%s@@" (org-element-property :back-end export-snippet) (org-element-property :value export-snippet))) @@ -2816,14 +2860,10 @@ When at a footnote reference, return a list whose car is (when closing (save-excursion (let* ((begin (point)) - (label - (or (org-match-string-no-properties 2) - (org-match-string-no-properties 3) - (and (match-string 1) - (concat "fn:" (org-match-string-no-properties 1))))) - (type (if (or (not label) (match-string 1)) 'inline 'standard)) + (label (match-string-no-properties 1)) (inner-begin (match-end 0)) (inner-end (1- closing)) + (type (if (match-end 2) 'inline 'standard)) (post-blank (progn (goto-char closing) (skip-chars-forward " \t"))) (end (point))) @@ -2839,9 +2879,9 @@ When at a footnote reference, return a list whose car is (defun org-element-footnote-reference-interpreter (footnote-reference contents) "Interpret FOOTNOTE-REFERENCE object as Org syntax. CONTENTS is its definition, when inline, or nil." - (format "[%s]" - (concat (or (org-element-property :label footnote-reference) "fn:") - (and contents (concat ":" contents))))) + (format "[fn:%s%s]" + (or (org-element-property :label footnote-reference) "") + (if contents (concat ":" contents) ""))) ;;;; Inline Babel Call @@ -2856,31 +2896,39 @@ When at an inline babel call, return a list whose car is Assume point is at the beginning of the babel call." (save-excursion - (unless (bolp) (backward-char)) - (when (let ((case-fold-search t)) - (looking-at org-babel-inline-lob-one-liner-regexp)) - (let ((begin (match-end 1)) - (call (org-match-string-no-properties 2)) - (inside-header (org-string-nw-p (org-match-string-no-properties 4))) - (arguments (org-string-nw-p (org-match-string-no-properties 6))) - (end-header (org-string-nw-p (org-match-string-no-properties 8))) - (value (buffer-substring-no-properties (match-end 1) (match-end 0))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'inline-babel-call - (list :call call - :inside-header inside-header - :arguments arguments - :end-header end-header - :begin begin - :end end - :value value - :post-blank post-blank)))))) + (catch :no-object + (when (let ((case-fold-search nil)) + (looking-at "\\<call_\\([^ \t\n[(]+\\)[([]")) + (goto-char (match-end 1)) + (let* ((begin (match-beginning 0)) + (call (match-string-no-properties 1)) + (inside-header + (let ((p (org-element--parse-paired-brackets ?\[))) + (and (org-string-nw-p p) + (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) + (arguments (org-string-nw-p + (or (org-element--parse-paired-brackets ?\() + ;; Parenthesis are mandatory. + (throw :no-object nil)))) + (end-header + (let ((p (org-element--parse-paired-brackets ?\[))) + (and (org-string-nw-p p) + (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) + (value (buffer-substring-no-properties begin (point))) + (post-blank (skip-chars-forward " \t")) + (end (point))) + (list 'inline-babel-call + (list :call call + :inside-header inside-header + :arguments arguments + :end-header end-header + :begin begin + :end end + :value value + :post-blank post-blank))))))) -(defun org-element-inline-babel-call-interpreter (inline-babel-call contents) - "Interpret INLINE-BABEL-CALL object as Org syntax. -CONTENTS is nil." +(defun org-element-inline-babel-call-interpreter (inline-babel-call _) + "Interpret INLINE-BABEL-CALL object as Org syntax." (concat "call_" (org-element-property :call inline-babel-call) (let ((h (org-element-property :inside-header inline-babel-call))) @@ -2902,26 +2950,29 @@ keywords. Otherwise, return nil. Assume point is at the beginning of the inline src block." (save-excursion - (unless (bolp) (backward-char)) - (when (looking-at org-babel-inline-src-block-regexp) - (let ((begin (match-beginning 1)) - (language (org-match-string-no-properties 2)) - (parameters (org-match-string-no-properties 4)) - (value (org-match-string-no-properties 5)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'inline-src-block - (list :language language - :value value - :parameters parameters - :begin begin - :end end - :post-blank post-blank)))))) + (catch :no-object + (when (let ((case-fold-search nil)) + (looking-at "\\<src_\\([^ \t\n[{]+\\)[{[]")) + (goto-char (match-end 1)) + (let ((begin (match-beginning 0)) + (language (match-string-no-properties 1)) + (parameters + (let ((p (org-element--parse-paired-brackets ?\[))) + (and (org-string-nw-p p) + (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) + (value (or (org-element--parse-paired-brackets ?\{) + (throw :no-object nil))) + (post-blank (skip-chars-forward " \t"))) + (list 'inline-src-block + (list :language language + :value value + :parameters parameters + :begin begin + :end (point) + :post-blank post-blank))))))) -(defun org-element-inline-src-block-interpreter (inline-src-block contents) - "Interpret INLINE-SRC-BLOCK object as Org syntax. -CONTENTS is nil." +(defun org-element-inline-src-block-interpreter (inline-src-block _) + "Interpret INLINE-SRC-BLOCK object as Org syntax." (let ((language (org-element-property :language inline-src-block)) (arguments (org-element-property :parameters inline-src-block)) (body (org-element-property :value inline-src-block))) @@ -2957,8 +3008,8 @@ Assume point is at the first slash marker." :contents-end contents-end :post-blank post-blank)))))) -(defun org-element-italic-interpreter (italic contents) - "Interpret ITALIC object as Org syntax. +(defun org-element-italic-interpreter (_ contents) + "Interpret italic object as Org syntax. CONTENTS is the contents of the object." (format "/%s/" contents)) @@ -2986,12 +3037,13 @@ Assume point is at the beginning of the LaTeX fragment." '(?\s ?\t ?\n ?, ?.))) (looking-at "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|$\\)") (point))) - (case (char-after (1+ (point))) + (pcase (char-after (1+ (point))) (?\( (search-forward "\\)" nil t)) (?\[ (search-forward "\\]" nil t)) - (otherwise + (_ ;; Macro. - (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*") + (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\ +\\|\\({[^{}\n]*}\\)\\)*") (match-end 0)))))) (post-blank (if (not after-fragment) (throw 'no-object nil) (goto-char after-fragment) @@ -3003,9 +3055,8 @@ Assume point is at the beginning of the LaTeX fragment." :end end :post-blank post-blank)))))) -(defun org-element-latex-fragment-interpreter (latex-fragment contents) - "Interpret LATEX-FRAGMENT object as Org syntax. -CONTENTS is nil." +(defun org-element-latex-fragment-interpreter (latex-fragment _) + "Interpret LATEX-FRAGMENT object as Org syntax." (org-element-property :value latex-fragment)) ;;;; Line Break @@ -3018,16 +3069,15 @@ and cdr a plist with `:begin', `:end' and `:post-blank' keywords. Otherwise, return nil. Assume point is at the beginning of the line break." - (when (and (org-looking-at-p "\\\\\\\\[ \t]*$") + (when (and (looking-at-p "\\\\\\\\[ \t]*$") (not (eq (char-before) ?\\))) (list 'line-break (list :begin (point) :end (line-beginning-position 2) :post-blank 0)))) -(defun org-element-line-break-interpreter (line-break contents) - "Interpret LINE-BREAK object as Org syntax. -CONTENTS is nil." +(defun org-element-line-break-interpreter (&rest _) + "Interpret LINE-BREAK object as Org syntax." "\\\\\n") @@ -3037,7 +3087,7 @@ CONTENTS is nil." "Parse link at point, if any. When at a link, return a list whose car is `link' and cdr a plist -with `:type', `:path', `:raw-link', `:application', +with `:type', `:path', `:format', `:raw-link', `:application', `:search-option', `:begin', `:end', `:contents-begin', `:contents-end' and `:post-blank' as keywords. Otherwise, return nil. @@ -3045,20 +3095,22 @@ nil. Assume point is at the beginning of the link." (catch 'no-object (let ((begin (point)) - end contents-begin contents-end link-end post-blank path type - raw-link link search-option application) + end contents-begin contents-end link-end post-blank path type format + raw-link search-option application) (cond ;; Type 1: Text targeted from a radio target. ((and org-target-link-regexp (save-excursion (or (bolp) (backward-char)) (looking-at org-target-link-regexp))) - (setq type "radio" - link-end (match-end 1) - path (org-match-string-no-properties 1) - contents-begin (match-beginning 1) - contents-end (match-end 1))) + (setq type "radio") + (setq format 'plain) + (setq link-end (match-end 1)) + (setq path (match-string-no-properties 1)) + (setq contents-begin (match-beginning 1)) + (setq contents-end (match-end 1))) ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]] ((looking-at org-bracket-link-regexp) + (setq format 'bracket) (setq contents-begin (match-beginning 3)) (setq contents-end (match-end 3)) (setq link-end (match-end 0)) @@ -3076,7 +3128,7 @@ Assume point is at the beginning of the link." (setq raw-link (org-link-expand-abbrev (replace-regexp-in-string "[ \t]*\n[ \t]*" " " - (org-match-string-no-properties 1)))) + (match-string-no-properties 1)))) ;; Determine TYPE of link and set PATH accordingly. According ;; to RFC 3986, remove whitespaces from URI in external links. ;; In internal ones, treat indentation as a single space. @@ -3086,16 +3138,13 @@ Assume point is at the beginning of the link." (string-match "\\`\\.\\.?/" raw-link)) (setq type "file") (setq path raw-link)) - ;; Explicit type (http, irc, bbdb...). See `org-link-types'. + ;; Explicit type (http, irc, bbdb...). ((string-match org-link-types-re raw-link) (setq type (match-string 1 raw-link)) (setq path (substring raw-link (match-end 0)))) - ;; Id type: PATH is the id. - ((string-match "\\`id:\\([-a-f0-9]+\\)\\'" raw-link) - (setq type "id" path (match-string 1 raw-link))) ;; Code-ref type: PATH is the name of the reference. - ((and (org-string-match-p "\\`(" raw-link) - (org-string-match-p ")\\'" raw-link)) + ((and (string-match-p "\\`(" raw-link) + (string-match-p ")\\'" raw-link)) (setq type "coderef") (setq path (substring raw-link 1 -1))) ;; Custom-id type: PATH is the name of the custom id. @@ -3110,21 +3159,23 @@ Assume point is at the beginning of the link." (setq path raw-link)))) ;; Type 3: Plain link, e.g., http://orgmode.org ((looking-at org-plain-link-re) - (setq raw-link (org-match-string-no-properties 0) - type (org-match-string-no-properties 1) - link-end (match-end 0) - path (org-match-string-no-properties 2))) + (setq format 'plain) + (setq raw-link (match-string-no-properties 0)) + (setq type (match-string-no-properties 1)) + (setq link-end (match-end 0)) + (setq path (match-string-no-properties 2))) ;; Type 4: Angular link, e.g., <http://orgmode.org>. Unlike to ;; bracket links, follow RFC 3986 and remove any extra ;; whitespace in URI. ((looking-at org-angle-link-re) - (setq type (org-match-string-no-properties 1)) + (setq format 'angle) + (setq type (match-string-no-properties 1)) (setq link-end (match-end 0)) (setq raw-link (buffer-substring-no-properties (match-beginning 1) (match-end 2))) (setq path (replace-regexp-in-string - "[ \t]*\n[ \t]*" "" (org-match-string-no-properties 2)))) + "[ \t]*\n[ \t]*" "" (match-string-no-properties 2)))) (t (throw 'no-object nil))) ;; In any case, deduce end point after trailing white space from ;; LINK-END variable. @@ -3149,6 +3200,7 @@ Assume point is at the beginning of the link." (list 'link (list :type type :path path + :format format :raw-link (or raw-link path) :application application :search-option search-option @@ -3164,18 +3216,38 @@ CONTENTS is the contents of the object, or nil." (let ((type (org-element-property :type link)) (path (org-element-property :path link))) (if (string= type "radio") path - (format "[[%s]%s]" - (cond ((string= type "coderef") (format "(%s)" path)) - ((string= type "custom-id") (concat "#" path)) - ((string= type "file") - (let ((app (org-element-property :application link)) - (opt (org-element-property :search-option link))) - (concat type (and app (concat "+" app)) ":" - path - (and opt (concat "::" opt))))) - ((string= type "fuzzy") path) - (t (concat type ":" path))) - (if contents (format "[%s]" contents) ""))))) + (let ((fmt (pcase (org-element-property :format link) + ;; Links with contents and internal links have to + ;; use bracket syntax. Ignore `:format' in these + ;; cases. This is also the default syntax when the + ;; property is not defined, e.g., when the object + ;; was crafted by the user. + ((guard contents) + (format "[[%%s][%s]]" + ;; Since this is going to be used as + ;; a format string, escape percent signs + ;; in description. + (replace-regexp-in-string "%" "%%" contents))) + ((or `bracket + `nil + (guard (member type '("coderef" "custom-id" "fuzzy")))) + "[[%s]]") + ;; Otherwise, just obey to `:format'. + (`angle "<%s>") + (`plain "%s") + (f (error "Wrong `:format' value: %s" f))))) + (format fmt + (pcase type + ("coderef" (format "(%s)" path)) + ("custom-id" (concat "#" path)) + ("file" + (let ((app (org-element-property :application link)) + (opt (org-element-property :search-option link))) + (concat type (and app (concat "+" app)) ":" + path + (and opt (concat "::" opt))))) + ("fuzzy" path) + (_ (concat type ":" path)))))))) ;;;; Macro @@ -3191,12 +3263,12 @@ Assume point is at the macro." (save-excursion (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}") (let ((begin (point)) - (key (downcase (org-match-string-no-properties 1))) - (value (org-match-string-no-properties 0)) + (key (downcase (match-string-no-properties 1))) + (value (match-string-no-properties 0)) (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point)) - (args (let ((args (org-match-string-no-properties 3))) + (args (let ((args (match-string-no-properties 3))) (and args (org-macro-extract-arguments args))))) (list 'macro (list :key key @@ -3206,9 +3278,8 @@ Assume point is at the macro." :end end :post-blank post-blank)))))) -(defun org-element-macro-interpreter (macro contents) - "Interpret MACRO object as Org syntax. -CONTENTS is nil." +(defun org-element-macro-interpreter (macro _) + "Interpret MACRO object as Org syntax." (org-element-property :value macro)) @@ -3228,7 +3299,7 @@ Assume point is at the radio target." (let ((begin (point)) (contents-begin (match-beginning 1)) (contents-end (match-end 1)) - (value (org-match-string-no-properties 1)) + (value (match-string-no-properties 1)) (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point))) @@ -3240,8 +3311,8 @@ Assume point is at the radio target." :post-blank post-blank :value value)))))) -(defun org-element-radio-target-interpreter (target contents) - "Interpret TARGET object as Org syntax. +(defun org-element-radio-target-interpreter (_ contents) + "Interpret target object as Org syntax. CONTENTS is the contents of the object." (concat "<<<" contents ">>>")) @@ -3270,9 +3341,8 @@ Assume point is at the beginning of the statistics-cookie." :value value :post-blank post-blank)))))) -(defun org-element-statistics-cookie-interpreter (statistics-cookie contents) - "Interpret STATISTICS-COOKIE object as Org syntax. -CONTENTS is nil." +(defun org-element-statistics-cookie-interpreter (statistics-cookie _) + "Interpret STATISTICS-COOKIE object as Org syntax." (org-element-property :value statistics-cookie)) @@ -3303,8 +3373,8 @@ Assume point is at the first plus sign marker." :contents-end contents-end :post-blank post-blank)))))) -(defun org-element-strike-through-interpreter (strike-through contents) - "Interpret STRIKE-THROUGH object as Org syntax. +(defun org-element-strike-through-interpreter (_ contents) + "Interpret strike-through object as Org syntax. CONTENTS is the contents of the object." (format "+%s+" contents)) @@ -3404,8 +3474,8 @@ and `:post-blank' keywords." :contents-end contents-end :post-blank 0)))) -(defun org-element-table-cell-interpreter (table-cell contents) - "Interpret TABLE-CELL element as Org syntax. +(defun org-element-table-cell-interpreter (_ contents) + "Interpret table-cell element as Org syntax. CONTENTS is the contents of the cell, or nil." (concat " " contents " |")) @@ -3423,7 +3493,7 @@ Assume point is at the target." (save-excursion (when (looking-at org-target-regexp) (let ((begin (point)) - (value (org-match-string-no-properties 1)) + (value (match-string-no-properties 1)) (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point))) @@ -3433,9 +3503,8 @@ Assume point is at the target." :value value :post-blank post-blank)))))) -(defun org-element-target-interpreter (target contents) - "Interpret TARGET object as Org syntax. -CONTENTS is nil." +(defun org-element-target-interpreter (target _) + "Interpret TARGET object as Org syntax." (format "<<%s>>" (org-element-property :value target))) @@ -3462,7 +3531,7 @@ cdr a plist with `:type', `:raw-value', `:year-start', Otherwise, return nil. Assume point is at the beginning of the timestamp." - (when (org-looking-at-p org-element--timestamp-regexp) + (when (looking-at-p org-element--timestamp-regexp) (save-excursion (let* ((begin (point)) (activep (eq (char-after) ?<)) @@ -3500,8 +3569,8 @@ Assume point is at the beginning of the timestamp." (t 'cumulate))) :repeater-value (string-to-number (match-string 2 raw-value)) :repeater-unit - (case (string-to-char (match-string 3 raw-value)) - (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year))))) + (pcase (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) (warning-props (and (not diaryp) (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) @@ -3509,8 +3578,8 @@ Assume point is at the beginning of the timestamp." :warning-type (if (match-string 1 raw-value) 'first 'all) :warning-value (string-to-number (match-string 2 raw-value)) :warning-unit - (case (string-to-char (match-string 3 raw-value)) - (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year))))) + (pcase (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) year-start month-start day-start hour-start minute-start year-end month-end day-end hour-end minute-end) ;; Parse date-start. @@ -3550,26 +3619,24 @@ Assume point is at the beginning of the timestamp." repeater-props warning-props)))))) -(defun org-element-timestamp-interpreter (timestamp contents) - "Interpret TIMESTAMP object as Org syntax. -CONTENTS is nil." +(defun org-element-timestamp-interpreter (timestamp _) + "Interpret TIMESTAMP object as Org syntax." (let* ((repeat-string (concat - (case (org-element-property :repeater-type timestamp) - (cumulate "+") (catch-up "++") (restart ".+")) + (pcase (org-element-property :repeater-type timestamp) + (`cumulate "+") (`catch-up "++") (`restart ".+")) (let ((val (org-element-property :repeater-value timestamp))) (and val (number-to-string val))) - (case (org-element-property :repeater-unit timestamp) - (hour "h") (day "d") (week "w") (month "m") (year "y")))) + (pcase (org-element-property :repeater-unit timestamp) + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) (warning-string (concat - (case (org-element-property :warning-type timestamp) - (first "--") - (all "-")) + (pcase (org-element-property :warning-type timestamp) + (`first "--") (`all "-")) (let ((val (org-element-property :warning-value timestamp))) (and val (number-to-string val))) - (case (org-element-property :warning-unit timestamp) - (hour "h") (day "d") (week "w") (month "m") (year "y")))) + (pcase (org-element-property :warning-unit timestamp) + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) (build-ts-string ;; Build an Org timestamp string from TIME. ACTIVEP is ;; non-nil when time stamp is active. If WITH-TIME-P is @@ -3578,7 +3645,7 @@ CONTENTS is nil." ;; the repeater string, if any. (lambda (time activep &optional with-time-p hour-end minute-end) (let ((ts (format-time-string - (funcall (if with-time-p 'cdr 'car) + (funcall (if with-time-p #'cdr #'car) org-time-stamp-formats) time))) (when (and hour-end minute-end) @@ -3597,8 +3664,8 @@ CONTENTS is nil." ;; Return value. ts))) (type (org-element-property :type timestamp))) - (case type - ((active inactive) + (pcase type + ((or `active `inactive) (let* ((minute-start (org-element-property :minute-start timestamp)) (minute-end (org-element-property :minute-end timestamp)) (hour-start (org-element-property :hour-start timestamp)) @@ -3618,7 +3685,7 @@ CONTENTS is nil." (and hour-start minute-start) (and time-range-p hour-end) (and time-range-p minute-end)))) - ((active-range inactive-range) + ((or `active-range `inactive-range) (let ((minute-start (org-element-property :minute-start timestamp)) (minute-end (org-element-property :minute-end timestamp)) (hour-start (org-element-property :hour-start timestamp)) @@ -3644,7 +3711,7 @@ CONTENTS is nil." (org-element-property :year-end timestamp)) (eq type 'active-range) (and hour-end minute-end))))) - (otherwise (org-element-property :raw-value timestamp))))) + (_ (org-element-property :raw-value timestamp))))) ;;;; Underline @@ -3674,8 +3741,8 @@ Assume point is at the first underscore marker." :contents-end contents-end :post-blank post-blank)))))) -(defun org-element-underline-interpreter (underline contents) - "Interpret UNDERLINE object as Org syntax. +(defun org-element-underline-interpreter (_ contents) + "Interpret underline object as Org syntax. CONTENTS is the contents of the object." (format "_%s_" contents)) @@ -3694,7 +3761,7 @@ Assume point is at the first equal sign marker." (unless (bolp) (backward-char 1)) (when (looking-at org-emph-re) (let ((begin (match-beginning 2)) - (value (org-match-string-no-properties 4)) + (value (match-string-no-properties 4)) (post-blank (progn (goto-char (match-end 2)) (skip-chars-forward " \t"))) (end (point))) @@ -3704,9 +3771,8 @@ Assume point is at the first equal sign marker." :end end :post-blank post-blank)))))) -(defun org-element-verbatim-interpreter (verbatim contents) - "Interpret VERBATIM object as Org syntax. -CONTENTS is nil." +(defun org-element-verbatim-interpreter (verbatim _) + "Interpret VERBATIM object as Org syntax." (format "=%s=" (org-element-property :value verbatim))) @@ -3808,27 +3874,35 @@ element it has to parse." ;; Keywords. ((looking-at "[ \t]*#") (goto-char (match-end 0)) - (cond ((looking-at "\\(?: \\|$\\)") - (beginning-of-line) - (org-element-comment-parser limit affiliated)) - ((looking-at "\\+BEGIN_\\(\\S-+\\)") - (beginning-of-line) - (let ((parser (assoc (upcase (match-string 1)) - org-element-block-name-alist))) - (if parser (funcall (cdr parser) limit affiliated) - (org-element-special-block-parser limit affiliated)))) - ((looking-at "\\+CALL:") - (beginning-of-line) - (org-element-babel-call-parser limit affiliated)) - ((looking-at "\\+BEGIN:? ") - (beginning-of-line) - (org-element-dynamic-block-parser limit affiliated)) - ((looking-at "\\+\\S-+:") - (beginning-of-line) - (org-element-keyword-parser limit affiliated)) - (t - (beginning-of-line) - (org-element-paragraph-parser limit affiliated)))) + (cond + ((looking-at "\\(?: \\|$\\)") + (beginning-of-line) + (org-element-comment-parser limit affiliated)) + ((looking-at "\\+BEGIN_\\(\\S-+\\)") + (beginning-of-line) + (funcall (pcase (upcase (match-string 1)) + ("CENTER" #'org-element-center-block-parser) + ("COMMENT" #'org-element-comment-block-parser) + ("EXAMPLE" #'org-element-example-block-parser) + ("EXPORT" #'org-element-export-block-parser) + ("QUOTE" #'org-element-quote-block-parser) + ("SRC" #'org-element-src-block-parser) + ("VERSE" #'org-element-verse-block-parser) + (_ #'org-element-special-block-parser)) + limit + affiliated)) + ((looking-at "\\+CALL:") + (beginning-of-line) + (org-element-babel-call-parser limit affiliated)) + ((looking-at "\\+BEGIN:? ") + (beginning-of-line) + (org-element-dynamic-block-parser limit affiliated)) + ((looking-at "\\+\\S-+:") + (beginning-of-line) + (org-element-keyword-parser limit affiliated)) + (t + (beginning-of-line) + (org-element-paragraph-parser limit affiliated)))) ;; Footnote Definition. ((looking-at org-footnote-definition-re) (org-element-footnote-definition-parser limit affiliated)) @@ -3893,7 +3967,7 @@ position of point and CDR is nil." (dualp (member kwd org-element-dual-keywords)) (dual-value (and dualp - (let ((sec (org-match-string-no-properties 2))) + (let ((sec (match-string-no-properties 2))) (if (or (not sec) (not parsedp)) sec (save-match-data (org-element--parse-objects @@ -4010,14 +4084,11 @@ If STRING is the empty string or nil, return nil." (dolist (v local-variables) (ignore-errors (if (symbolp v) (makunbound v) - (org-set-local (car v) (cdr v))))) + (set (make-local-variable (car v)) (cdr v))))) (insert string) (restore-buffer-modified-p nil) - (let ((data (org-element--parse-objects - (point-min) (point-max) nil restriction))) - (when parent - (dolist (o data) (org-element-put-property o :parent parent))) - data)))))) + (org-element--parse-objects + (point-min) (point-max) nil restriction parent)))))) (defun org-element-map (data types fun &optional info first-match no-recursion with-affiliated) @@ -4087,94 +4158,93 @@ looking into captions: (list no-recursion))) ;; Recursion depth is determined by --CATEGORY. (--category - (catch 'found + (catch :--found (let ((category 'greater-elements) (all-objects (cons 'plain-text org-element-all-objects))) (dolist (type types category) (cond ((memq type all-objects) - ;; If one object is found, the function has to - ;; recurse into every object. - (throw 'found 'objects)) + ;; If one object is found, the function has + ;; to recurse into every object. + (throw :--found 'objects)) ((not (memq type org-element-greater-elements)) ;; If one regular element is found, the ;; function has to recurse, at least, into ;; every element it encounters. (and (not (eq category 'elements)) (setq category 'elements)))))))) - --acc - --walk-tree - (--walk-tree - (lambda (--data) - ;; Recursively walk DATA. INFO, if non-nil, is a plist - ;; holding contextual information. - (let ((--type (org-element-type --data))) - (cond - ((not --data)) - ;; Ignored element in an export context. - ((and info (memq --data (plist-get info :ignore-list)))) - ;; List of elements or objects. - ((not --type) (mapc --walk-tree --data)) - ;; Unconditionally enter parse trees. - ((eq --type 'org-data) - (mapc --walk-tree (org-element-contents --data))) - (t - ;; Check if TYPE is matching among TYPES. If so, - ;; apply FUN to --DATA and accumulate return value - ;; into --ACC (or exit if FIRST-MATCH is non-nil). - (when (memq --type types) - (let ((result (funcall fun --data))) - (cond ((not result)) - (first-match (throw '--map-first-match result)) - (t (push result --acc))))) - ;; If --DATA has a secondary string that can contain - ;; objects with their type among TYPES, look into it. - (when (and (eq --category 'objects) (not (stringp --data))) - (dolist (p (cdr (assq --type - org-element-secondary-value-alist))) - (funcall --walk-tree (org-element-property p --data)))) - ;; If --DATA has any parsed affiliated keywords and - ;; WITH-AFFILIATED is non-nil, look for objects in - ;; them. - (when (and with-affiliated - (eq --category 'objects) - (memq --type org-element-all-elements)) - (dolist (kwd-pair org-element--parsed-properties-alist) - (let ((kwd (car kwd-pair)) - (value (org-element-property (cdr kwd-pair) --data))) - ;; Pay attention to the type of parsed keyword. - ;; In particular, preserve order for multiple - ;; keywords. - (cond - ((not value)) - ((member kwd org-element-dual-keywords) - (if (member kwd org-element-multiple-keywords) - (dolist (line (reverse value)) - (funcall --walk-tree (cdr line)) - (funcall --walk-tree (car line))) - (funcall --walk-tree (cdr value)) - (funcall --walk-tree (car value)))) - ((member kwd org-element-multiple-keywords) - (mapc --walk-tree (reverse value))) - (t (funcall --walk-tree value)))))) - ;; Determine if a recursion into --DATA is possible. - (cond - ;; --TYPE is explicitly removed from recursion. - ((memq --type no-recursion)) - ;; --DATA has no contents. - ((not (org-element-contents --data))) - ;; Looking for greater elements but --DATA is simply - ;; an element or an object. - ((and (eq --category 'greater-elements) - (not (memq --type org-element-greater-elements)))) - ;; Looking for elements but --DATA is an object. - ((and (eq --category 'elements) - (memq --type org-element-all-objects))) - ;; In any other case, map contents. - (t (mapc --walk-tree (org-element-contents --data)))))))))) - (catch '--map-first-match - (funcall --walk-tree data) - ;; Return value in a proper order. - (nreverse --acc)))) + --acc) + (letrec ((--walk-tree + (lambda (--data) + ;; Recursively walk DATA. INFO, if non-nil, is a plist + ;; holding contextual information. + (let ((--type (org-element-type --data))) + (cond + ((not --data)) + ;; Ignored element in an export context. + ((and info (memq --data (plist-get info :ignore-list)))) + ;; List of elements or objects. + ((not --type) (mapc --walk-tree --data)) + ;; Unconditionally enter parse trees. + ((eq --type 'org-data) + (mapc --walk-tree (org-element-contents --data))) + (t + ;; Check if TYPE is matching among TYPES. If so, + ;; apply FUN to --DATA and accumulate return value + ;; into --ACC (or exit if FIRST-MATCH is non-nil). + (when (memq --type types) + (let ((result (funcall fun --data))) + (cond ((not result)) + (first-match (throw :--map-first-match result)) + (t (push result --acc))))) + ;; If --DATA has a secondary string that can contain + ;; objects with their type among TYPES, look inside. + (when (and (eq --category 'objects) (not (stringp --data))) + (dolist (p (cdr (assq --type + org-element-secondary-value-alist))) + (funcall --walk-tree (org-element-property p --data)))) + ;; If --DATA has any parsed affiliated keywords and + ;; WITH-AFFILIATED is non-nil, look for objects in + ;; them. + (when (and with-affiliated + (eq --category 'objects) + (eq (org-element-class --data) 'element)) + (dolist (kwd-pair org-element--parsed-properties-alist) + (let ((kwd (car kwd-pair)) + (value (org-element-property (cdr kwd-pair) --data))) + ;; Pay attention to the type of parsed + ;; keyword. In particular, preserve order for + ;; multiple keywords. + (cond + ((not value)) + ((member kwd org-element-dual-keywords) + (if (member kwd org-element-multiple-keywords) + (dolist (line (reverse value)) + (funcall --walk-tree (cdr line)) + (funcall --walk-tree (car line))) + (funcall --walk-tree (cdr value)) + (funcall --walk-tree (car value)))) + ((member kwd org-element-multiple-keywords) + (mapc --walk-tree (reverse value))) + (t (funcall --walk-tree value)))))) + ;; Determine if a recursion into --DATA is possible. + (cond + ;; --TYPE is explicitly removed from recursion. + ((memq --type no-recursion)) + ;; --DATA has no contents. + ((not (org-element-contents --data))) + ;; Looking for greater elements but --DATA is + ;; simply an element or an object. + ((and (eq --category 'greater-elements) + (not (memq --type org-element-greater-elements)))) + ;; Looking for elements but --DATA is an object. + ((and (eq --category 'elements) + (eq (org-element-class --data) 'object))) + ;; In any other case, map contents. + (t (mapc --walk-tree (org-element-contents --data)))))))))) + (catch :--map-first-match + (funcall --walk-tree data) + ;; Return value in a proper order. + (nreverse --acc))))) (put 'org-element-map 'lisp-indent-function 2) ;; The following functions are internal parts of the parser. @@ -4195,21 +4265,21 @@ otherwise. Modes can be either `first-section', `item', `node-property', `planning', `property-drawer', `section', `table-row' or nil." (if parentp - (case type - (headline 'section) - (inlinetask 'planning) - (plain-list 'item) - (property-drawer 'node-property) - (section 'planning) - (table 'table-row)) - (case type - (item 'item) - (node-property 'node-property) - (planning 'property-drawer) - (table-row 'table-row)))) + (pcase type + (`headline 'section) + (`inlinetask 'planning) + (`plain-list 'item) + (`property-drawer 'node-property) + (`section 'planning) + (`table 'table-row)) + (pcase type + (`item 'item) + (`node-property 'node-property) + (`planning 'property-drawer) + (`table-row 'table-row)))) (defun org-element--parse-elements - (beg end mode structure granularity visible-only acc) + (beg end mode structure granularity visible-only acc) "Parse elements between BEG and END positions. MODE prioritizes some elements over the others. It can be set to @@ -4235,49 +4305,49 @@ Elements are accumulated into ACC." ;; When parsing only headlines, skip any text before first one. (when (and (eq granularity 'headline) (not (org-at-heading-p))) (org-with-limited-levels (outline-next-heading))) - ;; Main loop start. - (while (< (point) end) - ;; Find current element's type and parse it accordingly to - ;; its category. - (let* ((element (org-element--current-element - end granularity mode structure)) - (type (org-element-type element)) - (cbeg (org-element-property :contents-begin element))) - (goto-char (org-element-property :end element)) - ;; Visible only: skip invisible parts between siblings. - (when (and visible-only (org-invisible-p2)) - (goto-char (min (1+ (org-find-visible)) end))) - ;; Fill ELEMENT contents by side-effect. - (cond - ;; If element has no contents, don't modify it. - ((not cbeg)) - ;; Greater element: parse it between `contents-begin' and - ;; `contents-end'. Make sure GRANULARITY allows the - ;; recursion, or ELEMENT is a headline, in which case going - ;; inside is mandatory, in order to get sub-level headings. - ((and (memq type org-element-greater-elements) - (or (memq granularity '(element object nil)) - (and (eq granularity 'greater-element) - (eq type 'section)) - (eq type 'headline))) - (org-element--parse-elements - cbeg (org-element-property :contents-end element) - ;; Possibly switch to a special mode. - (org-element--next-mode type t) - (and (memq type '(item plain-list)) - (org-element-property :structure element)) - granularity visible-only element)) - ;; ELEMENT has contents. Parse objects inside, if - ;; GRANULARITY allows it. - ((memq granularity '(object nil)) - (org-element--parse-objects - cbeg (org-element-property :contents-end element) element - (org-element-restriction type)))) - (org-element-adopt-elements acc element) - ;; Update mode. - (setq mode (org-element--next-mode type nil)))) - ;; Return result. - acc)) + (let (elements) + (while (< (point) end) + ;; Find current element's type and parse it accordingly to + ;; its category. + (let* ((element (org-element--current-element + end granularity mode structure)) + (type (org-element-type element)) + (cbeg (org-element-property :contents-begin element))) + (goto-char (org-element-property :end element)) + ;; Visible only: skip invisible parts between siblings. + (when (and visible-only (org-invisible-p2)) + (goto-char (min (1+ (org-find-visible)) end))) + ;; Fill ELEMENT contents by side-effect. + (cond + ;; If element has no contents, don't modify it. + ((not cbeg)) + ;; Greater element: parse it between `contents-begin' and + ;; `contents-end'. Make sure GRANULARITY allows the + ;; recursion, or ELEMENT is a headline, in which case going + ;; inside is mandatory, in order to get sub-level headings. + ((and (memq type org-element-greater-elements) + (or (memq granularity '(element object nil)) + (and (eq granularity 'greater-element) + (eq type 'section)) + (eq type 'headline))) + (org-element--parse-elements + cbeg (org-element-property :contents-end element) + ;; Possibly switch to a special mode. + (org-element--next-mode type t) + (and (memq type '(item plain-list)) + (org-element-property :structure element)) + granularity visible-only element)) + ;; ELEMENT has contents. Parse objects inside, if + ;; GRANULARITY allows it. + ((memq granularity '(object nil)) + (org-element--parse-objects + cbeg (org-element-property :contents-end element) element + (org-element-restriction type)))) + (push (org-element-put-property element :parent acc) elements) + ;; Update mode. + (setq mode (org-element--next-mode type nil)))) + ;; Return result. + (apply #'org-element-set-contents acc (nreverse elements))))) (defun org-element--object-lex (restriction) "Return next object in current buffer or nil. @@ -4285,27 +4355,41 @@ RESTRICTION is a list of object types, as symbols, that should be looked after. This function assumes that the buffer is narrowed to an appropriate container (e.g., a paragraph)." (if (memq 'table-cell restriction) (org-element-table-cell-parser) - (save-excursion - (let ((limit (and org-target-link-regexp - (save-excursion - (or (bolp) (backward-char)) - (re-search-forward org-target-link-regexp nil t)) - (match-beginning 1))) - found) + (let* ((start (point)) + (limit + (save-excursion + (cond ((not org-target-link-regexp) nil) + ((not (memq 'link restriction)) nil) + ((progn + (unless (bolp) (forward-char -1)) + (not (re-search-forward org-target-link-regexp nil t))) + nil) + ;; Since we moved backward, we do not want to + ;; match again an hypothetical 1-character long + ;; radio link before us. Realizing that this can + ;; only happen if such a radio link starts at + ;; beginning of line, we prevent this here. + ((and (= start (1+ (line-beginning-position))) + (= start (match-end 1))) + (and (re-search-forward org-target-link-regexp nil t) + (match-beginning 1))) + (t (match-beginning 1))))) + found) + (save-excursion (while (and (not found) - (re-search-forward org-element--object-regexp limit t)) + (re-search-forward org-element--object-regexp limit 'move)) (goto-char (match-beginning 0)) (let ((result (match-string 0))) (setq found (cond - ((eq (compare-strings result nil nil "call_" nil nil t) t) + ((string-prefix-p "call_" result t) (and (memq 'inline-babel-call restriction) (org-element-inline-babel-call-parser))) - ((eq (compare-strings result nil nil "src_" nil nil t) t) + ((string-prefix-p "src_" result t) (and (memq 'inline-src-block restriction) (org-element-inline-src-block-parser))) (t - (case (char-after) + (pcase (char-after) (?^ (and (memq 'superscript restriction) (org-element-superscript-parser))) (?_ (or (and (memq 'subscript restriction) @@ -4336,7 +4420,8 @@ to an appropriate container (e.g., a paragraph)." (org-element-target-parser))) (or (and (memq 'timestamp restriction) (org-element-timestamp-parser)) - (and (memq 'link restriction) + (and (or (memq 'link restriction) + (memq 'simple-link restriction)) (org-element-link-parser))))) (?\\ (if (eq (aref result 1) ?\\) @@ -4357,60 +4442,63 @@ to an appropriate container (e.g., a paragraph)." (and (memq 'statistics-cookie restriction) (org-element-statistics-cookie-parser))))) ;; This is probably a plain link. - (otherwise (and (or (memq 'link restriction) - (memq 'plain-link restriction)) - (org-element-link-parser))))))) + (_ (and (or (memq 'link restriction) + (memq 'simple-link restriction)) + (org-element-link-parser))))))) (or (eobp) (forward-char)))) (cond (found) - ;; Radio link. - ((and limit (memq 'link restriction)) - (goto-char limit) (org-element-link-parser))))))) + (limit (org-element-link-parser)) ;radio link + (t nil)))))) -(defun org-element--parse-objects (beg end acc restriction) +(defun org-element--parse-objects (beg end acc restriction &optional parent) "Parse objects between BEG and END and return recursive structure. -Objects are accumulated in ACC. +Objects are accumulated in ACC. RESTRICTION is a list of object +successors which are allowed in the current object. -RESTRICTION is a list of object successors which are allowed in -the current object." +ACC becomes the parent for all parsed objects. However, if ACC +is nil (i.e., a secondary string is being parsed) and optional +argument PARENT is non-nil, use it as the parent for all objects. +Eventually, if both ACC and PARENT are nil, the common parent is +the list of objects itself." (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) - (let (next-object) + (let (next-object contents) (while (and (not (eobp)) (setq next-object (org-element--object-lex restriction))) - ;; 1. Text before any object. Untabify it. + ;; Text before any object. (let ((obj-beg (org-element-property :begin next-object))) (unless (= (point) obj-beg) - (setq acc - (org-element-adopt-elements - acc - (replace-regexp-in-string - "\t" (make-string tab-width ? ) - (buffer-substring-no-properties (point) obj-beg)))))) - ;; 2. Object... + (let ((text (buffer-substring-no-properties (point) obj-beg))) + (push (if acc (org-element-put-property text :parent acc) text) + contents)))) + ;; Object... (let ((obj-end (org-element-property :end next-object)) (cont-beg (org-element-property :contents-begin next-object))) - ;; Fill contents of NEXT-OBJECT by side-effect, if it has - ;; a recursive type. - (when (and cont-beg - (memq (car next-object) org-element-recursive-objects)) - (org-element--parse-objects - cont-beg (org-element-property :contents-end next-object) - next-object (org-element-restriction next-object))) - (setq acc (org-element-adopt-elements acc next-object)) - (goto-char obj-end)))) - ;; 3. Text after last object. Untabify it. - (unless (eobp) - (setq acc - (org-element-adopt-elements - acc - (replace-regexp-in-string - "\t" (make-string tab-width ? ) - (buffer-substring-no-properties (point) end))))) - ;; Result. - acc))) + (when acc (org-element-put-property next-object :parent acc)) + (push (if cont-beg + ;; Fill contents of NEXT-OBJECT if possible. + (org-element--parse-objects + cont-beg + (org-element-property :contents-end next-object) + next-object + (org-element-restriction next-object)) + next-object) + contents) + (goto-char obj-end))) + ;; Text after last object. + (unless (eobp) + (let ((text (buffer-substring-no-properties (point) end))) + (push (if acc (org-element-put-property text :parent acc) text) + contents))) + ;; Result. Set appropriate parent. + (if acc (apply #'org-element-set-contents acc (nreverse contents)) + (let* ((contents (nreverse contents)) + (parent (or parent contents))) + (dolist (datum contents contents) + (org-element-put-property datum :parent parent)))))))) @@ -4429,73 +4517,70 @@ the current object." "Interpret DATA as Org syntax. DATA is a parse tree, an element, an object or a secondary string to interpret. Return Org syntax as a string." - (org-element--interpret-data-1 data nil)) - -(defun org-element--interpret-data-1 (data parent) - "Interpret DATA as Org syntax. - -DATA is a parse tree, an element, an object or a secondary string -to interpret. PARENT is used for recursive calls. It contains -the element or object containing data, or nil. - -Return Org syntax as a string." - (let* ((type (org-element-type data)) - ;; Find interpreter for current object or element. If it - ;; doesn't exist (e.g. this is a pseudo object or element), - ;; return contents, if any. - (interpret - (let ((fun (intern (format "org-element-%s-interpreter" type)))) - (if (fboundp fun) fun (lambda (data contents) contents)))) - (results - (cond - ;; Secondary string. - ((not type) - (mapconcat - (lambda (obj) (org-element--interpret-data-1 obj parent)) data "")) - ;; Full Org document. - ((eq type 'org-data) - (mapconcat (lambda (obj) (org-element--interpret-data-1 obj parent)) - (org-element-contents data) "")) - ;; Plain text: return it. - ((stringp data) data) - ;; Element or object without contents. - ((not (org-element-contents data)) (funcall interpret data nil)) - ;; Element or object with contents. - (t - (funcall interpret data - ;; Recursively interpret contents. - (mapconcat - (lambda (obj) (org-element--interpret-data-1 obj data)) - (org-element-contents - (if (not (memq type '(paragraph verse-block))) - data - ;; Fix indentation of elements containing - ;; objects. We ignore `table-row' elements - ;; as they are one line long anyway. - (org-element-normalize-contents - data - ;; When normalizing first paragraph of an - ;; item or a footnote-definition, ignore - ;; first line's indentation. - (and (eq type 'paragraph) - (equal data (car (org-element-contents parent))) - (memq (org-element-type parent) - '(footnote-definition item)))))) - "")))))) - (if (memq type '(org-data plain-text nil)) results - ;; Build white spaces. If no `:post-blank' property is - ;; specified, assume its value is 0. - (let ((post-blank (or (org-element-property :post-blank data) 0))) - (if (or (memq type org-element-all-objects) - (and parent - (let ((type (org-element-type parent))) - (or (not type) - (memq type org-element-object-containers))))) - (concat results (make-string post-blank ?\s)) - (concat - (org-element--interpret-affiliated-keywords data) - (org-element-normalize-string results) - (make-string post-blank ?\n))))))) + (letrec ((fun + (lambda (data parent) + (let* ((type (org-element-type data)) + ;; Find interpreter for current object or + ;; element. If it doesn't exist (e.g. this is + ;; a pseudo object or element), return contents, + ;; if any. + (interpret + (let ((fun (intern + (format "org-element-%s-interpreter" type)))) + (if (fboundp fun) fun (lambda (_ contents) contents)))) + (results + (cond + ;; Secondary string. + ((not type) + (mapconcat (lambda (obj) (funcall fun obj parent)) + data + "")) + ;; Full Org document. + ((eq type 'org-data) + (mapconcat (lambda (obj) (funcall fun obj parent)) + (org-element-contents data) + "")) + ;; Plain text: return it. + ((stringp data) data) + ;; Element or object without contents. + ((not (org-element-contents data)) + (funcall interpret data nil)) + ;; Element or object with contents. + (t + (funcall + interpret + data + ;; Recursively interpret contents. + (mapconcat + (lambda (datum) (funcall fun datum data)) + (org-element-contents + (if (not (memq type '(paragraph verse-block))) + data + ;; Fix indentation of elements containing + ;; objects. We ignore `table-row' + ;; elements as they are one line long + ;; anyway. + (org-element-normalize-contents + data + ;; When normalizing first paragraph of + ;; an item or a footnote-definition, + ;; ignore first line's indentation. + (and (eq type 'paragraph) + (memq (org-element-type parent) + '(footnote-definition item)) + (eq data + (car (org-element-contents parent))))))) + "")))))) + (if (memq type '(org-data plain-text nil)) results + ;; Build white spaces. If no `:post-blank' property + ;; is specified, assume its value is 0. + (let ((blank (or (org-element-property :post-blank data) 0))) + (if (eq (org-element-class data parent) 'object) + (concat results (make-string blank ?\s)) + (concat (org-element--interpret-affiliated-keywords data) + (org-element-normalize-string results) + (make-string blank ?\n))))))))) + (funcall fun data nil))) (defun org-element--interpret-affiliated-keywords (element) "Return ELEMENT's affiliated keywords as Org syntax. @@ -4529,14 +4614,14 @@ If there is no affiliated keyword, return the empty string." ;; List all ELEMENT's properties matching an attribute line or an ;; affiliated keyword, but ignore translated keywords since they ;; cannot belong to the property list. - (loop for prop in (nth 1 element) by 'cddr - when (let ((keyword (upcase (substring (symbol-name prop) 1)))) - (or (string-match "^ATTR_" keyword) - (and - (member keyword org-element-affiliated-keywords) - (not (assoc keyword - org-element-keyword-translation-alist))))) - collect prop) + (cl-loop for prop in (nth 1 element) by 'cddr + when (let ((keyword (upcase (substring (symbol-name prop) 1)))) + (or (string-match "^ATTR_" keyword) + (and + (member keyword org-element-affiliated-keywords) + (not (assoc keyword + org-element-keyword-translation-alist))))) + collect prop) ""))) ;; Because interpretation of the parse tree must return the same @@ -4572,75 +4657,89 @@ If optional argument IGNORE-FIRST is non-nil, ignore first line's indentation to compute maximal common indentation. Return the normalized element that is element with global -indentation removed from its contents. The function assumes that -indentation is not done with TAB characters." - (let* ((min-ind most-positive-fixnum) - find-min-ind ; For byte-compiler. - (find-min-ind - ;; Return minimal common indentation within BLOB. This is - ;; done by walking recursively BLOB and updating MIN-IND - ;; along the way. FIRST-FLAG is non-nil when the next - ;; object is expected to be a string that doesn't start with - ;; a newline character. It happens for strings at the - ;; beginnings of the contents or right after a line break. - (lambda (blob first-flag) - (dolist (object (org-element-contents blob)) - (when first-flag - (setq first-flag nil) - ;; Objects cannot start with spaces: in this case, - ;; indentation is 0. - (if (not (stringp object)) (throw 'zero (setq min-ind 0)) - (string-match "\\` *" object) - (let ((len (match-end 0))) - ;; An indentation of zero means no string will be - ;; modified. Quit the process. - (if (zerop len) (throw 'zero (setq min-ind 0)) - (setq min-ind (min len min-ind)))))) - (cond - ((stringp object) - (dolist (line (cdr (org-split-string object " *\n"))) - (unless (string= line "") - (setq min-ind (min (org-get-indentation line) min-ind))))) - ((eq (org-element-type object) 'line-break) (setq first-flag t)) - ((memq (org-element-type object) org-element-recursive-objects) - (funcall find-min-ind object first-flag))))))) - ;; Find minimal indentation in ELEMENT. - (catch 'zero (funcall find-min-ind element (not ignore-first))) +indentation removed from its contents." + (letrec ((find-min-ind + ;; Return minimal common indentation within BLOB. This is + ;; done by walking recursively BLOB and updating MIN-IND + ;; along the way. FIRST-FLAG is non-nil when the next + ;; object is expected to be a string that doesn't start + ;; with a newline character. It happens for strings at + ;; the beginnings of the contents or right after a line + ;; break. + (lambda (blob first-flag min-ind) + (catch 'zero + (dolist (datum (org-element-contents blob) min-ind) + (when first-flag + (setq first-flag nil) + (cond + ;; Objects cannot start with spaces: in this + ;; case, indentation is 0. + ((not (stringp datum)) (throw 'zero 0)) + ((not (string-match + "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum)) + (throw 'zero 0)) + ((equal (match-string 2 datum) "\n") + (put-text-property + (match-beginning 1) (match-end 1) 'org-ind 'empty datum)) + (t + (let ((i (string-width (match-string 1 datum)))) + (put-text-property + (match-beginning 1) (match-end 1) 'org-ind i datum) + (setq min-ind (min i min-ind)))))) + (cond + ((stringp datum) + (let ((s 0)) + (while (string-match + "\n\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s) + (setq s (match-end 1)) + (if (equal (match-string 2 datum) "\n") + (put-text-property + (match-beginning 1) (match-end 1) + 'org-ind 'empty + datum) + (let ((i (string-width (match-string 1 datum)))) + (put-text-property + (match-beginning 1) (match-end 1) 'org-ind i datum) + (setq min-ind (min i min-ind))))))) + ((eq (org-element-type datum) 'line-break) + (setq first-flag t)) + ((memq (org-element-type datum) org-element-recursive-objects) + (setq min-ind + (funcall find-min-ind datum first-flag min-ind)))))))) + (min-ind (funcall find-min-ind + element (not ignore-first) most-positive-fixnum))) (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element ;; Build ELEMENT back, replacing each string with the same ;; string minus common indentation. - (let* (build ; For byte compiler. - (build - (lambda (blob first-flag) - ;; Return BLOB with all its strings indentation - ;; shortened from MIN-IND white spaces. FIRST-FLAG is - ;; non-nil when the next object is expected to be - ;; a string that doesn't start with a newline - ;; character. - (setcdr (cdr blob) - (mapcar - (lambda (object) - (when first-flag - (setq first-flag nil) - (when (stringp object) - (setq object - (replace-regexp-in-string - (format "\\` \\{%d\\}" min-ind) - "" object)))) - (cond - ((stringp object) - (replace-regexp-in-string - (format "\n \\{%d\\}" min-ind) "\n" object)) - ((memq (org-element-type object) - org-element-recursive-objects) - (funcall build object first-flag)) - ((eq (org-element-type object) 'line-break) - (setq first-flag t) - object) - (t object))) - (org-element-contents blob))) - blob))) - (funcall build element (not ignore-first)))))) + (letrec ((build + (lambda (datum) + ;; Return DATUM with all its strings indentation + ;; shortened from MIN-IND white spaces. + (setcdr + (cdr datum) + (mapcar + (lambda (object) + (cond + ((stringp object) + (with-temp-buffer + (insert object) + (let ((s (point-min))) + (while (setq s (text-property-not-all + s (point-max) 'org-ind nil)) + (goto-char s) + (let ((i (get-text-property s 'org-ind))) + (delete-region s (progn + (skip-chars-forward " \t") + (point))) + (when (integerp i) (indent-to (- i min-ind)))))) + (buffer-string))) + ((memq (org-element-type object) + org-element-recursive-objects) + (funcall build object)) + (t object))) + (org-element-contents datum))) + datum))) + (funcall build element))))) @@ -4722,7 +4821,7 @@ with `org-element--cache-compare'. This cache is used in Key is an element, as returned by `org-element-at-point', and value is an alist where each association is: - \(PARENT COMPLETEP . OBJECTS) + (PARENT COMPLETEP . OBJECTS) where PARENT is an element or object, COMPLETEP is a boolean, non-nil when all direct children of parent are already cached and @@ -4736,12 +4835,12 @@ contained within a paragraph If the paragraph is completely parsed, OBJECTS-DATA will be - \((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT) - \(BOLD-OBJECT t ENTITY-OBJECT)) + ((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT) + (BOLD-OBJECT t ENTITY-OBJECT)) whereas in a partially parsed paragraph, it could be - \((PARAGRAPH nil ENTITY-OBJECT)) + ((PARAGRAPH nil ENTITY-OBJECT)) This cache is used in `org-element-context'.") @@ -4830,16 +4929,16 @@ the following rules: gets a new level. Its value is the mean between LOWER and UPPER: - \(1 2) + (1 4) --> (1 3) + (1 2) + (1 4) --> (1 3) - If LOWER has no value to compare with, it is assumed that its value is `most-negative-fixnum'. E.g., - \(1 1) + (1 1 2) + (1 1) + (1 1 2) is equivalent to - \(1 1 m) + (1 1 2) + (1 1 m) + (1 1 2) where m is `most-negative-fixnum'. Likewise, if UPPER is short of levels, the current value is `most-positive-fixnum'. @@ -4847,18 +4946,18 @@ the following rules: - If they differ from only one, the new key inherits from current LOWER level and fork it at the next level. E.g., - \(2 1) + (3 3) + (2 1) + (3 3) is equivalent to - \(2 1) + (2 M) + (2 1) + (2 M) where M is `most-positive-fixnum'. - If the key is only one level long, it is returned as an integer: - \(1 2) + (3 2) --> 2 + (1 2) + (3 2) --> 2 When they are not equals, the function assumes that LOWER is lesser than UPPER, per `org-element--cache-key-less-p'." @@ -4976,10 +5075,10 @@ the cache." (setq node nil lower element upper element))))) - (case side - (both (cons lower upper)) - ((nil) lower) - (otherwise upper)))) + (pcase side + (`both (cons lower upper)) + (`nil lower) + (_ upper)))) (defun org-element--cache-put (element &optional data) "Store ELEMENT in current buffer's cache, if allowed. @@ -5053,8 +5152,8 @@ Properties are modified by side-effect." (not (eq (org-element-type (plist-get properties :parent)) 'item))) (dolist (item (plist-get properties :structure)) - (incf (car item) offset) - (incf (nth 6 item) offset))) + (cl-incf (car item) offset) + (cl-incf (nth 6 item) offset))) (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated)) (let ((value (and (or (not props) (memq key props)) (plist-get properties key)))) @@ -5093,7 +5192,7 @@ updated before current modification are actually submitted." ;; Request processed. Merge current and next offsets and ;; transfer ending position. (when next - (incf (aref next 3) (aref request 3)) + (cl-incf (aref next 3) (aref request 3)) (aset next 2 (aref request 2))) (setq org-element--cache-sync-requests (cdr org-element--cache-sync-requests)))) @@ -5483,12 +5582,12 @@ that range. See `after-change-functions' for more information." ;; to both previous and current state. We make a special ;; case for headline editing: if a headline is modified but ;; not removed, do not extend. - (when (case org-element--cache-change-warning - ((t) t) - (headline + (when (pcase org-element--cache-change-warning + (`t t) + (`headline (not (and (org-with-limited-levels (org-at-heading-p)) (= (line-end-position) bottom)))) - (otherwise + (_ (let ((case-fold-search t)) (re-search-forward org-element--cache-sensitive-re bottom t)))) @@ -5569,7 +5668,7 @@ change, as an integer." ;; Current changes can be merged with first sync request: we ;; can save a partial cache synchronization. (progn - (incf (aref next 3) offset) + (cl-incf (aref next 3) offset) ;; If last change happened within area to be removed, extend ;; boundaries of robust parents, if any. Otherwise, find ;; first element to remove and update request accordingly. @@ -5619,7 +5718,8 @@ change, as an integer." ;; No element to remove. No need to re-parent either. ;; Simply shift additional elements, if any, by OFFSET. (when org-element--cache-sync-requests - (incf (aref (car org-element--cache-sync-requests) 3) offset))))))) + (cl-incf (aref (car org-element--cache-sync-requests) 3) + offset))))))) ;;;; Public Functions @@ -5633,14 +5733,14 @@ buffers." (dolist (buffer (if all (buffer-list) (list (current-buffer)))) (with-current-buffer buffer (when (and org-element-use-cache (derived-mode-p 'org-mode)) - (org-set-local 'org-element--cache - (avl-tree-create #'org-element--cache-compare)) - (org-set-local 'org-element--cache-objects (make-hash-table :test #'eq)) - (org-set-local 'org-element--cache-sync-keys - (make-hash-table :weakness 'key :test #'eq)) - (org-set-local 'org-element--cache-change-warning nil) - (org-set-local 'org-element--cache-sync-requests nil) - (org-set-local 'org-element--cache-sync-timer nil) + (setq-local org-element--cache + (avl-tree-create #'org-element--cache-compare)) + (setq-local org-element--cache-objects (make-hash-table :test #'eq)) + (setq-local org-element--cache-sync-keys + (make-hash-table :weakness 'key :test #'eq)) + (setq-local org-element--cache-change-warning nil) + (setq-local org-element--cache-sync-requests nil) + (setq-local org-element--cache-sync-timer nil) (add-hook 'before-change-functions #'org-element--cache-before-change nil t) (add-hook 'after-change-functions @@ -5772,15 +5872,16 @@ Providing it allows for quicker computation." (throw 'objects-forbidden element))))) ;; At an headline or inlinetask, objects are in title. ((memq type '(headline inlinetask)) - (goto-char (org-element-property :begin element)) - (looking-at org-complex-heading-regexp) - (let ((end (match-end 4))) - (if (not end) (throw 'objects-forbidden element) - (goto-char (match-beginning 4)) - (when (let (case-fold-search) (looking-at org-comment-string)) - (goto-char (match-end 0))) - (if (>= (point) end) (throw 'objects-forbidden element) - (narrow-to-region (point) end))))) + (let ((case-fold-search nil)) + (goto-char (org-element-property :begin element)) + (looking-at org-complex-heading-regexp) + (let ((end (match-end 4))) + (if (not end) (throw 'objects-forbidden element) + (goto-char (match-beginning 4)) + (when (looking-at org-comment-string) + (goto-char (match-end 0))) + (if (>= (point) end) (throw 'objects-forbidden element) + (narrow-to-region (point) end)))))) ;; At a paragraph, a table-row or a verse block, objects are ;; located within their contents. ((memq type '(paragraph table-row verse-block)) @@ -5988,7 +6089,7 @@ end of ELEM-A." (goto-char beg-B) (when specialp (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) - (org-indent-to-column ind-B)) + (indent-to-column ind-B)) (insert body-A) ;; Restore ex ELEM-A overlays. (let ((offset (- beg-B beg-A))) @@ -6002,36 +6103,6 @@ end of ELEM-A." (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset)))) (goto-char (org-element-property :end elem-B))))) -(defun org-element-remove-indentation (s &optional n) - "Remove maximum common indentation in string S and return it. -When optional argument N is a positive integer, remove exactly -that much characters from indentation, if possible, or return -S as-is otherwise. Unlike to `org-remove-indentation', this -function doesn't call `untabify' on S." - (catch 'exit - (with-temp-buffer - (insert s) - (goto-char (point-min)) - ;; Find maximum common indentation, if not specified. - (setq n (or n - (let ((min-ind (point-max))) - (save-excursion - (while (re-search-forward "^[ \t]*\\S-" nil t) - (let ((ind (1- (current-column)))) - (if (zerop ind) (throw 'exit s) - (setq min-ind (min min-ind ind)))))) - min-ind))) - (if (zerop n) s - ;; Remove exactly N indentation, but give up if not possible. - (while (not (eobp)) - (let ((ind (progn (skip-chars-forward " \t") (current-column)))) - (cond ((eolp) (delete-region (line-beginning-position) (point))) - ((< ind n) (throw 'exit s)) - (t (org-indent-line-to (- ind n)))) - (forward-line))) - (buffer-string))))) - - (provide 'org-element) diff --git a/lisp/org-entities.el b/lisp/org-entities.el index 89c5962..79b28e2 100644 --- a/lisp/org-entities.el +++ b/lisp/org-entities.el @@ -1,4 +1,4 @@ -;;; org-entities.el --- Support for special entities in Org-mode +;;; org-entities.el --- Support for Special Entities -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -30,29 +30,24 @@ (declare-function org-toggle-pretty-entities "org" ()) (declare-function org-table-align "org-table" ()) -(eval-when-compile - (require 'cl)) - (defgroup org-entities nil - "Options concerning entities in Org-mode." + "Options concerning entities in Org mode." :tag "Org Entities" :group 'org) (defun org-entities--user-safe-p (v) "Non-nil if V is a safe value for `org-entities-user'." - (or (null v) - (and (listp v) - (= (length v) 7) - (stringp (nth 0 v)) - (stringp (nth 1 v)) - (booleanp (nth 2 v)) - (stringp (nth 3 v)) - (stringp (nth 4 v)) - (stringp (nth 5 v)) - (stringp (nth 6 v))))) + (pcase v + (`nil t) + (`(,(and (pred stringp) + (pred (string-match-p "\\`[a-zA-Z][a-zA-Z0-9]*\\'"))) + ,(pred stringp) ,(pred booleanp) ,(pred stringp) + ,(pred stringp) ,(pred stringp) ,(pred stringp)) + t) + (_ nil))) (defcustom org-entities-user nil - "User-defined entities used in Org-mode to produce special characters. + "User-defined entities used in Org to produce special characters. Each entry in this list is a list of strings. It associates the name of the entity that can be inserted into an Org file as \\name with the appropriate replacements for the different export backends. The order @@ -93,6 +88,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("aacute" "\\'{a}" nil "á" "a" "á" "á") ("Acirc" "\\^{A}" nil "Â" "A" "Â" "Â") ("acirc" "\\^{a}" nil "â" "a" "â" "â") + ("Amacr" "\\bar{A}" nil "Ā" "A" "Ã" "Ã") + ("amacr" "\\bar{a}" nil "ā" "a" "ã" "ã") ("Atilde" "\\~{A}" nil "Ã" "A" "Ã" "Ã") ("atilde" "\\~{a}" nil "ã" "a" "ã" "ã") ("Auml" "\\\"{A}" nil "Ä" "Ae" "Ä" "Ä") @@ -168,7 +165,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("beta" "\\beta" t "β" "beta" "beta" "β") ("Gamma" "\\Gamma" t "Γ" "Gamma" "Gamma" "Γ") ("gamma" "\\gamma" t "γ" "gamma" "gamma" "γ") - ("Delta" "\\Delta" t "Δ" "Delta" "Gamma" "Δ") + ("Delta" "\\Delta" t "Δ" "Delta" "Delta" "Δ") ("delta" "\\delta" t "δ" "delta" "delta" "δ") ("Epsilon" "E" nil "Ε" "Epsilon" "Epsilon" "Ε") ("epsilon" "\\epsilon" t "ε" "epsilon" "epsilon" "ε") @@ -208,8 +205,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("upsih" "\\Upsilon" t "ϒ" "upsilon" "upsilon" "ϒ") ("upsilon" "\\upsilon" t "υ" "upsilon" "upsilon" "υ") ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") - ("phi" "\\phi" t "φ" "phi" "phi" "φ") - ("varphi" "\\varphi" t "ϕ" "varphi" "varphi" "ɸ") + ("phi" "\\phi" t "φ" "phi" "phi" "ɸ") + ("varphi" "\\varphi" t "ϕ" "varphi" "varphi" "φ") ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") ("chi" "\\chi" t "χ" "chi" "chi" "χ") ("acutex" "\\acute x" t "´x" "'x" "'x" "𝑥́") @@ -265,8 +262,9 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." "* Other" "** Misc. (often used)" - ("circ" "\\^{}" nil "ˆ" "^" "^" "ˆ") + ("circ" "\\^{}" nil "ˆ" "^" "^" "∘") ("vert" "\\vert{}" t "|" "|" "|" "|") + ("vbar" "|" nil "|" "|" "|" "|") ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") ("S" "\\S" nil "§" "paragraph" "§" "§") ("sect" "\\S" nil "§" "paragraph" "§" "§") @@ -285,7 +283,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("ddag" "\\ddag{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") "** Whitespace" - ("nbsp" "~" nil " " " " " " " ") + ("nbsp" "~" nil " " " " "\x00A0" "\x00A0") ("ensp" "\\hspace*{.5em}" nil " " " " " " " ") ("emsp" "\\hspace*{1em}" nil " " " " " " " ") ("thinsp" "\\hspace*{.2em}" nil " " " " " " " ") @@ -514,9 +512,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("loz" "\\lozenge" t "◊" "[lozenge]" "[lozenge]" "⧫")) ;; Add "\_ "-entity family for spaces. (let (space-entities html-spaces (entity "_")) - (dotimes (n 20 (nreverse space-entities)) - (let ((n (+ 1 n)) - (spaces (make-string n ?\s))) + (dolist (n (number-sequence 1 20) (nreverse space-entities)) + (let ((spaces (make-string n ?\s))) (push (list (setq entity (concat entity " ")) (format "\\hspace*{%sem}" (* n .5)) nil @@ -539,29 +536,22 @@ This first checks the user list, then the built-in list." (defun org-entities-create-table () "Create an Org mode table with all entities." (interactive) - (let ((pos (point)) e latex mathp html latin utf8 name ascii) + (let ((pos (point))) (insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n") - (mapc (lambda (e) (when (listp e) - (setq name (car e) - latex (nth 1 e) - mathp (nth 2 e) - html (nth 3 e) - ascii (nth 4 e) - latin (nth 5 e) - utf8 (nth 6 e)) - (if (equal ascii "|") (setq ascii "\\vert")) - (if (equal latin "|") (setq latin "\\vert")) - (if (equal utf8 "|") (setq utf8 "\\vert")) - (if (equal ascii "=>") (setq ascii "= >")) - (if (equal latin "=>") (setq latin "= >")) - (insert "|" name - "|" (format "=%s=" latex) - "|" (format (if mathp "$%s$" "$\\mbox{%s}$") - latex) - "|" (format "=%s=" html) "|" html - "|" ascii "|" latin "|" utf8 - "|\n"))) - org-entities) + (dolist (e org-entities) + (pcase e + (`(,name ,latex ,mathp ,html ,ascii ,latin ,utf8) + (if (equal ascii "|") (setq ascii "\\vert")) + (if (equal latin "|") (setq latin "\\vert")) + (if (equal utf8 "|") (setq utf8 "\\vert")) + (if (equal ascii "=>") (setq ascii "= >")) + (if (equal latin "=>") (setq latin "= >")) + (insert "|" name + "|" (format "=%s=" latex) + "|" (format (if mathp "$%s$" "$\\mbox{%s}$") latex) + "|" (format "=%s=" html) "|" html + "|" ascii "|" latin "|" utf8 + "|\n")))) (goto-char pos) (org-table-align))) @@ -570,31 +560,27 @@ This first checks the user list, then the built-in list." "Create a Help buffer with all available entities." (interactive) (with-output-to-temp-buffer "*Org Entity Help*" - (princ "Org-mode entities\n=================\n\n") + (princ "Org mode entities\n=================\n\n") (let ((ll (append '("* User-defined additions (variable org-entities-user)") org-entities-user org-entities)) - e latex mathp html latin utf8 name ascii (lastwasstring t) (head (concat "\n" " Symbol Org entity LaTeX code HTML code\n" " -----------------------------------------------------------\n"))) - (while ll - (setq e (pop ll)) - (if (stringp e) - (progn - (princ e) - (princ "\n") - (setq lastwasstring t)) - (if lastwasstring (princ head)) - (setq lastwasstring nil) - (setq name (car e) - latex (nth 1 e) - html (nth 3 e) - utf8 (nth 6 e)) - (princ (format " %-8s \\%-16s %-22s %-13s\n" - utf8 name latex html)))))) + (dolist (e ll) + (pcase e + (`(,name ,latex ,_ ,html ,_ ,_ ,utf8) + (when lastwasstring + (princ head) + (setq lastwasstring nil)) + (princ (format " %-8s \\%-16s %-22s %-13s\n" + utf8 name latex html))) + ((pred stringp) + (princ e) + (princ "\n") + (setq lastwasstring t)))))) (with-current-buffer "*Org Entity Help*" (org-mode) (when org-pretty-entities diff --git a/lisp/org-eshell.el b/lisp/org-eshell.el index 9c1c4a1..6f9a18a 100644 --- a/lisp/org-eshell.el +++ b/lisp/org-eshell.el @@ -1,4 +1,4 @@ -;;; org-eshell.el - Support for links to working directories in eshell +;;; org-eshell.el - Support for Links to Working Directories in Eshell -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -27,8 +27,9 @@ (require 'eshell) (require 'esh-mode) -(org-add-link-type "eshell" 'org-eshell-open) -(add-hook 'org-store-link-functions 'org-eshell-store-link) +(org-link-set-parameters "eshell" + :follow #'org-eshell-open + :store #'org-eshell-store-link) (defun org-eshell-open (link) "Switch to am eshell buffer and execute a command line. @@ -43,7 +44,7 @@ (eshell-buffer-name (car buffer-and-command)) (command (cadr buffer-and-command))) (if (get-buffer eshell-buffer-name) - (org-pop-to-buffer-same-window eshell-buffer-name) + (pop-to-buffer-same-window eshell-buffer-name) (eshell)) (goto-char (point-max)) (eshell-kill-input) diff --git a/contrib/lisp/org-eww.el b/lisp/org-eww.el index 20ec9d4..01ec905 100644 --- a/contrib/lisp/org-eww.el +++ b/lisp/org-eww.el @@ -1,4 +1,4 @@ -;;; org-eww.el --- Store url and kill from Eww mode for Org +;;; org-eww.el --- Store url and kill from Eww mode for Org -*- lexical-binding: t -*- ;; Copyright (C) 2014-2016 Free Software Foundation, Inc. @@ -6,7 +6,7 @@ ;; Keywords: link, eww ;; Homepage: http://orgmode.org ;; -;; This file is not part of GNU Emacs. +;; This file is part of GNU Emacs. ;; ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -29,8 +29,8 @@ ;; In an eww buffer function `org-eww-copy-for-org-mode' kills either ;; a region or the whole buffer if no region is set and transforms the -;; text on the fly so that it can be pasted into an org-mode buffer -;; with hot links. +;; text on the fly so that it can be pasted into an Org buffer with +;; hot links. ;; C-c C-x C-w (and also C-c C-x M-w) trigger ;; `org-eww-copy-for-org-mode'. @@ -45,12 +45,20 @@ ;;; Code: (require 'org) +(require 'cl-lib) + +(defvar eww-current-title) +(defvar eww-current-url) +(defvar eww-data) +(defvar eww-mode-map) + +(declare-function eww-current-url "eww") ;; Store Org-link in eww-mode buffer -(add-hook 'org-store-link-functions 'org-eww-store-link) +(org-link-set-parameters "eww" :follow #'eww :store #'org-eww-store-link) (defun org-eww-store-link () - "Store a link to the url of a eww buffer." + "Store a link to the url of a Eww buffer." (when (eq major-mode 'eww-mode) (org-store-link-props :type "eww" @@ -61,22 +69,21 @@ :description (if (< emacs-major-version 25) (or eww-current-title eww-current-url) (or (plist-get eww-data :title) - (eww-current-url)))))) + (eww-current-url)))))) ;; Some auxiliary functions concerning links in eww buffers (defun org-eww-goto-next-url-property-change () - "Move cursor to the start of next link if exists. Else no -move. Return point." + "Move to the start of next link if exists. +Otherwise point is not moved. Return point." (goto-char (or (next-single-property-change (point) 'shr-url) (point)))) -(defun org-eww-no-next-link-p () - "Whether there is no next link after the cursor. -Return t if there is no next link; otherwise, return nil." +(defun org-eww-has-further-url-property-change-p () + "Non-nil if there is a next url property change." (save-excursion - (and (eq (point) (org-eww-goto-next-url-property-change)) t))) + (not (eq (point) (org-eww-goto-next-url-property-change))))) (defun org-eww-url-below-point () "Return the url below point if there is an url; otherwise, return nil." @@ -87,10 +94,10 @@ Return t if there is no next link; otherwise, return nil." "Copy current buffer content or active region with `org-mode' style links. This will encode `link-title' and `link-location' with `org-make-link-string', and insert the transformed test into the kill ring, -so that it can be yanked into an Org-mode buffer with links working correctly. +so that it can be yanked into an Org mode buffer with links working correctly. Further lines starting with a star get quoted with a comma to keep -the structure of the org file." +the structure of the Org file." (interactive) (let* ((regionp (org-region-active-p)) (transform-start (point-min)) @@ -102,29 +109,30 @@ the structure of the org file." (setq transform-start (region-beginning)) (setq transform-end (region-end)) ;; Deactivate mark if current mark is activate. - (if (fboundp 'deactivate-mark) (deactivate-mark))) + (when (fboundp 'deactivate-mark) (deactivate-mark))) (message "Transforming links...") (save-excursion (goto-char transform-start) - (while (and (not out-bound) ; still inside region to copy - (not (org-eww-no-next-link-p))) ; there is a next link - ;; store current point before jump next anchor + (while (and (not out-bound) ; still inside region to copy + (org-eww-has-further-url-property-change-p)) ; there is a next link + ;; Store current point before jump next anchor. (setq temp-position (point)) - ;; move to next anchor when current point is not at anchor + ;; Move to next anchor when current point is not at anchor. (or (org-eww-url-below-point) (org-eww-goto-next-url-property-change)) - (assert (org-eww-url-below-point) t - "program logic error: point must have an url below but it hasn't") - (if (<= (point) transform-end) ; if point is inside transform bound + (cl-assert + (org-eww-url-below-point) t + "program logic error: point must have an url below but it hasn't") + (if (<= (point) transform-end) ; if point is inside transform bound (progn - ;; get content between two links. - (if (> (point) temp-position) - (setq return-content (concat return-content - (buffer-substring - temp-position (point))))) - ;; get link location at current point. + ;; Get content between two links. + (when (< temp-position (point)) + (setq return-content (concat return-content + (buffer-substring + temp-position (point))))) + ;; Get link location at current point. (setq link-location (org-eww-url-below-point)) - ;; get link title at current point. + ;; Get link title at current point. (setq link-title (buffer-substring (point) @@ -133,22 +141,17 @@ the structure of the org file." (setq return-content (concat return-content (org-make-link-string link-location link-title)))) - (goto-char temp-position) ; reset point before jump next anchor - (setq out-bound t) ; for break out `while' loop + (goto-char temp-position) ; reset point before jump next anchor + (setq out-bound t) ; for break out `while' loop )) - ;; add the rest until end of the region to be copied - (if (< (point) transform-end) - (setq return-content - (concat return-content - (buffer-substring (point) transform-end)))) - ;; quote lines starting with * - (org-kill-new - (with-temp-buffer - (insert return-content) - (goto-char 0) - (replace-regexp "^\*" ",*") - (buffer-string))) - (message "Transforming links...done, use C-y to insert text into Org-mode file")))) + ;; Add the rest until end of the region to be copied. + (when (< (point) transform-end) + (setq return-content + (concat return-content + (buffer-substring (point) transform-end)))) + ;; Quote lines starting with *. + (org-kill-new (replace-regexp-in-string "^\\*" ",*" return-content)) + (message "Transforming links...done, use C-y to insert text into Org mode file")))) ;; Additional keys for eww-mode @@ -161,9 +164,7 @@ the structure of the org file." (keymapp eww-mode-map)) ; eww is already up. (org-eww-extend-eww-keymap)) -(add-hook - 'eww-mode-hook - (lambda () (org-eww-extend-eww-keymap))) +(add-hook 'eww-mode-hook #'org-eww-extend-eww-keymap) (provide 'org-eww) diff --git a/lisp/org-faces.el b/lisp/org-faces.el index 941a604..96f7b8e 100644 --- a/lisp/org-faces.el +++ b/lisp/org-faces.el @@ -1,4 +1,4 @@ -;;; org-faces.el --- Face definitions for Org-mode. +;;; org-faces.el --- Face definitions -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -28,19 +28,12 @@ ;;; Code: -(require 'org-macs) -(require 'org-compat) - -(when (featurep 'xemacs) - (put 'mode-line 'face-alias 'modeline)) - (defgroup org-faces nil - "Faces in Org-mode." + "Faces in Org mode." :tag "Org Faces" :group 'org-appearance) -(defface org-default - (org-compatible-face 'default nil) +(defface org-default '((t :inherit default)) "Face used for default text." :group 'org-faces) @@ -52,99 +45,49 @@ The foreground color of this face should be equal to the background color of the frame." :group 'org-faces) -(defface org-level-1 ;; originally copied from font-lock-function-name-face - (org-compatible-face 'outline-1 - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) +(defface org-level-1 '((t :inherit outline-1)) "Face used for level 1 headlines." :group 'org-faces) -(defface org-level-2 ;; originally copied from font-lock-variable-name-face - (org-compatible-face 'outline-2 - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8) (background light)) (:foreground "yellow")) - (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) - (t (:bold t)))) +(defface org-level-2 '((t :inherit outline-2)) "Face used for level 2 headlines." :group 'org-faces) -(defface org-level-3 ;; originally copied from font-lock-keyword-face - (org-compatible-face 'outline-3 - '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) - (((class color) (min-colors 16) (background light)) (:foreground "Purple")) - (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) - (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) - (t (:bold t)))) +(defface org-level-3 '((t :inherit outline-3)) "Face used for level 3 headlines." :group 'org-faces) -(defface org-level-4 ;; originally copied from font-lock-comment-face - (org-compatible-face 'outline-4 - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 16) (background light)) (:foreground "red")) - (((class color) (min-colors 16) (background dark)) (:foreground "red1")) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) +(defface org-level-4 '((t :inherit outline-4)) "Face used for level 4 headlines." :group 'org-faces) -(defface org-level-5 ;; originally copied from font-lock-type-face - (org-compatible-face 'outline-5 - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")))) +(defface org-level-5 '((t :inherit outline-5)) "Face used for level 5 headlines." :group 'org-faces) -(defface org-level-6 ;; originally copied from font-lock-constant-face - (org-compatible-face 'outline-6 - '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) - (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 8)) (:foreground "magenta")))) +(defface org-level-6 '((t :inherit outline-6)) "Face used for level 6 headlines." :group 'org-faces) -(defface org-level-7 ;; originally copied from font-lock-builtin-face - (org-compatible-face 'outline-7 - '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 8)) (:foreground "blue")))) +(defface org-level-7 '((t :inherit outline-7)) "Face used for level 7 headlines." :group 'org-faces) -(defface org-level-8 ;; originally copied from font-lock-string-face - (org-compatible-face 'outline-8 - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8)) (:foreground "green")))) +(defface org-level-8 '((t :inherit outline-8)) "Face used for level 8 headlines." :group 'org-faces) -(defface org-special-keyword ;; originally copied from font-lock-string-face - (org-compatible-face 'font-lock-keyword-face - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (t (:italic t)))) +(defface org-special-keyword '((t :inherit font-lock-keyword-face)) "Face used for special keywords." :group 'org-faces) -(defface org-drawer ;; originally copied from font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) +(defface org-drawer ;Copied from `font-lock-function-name-face' + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t))) "Face used for drawers." :group 'org-faces) @@ -153,18 +96,17 @@ color of the frame." :group 'org-faces) (defface org-column - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) - (:background "grey90" :weight normal :slant normal :strike-through nil - :underline nil)) - (((class color) (min-colors 16) (background dark)) - (:background "grey30" :weight normal :slant normal :strike-through nil - :underline nil)) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black" - :weight normal :slant normal :strike-through nil - :underline nil)) - (t (:inverse-video t)))) + '((((class color) (min-colors 16) (background light)) + (:background "grey90" :weight normal :slant normal :strike-through nil + :underline nil)) + (((class color) (min-colors 16) (background dark)) + (:background "grey30" :weight normal :slant normal :strike-through nil + :underline nil)) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black" + :weight normal :slant normal :strike-through nil + :underline nil)) + (t (:inverse-video t))) "Face for column display of entry properties. This is actually only part of the face definition for the text in column view. The following faces apply, with this priority. @@ -185,59 +127,33 @@ character (this might for example be the a TODO keyword) might still shine through in some properties. So when your column view looks funny, with \"random\" colors, weight, strike-through, try to explicitly set the properties in the `org-column' face. For example, set -:underline to nil, or the :slant to `normal'. - -Under XEmacs, the rules are simpler, because the XEmacs version of -column view defines special faces for each outline level. See the file -`org-colview-xemacs.el' in Org's contrib/ directory for details." +:underline to nil, or the :slant to `normal'." :group 'org-faces) (defface org-column-title - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) - (:background "grey90" :underline t :weight bold)) - (((class color) (min-colors 16) (background dark)) - (:background "grey30" :underline t :weight bold)) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black" :underline t :weight bold)) - (t (:inverse-video t)))) + '((((class color) (min-colors 16) (background light)) + (:background "grey90" :underline t :weight bold)) + (((class color) (min-colors 16) (background dark)) + (:background "grey30" :underline t :weight bold)) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black" :underline t :weight bold)) + (t (:inverse-video t))) "Face for column display of entry properties." :group 'org-faces) -(defface org-agenda-column-dateline - (org-compatible-face 'org-column - '((t nil))) +(defface org-agenda-column-dateline '((t :inherit org-column)) "Face used in agenda column view for datelines with summaries." :group 'org-faces) -(defface org-warning - (org-compatible-face 'font-lock-warning-face - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) +(defface org-warning '((t :inherit font-lock-warning-face)) "Face for deadlines and TODO keywords." :group 'org-faces) -(defface org-archived ; similar to shadow - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) +(defface org-archived '((t :inherit shadow)) "Face for headline with the ARCHIVE tag." :group 'org-faces) -(defface org-link - (org-compatible-face 'link - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t)))) +(defface org-link '((t :inherit link)) "Face for links." :group 'org-faces) @@ -270,12 +186,11 @@ column view defines special faces for each outline level. See the file :group 'org-faces) (defface org-date-selected - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t)) - (t (:inverse-video t)))) + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t)) + (t (:inverse-video t))) "Face for highlighting the calendar day when using `org-read-date'. Using a bold face here might cause discrepancies while displaying the calendar." @@ -288,43 +203,38 @@ calendar." "Face for diary-like sexp date specifications." :group 'org-faces) -(defface org-tag - '((t (:bold t))) +(defface org-tag '((t (:bold t))) "Default face for tags. Note that the variable `org-tag-faces' can be used to overrule this face for specific tags." :group 'org-faces) -(defface org-list-dt - '((t (:bold t))) +(defface org-list-dt '((t (:bold t))) "Default face for definition terms in lists." :group 'org-faces) -(defface org-todo ; font-lock-warning-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:inverse-video t :bold t)))) +(defface org-todo ;Copied from `font-lock-warning-face' + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:inverse-video t :bold t))) "Face for TODO keywords." :group 'org-faces) -(defface org-done ;; originally copied from font-lock-type-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t)))) +(defface org-done ;Copied from `font-lock-type-face' + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t))) "Face used for todo keywords that indicate DONE items." :group 'org-faces) -(defface org-agenda-done ;; originally copied from font-lock-type-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold nil)))) +(defface org-agenda-done ;Copied from `font-lock-type-face' + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold nil))) "Face used in agenda, to indicate lines switched to DONE. This face is used to de-emphasize items that where brightly colored in the agenda because they were things to do, or overdue. The DONE state itself @@ -333,11 +243,10 @@ is of course immediately visible, but for example a passed deadline is of the frame, for example." :group 'org-faces) -(defface org-headline-done ;; originally copied from font-lock-string-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8) (background light)) (:bold nil)))) +(defface org-headline-done ;Copied from `font-lock-string-face' + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 8) (background light)) (:bold nil))) "Face used to indicate that a headline is DONE. This face is only used if `org-fontify-done-headline' is set. If applies to the part of the headline after the DONE keyword." @@ -375,11 +284,7 @@ determines if it is a foreground or a background color." (string :tag "Color") (sexp :tag "Face"))))) -(defface org-priority ;; originally copied from font-lock-string-face - (org-compatible-face 'font-lock-keyword-face - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (t (:italic t)))) +(defface org-priority '((t :inherit font-lock-keyword-face)) "Face used for priority cookies." :group 'org-faces) @@ -408,19 +313,15 @@ determines if it is a foreground or a background color." (setq org-tags-special-faces-re (concat ":\\(" (mapconcat 'car value "\\|") "\\):")))) -(defface org-checkbox - (org-compatible-face 'bold - '((t (:bold t)))) +(defface org-checkbox '((t :inherit bold)) "Face for checkboxes." :group 'org-faces) -(defface org-checkbox-statistics-todo - '((t (:inherit org-todo))) +(defface org-checkbox-statistics-todo '((t (:inherit org-todo))) "Face used for unfinished checkbox statistics." :group 'org-faces) -(defface org-checkbox-statistics-done - '((t (:inherit org-done))) +(defface org-checkbox-statistics-done '((t (:inherit org-done))) "Face used for finished checkbox statistics." :group 'org-faces) @@ -444,43 +345,31 @@ changes." (string :tag "Foreground color") (sexp :tag "Face"))))) -(defface org-table ;; originally copied from font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8) (background light)) (:foreground "blue")) - (((class color) (min-colors 8) (background dark))))) +(defface org-table ;Copied from `font-lock-function-name-face' + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8) (background light)) (:foreground "blue")) + (((class color) (min-colors 8) (background dark)))) "Face used for tables." :group 'org-faces) (defface org-formula - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red")) - (t (:bold t :italic t)))) + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red")) + (t (:bold t :italic t))) "Face for formulas." :group 'org-faces) -(defface org-code - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) +(defface org-code '((t :inherit shadow)) "Face for fixed-width text like code snippets." :group 'org-faces :version "22.1") -(defface org-meta-line - (org-compatible-face 'font-lock-comment-face nil) +(defface org-meta-line '((t :inherit font-lock-comment-face)) "Face for meta lines starting with \"#+\"." :group 'org-faces :version "22.1") @@ -500,64 +389,35 @@ changes." follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword." :group 'org-faces) -(defface org-document-info-keyword - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) +(defface org-document-info-keyword '((t :inherit shadow)) "Face for #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords." :group 'org-faces) -(defface org-block - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) - "Face text in #+begin ... #+end blocks." +(defface org-block '((t :inherit shadow)) + "Face text in #+begin ... #+end blocks. +For source-blocks `org-src-block-faces' takes precedence. +See also `org-fontify-quote-and-verse-blocks'." :group 'org-faces - :version "22.1") + :version "25.2") -(defface org-block-begin-line - '((t (:inherit org-meta-line))) +(defface org-block-begin-line '((t (:inherit org-meta-line))) "Face used for the line delimiting the begin of source blocks." :group 'org-faces) -(defface org-block-end-line - '((t (:inherit org-block-begin-line))) +(defface org-block-end-line '((t (:inherit org-block-begin-line))) "Face used for the line delimiting the end of source blocks." :group 'org-faces) -(defface org-verbatim - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50" :underline t)) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70" :underline t)) - (((class color) (min-colors 8) (background light)) - (:foreground "green" :underline t)) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow" :underline t)))) - "Face for fixed-with text like code snippets." +(defface org-verbatim '((t (:inherit shadow))) + "Face for fixed-with text like code snippets" :group 'org-faces :version "22.1") -(defface org-quote - '((t (:inherit org-block))) +(defface org-quote '((t (:inherit org-block))) "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks." :group 'org-faces) -(defface org-verse - '((t (:inherit org-block))) +(defface org-verse '((t (:inherit org-block))) "Face for #+BEGIN_VERSE ... #+END_VERSE blocks." :group 'org-faces) @@ -569,35 +429,32 @@ content of these blocks will still be treated as Org syntax." :version "24.1" :type 'boolean) -(defface org-clock-overlay ;; copied from secondary-selection - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) - (:background "LightGray" :foreground "black")) - (((class color) (min-colors 88) (background dark)) - (:background "SkyBlue4" :foreground "white")) - (((class color) (min-colors 16) (background light)) - (:background "gray" :foreground "black")) - (((class color) (min-colors 16) (background dark)) - (:background "SkyBlue4" :foreground "white")) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) +(defface org-clock-overlay ;Copied from `secondary-selection' + '((((class color) (min-colors 88) (background light)) + (:background "LightGray" :foreground "black")) + (((class color) (min-colors 88) (background dark)) + (:background "SkyBlue4" :foreground "white")) + (((class color) (min-colors 16) (background light)) + (:background "gray" :foreground "black")) + (((class color) (min-colors 16) (background dark)) + (:background "SkyBlue4" :foreground "white")) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black")) + (t (:inverse-video t))) "Basic face for displaying the secondary selection." :group 'org-faces) -(defface org-agenda-structure ;; originally copied from font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) +(defface org-agenda-structure ;Copied from `font-lock-function-name-face' + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t))) "Face used in agenda for captions and dates." :group 'org-faces) -(defface org-agenda-date - '((t (:inherit org-agenda-structure))) +(defface org-agenda-date '((t (:inherit org-agenda-structure))) "Face used in agenda for normal days." :group 'org-faces) @@ -606,13 +463,11 @@ content of these blocks will still be treated as Org syntax." "Face used in agenda for today." :group 'org-faces) -(defface org-agenda-clocking - '((t (:inherit secondary-selection))) +(defface org-agenda-clocking '((t (:inherit secondary-selection))) "Face marking the current clock item in the agenda." :group 'org-faces) -(defface org-agenda-date-weekend - '((t (:inherit org-agenda-date :weight bold))) +(defface org-agenda-date-weekend '((t (:inherit org-agenda-date :weight bold))) "Face used in agenda for weekend days. See the variable `org-agenda-weekend-days' for a definition of @@ -620,20 +475,18 @@ which days belong to the weekend." :group 'org-faces) (defface org-scheduled - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t :italic t)))) + '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) + (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t :italic t))) "Face for items scheduled for a certain day." :group 'org-faces) (defface org-scheduled-today - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t :italic t)))) + '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) + (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t :italic t))) "Face for items scheduled for a certain day." :group 'org-faces) @@ -644,22 +497,20 @@ which days belong to the weekend." :group 'org-faces) (defface org-scheduled-previously - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t))) "Face for items scheduled previously, and not yet done." :group 'org-faces) (defface org-upcoming-deadline - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t))) "Face for items scheduled previously, and not yet done." :group 'org-faces) @@ -689,67 +540,57 @@ month and 365.24 days for a year)." (sexp :tag "Face")))) (defface org-agenda-restriction-lock - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:background "#eeeeee")) - (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C")) - (((class color) (min-colors 16) (background light)) (:background "#eeeeee")) - (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C")) - (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) + '((((class color) (min-colors 88) (background light)) (:background "#eeeeee")) + (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C")) + (((class color) (min-colors 16) (background light)) (:background "#eeeeee")) + (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C")) + (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) + (t (:inverse-video t))) "Face for showing the agenda restriction lock." :group 'org-faces) -(defface org-agenda-filter-tags - (org-compatible-face 'mode-line nil) +(defface org-agenda-filter-tags '((t :inherit mode-line)) "Face for tag(s) in the mode-line when filtering the agenda." :group 'org-faces) -(defface org-agenda-filter-regexp - (org-compatible-face 'mode-line nil) +(defface org-agenda-filter-regexp '((t :inherit mode-line)) "Face for regexp(s) in the mode-line when filtering the agenda." :group 'org-faces) -(defface org-agenda-filter-category - (org-compatible-face 'mode-line nil) +(defface org-agenda-filter-category '((t :inherit mode-line)) "Face for categories(s) in the mode-line when filtering the agenda." :group 'org-faces) -(defface org-time-grid ;; originally copied from font-lock-variable-name-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) +(defface org-time-grid ;Copied from `font-lock-variable-name-face' + '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 8)) (:foreground "yellow" :weight light))) "Face used for time grids." :group 'org-faces) -(defface org-agenda-current-time - '((t (:inherit org-time-grid))) +(defface org-agenda-current-time '((t (:inherit org-time-grid))) "Face used to show the current time in the time grid." :group 'org-faces) -(defface org-agenda-diary - (org-compatible-face 'default nil) +(defface org-agenda-diary '((t :inherit default)) "Face used for agenda entries that come from the Emacs diary." :group 'org-faces) -(defface org-agenda-calendar-event - (org-compatible-face 'default nil) +(defface org-agenda-calendar-event '((t :inherit default)) "Face used to show events and appointments in the agenda." :group 'org-faces) -(defface org-agenda-calendar-sexp - (org-compatible-face 'default nil) +(defface org-agenda-calendar-sexp '((t :inherit default)) "Face used to show events computed from a S-expression." :group 'org-faces) (defconst org-level-faces '(org-level-1 org-level-2 org-level-3 org-level-4 - org-level-5 org-level-6 org-level-7 org-level-8 - )) + org-level-5 org-level-6 org-level-7 org-level-8)) (defcustom org-n-level-faces (length org-level-faces) "The number of different faces to be used for headlines. -Org-mode defines 8 different headline faces, so this can be at most 8. +Org mode defines 8 different headline faces, so this can be at most 8. If it is less than 8, the level-1 face gets re-used for level N+1 etc." :type 'integer :group 'org-faces) @@ -782,22 +623,19 @@ level org-n-level-faces" :version "24.4" :package-version '(Org . "8.0")) -(defface org-macro - (org-compatible-face 'org-latex-and-related nil) +(defface org-macro '((t :inherit org-latex-and-related)) "Face for macros." :group 'org-faces :version "24.4" :package-version '(Org . "8.0")) -(defface org-tag-group - (org-compatible-face 'org-tag nil) +(defface org-tag-group '((t :inherit org-tag)) "Face for group tags." :group 'org-faces :version "24.4" :package-version '(Org . "8.0")) -(defface org-mode-line-clock - '((t (:inherit mode-line))) +(defface org-mode-line-clock '((t (:inherit mode-line))) "Face used for clock display in mode line." :group 'org-faces) diff --git a/lisp/org-feed.el b/lisp/org-feed.el index 0600f63..0c3cd05 100644 --- a/lisp/org-feed.el +++ b/lisp/org-feed.el @@ -1,4 +1,4 @@ -;;; org-feed.el --- Add RSS feed items to Org files +;;; org-feed.el --- Add RSS feed items to Org files -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. ;; @@ -24,11 +24,11 @@ ;; ;;; Commentary: ;; -;; This module allows entries to be created and changed in an Org-mode -;; file triggered by items in an RSS feed. The basic functionality is -;; geared toward simply adding new items found in a feed as outline nodes -;; to an Org file. Using hooks, arbitrary actions can be triggered for -;; new or changed items. +;; This module allows entries to be created and changed in an Org mode +;; file triggered by items in an RSS feed. The basic functionality +;; is geared toward simply adding new items found in a feed as +;; outline nodes to an Org file. Using hooks, arbitrary actions can +;; be triggered for new or changed items. ;; ;; Selecting feeds and target locations ;; ------------------------------------ @@ -77,10 +77,8 @@ ;; org-feed.el needs to keep track of which feed items have been handled ;; before, so that they will not be handled again. For this, org-feed.el ;; stores information in a special drawer, FEEDSTATUS, under the heading -;; that received the input of the feed. You should add FEEDSTATUS -;; to your list of drawers in the files that receive feed input: +;; that received the input of the feed. ;; -;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS ;; ;; Acknowledgments ;; --------------- @@ -93,7 +91,8 @@ (require 'org) (require 'sha1) -(declare-function url-retrieve-synchronously "url" (url)) +(declare-function url-retrieve-synchronously "url" + (url &optional silent inhibit-cookies timeout)) (declare-function xml-node-children "xml" (node)) (declare-function xml-get-children "xml" (node child-name)) (declare-function xml-get-attribute "xml" (node attribute)) @@ -101,8 +100,8 @@ (declare-function xml-substitute-special "xml" (string)) (declare-function org-capture-escaped-% "org-capture" ()) +(declare-function org-capture-expand-embedded-elisp "org-capture" (&optional mark)) (declare-function org-capture-inside-embedded-elisp-p "org-capture" ()) -(declare-function org-capture-expand-embedded-elisp "org-capture" ()) (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." @@ -314,7 +313,7 @@ it can be a list structured like an entry in `org-feed-alist'." (parse-entry (or (nth 1 (memq :parse-entry feed)) 'org-feed-parse-rss-entry)) feed-buffer inbox-pos new-formatted - entries old-status status new changed guid-alist e guid olds) + entries old-status status new changed guid-alist guid olds) (setq feed-buffer (org-feed-get-feed url)) (unless (and feed-buffer (bufferp (get-buffer feed-buffer))) (error "Cannot get feed %s" name)) @@ -407,7 +406,7 @@ it can be a list structured like an entry in `org-feed-alist'." ;; Normalize the visibility of the inbox tree (goto-char inbox-pos) (outline-hide-subtree) - (outline-show-children) + (org-show-children) (org-cycle-hide-drawers 'children) ;; Hooks and messages @@ -441,7 +440,7 @@ it can be a list structured like an entry in `org-feed-alist'." (if (stringp feed) (setq feed (assoc feed org-feed-alist))) (unless feed (error "No such feed in `org-feed-alist")) - (org-pop-to-buffer-same-window + (pop-to-buffer-same-window (org-feed-update feed 'retrieve-only)) (goto-char (point-min))) @@ -476,8 +475,7 @@ This will find DRAWER and extract the alist." "Write the feed STATUS to DRAWER in entry at POS." (save-excursion (goto-char pos) - (let ((end (save-excursion (org-end-of-subtree t t))) - guid) + (let ((end (save-excursion (org-end-of-subtree t t)))) (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*\n") end t) (progn @@ -513,66 +511,77 @@ ENTRY is a property list. This function adds a `:formatted-for-org' property and returns the full property list. If that property is already present, nothing changes." (require 'org-capture) - (if formatter - (funcall formatter entry) - (let (dlines time escape name tmp - v-h v-t v-T v-u v-U v-a) - (setq dlines (org-split-string (or (plist-get entry :description) "???") - "\n") - v-h (or (plist-get entry :title) (car dlines) "???") - time (or (if (plist-get entry :pubDate) - (org-read-date t t (plist-get entry :pubDate))) - (current-time)) - v-t (format-time-string (org-time-stamp-format nil nil) time) - v-T (format-time-string (org-time-stamp-format t nil) time) - v-u (format-time-string (org-time-stamp-format nil t) time) - v-U (format-time-string (org-time-stamp-format t t) time) - v-a (if (setq tmp (or (and (plist-get entry :guid-permalink) - (plist-get entry :guid)) - (plist-get entry :link))) - (concat "[[" tmp "]]\n") - "")) + (if formatter (funcall formatter entry) + (let* ((dlines + (org-split-string (or (plist-get entry :description) "???") + "\n")) + (time (or (if (plist-get entry :pubDate) + (org-read-date t t (plist-get entry :pubDate))) + (current-time))) + (v-h (or (plist-get entry :title) (car dlines) "???")) + (v-t (format-time-string (org-time-stamp-format nil nil) time)) + (v-T (format-time-string (org-time-stamp-format t nil) time)) + (v-u (format-time-string (org-time-stamp-format nil t) time)) + (v-U (format-time-string (org-time-stamp-format t t) time)) + (v-a (let ((tmp (or (and (plist-get entry :guid-permalink) + (plist-get entry :guid)) + (plist-get entry :link)))) + (if tmp (format "[[%s]]\n" tmp ) "")))) (with-temp-buffer - (insert template) - - ;; Simple %-escapes - ;; before embedded elisp to support simple %-escapes as - ;; arguments for embedded elisp - (goto-char (point-min)) - (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t) - (unless (org-capture-escaped-%) - (setq name (match-string 1) - escape (org-capture-inside-embedded-elisp-p)) - (cond - ((member name '("h" "t" "T" "u" "U" "a")) - (setq tmp (symbol-value (intern (concat "v-" name))))) - ((setq tmp (plist-get entry (intern (concat ":" name)))) - (save-excursion - (save-match-data - (beginning-of-line 1) - (when (looking-at - (concat "^\\([ \t]*\\)%" name "[ \t]*$")) - (setq tmp (org-feed-make-indented-block - tmp (org-get-indentation)))))))) - (when tmp - ;; escape string delimiters `"' when inside %() embedded lisp - (when escape - (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp))) - (replace-match tmp t t)))) - - ;; %() embedded elisp - (org-capture-expand-embedded-elisp) - - (decode-coding-string - (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) + (insert template) + (goto-char (point-min)) + + ;; Mark %() embedded elisp for later evaluation. + (org-capture-expand-embedded-elisp 'mark) + + ;; Simple %-escapes. `org-capture-escaped-%' may modify + ;; buffer and cripple match-data. Use markers instead. + (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t) + (let ((key (match-string 1)) + (beg (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0)))) + (unless (org-capture-escaped-%) + (delete-region beg end) + (set-marker beg nil) + (set-marker end nil) + (let ((replacement + (pcase key + ("h" v-h) + ("t" v-t) + ("T" v-T) + ("u" v-u) + ("U" v-U) + ("a" v-a) + (name + (let ((v (plist-get entry (intern (concat ":" name))))) + (save-excursion + (save-match-data + (beginning-of-line) + (if (looking-at + (concat "^\\([ \t]*\\)%" name "[ \t]*$")) + (org-feed-make-indented-block + v (org-get-indentation)) + v)))))))) + (when replacement + (insert + ;; Escape string delimiters within embedded lisp. + (if (org-capture-inside-embedded-elisp-p) + (replace-regexp-in-string "\"" "\\\\\"" replacement) + replacement))))))) + + ;; %() embedded elisp + (org-capture-expand-embedded-elisp) + + (decode-coding-string + (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) (defun org-feed-make-indented-block (s n) "Add indentation of N spaces to a multiline string S." (if (not (string-match "\n" s)) s (mapconcat 'identity - (org-split-string s "\n") - (concat "\n" (make-string n ?\ ))))) + (org-split-string s "\n") + (concat "\n" (make-string n ?\ ))))) (defun org-feed-skip-http-headers (buffer) "Remove HTTP headers from BUFFER, and return it. @@ -616,7 +625,7 @@ containing the properties `:guid' and `:item-full-text'." (match-beginning 0))) (setq item (buffer-substring beg end) guid (if (string-match "<guid\\>.*?>\\(.*?\\)</guid>" item) - (xml-substitute-special (org-match-string-no-properties 1 item)))) + (xml-substitute-special (match-string-no-properties 1 item)))) (setq entry (list :guid guid :item-full-text item)) (push entry entries) (widen) diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index 800b5df..5b60a19 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -1,4 +1,4 @@ -;;; org-footnote.el --- Footnote support in Org and elsewhere +;;; org-footnote.el --- Footnote support in Org -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. ;; @@ -24,33 +24,28 @@ ;; ;;; Commentary: -;; This file contains the code dealing with footnotes in Org-mode. -;; The code can also be used in arbitrary text modes to provide -;; footnotes. Compared to Steven L Baur's footnote.el it provides -;; better support for resuming editing. It is less configurable than -;; Steve's code, though. +;; This file contains the code dealing with footnotes in Org mode. ;;; Code: -(eval-when-compile - (require 'cl)) +;;;; Declarations + +(require 'cl-lib) (require 'org-macs) (require 'org-compat) -(declare-function message-point-in-header-p "message" ()) (declare-function org-at-comment-p "org" ()) (declare-function org-at-heading-p "org" (&optional ignored)) (declare-function org-back-over-empty-lines "org" ()) -(declare-function org-back-to-heading "org" (&optional invisible-ok)) -(declare-function org-combine-plists "org" (&rest plists)) (declare-function org-edit-footnote-reference "org-src" ()) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-class "org-element" (datum &optional parent)) (declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-lineage "org-element" (blob &optional types with-self)) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-fill-paragraph "org" (&optional justify)) -(declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-id-uuid "org-id" ()) (declare-function org-in-block-p "org" (names)) (declare-function org-in-regexp "org" (re &optional nlines visually)) (declare-function org-in-verbatim-emphasis "org" ()) @@ -58,45 +53,39 @@ (declare-function org-inside-latex-macro-p "org" ()) (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function org-show-context "org" (&optional key)) -(declare-function org-skip-whitespace "org" ()) -(declare-function org-skip-whitespace "org" ()) -(declare-function org-trim "org" (s)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function outline-next-heading "outline") -(defvar message-cite-prefix-regexp) ; defined in message.el -(defvar message-signature-separator) ; defined in message.el +(defvar electric-indent-mode) +(defvar org-blank-before-new-entry) ; defined in org.el (defvar org-bracket-link-regexp) ; defined in org.el (defvar org-complex-heading-regexp) ; defined in org.el -(defvar org-element-all-elements) ; defined in org-element.el -(defvar org-element-all-objects) ; defined in org-element.el (defvar org-odd-levels-only) ; defined in org.el +(defvar org-outline-regexp) ; defined in org.el (defvar org-outline-regexp-bol) ; defined in org.el + +;;;; Constants + (defconst org-footnote-re - ;; Only [1]-like footnotes are closed in this regexp, as footnotes - ;; from other types might contain square brackets (i.e. links) in - ;; their definition. - ;; - ;; `org-re' is used for regexp compatibility with XEmacs. - (concat "\\[\\(?:" - ;; Match inline footnotes. - (org-re "fn:\\([-_[:word:]]+\\)?:\\|") - ;; Match other footnotes. - "\\(?:\\([0-9]+\\)\\]\\)\\|" - (org-re "\\(fn:[-_[:word:]]+\\)") - "\\)") - "Regular expression for matching footnotes.") - -(defconst org-footnote-definition-re - (org-re "^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]") - "Regular expression matching the definition of a footnote.") - -(defconst org-footnote-forbidden-blocks - '("ascii" "beamer" "comment" "example" "html" "latex" "odt" "src") + "\\[fn:\\(?:\\(?1:[-_[:word:]]+\\)?\\(:\\)\\|\\(?1:[-_[:word:]]+\\)\\]\\)" + "Regular expression for matching footnotes. +Match group 1 contains footnote's label. It is nil for anonymous +footnotes. Match group 2 is non-nil only when footnote is +inline, i.e., it contains its own definition.") + +(defconst org-footnote-definition-re "^\\[fn:\\([-_[:word:]]+\\)\\]" + "Regular expression matching the definition of a footnote. +Match group 1 contains definition's label.") + +(defconst org-footnote-forbidden-blocks '("comment" "example" "export" "src") "Names of blocks where footnotes are not allowed.") + +;;;; Customization + (defgroup org-footnote nil - "Footnotes in Org-mode." + "Footnotes in Org mode." :tag "Org Footnote" :group 'org) @@ -118,7 +107,7 @@ this heading will be ignored. If you don't use the customize interface to change this variable, you will need to run the following command after the change: - \\[universal-argument] \\[org-element-cache-reset]" + `\\[universal-argument] \\[org-element-cache-reset]'" :group 'org-footnote :initialize 'custom-initialize-default :set (lambda (var val) @@ -129,20 +118,6 @@ you will need to run the following command after the change: (string :tag "Collect footnotes under heading") (const :tag "Define footnotes locally" nil))) -(defcustom org-footnote-tag-for-non-org-mode-files "Footnotes:" - "Tag marking the beginning of footnote section. -The Org footnote engine can be used in arbitrary text files as well -as in Org-mode. Outside Org mode, new footnotes are always placed at -the end of the file. When you normalize the notes, any line containing -only this tag will be removed, a new one will be inserted at the end -of the file, followed by the collected and normalized footnotes. - -If you don't want any tag in such buffers, set this variable to nil." - :group 'org-footnote - :type '(choice - (string :tag "Collect footnotes under tag") - (const :tag "Don't use a tag" nil))) - (defcustom org-footnote-define-inline nil "Non-nil means define footnotes inline, at reference location. When nil, footnotes will be defined in a special section near @@ -160,15 +135,13 @@ t Create unique labels of the form [fn:1], [fn:2], etc. confirm Like t, but let the user edit the created value. The label can be removed from the minibuffer to create an anonymous footnote. -random Automatically generate a unique, random label. -plain Automatically create plain number labels like [1]." +random Automatically generate a unique, random label." :group 'org-footnote :type '(choice (const :tag "Prompt for label" nil) (const :tag "Create automatic [fn:N]" t) (const :tag "Offer automatic [fn:N] for editing" confirm) - (const :tag "Create a random label" random) - (const :tag "Create automatic [N]" plain))) + (const :tag "Create a random label" random))) (defcustom org-footnote-auto-adjust nil "Non-nil means automatically adjust footnotes after insert/delete. @@ -196,6 +169,9 @@ extracted will be filled again." :group 'org-footnote :type 'boolean) + +;;;; Predicates + (defun org-footnote-in-valid-context-p () "Is point in a context where footnotes are allowed?" (save-match-data @@ -206,12 +182,6 @@ extracted will be filled again." (save-excursion (beginning-of-line) (looking-at "[ \t]*:[ \t]+")) - ;; Avoid cited text and headers in message-mode. - (and (derived-mode-p 'message-mode) - (or (save-excursion - (beginning-of-line) - (looking-at message-cite-prefix-regexp)) - (message-point-in-header-p))) ;; Avoid forbidden blocks. (org-in-block-p org-footnote-forbidden-blocks))))) @@ -224,13 +194,9 @@ positions, and the definition, when inlined." (or (looking-at org-footnote-re) (org-in-regexp org-footnote-re) (save-excursion (re-search-backward org-footnote-re nil t))) - (/= (match-beginning 0) (point-at-bol))) + (/= (match-beginning 0) (line-beginning-position))) (let* ((beg (match-beginning 0)) - (label (or (org-match-string-no-properties 2) - (org-match-string-no-properties 3) - ;; Anonymous footnotes don't have labels - (and (match-string 1) - (concat "fn:" (org-match-string-no-properties 1))))) + (label (match-string-no-properties 1)) ;; Inline footnotes don't end at (match-end 0) as ;; `org-footnote-re' stops just after the second colon. ;; Find the real ending with `scan-sexps', so Org doesn't @@ -238,7 +204,8 @@ positions, and the definition, when inlined." (end (ignore-errors (scan-sexps beg 1)))) ;; Point is really at a reference if it's located before true ;; ending of the footnote. - (when (and end (< (point) end) + (when (and end + (< (point) end) ;; Verify match isn't a part of a link. (not (save-excursion (goto-char beg) @@ -250,9 +217,10 @@ positions, and the definition, when inlined." (not (org-inside-latex-macro-p))) (list label beg end ;; Definition: ensure this is an inline footnote first. - (and (or (not label) (match-string 1)) - (org-trim (buffer-substring-no-properties - (match-end 0) (1- end))))))))) + (and (match-end 2) + (org-trim + (buffer-substring-no-properties + (match-end 0) (1- end))))))))) (defun org-footnote-at-definition-p () "Is point within a footnote definition? @@ -275,26 +243,224 @@ otherwise." (concat org-outline-regexp-bol "\\|^\\([ \t]*\n\\)\\{2,\\}") nil t)))) (when (re-search-backward org-footnote-definition-re lim t) - (let ((label (org-match-string-no-properties 1)) + (let ((label (match-string-no-properties 1)) (beg (match-beginning 0)) (beg-def (match-end 0)) - ;; In message-mode, do not search after signature. - (end (let ((bound (and (derived-mode-p 'message-mode) - (save-excursion - (goto-char (point-max)) - (re-search-backward - message-signature-separator nil t))))) - (if (progn - (end-of-line) - (re-search-forward - (concat org-outline-regexp-bol "\\|" - org-footnote-definition-re "\\|" - "^\\([ \t]*\n\\)\\{2,\\}") bound 'move)) - (match-beginning 0) - (point))))) + (end (if (progn + (end-of-line) + (re-search-forward + (concat org-outline-regexp-bol "\\|" + org-footnote-definition-re "\\|" + "^\\([ \t]*\n\\)\\{2,\\}") nil 'move)) + (match-beginning 0) + (point)))) (list label beg end (org-trim (buffer-substring-no-properties beg-def end))))))))) + +;;;; Internal functions + +(defun org-footnote--allow-reference-p () + "Non-nil when a footnote reference can be inserted at point." + ;; XXX: This is similar to `org-footnote-in-valid-context-p' but + ;; more accurate and usually faster, except in some corner cases. + ;; It may replace it after doing proper benchmarks as it would be + ;; used in fontification. + (unless (bolp) + (let* ((context (org-element-context)) + (type (org-element-type context))) + (cond + ;; No footnote reference in attributes. + ((let ((post (org-element-property :post-affiliated context))) + (and post (< (point) post))) + nil) + ;; Paragraphs and blank lines at top of document are fine. + ((memq type '(nil paragraph))) + ;; So are contents of verse blocks. + ((eq type 'verse-block) + (and (>= (point) (org-element-property :contents-begin context)) + (< (point) (org-element-property :contents-end context)))) + ;; In an headline or inlinetask, point must be either on the + ;; heading itself or on the blank lines below. + ((memq type '(headline inlinetask)) + (or (not (org-at-heading-p)) + (and (save-excursion + (beginning-of-line) + (and (let ((case-fold-search t)) + (not (looking-at-p "\\*+ END[ \t]*$"))) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)))) + (match-beginning 4) + (>= (point) (match-beginning 4)) + (or (not (match-beginning 5)) + (< (point) (match-beginning 5)))))) + ;; White spaces after an object or blank lines after an element + ;; are OK. + ((>= (point) + (save-excursion (goto-char (org-element-property :end context)) + (skip-chars-backward " \r\t\n") + (if (eq (org-element-class context) 'object) (point) + (1+ (line-beginning-position 2)))))) + ;; Other elements are invalid. + ((eq (org-element-class context) 'element) nil) + ;; Just before object is fine. + ((= (point) (org-element-property :begin context))) + ;; Within recursive object too, but not in a link. + ((eq type 'link) nil) + ((let ((cbeg (org-element-property :contents-begin context)) + (cend (org-element-property :contents-end context))) + (and cbeg (>= (point) cbeg) (<= (point) cend)))))))) + +(defun org-footnote--clear-footnote-section () + "Remove all footnote sections in buffer and create a new one. +New section is created at the end of the buffer, before any file +local variable definition. Leave point within the new section." + (when org-footnote-section + (goto-char (point-min)) + (let ((regexp + (format "^\\*+ +%s[ \t]*$" + (regexp-quote org-footnote-section)))) + (while (re-search-forward regexp nil t) + (delete-region + (match-beginning 0) + (progn (org-end-of-subtree t t) + (if (not (eobp)) (point) + (org-footnote--goto-local-insertion-point) + (skip-chars-forward " \t\n") + (if (eobp) (point) (line-beginning-position))))))) + (goto-char (point-max)) + (org-footnote--goto-local-insertion-point) + (when (and (cdr (assq 'heading org-blank-before-new-entry)) + (zerop (save-excursion (org-back-over-empty-lines)))) + (insert "\n")) + (insert "* " org-footnote-section "\n"))) + +(defun org-footnote--set-label (label) + "Set label of footnote at point to string LABEL. +Assume point is at the beginning of the reference or definition +to rename." + (forward-char 4) + (cond ((eq (char-after) ?:) (insert label)) + ((looking-at "\\([-_[:word:]]+\\)") (replace-match label nil nil nil 1)) + (t nil))) + +(defun org-footnote--collect-references (&optional anonymous) + "Collect all labelled footnote references in current buffer. + +Return an alist where associations follow the pattern + + (LABEL MARKER TOP-LEVEL SIZE) + +with + + LABEL the label of the of the definition, + MARKER a marker pointing to its beginning, + TOP-LEVEL a boolean, nil when the footnote is contained within + another one, + SIZE the length of the inline definition, in characters, + or nil for non-inline references. + +When optional ANONYMOUS is non-nil, also collect anonymous +references. In such cases, LABEL is nil. + +References are sorted according to a deep-reading order." + (org-with-wide-buffer + (goto-char (point-min)) + (let ((regexp (if anonymous org-footnote-re "\\[fn:[-_[:word:]]+[]:]")) + references nested) + (save-excursion + (while (re-search-forward regexp nil t) + ;; Ignore definitions. + (unless (and (eq (char-before) ?\]) + (= (line-beginning-position) (match-beginning 0))) + ;; Ensure point is within the reference before parsing it. + (backward-char) + (let ((object (org-element-context))) + (when (eq (org-element-type object) 'footnote-reference) + (let* ((label (org-element-property :label object)) + (begin (org-element-property :begin object)) + (size + (and (eq (org-element-property :type object) 'inline) + (- (org-element-property :contents-end object) + (org-element-property :contents-begin object))))) + (let ((d (org-element-lineage object '(footnote-definition)))) + (push (list label (copy-marker begin) (not d) size) + references) + (when d + ;; Nested references are stored in alist NESTED. + ;; Associations there follow the pattern + ;; + ;; (DEFINITION-LABEL . REFERENCES) + (let* ((def-label (org-element-property :label d)) + (labels (assoc def-label nested))) + (if labels (push label (cdr labels)) + (push (list def-label label) nested))))))))))) + ;; Sort the list of references. Nested footnotes have priority + ;; over top-level ones. + (letrec ((ordered nil) + (add-reference + (lambda (ref allow-nested) + (when (or allow-nested (nth 2 ref)) + (push ref ordered) + (dolist (r (mapcar (lambda (l) (assoc l references)) + (reverse + (cdr (assoc (nth 0 ref) nested))))) + (funcall add-reference r t)))))) + (dolist (r (reverse references) (nreverse ordered)) + (funcall add-reference r nil)))))) + +(defun org-footnote--collect-definitions (&optional delete) + "Collect all footnote definitions in current buffer. + +Return an alist where associations follow the pattern + + (LABEL . DEFINITION) + +with LABEL and DEFINITION being, respectively, the label and the +definition of the footnote, as strings. + +When optional argument DELETE is non-nil, delete the definition +while collecting them." + (org-with-wide-buffer + (goto-char (point-min)) + (let (definitions seen) + (while (re-search-forward org-footnote-definition-re nil t) + (backward-char) + (let ((element (org-element-at-point))) + (let ((label (org-element-property :label element))) + (when (and (eq (org-element-type element) 'footnote-definition) + (not (member label seen))) + (push label seen) + (let* ((beg (progn + (goto-char (org-element-property :begin element)) + (skip-chars-backward " \r\t\n") + (if (bobp) (point) (line-beginning-position 2)))) + (end (progn + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2))) + (def (org-trim (buffer-substring-no-properties beg end)))) + (push (cons label def) definitions) + (when delete (delete-region beg end))))))) + definitions))) + +(defun org-footnote--goto-local-insertion-point () + "Find insertion point for footnote, just before next outline heading. +Assume insertion point is within currently accessible part of the buffer." + (org-with-limited-levels (outline-next-heading)) + ;; Skip file local variables. See `modify-file-local-variable'. + (when (eobp) + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*# +Local Variables:" + (max (- (point-max) 3000) (point-min)) + t))) + (skip-chars-backward " \t\n") + (forward-line) + (unless (bolp) (insert "\n"))) + + +;;;; Navigation + (defun org-footnote-get-next-reference (&optional label backward limit) "Return complete reference of the next footnote. @@ -305,7 +471,7 @@ the buffer position bounding the search. Return value is a list like those provided by `org-footnote-at-reference-p'. If no footnote is found, return nil." (save-excursion - (let* ((label-fmt (if label (format "\\[%s[]:]" label) org-footnote-re))) + (let* ((label-fmt (if label (format "\\[fn:%s[]:]" label) org-footnote-re))) (catch 'exit (while t (unless (funcall (if backward #'re-search-backward #'re-search-forward) @@ -329,45 +495,19 @@ If no footnote is found, return nil." (unless (re-search-forward org-footnote-re limit t) (goto-char origin) (throw 'exit nil)) - ;; Beware: with [1]-like footnotes point will be just after + ;; Beware: with non-inline footnotes point will be just after ;; the closing square bracket. (backward-char) (cond ((setq ref (org-footnote-at-reference-p)) (throw 'exit ref)) - ;; Definition: also grab the last square bracket, only - ;; matched in `org-footnote-re' for [1]-like footnotes. + ;; Definition: also grab the last square bracket, matched in + ;; `org-footnote-re' for non-inline footnotes. ((save-match-data (org-footnote-at-definition-p)) (let ((end (match-end 0))) (throw 'exit (list nil (match-beginning 0) - (if (eq (char-before end) 93) end (1+ end))))))))))) - -(defun org-footnote-get-definition (label) - "Return label, boundaries and definition of the footnote LABEL." - (let* ((label (regexp-quote (org-footnote-normalize-label label))) - (re (format "^\\[%s\\]\\|.\\[%s:" label label))) - (org-with-wide-buffer - (goto-char (point-min)) - (catch 'found - (while (re-search-forward re nil t) - (let* ((datum (progn (backward-char) (org-element-context))) - (type (org-element-type datum))) - (when (memq type '(footnote-definition footnote-reference)) - (throw 'found - (list - label - (org-element-property :begin datum) - (org-element-property :end datum) - (let ((cbeg (org-element-property :contents-begin datum))) - (if (not cbeg) "" - (replace-regexp-in-string - "[ \t\n]*\\'" - "" - (buffer-substring-no-properties - cbeg - (org-element-property :contents-end datum)))))))))) - nil)))) + (if (eq (char-before end) ?\]) end (1+ end))))))))))) (defun org-footnote-goto-definition (label &optional location) "Move point to the definition of the footnote LABEL. @@ -379,7 +519,8 @@ Throw an error if there is no definition or if it cannot be reached from current narrowed part of buffer. Return a non-nil value if point was successfully moved." (interactive "sLabel: ") - (let ((def-start (or location (nth 1 (org-footnote-get-definition label))))) + (let* ((label (org-footnote-normalize-label label)) + (def-start (or location (nth 1 (org-footnote-get-definition label))))) (cond ((not def-start) (user-error "Cannot find definition of footnote %s" label)) @@ -387,21 +528,21 @@ value if point was successfully moved." (user-error "Definition is outside narrowed part of buffer"))) (org-mark-ring-push) (goto-char def-start) - (looking-at (format "\\[%s[]:] ?" label)) + (looking-at (format "\\[fn:%s[]:] ?" (regexp-quote label))) (goto-char (match-end 0)) (org-show-context 'link-search) (when (derived-mode-p 'org-mode) - (message - (substitute-command-keys - "Edit definition and go back with `\\[org-mark-ring-goto]' or, if \ -unique, with `\\[org-ctrl-c-ctrl-c]'."))) + (message "%s" (substitute-command-keys + "Edit definition and go back with \ +`\\[org-mark-ring-goto]' or, if unique, with `\\[org-ctrl-c-ctrl-c]'."))) t)) (defun org-footnote-goto-previous-reference (label) "Find the first closest (to point) reference of footnote with label LABEL." (interactive "sLabel: ") (org-mark-ring-push) - (let* ((label (org-footnote-normalize-label label)) ref) + (let ((label (org-footnote-normalize-label label)) + ref) (save-excursion (setq ref (or (org-footnote-get-next-reference label t) (org-footnote-get-next-reference label) @@ -415,111 +556,74 @@ unique, with `\\[org-ctrl-c-ctrl-c]'."))) (goto-char (nth 1 ref)) (org-show-context 'link-search)))) + +;;;; Getters + (defun org-footnote-normalize-label (label) - "Return LABEL as an appropriate string." - (cond - ((numberp label) (number-to-string label)) - ((equal "" label) nil) - ((not (string-match "^[0-9]+$\\|^fn:" label)) - (concat "fn:" label)) - (t label))) - -(defun org-footnote-all-labels (&optional with-defs) - "Return list with all defined foot labels used in the buffer. - -If WITH-DEFS is non-nil, also associate the definition to each -label. The function will then return an alist whose key is label -and value definition." - (let* (rtn - (push-to-rtn - (function - ;; Depending on WITH-DEFS, store label or (label . def) of - ;; footnote reference/definition given as argument in RTN. - (lambda (el) - (let ((lbl (car el))) - (push (if with-defs (cons lbl (nth 3 el)) lbl) rtn)))))) - (save-excursion - (save-restriction - (widen) - ;; Find all labels found in definitions. - (goto-char (point-min)) - (let (def) - (while (re-search-forward org-footnote-definition-re nil t) - (when (setq def (org-footnote-at-definition-p)) - (funcall push-to-rtn def)))) - ;; Find all labels found in references. - (goto-char (point-min)) - (let (ref) - (while (setq ref (org-footnote-get-next-reference)) - (goto-char (nth 2 ref)) - (and (car ref) ; ignore anonymous footnotes - (not (funcall (if with-defs #'assoc #'member) (car ref) rtn)) - (funcall push-to-rtn ref)))))) - rtn)) + "Return LABEL without \"fn:\" prefix. +If LABEL is the empty string or constituted of white spaces only, +return nil instead." + (pcase (org-trim label) + ("" nil) + ((pred (string-prefix-p "fn:")) (substring label 3)) + (_ label))) + +(defun org-footnote-get-definition (label) + "Return label, boundaries and definition of the footnote LABEL." + (let* ((label (regexp-quote (org-footnote-normalize-label label))) + (re (format "^\\[fn:%s\\]\\|.\\[fn:%s:" label label))) + (org-with-wide-buffer + (goto-char (point-min)) + (catch 'found + (while (re-search-forward re nil t) + (let* ((datum (progn (backward-char) (org-element-context))) + (type (org-element-type datum))) + (when (memq type '(footnote-definition footnote-reference)) + (throw 'found + (list + label + (org-element-property :begin datum) + (org-element-property :end datum) + (let ((cbeg (org-element-property :contents-begin datum))) + (if (not cbeg) "" + (replace-regexp-in-string + "[ \t\n]*\\'" + "" + (buffer-substring-no-properties + cbeg + (org-element-property :contents-end datum)))))))))) + nil)))) + +(defun org-footnote-all-labels () + "List all defined footnote labels used throughout the buffer. +This function ignores narrowing, if any." + (org-with-wide-buffer + (goto-char (point-min)) + (let (all) + (while (re-search-forward org-footnote-re nil t) + (backward-char) + (let ((context (org-element-context))) + (when (memq (org-element-type context) + '(footnote-definition footnote-reference)) + (let ((label (org-element-property :label context))) + (when label (cl-pushnew label all :test #'equal)))))) + all))) (defun org-footnote-unique-label (&optional current) "Return a new unique footnote label. -The function returns the first \"fn:N\" or \"N\" label that is -currently not used. +The function returns the first numeric label currently unused. Optional argument CURRENT is the list of labels active in the buffer." - (unless current (setq current (org-footnote-all-labels))) - (let ((fmt (if (eq org-footnote-auto-label 'plain) "%d" "fn:%d")) - (cnt 1)) - (while (member (format fmt cnt) current) - (incf cnt)) - (format fmt cnt))) + (let ((current (or current (org-footnote-all-labels)))) + (let ((count 1)) + (while (member (number-to-string count) current) + (cl-incf count)) + (number-to-string count)))) -(defun org-footnote--allow-reference-p () - "Non-nil when a footnote reference can be inserted at point." - ;; XXX: This is similar to `org-footnote-in-valid-context-p' but - ;; more accurate and usually faster, except in some corner cases. - ;; It may replace it after doing proper benchmarks as it would be - ;; used in fontification. - (unless (bolp) - (let* ((context (org-element-context)) - (type (org-element-type context))) - (cond - ;; No footnote reference in attributes. - ((let ((post (org-element-property :post-affiliated context))) - (and post (< (point) post))) - nil) - ;; Paragraphs and blank lines at top of document are fine. - ((memq type '(nil paragraph))) - ;; So are contents of verse blocks. - ((eq type 'verse-block) - (and (>= (point) (org-element-property :contents-begin context)) - (< (point) (org-element-property :contents-end context)))) - ;; In an headline or inlinetask, point must be either on the - ;; heading itself or on the blank lines below. - ((memq type '(headline inlinetask)) - (or (not (org-at-heading-p)) - (and (save-excursion (beginning-of-line) - (and (let ((case-fold-search t)) - (not (looking-at "\\*+ END[ \t]*$"))) - (looking-at org-complex-heading-regexp))) - (match-beginning 4) - (>= (point) (match-beginning 4)) - (or (not (match-beginning 5)) - (< (point) (match-beginning 5)))))) - ;; White spaces after an object or blank lines after an element - ;; are OK. - ((>= (point) - (save-excursion (goto-char (org-element-property :end context)) - (skip-chars-backward " \r\t\n") - (if (memq type org-element-all-objects) (point) - (1+ (line-beginning-position 2)))))) - ;; Other elements are invalid. - ((memq type org-element-all-elements) nil) - ;; Just before object is fine. - ((= (point) (org-element-property :begin context))) - ;; Within recursive object too, but not in a link. - ((eq type 'link) nil) - ((let ((cbeg (org-element-property :contents-begin context)) - (cend (org-element-property :contents-end context))) - (and cbeg (>= (point) cbeg) (<= (point) cend)))))))) + +;;;; Adding, Deleting Footnotes (defun org-footnote-new () "Insert a new footnote. @@ -531,12 +635,12 @@ or new, let the user edit the definition of the footnote." (user-error "Cannot insert a footnote here")) (let* ((all (org-footnote-all-labels)) (label - (org-footnote-normalize-label - (if (eq org-footnote-auto-label 'random) - (format "fn:%x" (random most-positive-fixnum)) + (if (eq org-footnote-auto-label 'random) + (format "%x" (random most-positive-fixnum)) + (org-footnote-normalize-label (let ((propose (org-footnote-unique-label all))) - (if (memq org-footnote-auto-label '(t plain)) propose - (org-icompleting-read + (if (eq org-footnote-auto-label t) propose + (completing-read "Label (leave empty for anonymous): " (mapcar #'list all) nil nil (and (eq org-footnote-auto-label 'confirm) propose)))))))) @@ -544,14 +648,14 @@ or new, let the user edit the definition of the footnote." (insert "[fn::]") (backward-char 1)) ((member label all) - (insert "[" label "]") + (insert "[fn:" label "]") (message "New reference to existing note")) (org-footnote-define-inline - (insert "[" label ":]") + (insert "[fn:" label ":]") (backward-char 1) (org-footnote-auto-adjust-maybe)) (t - (insert "[" label "]") + (insert "[fn:" label "]") (let ((p (org-footnote-create-definition label))) ;; `org-footnote-goto-definition' needs to be called ;; after `org-footnote-auto-adjust-maybe'. Otherwise @@ -566,324 +670,27 @@ or new, let the user edit the definition of the footnote." (org-footnote-auto-adjust-maybe) (org-edit-footnote-reference))))))) -(defvar org-blank-before-new-entry) ; Silence byte-compiler. (defun org-footnote-create-definition (label) "Start the definition of a footnote with label LABEL. -Return buffer position at the beginning of the definition. In an -Org buffer, this function doesn't move point." +Return buffer position at the beginning of the definition. This +function doesn't move point." (let ((label (org-footnote-normalize-label label)) electric-indent-mode) ; Prevent wrong indentation. - (cond - ;; In an Org document. - ((derived-mode-p 'org-mode) - ;; If `org-footnote-section' is defined, find it, or create it - ;; at the end of the buffer. - (org-with-wide-buffer - (cond - ((not org-footnote-section) - (org-footnote--goto-local-insertion-point)) - ((save-excursion - (goto-char (point-min)) - (re-search-forward - (concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$") - nil t)) - (goto-char (match-end 0)) - (forward-line) - (unless (bolp) (insert "\n"))) - (t - (goto-char (point-max)) - (unless (bolp) (insert "\n")) - ;; Insert new section. Separate it from the previous one - ;; with a blank line, unless `org-blank-before-new-entry' - ;; explicitly says no. - (when (and (cdr (assq 'heading org-blank-before-new-entry)) - (zerop (save-excursion (org-back-over-empty-lines)))) - (insert "\n")) - (insert "* " org-footnote-section "\n"))) - (when (zerop (org-back-over-empty-lines)) (insert "\n")) - (insert "[" label "] \n") - (line-beginning-position 0))) - (t - ;; In a non-Org file. Search for footnote tag, or create it if - ;; specified (at the end of buffer, or before signature if in - ;; Message mode). Set point after any definition already there. - (let ((tag (and org-footnote-tag-for-non-org-mode-files - (concat "^" (regexp-quote - org-footnote-tag-for-non-org-mode-files) - "[ \t]*$"))) - (max (if (and (derived-mode-p 'message-mode) - (goto-char (point-max)) - (re-search-backward - message-signature-separator nil t)) - (progn - ;; Ensure one blank line separates last - ;; footnote from signature. - (beginning-of-line) - (open-line 2) - (point-marker)) - (point-max-marker)))) - (set-marker-insertion-type max t) - (goto-char max) - ;; Check if the footnote tag is defined but missing. In this - ;; case, insert it, before any footnote or one blank line - ;; after any previous text. - (when (and tag (not (re-search-backward tag nil t))) - (skip-chars-backward " \t\r\n") - (while (re-search-backward org-footnote-definition-re nil t)) - (unless (bolp) (newline 2)) - (insert org-footnote-tag-for-non-org-mode-files "\n\n")) - ;; Remove superfluous white space and clear marker. - (goto-char max) - (skip-chars-backward " \t\r\n") - (delete-region (point) max) - (unless (bolp) (newline)) - (set-marker max nil)) - (when (zerop (org-back-over-empty-lines)) (insert "\n")) - (insert "[" label "] \n") - (backward-char) - (line-beginning-position))))) - -;;;###autoload -(defun org-footnote-action (&optional special) - "Do the right thing for footnotes. - -When at a footnote reference, jump to the definition. - -When at a definition, jump to the references if they exist, offer -to create them otherwise. - -When neither at definition or reference, create a new footnote, -interactively if possible. - -With prefix arg SPECIAL, or when no footnote can be created, -offer additional commands in a menu." - (interactive "P") - (let* ((context (and (not special) (org-element-context))) - (type (org-element-type context))) - (cond - ;; On white space after element, insert a new footnote. - ((and context - (> (point) - (save-excursion - (goto-char (org-element-property :end context)) - (skip-chars-backward " \t") - (point)))) - (org-footnote-new)) - ((eq type 'footnote-reference) - (let ((label (org-element-property :label context))) - (cond - ;; Anonymous footnote: move point at the beginning of its - ;; definition. - ((not label) - (goto-char (org-element-property :contents-begin context))) - ;; Check if a definition exists: then move to it. - ((let ((p (nth 1 (org-footnote-get-definition label)))) - (when p (org-footnote-goto-definition label p)))) - ;; No definition exists: offer to create it. - ((yes-or-no-p (format "No definition for %s. Create one? " label)) - (let ((p (org-footnote-create-definition label))) - (or (ignore-errors (org-footnote-goto-definition label p)) - ;; Since definition was created outside current scope, - ;; edit it remotely. - (org-edit-footnote-reference))))))) - ((eq type 'footnote-definition) - (org-footnote-goto-previous-reference - (org-element-property :label context))) - ((or special (not (org-footnote--allow-reference-p))) - (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s | \ -->[n]umeric | [d]elete") - (let ((c (read-char-exclusive))) - (cond - ((eq c ?s) (org-footnote-normalize 'sort)) - ((eq c ?r) (org-footnote-renumber-fn:N)) - ((eq c ?S) - (org-footnote-renumber-fn:N) - (org-footnote-normalize 'sort)) - ((eq c ?n) (org-footnote-normalize)) - ((eq c ?d) (org-footnote-delete)) - (t (error "No such footnote command %c" c))))) - (t (org-footnote-new))))) - -;;;###autoload -(defun org-footnote-normalize (&optional sort-only) - "Collect the footnotes in various formats and normalize them. - -This finds the different sorts of footnotes allowed in Org, and -normalizes them to the usual [N] format. - -When SORT-ONLY is set, only sort the footnote definitions into the -referenced sequence." - ;; This is based on Paul's function, but rewritten. - ;; - ;; Re-create `org-with-limited-levels', but not limited to Org - ;; buffers. - (let* ((limit-level - (and (boundp 'org-inlinetask-min-level) - org-inlinetask-min-level - (1- org-inlinetask-min-level))) - (nstars (and limit-level - (if org-odd-levels-only (1- (* limit-level 2)) - limit-level))) - (org-outline-regexp - (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))) - (count 0) - ins-point ref ref-table) (org-with-wide-buffer - ;; 1. Find every footnote reference, extract the definition, and - ;; collect that data in REF-TABLE. If SORT-ONLY is nil, also - ;; normalize references. - (goto-char (point-min)) - (while (setq ref (org-footnote-get-next-reference)) - (let* ((lbl (car ref)) - (pos (nth 1 ref)) - ;; When footnote isn't anonymous, check if it's label - ;; (REF) is already stored in REF-TABLE. In that case, - ;; extract number used to identify it (MARKER). If - ;; footnote is unknown, increment the global counter - ;; (COUNT) to create an unused identifier. - (a (and lbl (assoc lbl ref-table))) - (marker (or (nth 1 a) (incf count))) - ;; Is the reference inline or pointing to an inline - ;; footnote? - (inlinep (or (stringp (nth 3 ref)) (nth 3 a)))) - ;; Replace footnote reference with [MARKER]. Maybe fill - ;; paragraph once done. If SORT-ONLY is non-nil, only move - ;; to the end of reference found to avoid matching it twice. - (if sort-only (goto-char (nth 2 ref)) - (delete-region (nth 1 ref) (nth 2 ref)) - (goto-char (nth 1 ref)) - (insert (format "[%d]" marker)) - (and inlinep - org-footnote-fill-after-inline-note-extraction - (org-fill-paragraph))) - ;; Add label (REF), identifier (MARKER), definition (DEF) - ;; type (INLINEP) and position (POS) to REF-TABLE if data was - ;; unknown. - (unless a - (let ((def (or (nth 3 ref) ; Inline definition. - (nth 3 (org-footnote-get-definition lbl))))) - (push (list lbl marker def - ;; Reference beginning position is a marker - ;; to preserve it during further buffer - ;; modifications. - inlinep (copy-marker pos)) ref-table))))) - ;; 2. Find and remove the footnote section, if any. Also - ;; determine where footnotes shall be inserted (INS-POINT). (cond - ((and org-footnote-section (derived-mode-p 'org-mode)) - (goto-char (point-min)) - (if (re-search-forward - (concat "^\\*[ \t]+" (regexp-quote org-footnote-section) - "[ \t]*$") nil t) - (delete-region (match-beginning 0) (org-end-of-subtree t t))) - ;; A new footnote section is inserted by default at the end of - ;; the buffer. - (goto-char (point-max)) - (skip-chars-backward " \r\t\n") + ((not org-footnote-section) (org-footnote--goto-local-insertion-point)) + ((save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$") + nil t)) + (goto-char (match-end 0)) (forward-line) - (unless (bolp) (newline))) - ;; No footnote section set: Footnotes will be added at the end - ;; of the section containing their first reference. - ((derived-mode-p 'org-mode)) - (t - ;; Remove any left-over tag in the buffer, if one is set up. - (when org-footnote-tag-for-non-org-mode-files - (let ((tag (concat "^" (regexp-quote - org-footnote-tag-for-non-org-mode-files) - "[ \t]*$"))) - (goto-char (point-min)) - (while (re-search-forward tag nil t) - (replace-match "") - (delete-region (point) (progn (forward-line) (point)))))) - ;; In Message mode, ensure footnotes are inserted before the - ;; signature. - (if (and (derived-mode-p 'message-mode) - (goto-char (point-max)) - (re-search-backward message-signature-separator nil t)) - (beginning-of-line) - (goto-char (point-max))))) - (setq ins-point (point-marker)) - ;; 3. Clean-up REF-TABLE. - (setq ref-table - (delq nil - (mapcar - (lambda (x) - (cond - ;; When only sorting, ignore inline footnotes. - ;; Also clear position marker. - ((and sort-only (nth 3 x)) - (set-marker (nth 4 x) nil) nil) - ;; No definition available: provide one. - ((not (nth 2 x)) - (append - (list (car x) (nth 1 x) - (format "DEFINITION NOT FOUND: %s" (car x))) - (nthcdr 3 x))) - (t x))) - ref-table))) - (setq ref-table (nreverse ref-table)) - ;; 4. Remove left-over definitions in the buffer. - (dolist (x ref-table) - (unless (nth 3 x) (org-footnote-delete-definitions (car x)))) - ;; 5. Insert the footnotes again in the buffer, at the - ;; appropriate spot. - (goto-char ins-point) - (cond - ;; No footnote: exit. - ((not ref-table)) - ;; Cases when footnotes should be inserted in one place. - ((or (not (derived-mode-p 'org-mode)) org-footnote-section) - ;; Insert again the section title, if any. Ensure that title, - ;; or the subsequent footnotes, will be separated by a blank - ;; lines from the rest of the document. In an Org buffer, - ;; separate section with a blank line, unless explicitly stated - ;; in `org-blank-before-new-entry'. - (if (not (derived-mode-p 'org-mode)) - (progn (skip-chars-backward " \t\n\r") - (delete-region (point) ins-point) - (unless (bolp) (newline)) - (when org-footnote-tag-for-non-org-mode-files - (insert "\n" org-footnote-tag-for-non-org-mode-files "\n"))) - (when (and (cdr (assq 'heading org-blank-before-new-entry)) - (zerop (save-excursion (org-back-over-empty-lines)))) - (insert "\n")) - (insert "* " org-footnote-section "\n")) - (set-marker ins-point nil) - ;; Insert the footnotes, separated by a blank line. - (insert - (mapconcat - (lambda (x) - ;; Clean markers. - (set-marker (nth 4 x) nil) - (format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x))) - ref-table "\n")) - (unless (eobp) (insert "\n\n"))) - ;; Each footnote definition has to be inserted at the end of the - ;; section where its first reference belongs. - (t - (dolist (x ref-table) - (let ((pos (nth 4 x))) - (goto-char pos) - ;; Clean marker. - (set-marker pos nil)) - (org-footnote--goto-local-insertion-point) - (insert (format "\n[%s] %s\n" - (nth (if sort-only 0 1) x) - (nth 2 x))))))))) - -(defun org-footnote--goto-local-insertion-point () - "Find insertion point for footnote, just before next outline heading. -Assume insertion point is within currently accessible part of the buffer." - (org-with-limited-levels (outline-next-heading)) - ;; Skip file local variables. See `modify-file-local-variable'. - (when (eobp) - (let ((case-fold-search t)) - (re-search-backward "^[ \t]*# +Local Variables:" - (max (- (point-max) 3000) (point-min)) - t))) - (skip-chars-backward " \t\n") - (forward-line) - (unless (bolp) (insert "\n"))) + (unless (bolp) (insert "\n"))) + (t (org-footnote--clear-footnote-section))) + (when (zerop (org-back-over-empty-lines)) (insert "\n")) + (insert "[fn:" label "] \n") + (line-beginning-position 0)))) (defun org-footnote-delete-references (label) "Delete every reference to footnote LABEL. @@ -894,7 +701,7 @@ Return the number of footnotes removed." (while (setq ref (org-footnote-get-next-reference label)) (goto-char (nth 1 ref)) (delete-region (nth 1 ref) (nth 2 ref)) - (incf nref)) + (cl-incf nref)) nref))) (defun org-footnote-delete-definitions (label) @@ -902,7 +709,7 @@ Return the number of footnotes removed." Return the number of footnotes removed." (save-excursion (goto-char (point-min)) - (let ((def-re (concat "^\\[" (regexp-quote label) "\\]")) + (let ((def-re (format "^\\[fn:%s\\]" (regexp-quote label))) (ndef 0)) (while (re-search-forward def-re nil t) (let ((full-def (org-footnote-at-definition-p))) @@ -912,7 +719,7 @@ Return the number of footnotes removed." (skip-chars-backward " \r\t\n") (unless (bolp) (forward-line)) (delete-region (point) (nth 2 full-def)) - (incf ndef)))) + (cl-incf ndef)))) ndef))) (defun org-footnote-delete (&optional label) @@ -948,24 +755,165 @@ If LABEL is non-nil, delete that footnote instead." (message "%d definition(s) of and %d reference(s) of footnote %s removed" ndef nref label)))) + +;;;; Sorting, Renumbering, Normalizing + (defun org-footnote-renumber-fn:N () - "Renumber the simple footnotes like fn:17 into a sequence in the document." + "Order numbered footnotes into a sequence in the document." (interactive) - (let (map (n 0)) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t) - (save-excursion - (goto-char (match-beginning 0)) - ;; Ensure match is a footnote reference or definition. - (when (save-match-data (if (bolp) - (org-footnote-at-definition-p) - (org-footnote-at-reference-p))) - (let ((new-val (or (cdr (assoc (match-string 1) map)) - (number-to-string (incf n))))) - (unless (assoc (match-string 1) map) - (push (cons (match-string 1) new-val) map)) - (replace-match new-val nil nil nil 1)))))))) + (let ((references (org-footnote--collect-references))) + (unwind-protect + (let* ((c 0) + (references (cl-remove-if-not + (lambda (r) (string-match-p "\\`[0-9]+\\'" (car r))) + references)) + (alist (mapcar (lambda (l) (cons l (number-to-string (cl-incf c)))) + (delete-dups (mapcar #'car references))))) + (org-with-wide-buffer + ;; Re-number references. + (dolist (ref references) + (goto-char (nth 1 ref)) + (org-footnote--set-label (cdr (assoc (nth 0 ref) alist)))) + ;; Re-number definitions. + (goto-char (point-min)) + (while (re-search-forward "^\\[fn:\\([0-9]+\\)\\]" nil t) + (replace-match (or (cdr (assoc (match-string 1) alist)) + ;; Un-referenced definitions get + ;; higher numbers. + (number-to-string (cl-incf c))) + nil nil nil 1)))) + (dolist (r references) (set-marker (nth 1 r) nil))))) + +(defun org-footnote-sort () + "Rearrange footnote definitions in the current buffer. +Sort footnote definitions so they match order of footnote +references. Also relocate definitions at the end of their +relative section or within a single footnote section, according +to `org-footnote-section'. Inline definitions are ignored." + (let ((references (org-footnote--collect-references))) + (unwind-protect + (let ((definitions (org-footnote--collect-definitions 'delete))) + (org-with-wide-buffer + (org-footnote--clear-footnote-section) + ;; Insert footnote definitions at the appropriate location, + ;; separated by a blank line. Each definition is inserted + ;; only once throughout the buffer. + (let (inserted) + (dolist (cell references) + (let ((label (car cell)) + (nested (not (nth 2 cell))) + (inline (nth 3 cell))) + (unless (or (member label inserted) inline) + (push label inserted) + (unless (or org-footnote-section nested) + ;; If `org-footnote-section' is non-nil, or + ;; reference is nested, point is already at the + ;; correct position. Otherwise, move at the + ;; appropriate location within the section + ;; containing the reference. + (goto-char (nth 1 cell)) + (org-footnote--goto-local-insertion-point)) + (insert "\n" + (or (cdr (assoc label definitions)) + (format "[fn:%s] DEFINITION NOT FOUND." label)) + "\n")))) + ;; Insert un-referenced footnote definitions at the end. + (let ((unreferenced + (cl-remove-if (lambda (d) (member (car d) inserted)) + definitions))) + (dolist (d unreferenced) (insert "\n" (cdr d) "\n")))))) + ;; Clear dangling markers in the buffer. + (dolist (r references) (set-marker (nth 1 r) nil))))) + +(defun org-footnote-normalize () + "Turn every footnote in buffer into a numbered one." + (interactive) + (let ((references (org-footnote--collect-references 'anonymous))) + (unwind-protect + (let ((n 0) + (translations nil) + (definitions nil)) + (org-with-wide-buffer + ;; Update label for reference. We need to do this before + ;; clearing definitions in order to rename nested footnotes + ;; before they are deleted. + (dolist (cell references) + (let* ((label (car cell)) + (anonymous (not label)) + (new + (cond + ;; In order to differentiate anonymous + ;; references from regular ones, set their + ;; labels to integers, not strings. + (anonymous (setcar cell (cl-incf n))) + ((cdr (assoc label translations))) + (t (let ((l (number-to-string (cl-incf n)))) + (push (cons label l) translations) + l))))) + (goto-char (nth 1 cell)) ; Move to reference's start. + (org-footnote--set-label + (if anonymous (number-to-string new) new)) + (let ((size (nth 3 cell))) + ;; Transform inline footnotes into regular references + ;; and retain their definition for later insertion as + ;; a regular footnote definition. + (when size + (let ((def (concat + (format "[fn:%s] " new) + (org-trim + (substring + (delete-and-extract-region + (point) (+ (point) size 1)) + 1))))) + (push (cons (if anonymous new label) def) definitions) + (when org-footnote-fill-after-inline-note-extraction + (org-fill-paragraph))))))) + ;; Collect definitions. Update labels according to ALIST. + (let ((definitions + (nconc definitions + (org-footnote--collect-definitions 'delete))) + (inserted)) + (org-footnote--clear-footnote-section) + (dolist (cell references) + (let* ((label (car cell)) + (anonymous (integerp label)) + (pos (nth 1 cell))) + ;; Move to appropriate location, if required. When + ;; there is a footnote section or reference is + ;; nested, point is already at the expected location. + (unless (or org-footnote-section (not (nth 2 cell))) + (goto-char pos) + (org-footnote--goto-local-insertion-point)) + ;; Insert new definition once label is updated. + (unless (member label inserted) + (push label inserted) + (let ((stored (cdr (assoc label definitions))) + ;; Anonymous footnotes' label is already + ;; up-to-date. + (new (if anonymous label + (cdr (assoc label translations))))) + (insert "\n" + (cond + ((not stored) + (format "[fn:%s] DEFINITION NOT FOUND." new)) + (anonymous stored) + (t + (replace-regexp-in-string + "\\`\\[fn:\\(.*?\\)\\]" new stored nil nil 1))) + "\n"))))) + ;; Insert un-referenced footnote definitions at the end. + (let ((unreferenced + (cl-remove-if (lambda (d) (member (car d) inserted)) + definitions))) + (dolist (d unreferenced) + (insert "\n" + (replace-regexp-in-string + org-footnote-definition-re + (format "[fn:%d]" (cl-incf n)) + (cdr d)) + "\n")))))) + ;; Clear dangling markers. + (dolist (r references) (set-marker (nth 1 r) nil))))) (defun org-footnote-auto-adjust-maybe () "Renumber and/or sort footnotes according to user settings." @@ -973,14 +921,77 @@ If LABEL is non-nil, delete that footnote instead." (org-footnote-renumber-fn:N)) (when (memq org-footnote-auto-adjust '(t sort)) (let ((label (car (org-footnote-at-definition-p)))) - (org-footnote-normalize 'sort) + (org-footnote-sort) (when label (goto-char (point-min)) - (and (re-search-forward (concat "^\\[" (regexp-quote label) "\\]") + (and (re-search-forward (format "^\\[fn:%s\\]" (regexp-quote label)) nil t) (progn (insert " ") (just-one-space))))))) + +;;;; End-user interface + +;;;###autoload +(defun org-footnote-action (&optional special) + "Do the right thing for footnotes. + +When at a footnote reference, jump to the definition. + +When at a definition, jump to the references if they exist, offer +to create them otherwise. + +When neither at definition or reference, create a new footnote, +interactively if possible. + +With prefix arg SPECIAL, or when no footnote can be created, +offer additional commands in a menu." + (interactive "P") + (let* ((context (and (not special) (org-element-context))) + (type (org-element-type context))) + (cond + ;; On white space after element, insert a new footnote. + ((and context + (> (point) + (save-excursion + (goto-char (org-element-property :end context)) + (skip-chars-backward " \t") + (point)))) + (org-footnote-new)) + ((eq type 'footnote-reference) + (let ((label (org-element-property :label context))) + (cond + ;; Anonymous footnote: move point at the beginning of its + ;; definition. + ((not label) + (goto-char (org-element-property :contents-begin context))) + ;; Check if a definition exists: then move to it. + ((let ((p (nth 1 (org-footnote-get-definition label)))) + (when p (org-footnote-goto-definition label p)))) + ;; No definition exists: offer to create it. + ((yes-or-no-p (format "No definition for %s. Create one? " label)) + (let ((p (org-footnote-create-definition label))) + (or (ignore-errors (org-footnote-goto-definition label p)) + ;; Since definition was created outside current scope, + ;; edit it remotely. + (org-edit-footnote-reference))))))) + ((eq type 'footnote-definition) + (org-footnote-goto-previous-reference + (org-element-property :label context))) + ((or special (not (org-footnote--allow-reference-p))) + (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s | [n]ormalize | \ +\[d]elete") + (pcase (read-char-exclusive) + (?s (org-footnote-sort)) + (?r (org-footnote-renumber-fn:N)) + (?S (org-footnote-renumber-fn:N) + (org-footnote-sort)) + (?n (org-footnote-normalize)) + (?d (org-footnote-delete)) + (char (error "No such footnote command %c" char)))) + (t (org-footnote-new))))) + + (provide 'org-footnote) ;; Local variables: diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el index a574c0f..a0de1c1 100644 --- a/lisp/org-gnus.el +++ b/lisp/org-gnus.el @@ -1,4 +1,4 @@ -;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode +;;; org-gnus.el --- Support for Links to Gnus Groups and Messages -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -25,8 +25,8 @@ ;; ;;; Commentary: -;; This file implements links to Gnus groups and messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; This file implements links to Gnus groups and messages from within Org. +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;;; Code: @@ -39,18 +39,17 @@ (declare-function message-fetch-field "message" (header &optional not-all)) (declare-function message-narrow-to-head-1 "message" nil) -(declare-function nnimap-group-overview-filename "nnimap" (group server)) (declare-function gnus-summary-last-subject "gnus-sum" nil) (declare-function nnvirtual-map-article "nnvirtual" (article)) ;; Customization variables -(org-defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links) +(defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links) (defcustom org-gnus-prefer-web-links nil "If non-nil, `org-store-link' creates web links to Google groups or Gmane. -When nil, Gnus will be used for such links. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') +\\<org-mode-map>When nil, Gnus will be used for such links. +Using a prefix argument to the command `\\[org-store-link]' (`org-store-link') negates this setting for the duration of the command." :group 'org-link-store :type 'boolean) @@ -75,8 +74,7 @@ this variable to t." :type 'boolean) ;; Install the link type -(org-add-link-type "gnus" 'org-gnus-open) -(add-hook 'org-store-link-functions 'org-gnus-store-link) +(org-link-set-parameters "gnus" :follow #'org-gnus-open :store #'org-gnus-store-link) ;; Implementation @@ -85,8 +83,12 @@ this variable to t." MESSAGE-ID is the message-id header field that identifies the message. If the uid is not cached, return nil." (with-temp-buffer - (let ((nov (nnimap-group-overview-filename group server))) - (when (file-exists-p nov) + (let ((nov (and (fboundp 'nnimap-group-overview-filename) + ;; nnimap-group-overview-filename was removed from + ;; Gnus in September 2010, and therefore should + ;; only be present in Emacs 23.1. + (nnimap-group-overview-filename group server)))) + (when (and nov (file-exists-p nov)) (mm-insert-file-contents nov) (set-buffer-modified-p nil) (goto-char (point-min)) @@ -105,7 +107,7 @@ Otherwise create a link to the group inside Gnus. If `org-store-link' was called with a prefix arg the meaning of `org-gnus-prefer-web-links' is reversed." (let ((unprefixed-group (replace-regexp-in-string "^[^:]+:" "" group))) - (if (and (string-match "^nntp" group) ;; Only for nntp groups + (if (and (string-prefix-p "nntp" group) ;; Only for nntp groups (org-xor current-prefix-arg org-gnus-prefer-web-links)) (concat (if (string-match "gmane" unprefixed-group) @@ -157,25 +159,17 @@ If `org-store-link' was called with a prefix arg the meaning of (header (with-current-buffer gnus-summary-buffer (gnus-summary-article-header))) (from (mail-header-from header)) - (message-id (org-remove-angle-brackets (mail-header-id header))) + (message-id (org-unbracket-string "<" ">" (mail-header-id header))) (date (org-trim (mail-header-date header))) - (date-ts (and date - (ignore-errors - (format-time-string - (org-time-stamp-format t) - (date-to-time date))))) - (date-ts-ia (and date - (ignore-errors - (format-time-string - (org-time-stamp-format t t) - (date-to-time date))))) (subject (copy-sequence (mail-header-subject header))) (to (cdr (assq 'To (mail-header-extra header)))) newsgroups x-no-archive desc link) - (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) - 'nnvirtual) - (setq group (car (nnvirtual-map-article - (gnus-summary-article-number))))) + (cl-case (car (gnus-find-method-for-group gnus-newsgroup-name)) + (nnvirtual + (setq group (car (nnvirtual-map-article + (gnus-summary-article-number))))) + (nnir + (setq group (nnir-article-group (gnus-summary-article-number))))) ;; Remove text properties of subject string to avoid Emacs bug ;; #3506 (set-text-properties 0 (length subject) nil subject) @@ -188,11 +182,8 @@ If `org-store-link' was called with a prefix arg the meaning of (setq to (or to (gnus-fetch-original-field "To")) newsgroups (gnus-fetch-original-field "Newsgroups") x-no-archive (gnus-fetch-original-field "x-no-archive"))) - (org-store-link-props :type "gnus" :from from :subject subject + (org-store-link-props :type "gnus" :from from :date date :subject subject :message-id message-id :group group :to to) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) (setq desc (org-email-link-description) link (org-gnus-article-link group newsgroups message-id x-no-archive)) @@ -211,7 +202,7 @@ If `org-store-link' was called with a prefix arg the meaning of (let ((gcc (car (last (message-unquote-tokens (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,"))))) - (id (org-remove-angle-brackets (mail-fetch-field "Message-ID"))) + (id (org-unbracket-string "<" ">" (mail-fetch-field "Message-ID"))) (to (mail-fetch-field "To")) (from (mail-fetch-field "From")) (subject (mail-fetch-field "Subject")) diff --git a/lisp/org-habit.el b/lisp/org-habit.el index 25bc160..081627e 100644 --- a/lisp/org-habit.el +++ b/lisp/org-habit.el @@ -1,4 +1,4 @@ -;;; org-habit.el --- The habit tracking code for Org-mode +;;; org-habit.el --- The habit tracking code for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -24,18 +24,16 @@ ;; ;;; Commentary: -;; This file contains the habit tracking code for Org-mode +;; This file contains the habit tracking code for Org mode ;;; Code: +(require 'cl-lib) (require 'org) (require 'org-agenda) -(eval-when-compile - (require 'cl)) - (defgroup org-habit nil - "Options concerning habit tracking in Org-mode." + "Options concerning habit tracking in Org mode." :tag "Org Habit" :group 'org-progress) @@ -170,7 +168,7 @@ Returns a list with the following elements: This list represents a \"habit\" for the rest of this module." (save-excursion (if pom (goto-char pom)) - (assert (org-is-habit-p (point))) + (cl-assert (org-is-habit-p (point))) (let* ((scheduled (org-get-scheduled-time (point))) (scheduled-repeat (org-get-repeat org-scheduled-string)) (end (org-entry-end-position)) @@ -185,7 +183,7 @@ This list represents a \"habit\" for the rest of this module." habit-entry)) (setq sr-days (org-habit-duration-to-days scheduled-repeat) sr-type (progn (string-match "[\\.+]?\\+" scheduled-repeat) - (org-match-string-no-properties 0 scheduled-repeat))) + (match-string-no-properties 0 scheduled-repeat))) (unless (> sr-days 0) (error "Habit %s scheduled repeat period is less than 1d" habit-entry)) (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat) @@ -222,8 +220,8 @@ This list represents a \"habit\" for the rest of this module." (while (and (< count maxdays) (funcall search re limit t)) (push (time-to-days (org-time-string-to-time - (or (org-match-string-no-properties 1) - (org-match-string-no-properties 2)))) + (or (match-string-no-properties 1) + (match-string-no-properties 2)))) closed-dates) (setq count (1+ count)))) (list scheduled sr-days deadline dr-days closed-dates sr-type)))) @@ -286,7 +284,6 @@ Habits are assigned colors on the following basis: schedule's repeat period." (let* ((scheduled (or scheduled-days (org-habit-scheduled habit))) (s-repeat (org-habit-scheduled-repeat habit)) - (scheduled-end (+ scheduled (1- s-repeat))) (d-repeat (org-habit-deadline-repeat habit)) (deadline (if scheduled-days (+ scheduled-days (- d-repeat s-repeat)) @@ -310,13 +307,14 @@ Habits are assigned colors on the following basis: CURRENT gives the current time between STARTING and ENDING, for the purpose of drawing the graph. It need not be the actual current time." - (let* ((done-dates (sort (org-habit-done-dates habit) '<)) + (let* ((all-done-dates (sort (org-habit-done-dates habit) #'<)) + (done-dates all-done-dates) (scheduled (org-habit-scheduled habit)) (s-repeat (org-habit-scheduled-repeat habit)) (start (time-to-days starting)) (now (time-to-days current)) (end (time-to-days ending)) - (graph (make-string (1+ (- end start)) ?\ )) + (graph (make-string (1+ (- end start)) ?\s)) (index 0) last-done-date) (while (and done-dates (< (car done-dates) start)) @@ -325,35 +323,55 @@ current time." (while (< start end) (let* ((in-the-past-p (< start now)) (todayp (= start now)) - (donep (and done-dates - (= start (car done-dates)))) - (faces (if (and in-the-past-p - (not last-done-date) - (not (< scheduled now))) - '(org-habit-clear-face . org-habit-clear-future-face) - (org-habit-get-faces - habit start - (and in-the-past-p last-done-date - ;; Compute scheduled time for habit at the - ;; time START was current. - (let ((type (org-habit-repeat-type habit))) - (cond - ((equal type ".+") - (+ last-done-date s-repeat)) - ((equal type "+") - ;; Since LAST-DONE-DATE, each done - ;; mark shifted scheduled date by - ;; S-REPEAT. - (- scheduled (* (length done-dates) s-repeat))) - (t - ;; Scheduled time was the first time - ;; past LAST-DONE-STATE which can jump - ;; to current SCHEDULED time by - ;; S-REPEAT hops. - (- scheduled - (* (/ (- scheduled last-done-date) s-repeat) - s-repeat)))))) - donep))) + (donep (and done-dates (= start (car done-dates)))) + (faces + (if (and in-the-past-p + (not last-done-date) + (not (< scheduled now))) + '(org-habit-clear-face . org-habit-clear-future-face) + (org-habit-get-faces + habit start + (and in-the-past-p + last-done-date + ;; Compute scheduled time for habit at the time + ;; START was current. + (let ((type (org-habit-repeat-type habit))) + (cond + ;; At the last done date, use current + ;; scheduling in all cases. + ((null done-dates) scheduled) + ((equal type ".+") (+ last-done-date s-repeat)) + ((equal type "+") + ;; Since LAST-DONE-DATE, each done mark + ;; shifted scheduled date by S-REPEAT. + (- scheduled (* (length done-dates) s-repeat))) + (t + ;; Compute the scheduled time after the + ;; first repeat. This is the closest time + ;; past FIRST-DONE which can reach SCHEDULED + ;; by a number of S-REPEAT hops. + ;; + ;; Then, play TODO state change history from + ;; the beginning in order to find current + ;; scheduled time. + (let* ((first-done (car all-done-dates)) + (s (let ((shift (mod (- scheduled first-done) + s-repeat))) + (+ (if (= shift 0) s-repeat shift) + first-done)))) + (if (= first-done last-done-date) s + (catch :exit + (dolist (done (cdr all-done-dates) s) + ;; Each repeat shifts S by any + ;; number of S-REPEAT hops it takes + ;; to get past DONE, with a minimum + ;; of one hop. + (cl-incf s (* (1+ (/ (max (- done s) 0) + s-repeat)) + s-repeat)) + (when (= done last-done-date) + (throw :exit s)))))))))) + donep))) markedp face) (if donep (let ((done-time (time-add @@ -386,7 +404,7 @@ current time." (defun org-habit-insert-consistency-graphs (&optional line) "Insert consistency graph for any habitual tasks." - (let ((inhibit-read-only t) l c + (let ((inhibit-read-only t) (buffer-invisibility-spec '(org-link)) (moment (time-subtract (current-time) (list 0 (* 3600 org-extend-today-until) 0)))) diff --git a/lisp/org-id.el b/lisp/org-id.el index 107ac39..cf26851 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -1,4 +1,4 @@ -;;; org-id.el --- Global identifiers for Org-mode entries +;;; org-id.el --- Global identifiers for Org entries -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. ;; @@ -24,7 +24,7 @@ ;; ;;; Commentary: -;; This file implements globally unique identifiers for Org-mode entries. +;; This file implements globally unique identifiers for Org entries. ;; Identifiers are stored in the entry as an :ID: property. Functions ;; are provided that create and retrieve such identifiers, and that find ;; entries based on the identifier. @@ -73,18 +73,14 @@ (require 'org) (declare-function message-make-fqdn "message" ()) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) ;;; Customization (defgroup org-id nil - "Options concerning global entry identifiers in Org-mode." + "Options concerning global entry identifiers in Org mode." :tag "Org ID" :group 'org) -(define-obsolete-variable-alias - 'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3") (defcustom org-id-link-to-org-use-id nil "Non-nil means storing a link to an Org file will use entry IDs. \\<org-mode-map>\ @@ -102,7 +98,7 @@ create-if-interactive call `org-capture' that automatically and preemptively creates a link. If you do want to get an ID link in a capture template to an entry not having an ID, create it first by explicitly creating - a link to it, using `\\[org-insert-link]' first. + a link to it, using `\\[org-store-link]' first. create-if-interactive-and-no-custom-id Like create-if-interactive, but do not create an ID if there is @@ -204,7 +200,7 @@ This variable is only relevant when `org-id-track-globally' is set." When Org reparses files to remake the list of files and IDs it is tracking, it will normally scan the agenda files, the archives related to agenda files, any files that are listed as ID containing in the current register, and -any Org-mode files currently visited by Emacs. +any Org file currently visited by Emacs. You can list additional files here. This variable is only relevant when `org-id-track-globally' is set." :group 'org-id @@ -278,7 +274,7 @@ If necessary, the ID is created." (move-marker pom nil)))) ;;;###autoload -(defun org-id-get-with-outline-drilling (&optional targets) +(defun org-id-get-with-outline-drilling () "Use an outline-cycling interface to retrieve the ID of an entry. This only finds entries in the current buffer, using `org-get-location'. It returns the ID of the entry. If necessary, the ID is created." @@ -295,7 +291,7 @@ Move the cursor to that entry in that buffer." (let ((m (org-id-find id 'marker))) (unless m (error "Cannot find entry with ID \"%s\"" id)) - (org-pop-to-buffer-same-window (marker-buffer m)) + (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) (move-marker m nil) (org-show-context))) @@ -448,8 +444,7 @@ and time is the usual three-integer representation of time." Store the relation between files and corresponding IDs. This will scan all agenda files, all associated archives, and all files currently mentioned in `org-id-locations'. -When FILES is given, scan these files instead. -When CHECK is given, prepare detailed information about duplicate IDs." +When FILES is given, scan these files instead." (interactive) (if (not org-id-track-globally) (error "Please turn on `org-id-track-globally' if you want to track IDs") @@ -467,7 +462,7 @@ When CHECK is given, prepare detailed information about duplicate IDs." (if (symbolp org-id-extra-files) (symbol-value org-id-extra-files) org-id-extra-files) - ;; Files associated with live org-mode buffers + ;; Files associated with live Org buffers (delq nil (mapcar (lambda (b) (with-current-buffer b @@ -495,7 +490,7 @@ When CHECK is given, prepare detailed information about duplicate IDs." (goto-char (point-min)) (while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$" nil t) - (setq id (org-match-string-no-properties 1)) + (setq id (match-string-no-properties 1)) (if (member id found) (progn (message "Duplicate ID \"%s\", also in file %s" @@ -679,7 +674,7 @@ optional argument MARKERP, return the position as a new marker." (move-marker m nil) (org-show-context))) -(org-add-link-type "id" 'org-id-open) +(org-link-set-parameters "id" :follow #'org-id-open) (provide 'org-id) diff --git a/lisp/org-indent.el b/lisp/org-indent.el index 83c5aac..fd58c69 100644 --- a/lisp/org-indent.el +++ b/lisp/org-indent.el @@ -1,4 +1,5 @@ -;;; org-indent.el --- Dynamic indentation for Org-mode +;;; org-indent.el --- Dynamic indentation for Org -*- lexical-binding: t; -*- + ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> @@ -39,8 +40,7 @@ (require 'org-compat) (require 'org) -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (declare-function org-inlinetask-get-task-level "org-inlinetask" ()) (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) @@ -68,7 +68,7 @@ Delay used when the buffer to initialize is current.") Delay used when the buffer to initialize isn't current.") (defvar org-indent-agent-resume-delay '(0 0 100000) "Minimal time for other idle processes before switching back to agent.") -(defvar org-indent-initial-marker nil +(defvar org-indent--initial-marker nil "Position of initialization before interrupt. This is used locally in each buffer being initialized.") (defvar org-hide-leading-stars-before-indent-mode nil @@ -127,32 +127,23 @@ buffer, which can take a few seconds on large buffers, is done during idle time." nil " Ind" nil (cond - ((and org-indent-mode (featurep 'xemacs)) - (message "org-indent-mode does not work in XEmacs - refusing to turn it on") - (setq org-indent-mode nil)) - ((and org-indent-mode - (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) - (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!") - (ding) - (sit-for 1) - (setq org-indent-mode nil)) (org-indent-mode ;; mode was turned on. - (org-set-local 'indent-tabs-mode nil) - (org-set-local 'org-indent-initial-marker (copy-marker 1)) + (setq-local indent-tabs-mode nil) + (setq-local org-indent--initial-marker (copy-marker 1)) (when org-indent-mode-turns-off-org-adapt-indentation - (org-set-local 'org-adapt-indentation nil)) + (setq-local org-adapt-indentation nil)) (when org-indent-mode-turns-on-hiding-stars - (org-set-local 'org-hide-leading-stars-before-indent-mode - org-hide-leading-stars) - (org-set-local 'org-hide-leading-stars t)) - (org-add-hook 'filter-buffer-substring-functions + (setq-local org-hide-leading-stars-before-indent-mode + org-hide-leading-stars) + (setq-local org-hide-leading-stars t)) + (add-hook 'filter-buffer-substring-functions (lambda (fun start end delete) (org-indent-remove-properties-from-string (funcall fun start end delete))) nil t) - (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) - (org-add-hook 'before-change-functions + (add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) + (add-hook 'before-change-functions 'org-indent-notify-modified-headline nil 'local) (and font-lock-mode (org-restart-font-lock)) (org-indent-remove-properties (point-min) (point-max)) @@ -169,11 +160,11 @@ during idle time." (kill-local-variable 'org-adapt-indentation) (setq org-indent-agentized-buffers (delq (current-buffer) org-indent-agentized-buffers)) - (when (markerp org-indent-initial-marker) - (set-marker org-indent-initial-marker nil)) + (when (markerp org-indent--initial-marker) + (set-marker org-indent--initial-marker nil)) (when (boundp 'org-hide-leading-stars-before-indent-mode) - (org-set-local 'org-hide-leading-stars - org-hide-leading-stars-before-indent-mode)) + (setq-local org-hide-leading-stars + org-hide-leading-stars-before-indent-mode)) (remove-hook 'filter-buffer-substring-functions (lambda (fun start end delete) (org-indent-remove-properties-from-string @@ -209,7 +200,7 @@ When no more buffer is being watched, the agent suppress itself." (when org-indent-agent-resume-timer (cancel-timer org-indent-agent-resume-timer)) (setq org-indent-agentized-buffers - (org-remove-if-not #'buffer-live-p org-indent-agentized-buffers)) + (cl-remove-if-not #'buffer-live-p org-indent-agentized-buffers)) (cond ;; Job done: kill agent. ((not org-indent-agentized-buffers) (cancel-timer org-indent-agent-timer)) @@ -233,13 +224,15 @@ a time value." (let ((interruptp ;; Always nil unless interrupted. (catch 'interrupt - (and org-indent-initial-marker - (marker-position org-indent-initial-marker) - (org-indent-add-properties org-indent-initial-marker + (and org-indent--initial-marker + (marker-position org-indent--initial-marker) + (equal (marker-buffer org-indent--initial-marker) + buffer) + (org-indent-add-properties org-indent--initial-marker (point-max) delay) nil)))) - (move-marker org-indent-initial-marker interruptp) + (move-marker org-indent--initial-marker interruptp) ;; Job is complete: un-agentize buffer. (unless interruptp (setq org-indent-agentized-buffers @@ -260,7 +253,7 @@ have `org-warning' face." ?*))) (line (cond - ((and (org-bound-and-true-p org-inlinetask-show-first-star) + ((and (bound-and-true-p org-inlinetask-show-first-star) (eq heading 'inlinetask)) (concat org-indent-inlinetask-first-star (org-add-props (substring stars 1) nil 'face 'org-hide))) @@ -319,7 +312,7 @@ stopped." ;; Headline or inline task. ((looking-at org-outline-regexp) (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) - (type (or (org-looking-at-p limited-re) 'inlinetask))) + (type (or (looking-at-p limited-re) 'inlinetask))) (org-indent-set-line-properties nstars 0 type) ;; At an headline, define new value for LEVEL. (unless (eq type 'inlinetask) (setq level nstars)))) @@ -349,7 +342,7 @@ headline." (re-search-forward (org-with-limited-levels org-outline-regexp-bol) end t))))))) -(defun org-indent-refresh-maybe (beg end dummy) +(defun org-indent-refresh-maybe (beg end _) "Refresh indentation properties in an adequate portion of buffer. BEG and END are the positions of the beginning and end of the range of inserted text. DUMMY is an unused argument. diff --git a/lisp/org-info.el b/lisp/org-info.el index 270c19f..d82168e 100644 --- a/lisp/org-info.el +++ b/lisp/org-info.el @@ -1,4 +1,4 @@ -;;; org-info.el --- Support for links to Info nodes from within Org-Mode +;;; org-info.el --- Support for Links to Info Nodes -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -24,8 +24,8 @@ ;; ;;; Commentary: -;; This file implements links to Info nodes from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; This file implements links to Info nodes from within Org mode. +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;;; Code: @@ -34,25 +34,26 @@ ;; Declare external functions and variables -(declare-function Info-find-node "info" (filename nodename - &optional no-going-back)) +(declare-function Info-find-node "info" + (filename nodename &optional no-going-back strict-case)) (defvar Info-current-file) (defvar Info-current-node) ;; Install the link type -(org-add-link-type "info" 'org-info-open 'org-info-export) -(add-hook 'org-store-link-functions 'org-info-store-link) +(org-link-set-parameters "info" + :follow #'org-info-open + :export #'org-info-export + :store #'org-info-store-link) ;; Implementation (defun org-info-store-link () "Store a link to an Info file and node." (when (eq major-mode 'Info-mode) - (let (link desc) - (setq link (concat "info:" - (file-name-nondirectory Info-current-file) - "#" Info-current-node)) - (setq desc (concat (file-name-nondirectory Info-current-file) - "#" Info-current-node)) + (let ((link (concat "info:" + (file-name-nondirectory Info-current-file) + "#" Info-current-node)) + (desc (concat (file-name-nondirectory Info-current-file) + "#" Info-current-node))) (org-store-link-props :type "info" :file Info-current-file :node Info-current-node :link link :desc desc) @@ -81,16 +82,47 @@ nodename-or-index))))) (user-error "Could not open: %s" name))) +(defconst org-info-emacs-documents + '("ada-mode" "auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x" + "ebrowse" "ede" "ediff" "edt" "efaq-w32" "efaq" "eieio" "eintr" "elisp" + "emacs-gnutls" "emacs-mime" "emacs" "epa" "erc" "ert" "eshell" "eudc" "eww" + "flymake" "forms" "gnus" "htmlfontify" "idlwave" "ido" "info" "mairix-el" + "message" "mh-e" "newsticker" "nxml-mode" "octave-mode" "org" "pcl-cvs" + "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve" + "smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "url" "vip" "viper" + "widget" "wisent" "woman") + "List of emacs documents available. +Taken from <http://www.gnu.org/software/emacs/manual/html_mono/.>") + +(defconst org-info-other-documents + '(("libc" . "http://www.gnu.org/software/libc/manual/html_mono/libc.html") + ("make" . "http://www.gnu.org/software/make/manual/make.html")) + "Alist of documents generated from texinfo source. + +When converting info links to html, links to any one of these manuals are +converted to use these URL's.") + +(defun org-info-map-html-url (filename) + "Given info FILENAME, either return it (plus '.html' suffix added) or convert +it to URL pointing to the official page on internet, e.g., use gnu.org for all +emacs related documents. See `org-info-official-gnu-document' and +`org-info-other-documents' for details." + (if (member filename org-info-emacs-documents) + (format "http://www.gnu.org/software/emacs/manual/html_mono/%s.html" + filename) + (let ((url (cdr (assoc filename org-info-other-documents)))) + (or url (concat filename ".html"))))) + (defun org-info-export (path desc format) "Export an info link. -See `org-add-link-type' for details about PATH, DESC and FORMAT." +See `org-link-parameters' for details about PATH, DESC and FORMAT." (when (eq format 'html) (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" path) (string-match "\\(.*\\)" path)) (let ((filename (match-string 1 path)) (node (or (match-string 2 path) "Top"))) - (format "<a href=\"%s.html#%s\">%s</a>" - filename + (format "<a href=\"%s#%s\">%s</a>" + (org-info-map-html-url filename) (replace-regexp-in-string " " "-" node) (or desc path))))) diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index 26d2e3d..910b1a0 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -1,4 +1,4 @@ -;;; org-inlinetask.el --- Tasks independent of outline hierarchy +;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. ;; @@ -26,7 +26,7 @@ ;; ;;; Commentary: ;; -;; This module implements inline tasks in Org-mode. Inline tasks are +;; This module implements inline tasks in Org mode. Inline tasks are ;; tasks that have all the properties of normal outline nodes, ;; including the ability to store meta data like scheduling dates, ;; TODO state, tags and properties. However, these nodes are treated @@ -167,9 +167,9 @@ The number of levels is controlled by `org-inlinetask-min-level'." (stars-re (org-inlinetask-outline-regexp)) (task-beg-re (concat stars-re "\\(?:.*\\)")) (task-end-re (concat stars-re "END[ \t]*$"))) - (or (org-looking-at-p task-beg-re) + (or (looking-at-p task-beg-re) (and (re-search-forward "^\\*+[ \t]+" nil t) - (progn (beginning-of-line) (org-looking-at-p task-end-re))))))) + (progn (beginning-of-line) (looking-at-p task-end-re))))))) (defun org-inlinetask-goto-beginning () "Go to the beginning of the inline task at point." @@ -177,7 +177,7 @@ The number of levels is controlled by `org-inlinetask-min-level'." (let ((case-fold-search t) (inlinetask-re (org-inlinetask-outline-regexp))) (re-search-backward inlinetask-re nil t) - (when (org-looking-at-p (concat inlinetask-re "END[ \t]*$")) + (when (looking-at-p (concat inlinetask-re "END[ \t]*$")) (re-search-backward inlinetask-re nil t)))) (defun org-inlinetask-goto-end () @@ -189,17 +189,16 @@ Return point." (inlinetask-re (org-inlinetask-outline-regexp)) (task-end-re (concat inlinetask-re "END[ \t]*$"))) (cond - ((looking-at task-end-re) (forward-line)) + ((looking-at task-end-re)) ((looking-at inlinetask-re) (forward-line) (cond - ((looking-at task-end-re) (forward-line)) + ((looking-at task-end-re)) ((looking-at inlinetask-re)) ((org-inlinetask-in-task-p) - (re-search-forward inlinetask-re nil t) - (forward-line)))) - (t (re-search-forward inlinetask-re nil t) - (forward-line))) + (re-search-forward inlinetask-re nil t)))) + (t (re-search-forward inlinetask-re nil t))) + (end-of-line) (point)))) (defun org-inlinetask-get-task-level () @@ -272,8 +271,7 @@ If the task has an end part, also demote it." (defvar org-indent-indentation-per-level) ; defined in org-indent.el -(defface org-inlinetask - (org-compatible-face 'shadow '((t (:bold t)))) +(defface org-inlinetask '((t :inherit shadow)) "Face for inlinetask headlines." :group 'org-faces) @@ -287,7 +285,7 @@ If the task has an end part, also demote it." ",\\}\\)\\(\\*\\* .*\\)")) ;; Virtual indentation will add the warning face on the first ;; star. Thus, in that case, only hide it. - (start-face (if (and (org-bound-and-true-p org-indent-mode) + (start-face (if (and (bound-and-true-p org-indent-mode) (> org-indent-indentation-per-level 1)) 'org-hide 'org-warning))) @@ -322,15 +320,15 @@ If the task has an end part, also demote it." (defun org-inlinetask-hide-tasks (state) "Hide inline tasks in buffer when STATE is `contents' or `children'. This function is meant to be used in `org-cycle-hook'." - (case state - (contents + (pcase state + (`contents (let ((regexp (org-inlinetask-outline-regexp))) (save-excursion (goto-char (point-min)) (while (re-search-forward regexp nil t) (org-inlinetask-toggle-visibility) (org-inlinetask-goto-end))))) - (children + (`children (save-excursion (while (and (outline-next-heading) (org-inlinetask-at-task-p)) (org-inlinetask-toggle-visibility) diff --git a/lisp/org-irc.el b/lisp/org-irc.el index 333c4b1..2447793 100644 --- a/lisp/org-irc.el +++ b/lisp/org-irc.el @@ -1,4 +1,4 @@ -;;; org-irc.el --- Store links to IRC sessions +;;; org-irc.el --- Store Links to IRC Sessions -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. ;; @@ -22,8 +22,8 @@ ;;; Commentary: -;; This file implements links to an IRC session from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; This file implements links to an IRC session from within Org mode. +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;; ;; Please customize the variable `org-modules' to select @@ -59,8 +59,6 @@ (declare-function erc-server-buffer "erc" ()) (declare-function erc-get-server-nickname-list "erc" ()) (declare-function erc-cmd-JOIN "erc" (channel &optional key)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) (defvar org-irc-client 'erc "The IRC client to act on.") @@ -73,9 +71,7 @@ ;; Generic functions/config (extend these for other clients) -(add-to-list 'org-store-link-functions 'org-irc-store-link) - -(org-add-link-type "irc" 'org-irc-visit nil) +(org-link-set-parameters "irc" :follow #'org-irc-visit :store #'org-irc-store-link) (defun org-irc-visit (link) "Parse LINK and dispatch to the correct function based on the client found." @@ -114,11 +110,9 @@ chars that the value AFTER with `...'" (cons "[ \t]*$" "") (cons (concat "^\\(.\\{" after "\\}\\).*") "\\1...")))) - (mapc (lambda (x) - (when (string-match (car x) string) - (setq string (replace-match (cdr x) nil nil string)))) - replace-map) - string)) + (dolist (x replace-map string) + (when (string-match (car x) string) + (setq string (replace-match (cdr x) nil nil string)))))) ;; ERC specific functions @@ -233,7 +227,7 @@ default." (throw 'found x)))))) (if chan-buf (progn - (org-pop-to-buffer-same-window chan-buf) + (pop-to-buffer-same-window chan-buf) ;; if we got a nick, and they're in the chan, ;; then start a chat with them (let ((nick (pop link))) @@ -244,9 +238,9 @@ default." (insert (concat nick ": "))) (error "%s not found in %s" nick chan-name))))) (progn - (org-pop-to-buffer-same-window server-buffer) + (pop-to-buffer-same-window server-buffer) (erc-cmd-JOIN chan-name)))) - (org-pop-to-buffer-same-window server-buffer))) + (pop-to-buffer-same-window server-buffer))) ;; no server match, make new connection (erc-select :server server :port port)))) diff --git a/lisp/org-lint.el b/lisp/org-lint.el index 37d05ed..2f92bb4 100644 --- a/lisp/org-lint.el +++ b/lisp/org-lint.el @@ -1,6 +1,6 @@ ;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*- -;; Copyright (C) 2015 Free Software Foundation +;; Copyright (C) 2015-2016 Free Software Foundation ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr> ;; Keywords: outlines, hypermedia, calendar, wp @@ -68,8 +68,10 @@ ;; - orphaned affiliated keywords ;; - obsolete affiliated keywords ;; - missing language in src blocks +;; - missing back-end in export blocks ;; - invalid Babel call blocks ;; - NAME values with a colon +;; - deprecated export block syntax ;; - deprecated Babel header properties ;; - wrong header arguments in src blocks ;; - misuse of CATEGORY keyword @@ -80,6 +82,7 @@ ;; - links to non-existent local files ;; - SETUPFILE keywords with non-existent file parameter ;; - INCLUDE keywords with wrong link parameter +;; - obsolete markup in INCLUDE keyword ;; - unknown items in OPTIONS keyword ;; - spurious macro arguments or invalid macro templates ;; - special properties in properties drawer @@ -93,6 +96,7 @@ ;; - incomplete drawers ;; - indented diary-sexps ;; - obsolete QUOTE section +;; - obsolete "file+application" link ;;; Code: @@ -143,15 +147,24 @@ :description "Report obsolete affiliated keywords" :categories '(obsolete)) (make-org-lint-checker + :name 'deprecated-export-blocks + :description "Report deprecated export block syntax" + :categories '(obsolete export) + :trust 'low) + (make-org-lint-checker :name 'deprecated-header-syntax :description "Report deprecated Babel header syntax" - :categories '(babel obsolete) + :categories '(obsolete babel) :trust 'low) (make-org-lint-checker :name 'missing-language-in-src-block :description "Report missing language in src blocks" :categories '(babel)) (make-org-lint-checker + :name 'missing-backend-in-export-block + :description "Report missing back-end in export blocks" + :categories '(export)) + (make-org-lint-checker :name 'invalid-babel-call-block :description "Report invalid Babel call blocks" :categories '(babel)) @@ -203,6 +216,11 @@ :categories '(export) :trust 'low) (make-org-lint-checker + :name 'obsolete-include-markup + :description "Report obsolete markup in INCLUDE keyword" + :categories '(obsolete export) + :trust 'low) + (make-org-lint-checker :name 'unknown-options-item :description "Report unknown items in OPTIONS keyword" :categories '(export) @@ -256,7 +274,11 @@ :name 'quote-section :description "Report obsolete QUOTE section" :categories '(obsolete) - :trust 'low)) + :trust 'low) + (make-org-lint-checker + :name 'file-application + :description "Report obsolete \"file+application\" link" + :categories '(link obsolete))) "List of all available checkers.") (defun org-lint--collect-duplicates @@ -341,7 +363,7 @@ called with one argument, the key used for comparison." (lambda (k) (let ((key (org-element-property :key k))) (and (or (let ((case-fold-search t)) - (org-string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key)) + (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key)) (member key keywords)) (list (org-element-property :post-affiliated k) (format "Orphaned affiliated keyword: \"%s\"" key)))))))) @@ -353,7 +375,7 @@ called with one argument, the key used for comparison." t))) reports) (while (re-search-forward regexp nil t) - (let ((key (upcase (org-match-string-no-properties 1)))) + (let ((key (upcase (match-string-no-properties 1)))) (when (< (point) (org-element-property :post-affiliated (org-element-at-point))) (push @@ -368,6 +390,20 @@ called with one argument, the key used for comparison." reports)))) reports)) +(defun org-lint-deprecated-export-blocks (ast) + (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD" + "ODT" "ORG" "TEXINFO"))) + (org-element-map ast 'special-block + (lambda (b) + (let ((type (org-element-property :type b))) + (when (member-ignore-case type deprecated) + (list + (org-element-property :post-affiliated b) + (format + "Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \ +instead" + type)))))))) + (defun org-lint-deprecated-header-syntax (ast) (let* ((deprecated-babel-properties (mapcar (lambda (arg) (symbol-name (car arg))) @@ -385,7 +421,7 @@ called with one argument, the key used for comparison." (list (org-element-property :begin datum) (format "Deprecated syntax for \"%s\". \ Use header-args instead" - (org-match-string-no-properties 1 value)))))) + (match-string-no-properties 1 value)))))) (`node-property (and (member-ignore-case key deprecated-babel-properties) (list @@ -401,6 +437,13 @@ Use :header-args: instead" (list (org-element-property :post-affiliated b) "Missing language in source block"))))) +(defun org-lint-missing-backend-in-export-block (ast) + (org-element-map ast 'export-block + (lambda (b) + (unless (org-element-property :type b) + (list (org-element-property :post-affiliated b) + "Missing back-end in export block"))))) + (defun org-lint-invalid-babel-call-block (ast) (org-element-map ast 'babel-call (lambda (b) @@ -409,7 +452,7 @@ Use :header-args: instead" (list (org-element-property :post-affiliated b) "Invalid syntax in babel call block")) ((let ((h (org-element-property :end-header b))) - (and h (org-string-match-p "\\`\\[.*\\]\\'" h))) + (and h (string-match-p "\\`\\[.*\\]\\'" h))) (list (org-element-property :post-affiliated b) "Babel call's end header must not be wrapped within brackets")))))) @@ -509,7 +552,8 @@ Use :header-args: instead" (org-element-map ast 'keyword (lambda (k) (when (equal (org-element-property :key k) "SETUPFILE") - (let ((file (org-remove-double-quotes + (let ((file (org-unbracket-string + "\"" "\"" (org-element-property :value k)))) (and (not (file-remote-p file)) (not (file-exists-p file)) @@ -524,7 +568,7 @@ Use :header-args: instead" (path (and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value) (save-match-data - (org-remove-double-quotes (match-string 1 value)))))) + (org-unbracket-string "\"" "\"" (match-string 1 value)))))) (if (not path) (list (org-element-property :post-affiliated k) "Missing location argument in INCLUDE keyword") @@ -555,6 +599,25 @@ Use :header-args: instead" search)))) (unless visiting (kill-buffer buffer)))))))))))) +(defun org-lint-obsolete-include-markup (ast) + (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s" + (regexp-opt + '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD" + "ODT" "ORG" "TEXINFO") + t)))) + (org-element-map ast 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "INCLUDE") + (let ((case-fold-search t) + (value (org-element-property :value k))) + (when (string-match regexp value) + (let ((markup (match-string-no-properties 1 value))) + (list (org-element-property :post-affiliated k) + (format "Obsolete markup \"%s\" in INCLUDE keyword. \ +Use \"export %s\" instead" + markup + markup)))))))))) + (defun org-lint-unknown-options-item (ast) (let ((allowed (delq nil (append @@ -676,7 +739,7 @@ Use :header-args: instead" (lambda (e) (let ((name (org-element-property :name e))) (and name - (org-string-match-p ":" name) + (string-match-p ":" name) (list (progn (goto-char (org-element-property :begin e)) (re-search-forward @@ -700,7 +763,7 @@ Use :header-args: instead" (defun org-lint-incomplete-drawer (_) (let (reports) (while (re-search-forward org-drawer-regexp nil t) - (let ((name (org-trim (org-match-string-no-properties 0))) + (let ((name (org-trim (match-string-no-properties 0))) (element (org-element-at-point))) (pcase (org-element-type element) ((or `drawer `property-drawer) @@ -755,7 +818,7 @@ Use :header-args: instead" (regexp-opt org-element-dual-keywords))) reports) (while (re-search-forward regexp nil t) - (let ((name (org-match-string-no-properties 1))) + (let ((name (match-string-no-properties 1))) (unless (or (string-prefix-p "BEGIN" name t) (string-prefix-p "END" name t) (save-excursion @@ -781,7 +844,7 @@ Use :header-args: instead" (org-element-property :commentedp e)))) nil t '(footnote-definition property-drawer)) (list (org-element-property :begin h) - "Extraneous elements in footnote section"))))) + "Extraneous elements in footnote section are not exported"))))) (defun org-lint-quote-section (ast) (org-element-map ast '(headline inlinetask) @@ -792,6 +855,14 @@ Use :header-args: instead" (list (org-element-property :begin h) "Deprecated QUOTE section")))))) +(defun org-lint-file-application (ast) + (org-element-map ast 'link + (lambda (l) + (let ((app (org-element-property :application l))) + (and app + (list (org-element-property :begin l) + (format "Deprecated \"file+%s\" link type" app))))))) + (defun org-lint-wrong-header-argument (ast) (let* ((reports) (verify @@ -883,35 +954,22 @@ Use :header-args: instead" (and (boundp v) (symbol-value v)))) org-babel-common-header-args-w-values)) (datum-header-values - (apply - #'org-babel-merge-params - org-babel-default-header-args - (and language - (let ((v (intern (concat "org-babel-default-header-args:" - language)))) - (and (boundp v) (symbol-value v)))) - (append - (list (and (memq type '(babel-call inline-babel-call)) - org-babel-default-lob-header-args)) - (progn (goto-char (org-element-property :begin datum)) - (org-babel-params-from-properties language)) - (list - (org-babel-parse-header-arguments - (org-trim - (pcase type - (`src-block - (mapconcat - #'identity - (cons (org-element-property :parameters datum) - (org-element-property :header datum)) - " ")) - (`inline-src-block - (or (org-element-property :parameters datum) "")) - (_ - (concat - (org-element-property :inside-header datum) - " " - (org-element-property :end-header datum))))))))))) + (org-babel-parse-header-arguments + (org-trim + (pcase type + (`src-block + (mapconcat + #'identity + (cons (org-element-property :parameters datum) + (org-element-property :header datum)) + " ")) + (`inline-src-block + (or (org-element-property :parameters datum) "")) + (_ + (concat + (org-element-property :inside-header datum) + " " + (org-element-property :end-header datum)))))))) (dolist (header datum-header-values) (let ((allowed-values (cdr (assoc-string (substring (symbol-name (car header)) 1) @@ -1002,14 +1060,15 @@ for `tabulated-list-printer'." (mapcar (lambda (report) (list - (incf id) + (cl-incf id) (apply #'vector (cons (progn (goto-char (car report)) (beginning-of-line) (prog1 (number-to-string - (incf last-line (count-lines last-pos (point)))) + (cl-incf last-line + (count-lines last-pos (point)))) (setf last-pos (point)))) (cdr report))))) ;; Insert trust level in generated reports. Also sort them @@ -1103,16 +1162,16 @@ Checker will also be ignored in all subsequent reports." (defun org-lint (&optional arg) "Check current Org buffer for syntax mistakes. -By default, run all checkers. With a single prefix ARG \ -\\[universal-argument], -select one category of checkers only. With a double prefix -\\[universal-argument] \\[universal-argument], select one precise \ +By default, run all checkers. With a `\\[universal-argument]' prefix ARG, \ +select one +category of checkers only. With a `\\[universal-argument] \ +\\[universal-argument]' prefix, run one precise checker by its name. ARG can also be a list of checker names, as symbols, to run." (interactive "P") (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer")) - (when (org-called-interactively-p) + (when (called-interactively-p 'any) (message "Org linting process starting...")) (let ((checkers (pcase arg @@ -1141,7 +1200,7 @@ ARG can also be a list of checker names, as symbols, to run." (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg)) org-lint--checkers)) (_ (user-error "Invalid argument `%S' for `org-lint'" arg))))) - (if (not (org-called-interactively-p)) + (if (not (called-interactively-p 'any)) (org-lint--generate-reports (current-buffer) checkers) (org-lint--display-reports (current-buffer) checkers) (message "Org linting process completed")))) diff --git a/lisp/org-list.el b/lisp/org-list.el index d264451..e8d9aef 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1,4 +1,4 @@ -;;; org-list.el --- Plain lists for Org-mode +;;; org-list.el --- Plain lists for Org -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. ;; @@ -25,7 +25,7 @@ ;; ;;; Commentary: -;; This file contains the code dealing with plain lists in Org-mode. +;; This file contains the code dealing with plain lists in Org mode. ;; The core concept behind lists is their structure. A structure is ;; a snapshot of the list, in the shape of a data tree (see @@ -76,8 +76,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'org-macs) (require 'org-compat) @@ -88,32 +87,54 @@ (defvar org-closed-string) (defvar org-deadline-string) (defvar org-description-max-indent) +(defvar org-done-keywords) +(defvar org-drawer-regexp) +(defvar org-element-all-objects) +(defvar org-inhibit-startup) (defvar org-odd-levels-only) +(defvar org-outline-regexp-bol) (defvar org-scheduled-string) +(defvar org-todo-line-regexp) (defvar org-ts-regexp) (defvar org-ts-regexp-both) -(defvar org-drawer-regexp) (declare-function org-at-heading-p "org" (&optional invisible-ok)) (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-before-first-heading-p "org" ()) (declare-function org-combine-plists "org" (&rest plists)) -(declare-function org-count "org" (cl-item cl-seq)) (declare-function org-current-level "org" ()) (declare-function org-element-at-point "org-element" ()) (declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-lineage "org-element" - (blob &optional types with-self)) +(declare-function org-element-interpret-data "org-element" (data)) +(declare-function + org-element-lineage "org-element" (blob &optional types with-self)) +(declare-function org-element-macro-interpreter "org-element" (macro ##)) +(declare-function + org-element-map "org-element" + (data types fun &optional info first-match no-recursion with-affiliated)) +(declare-function org-element-normalize-string "org-element" (s)) +(declare-function org-element-parse-buffer "org-element" + (&optional granularity visible-only)) (declare-function org-element-property "org-element" (property element)) +(declare-function org-element-put-property "org-element" + (element property value)) +(declare-function org-element-set-element "org-element" (old new)) (declare-function org-element-type "org-element" (element)) (declare-function org-element-update-syntax "org-element" ()) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) -(declare-function org-export-string-as "ox" - (string backend &optional body-only ext-plist)) +(declare-function org-export-create-backend "ox" (&rest rest) t) +(declare-function org-export-data-with-backend "ox" (data backend info)) +(declare-function org-export-get-backend "ox" (name)) +(declare-function org-export-get-environment "ox" + (&optional backend subtreep ext-plist)) +(declare-function org-export-get-next-element "ox" + (blob info &optional n)) +(declare-function org-export-with-backend "ox" + (backend data &optional contents info)) (declare-function org-fix-tags-on-the-fly "org" ()) (declare-function org-get-indentation "org" (&optional line)) -(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-get-todo-state "org" ()) (declare-function org-in-block-p "org" (names)) (declare-function org-in-regexp "org" (re &optional nlines visually)) (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) @@ -122,15 +143,16 @@ (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-level-increment "org" ()) (declare-function org-narrow-to-subtree "org" ()) +(declare-function org-outline-level "org" ()) (declare-function org-previous-line-empty-p "org" ()) (declare-function org-reduced-level "org" (L)) -(declare-function org-remove-if "org" (predicate seq)) +(declare-function org-remove-indentation "org" (code &optional n)) (declare-function org-show-subtree "org" ()) (declare-function org-sort-remove-invisible "org" (S)) (declare-function org-time-string-to-seconds "org" (s)) (declare-function org-timer-hms-to-secs "org-timer" (hms)) (declare-function org-timer-item "org-timer" (&optional arg)) -(declare-function org-trim "org" (s)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function org-uniquify "org" (list)) (declare-function outline-flag-region "outline" (from to flag)) (declare-function outline-invisible-p "outline" (&optional pos)) @@ -142,7 +164,7 @@ ;;; Configuration variables (defgroup org-plain-lists nil - "Options concerning plain lists in Org-mode." + "Options concerning plain lists in Org mode." :tag "Org Plain lists" :group 'org-structure) @@ -219,7 +241,7 @@ This variable needs to be set before org.el is loaded. If you need to make a change while Emacs is running, use the customize interface or run the following code after updating it: - \\[org-element-update-syntax]" + `\\[org-element-update-syntax]'" :group 'org-plain-lists :type '(choice (const :tag "dot like in \"2.\"" ?.) (const :tag "paren like in \"2)\"" ?\)) @@ -227,8 +249,6 @@ interface or run the following code after updating it: :set (lambda (var val) (set var val) (when (featurep 'org-element) (org-element-update-syntax)))) -(define-obsolete-variable-alias 'org-alphabetical-lists - 'org-list-allow-alphabetical "24.4") ; Since 8.0 (defcustom org-list-allow-alphabetical nil "Non-nil means single character alphabetical bullets are allowed. @@ -240,7 +260,7 @@ This variable needs to be set before org.el is loaded. If you need to make a change while Emacs is running, use the customize interface or run the following code after updating it: - \\[org-element-update-syntax]" + `\\[org-element-update-syntax]'" :group 'org-plain-lists :version "24.1" :type 'boolean @@ -259,23 +279,22 @@ spaces instead of one after the bullet in each item of the list." (const :tag "never" nil) (regexp))) -(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists - 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0 -(defcustom org-list-empty-line-terminates-plain-lists nil - "Non-nil means an empty line ends all plain list levels. -Otherwise, two of them will be necessary." - :group 'org-plain-lists - :type 'boolean) - (defcustom org-list-automatic-rules '((checkbox . t) (indent . t)) "Non-nil means apply set of rules when acting on lists. +\\<org-mode-map> By default, automatic actions are taken when using - \\[org-meta-return], \\[org-metaright], \\[org-metaleft], - \\[org-shiftmetaright], \\[org-shiftmetaleft], - \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or - \\[org-insert-todo-heading]. You can disable individually these - rules by setting them to nil. Valid rules are: + `\\[org-meta-return]', + `\\[org-metaright]', + `\\[org-metaleft]', + `\\[org-shiftmetaright]', + `\\[org-shiftmetaleft]', + `\\[org-ctrl-c-minus]', + `\\[org-toggle-checkbox]', + `\\[org-insert-todo-heading]'. + +You can disable individually these rules by setting them to nil. +Valid rules are: checkbox when non-nil, checkbox statistics is updated each time you either insert a new checkbox or toggle a checkbox. @@ -295,13 +314,15 @@ indent when non-nil, indenting or outdenting list top-item (defcustom org-list-use-circular-motion nil "Non-nil means commands implying motion in lists should be cyclic. - +\\<org-mode-map> In that case, the item following the last item is the first one, and the item preceding the first item is the last one. -This affects the behavior of \\[org-move-item-up], - \\[org-move-item-down], \\[org-next-item] and - \\[org-previous-item]." +This affects the behavior of + `\\[org-move-item-up]', + `\\[org-move-item-down]', + `\\[org-next-item]', + `\\[org-previous-item]'." :group 'org-plain-lists :version "24.1" :type 'boolean) @@ -313,8 +334,6 @@ This hook runs even if checkbox rule in implement alternative ways of collecting statistics information.") -(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics - 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0 (defcustom org-checkbox-hierarchical-statistics t "Non-nil means checkbox statistics counts only the state of direct children. When nil, all boxes below the cookie are counted. @@ -323,8 +342,6 @@ with the word \"recursive\" in the value." :group 'org-plain-lists :type 'boolean) -(org-defvaralias 'org-description-max-indent - 'org-list-description-max-indent) ;; Since 8.0 (defcustom org-list-description-max-indent 20 "Maximum indentation for the second line of a description list. When the indentation would be larger than this, it will become @@ -367,8 +384,7 @@ list, obtained by prompting the user." (list (symbol :tag "Major mode") (string :tag "Format")))) -(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer" - "html" "latex" "odt") +(defvar org-list-forbidden-blocks '("example" "verse" "src" "export") "Names of blocks where lists are not allowed. Names must be in lower case.") @@ -383,10 +399,8 @@ specifically, type `block' is determined by the variable ;;; Predicates and regexps -(defconst org-list-end-re (if org-list-empty-line-terminates-plain-lists "^[ \t]*\n" - "^[ \t]*\n[ \t]*\n") - "Regex corresponding to the end of a list. -It depends on `org-list-empty-line-terminates-plain-lists'.") +(defconst org-list-end-re "^[ \t]*\n[ \t]*\n" + "Regex matching the end of a plain list.") (defconst org-list-full-item-re (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)" @@ -653,7 +667,7 @@ Assume point is at an item." (match-string-no-properties 2) ; counter (match-string-no-properties 3) ; checkbox ;; Description tag. - (and (save-match-data (string-match "[-+*]" bullet)) + (and (string-match-p "[-+*]" bullet) (match-string-no-properties 4))))))) (end-before-blank (function @@ -1020,7 +1034,7 @@ Possible types are `descriptive', `ordered' and `unordered'. The type is determined by the first item of the list." (let ((first (org-list-get-list-begin item struct prevs))) (cond - ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) + ((string-match-p "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) ((org-list-get-tag first struct) 'descriptive) (t 'unordered)))) @@ -1042,7 +1056,7 @@ that value." (let ((seq 0) (pos item) counter) (while (and (not (setq counter (org-list-get-counter pos struct))) (setq pos (org-list-get-prev-item pos struct prevs))) - (incf seq)) + (cl-incf seq)) (if (not counter) (1+ seq) (cond ((string-match "[A-Za-z]" counter) @@ -1222,7 +1236,7 @@ some heuristics to guess the result." (point)))))))) (cond ;; Trivial cases where there should be none. - ((or org-list-empty-line-terminates-plain-lists (not insert-blank-p)) 0) + ((not insert-blank-p) 0) ;; When `org-blank-before-new-entry' says so, it is 1. ((eq insert-blank-p t) 1) ;; `plain-list-item' is 'auto. Count blank lines separating @@ -1324,7 +1338,7 @@ This function modifies STRUCT." (size-offset (- item-size (length text-cut)))) ;; 4. Insert effectively item into buffer. (goto-char item) - (org-indent-to-column ind) + (indent-to-column ind) (insert body item-sep) ;; 5. Add new item to STRUCT. (mapc (lambda (e) @@ -1466,7 +1480,7 @@ This function returns, destructively, the new list structure." (save-excursion (goto-char (org-list-get-last-item item struct prevs)) (point-at-eol))) - ((string-match "\\`[0-9]+\\'" dest) + ((string-match-p "\\`[0-9]+\\'" dest) (let* ((all (org-list-get-all-items item struct prevs)) (len (length all)) (index (mod (string-to-number dest) len))) @@ -1481,7 +1495,7 @@ This function returns, destructively, the new list structure." (t dest))) (org-M-RET-may-split-line nil) ;; Store inner overlays (to preserve visibility). - (overlays (org-remove-if (lambda (o) (or (< (overlay-start o) item) + (overlays (cl-remove-if (lambda (o) (or (< (overlay-start o) item) (> (overlay-end o) item))) (overlays-in item item-end)))) (cond @@ -1640,7 +1654,7 @@ as returned by `org-list-prevs-alist'." (while item (let ((count (org-list-get-counter item struct))) ;; Virtually determine current bullet - (if (and count (string-match "[a-zA-Z]" count)) + (if (and count (string-match-p "[a-zA-Z]" count)) ;; Counters are not case-sensitive. (setq ascii (string-to-char (upcase count))) (setq ascii (1+ ascii))) @@ -1883,8 +1897,8 @@ Initial position of cursor is restored after the changes." ((and inlinetask-re (looking-at inlinetask-re)) (org-inlinetask-goto-beginning)) ;; Shift only non-empty lines. - ((org-looking-at-p "^[ \t]*\\S-") - (org-indent-line-to (+ (org-get-indentation) delta)))) + ((looking-at-p "^[ \t]*\\S-") + (indent-line-to (+ (org-get-indentation) delta)))) (forward-line -1))))) (modify-item (function @@ -1967,7 +1981,7 @@ Initial position of cursor is restored after the changes." (while (< (point) down) ;; Ignore empty lines. Also ignore blocks and ;; drawers contents. - (unless (org-looking-at-p "[ \t]*$") + (unless (looking-at-p "[ \t]*$") (setq min-ind (min (org-get-indentation) min-ind)) (cond ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)") @@ -2087,11 +2101,11 @@ Possible values are: `folded', `children' or `subtree'. See (if (match-beginning 2) (let ((start (1+ (match-end 2))) (ind (org-get-indentation))) - (if (> start (+ ind org-description-max-indent)) (+ ind 5) start)) + (if (> start (+ ind org-list-description-max-indent)) (+ ind 5) start)) (+ (progn (goto-char (match-end 1)) (current-column)) (if (and org-list-two-spaces-after-bullet-regexp - (org-string-match-p org-list-two-spaces-after-bullet-regexp - (match-string 1))) + (string-match-p org-list-two-spaces-after-bullet-regexp + (match-string 1))) 2 1))))) @@ -2410,7 +2424,7 @@ in subtree, ignoring drawers." (parents (org-list-parents-alist struct)) (prevs (org-list-prevs-alist struct)) (bottom (copy-marker (org-list-get-bottom-point struct))) - (items-to-toggle (org-remove-if + (items-to-toggle (cl-remove-if (lambda (e) (or (< e lim-up) (> e lim-down))) (mapcar #'car struct)))) (mapc (lambda (e) (org-list-set-checkbox @@ -2506,8 +2520,8 @@ With optional prefix argument ALL, do this for the whole buffer." (lambda (e) (org-list-get-checkbox e s)) items)))) - (incf c-all (length cookies)) - (incf c-on (org-count "[X]" cookies))))))) + (cl-incf c-all (length cookies)) + (cl-incf c-on (cl-count "[X]" cookies :test #'equal))))))) cookies-list cache) ;; Move to start. (cond (all (goto-char (point-min))) @@ -2685,7 +2699,7 @@ Return t if successful." ;; of the subtree mustn't have a child. (let ((last-item (caar (reverse - (org-remove-if + (cl-remove-if (lambda (e) (>= (car e) end)) struct))))) (org-list-has-child-p last-item struct)))) @@ -2802,7 +2816,7 @@ Return t at each successful move." ((and (= ind (car org-tab-ind-state)) (ignore-errors (org-list-indent-item-generic 1 t struct)))) (t (delete-region (point-at-bol) (point-at-eol)) - (org-indent-to-column (car org-tab-ind-state)) + (indent-to-column (car org-tab-ind-state)) (insert (cdr org-tab-ind-state) " ") ;; Break cycle (setq this-command 'identity))) @@ -2862,8 +2876,8 @@ ignores hidden links." (getkey-func (or getkey-func (and (= (downcase sorting-type) ?f) - (intern (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)))))) + (intern (completing-read "Sort using function: " + obarray 'fboundp t nil nil)))))) (message "Sorting items...") (save-restriction (narrow-to-region start end) @@ -2905,7 +2919,7 @@ ignores hidden links." (save-excursion (re-search-forward org-ts-regexp-both (point-at-eol) t))) (org-time-string-to-seconds (match-string 0))) - (t (org-float-time now)))) + (t (float-time now)))) ((= dcst ?x) (or (and (stringp (match-string 1)) (match-string 1)) "")) @@ -2929,128 +2943,249 @@ ignores hidden links." (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting items...done"))))) +(defun org-toggle-item (arg) + "Convert headings or normal lines to items, items to normal lines. +If there is no active region, only the current line is considered. + +If the first non blank line in the region is a headline, convert +all headlines to items, shifting text accordingly. + +If it is an item, convert all items to normal lines. + +If it is normal text, change region into a list of items. +With a prefix argument ARG, change the region in a single item." + (interactive "P") + (let ((shift-text + (lambda (ind end) + ;; Shift text in current section to IND, from point to END. + ;; The function leaves point to END line. + (let ((min-i 1000) (end (copy-marker end))) + ;; First determine the minimum indentation (MIN-I) of + ;; the text. + (save-excursion + (catch 'exit + (while (< (point) end) + (let ((i (org-get-indentation))) + (cond + ;; Skip blank lines and inline tasks. + ((looking-at "^[ \t]*$")) + ((looking-at org-outline-regexp-bol)) + ;; We can't find less than 0 indentation. + ((zerop i) (throw 'exit (setq min-i 0))) + ((< i min-i) (setq min-i i)))) + (forward-line)))) + ;; Then indent each line so that a line indented to + ;; MIN-I becomes indented to IND. Ignore blank lines + ;; and inline tasks in the process. + (let ((delta (- ind min-i))) + (while (< (point) end) + (unless (or (looking-at "^[ \t]*$") + (looking-at org-outline-regexp-bol)) + (indent-line-to (+ (org-get-indentation) delta))) + (forward-line)))))) + (skip-blanks + (lambda (pos) + ;; Return beginning of first non-blank line, starting from + ;; line at POS. + (save-excursion + (goto-char pos) + (skip-chars-forward " \r\t\n") + (point-at-bol)))) + beg end) + ;; Determine boundaries of changes. + (if (org-region-active-p) + (setq beg (funcall skip-blanks (region-beginning)) + end (copy-marker (region-end))) + (setq beg (funcall skip-blanks (point-at-bol)) + end (copy-marker (point-at-eol)))) + ;; Depending on the starting line, choose an action on the text + ;; between BEG and END. + (org-with-limited-levels + (save-excursion + (goto-char beg) + (cond + ;; Case 1. Start at an item: de-itemize. Note that it only + ;; happens when a region is active: `org-ctrl-c-minus' + ;; would call `org-cycle-list-bullet' otherwise. + ((org-at-item-p) + (while (< (point) end) + (when (org-at-item-p) + (skip-chars-forward " \t") + (delete-region (point) (match-end 0))) + (forward-line))) + ;; Case 2. Start at an heading: convert to items. + ((org-at-heading-p) + (let* ((bul (org-list-bullet-string "-")) + (bul-len (length bul)) + ;; Indentation of the first heading. It should be + ;; relative to the indentation of its parent, if any. + (start-ind (save-excursion + (cond + ((not org-adapt-indentation) 0) + ((not (outline-previous-heading)) 0) + (t (length (match-string 0)))))) + ;; Level of first heading. Further headings will be + ;; compared to it to determine hierarchy in the list. + (ref-level (org-reduced-level (org-outline-level)))) + (while (< (point) end) + (let* ((level (org-reduced-level (org-outline-level))) + (delta (max 0 (- level ref-level))) + (todo-state (org-get-todo-state))) + ;; If current headline is less indented than the first + ;; one, set it as reference, in order to preserve + ;; subtrees. + (when (< level ref-level) (setq ref-level level)) + ;; Remove stars and TODO keyword. + (looking-at org-todo-line-regexp) + (delete-region (point) (or (match-beginning 3) + (line-end-position))) + (insert bul) + (indent-line-to (+ start-ind (* delta bul-len))) + ;; Turn TODO keyword into a check box. + (when todo-state + (let* ((struct (org-list-struct)) + (old (copy-tree struct))) + (org-list-set-checkbox + (line-beginning-position) + struct + (if (member todo-state org-done-keywords) + "[X]" + "[ ]")) + (org-list-write-struct struct + (org-list-parents-alist struct) + old))) + ;; Ensure all text down to END (or SECTION-END) belongs + ;; to the newly created item. + (let ((section-end (save-excursion + (or (outline-next-heading) (point))))) + (forward-line) + (funcall shift-text + (+ start-ind (* (1+ delta) bul-len)) + (min end section-end))))))) + ;; Case 3. Normal line with ARG: make the first line of region + ;; an item, and shift indentation of others lines to + ;; set them as item's body. + (arg (let* ((bul (org-list-bullet-string "-")) + (bul-len (length bul)) + (ref-ind (org-get-indentation))) + (skip-chars-forward " \t") + (insert bul) + (forward-line) + (while (< (point) end) + ;; Ensure that lines less indented than first one + ;; still get included in item body. + (funcall shift-text + (+ ref-ind bul-len) + (min end (save-excursion (or (outline-next-heading) + (point))))) + (forward-line)))) + ;; Case 4. Normal line without ARG: turn each non-item line + ;; into an item. + (t + (while (< (point) end) + (unless (or (org-at-heading-p) (org-at-item-p)) + (when (looking-at "\\([ \t]*\\)\\(\\S-\\)") + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) + (forward-line)))))))) ;;; Send and receive lists -(defun org-list-parse-list (&optional delete) +(defun org-list-to-lisp (&optional delete) "Parse the list at point and maybe DELETE it. Return a list whose car is a symbol of list type, among `ordered', `unordered' and `descriptive'. Then, each item is -a list whose car is counter, and cdr are strings and other -sub-lists. Inside strings, check-boxes are replaced by -\"[CBON]\", \"[CBOFF]\" and \"[CBTRANS]\". +a list of strings and other sub-lists. For example, the following list: -1. first item - + sub-item one - + [X] sub-item two - more text in first item -2. [@3] last item + 1. first item + + sub-item one + + [X] sub-item two + more text in first item + 2. [@3] last item -will be parsed as: +is parsed as (ordered - (nil \"first item\" - (unordered - (nil \"sub-item one\") - (nil \"[CBON] sub-item two\")) - \"more text in first item\") - (3 \"last item\")) - -Point is left at list end." - (defvar parse-item) ;FIXME: Or use `cl-labels' or `letrec'. - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (parents (org-list-parents-alist struct)) - (top (org-list-get-top-point struct)) - (bottom (org-list-get-bottom-point struct)) - out - (get-text - (function - ;; Return text between BEG and END, trimmed, with - ;; checkboxes replaced. - (lambda (beg end) - (let ((text (org-trim (buffer-substring beg end)))) - (if (string-match "\\`\\[\\([-X ]\\)\\]" text) - (replace-match - (let ((box (match-string 1 text))) - (cond - ((equal box " ") "CBOFF") - ((equal box "-") "CBTRANS") - (t "CBON"))) - t nil text 1) - text))))) - (parse-sublist - (function - ;; Return a list whose car is list type and cdr a list of - ;; items' body. - (lambda (e) - (cons (org-list-get-list-type (car e) struct prevs) - (mapcar parse-item e))))) - (parse-item - (function - ;; Return a list containing counter of item, if any, text - ;; and any sublist inside it. - (lambda (e) - (let ((start (save-excursion - (goto-char e) - (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*") - (match-end 0))) - ;; Get counter number. For alphabetic counter, get - ;; its position in the alphabet. - (counter (let ((c (org-list-get-counter e struct))) - (cond - ((not c) nil) - ((string-match "[A-Za-z]" c) - (- (string-to-char (upcase (match-string 0 c))) - 64)) - ((string-match "[0-9]+" c) - (string-to-number (match-string 0 c)))))) - (childp (org-list-has-child-p e struct)) - (end (org-list-get-item-end e struct))) - ;; If item has a child, store text between bullet and - ;; next child, then recursively parse all sublists. At - ;; the end of each sublist, check for the presence of - ;; text belonging to the original item. - (if childp - (let* ((children (org-list-get-children e struct parents)) - (body (list (funcall get-text start childp)))) - (while children - (let* ((first (car children)) - (sub (org-list-get-all-items first struct prevs)) - (last-c (car (last sub))) - (last-end (org-list-get-item-end last-c struct))) - (push (funcall parse-sublist sub) body) - ;; Remove children from the list just parsed. - (setq children (cdr (member last-c children))) - ;; There is a chunk of text belonging to the - ;; item if last child doesn't end where next - ;; child starts or where item ends. - (unless (= (or (car children) end) last-end) - (push (funcall get-text - last-end (or (car children) end)) - body)))) - (cons counter (nreverse body))) - (list counter (funcall get-text start end)))))))) + (\"first item\" + (unordered + (\"sub-item one\") + (\"[X] sub-item two\")) + \"more text in first item\") + (\"[@3] last item\")) + +Point is left at list's end." + (letrec ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct)) + (top (org-list-get-top-point struct)) + (bottom (org-list-get-bottom-point struct)) + (trim + (lambda (text) + ;; Remove indentation and final newline from TEXT. + (org-remove-indentation + (if (string-match-p "\n\\'" text) + (substring text 0 -1) + text)))) + (parse-sublist + (lambda (e) + ;; Return a list whose car is list type and cdr a list + ;; of items' body. + (cons (org-list-get-list-type (car e) struct prevs) + (mapcar parse-item e)))) + (parse-item + (lambda (e) + ;; Return a list containing counter of item, if any, + ;; text and any sublist inside it. + (let* ((end (org-list-get-item-end e struct)) + (children (org-list-get-children e struct parents)) + (body + (save-excursion + (goto-char e) + (looking-at "[ \t]*\\S-+[ \t]*") + (list + (funcall + trim + (concat + (make-string (string-width (match-string 0)) ?\s) + (buffer-substring-no-properties + (match-end 0) (or (car children) end)))))))) + (while children + (let* ((child (car children)) + (sub (org-list-get-all-items child struct prevs)) + (last-in-sub (car (last sub)))) + (push (funcall parse-sublist sub) body) + ;; Remove whole sub-list from children. + (setq children (cdr (memq last-in-sub children))) + ;; There is a chunk of text belonging to the item + ;; if last child doesn't end where next child + ;; starts or where item ends. + (let ((sub-end (org-list-get-item-end last-in-sub struct)) + (next (or (car children) end))) + (when (/= sub-end next) + (push (funcall + trim + (buffer-substring-no-properties sub-end next)) + body))))) + (nreverse body))))) ;; Store output, take care of cursor position and deletion of ;; list, then return output. - (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs))) - (goto-char top) - (when delete - (delete-region top bottom) - (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re)) - (replace-match ""))) - out)) + (prog1 (funcall parse-sublist (org-list-get-all-items top struct prevs)) + (goto-char top) + (when delete + (delete-region top bottom) + (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re)) + (replace-match "")))))) (defun org-list-make-subtree () "Convert the plain list at point into a subtree." (interactive) (if (not (ignore-errors (goto-char (org-in-item-p)))) (error "Not in a list") - (let ((list (save-excursion (org-list-parse-list t)))) + (let ((list (save-excursion (org-list-to-lisp t)))) (insert (org-list-to-subtree list))))) (defun org-list-insert-radio-list () @@ -3076,11 +3211,13 @@ for this list." (catch 'exit (unless (org-at-item-p) (error "Not at a list item")) (save-excursion - (re-search-backward "#\\+ORGLST" nil t) - (unless (looking-at "\\(?:[ \t]\\)?#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)") - (if maybe (throw 'exit nil) - (error "Don't know how to transform this list")))) - (let* ((name (match-string 1)) + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*#\\+ORGLST:" nil t) + (unless (looking-at + "[ \t]*#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\([^ \t\n]+\\)") + (if maybe (throw 'exit nil) + (error "Don't know how to transform this list"))))) + (let* ((name (regexp-quote (match-string 1))) (transform (intern (match-string 2))) (bottom-point (save-excursion @@ -3092,220 +3229,342 @@ for this list." (re-search-backward "#\\+ORGLST" nil t) (re-search-forward (org-item-beginning-re) bottom-point t) (match-beginning 0))) - (plain-list (buffer-substring-no-properties top-point bottom-point)) - beg) + (plain-list (save-excursion + (goto-char top-point) + (org-list-to-lisp)))) (unless (fboundp transform) (error "No such transformation function %s" transform)) (let ((txt (funcall transform plain-list))) - ;; Find the insertion place + ;; Find the insertion(s) place(s). (save-excursion (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN RECEIVE ORGLST +" - name - "\\([ \t]\\|$\\)") - nil t) - (error "Don't know where to insert translated list")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (setq beg (point)) - (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) - (error "Cannot find end of insertion region")) - (delete-region beg (point-at-bol)) - (goto-char beg) - (insert txt "\n"))) - (message "List converted and installed at receiver location")))) - -(defsubst org-list-item-trim-br (item) - "Trim line breaks in a list ITEM." - (setq item (replace-regexp-in-string "\n +" " " item))) + (let ((receiver-count 0) + (begin-re (format "BEGIN +RECEIVE +ORGLST +%s\\([ \t]\\|$\\)" + name)) + (end-re (format "END +RECEIVE +ORGLST +%s\\([ \t]\\|$\\)" + name))) + (while (re-search-forward begin-re nil t) + (cl-incf receiver-count) + (let ((beg (line-beginning-position 2))) + (unless (re-search-forward end-re nil t) + (user-error "Cannot find end of receiver location at %d" beg)) + (beginning-of-line) + (delete-region beg (point)) + (insert txt "\n"))) + (cond + ((> receiver-count 1) + (message "List converted and installed at receiver locations")) + ((= receiver-count 1) + (message "List converted and installed at receiver location")) + (t (user-error "No valid receiver location found"))))))))) (defun org-list-to-generic (list params) - "Convert a LIST parsed through `org-list-parse-list' to other formats. -Valid parameters PARAMS are: - -:ustart String to start an unordered list -:uend String to end an unordered list - -:ostart String to start an ordered list -:oend String to end an ordered list - -:dstart String to start a descriptive list -:dend String to end a descriptive list -:dtstart String to start a descriptive term -:dtend String to end a descriptive term -:ddstart String to start a description -:ddend String to end a description - -:splice When set to t, return only list body lines, don't wrap - them into :[u/o]start and :[u/o]end. Default is nil. - -:istart String to start a list item. -:icount String to start an item with a counter. -:iend String to end a list item -:isep String to separate items -:lsep String to separate sublists -:csep String to separate text from a sub-list - -:cboff String to insert for an unchecked check-box -:cbon String to insert for a checked check-box -:cbtrans String to insert for a check-box in transitional state - -:nobr Non-nil means remove line breaks in lists items. - -Alternatively, each parameter can also be a form returning -a string. These sexp can use keywords `counter' and `depth', -representing respectively counter associated to the current -item, and depth of the current sub-list, starting at 0. -Obviously, `counter' is only available for parameters applying to -items." - (interactive) - (let* ((p params) - (splicep (plist-get p :splice)) - (ostart (plist-get p :ostart)) - (oend (plist-get p :oend)) - (ustart (plist-get p :ustart)) - (uend (plist-get p :uend)) - (dstart (plist-get p :dstart)) - (dend (plist-get p :dend)) - (dtstart (plist-get p :dtstart)) - (dtend (plist-get p :dtend)) - (ddstart (plist-get p :ddstart)) - (ddend (plist-get p :ddend)) - (istart (plist-get p :istart)) - (icount (plist-get p :icount)) - (iend (plist-get p :iend)) - (isep (plist-get p :isep)) - (lsep (plist-get p :lsep)) - (csep (plist-get p :csep)) - (cbon (plist-get p :cbon)) - (cboff (plist-get p :cboff)) - (cbtrans (plist-get p :cbtrans)) - (nobr (plist-get p :nobr)) - export-sublist ; for byte-compiler - (export-item - (function - ;; Export an item ITEM of type TYPE, at DEPTH. First - ;; string in item is treated in a special way as it can - ;; bring extra information that needs to be processed. - (lambda (item type depth) - (let* ((counter (pop item)) - (fmt (concat - (cond - ((eq type 'descriptive) - ;; Stick DTSTART to ISTART by - ;; left-trimming the latter. - (concat (let ((s (eval istart))) - (or (and (string-match "[ \t\n\r]+\\'" s) - (replace-match "" t t s)) - istart)) - "%s" (eval ddend))) - ((and counter (eq type 'ordered)) - (concat (eval icount) "%s")) - (t (concat (eval istart) "%s"))) - (eval iend))) - (first (car item))) - ;; Replace checkbox if any is found. - (cond - ((string-match "\\[CBON\\]" first) - (setq first (replace-match cbon t t first))) - ((string-match "\\[CBOFF\\]" first) - (setq first (replace-match cboff t t first))) - ((string-match "\\[CBTRANS\\]" first) - (setq first (replace-match cbtrans t t first)))) - ;; Replace line breaks if required - (when nobr (setq first (org-list-item-trim-br first))) - ;; Insert descriptive term if TYPE is `descriptive'. - (when (eq type 'descriptive) - (let* ((complete - (string-match "^\\(.*\\)[ \t]+::[ \t]*" first)) - (term (if complete - (save-match-data - (org-trim (match-string 1 first))) - "???")) - (desc (if complete (substring first (match-end 0)) - first))) - (setq first (concat (eval dtstart) term (eval dtend) - (eval ddstart) desc)))) - (setcar item first) - (format fmt - (mapconcat (lambda (e) - (if (stringp e) e - (funcall export-sublist e (1+ depth)))) - item (or (eval csep) ""))))))) - (export-sublist - (function - ;; Export sublist SUB at DEPTH. - (lambda (sub depth) - (let* ((type (car sub)) - (items (cdr sub)) - (fmt (concat (cond - (splicep "%s") - ((eq type 'ordered) - (concat (eval ostart) "%s" (eval oend))) - ((eq type 'descriptive) - (concat (eval dstart) "%s" (eval dend))) - (t (concat (eval ustart) "%s" (eval uend)))) - (eval lsep)))) - (format fmt (mapconcat (lambda (e) - (funcall export-item e type depth)) - items (or (eval isep) "")))))))) - (concat (funcall export-sublist list 0) "\n"))) - -(defun org-list-to-latex (list &optional _params) + "Convert a LIST parsed through `org-list-to-lisp' to a custom format. + +LIST is a list as returned by `org-list-to-lisp', which see. +PARAMS is a property list of parameters used to tweak the output +format. + +Valid parameters are: + +:backend, :raw + + Export back-end used as a basis to transcode elements of the + list, when no specific parameter applies to it. It is also + used to translate its contents. You can prevent this by + setting :raw property to a non-nil value. + +:splice + + When non-nil, only export the contents of the top most plain + list, effectively ignoring its opening and closing lines. + +:ustart, :uend + + Strings to start and end an unordered list. They can also be + set to a function returning a string or nil, which will be + called with the depth of the list, counting from 1. + +:ostart, :oend + + Strings to start and end an ordered list. They can also be set + to a function returning a string or nil, which will be called + with the depth of the list, counting from 1. + +:dstart, :dend + + Strings to start and end a descriptive list. They can also be + set to a function returning a string or nil, which will be + called with the depth of the list, counting from 1. + +:dtstart, :dtend, :ddstart, :ddend + + Strings to start and end a descriptive term. + +:istart, :iend + + Strings to start or end a list item, and to start a list item + with a counter. They can also be set to a function returning + a string or nil, which will be called with the depth of the + item, counting from 1. + +:icount + + Strings to start a list item with a counter. It can also be + set to a function returning a string or nil, which will be + called with two arguments: the depth of the item, counting from + 1, and the counter. Its value, when non-nil, has precedence + over `:istart'. + +:isep + + String used to separate items. It can also be set to + a function returning a string or nil, which will be called with + the depth of the items, counting from 1. It always start on + a new line. + +:cbon, :cboff, :cbtrans + + String to insert, respectively, an un-checked check-box, + a checked check-box and a check-box in transitional state." + (require 'ox) + (let* ((backend (plist-get params :backend)) + (custom-backend + (org-export-create-backend + :parent (or backend 'org) + :transcoders + `((plain-list . ,(org-list--to-generic-plain-list params)) + (item . ,(org-list--to-generic-item params)) + (macro . (lambda (m c i) (org-element-macro-interpreter m nil)))))) + data info) + ;; Write LIST back into Org syntax and parse it. + (with-temp-buffer + (let ((org-inhibit-startup t)) (org-mode)) + (letrec ((insert-list + (lambda (l) + (dolist (i (cdr l)) + (funcall insert-item i (car l))))) + (insert-item + (lambda (i type) + (let ((start (point))) + (insert (if (eq type 'ordered) "1. " "- ")) + (dolist (e i) + (if (consp e) (funcall insert-list e) + (insert e) + (insert "\n"))) + (beginning-of-line) + (save-excursion + (let ((ind (if (eq type 'ordered) 3 2))) + (while (> (point) start) + (unless (looking-at-p "[ \t]*$") + (indent-to ind)) + (forward-line -1)))))))) + (funcall insert-list list)) + (setf data + (org-element-map (org-element-parse-buffer) 'plain-list + #'identity nil t)) + (setf info (org-export-get-environment backend nil params))) + (when (and backend (symbolp backend) (not (org-export-get-backend backend))) + (user-error "Unknown :backend value")) + (unless backend (require 'ox-org)) + ;; When`:raw' property has a non-nil value, turn all objects back + ;; into Org syntax. + (when (and backend (plist-get params :raw)) + (org-element-map data org-element-all-objects + (lambda (object) + (org-element-set-element + object (org-element-interpret-data object))))) + ;; We use a low-level mechanism to export DATA so as to skip all + ;; usual pre-processing and post-processing, i.e., hooks, filters, + ;; Babel code evaluation, include keywords and macro expansion, + ;; and filters. + (let ((output (org-export-data-with-backend data custom-backend info))) + ;; Remove final newline. + (if (org-string-nw-p output) (substring-no-properties output 0 -1) "")))) + +(defun org-list--depth (element) + "Return the level of ELEMENT within current plain list. +ELEMENT is either an item or a plain list." + (cl-count-if (lambda (ancestor) (eq (org-element-type ancestor) 'plain-list)) + (org-element-lineage element nil t))) + +(defun org-list--trailing-newlines (string) + "Return the number of trailing newlines in STRING." + (with-temp-buffer + (insert string) + (skip-chars-backward " \t\n") + (count-lines (line-beginning-position 2) (point-max)))) + +(defun org-list--generic-eval (value &rest args) + "Evaluate VALUE according to its type. +VALUE is either nil, a string or a function. In the latter case, +it is called with arguments ARGS." + (cond ((null value) nil) + ((stringp value) value) + ((functionp value) (apply value args)) + (t (error "Wrong value: %s" value)))) + +(defun org-list--to-generic-plain-list (params) + "Return a transcoder for `plain-list' elements. +PARAMS is a plist used to tweak the behavior of the transcoder." + (let ((ustart (plist-get params :ustart)) + (uend (plist-get params :uend)) + (ostart (plist-get params :ostart)) + (oend (plist-get params :oend)) + (dstart (plist-get params :dstart)) + (dend (plist-get params :dend)) + (splice (plist-get params :splice)) + (backend (plist-get params :backend))) + (lambda (plain-list contents info) + (let* ((type (org-element-property :type plain-list)) + (depth (org-list--depth plain-list)) + (start (and (not splice) + (org-list--generic-eval + (pcase type + (`ordered ostart) + (`unordered ustart) + (_ dstart)) + depth))) + (end (and (not splice) + (org-list--generic-eval + (pcase type + (`ordered oend) + (`unordered uend) + (_ dend)) + depth)))) + ;; Make sure trailing newlines in END appear in the output by + ;; setting `:post-blank' property to their number. + (when end + (org-element-put-property + plain-list :post-blank (org-list--trailing-newlines end))) + ;; Build output. + (concat (and start (concat start "\n")) + (if (or start end splice (not backend)) + contents + (org-export-with-backend backend plain-list contents info)) + end))))) + +(defun org-list--to-generic-item (params) + "Return a transcoder for `item' elements. +PARAMS is a plist used to tweak the behavior of the transcoder." + (let ((backend (plist-get params :backend)) + (istart (plist-get params :istart)) + (iend (plist-get params :iend)) + (isep (plist-get params :isep)) + (icount (plist-get params :icount)) + (cboff (plist-get params :cboff)) + (cbon (plist-get params :cbon)) + (cbtrans (plist-get params :cbtrans)) + (dtstart (plist-get params :dtstart)) + (dtend (plist-get params :dtend)) + (ddstart (plist-get params :ddstart)) + (ddend (plist-get params :ddend))) + (lambda (item contents info) + (let* ((type + (org-element-property :type (org-element-property :parent item))) + (tag (org-element-property :tag item)) + (depth (org-list--depth item)) + (separator (and (org-export-get-next-element item info) + (org-list--generic-eval isep depth))) + (closing (pcase (org-list--generic-eval iend depth) + ((or `nil `"") "\n") + ((and (guard separator) s) + (if (equal (substring s -1) "\n") s (concat s "\n"))) + (s s)))) + ;; When a closing line or a separator is provided, make sure + ;; its trailing newlines are taken into account when building + ;; output. This is done by setting `:post-blank' property to + ;; the number of such lines in the last line to be added. + (let ((last-string (or separator closing))) + (when last-string + (org-element-put-property + item + :post-blank + (max (1- (org-list--trailing-newlines last-string)) 0)))) + ;; Build output. + (concat + (let ((c (org-element-property :counter item))) + (if c (org-list--generic-eval icount depth c) + (org-list--generic-eval istart depth))) + (let ((body + (if (or istart iend icount cbon cboff cbtrans (not backend) + (and (eq type 'descriptive) + (or dtstart dtend ddstart ddend))) + (concat + (pcase (org-element-property :checkbox item) + (`on cbon) + (`off cboff) + (`trans cbtrans)) + (and tag + (concat dtstart + (if backend + (org-export-data-with-backend + tag backend info) + (org-element-interpret-data tag)) + dtend)) + (and tag ddstart) + (if (= (length contents) 0) "" (substring contents 0 -1)) + (and tag ddend)) + (org-export-with-backend backend item contents info)))) + ;; Remove final newline. + (if (equal body "") "" + (substring (org-element-normalize-string body) 0 -1))) + closing + separator))))) + +(defun org-list-to-latex (list &optional params) "Convert LIST into a LaTeX list. -LIST is as string representing the list to transform, as Org -syntax. Return converted list as a string." +LIST is a parsed plain list, as returned by `org-list-to-lisp'. +PARAMS is a property list with overruling parameters for +`org-list-to-generic'. Return converted list as a string." (require 'ox-latex) - (org-export-string-as list 'latex t)) + (org-list-to-generic list (org-combine-plists '(:backend latex) params))) -(defun org-list-to-html (list) +(defun org-list-to-html (list &optional params) "Convert LIST into a HTML list. -LIST is as string representing the list to transform, as Org -syntax. Return converted list as a string." +LIST is a parsed plain list, as returned by `org-list-to-lisp'. +PARAMS is a property list with overruling parameters for +`org-list-to-generic'. Return converted list as a string." (require 'ox-html) - (org-export-string-as list 'html t)) + (org-list-to-generic list (org-combine-plists '(:backend html) params))) -(defun org-list-to-texinfo (list &optional _params) +(defun org-list-to-texinfo (list &optional params) "Convert LIST into a Texinfo list. -LIST is as string representing the list to transform, as Org -syntax. Return converted list as a string." +LIST is a parsed plain list, as returned by `org-list-to-lisp'. +PARAMS is a property list with overruling parameters for +`org-list-to-generic'. Return converted list as a string." (require 'ox-texinfo) - (org-export-string-as list 'texinfo t)) + (org-list-to-generic list (org-combine-plists '(:backend texinfo) params))) (defun org-list-to-subtree (list &optional params) "Convert LIST into an Org subtree. -LIST is as returned by `org-list-parse-list'. PARAMS is a property list -with overruling parameters for `org-list-to-generic'." - (defvar get-stars) (defvar org--blankp) - (let* ((rule (cdr (assq 'heading org-blank-before-new-entry))) +LIST is as returned by `org-list-to-lisp'. PARAMS is a property +list with overruling parameters for `org-list-to-generic'." + (let* ((blank (pcase (cdr (assq 'heading org-blank-before-new-entry)) + (`t t) + (`auto (save-excursion + (org-with-limited-levels (outline-previous-heading)) + (org-previous-line-empty-p))))) (level (org-reduced-level (or (org-current-level) 0))) - (org--blankp (or (eq rule t) - (and (eq rule 'auto) - (save-excursion - (outline-previous-heading) - (org-previous-line-empty-p))))) - (get-stars ;FIXME: Can't rename without renaming it in org.el as well! - (function - ;; Return the string for the heading, depending on depth D - ;; of current sub-list. - (lambda (d) - (let ((oddeven-level (+ level d 1))) - (concat (make-string (if org-odd-levels-only - (1- (* 2 oddeven-level)) - oddeven-level) - ?*) - " ")))))) + (make-stars + (lambda (depth) + ;; Return the string for the heading, depending on DEPTH + ;; of current sub-list. + (let ((oddeven-level (+ level depth))) + (concat (make-string (if org-odd-levels-only + (1- (* 2 oddeven-level)) + oddeven-level) + ?*) + " "))))) (org-list-to-generic list (org-combine-plists - '(:splice t - :dtstart " " :dtend " " - :istart (funcall get-stars depth) - :icount (funcall get-stars depth) - :isep (if org--blankp "\n\n" "\n") - :csep (if org--blankp "\n\n" "\n") - :cbon "DONE" :cboff "TODO" :cbtrans "TODO") + (list :splice t + :istart make-stars + :icount make-stars + :dtstart " " :dtend " " + :isep (if blank "\n\n" "\n") + :cbon "DONE " :cboff "TODO " :cbtrans "TODO ") params)))) (provide 'org-list) diff --git a/lisp/org-loaddefs.el b/lisp/org-loaddefs.el index b61eaa3..5bc5fef 100644 --- a/lisp/org-loaddefs.el +++ b/lisp/org-loaddefs.el @@ -2,28 +2,86 @@ ;; ;;; Code: -;;;### (autoloads (org-babel-mark-block org-babel-previous-src-block -;;;;;; org-babel-next-src-block org-babel-goto-named-result org-babel-goto-named-src-block -;;;;;; org-babel-goto-src-block-head org-babel-hide-result-toggle-maybe -;;;;;; org-babel-sha1-hash org-babel-execute-subtree org-babel-execute-buffer -;;;;;; org-babel-map-executables org-babel-map-call-lines org-babel-map-inline-src-blocks -;;;;;; org-babel-map-src-blocks org-babel-open-src-block-result -;;;;;; org-babel-do-in-edit-buffer org-babel-switch-to-session-with-code -;;;;;; org-babel-switch-to-session org-babel-initiate-session org-babel-load-in-session -;;;;;; org-babel-insert-header-arg org-babel-check-src-block org-babel-expand-src-block -;;;;;; org-babel-execute-src-block org-babel-pop-to-session-maybe -;;;;;; org-babel-load-in-session-maybe org-babel-expand-src-block-maybe -;;;;;; org-babel-view-src-block-info org-babel-execute-maybe org-babel-execute-safely-maybe) -;;;;;; "ob-core" "ob-core.el" "ee83b8920bd29f8ac10c08e0b4271f48") +;;;### (autoloads nil "ob-C" "ob-C.el" (0 0 0 0)) +;;; Generated autoloads from ob-C.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-C" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-J" "ob-J.el" (0 0 0 0)) +;;; Generated autoloads from ob-J.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-J" '("obj-" "org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-R" "ob-R.el" (0 0 0 0)) +;;; Generated autoloads from ob-R.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("ob-R-" "org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-abc" "ob-abc.el" (0 0 0 0)) +;;; Generated autoloads from ob-abc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-abc" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-asymptote" "ob-asymptote.el" (0 0 0 0)) +;;; Generated autoloads from ob-asymptote.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-asymptote" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-awk" "ob-awk.el" (0 0 0 0)) +;;; Generated autoloads from ob-awk.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-awk" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-calc" "ob-calc.el" (0 0 0 0)) +;;; Generated autoloads from ob-calc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-calc" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-clojure" "ob-clojure.el" (0 0 0 0)) +;;; Generated autoloads from ob-clojure.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-clojure" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-comint" "ob-comint.el" (0 0 0 0)) +;;; Generated autoloads from ob-comint.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-comint" '("org-babel-comint-"))) + +;;;*** + +;;;### (autoloads nil "ob-coq" "ob-coq.el" (0 0 0 0)) +;;; Generated autoloads from ob-coq.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-coq" '("org-babel-" "coq-program-name"))) + +;;;*** + +;;;### (autoloads nil "ob-core" "ob-core.el" (0 0 0 0)) ;;; Generated autoloads from ob-core.el (autoload 'org-babel-execute-safely-maybe "ob-core" "\ -Not documented + \(fn)" nil nil) (autoload 'org-babel-execute-maybe "ob-core" "\ -Not documented + \(fn)" t nil) @@ -78,7 +136,7 @@ Expand the current source code block. Expand according to the source code block's header arguments and pop open the results in a preview buffer. -\(fn &optional _ARG INFO PARAMS)" t nil) +\(fn &optional ARG INFO PARAMS)" t nil) (autoload 'org-babel-check-src-block "ob-core" "\ Check for misspelled header arguments in the current code block. @@ -96,7 +154,7 @@ Evaluate the header arguments for the source block before entering the session. After loading the body this pops open the session. -\(fn &optional _ARG INFO)" t nil) +\(fn &optional ARG INFO)" t nil) (autoload 'org-babel-initiate-session "ob-core" "\ Initiate session for current code block. @@ -117,13 +175,13 @@ with a prefix argument then this is passed on to (autoload 'org-babel-switch-to-session-with-code "ob-core" "\ Switch to code buffer and display session. -\(fn &optional ARG _INFO)" t nil) +\(fn &optional ARG INFO)" t nil) (autoload 'org-babel-do-in-edit-buffer "ob-core" "\ Evaluate BODY in edit buffer if there is a code block at point. Return t if a code block was found at point, nil otherwise. -\(fn &rest BODY)" nil (quote macro)) +\(fn &rest BODY)" nil t) (autoload 'org-babel-open-src-block-result "ob-core" "\ If `point' is on a src block then open the results of the @@ -155,26 +213,36 @@ body ------------- string holding the body of the code block beg-body --------- point at the beginning of the body end-body --------- point at the end of the body -\(fn FILE &rest BODY)" nil (quote macro)) +\(fn FILE &rest BODY)" nil t) + +(function-put 'org-babel-map-src-blocks 'lisp-indent-function '1) (autoload 'org-babel-map-inline-src-blocks "ob-core" "\ -Evaluate BODY forms on each inline source-block in FILE. +Evaluate BODY forms on each inline source block in FILE. If FILE is nil evaluate BODY forms on source blocks in current buffer. -\(fn FILE &rest BODY)" nil (quote macro)) +\(fn FILE &rest BODY)" nil t) + +(function-put 'org-babel-map-inline-src-blocks 'lisp-indent-function '1) (autoload 'org-babel-map-call-lines "ob-core" "\ Evaluate BODY forms on each call line in FILE. If FILE is nil evaluate BODY forms on source blocks in current buffer. -\(fn FILE &rest BODY)" nil (quote macro)) +\(fn FILE &rest BODY)" nil t) + +(function-put 'org-babel-map-call-lines 'lisp-indent-function '1) (autoload 'org-babel-map-executables "ob-core" "\ -Not documented +Evaluate BODY forms on each active Babel code in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer. + +\(fn FILE &rest BODY)" nil t) -\(fn FILE &rest BODY)" nil (quote macro)) +(function-put 'org-babel-map-executables 'lisp-indent-function '1) (autoload 'org-babel-execute-buffer "ob-core" "\ Execute source code blocks in a buffer. @@ -232,10 +300,116 @@ Mark current src block. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-core" '("org-"))) + +;;;*** + +;;;### (autoloads nil "ob-css" "ob-css.el" (0 0 0 0)) +;;; Generated autoloads from ob-css.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-css" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-ditaa" "ob-ditaa.el" (0 0 0 0)) +;;; Generated autoloads from ob-ditaa.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ditaa" '("org-"))) + +;;;*** + +;;;### (autoloads nil "ob-dot" "ob-dot.el" (0 0 0 0)) +;;; Generated autoloads from ob-dot.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-dot" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-ebnf" "ob-ebnf.el" (0 0 0 0)) +;;; Generated autoloads from ob-ebnf.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ebnf" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-emacs-lisp" "ob-emacs-lisp.el" (0 0 0 0)) +;;; Generated autoloads from ob-emacs-lisp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-emacs-lisp" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-eval" "ob-eval.el" (0 0 0 0)) +;;; Generated autoloads from ob-eval.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-eval" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-exp" "ob-exp.el" (0 0 0 0)) +;;; Generated autoloads from ob-exp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-exp" '("org-"))) + +;;;*** + +;;;### (autoloads nil "ob-forth" "ob-forth.el" (0 0 0 0)) +;;; Generated autoloads from ob-forth.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-forth" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-fortran" "ob-fortran.el" (0 0 0 0)) +;;; Generated autoloads from ob-fortran.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-fortran" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-gnuplot" "ob-gnuplot.el" (0 0 0 0)) +;;; Generated autoloads from ob-gnuplot.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-gnuplot" '("org-babel-" "*org-babel-gnuplot-"))) + +;;;*** + +;;;### (autoloads nil "ob-groovy" "ob-groovy.el" (0 0 0 0)) +;;; Generated autoloads from ob-groovy.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-groovy" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-haskell" "ob-haskell.el" (0 0 0 0)) +;;; Generated autoloads from ob-haskell.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-haskell" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-io" "ob-io.el" (0 0 0 0)) +;;; Generated autoloads from ob-io.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-io" '("org-babel-"))) + ;;;*** -;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "ob-keys.el" -;;;;;; "24762aeb15b93f86ba40d1649d47134a") +;;;### (autoloads nil "ob-java" "ob-java.el" (0 0 0 0)) +;;; Generated autoloads from ob-java.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-java" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-js" "ob-js.el" (0 0 0 0)) +;;; Generated autoloads from ob-js.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-js" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-keys" "ob-keys.el" (0 0 0 0)) ;;; Generated autoloads from ob-keys.el (autoload 'org-babel-describe-bindings "ob-keys" "\ @@ -243,10 +417,39 @@ Describe all keybindings behind `org-babel-key-prefix'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-keys" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-latex" "ob-latex.el" (0 0 0 0)) +;;; Generated autoloads from ob-latex.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-ledger" "ob-ledger.el" (0 0 0 0)) +;;; Generated autoloads from ob-ledger.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ledger" '("org-babel-"))) + ;;;*** -;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe) -;;;;;; "ob-lob" "ob-lob.el" "642d1791b061066c54b8ff95e332f856") +;;;### (autoloads nil "ob-lilypond" "ob-lilypond.el" (0 0 0 0)) +;;; Generated autoloads from ob-lilypond.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lilypond" '("org-babel-" "lilypond-mode"))) + +;;;*** + +;;;### (autoloads nil "ob-lisp" "ob-lisp.el" (0 0 0 0)) +;;; Generated autoloads from ob-lisp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lisp" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-lob" "ob-lob.el" (0 0 0 0)) ;;; Generated autoloads from ob-lob.el (autoload 'org-babel-lob-execute-maybe "ob-lob" "\ @@ -257,14 +460,193 @@ if so then run the appropriate source block from the Library. \(fn)" t nil) (autoload 'org-babel-lob-get-info "ob-lob" "\ -Return a Library of Babel function call as a string. +Return internal representation for Library of Babel function call. +Consider DATUM, when provided, or element at point. Return nil +when not on an appropriate location. Otherwise return a list +compatible with `org-babel-get-src-block-info', which see. -\(fn)" nil nil) +\(fn &optional DATUM)" nil nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lob" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-lua" "ob-lua.el" (0 0 0 0)) +;;; Generated autoloads from ob-lua.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lua" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-makefile" "ob-makefile.el" (0 0 0 0)) +;;; Generated autoloads from ob-makefile.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-makefile" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-maxima" "ob-maxima.el" (0 0 0 0)) +;;; Generated autoloads from ob-maxima.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-maxima" '("org-babel-"))) ;;;*** -;;;### (autoloads (org-babel-tangle org-babel-tangle-file) "ob-tangle" -;;;;;; "ob-tangle.el" "3ba1e4bcd6d4b3c9293130baa1e76017") +;;;### (autoloads nil "ob-mscgen" "ob-mscgen.el" (0 0 0 0)) +;;; Generated autoloads from ob-mscgen.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-mscgen" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-ocaml" "ob-ocaml.el" (0 0 0 0)) +;;; Generated autoloads from ob-ocaml.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ocaml" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-octave" "ob-octave.el" (0 0 0 0)) +;;; Generated autoloads from ob-octave.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-octave" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-org" "ob-org.el" (0 0 0 0)) +;;; Generated autoloads from ob-org.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-org" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-perl" "ob-perl.el" (0 0 0 0)) +;;; Generated autoloads from ob-perl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-perl" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-picolisp" "ob-picolisp.el" (0 0 0 0)) +;;; Generated autoloads from ob-picolisp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-picolisp" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-plantuml" "ob-plantuml.el" (0 0 0 0)) +;;; Generated autoloads from ob-plantuml.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-plantuml" '("org-"))) + +;;;*** + +;;;### (autoloads nil "ob-processing" "ob-processing.el" (0 0 0 0)) +;;; Generated autoloads from ob-processing.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-processing" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-python" "ob-python.el" (0 0 0 0)) +;;; Generated autoloads from ob-python.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-python" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-ref" "ob-ref.el" (0 0 0 0)) +;;; Generated autoloads from ob-ref.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ref" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-ruby" "ob-ruby.el" (0 0 0 0)) +;;; Generated autoloads from ob-ruby.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ruby" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-sass" "ob-sass.el" (0 0 0 0)) +;;; Generated autoloads from ob-sass.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sass" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-scala" "ob-scala.el" (0 0 0 0)) +;;; Generated autoloads from ob-scala.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-scala" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-scheme" "ob-scheme.el" (0 0 0 0)) +;;; Generated autoloads from ob-scheme.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-scheme" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-screen" "ob-screen.el" (0 0 0 0)) +;;; Generated autoloads from ob-screen.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-screen" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-sed" "ob-sed.el" (0 0 0 0)) +;;; Generated autoloads from ob-sed.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sed" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-shell" "ob-shell.el" (0 0 0 0)) +;;; Generated autoloads from ob-shell.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shell" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-shen" "ob-shen.el" (0 0 0 0)) +;;; Generated autoloads from ob-shen.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shen" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-sql" "ob-sql.el" (0 0 0 0)) +;;; Generated autoloads from ob-sql.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-sqlite" "ob-sqlite.el" (0 0 0 0)) +;;; Generated autoloads from ob-sqlite.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sqlite" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-stan" "ob-stan.el" (0 0 0 0)) +;;; Generated autoloads from ob-stan.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-stan" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-table" "ob-table.el" (0 0 0 0)) +;;; Generated autoloads from ob-table.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-table" '("org-"))) + +;;;*** + +;;;### (autoloads nil "ob-tangle" "ob-tangle.el" (0 0 0 0)) ;;; Generated autoloads from ob-tangle.el (autoload 'org-babel-tangle-file "ob-tangle" "\ @@ -290,15 +672,11 @@ used to limit the exported source code blocks by language. \(fn &optional ARG TARGET-FILE LANG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-tangle" '("org-babel-"))) + ;;;*** -;;;### (autoloads (org-agenda-to-appt org-calendar-goto-agenda org-agenda-set-restriction-lock -;;;;;; org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item -;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list -;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views -;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda -;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org-agenda.el" -;;;;;; (22194 60218)) +;;;### (autoloads nil "org-agenda" "org-agenda.el" (0 0 0 0)) ;;; Generated autoloads from org-agenda.el (autoload 'org-toggle-sticky-agenda "org-agenda" "\ @@ -335,9 +713,9 @@ More commands can be added by configuring the variable `org-agenda-custom-commands'. In particular, specific tags and TODO keyword searches can be pre-defined in this way. -If the current buffer is in Org-mode and visiting a file, you can also +If the current buffer is in Org mode and visiting a file, you can also first press `<' once to indicate that the agenda should be temporarily -\(until the next use of \\[org-agenda]) restricted to the current file. +\(until the next use of `\\[org-agenda]') restricted to the current file. Pressing `<' twice means to restrict to the current subtree or region \(if active). @@ -351,7 +729,7 @@ longer string it is used as a tags/todo match string. Parameters are alternating variable names and values that will be bound before running the agenda command. -\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro)) +\(fn CMD-KEY &rest PARAMETERS)" nil t) (autoload 'org-batch-agenda-csv "org-agenda" "\ Run an agenda command in batch mode and send the result to STDOUT. @@ -388,7 +766,7 @@ priority-l The priority letter if any was given priority-n The computed numerical priority agenda-day The day in the agenda where this is listed -\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro)) +\(fn CMD-KEY &rest PARAMETERS)" nil t) (autoload 'org-store-agenda-views "org-agenda" "\ Store agenda views. @@ -398,7 +776,7 @@ Store agenda views. (autoload 'org-batch-store-agenda-views "org-agenda" "\ Run all custom agenda commands that have a file argument. -\(fn &rest PARAMETERS)" nil (quote macro)) +\(fn &rest PARAMETERS)" nil t) (autoload 'org-agenda-list "org-agenda" "\ Produce a daily/weekly view from all files in variable `org-agenda-files'. @@ -466,7 +844,7 @@ in `org-agenda-text-search-extra-files'. (autoload 'org-todo-list "org-agenda" "\ Show all (not done) TODO entries from all agenda file in a single list. The prefix arg can be used to select a specific TODO keyword and limit -the list to these. When using \\[universal-argument], you will be prompted +the list to these. When using `\\[universal-argument]', you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'. @@ -529,15 +907,15 @@ in the file. Otherwise, restriction will be to the current subtree. \(fn &optional TYPE)" t nil) (autoload 'org-calendar-goto-agenda "org-agenda" "\ -Compute the Org-mode agenda for the calendar date displayed at the cursor. +Compute the Org agenda for the calendar date displayed at the cursor. This is a command that has to be installed in `calendar-mode-map'. \(fn)" t nil) (autoload 'org-agenda-to-appt "org-agenda" "\ Activate appointments found in `org-agenda-files'. -With a \\[universal-argument] prefix, refresh the list of -appointments. + +With a `\\[universal-argument]' prefix, refresh the list of appointments. If FILTER is t, interactively prompt the user for a regular expression, and filter out entries that don't match it. @@ -569,12 +947,11 @@ to override `appt-message-warning-time'. \(fn &optional REFRESH FILTER &rest ARGS)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-agenda" '("org-"))) + ;;;*** -;;;### (autoloads (org-archive-subtree-default-with-confirmation -;;;;;; org-archive-subtree-default org-toggle-archive-tag org-archive-to-archive-sibling -;;;;;; org-archive-subtree org-add-archive-files) "org-archive" -;;;;;; "org-archive.el" "49615e9b6aa6314b77b090b118280556") +;;;### (autoloads nil "org-archive" "org-archive.el" (0 0 0 0)) ;;; Generated autoloads from org-archive.el (autoload 'org-add-archive-files "org-archive" "\ @@ -627,9 +1004,11 @@ This command is set with the variable `org-archive-default-command'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-archive" '("org-"))) + ;;;*** -;;;### (autoloads (org-attach) "org-attach" "org-attach.el" "1e4c1afefe41ea28817861da7ea71ce6") +;;;### (autoloads nil "org-attach" "org-attach.el" (0 0 0 0)) ;;; Generated autoloads from org-attach.el (autoload 'org-attach "org-attach" "\ @@ -638,10 +1017,11 @@ Shows a list of commands and prompts for another key to execute a command. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-attach" '("org-attach-"))) + ;;;*** -;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org-bbdb.el" -;;;;;; "e782f707a5a0d3b8a8fd76825deb4111") +;;;### (autoloads nil "org-bbdb" "org-bbdb.el" (0 0 0 0)) ;;; Generated autoloads from org-bbdb.el (autoload 'org-bbdb-anniversaries "org-bbdb" "\ @@ -649,11 +1029,23 @@ Extract anniversaries from BBDB for display in the agenda. \(fn)" nil nil) +(autoload 'org-bbdb-anniversaries-future "org-bbdb" "\ +Return list of anniversaries for today and the next n-1 days (default n=7). + +\(fn &optional N)" nil nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-bbdb" '("org-bbdb-"))) + +;;;*** + +;;;### (autoloads nil "org-bibtex" "org-bibtex.el" (0 0 0 0)) +;;; Generated autoloads from org-bibtex.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-bibtex" '("org-"))) + ;;;*** -;;;### (autoloads (org-capture-import-remember-templates org-capture -;;;;;; org-capture-string) "org-capture" "org-capture.el" (22200 -;;;;;; 12002)) +;;;### (autoloads nil "org-capture" "org-capture.el" (0 0 0 0)) ;;; Generated autoloads from org-capture.el (autoload 'org-capture-string "org-capture" "\ @@ -664,16 +1056,17 @@ Capture STRING with the template selected by KEYS. (autoload 'org-capture "org-capture" "\ Capture something. \\<org-capture-mode-map> -This will let you select a template from `org-capture-templates', and then -file the newly captured information. The text is immediately inserted -at the target location, and an indirect buffer is shown where you can -edit it. Pressing \\[org-capture-finalize] brings you back to the previous state -of Emacs, so that you can continue your work. +This will let you select a template from `org-capture-templates', and +then file the newly captured information. The text is immediately +inserted at the target location, and an indirect buffer is shown where +you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the previous +state of Emacs, so that you can continue your work. -When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture -anything, just go to the file/headline where the selected template -stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last note -stored. +When called interactively with a `\\[universal-argument]' prefix argument GOTO, don't +capture anything, just go to the file/headline where the selected +template stores its notes. + +With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to the last note stored. When called with a `C-0' (zero) prefix, insert a template at point. @@ -693,18 +1086,15 @@ Set `org-capture-templates' to be similar to `org-remember-templates'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-capture" '("org-"))) + ;;;*** -;;;### (autoloads (org-clock-update-time-maybe org-dblock-write:clocktable -;;;;;; org-clocktable-shift org-clock-report org-clock-get-clocktable -;;;;;; org-clock-remove-overlays org-clock-display org-clock-sum -;;;;;; org-clock-goto org-clock-cancel org-clock-out org-clock-in-last -;;;;;; org-clock-in org-resolve-clocks) "org-clock" "org-clock.el" -;;;;;; "133b6d837d46606bf3b4f1753035bca8") +;;;### (autoloads nil "org-clock" "org-clock.el" (0 0 0 0)) ;;; Generated autoloads from org-clock.el (autoload 'org-resolve-clocks "org-clock" "\ -Resolve all currently open org-mode clocks. +Resolve all currently open Org clocks. If `only-dangling-p' is non-nil, only ask to resolve dangling \(i.e., not currently open and valid) clocks. @@ -712,14 +1102,19 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (autoload 'org-clock-in "org-clock" "\ Start the clock on the current item. + If necessary, clock-out of the currently active clock. -With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked -tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task -and mark it as the default task, a special task that will always be offered -in the clocking selection, associated with the letter `d'. -When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], clock in by using the last clock-out -time as the start time (see `org-clock-continuously' to -make this the default behavior.) + +With a `\\[universal-argument]' prefix argument SELECT, offer a list of recently clocked +tasks to clock into. + +When SELECT is `\\[universal-argument] \\[universal-argument]', clock into the current task and mark it as +the default task, a special task that will always be offered in the +clocking selection, associated with the letter `d'. + +When SELECT is `\\[universal-argument] \\[universal-argument] \\[universal-argument]', clock in by using the last clock-out +time as the start time. See `org-clock-continuously' to make this +the default behavior. \(fn &optional SELECT START-TIME)" t nil) @@ -770,19 +1165,22 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes. Show subtree times in the entire buffer. By default, show the total time for the range defined in -`org-clock-display-default-range'. With \\[universal-argument] prefix, show -the total time for today instead. With \\[universal-argument] \\[universal-argument] prefix, use -a custom range, entered at the prompt. With \\[universal-argument] \\[universal-argument] \\[universal-argument] -prefix, display the total time in the echo area. +`org-clock-display-default-range'. With `\\[universal-argument]' prefix, show +the total time for today instead. -Use \\[org-clock-remove-overlays] to remove the subtree times. +With `\\[universal-argument] \\[universal-argument]' prefix, use a custom range, entered at prompt. + +With `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix, display the total time in the +echo area. + +Use `\\[org-clock-remove-overlays]' to remove the subtree times. \(fn &optional ARG)" t nil) (autoload 'org-clock-remove-overlays "org-clock" "\ Remove the occur highlights from the buffer. -BEG and END are ignored. If NOREMOVE is nil, remove this function -from the `before-change-functions' in the current buffer. +If NOREMOVE is nil, remove this function from the +`before-change-functions' in the current buffer. \(fn &optional BEG END NOREMOVE)" t nil) @@ -828,12 +1226,11 @@ Otherwise, return nil. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-clock" '("org-"))) + ;;;*** -;;;### (autoloads (org-agenda-columns org-insert-columns-dblock org-dblock-write:columnview -;;;;;; org-columns-number-to-string org-columns-compute org-columns -;;;;;; org-columns-get-format-and-top-level org-columns-remove-overlays) -;;;;;; "org-colview" "org-colview.el" (22176 30266)) +;;;### (autoloads nil "org-colview" "org-colview.el" (0 0 0 0)) ;;; Generated autoloads from org-colview.el (autoload 'org-columns-remove-overlays "org-colview" "\ @@ -842,31 +1239,34 @@ Remove all currently active column overlays. \(fn)" t nil) (autoload 'org-columns-get-format-and-top-level "org-colview" "\ -Not documented + \(fn)" nil nil) (autoload 'org-columns "org-colview" "\ -Turn on column view on an org-mode file. +Turn on column view on an Org mode file. + +Column view applies to the whole buffer if point is before the +first headline. Otherwise, it applies to the first ancestor +setting \"COLUMNS\" property. If there is none, it defaults to +the current headline. With a `\\[universal-argument]' prefix argument, turn on column +view for the whole buffer unconditionally. + When COLUMNS-FMT-STRING is non-nil, use it as the column format. -\(fn &optional COLUMNS-FMT-STRING)" t nil) +\(fn &optional GLOBAL COLUMNS-FMT-STRING)" t nil) (autoload 'org-columns-compute "org-colview" "\ -Sum the values of property PROPERTY hierarchically, for the entire buffer. +Summarize the values of PROPERTY hierarchically. +Also update existing values for PROPERTY according to the first +column specification. \(fn PROPERTY)" t nil) -(autoload 'org-columns-number-to-string "org-colview" "\ -Convert a computed column number to a string value, according to FMT. - -\(fn N FMT &optional PRINTF)" nil nil) - (autoload 'org-dblock-write:columnview "org-colview" "\ Write the column view table. PARAMS is a property list of parameters: -:width enforce same column widths with <N> specifiers. :id the :ID: property of the entry where the columns view should be built. When the symbol `local', call locally. When `global' call column view with the cursor at the beginning @@ -876,15 +1276,17 @@ PARAMS is a property list of parameters: using `org-id-find'. :hlines When t, insert a hline before each item. When a number, insert a hline before each level <= that number. +:indent When non-nil, indent each ITEM field according to its level. :vlines When t, make each column a colgroup to enforce vertical lines. :maxlevel When set to a number, don't capture headlines below this level. :skip-empty-rows When t, skip rows where all specifiers other than ITEM are empty. +:width apply widths specified in columns format using <N> specifiers. :format When non-nil, specify the column view format to use. \(fn PARAMS)" nil nil) -(autoload 'org-insert-columns-dblock "org-colview" "\ +(autoload 'org-columns-insert-dblock "org-colview" "\ Create a dynamic block capturing a column view table. \(fn)" t nil) @@ -894,36 +1296,69 @@ Turn on or update column view in the agenda. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-colview" '("org-"))) + ;;;*** -;;;### (autoloads (org-check-version) "org-compat" "org-compat.el" -;;;;;; (22193 39354)) +;;;### (autoloads nil "org-compat" "org-compat.el" (0 0 0 0)) ;;; Generated autoloads from org-compat.el (autoload 'org-check-version "org-compat" "\ Try very hard to provide sensible version strings. -\(fn)" nil (quote macro)) +\(fn)" nil t) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-compat" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-crypt" "org-crypt.el" (0 0 0 0)) +;;; Generated autoloads from org-crypt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-crypt" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-ctags" "org-ctags.el" (0 0 0 0)) +;;; Generated autoloads from org-ctags.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-"))) ;;;*** -;;;### (autoloads (org-datetree-find-date-create) "org-datetree" -;;;;;; "org-datetree.el" "b568067e20b64b5dcfc50d0fe986fb9f") +;;;### (autoloads nil "org-datetree" "org-datetree.el" (0 0 0 0)) ;;; Generated autoloads from org-datetree.el (autoload 'org-datetree-find-date-create "org-datetree" "\ -Find or create an entry for DATE. +Find or create an entry for date D. If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it is nil, the buffer will be widened to make sure an existing date tree can be found. -\(fn DATE &optional KEEP-RESTRICTION)" nil nil) +\(fn D &optional KEEP-RESTRICTION)" nil nil) + +(autoload 'org-datetree-find-iso-week-create "org-datetree" "\ +Find or create an ISO week entry for date D. +Compared to `org-datetree-find-date-create' this function creates +entries ordered by week instead of months. +If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it +is nil, the buffer will be widened to make sure an existing date +tree can be found. + +\(fn D &optional KEEP-RESTRICTION)" nil nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-datetree" '("org-datetree-"))) + +;;;*** + +;;;### (autoloads nil "org-docview" "org-docview.el" (0 0 0 0)) +;;; Generated autoloads from org-docview.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-docview" '("org-docview-"))) ;;;*** -;;;### (autoloads (org-element-context org-element-at-point org-element-cache-refresh -;;;;;; org-element-cache-reset org-element-interpret-data org-element-update-syntax) -;;;;;; "org-element" "org-element.el" "54a3a77d31b0c99c7ce9827c94b05491") +;;;### (autoloads nil "org-element" "org-element.el" (0 0 0 0)) ;;; Generated autoloads from org-element.el (autoload 'org-element-update-syntax "org-element" "\ @@ -993,10 +1428,39 @@ Providing it allows for quicker computation. \(fn &optional ELEMENT)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-element" '("org-element-"))) + +;;;*** + +;;;### (autoloads nil "org-entities" "org-entities.el" (0 0 0 0)) +;;; Generated autoloads from org-entities.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("org-entit"))) + +;;;*** + +;;;### (autoloads nil "org-eshell" "org-eshell.el" (0 0 0 0)) +;;; Generated autoloads from org-eshell.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-eshell" '("org-eshell-"))) + +;;;*** + +;;;### (autoloads nil "org-eww" "org-eww.el" (0 0 0 0)) +;;; Generated autoloads from org-eww.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-eww" '("org-eww-"))) + ;;;*** -;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update -;;;;;; org-feed-update-all) "org-feed" "org-feed.el" "d0f9ed4388a963a1ef1623799a68a0f0") +;;;### (autoloads nil "org-faces" "org-faces.el" (0 0 0 0)) +;;; Generated autoloads from org-faces.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-faces" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-feed" "org-feed.el" (0 0 0 0)) ;;; Generated autoloads from org-feed.el (autoload 'org-feed-update-all "org-feed" "\ @@ -1021,10 +1485,11 @@ Show the raw feed buffer of a feed. \(fn FEED)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-feed" '("org-feed-"))) + ;;;*** -;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote" -;;;;;; "org-footnote.el" "9ceecddca334b14eed8100670d00bb8f") +;;;### (autoloads nil "org-footnote" "org-footnote.el" (0 0 0 0)) ;;; Generated autoloads from org-footnote.el (autoload 'org-footnote-action "org-footnote" "\ @@ -1043,23 +1508,25 @@ offer additional commands in a menu. \(fn &optional SPECIAL)" t nil) -(autoload 'org-footnote-normalize "org-footnote" "\ -Collect the footnotes in various formats and normalize them. +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-footnote" '("org-footnote-"))) + +;;;*** + +;;;### (autoloads nil "org-gnus" "org-gnus.el" (0 0 0 0)) +;;; Generated autoloads from org-gnus.el -This finds the different sorts of footnotes allowed in Org, and -normalizes them to the usual [N] format. +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-gnus" '("org-"))) -When SORT-ONLY is set, only sort the footnote definitions into the -referenced sequence. +;;;*** + +;;;### (autoloads nil "org-habit" "org-habit.el" (0 0 0 0)) +;;; Generated autoloads from org-habit.el -\(fn &optional SORT-ONLY)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-habit" '("org-"))) ;;;*** -;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-update-id-locations -;;;;;; org-id-new org-id-find org-id-goto org-id-get-with-outline-drilling -;;;;;; org-id-get-with-outline-path-completion org-id-get org-id-copy -;;;;;; org-id-get-create) "org-id" "org-id.el" "aa9a9a641f5d77fb14a6ac89b1831168") +;;;### (autoloads nil "org-id" "org-id.el" (0 0 0 0)) ;;; Generated autoloads from org-id.el (autoload 'org-id-get-create "org-id" "\ @@ -1099,7 +1566,7 @@ Use an outline-cycling interface to retrieve the ID of an entry. This only finds entries in the current buffer, using `org-get-location'. It returns the ID of the entry. If necessary, the ID is created. -\(fn &optional TARGETS)" nil nil) +\(fn)" nil nil) (autoload 'org-id-goto "org-id" "\ Switch to the buffer containing the entry with id ID. @@ -1136,7 +1603,6 @@ Store the relation between files and corresponding IDs. This will scan all agenda files, all associated archives, and all files currently mentioned in `org-id-locations'. When FILES is given, scan these files instead. -When CHECK is given, prepare detailed information about duplicate IDs. \(fn &optional FILES SILENT)" t nil) @@ -1150,10 +1616,11 @@ Store a link to the current entry, using its ID. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-id" '("org-id-"))) + ;;;*** -;;;### (autoloads (org-indent-mode) "org-indent" "org-indent.el" -;;;;;; "da988e2c3b7826ad167376bcfd481df9") +;;;### (autoloads nil "org-indent" "org-indent.el" (0 0 0 0)) ;;; Generated autoloads from org-indent.el (autoload 'org-indent-mode "org-indent" "\ @@ -1168,9 +1635,26 @@ during idle time. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-indent" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-info" "org-info.el" (0 0 0 0)) +;;; Generated autoloads from org-info.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-info" '("org-info-"))) + +;;;*** + +;;;### (autoloads nil "org-inlinetask" "org-inlinetask.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from org-inlinetask.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-inlinetask" '("org-inlinetask-"))) + ;;;*** -;;;### (autoloads (org-irc-store-link) "org-irc" "org-irc.el" "844cf138fe188afd472820c355b395ae") +;;;### (autoloads nil "org-irc" "org-irc.el" (0 0 0 0)) ;;; Generated autoloads from org-irc.el (autoload 'org-irc-store-link "org-irc" "\ @@ -1178,37 +1662,62 @@ Dispatch to the appropriate function to store a link to an IRC session. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-irc" '("org-irc-"))) + ;;;*** -;;;### (autoloads (org-lint) "org-lint" "org-lint.el" (22106 38585)) +;;;### (autoloads nil "org-lint" "org-lint.el" (0 0 0 0)) ;;; Generated autoloads from org-lint.el (autoload 'org-lint "org-lint" "\ Check current Org buffer for syntax mistakes. -By default, run all checkers. With a single prefix ARG \\[universal-argument], -select one category of checkers only. With a double prefix -\\[universal-argument] \\[universal-argument], select one precise checker by its name. +By default, run all checkers. With a `\\[universal-argument]' prefix ARG, select one +category of checkers only. With a `\\[universal-argument] \\[universal-argument]' prefix, run one precise +checker by its name. ARG can also be a list of checker names, as symbols, to run. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-lint" '("org-lint-"))) + +;;;*** + +;;;### (autoloads nil "org-list" "org-list.el" (0 0 0 0)) +;;; Generated autoloads from org-list.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-list" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-macro" "org-macro.el" (0 0 0 0)) +;;; Generated autoloads from org-macro.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macro" '("org-macro-"))) + ;;;*** -;;;### (autoloads (org-load-noerror-mustsuffix) "org-macs" "org-macs.el" -;;;;;; (22161 62906)) +;;;### (autoloads nil "org-macs" "org-macs.el" (0 0 0 0)) ;;; Generated autoloads from org-macs.el (autoload 'org-load-noerror-mustsuffix "org-macs" "\ -Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it. +Load FILE with optional arguments NOERROR and MUSTSUFFIX. + +\(fn FILE)" nil t) -\(fn FILE)" nil (quote macro)) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macs" '("org-"))) ;;;*** -;;;### (autoloads (org-mobile-pull org-mobile-push) "org-mobile" -;;;;;; "org-mobile.el" "6fe291f3ef3fff1fbde9b1ec117c2d2a") +;;;### (autoloads nil "org-mhe" "org-mhe.el" (0 0 0 0)) +;;; Generated autoloads from org-mhe.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mhe" '("org-mhe-"))) + +;;;*** + +;;;### (autoloads nil "org-mobile" "org-mobile.el" (0 0 0 0)) ;;; Generated autoloads from org-mobile.el (autoload 'org-mobile-push "org-mobile" "\ @@ -1225,9 +1734,25 @@ agenda view showing the flagged items. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mobile" '("org-mobile-"))) + +;;;*** + +;;;### (autoloads nil "org-mouse" "org-mouse.el" (0 0 0 0)) +;;; Generated autoloads from org-mouse.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mouse" '("org-mouse-"))) + +;;;*** + +;;;### (autoloads nil "org-pcomplete" "org-pcomplete.el" (0 0 0 0)) +;;; Generated autoloads from org-pcomplete.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-pcomplete" '("org-" "pcomplete/org-mode/"))) + ;;;*** -;;;### (autoloads (org-plot/gnuplot) "org-plot" "org-plot.el" "e480cdf4e7d3e91e180354e60f40dd55") +;;;### (autoloads nil "org-plot" "org-plot.el" (0 0 0 0)) ;;; Generated autoloads from org-plot.el (autoload 'org-plot/gnuplot "org-plot" "\ @@ -1237,35 +1762,37 @@ line directly before or after the table. \(fn &optional PARAMS)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-plot" '("org-plot"))) + +;;;*** + +;;;### (autoloads nil "org-protocol" "org-protocol.el" (0 0 0 0)) +;;; Generated autoloads from org-protocol.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-protocol" '("org-protocol-"))) + ;;;*** -;;;### (autoloads (orgtbl-ascii-plot orgtbl-to-orgtbl orgtbl-to-texinfo -;;;;;; orgtbl-to-html orgtbl-to-latex orgtbl-to-csv orgtbl-to-tsv -;;;;;; orgtbl-to-generic org-table-to-lisp orgtbl-mode org-table-toggle-formula-debugger -;;;;;; org-table-toggle-coordinate-overlays org-table-edit-formulas -;;;;;; org-table-iterate-buffer-tables org-table-recalculate-buffer-tables -;;;;;; org-table-iterate org-table-recalculate org-table-eval-formula -;;;;;; org-table-maybe-recalculate-line org-table-analyze org-table-rotate-recalc-marks -;;;;;; org-table-maybe-eval-formula org-table-get-stored-formulas -;;;;;; org-table-sum org-table-edit-field org-table-wrap-region -;;;;;; org-table-convert org-table-paste-rectangle org-table-copy-region -;;;;;; org-table-cut-region org-table-sort-lines org-table-kill-row -;;;;;; org-table-hline-and-move org-table-insert-hline org-table-insert-row -;;;;;; org-table-move-row org-table-move-row-up org-table-move-row-down -;;;;;; org-table-move-column org-table-move-column-left org-table-move-column-right -;;;;;; org-table-delete-column org-table-insert-column org-table-goto-column -;;;;;; org-table-current-dline org-table-field-info org-table-blank-field -;;;;;; org-table-copy-down org-table-next-row org-table-previous-field -;;;;;; org-table-next-field org-table-justify-field-maybe org-table-end -;;;;;; org-table-begin org-table-align org-table-export org-table-import -;;;;;; org-table-convert-region org-table-create org-table-create-or-convert-from-region -;;;;;; org-table-create-with-table\.el) "org-table" "org-table.el" -;;;;;; "e9359ea5b998c77257caa9b21313bf8a") +;;;### (autoloads nil "org-rmail" "org-rmail.el" (0 0 0 0)) +;;; Generated autoloads from org-rmail.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-rmail" '("org-rmail-"))) + +;;;*** + +;;;### (autoloads nil "org-src" "org-src.el" (0 0 0 0)) +;;; Generated autoloads from org-src.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-src" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-table" "org-table.el" (0 0 0 0)) ;;; Generated autoloads from org-table.el (autoload 'org-table-create-with-table\.el "org-table" "\ Use the table.el package to insert a new table. -If there is already a table at point, convert between Org-mode tables +If there is already a table at point, convert between Org tables and table.el tables. \(fn)" t nil) @@ -1540,13 +2067,13 @@ lines. (autoload 'org-table-convert "org-table" "\ Convert from `org-mode' table to table.el and back. -Obviously, this only works within limits. When an Org-mode table is -converted to table.el, all horizontal separator lines get lost, because -table.el uses these as cell boundaries and has no notion of horizontal lines. -A table.el table can be converted to an Org-mode table only if it does not -do row or column spanning. Multiline cells will become multiple cells. -Beware, Org-mode does not test if the table can be successfully converted - it -blindly applies a recipe that works for simple tables. +Obviously, this only works within limits. When an Org table is converted +to table.el, all horizontal separator lines get lost, because table.el uses +these as cell boundaries and has no notion of horizontal lines. A table.el +table can be converted to an Org table only if it does not do row or column +spanning. Multiline cells will become multiple cells. Beware, Org mode +does not test if the table can be successfully converted - it blindly +applies a recipe that works for simple tables. \(fn)" t nil) @@ -1577,9 +2104,9 @@ blank, and the content is appended to the field above. (autoload 'org-table-edit-field "org-table" "\ Edit table field in a different window. -This is mainly useful for fields that contain hidden parts. -When called with a \\[universal-argument] prefix, just make the full field visible so that -it can be edited in place. +This is mainly useful for fields that contain hidden parts. When called +with a `\\[universal-argument]' prefix, just make the full field visible so that it can be +edited in place. \(fn ARG)" t nil) @@ -1651,20 +2178,14 @@ Recompute the current line if marked for it, and if we haven't just done it. (autoload 'org-table-eval-formula "org-table" "\ Replace the table field value at the cursor by the result of a calculation. -This function makes use of Dave Gillespie's Calc package, in my view the -most exciting program ever written for GNU Emacs. So you need to have Calc -installed in order to use this function. - In a table, this command replaces the value in the current field with the result of a formula. It also installs the formula as the \"current\" column formula, by storing it in a special line below the table. When called -with a `C-u' prefix, the current field must be a named field, and the -formula is installed as valid in only this specific field. +with a `\\[universal-argument]' prefix the formula is installed as a field formula. -When called with two `C-u' prefixes, insert the active equation -for the field back into the current field, so that it can be -edited there. This is useful in order to use \\[org-table-show-reference] -to check the referenced fields. +When called with a `\\[universal-argument] \\[universal-argument]' prefix, insert the active equation for the field +back into the current field, so that it can be edited there. This is useful +in order to use \\<org-table-fedit-map>`\\[org-table-show-reference]' to check the referenced fields. When called, the command first prompts for a formula, which is read in the minibuffer. Previously entered formulas are available through the @@ -1673,7 +2194,7 @@ These stored formulas are adapted correctly when moving, inserting, or deleting columns with the corresponding commands. The formula can be any algebraic expression understood by the Calc package. -For details, see the Org-mode manual. +For details, see the Org mode manual. This function can also be called from Lisp programs and offers additional arguments: EQUATION can be the formula to apply. If this @@ -1683,15 +2204,19 @@ SUPPRESS-CONST suppresses the interpretation of constants in the formula, assuming that this has been done already outside the function. SUPPRESS-STORE means the formula should not be stored, either because it is already stored, or because it is a modified equation that should -not overwrite the stored one. +not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to +`org-table-analyze'. \(fn &optional ARG EQUATION SUPPRESS-ALIGN SUPPRESS-CONST SUPPRESS-STORE SUPPRESS-ANALYSIS)" t nil) (autoload 'org-table-recalculate "org-table" "\ Recalculate the current table line by applying all stored formulas. + With prefix arg ALL, do this for all lines in the table. -With the prefix argument ALL is `(16)' (a double \\[universal-prefix] \\[universal-prefix] prefix), or if -it is the symbol `iterate', recompute the table until it no longer changes. + +When called with a `\\[universal-argument] \\[universal-argument]' prefix, or if ALL is the symbol `iterate', +recompute the table until it no longer changes. + If NOALIGN is not nil, do not re-align the table after the computations are done. This is typically used internally to save time, if it is known that the table will be realigned a little later anyway. @@ -1928,19 +2453,22 @@ be set to provide ORGTBL directives for the generated table. \(fn TABLE PARAMS)" nil nil) (autoload 'orgtbl-ascii-plot "org-table" "\ -Draw an ascii bar plot in a column. -With cursor in a column containing numerical values, this -function will draw a plot in a new column. +Draw an ASCII bar plot in a column. + +With cursor in a column containing numerical values, this function +will draw a plot in a new column. + ASK, if given, is a numeric prefix to override the default 12 -characters width of the plot. ASK may also be the -\\[universal-argument] prefix, which will prompt for the width. +characters width of the plot. ASK may also be the `\\[universal-argument]' prefix, +which will prompt for the width. \(fn &optional ASK)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org"))) + ;;;*** -;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region -;;;;;; org-timer org-timer-start) "org-timer" "org-timer.el" "96624173cc52bc1945ce7cb5940a7d2b") +;;;### (autoloads nil "org-timer" "org-timer.el" (0 0 0 0)) ;;; Generated autoloads from org-timer.el (autoload 'org-timer-start "org-timer" "\ @@ -1958,16 +2486,18 @@ the region 0:00:00. (autoload 'org-timer "org-timer" "\ Insert a H:MM:SS string from the timer into the buffer. -The first time this command is used, the timer is started. When used with -a \\[universal-argument] prefix, force restarting the timer. -When used with a double prefix argument \\[universal-argument], change all the timer string -in the region by a fixed amount. This can be used to recalibrate a timer -that was not started at the correct moment. +The first time this command is used, the timer is started. -If NO-INSERT-P is non-nil, return the string instead of inserting +When used with a `\\[universal-argument]' prefix, force restarting the timer. + +When used with a `\\[universal-argument] \\[universal-argument]' prefix, change all the timer strings +in the region by a fixed amount. This can be used to re-calibrate +a timer that was not started at the correct moment. + +If NO-INSERT is non-nil, return the string instead of inserting it in the buffer. -\(fn &optional RESTART NO-INSERT-P)" t nil) +\(fn &optional RESTART NO-INSERT)" t nil) (autoload 'org-timer-change-times-in-region "org-timer" "\ Change all h:mm:ss time in region by a DELTA. @@ -2002,21 +2532,22 @@ using three `C-u' prefix arguments. \(fn &optional OPT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-timer" '("org-timer-"))) + ;;;*** -;;;### (autoloads (org-git-version org-release) "org-version" "org-version.el" -;;;;;; (22219 35318)) +;;;### (autoloads nil "org-version" "org-version.el" (0 0 0 0)) ;;; Generated autoloads from org-version.el (autoload 'org-release "org-version" "\ -The release version of org-mode. - Inserted by installing org-mode or when a release is made. +The release version of Org. +Inserted by installing Org mode or when a release is made. \(fn)" nil nil) (autoload 'org-git-version "org-version" "\ The Git version of org-mode. - Inserted by installing org-mode or when a release is made. +Inserted by installing Org or when a release is made. \(fn)" nil nil) @@ -2025,13 +2556,14 @@ The location of ODT styles.") ;;;*** -;;;### (autoloads (org-customize org-reload org-submit-bug-report -;;;;;; org-cycle-agenda-files org-switchb org-open-link-from-string -;;;;;; org-open-at-point-global org-insert-link-global org-store-link -;;;;;; org-run-like-in-org-mode turn-on-orgstruct++ turn-on-orgstruct -;;;;;; orgstruct-mode org-global-cycle org-cycle org-mode org-clock-persistence-insinuate -;;;;;; turn-on-orgtbl org-version org-babel-load-file org-babel-do-load-languages) -;;;;;; "org" "org.el" (22219 35205)) +;;;### (autoloads nil "org-w3m" "org-w3m.el" (0 0 0 0)) +;;; Generated autoloads from org-w3m.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-w3m" '("org-w3m-"))) + +;;;*** + +;;;### (autoloads nil "org" "org.el" (0 0 0 0)) ;;; Generated autoloads from org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -2040,7 +2572,7 @@ Load the languages defined in `org-babel-load-languages'. \(fn SYM VALUE)" nil nil) (autoload 'org-babel-load-file "org" "\ -Load Emacs Lisp source code blocks in the Org-mode FILE. +Load Emacs Lisp source code blocks in the Org FILE. This function exports the source code using `org-babel-tangle' and then loads the resulting file using `load-file'. With prefix arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp @@ -2049,7 +2581,7 @@ file to byte-code before it is loaded. \(fn FILE &optional COMPILE)" t nil) (autoload 'org-version "org" "\ -Show the org-mode version. +Show the Org version. Interactively, or when MESSAGE is non-nil, show it in echo area. With prefix argument, or when HERE is non-nil, insert it at point. In non-interactive uses, a reduced version string is output unless @@ -2071,15 +2603,15 @@ Set up hooks for clock persistence. Outline-based notes management and organizer, alias \"Carsten's outline-mode for keeping track of everything.\" -Org-mode develops organizational tasks around a NOTES file which -contains information about projects as plain text. Org-mode is -implemented on top of outline-mode, which is ideal to keep the content +Org mode develops organizational tasks around a NOTES file which +contains information about projects as plain text. Org mode is +implemented on top of Outline mode, which is ideal to keep the content of large files well structured. It supports ToDo items, deadlines and time stamps, which magically appear in the diary listing of the Emacs calendar. Tables are easily created with a built-in table editor. Plain text URL-like links connect to websites, emails (VM), Usenet messages (Gnus), BBDB entries, and any files related to the project. -For printing and sharing of notes, an Org-mode file (or a part of it) +For printing and sharing of notes, an Org file (or a part of it) can be exported as a structured ASCII or HTML file. The following commands are available: @@ -2089,57 +2621,60 @@ The following commands are available: \(fn)" t nil) (autoload 'org-cycle "org" "\ -TAB-action and visibility cycling for Org-mode. +TAB-action and visibility cycling for Org mode. -This is the command invoked in Org-mode by the TAB key. Its main purpose -is outline visibility cycling, but it also invokes other actions +This is the command invoked in Org mode by the `TAB' key. Its main +purpose is outline visibility cycling, but it also invokes other actions in special contexts. -- When this function is called with a prefix argument, rotate the entire - buffer through 3 states (global cycling) +When this function is called with a `\\[universal-argument]' prefix, rotate the entire +buffer through 3 states (global cycling) 1. OVERVIEW: Show only top-level headlines. 2. CONTENTS: Show all headlines of all levels, but no body text. 3. SHOW ALL: Show everything. - With a double \\[universal-argument] prefix argument, switch to the startup visibility, - determined by the variable `org-startup-folded', and by any VISIBILITY - properties in the buffer. - With a triple \\[universal-argument] prefix argument, show the entire buffer, including any drawers. -- When inside a table, re-align the table and move to the next field. +With a `\\[universal-argument] \\[universal-argument]' prefix argument, switch to the startup visibility, +determined by the variable `org-startup-folded', and by any VISIBILITY +properties in the buffer. + +With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix argument, show the entire buffer, including +any drawers. + +When inside a table, re-align the table and move to the next field. -- When point is at the beginning of a headline, rotate the subtree started - by this line through 3 different states (local cycling) +When point is at the beginning of a headline, rotate the subtree started +by this line through 3 different states (local cycling) 1. FOLDED: Only the main headline is shown. 2. CHILDREN: The main headline and the direct children are shown. From this state, you can move to one of the children and zoom in further. 3. SUBTREE: Show the entire subtree, including body text. - If there is no subtree, switch directly from CHILDREN to FOLDED. +If there is no subtree, switch directly from CHILDREN to FOLDED. -- When point is at the beginning of an empty headline and the variable - `org-cycle-level-after-item/entry-creation' is set, cycle the level - of the headline by demoting and promoting it to likely levels. This - speeds up creation document structure by pressing TAB once or several - times right after creating a new headline. +When point is at the beginning of an empty headline and the variable +`org-cycle-level-after-item/entry-creation' is set, cycle the level +of the headline by demoting and promoting it to likely levels. This +speeds up creation document structure by pressing `TAB' once or several +times right after creating a new headline. -- When there is a numeric prefix, go up to a heading with level ARG, do - a `show-subtree' and return to the previous cursor position. If ARG - is negative, go up that many levels. +When there is a numeric prefix, go up to a heading with level ARG, do +a `show-subtree' and return to the previous cursor position. If ARG +is negative, go up that many levels. -- When point is not at the beginning of a headline, execute the global - binding for TAB, which is re-indenting the line. See the option - `org-cycle-emulate-tab' for details. +When point is not at the beginning of a headline, execute the global +binding for `TAB', which is re-indenting the line. See the option +`org-cycle-emulate-tab' for details. -- Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg - (\\[universal-argument] TAB, same as S-TAB) also when called without prefix arg. - But only if also the variable `org-cycle-global-at-bob' is t. +As a special case, if point is at the beginning of the buffer and there is +no headline in line 1, this function will act as if called with prefix arg +\(`\\[universal-argument] TAB', same as `S-TAB') also when called without prefix arg, but only +if the variable `org-cycle-global-at-bob' is t. \(fn &optional ARG)" t nil) (autoload 'org-global-cycle "org" "\ Cycle the global visibility. For details see `org-cycle'. -With \\[universal-argument] prefix arg, switch to startup visibility. +With `\\[universal-argument]' prefix ARG, switch to startup visibility. With a numeric prefix, show all headlines up to that level. \(fn &optional ARG)" t nil) @@ -2147,10 +2682,10 @@ With a numeric prefix, show all headlines up to that level. (autoload 'orgstruct-mode "org" "\ Toggle the minor mode `orgstruct-mode'. -This mode is for using Org-mode structure commands in other -modes. The following keys behave as if Org-mode were active, if +This mode is for using Org mode structure commands in other +modes. The following keys behave as if Org mode were active, if the cursor is on a headline, or on a plain list item (both as -defined by Org-mode). +defined by Org mode). \(fn &optional ARG)" t nil) @@ -2165,61 +2700,59 @@ Unconditionally turn on `orgstruct++-mode'. \(fn)" nil nil) (autoload 'org-run-like-in-org-mode "org" "\ -Run a command, pretending that the current buffer is in Org-mode. +Run a command, pretending that the current buffer is in Org mode. This will temporarily bind local variables that are typically bound in -Org-mode to the values they have in Org-mode, and then interactively +Org mode to the values they have in Org mode, and then interactively call CMD. \(fn CMD)" nil nil) (autoload 'org-store-link "org" "\ -\\<org-mode-map>Store an org-link to the current location. +Store an org-link to the current location. +\\<org-mode-map> This link is added to `org-stored-links' and can later be inserted -into an Org buffer with \\[org-insert-link]. +into an Org buffer with `org-insert-link' (`\\[org-insert-link]'). -For some link types, a prefix ARG is interpreted. +For some link types, a `\\[universal-argument]' prefix ARG is interpreted. For links to Usenet articles, ARG negates `org-gnus-prefer-web-links'. For file links, ARG negates `org-context-in-file-links'. -A double prefix ARG force skipping storing functions that are not -part of Org's core. +A `\\[universal-argument] \\[universal-argument]' prefix ARG forces skipping storing functions that are not +part of Org core. -A triple prefix ARG force storing a link for each line in the +A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix ARG forces storing a link for each line in the active region. \(fn ARG)" t nil) (autoload 'org-insert-link-global "org" "\ -Insert a link like Org-mode does. -This command can be called in any mode to insert a link in Org-mode syntax. +Insert a link like Org mode does. +This command can be called in any mode to insert a link in Org syntax. \(fn)" t nil) (autoload 'org-open-at-point-global "org" "\ -Follow a link like Org-mode does. -This command can be called in any mode to follow a link that has -Org-mode syntax. +Follow a link or time-stamp like Org mode does. +This command can be called in any mode to follow an external link +or a time-stamp that has Org mode syntax. Its behavior is +undefined when called on internal links (e.g., fuzzy links). +Raise an error when there is nothing to follow. \(fn)" t nil) (autoload 'org-open-link-from-string "org" "\ -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. \(fn S &optional ARG REFERENCE-BUFFER)" t nil) (autoload 'org-switchb "org" "\ Switch between Org buffers. -With one prefix argument, restrict available buffers to files. -With two prefix arguments, restrict available buffers to agenda files. -Defaults to `iswitchb' for buffer name completion. -Set `org-completion-use-ido' to make it use ido instead. +With `\\[universal-argument]' prefix, restrict available buffers to files. -\(fn &optional ARG)" t nil) - -(defalias 'org-ido-switchb 'org-switchb) +With `\\[universal-argument] \\[universal-argument]' prefix, restrict available buffers to agenda files. -(defalias 'org-iswitchb 'org-switchb) +\(fn &optional ARG)" t nil) (autoload 'org-cycle-agenda-files "org" "\ Cycle through the files in `org-agenda-files'. @@ -2229,13 +2762,13 @@ If the current buffer does not, find the first agenda file. \(fn)" t nil) (autoload 'org-submit-bug-report "org" "\ -Submit a bug report on Org-mode via mail. +Submit a bug report on Org via mail. Don't hesitate to report any problems or inaccurate documentation. If you don't have setup sending mail from (X)Emacs, please copy the output buffer into your mail program, as it gives us important -information about your Org-mode version and configuration. +information about your Org version and configuration. \(fn)" t nil) @@ -2250,11 +2783,11 @@ Call the customize function with org as argument. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org" '("org" "turn-on-org-cdlatex"))) + ;;;*** -;;;### (autoloads (org-ascii-publish-to-utf8 org-ascii-publish-to-latin1 -;;;;;; org-ascii-publish-to-ascii org-ascii-export-to-ascii org-ascii-export-as-ascii) -;;;;;; "ox-ascii" "ox-ascii.el" "8b996711b8e315a0dd406d54c0854eaa") +;;;### (autoloads nil "ox-ascii" "ox-ascii.el" (0 0 0 0)) ;;; Generated autoloads from ox-ascii.el (autoload 'org-ascii-export-as-ascii "ox-ascii" "\ @@ -2352,12 +2885,11 @@ Return output file name. \(fn PLIST FILENAME PUB-DIR)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-ascii" '("org-ascii-"))) + ;;;*** -;;;### (autoloads (org-beamer-publish-to-pdf org-beamer-publish-to-latex -;;;;;; org-beamer-select-environment org-beamer-export-to-pdf org-beamer-export-to-latex -;;;;;; org-beamer-export-as-latex org-beamer-mode) "ox-beamer" "ox-beamer.el" -;;;;;; "794938d6b0ee97f126e6c5d6330eeaff") +;;;### (autoloads nil "ox-beamer" "ox-beamer.el" (0 0 0 0)) ;;; Generated autoloads from ox-beamer.el (autoload 'org-beamer-mode "ox-beamer" "\ @@ -2490,11 +3022,11 @@ Return output file name. \(fn PLIST FILENAME PUB-DIR)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-beamer" '("org-beamer-"))) + ;;;*** -;;;### (autoloads (org-html-publish-to-html org-html-export-to-html -;;;;;; org-html-convert-region-to-html org-html-export-as-html org-html-htmlize-generate-css) -;;;;;; "ox-html" "ox-html.el" "8a71c624b1d1c388ab0adfe0baf74040") +;;;### (autoloads nil "ox-html" "ox-html.el" (0 0 0 0)) ;;; Generated autoloads from ox-html.el (put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) @@ -2550,10 +3082,10 @@ is non-nil. \(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) (autoload 'org-html-convert-region-to-html "ox-html" "\ -Assume the current region has org-mode syntax, and convert it to HTML. +Assume the current region has Org syntax, and convert it to HTML. This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an HTML buffer and use this -command to convert it. +itemized list in Org syntax in an HTML buffer and use this command +to convert it. \(fn)" t nil) @@ -2598,11 +3130,11 @@ Return output file name. \(fn PLIST FILENAME PUB-DIR)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-html" '("org-html-"))) + ;;;*** -;;;### (autoloads (org-icalendar-combine-agenda-files org-icalendar-export-agenda-files -;;;;;; org-icalendar-export-to-ics) "ox-icalendar" "ox-icalendar.el" -;;;;;; "0420c450f1da4a87e24a8afbc23f75f3") +;;;### (autoloads nil "ox-icalendar" "ox-icalendar.el" (0 0 0 0)) ;;; Generated autoloads from ox-icalendar.el (autoload 'org-icalendar-export-to-ics "ox-icalendar" "\ @@ -2650,11 +3182,11 @@ The file is stored under the name chosen in \(fn &optional ASYNC)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-icalendar" '("org-icalendar-"))) + ;;;*** -;;;### (autoloads (org-latex-publish-to-pdf org-latex-publish-to-latex -;;;;;; org-latex-export-to-pdf org-latex-export-to-latex org-latex-convert-region-to-latex -;;;;;; org-latex-export-as-latex) "ox-latex" "ox-latex.el" "d27ca15eea14bcf3173e74f51b3d3e69") +;;;### (autoloads nil "ox-latex" "ox-latex.el" (0 0 0 0)) ;;; Generated autoloads from ox-latex.el (autoload 'org-latex-export-as-latex "ox-latex" "\ @@ -2690,9 +3222,9 @@ is non-nil. \(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) (autoload 'org-latex-convert-region-to-latex "ox-latex" "\ -Assume the current region has org-mode syntax, and convert it to LaTeX. +Assume the current region has Org syntax, and convert it to LaTeX. This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an LaTeX buffer and use this +itemized list in Org syntax in an LaTeX buffer and use this command to convert it. \(fn)" t nil) @@ -2777,11 +3309,18 @@ Return output file name. \(fn PLIST FILENAME PUB-DIR)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-latex" '("org-latex-"))) + +;;;*** + +;;;### (autoloads nil "ox-man" "ox-man.el" (0 0 0 0)) +;;; Generated autoloads from ox-man.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-man" '("org-man-"))) + ;;;*** -;;;### (autoloads (org-md-publish-to-md org-md-export-to-markdown -;;;;;; org-md-convert-region-to-md org-md-export-as-markdown) "ox-md" -;;;;;; "ox-md.el" "875c98308c9f63cd880c47ae90b2fb91") +;;;### (autoloads nil "ox-md" "ox-md.el" (0 0 0 0)) ;;; Generated autoloads from ox-md.el (autoload 'org-md-export-as-markdown "ox-md" "\ @@ -2810,9 +3349,9 @@ non-nil. \(fn &optional ASYNC SUBTREEP VISIBLE-ONLY)" t nil) (autoload 'org-md-convert-region-to-md "ox-md" "\ -Assume the current region has org-mode syntax, and convert it to Markdown. +Assume the current region has Org syntax, and convert it to Markdown. This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in a Markdown buffer and use +itemized list in Org syntax in a Markdown buffer and use this command to convert it. \(fn)" t nil) @@ -2851,10 +3390,11 @@ Return output file name. \(fn PLIST FILENAME PUB-DIR)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-md" '("org-md-"))) + ;;;*** -;;;### (autoloads (org-odt-convert org-odt-export-to-odt org-odt-export-as-odf-and-open -;;;;;; org-odt-export-as-odf) "ox-odt" "ox-odt.el" "e3a936f4f3bbe947f4d4b75ce359538f") +;;;### (autoloads nil "ox-odt" "ox-odt.el" (0 0 0 0)) ;;; Generated autoloads from ox-odt.el (put 'org-odt-preferred-output-format 'safe-local-variable 'stringp) @@ -2908,16 +3448,17 @@ Return output file's name. Convert IN-FILE to format OUT-FMT using a command line converter. IN-FILE is the file to be converted. If unspecified, it defaults to variable `buffer-file-name'. OUT-FMT is the desired output -format. Use `org-odt-convert-process' as the converter. -If PREFIX-ARG is non-nil then the newly converted file is opened -using `org-open-file'. +format. Use `org-odt-convert-process' as the converter. If OPEN +is non-nil then the newly converted file is opened using +`org-open-file'. -\(fn &optional IN-FILE OUT-FMT PREFIX-ARG)" t nil) +\(fn &optional IN-FILE OUT-FMT OPEN)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-odt" '("org-odt-"))) ;;;*** -;;;### (autoloads (org-org-publish-to-org org-org-export-to-org org-org-export-as-org) -;;;;;; "ox-org" "ox-org.el" "8f2b09ccf51699abf1204d296e93a399") +;;;### (autoloads nil "ox-org" "ox-org.el" (0 0 0 0)) ;;; Generated autoloads from ox-org.el (autoload 'org-org-export-as-org "ox-org" "\ @@ -2993,11 +3534,11 @@ Return output file name. \(fn PLIST FILENAME PUB-DIR)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-org" '("org-org-"))) + ;;;*** -;;;### (autoloads (org-publish-current-project org-publish-current-file -;;;;;; org-publish-all org-publish) "ox-publish" "ox-publish.el" -;;;;;; "a6e792ca3583d341a674e11cecfdd6e9") +;;;### (autoloads nil "ox-publish" "ox-publish.el" (0 0 0 0)) ;;; Generated autoloads from ox-publish.el (defalias 'org-publish-project 'org-publish) @@ -3038,10 +3579,11 @@ the project. \(fn &optional FORCE ASYNC)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-publish" '("org-publish-"))) + ;;;*** -;;;### (autoloads (org-texinfo-convert-region-to-texinfo org-texinfo-publish-to-texinfo) -;;;;;; "ox-texinfo" "ox-texinfo.el" "78e9355de19d5650647109cc50825a58") +;;;### (autoloads nil "ox-texinfo" "ox-texinfo.el" (0 0 0 0)) ;;; Generated autoloads from ox-texinfo.el (autoload 'org-texinfo-publish-to-texinfo "ox-texinfo" "\ @@ -3056,18 +3598,18 @@ Return output file name. \(fn PLIST FILENAME PUB-DIR)" nil nil) (autoload 'org-texinfo-convert-region-to-texinfo "ox-texinfo" "\ -Assume the current region has org-mode syntax, and convert it to Texinfo. +Assume the current region has Org syntax, and convert it to Texinfo. This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an Texinfo buffer and use -this command to convert it. +itemized list in Org syntax in an Texinfo buffer and use this +command to convert it. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-texinfo" '("org-texinfo-"))) + ;;;*** -;;;### (autoloads (org-export-dispatch org-export-to-file org-export-to-buffer -;;;;;; org-export-insert-default-template org-export-replace-region-by -;;;;;; org-export-string-as org-export-as) "ox" "ox.el" "666ded911b08be6cee87ae459dc28b1c") +;;;### (autoloads nil "ox" "ox.el" (0 0 0 0)) ;;; Generated autoloads from ox.el (autoload 'org-export-as "ox" "\ @@ -3174,6 +3716,8 @@ This function returns BUFFER. \(fn BACKEND BUFFER &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil) +(function-put 'org-export-to-buffer 'lisp-indent-function '2) + (autoload 'org-export-to-file "ox" "\ Call `org-export-as' with output to a specified file. @@ -3208,6 +3752,8 @@ or FILE. \(fn BACKEND FILE &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil) +(function-put 'org-export-to-file 'lisp-indent-function '2) + (autoload 'org-export-dispatch "ox" "\ Export dispatcher for Org mode. @@ -3222,13 +3768,15 @@ SPC and DEL (resp. C-n and C-p) keys. Set variable `org-export-dispatch-use-expert-ui' to switch to one flavor or the other. -When ARG is \\[universal-argument], repeat the last export action, with the same set -of options used back then, on the current buffer. +When ARG is `\\[universal-argument]', repeat the last export action, with the same +set of options used back then, on the current buffer. -When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack. +When ARG is `\\[universal-argument] \\[universal-argument]', display the asynchronous export stack. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox" '("org-export-"))) + ;;;*** (provide 'org-loaddefs) diff --git a/lisp/org-macro.el b/lisp/org-macro.el index fee33f6..8560891 100644 --- a/lisp/org-macro.el +++ b/lisp/org-macro.el @@ -1,4 +1,4 @@ -;;; org-macro.el --- Macro Replacement Code for Org Mode +;;; org-macro.el --- Macro Replacement Code for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. @@ -43,6 +43,7 @@ ;; {{{email}}} and {{{title}}} macros. ;;; Code: +(require 'cl-lib) (require 'org-macs) (require 'org-compat) @@ -57,12 +58,13 @@ (declare-function org-element-type "org-element" (element)) (declare-function org-file-contents "org" (file &optional noerror)) (declare-function org-mode "org" ()) -(declare-function org-remove-double-quotes "org" (s)) -(declare-function org-with-wide-buffer "org-macs" (&rest body)) +(declare-function vc-backend "vc-hooks" (f)) +(declare-function vc-call "vc-hooks" (fun file &rest args) t) +(declare-function vc-exec-after "vc-dispatcher" (code)) ;;; Variables -(defvar org-macro-templates nil +(defvar-local org-macro-templates nil "Alist containing all macro templates in current buffer. Associations are in the shape of (NAME . TEMPLATE) where NAME stands for macro's name and template for its replacement value, @@ -70,50 +72,48 @@ both as strings. This is an internal variable. Do not set it directly, use instead: #+MACRO: name template") -(make-variable-buffer-local 'org-macro-templates) - ;;; Functions (defun org-macro--collect-macros () "Collect macro definitions in current buffer and setup files. Return an alist containing all macro templates found." - (let* (collect-macros ; For byte-compiler. - (collect-macros - (lambda (files templates) - ;; Return an alist of macro templates. FILES is a list of - ;; setup files names read so far, used to avoid circular - ;; dependencies. TEMPLATES is the alist collected so far. - (let ((case-fold-search t)) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let ((val (org-element-property :value element))) - (if (equal (org-element-property :key element) "MACRO") - ;; Install macro in TEMPLATES. - (when (string-match - "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val) - (let* ((name (match-string 1 val)) - (template (or (match-string 2 val) "")) - (old-cell (assoc name templates))) - (if old-cell (setcdr old-cell template) - (push (cons name template) templates)))) - ;; Enter setup file. - (let ((file (expand-file-name - (org-remove-double-quotes val)))) - (unless (member file files) - (with-temp-buffer - (setq default-directory - (file-name-directory file)) - (org-mode) - (insert (org-file-contents file 'noerror)) - (setq templates - (funcall collect-macros (cons file files) - templates))))))))))) - templates)))) + (letrec ((collect-macros + (lambda (files templates) + ;; Return an alist of macro templates. FILES is a list + ;; of setup files names read so far, used to avoid + ;; circular dependencies. TEMPLATES is the alist + ;; collected so far. + (let ((case-fold-search t)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) "MACRO") + ;; Install macro in TEMPLATES. + (when (string-match + "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val) + (let* ((name (match-string 1 val)) + (template (or (match-string 2 val) "")) + (old-cell (assoc name templates))) + (if old-cell (setcdr old-cell template) + (push (cons name template) templates)))) + ;; Enter setup file. + (let ((file (expand-file-name + (org-unbracket-string "\"" "\"" val)))) + (unless (member file files) + (with-temp-buffer + (setq default-directory + (file-name-directory file)) + (org-mode) + (insert (org-file-contents file 'noerror)) + (setq templates + (funcall collect-macros (cons file files) + templates))))))))))) + templates)))) (funcall collect-macros nil nil))) (defun org-macro-initialize-templates () @@ -148,7 +148,8 @@ function installs the following ones: \"property\", (mapc update-templates (list (cons "input-file" (file-name-nondirectory visited-file)) (cons "modification-time" - (format "(eval (format-time-string \"$1\" '%s))" + (format "(eval (format-time-string \"$1\" (or (and (org-string-nw-p \"$2\") (org-macro--vc-modified-time %s)) '%s)))" + (prin1-to-string visited-file) (prin1-to-string (nth 5 (file-attributes visited-file))))))))) (setq org-macro-templates templates))) @@ -189,54 +190,54 @@ found in the buffer with no definition in TEMPLATES. Optional argument KEYWORDS, when non-nil is a list of keywords, as strings, where macro expansion is allowed." (org-with-wide-buffer - (goto-char (point-min)) - (let ((properties-regexp - (format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords))) - record) - (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) - (let* ((datum (save-match-data (org-element-context))) - (type (org-element-type datum)) - (macro - (cond - ((eq type 'macro) datum) - ;; In parsed keywords and associated node properties, - ;; force macro recognition. - ((or (and (eq type 'keyword) - (member (org-element-property :key datum) keywords)) - (and (eq type 'node-property) - (org-string-match-p - properties-regexp - (org-element-property :key datum)))) - (save-restriction - (narrow-to-region (match-beginning 0) (line-end-position)) - (org-element-map (org-element-parse-buffer) 'macro - #'identity nil t)))))) - (when macro - (let* ((value (org-macro-expand macro templates)) - (begin (org-element-property :begin macro)) - (signature (list begin - macro - (org-element-property :args macro)))) - ;; Avoid circular dependencies by checking if the same - ;; macro with the same arguments is expanded at the same - ;; position twice. - (cond ((member signature record) - (error "Circular macro expansion: %s" - (org-element-property :key macro))) - (value - (push signature record) - (delete-region - begin - ;; Preserve white spaces after the macro. - (progn (goto-char (org-element-property :end macro)) - (skip-chars-backward " \t") - (point))) - ;; Leave point before replacement in case of - ;; recursive expansions. - (save-excursion (insert value))) - (finalize - (error "Undefined Org macro: %s; aborting" - (org-element-property :key macro))))))))))) + (goto-char (point-min)) + (let ((properties-regexp + (format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords))) + record) + (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) + (let* ((datum (save-match-data (org-element-context))) + (type (org-element-type datum)) + (macro + (cond + ((eq type 'macro) datum) + ;; In parsed keywords and associated node properties, + ;; force macro recognition. + ((or (and (eq type 'keyword) + (member (org-element-property :key datum) keywords)) + (and (eq type 'node-property) + (string-match-p + properties-regexp + (org-element-property :key datum)))) + (save-restriction + (narrow-to-region (match-beginning 0) (line-end-position)) + (org-element-map (org-element-parse-buffer) 'macro + #'identity nil t)))))) + (when macro + (let* ((value (org-macro-expand macro templates)) + (begin (org-element-property :begin macro)) + (signature (list begin + macro + (org-element-property :args macro)))) + ;; Avoid circular dependencies by checking if the same + ;; macro with the same arguments is expanded at the same + ;; position twice. + (cond ((member signature record) + (error "Circular macro expansion: %s" + (org-element-property :key macro))) + (value + (push signature record) + (delete-region + begin + ;; Preserve white spaces after the macro. + (progn (goto-char (org-element-property :end macro)) + (skip-chars-backward " \t") + (point))) + ;; Leave point before replacement in case of + ;; recursive expansions. + (save-excursion (insert value))) + (finalize + (error "Undefined Org macro: %s; aborting" + (org-element-property :key macro))))))))))) (defun org-macro-escape-arguments (&rest args) "Build macro's arguments string from ARGS. @@ -279,6 +280,30 @@ Return a list of arguments, as strings. This is the opposite of s nil t) "\000")) +(defun org-macro--vc-modified-time (file) + (save-window-excursion + (when (vc-backend file) + (let ((buf (get-buffer-create " *org-vc*")) + (case-fold-search t) + date) + (unwind-protect + (progn + (vc-call print-log file buf nil nil 1) + (with-current-buffer buf + (vc-exec-after + (lambda () + (goto-char (point-min)) + (when (re-search-forward "Date:?[ \t]*" nil t) + (let ((time (parse-time-string + (buffer-substring + (point) (line-end-position))))) + (when (cl-some #'identity time) + (setq date (apply #'encode-time time)))))))) + (let ((proc (get-buffer-process buf))) + (while (and proc (accept-process-output proc .5 nil t))))) + (kill-buffer buf)) + date)))) + (provide 'org-macro) ;;; org-macro.el ends here diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 631f83a..6c0abcb 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -1,4 +1,4 @@ -;;; org-macs.el --- Top-level definitions for Org-mode +;;; org-macs.el --- Top-level Definitions for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -25,28 +25,12 @@ ;;; Commentary: ;; This file contains macro definitions, defsubst definitions, other -;; stuff needed for compilation and top-level forms in Org-mode, as well -;; lots of small functions that are not org-mode specific but simply -;; generally useful stuff. +;; stuff needed for compilation and top-level forms in Org mode, as +;; well lots of small functions that are not Org mode specific but +;; simply generally useful stuff. ;;; Code: -(eval-and-compile - (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional _arglist _fileonly) - `(autoload ',fn ,file))) - - (if (>= emacs-major-version 23) - (defsubst org-char-to-string(c) - "Defsubst to decode UTF-8 character values in emacs 23 and beyond." - (char-to-string c)) - (defsubst org-char-to-string (c) - "Defsubst to decode UTF-8 character values in emacs 22." - (string (decode-char 'ucs c))))) - -(declare-function org-add-props "org-compat" (string plist &rest props)) -(declare-function org-string-match-p "org-compat" (&rest args)) - (defmacro org-with-gensyms (symbols &rest body) (declare (debug (sexp body)) (indent 1)) `(let ,(mapcar (lambda (s) @@ -54,27 +38,11 @@ symbols) ,@body)) -(defmacro org-called-interactively-p (&optional kind) - (declare (debug (&optional ("quote" symbolp)))) ;Why not just t? - (if (featurep 'xemacs) - `(interactive-p) - (if (or (> emacs-major-version 23) - (and (>= emacs-major-version 23) - (>= emacs-minor-version 2))) - ;; defined with no argument in <=23.1 - `(with-no-warnings (called-interactively-p ,kind)) - `(interactive-p)))) - -(defmacro org-bound-and-true-p (var) - "Return the value of symbol VAR if it is bound, else nil." - (declare (debug (symbolp))) - `(and (boundp (quote ,var)) ,var)) - (defun org-string-nw-p (s) "Return S if S is a string containing a non-blank character. Otherwise, return nil." (and (stringp s) - (org-string-match-p "[^ \r\t\n]" s) + (string-match-p "[^ \r\t\n]" s) s)) (defun org-not-nil (v) @@ -82,25 +50,6 @@ Otherwise, return nil." Otherwise return nil." (and v (not (equal v "nil")) v)) -(defun org-substitute-posix-classes (re) - "Substitute posix classes in regular expression RE." - (let ((ss re)) - (save-match-data - (while (string-match "\\[:alnum:\\]" ss) - (setq ss (replace-match "a-zA-Z0-9" t t ss))) - (while (string-match "\\[:word:\\]" ss) - (setq ss (replace-match "a-zA-Z0-9" t t ss))) - (while (string-match "\\[:alpha:\\]" ss) - (setq ss (replace-match "a-zA-Z" t t ss))) - (while (string-match "\\[:punct:\\]" ss) - (setq ss (replace-match "\001-@[-`{-~" t t ss))) - ss))) - -(defmacro org-re (s) - "Replace posix classes in regular expression." - (declare (debug (form))) - (if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s)) - (defmacro org-preserve-lc (&rest body) (declare (debug (body))) (org-with-gensyms (line col) @@ -136,19 +85,6 @@ Otherwise return nil." (partial-completion-mode 1)) ,@body)) -;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22 -(defmacro org-maybe-intangible (props) - "Add \\='(intangible t) to PROPS if Emacs version is earlier than Emacs 22. -In Emacs 21, invisible text is not avoided by the command loop, so the -intangible property is needed to make sure point skips this text. -In Emacs 22, this is not necessary. The intangible text property has -led to problems with flyspell. These problems are fixed in flyspell.el, -but we still avoid setting the property in Emacs 22 and later. -We use a macro so that the test can happen at compilation time." - (if (< emacs-major-version 22) - `(append '(intangible t) ,props) - props)) - (defmacro org-with-point-at (pom &rest body) "Move to buffer and point of point-or-marker POM for the duration of BODY." (declare (debug (form body)) (indent 1)) @@ -160,10 +96,6 @@ We use a macro so that the test can happen at compilation time." (goto-char (or ,mpom (point))) ,@body))))) -(defmacro org-no-warnings (&rest body) - (declare (debug (body))) - (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) - (defmacro org-with-remote-undo (buffer &rest body) "Execute BODY while recording undo information in two buffers." (declare (debug (form body)) (indent 1)) @@ -199,22 +131,12 @@ We use a macro so that the test can happen at compilation time." org-emphasis t) "Properties to remove when a string without properties is wanted.") -(defsubst org-match-string-no-properties (num &optional string) - (if (featurep 'xemacs) - (let ((s (match-string num string))) - (and s (remove-text-properties 0 (length s) org-rm-props s)) - s) - (match-string-no-properties num string))) - (defsubst org-no-properties (s &optional restricted) "Remove all text properties from string S. When RESTRICTED is non-nil, only remove the properties listed in `org-rm-props'." - (if (fboundp 'set-text-properties) - (set-text-properties 0 (length s) nil s) - (if restricted - (remove-text-properties 0 (length s) org-rm-props s) - (set-text-properties 0 (length s) nil s))) + (if restricted (remove-text-properties 0 (length s) org-rm-props s) + (set-text-properties 0 (length s) nil s)) s) (defsubst org-get-alist-option (option key) @@ -236,16 +158,6 @@ program is needed for, so that the error message can be more informative." (error "Can't find `%s'%s" cmd (if use (format " (%s)" use) ""))))) -(defsubst org-inhibit-invisibility () - "Modified `buffer-invisibility-spec' for Emacs 21. -Some ops with invisible text do not work correctly on Emacs 21. For these -we turn off invisibility temporarily. Use this in a `let' form." - (if (< emacs-major-version 22) nil buffer-invisibility-spec)) - -(defsubst org-set-local (var value) - "Make VAR local in current buffer and set it to VALUE." - (set (make-local-variable var) value)) - (defsubst org-last (list) "Return the last element of LIST." (car (last list))) @@ -298,13 +210,6 @@ This is in contrast to merely setting it to 0." (setq plist (cddr plist))) p)) -(defun org-replace-match-keep-properties (newtext &optional fixedcase - literal string) - "Like `replace-match', but add the text properties found original text." - (setq newtext (org-add-props newtext (text-properties-at - (match-beginning 0) string))) - (replace-match newtext fixedcase literal string)) - (defmacro org-save-outline-visibility (use-markers &rest body) "Save and restore outline visibility around BODY. If USE-MARKERS is non-nil, use markers for the positions. @@ -313,19 +218,15 @@ but it also means that the buffer should stay alive during the operation, because otherwise all these markers will point nowhere." (declare (debug (form body)) (indent 1)) - (org-with-gensyms (data rtn) - `(let ((,data (org-outline-overlay-data ,use-markers)) - ,rtn) + (org-with-gensyms (data) + `(let ((,data (org-outline-overlay-data ,use-markers))) (unwind-protect - (progn - (setq ,rtn (progn ,@body)) + (prog1 (progn ,@body) (org-set-outline-overlay-data ,data)) (when ,use-markers - (mapc (lambda (c) - (and (markerp (car c)) (move-marker (car c) nil)) - (and (markerp (cdr c)) (move-marker (cdr c) nil))) - ,data))) - ,rtn))) + (dolist (c ,data) + (when (markerp (car c)) (move-marker (car c) nil)) + (when (markerp (cdr c)) (move-marker (cdr c) nil)))))))) (defmacro org-with-wide-buffer (&rest body) "Execute body while temporarily widening the buffer." @@ -366,12 +267,6 @@ The number of levels is controlled by `org-inlinetask-min-level'" limit-level))) (format "\\*\\{1,%d\\} " nstars))))) -(defun org-format-seconds (string seconds) - "Compatibility function replacing format-seconds." - (if (fboundp 'format-seconds) - (format-seconds string seconds) - (format-time-string string (seconds-to-time seconds)))) - (defmacro org-eval-in-environment (environment form) (declare (debug (form form)) (indent 1)) `(eval (list 'let ,environment ',form))) @@ -387,10 +282,17 @@ the value in cdr." ;;;###autoload (defmacro org-load-noerror-mustsuffix (file) - "Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it." - (if (featurep 'xemacs) - `(load ,file 'noerror) - `(load ,file 'noerror nil nil 'mustsuffix))) + "Load FILE with optional arguments NOERROR and MUSTSUFFIX." + `(load ,file 'noerror nil nil 'mustsuffix)) + +(defun org-unbracket-string (pre post string) + "Remove PRE/POST from the beginning/end of STRING. +Both PRE and POST must be pre-/suffixes of STRING, or neither is +removed." + (if (and (string-prefix-p pre string) + (string-suffix-p post string)) + (substring string (length pre) (- (length post))) + string)) (provide 'org-macs) diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el index e8abef9..5d9ae58 100644 --- a/lisp/org-mhe.el +++ b/lisp/org-mhe.el @@ -1,4 +1,4 @@ -;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode +;;; org-mhe.el --- Support for Links to MH-E Messages -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -24,8 +24,8 @@ ;; ;;; Commentary: -;; This file implements links to MH-E messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; This file implements links to MH-E messages from within Org. +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;;; Code: @@ -74,34 +74,25 @@ supported by MH-E." (defvar mh-search-regexp-builder) ;; Install the link type -(org-add-link-type "mhe" 'org-mhe-open) -(add-hook 'org-store-link-functions 'org-mhe-store-link) +(org-link-set-parameters "mhe" :follow #'org-mhe-open :store #'org-mhe-store-link) ;; Implementation (defun org-mhe-store-link () "Store a link to an MH-E folder or message." - (when (or (equal major-mode 'mh-folder-mode) - (equal major-mode 'mh-show-mode)) + (when (or (eq major-mode 'mh-folder-mode) + (eq major-mode 'mh-show-mode)) (save-window-excursion (let* ((from (org-mhe-get-header "From:")) (to (org-mhe-get-header "To:")) (message-id (org-mhe-get-header "Message-Id:")) (subject (org-mhe-get-header "Subject:")) (date (org-mhe-get-header "Date:")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) link desc) - (org-store-link-props :type "mh" :from from :to to + (org-store-link-props :type "mh" :from from :to to :date date :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) (setq desc (org-email-link-description)) (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#" - (org-remove-angle-brackets message-id))) + (org-unbracket-string "<" ">" message-id))) (org-add-link-props :link link :description desc) link)))) @@ -120,7 +111,7 @@ supported by MH-E." So if you use sequences, it will now work." (save-excursion (let* ((folder - (if (equal major-mode 'mh-folder-mode) + (if (eq major-mode 'mh-folder-mode) mh-current-folder ;; Refer to the show buffer mh-show-folder-buffer)) @@ -132,7 +123,7 @@ So if you use sequences, it will now work." ;; mh-index-data is always nil in a show buffer. (if (and (boundp 'mh-index-folder) (string= mh-index-folder (substring folder 0 end-index))) - (if (equal major-mode 'mh-show-mode) + (if (eq major-mode 'mh-show-mode) (save-window-excursion (let (pop-up-frames) (when (buffer-live-p (get-buffer folder)) @@ -158,7 +149,7 @@ So if you use sequences, it will now work." "Return the name of the current message folder. Be careful if you use sequences." (save-excursion - (if (equal major-mode 'mh-folder-mode) + (if (eq major-mode 'mh-folder-mode) mh-current-folder ;; Refer to the show buffer mh-show-folder-buffer))) @@ -167,7 +158,7 @@ Be careful if you use sequences." "Return the number of the current message. Be careful if you use sequences." (save-excursion - (if (equal major-mode 'mh-folder-mode) + (if (eq major-mode 'mh-folder-mode) (mh-get-msg-num nil) ;; Refer to the show buffer (mh-show-buffer-message-number)))) @@ -182,12 +173,12 @@ you have a better idea of how to do this then please let us know." (header-field)) (with-current-buffer buffer (mh-display-msg num folder) - (if (equal major-mode 'mh-folder-mode) + (if (eq major-mode 'mh-folder-mode) (mh-header-display) (mh-show-header-display)) (set-buffer buffer) (setq header-field (mh-get-header-field header)) - (if (equal major-mode 'mh-folder-mode) + (if (eq major-mode 'mh-folder-mode) (mh-show) (mh-show-show)) (org-trim header-field)))) @@ -206,7 +197,7 @@ folders." (if (not article) (mh-visit-folder (mh-normalize-folder-name folder)) (mh-search-choose) - (if (equal mh-searcher 'pick) + (if (eq mh-searcher 'pick) (progn (setq article (org-add-angle-brackets article)) (mh-search folder (list "--message-id" article)) diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index e6709e4..3ef3f4e 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -1,4 +1,4 @@ -;;; org-mobile.el --- Code for asymmetric sync with a mobile device +;;; org-mobile.el --- Code for Asymmetric Sync With a Mobile Device -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> @@ -24,21 +24,20 @@ ;; ;;; Commentary: ;; -;; This file contains the code to interact with Richard Moreland's iPhone -;; application MobileOrg, as well as with the Android version by Matthew Jones. -;; This code is documented in Appendix B of the Org-mode manual. The code is -;; not specific for the iPhone and Android - any external -;; viewer/flagging/editing application that uses the same conventions could -;; be used. +;; This file contains the code to interact with Richard Moreland's +;; iPhone application MobileOrg, as well as with the Android version +;; by Matthew Jones. This code is documented in Appendix B of the Org +;; manual. The code is not specific for the iPhone and Android - any +;; external viewer/flagging/editing application that uses the same +;; conventions could be used. (require 'org) (require 'org-agenda) -;;; Code: +(require 'cl-lib) -(eval-when-compile (require 'cl)) +(defvar org-agenda-keep-restricted-file-list) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) +;;; Code: (defgroup org-mobile nil "Options concerning support for a viewer/editor on a mobile device." @@ -192,27 +191,6 @@ the editing types for which the mobile version should always dominate." (const heading) (const body)))) -(defcustom org-mobile-action-alist - '(("edit" . (org-mobile-edit data old new))) - "Alist with flags and actions for mobile sync. -When flagging an entry, MobileOrg will create entries that look like - - * F(action:data) [[id:entry-id][entry title]] - -This alist defines that the ACTION in the parentheses of F() should mean, -i.e. what action should be taken. The :data part in the parenthesis is -optional. If present, the string after the colon will be passed to the -action form as the `data' variable. -The car of each elements of the alist is an actions string. The cdr is -an Emacs Lisp form that will be evaluated with the cursor on the headline -of that entry. - -For now, it is not recommended to change this variable." - :group 'org-mobile - :type '(repeat - (cons (string :tag "Action flag") - (sexp :tag "Action form")))) - (defcustom org-mobile-checksum-binary (or (executable-find "shasum") (executable-find "sha1sum") (executable-find "md5sum") @@ -249,6 +227,23 @@ by the mobile device, this hook should be used to copy the emptied capture file `mobileorg.org' back to the WebDAV directory, for example using `rsync' or `scp'.") +(defconst org-mobile-action-alist '(("edit" . org-mobile-edit)) + "Alist with flags and actions for mobile sync. +When flagging an entry, MobileOrg will create entries that look like + + * F(action:data) [[id:entry-id][entry title]] + +This alist defines that the ACTION in the parentheses of F() +should mean, i.e. what action should be taken. The :data part in +the parenthesis is optional. If present, the string after the +colon will be passed to the action function as the first argument +variable. + +The car of each elements of the alist is an actions string. The +cdr is a function that is called with the cursor on the headline +of that entry. It should accept three arguments, the :data part, +the old and new values for the entry.") + (defvar org-mobile-last-flagged-files nil "List of files containing entries flagged in the latest pull.") @@ -422,10 +417,10 @@ agenda view showing the flagged items." (let ((files-alist (sort (copy-sequence org-mobile-files-alist) (lambda (a b) (string< (cdr a) (cdr b))))) (def-todo (default-value 'org-todo-keywords)) - (def-tags (default-value 'org-tag-alist)) + (def-tags org-tag-alist) (target-file (expand-file-name org-mobile-index-file org-mobile-directory)) - file link-name todo-kwds done-kwds tags entry kwds dwds twds) + todo-kwds done-kwds tags) (when (stringp (car def-todo)) (setq def-todo (list (cons 'sequence def-todo)))) (org-agenda-prepare-buffers (mapcar 'car files-alist)) @@ -435,35 +430,24 @@ agenda view showing the flagged items." (org-uniquify org-todo-keywords-for-agenda))) (setq tags (mapcar 'car (org-global-tags-completion-table (mapcar 'car files-alist)))) - (with-temp-file - (if org-mobile-use-encryption - org-mobile-encryption-tempfile - target-file) + (with-temp-file (if org-mobile-use-encryption org-mobile-encryption-tempfile + target-file) (insert "#+READONLY\n") - (while (setq entry (pop def-todo)) - (setq kwds (mapcar (lambda (x) (if (string-match "(" x) - (substring x 0 (match-beginning 0)) - x)) - (cdr entry))) - (insert "#+TODO: " (mapconcat 'identity kwds " ") "\n") - (setq dwds (or (member "|" kwds) (last kwds)) - twds (org-delete-all dwds kwds) - todo-kwds (org-delete-all twds todo-kwds) - done-kwds (org-delete-all dwds done-kwds))) + (dolist (entry def-todo) + (let ((kwds (mapcar (lambda (x) + (if (string-match "(" x) + (substring x 0 (match-beginning 0)) + x)) + (cdr entry)))) + (insert "#+TODO: " (mapconcat #'identity kwds " ") "\n") + (let* ((dwds (or (member "|" kwds) (last kwds))) + (twds (org-delete-all dwds kwds))) + (setq todo-kwds (org-delete-all twds todo-kwds)) + (setq done-kwds (org-delete-all dwds done-kwds))))) (when (or todo-kwds done-kwds) (insert "#+TODO: " (mapconcat 'identity todo-kwds " ") " | " (mapconcat 'identity done-kwds " ") "\n")) - (setq def-tags (mapcar - (lambda (x) - (cond ((null x) nil) - ((stringp x) x) - ((eq (car x) :startgroup) "{") - ((eq (car x) :endgroup) "}") - ((eq (car x) :grouptags) nil) - ((eq (car x) :newline) nil) - ((listp x) (car x)))) - def-tags)) - (setq def-tags (delq nil def-tags)) + (setq def-tags (split-string (org-tag-alist-to-string def-tags t))) (setq tags (org-delete-all def-tags tags)) (setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b))))) (setq tags (append def-tags tags nil)) @@ -472,11 +456,8 @@ agenda view showing the flagged items." (when (file-exists-p (expand-file-name org-mobile-directory "agendas.org")) (insert "* [[file:agendas.org][Agenda Views]]\n")) - (while (setq entry (pop files-alist)) - (setq file (car entry) - link-name (cdr entry)) - (insert (format "* [[file:%s][%s]]\n" - link-name link-name))) + (pcase-dolist (`(,_ . ,link-name) files-alist) + (insert (format "* [[file:%s][%s]]\n" link-name link-name))) (push (cons org-mobile-index-file (md5 (buffer-string))) org-mobile-checksum-files)) (when org-mobile-use-encryption @@ -662,7 +643,7 @@ The table of checksums is written to the file mobile-checksums." m 10 " " 'planning) "\n") (when (setq id - (if (org-bound-and-true-p + (if (bound-and-true-p org-mobile-force-id-on-agenda-items) (org-id-get m 'create) (or (org-entry-get m "ID") @@ -822,14 +803,14 @@ If BEG and END are given, only do this in that region." (cnt-flag 0) (cnt-error 0) buf-list - id-pos org-mobile-error) + org-mobile-error) ;; Count the new captures (goto-char beg) (while (re-search-forward "^\\* \\(.*\\)" end t) (and (>= (- (match-end 1) (match-beginning 1)) 2) (not (equal (downcase (substring (match-string 1) 0 2)) "f(")) - (incf cnt-new))) + (cl-incf cnt-new))) ;; Find and apply the edits (goto-char beg) @@ -841,19 +822,21 @@ If BEG and END are given, only do this in that region." (id-pos (condition-case msg (org-mobile-locate-entry (match-string 4)) (error (nth 1 msg)))) - (bos (point-at-bol)) + (bos (line-beginning-position)) (eos (save-excursion (org-end-of-subtree t t))) (cmd (if (equal action "") - '(progn - (incf cnt-flag) - (org-toggle-tag "FLAGGED" 'on) - (and note - (org-entry-put nil "THEFLAGGINGNOTE" note))) - (incf cnt-edit) + (let ((note (buffer-substring-no-properties + (line-beginning-position 2) eos))) + (lambda (_data _old _new) + (cl-incf cnt-flag) + (org-toggle-tag "FLAGGED" 'on) + (org-entry-put + nil "THEFLAGGINGNOTE" + (replace-regexp-in-string "\n" "\\\\n" note)))) + (cl-incf cnt-edit) (cdr (assoc action org-mobile-action-alist)))) - (note (and (equal action "") - (buffer-substring (1+ (point-at-eol)) eos))) - (org-inhibit-logging 'note) ;; Do not take notes interactively + ;; Do not take notes interactively. + (org-inhibit-logging 'note) old new) (goto-char bos) @@ -866,11 +849,11 @@ If BEG and END are given, only do this in that region." (if (stringp id-pos) (insert id-pos " ") (insert "BAD REFERENCE ")) - (incf cnt-error) + (cl-incf cnt-error) (throw 'next t)) (unless cmd (insert "BAD FLAG ") - (incf cnt-error) + (cl-incf cnt-error) (throw 'next t)) (move-marker bos-marker (point)) (if (re-search-forward "^** Old value[ \t]*$" eos t) @@ -883,34 +866,28 @@ If BEG and END are given, only do this in that region." (progn (outline-next-heading) (if (eobp) (org-back-over-empty-lines)) (point))))) - (setq old (and old (if (string-match "\\S-" old) old nil))) - (setq new (and new (if (string-match "\\S-" new) new nil))) - (if (and note (> (length note) 0)) - ;; Make Note into a single line, to fit into a property - (setq note (mapconcat 'identity - (org-split-string (org-trim note) "\n") - "\\n"))) + (setq old (org-string-nw-p old)) + (setq new (org-string-nw-p new)) (unless (equal data "body") - (setq new (and new (org-trim new)) - old (and old (org-trim old)))) + (setq new (and new (org-trim new))) + (setq old (and old (org-trim old)))) (goto-char (+ 2 bos-marker)) ;; Remember this place so that we can return (move-marker marker (point)) (setq org-mobile-error nil) - (save-excursion - (condition-case msg - (org-with-point-at id-pos - (progn - (eval cmd) - (unless (member data (list "delete" "archive" "archive-sibling" "addheading")) - (if (member "FLAGGED" (org-get-tags)) - (add-to-list 'org-mobile-last-flagged-files - (buffer-file-name (current-buffer))))))) - (error (setq org-mobile-error msg)))) + (condition-case msg + (org-with-point-at id-pos + (funcall cmd data old new) + (unless (member data '("delete" "archive" "archive-sibling" + "addheading")) + (when (member "FLAGGED" (org-get-tags)) + (add-to-list 'org-mobile-last-flagged-files + (buffer-file-name))))) + (error (setq org-mobile-error msg))) (when org-mobile-error - (org-pop-to-buffer-same-window (marker-buffer marker)) + (pop-to-buffer-same-window (marker-buffer marker)) (goto-char marker) - (incf cnt-error) + (cl-incf cnt-error) (insert (if (stringp (nth 1 org-mobile-error)) (nth 1 org-mobile-error) "EXECUTION FAILED") @@ -923,8 +900,8 @@ If BEG and END are given, only do this in that region." (save-buffer) (move-marker marker nil) (move-marker end nil) - (message "%d new, %d edits, %d flags, %d errors" cnt-new - cnt-edit cnt-flag cnt-error) + (message "%d new, %d edits, %d flags, %d errors" + cnt-new cnt-edit cnt-flag cnt-error) (sit-for 1))) (defun org-mobile-timestamp-buffer (buf) @@ -1019,7 +996,7 @@ be returned that indicates what went wrong." ((equal new "DONEARCHIVE") (org-todo 'done) (org-archive-subtree-default)) - ((equal new current) t) ; nothing needs to be done + ((equal new current) t) ; nothing needs to be done ((or (equal current old) (eq org-mobile-force-mobile-change t) (memq 'todo org-mobile-force-mobile-change)) @@ -1041,33 +1018,35 @@ be returned that indicates what went wrong." (or old "") (or current ""))))) ((eq what 'priority) - (when (looking-at org-complex-heading-regexp) - (setq current (and (match-end 3) (substring (match-string 3) 2 3))) - (cond - ((equal current new) t) ; no action required - ((or (equal current old) - (eq org-mobile-force-mobile-change t) - (memq 'tags org-mobile-force-mobile-change)) - (org-priority (and new (string-to-char new)))) - (t (error "Priority was expected to be %s, but is %s" - old current))))) + (let ((case-fold-search nil)) + (when (looking-at org-complex-heading-regexp) + (let ((current (and (match-end 3) (substring (match-string 3) 2 3)))) + (cond + ((equal current new) t) ;no action required + ((or (equal current old) + (eq org-mobile-force-mobile-change t) + (memq 'tags org-mobile-force-mobile-change)) + (org-priority (and new (string-to-char new)))) + (t (error "Priority was expected to be %s, but is %s" + old current))))))) ((eq what 'heading) - (when (looking-at org-complex-heading-regexp) - (setq current (match-string 4)) - (cond - ((equal current new) t) ; no action required - ((or (equal current old) - (eq org-mobile-force-mobile-change t) - (memq 'heading org-mobile-force-mobile-change)) - (goto-char (match-beginning 4)) - (insert new) - (delete-region (point) (+ (point) (length current))) - (org-set-tags nil 'align)) - (t (error "Heading changed in MobileOrg and on the computer"))))) + (let ((case-fold-search nil)) + (when (looking-at org-complex-heading-regexp) + (let ((current (match-string 4))) + (cond + ((equal current new) t) ;no action required + ((or (equal current old) + (eq org-mobile-force-mobile-change t) + (memq 'heading org-mobile-force-mobile-change)) + (goto-char (match-beginning 4)) + (insert new) + (delete-region (point) (+ (point) (length current))) + (org-set-tags nil 'align)) + (t (error "Heading changed in MobileOrg and on the computer"))))))) ((eq what 'addheading) - (if (org-at-heading-p) ; if false we are in top-level of file + (if (org-at-heading-p) ; if false we are in top-level of file (progn ;; Workaround a `org-insert-heading-respect-content' bug ;; which prevents correct insertion when point is invisible @@ -1082,7 +1061,7 @@ be returned that indicates what went wrong." ((eq what 'refile) (org-copy-subtree) (org-with-point-at (org-mobile-locate-entry new) - (if (org-at-heading-p) ; if false we are in top-level of file + (if (org-at-heading-p) ; if false we are in top-level of file (progn (setq level (org-get-valid-level (funcall outline-level) 1)) (org-end-of-subtree t t) diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index 232a4be..797a21f 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -1,4 +1,4 @@ -;;; org-mouse.el --- Better mouse support for org-mode +;;; org-mouse.el --- Better mouse support for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2016 Free Software Foundation, Inc. @@ -26,8 +26,8 @@ ;; ;; http://orgmode.org ;; -;; Org-mouse implements the following features: -;; * following links with the left mouse button (in Emacs 22) +;; Org mouse implements the following features: +;; * following links with the left mouse button ;; * subtree expansion/collapse (org-cycle) with the left mouse button ;; * several context menus on the right mouse button: ;; + general text @@ -66,12 +66,12 @@ ;; History: ;; -;; Since version 5.10: Changes are listed in the general org-mode docs. +;; Since version 5.10: Changes are listed in the general Org docs. ;; -;; Version 5.09;; + Version number synchronization with Org-mode. +;; Version 5.09;; + Version number synchronization with Org mode. ;; ;; Version 0.25 -;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch) +;; + made compatible with Org 4.70 (thanks to Carsten for the patch) ;; ;; Version 0.24 ;; + minor changes to the table menu @@ -81,7 +81,7 @@ ;; + context menu support for org-agenda-undo & org-sort-entries ;; ;; Version 0.22 -;; + handles undo support for the agenda buffer (requires org-mode >=4.58) +;; + handles undo support for the agenda buffer (requires Org >=4.58) ;; ;; Version 0.21 ;; + selected text activates its context menu @@ -105,7 +105,7 @@ ;; + added support for checkboxes ;; ;; Version 0.15 -;; + org-mode now works with the Agenda buffer as well +;; + Org now works with the Agenda buffer as well ;; ;; Version 0.14 ;; + added a menu option that converts plain list items to outline items @@ -125,7 +125,7 @@ ;; ;; Version 0.10 ;; + added a menu option to remove highlights -;; + compatible with org-mode 4.21 now +;; + compatible with Org 4.21 now ;; ;; Version 0.08: ;; + trees can be moved/promoted/demoted by dragging with the right @@ -136,8 +136,8 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'org) +(require 'cl-lib) (defvar org-agenda-allow-remote-undo) (defvar org-agenda-undo-list) @@ -149,6 +149,8 @@ (declare-function org-agenda-earlier "org-agenda" (arg)) (declare-function org-agenda-later "org-agenda" (arg)) +(defvar org-mouse-main-buffer nil + "Active buffer for mouse operations.") (defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " "Regular expression that matches a plain list.") (defvar org-mouse-direct t @@ -191,15 +193,14 @@ Changing this variable requires a restart of Emacs to get activated." (interactive) (end-of-line) (skip-chars-backward "\t ") - (when (org-looking-back ":[A-Za-z]+:" (line-beginning-position)) + (when (looking-back ":[A-Za-z]+:" (line-beginning-position)) (skip-chars-backward ":A-Za-z") (skip-chars-backward "\t "))) -(defvar org-mouse-context-menu-function nil +(defvar-local org-mouse-context-menu-function nil "Function to create the context menu. The value of this variable is the function invoked by `org-mouse-context-menu' as the context menu.") -(make-variable-buffer-local 'org-mouse-context-menu-function) (defun org-mouse-show-context-menu (event prefix) "Invoke the context menu. @@ -220,7 +221,7 @@ this function is called. Otherwise, the current major mode menu is used." (funcall org-mouse-context-menu-function event) (if (fboundp 'mouse-menu-major-mode-map) (popup-menu (mouse-menu-major-mode-map) event prefix) - (org-no-warnings ; don't warn about fallback, obsolete since 23.1 + (with-no-warnings ; don't warn about fallback, obsolete since 23.1 (mouse-major-mode-menu event prefix))))) (setq this-command 'mouse-save-then-kill) (mouse-save-then-kill event))) @@ -257,7 +258,7 @@ If the point is at the :beginning (`org-mouse-line-position') of the line, insert the new heading before the current line. Otherwise, insert it after the current heading." (interactive) - (case (org-mouse-line-position) + (cl-case (org-mouse-line-position) (:beginning (beginning-of-line) (org-insert-heading)) (t (org-mouse-next-heading) @@ -313,10 +314,10 @@ nor a function, elements of KEYWORDS are used directly." (just-one-space)) (defvar org-mouse-rest) -(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase - literal string subexp) +(defun org-mouse-replace-match-and-surround + (_newtext &optional _fixedcase _literal _string subexp) "The same as `replace-match', but surrounds the replacement with spaces." - (apply 'replace-match org-mouse-rest) + (apply #'replace-match org-mouse-rest) (save-excursion (goto-char (match-beginning (or subexp 0))) (just-one-space) @@ -406,8 +407,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (> (match-end 0) point)))))) (defun org-mouse-priority-list () - (loop for priority from ?A to org-lowest-priority - collect (char-to-string priority))) + (cl-loop for priority from ?A to org-lowest-priority + collect (char-to-string priority))) (defun org-mouse-todo-menu (state) "Create the menu with TODO keywords." @@ -459,33 +460,33 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (insert " [ ] ")))) (defun org-mouse-agenda-type (type) - (case type - ('tags "Tags: ") - ('todo "TODO: ") - ('tags-tree "Tags tree: ") - ('todo-tree "TODO tree: ") - ('occur-tree "Occur tree: ") - (t "Agenda command ???"))) + (pcase type + (`tags "Tags: ") + (`todo "TODO: ") + (`tags-tree "Tags tree: ") + (`todo-tree "TODO tree: ") + (`occur-tree "Occur tree: ") + (_ "Agenda command ???"))) (defun org-mouse-list-options-menu (alloptions &optional function) (let ((options (save-match-data (split-string (match-string-no-properties 1))))) (print options) - (loop for name in alloptions - collect - (vector name - `(progn - (replace-match - (mapconcat 'identity - (sort (if (member ',name ',options) - (delete ',name ',options) - (cons ',name ',options)) - 'string-lessp) - " ") - nil nil nil 1) - (when (functionp ',function) (funcall ',function))) - :style 'toggle - :selected (and (member name options) t))))) + (cl-loop for name in alloptions + collect + (vector name + `(progn + (replace-match + (mapconcat 'identity + (sort (if (member ',name ',options) + (delete ',name ',options) + (cons ',name ',options)) + 'string-lessp) + " ") + nil nil nil 1) + (when (functionp ',function) (funcall ',function))) + :style 'toggle + :selected (and (member name options) t))))) (defun org-mouse-clip-text (text maxlength) (if (> (length text) maxlength) @@ -555,12 +556,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (let ((contextdata (assq context contextlist))) (when contextdata (save-excursion - (goto-char (second contextdata)) - (re-search-forward ".*" (third contextdata)))))) + (goto-char (nth 1 contextdata)) + (re-search-forward ".*" (nth 2 contextdata)))))) (defun org-mouse-for-each-item (funct) - ;; Functions called by `org-apply-on-list' need an argument - (let ((wrap-fun (lambda (c) (funcall funct)))) + ;; Functions called by `org-apply-on-list' need an argument. + (let ((wrap-fun (lambda (_) (funcall funct)))) (when (ignore-errors (goto-char (org-in-item-p))) (save-excursion (org-apply-on-list wrap-fun nil))))) @@ -571,14 +572,14 @@ This means, between the beginning of line and the point." (skip-chars-backward " \t*") (bolp))) (defun org-mouse-insert-item (text) - (case (org-mouse-line-position) - (:beginning ; insert before + (cl-case (org-mouse-line-position) + (:beginning ; insert before (beginning-of-line) (looking-at "[ \t]*") (open-line 1) - (org-indent-to-column (- (match-end 0) (match-beginning 0))) + (indent-to-column (- (match-end 0) (match-beginning 0))) (insert "+ ")) - (:middle ; insert after + (:middle ; insert after (end-of-line) (newline t) (indent-relative) @@ -586,7 +587,7 @@ This means, between the beginning of line and the point." (:end ; insert text here (skip-chars-backward " \t") (kill-region (point) (point-at-eol)) - (unless (org-looking-back org-mouse-punctuation (line-beginning-position)) + (unless (looking-back org-mouse-punctuation (line-beginning-position)) (insert (concat org-mouse-punctuation " "))))) (insert text) (beginning-of-line)) @@ -644,8 +645,8 @@ This means, between the beginning of line and the point." 'org-mode-restart)))) ((or (eolp) (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") - (org-looking-back " \\|\t" (- (point) 2) - (line-beginning-position)))) + (looking-back " \\|\t" (- (point) 2) + (line-beginning-position)))) (org-mouse-popup-global-menu)) ((funcall get-context :checkbox) (popup-menu @@ -737,13 +738,13 @@ This means, between the beginning of line and the point." ["- 1 Month" (org-timestamp-change -1 'month)]))) ((funcall get-context :table-special) (let ((mdata (match-data))) - (incf (car mdata) 2) + (cl-incf (car mdata) 2) (store-match-data mdata)) (message "match: %S" (match-string 0)) (popup-menu `(nil ,@(org-mouse-keyword-replace-menu '(" " "!" "^" "_" "$" "#" "*" "'") 0 (lambda (mark) - (case (string-to-char mark) + (cl-case (string-to-char mark) (? "( ) Nothing Special") (?! "(!) Column Names") (?^ "(^) Field Names Above") @@ -914,7 +915,7 @@ This means, between the beginning of line and the point." ((org-footnote-at-reference-p) nil) (t ad-do-it)))))) -(defun org-mouse-move-tree-start (event) +(defun org-mouse-move-tree-start (_event) (interactive "e") (message "Same line: promote/demote, (***):move before, (text): make a child")) @@ -993,7 +994,7 @@ This means, between the beginning of line and the point." (defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'. (defun org-mouse-do-remotely (command) - ; (org-agenda-check-no-diary) + ;; (org-agenda-check-no-diary) (when (get-text-property (point) 'org-marker) (let* ((anticol (- (point-at-eol) (point))) (marker (get-text-property (point) 'org-marker)) @@ -1031,7 +1032,7 @@ This means, between the beginning of line and the point." (org-agenda-change-all-lines newhead hdmarker 'fixface)))) t)))) -(defun org-mouse-agenda-context-menu (&optional event) +(defun org-mouse-agenda-context-menu (&optional _event) (or (org-mouse-do-remotely 'org-mouse-context-menu) (popup-menu '("Agenda" @@ -1093,17 +1094,17 @@ This means, between the beginning of line and the point." ; (setq org-agenda-mode-hook nil) (defvar org-agenda-mode-map) (add-hook 'org-agenda-mode-hook - #'(lambda () - (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) - (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) - (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) - (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) - (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) - (org-defkey org-agenda-mode-map [drag-mouse-3] - #'(lambda (event) (interactive "e") - (case (org-mouse-get-gesture event) - (:left (org-agenda-earlier 1)) - (:right (org-agenda-later 1))))))) + (lambda () + (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) + (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) + (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) + (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) + (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) + (org-defkey org-agenda-mode-map [drag-mouse-3] + (lambda (event) (interactive "e") + (cl-case (org-mouse-get-gesture event) + (:left (org-agenda-earlier 1)) + (:right (org-agenda-later 1))))))) (provide 'org-mouse) diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index e27492c..f3b498e 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -1,4 +1,4 @@ -;;; org-pcomplete.el --- In-buffer completion code +;;; org-pcomplete.el --- In-buffer Completion Code -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. ;; @@ -27,21 +27,17 @@ ;;;; Require other packages -(eval-when-compile - (require 'cl)) - (require 'org-macs) (require 'org-compat) (require 'pcomplete) -(declare-function org-split-string "org" (string &optional separators)) -(declare-function org-make-org-heading-search-string "org" - (&optional string)) +(declare-function org-make-org-heading-search-string "org" (&optional string)) (declare-function org-get-buffer-tags "org" ()) (declare-function org-get-tags "org" ()) (declare-function org-buffer-property-keys "org" - (&optional include-specials include-defaults include-columns)) -(declare-function org-entry-properties "org" (&optional pom which specific)) + (&optional specials defaults columns ignore-malformed)) +(declare-function org-entry-properties "org" (&optional pom which)) +(declare-function org-tag-alist-to-string "org" (alist &optional skip-key)) ;;;; Customization variables @@ -52,12 +48,13 @@ (defvar org-drawer-regexp) (defvar org-property-re) +(defvar org-current-tag-alist) (defun org-thing-at-point () "Examine the thing at point and let the caller know what it is. The return value is a string naming the thing at point." (let ((beg1 (save-excursion - (skip-chars-backward (org-re "[:alnum:]-_@")) + (skip-chars-backward "[:alnum:]-_@") (point))) (beg (save-excursion (skip-chars-backward "a-zA-Z0-9-_:$") @@ -93,10 +90,10 @@ The return value is a string naming the thing at point." (skip-chars-backward "[ \t\n]") ;; org-drawer-regexp matches a whole line but while ;; looking-back, we just ignore trailing whitespaces - (or (org-looking-back (substring org-drawer-regexp 0 -1) - (line-beginning-position)) - (org-looking-back org-property-re - (line-beginning-position))))) + (or (looking-back (substring org-drawer-regexp 0 -1) + (line-beginning-position)) + (looking-back org-property-re + (line-beginning-position))))) (cons "prop" nil)) ((and (equal (char-before beg1) ?:) (not (equal (char-after (point-at-bol)) ?*))) @@ -142,7 +139,6 @@ When completing for #+STARTUP, for example, this function returns pcomplete-default-completion-function)))) (defvar org-options-keywords) ; From org.el -(defvar org-element-block-name-alist) ; From org-element.el (defvar org-element-affiliated-keywords) ; From org-element.el (declare-function org-get-export-keywords "org" ()) (defun pcomplete/org-mode/file-option () @@ -155,16 +151,19 @@ When completing for #+STARTUP, for example, this function returns (mapcar (lambda (keyword) (concat keyword ": ")) org-element-affiliated-keywords) (let (block-names) - (dolist (block-info org-element-block-name-alist block-names) - (let ((name (car block-info))) - (push (format "END_%s" name) block-names) - (push (concat "BEGIN_" - name - ;; Since language is compulsory in - ;; source blocks, add a space. - (and (equal name "SRC") " ")) - block-names) - (push (format "ATTR_%s: " name) block-names)))) + (dolist (name + '("CENTER" "COMMENT" "EXAMPLE" "EXPORT" "QUOTE" "SRC" + "VERSE") + block-names) + (push (format "END_%s" name) block-names) + (push (concat "BEGIN_" + name + ;; Since language is compulsory in + ;; export blocks source blocks, add + ;; a space. + (and (member name '("EXPORT" "SRC")) " ")) + block-names) + (push (format "ATTR_%s: " name) block-names))) (mapcar (lambda (keyword) (concat keyword ": ")) (org-get-export-keywords)))) (substring pcomplete-stub 2))) @@ -235,20 +234,10 @@ When completing for #+STARTUP, for example, this function returns (setq opts (delete "showstars" opts))))) opts)))) -(defvar org-tag-alist) (defun pcomplete/org-mode/file-option/tags () "Complete arguments for the #+TAGS file option." (pcomplete-here - (list - (mapconcat (lambda (x) - (cond - ((eq :startgroup (car x)) "{") - ((eq :endgroup (car x)) "}") - ((eq :grouptags (car x)) ":") - ((eq :newline (car x)) "\\n") - ((cdr x) (format "%s(%c)" (car x) (cdr x))) - (t (car x)))) - org-tag-alist " ")))) + (list (org-tag-alist-to-string org-current-tag-alist)))) (defun pcomplete/org-mode/file-option/title () "Complete arguments for the #+TITLE file option." @@ -260,7 +249,7 @@ When completing for #+STARTUP, for example, this function returns (buffer-name (buffer-base-buffer))))))) -(declare-function org-export-backend-options "org-export" (cl-x)) +(declare-function org-export-backend-options "ox" (cl-x) t) (defun pcomplete/org-mode/file-option/options () "Complete arguments for the #+OPTIONS file option." (while (pcomplete-here @@ -273,7 +262,7 @@ When completing for #+STARTUP, for example, this function returns "|:" "tags:" "tasks:" "<:" "todo:") ;; OPTION items from registered back-ends. (let (items) - (dolist (backend (org-bound-and-true-p + (dolist (backend (bound-and-true-p org-export-registered-backends)) (dolist (option (org-export-backend-options backend)) (let ((item (nth 2 option))) @@ -285,7 +274,7 @@ When completing for #+STARTUP, for example, this function returns (while (pcomplete-here (pcomplete-uniqify-list (mapcar (lambda (item) (format "%s:" (car item))) - (org-bound-and-true-p org-html-infojs-opts-table)))))) + (bound-and-true-p org-html-infojs-opts-table)))))) (defun pcomplete/org-mode/file-option/bind () "Complete arguments for the #+BIND file option, which are variable names." @@ -333,19 +322,16 @@ This needs more work, to handle headings with lots of spaces in them." (pcomplete-uniqify-list tbl))) (substring pcomplete-stub 1)))) -(defvar org-tag-alist) (defun pcomplete/org-mode/tag () "Complete a tag name. Omit tags already set." (while (pcomplete-here - (mapcar (lambda (x) - (concat x ":")) + (mapcar (lambda (x) (concat x ":")) (let ((lst (pcomplete-uniqify-list - (or (remove + (or (remq nil - (mapcar (lambda (x) - (and (stringp (car x)) (car x))) - org-tag-alist)) - (mapcar 'car (org-get-buffer-tags)))))) + (mapcar (lambda (x) (org-string-nw-p (car x))) + org-current-tag-alist)) + (mapcar #'car (org-get-buffer-tags)))))) (dolist (tag (org-get-tags)) (setq lst (delete tag lst))) lst)) @@ -359,7 +345,7 @@ This needs more work, to handle headings with lots of spaces in them." (concat x ": ")) (let ((lst (pcomplete-uniqify-list (copy-sequence - (org-buffer-property-keys nil t t))))) + (org-buffer-property-keys nil t t t))))) (dolist (prop (org-entry-properties)) (setq lst (delete (car prop) lst))) lst)) diff --git a/lisp/org-plot.el b/lisp/org-plot.el index 9dbf882..6b51368 100644 --- a/lisp/org-plot.el +++ b/lisp/org-plot.el @@ -1,4 +1,4 @@ -;;; org-plot.el --- Support for plotting from Org-mode +;;; org-plot.el --- Support for Plotting from Org -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. ;; @@ -25,14 +25,14 @@ ;; Borrows ideas and a couple of lines of code from org-exp.el. -;; Thanks to the org-mode mailing list for testing and implementation -;; and feature suggestions +;; Thanks to the Org mailing list for testing and implementation and +;; feature suggestions ;;; Code: + +(require 'cl-lib) (require 'org) (require 'org-table) -(eval-when-compile - (require 'cl)) (declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg)) (declare-function gnuplot-mode "ext:gnuplot" ()) @@ -49,41 +49,39 @@ (defun org-plot/add-options-to-plist (p options) "Parse an OPTIONS line and set values in the property list P. Returns the resulting property list." - (let (o) - (when options - (let ((op '(("type" . :plot-type) - ("script" . :script) - ("line" . :line) - ("set" . :set) - ("title" . :title) - ("ind" . :ind) - ("deps" . :deps) - ("with" . :with) - ("file" . :file) - ("labels" . :labels) - ("map" . :map) - ("timeind" . :timeind) - ("timefmt" . :timefmt))) - (multiples '("set" "line")) - (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)") - (start 0) - o) - (while (setq o (pop op)) - (if (member (car o) multiples) ;; keys with multiple values - (while (string-match - (concat (regexp-quote (car o)) regexp) - options start) - (setq start (match-end 0)) - (setq p (plist-put p (cdr o) - (cons (car (read-from-string - (match-string 1 options))) - (plist-get p (cdr o))))) - p) - (if (string-match (concat (regexp-quote (car o)) regexp) - options) - (setq p (plist-put p (cdr o) - (car (read-from-string - (match-string 1 options))))))))))) + (when options + (let ((op '(("type" . :plot-type) + ("script" . :script) + ("line" . :line) + ("set" . :set) + ("title" . :title) + ("ind" . :ind) + ("deps" . :deps) + ("with" . :with) + ("file" . :file) + ("labels" . :labels) + ("map" . :map) + ("timeind" . :timeind) + ("timefmt" . :timefmt))) + (multiples '("set" "line")) + (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)") + (start 0)) + (dolist (o op) + (if (member (car o) multiples) ;; keys with multiple values + (while (string-match + (concat (regexp-quote (car o)) regexp) + options start) + (setq start (match-end 0)) + (setq p (plist-put p (cdr o) + (cons (car (read-from-string + (match-string 1 options))) + (plist-get p (cdr o))))) + p) + (if (string-match (concat (regexp-quote (car o)) regexp) + options) + (setq p (plist-put p (cdr o) + (car (read-from-string + (match-string 1 options)))))))))) p) (defun org-plot/goto-nearest-table () @@ -119,10 +117,9 @@ will be added. Returns the resulting property list." Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." (with-temp-file data-file - (make-local-variable 'org-plot-timestamp-fmt) - (setq org-plot-timestamp-fmt (or - (plist-get params :timefmt) - "%Y-%m-%d-%H:%M:%S")) + (setq-local org-plot-timestamp-fmt (or + (plist-get params :timefmt) + "%Y-%m-%d-%H:%M:%S")) (insert (orgtbl-to-generic table (org-combine-plists @@ -140,7 +137,7 @@ and dependant variables." (deps (if (plist-member params :deps) (mapcar (lambda (val) (- val 1)) (plist-get params :deps)) (let (collector) - (dotimes (col (length (first table))) + (dotimes (col (length (nth 0 table))) (setf collector (cons col collector))) collector))) (counter 0) @@ -158,7 +155,7 @@ and dependant variables." table))) ;; write table to gnuplot grid datafile format (with-temp-file data-file - (let ((num-rows (length table)) (num-cols (length (first table))) + (let ((num-rows (length table)) (num-cols (length (nth 0 table))) (gnuplot-row (lambda (col row value) (setf col (+ 1 col)) (setf row (+ 1 row)) (format "%f %f %f\n%f %f %f\n" @@ -202,10 +199,10 @@ manner suitable for prepending to a user-specified script." (x-labels (plist-get params :xlabels)) (y-labels (plist-get params :ylabels)) (plot-str "'%s' using %s%d%s with %s title '%s'") - (plot-cmd (case type - ('2d "plot") - ('3d "splot") - ('grid "splot"))) + (plot-cmd (pcase type + (`2d "plot") + (`3d "splot") + (`grid "splot"))) (script "reset") ;; ats = add-to-script (ats (lambda (line) (setf script (concat script "\n" line)))) @@ -213,15 +210,15 @@ manner suitable for prepending to a user-specified script." (when file ; output file (funcall ats (format "set term %s" (file-name-extension file))) (funcall ats (format "set output '%s'" file))) - (case type ; type - (2d ()) - (3d (when map (funcall ats "set map"))) - (grid (if map (funcall ats "set pm3d map") (funcall ats "set pm3d")))) + (pcase type ; type + (`2d ()) + (`3d (when map (funcall ats "set map"))) + (`grid (funcall ats (if map "set pm3d map" "set pm3d")))) (when title (funcall ats (format "set title '%s'" title))) ; title (mapc ats lines) ; line (dolist (el sets) (funcall ats (format "set %s" el))) ; set ;; Unless specified otherwise, values are TAB separated. - (unless (org-string-match-p "^set datafile separator" script) + (unless (string-match-p "^set datafile separator" script) (funcall ats "set datafile separator \"\\t\"")) (when x-labels ; x labels (xtics) (funcall ats @@ -241,26 +238,27 @@ manner suitable for prepending to a user-specified script." (or timefmt ; timefmt passed to gnuplot "%Y-%m-%d-%H:%M:%S") "\""))) (unless preface - (case type ; plot command - (2d (dotimes (col num-cols) - (unless (and (eq type '2d) - (or (and ind (equal (1+ col) ind)) - (and deps (not (member (1+ col) deps))))) - (setf plot-lines - (cons - (format plot-str data-file - (or (and ind (> ind 0) - (not text-ind) - (format "%d:" ind)) "") - (1+ col) - (if text-ind (format ":xticlabel(%d)" ind) "") - with - (or (nth col col-labels) (format "%d" (1+ col)))) - plot-lines))))) - (3d + (pcase type ; plot command + (`2d (dotimes (col num-cols) + (unless (and (eq type '2d) + (or (and ind (equal (1+ col) ind)) + (and deps (not (member (1+ col) deps))))) + (setf plot-lines + (cons + (format plot-str data-file + (or (and ind (> ind 0) + (not text-ind) + (format "%d:" ind)) "") + (1+ col) + (if text-ind (format ":xticlabel(%d)" ind) "") + with + (or (nth col col-labels) + (format "%d" (1+ col)))) + plot-lines))))) + (`3d (setq plot-lines (list (format "'%s' matrix with %s title ''" data-file with)))) - (grid + (`grid (setq plot-lines (list (format "'%s' with %s title ''" data-file with))))) (funcall ats @@ -291,24 +289,25 @@ line directly before or after the table." ;; collect table and table information (let* ((data-file (make-temp-file "org-plot")) (table (org-table-to-lisp)) - (num-cols (length (if (eq (first table) 'hline) (second table) - (first table))))) + (num-cols (length (if (eq (nth 0 table) 'hline) (nth 1 table) + (nth 0 table))))) (run-with-idle-timer 0.1 nil #'delete-file data-file) (while (eq 'hline (car table)) (setf table (cdr table))) (when (eq (cadr table) 'hline) - (setf params (plist-put params :labels (first table))) ; headers to labels + (setf params + (plist-put params :labels (nth 0 table))) ; headers to labels (setf table (delq 'hline (cdr table)))) ; clean non-data from table ;; Collect options. (save-excursion (while (and (equal 0 (forward-line -1)) (looking-at "[[:space:]]*#\\+")) (setf params (org-plot/collect-options params)))) ;; Dump table to datafile (very different for grid). - (case (plist-get params :plot-type) - (2d (org-plot/gnuplot-to-data table data-file params)) - (3d (org-plot/gnuplot-to-data table data-file params)) - (grid (let ((y-labels (org-plot/gnuplot-to-grid-data - table data-file params))) - (when y-labels (plist-put params :ylabels y-labels))))) + (pcase (plist-get params :plot-type) + (`2d (org-plot/gnuplot-to-data table data-file params)) + (`3d (org-plot/gnuplot-to-data table data-file params)) + (`grid (let ((y-labels (org-plot/gnuplot-to-grid-data + table data-file params))) + (when y-labels (plist-put params :ylabels y-labels))))) ;; Check for timestamp ind column. (let ((ind (1- (plist-get params :ind)))) (when (and (>= ind 0) (eq '2d (plist-get params :plot-type))) diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index 2f2c54b..4ffa030 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -1,4 +1,4 @@ -;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. +;;; org-protocol.el --- Intercept Calls from Emacsclient to Trigger Custom Actions -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. ;; @@ -49,7 +49,7 @@ ;; 4.) Try this from the command line (adjust the URL as needed): ;; ;; $ emacsclient \ -;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title +;; org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title ;; ;; 5.) Optionally add custom sub-protocols and handlers: ;; @@ -60,7 +60,7 @@ ;; ;; A "sub-protocol" will be found in URLs like this: ;; -;; org-protocol://sub-protocol://data +;; org-protocol://sub-protocol?key=val&key2=val2 ;; ;; If it works, you can now setup other applications for using this feature. ;; @@ -81,12 +81,12 @@ ;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps ;; URLs to local filenames defined in `org-protocol-project-alist'. ;; -;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and +;; * `org-protocol-store-link' stores an Org link (if Org is present) and ;; pushes the browsers URL to the `kill-ring' for yanking. This handler is ;; triggered through the sub-protocol \"store-link\". ;; ;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If -;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the +;; Org is loaded, Emacs will pop-up a capture buffer and fill the ;; template with the data provided. I.e. the browser's URL is inserted as an ;; Org-link of which the page title will be the description part. If text ;; was select in the browser, that text will be the body of the entry. @@ -94,20 +94,20 @@ ;; You may use the same bookmark URL for all those standard handlers and just ;; adjust the sub-protocol used: ;; -;; location.href='org-protocol://sub-protocol://'+ -;; encodeURIComponent(location.href)+'/'+ -;; encodeURIComponent(document.title)+'/'+ +;; location.href='org-protocol://sub-protocol?url='+ +;; encodeURIComponent(location.href)+'&title='+ +;; encodeURIComponent(document.title)+'&body='+ ;; encodeURIComponent(window.getSelection()) ;; ;; The handler for the sub-protocol \"capture\" detects an optional template ;; char that, if present, triggers the use of a special template. ;; Example: ;; -;; location.href='org-protocol://sub-protocol://x/'+ ... +;; location.href='org-protocol://capture?template=x'+ ... ;; -;; use template ?x. +;; uses template ?x. ;; -;; Note, that using double slashes is optional from org-protocol.el's point of +;; Note that using double slashes is optional from org-protocol.el's point of ;; view because emacsclient squashes the slashes to one. ;; ;; @@ -116,25 +116,12 @@ ;;; Code: (require 'org) -(eval-when-compile - (require 'cl)) -(declare-function org-publish-get-project-from-filename "org-publish" +(declare-function org-publish-get-project-from-filename "ox-publish" (filename &optional up)) (declare-function server-edit "server" (&optional arg)) -(define-obsolete-function-alias - 'org-protocol-unhex-compound 'org-link-unescape-compound - "2011-02-17") - -(define-obsolete-function-alias - 'org-protocol-unhex-string 'org-link-unescape - "2011-02-17") - -(define-obsolete-function-alias - 'org-protocol-unhex-single-byte-sequence - 'org-link-unescape-single-byte-sequence - "2011-02-17") +(defvar org-capture-link-is-already-stored) (defgroup org-protocol nil "Intercept calls from emacsclient to trigger custom actions. @@ -225,27 +212,36 @@ Each element of this list must be of the form: (module-name :protocol protocol :function func :kill-client nil) -protocol - protocol to detect in a filename without trailing colon and slashes. - See rfc1738 section 2.1 for more on this. - If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol' - will search filenames for \"org-protocol:/my-protocol:/\" - and trigger your action for every match. `org-protocol' is defined in - `org-protocol-the-protocol'. Double and triple slashes are compressed - to one by emacsclient. - -function - function that handles requests with protocol and takes exactly one - argument: the filename with all protocols stripped. If the function - returns nil, emacsclient and -server do nothing. Any non-nil return - value is considered a valid filename and thus passed to the server. - - `org-protocol.el provides some support for handling those filenames, - if you stay with the conventions used for the standard handlers in - `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. +protocol - protocol to detect in a filename without trailing + colon and slashes. See rfc1738 section 2.1 for more + on this. If you define a protocol \"my-protocol\", + `org-protocol-check-filename-for-protocol' will search + filenames for \"org-protocol:/my-protocol\" and + trigger your action for every match. `org-protocol' + is defined in `org-protocol-the-protocol'. Double and + triple slashes are compressed to one by emacsclient. + +function - function that handles requests with protocol and takes + one argument. If a new-style link (key=val&key2=val2) + is given, the argument will be a property list with + the values from the link. If an old-style link is + given (val1/val2), the argument will be the filename + with all protocols stripped. + + If the function returns nil, emacsclient and -server + do nothing. Any non-nil return value is considered a + valid filename and thus passed to the server. + + `org-protocol.el' provides some support for handling + old-style filenames, if you follow the conventions + used for the standard handlers in + `org-protocol-protocol-alist-default'. See + `org-protocol-parse-parameters'. kill-client - If t, kill the client immediately, once the sub-protocol is detected. This is necessary for actions that can be interrupted by - `C-g' to avoid dangling emacsclients. Note, that all other command - line arguments but the this one will be discarded, greedy handlers + `C-g' to avoid dangling emacsclients. Note that all other command + line arguments but the this one will be discarded. Greedy handlers still receive the whole list of arguments though. Here is an example: @@ -269,7 +265,7 @@ string with two characters." (defcustom org-protocol-data-separator "/+\\|\\?" "The default data separator to use. - This should be a single regexp string." +This should be a single regexp string." :group 'org-protocol :version "24.4" :package-version '(Org . "8.0") @@ -278,21 +274,20 @@ string with two characters." ;;; Helper functions: (defun org-protocol-sanitize-uri (uri) - "emacsclient compresses double and triple slashes. -Slashes are sanitized to double slashes here." + "Sanitize slashes to double-slashes in URI. +Emacsclient compresses double and triple slashes." (when (string-match "^\\([a-z]+\\):/" uri) (let* ((splitparts (split-string uri "/+"))) (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/"))))) uri) (defun org-protocol-split-data (data &optional unhexify separator) - "Split what an org-protocol handler function gets as only argument. -DATA is that one argument. DATA is split at each occurrence of -SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is -nil, assume \"/+\". The results of that splitting are returned -as a list. If UNHEXIFY is non-nil, hex-decode each split part. -If UNHEXIFY is a function, use that function to decode each split -part." + "Split the DATA argument for an org-protocol handler function. +If UNHEXIFY is non-nil, hex-decode each split part. If UNHEXIFY +is a function, use that function to decode each split part. The +string is split at each occurrence of SEPARATOR (regexp). If no +SEPARATOR is specified or SEPARATOR is nil, assume \"/+\". The +results of that splitting are returned as a list." (let* ((sep (or separator "/+\\|\\?")) (split-parts (split-string data sep))) (if unhexify @@ -302,23 +297,25 @@ part." split-parts))) (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) - "Greedy handlers might receive a list like this from emacsclient: - ((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) -where \"/dir/\" is the absolute path to emacsclients working directory. This + "Transform PARAM-LIST into a flat list for greedy handlers. + +Greedy handlers might receive a list like this from emacsclient: +\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) +where \"/dir/\" is the absolute path to emacsclient's working directory. This function transforms it into a flat list using `org-protocol-flatten' and transforms the elements of that list as follows: -If strip-path is non-nil, remove the \"/dir/\" prefix from all members of +If STRIP-PATH is non-nil, remove the \"/dir/\" prefix from all members of param-list. -If replacement is string, replace the \"/dir/\" prefix with it. +If REPLACEMENT is string, replace the \"/dir/\" prefix with it. The first parameter, the one that contains the protocols, is always changed. Everything up to the end of the protocols is stripped. Note, that this function will always behave as if `org-protocol-reverse-list-of-files' was set to t and the returned list will -reflect that. I.e. emacsclients first parameter will be the first one in the +reflect that. emacsclient's first parameter will be the first one in the returned list." (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files param-list @@ -345,50 +342,106 @@ returned list." ret) l))) -(defun org-protocol-flatten (l) - "Greedy handlers might receive a list like this from emacsclient: - ((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) +(defun org-protocol-flatten (list) + "Transform LIST into a flat list. + +Greedy handlers might receive a list like this from emacsclient: +\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) where \"/dir/\" is the absolute path to emacsclients working directory. This function transforms it into a flat list." - (if (null l) () - (if (listp l) - (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) - (list l)))) - + (if (null list) () + (if (listp list) + (append (org-protocol-flatten (car list)) (org-protocol-flatten (cdr list))) + (list list)))) + +(defun org-protocol-parse-parameters (info &optional new-style default-order) + "Return a property list of parameters from INFO. +If NEW-STYLE is non-nil, treat INFO as a query string (ex: +url=URL&title=TITLE). If old-style links are used (ex: +org-protocol://store-link/url/title), assign them to attributes +following DEFAULT-ORDER. + +If no DEFAULT-ORDER is specified, return the list of values. + +If INFO is already a property list, return it unchanged." + (if (listp info) + info + (if new-style + (let ((data (org-protocol-convert-query-to-plist info)) + result) + (while data + (setq result + (append + result + (list + (pop data) + (org-link-unescape (pop data)))))) + result) + (let ((data (org-protocol-split-data info t org-protocol-data-separator))) + (if default-order + (org-protocol-assign-parameters data default-order) + data))))) + +(defun org-protocol-assign-parameters (data default-order) + "Return a property list of parameters from DATA. +Key names are taken from DEFAULT-ORDER, which should be a list of +symbols. If DEFAULT-ORDER is shorter than the number of values +specified, the rest of the values are treated as :key value pairs." + (let (result) + (while default-order + (setq result + (append result + (list (pop default-order) + (pop data))))) + (while data + (setq result + (append result + (list (intern (concat ":" (pop data))) + (pop data))))) + result)) ;;; Standard protocol handlers: (defun org-protocol-store-link (fname) - "Process an org-protocol://store-link:// style url. + "Process an org-protocol://store-link style url. Additionally store a browser URL as an org link. Also pushes the link's URL to the `kill-ring'. +Parameters: url, title (optional), body (optional) + +Old-style links such as org-protocol://store-link://URL/TITLE are +also recognized. + The location for a browser's bookmark has to look like this: - javascript:location.href=\\='org-protocol://store-link://\\='+ \\ - encodeURIComponent(location.href) - encodeURIComponent(document.title)+\\='/\\='+ \\ + javascript:location.href = \\ + \\='org-protocol://store-link?url=\\=' + \\ + encodeURIComponent(location.href) + \\='&title=\\=' + \\ + encodeURIComponent(document.title); -Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page -could contain slashes and the location definitely will. +Don't use `escape()'! Use `encodeURIComponent()' instead. The +title of the page could contain slashes and the location +definitely will. The sub-protocol used to reach this function is set in -`org-protocol-protocol-alist'." - (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator)) - (uri (org-protocol-sanitize-uri (car splitparts))) - (title (cadr splitparts)) - orglink) - (if (boundp 'org-stored-links) - (setq org-stored-links (cons (list uri title) org-stored-links))) +`org-protocol-protocol-alist'. + +FNAME should be a property list. If not, an old-style link of the +form URL/TITLE can also be used." + (let* ((splitparts (org-protocol-parse-parameters fname nil '(:url :title))) + (uri (org-protocol-sanitize-uri (plist-get splitparts :url))) + (title (plist-get splitparts :title))) + (when (boundp 'org-stored-links) + (push (list uri title) org-stored-links)) (kill-new uri) (message "`%s' to insert new org-link, `%s' to insert `%s'" - (substitute-command-keys"\\[org-insert-link]") - (substitute-command-keys"\\[yank]") + (substitute-command-keys "`\\[org-insert-link]'") + (substitute-command-keys "`\\[yank]'") uri)) nil) (defun org-protocol-capture (info) - "Process an org-protocol://capture:// style url. + "Process an org-protocol://capture style url with INFO. The sub-protocol used to reach this function is set in `org-protocol-protocol-alist'. @@ -396,16 +449,16 @@ The sub-protocol used to reach this function is set in This function detects an URL, title and optional text, separated by `/'. The location for a browser's bookmark looks like this: - javascript:location.href=\\='org-protocol://capture://\\='+ \\ - encodeURIComponent(location.href)+\\='/\\=' \\ - encodeURIComponent(document.title)+\\='/\\='+ \\ + javascript:location.href = \\='org-protocol://capture?url=\\='+ \\ + encodeURIComponent(location.href) + \\='&title=\\=' \\ + encodeURIComponent(document.title) + \\='&body=\\=' + \\ encodeURIComponent(window.getSelection()) By default, it uses the character `org-protocol-default-template-key', which should be associated with a template in `org-capture-templates'. -But you may prepend the encoded URL with a character and a slash like so: +You may specify the template with a template= query parameter, like this: - javascript:location.href=\\='org-protocol://capture://b/\\='+ ... + javascript:location.href = \\='org-protocol://capture?template=b\\='+ ... Now template ?b will be used." (if (and (boundp 'org-stored-links) @@ -414,7 +467,7 @@ Now template ?b will be used." nil) (defun org-protocol-convert-query-to-plist (query) - "Convert query string that is part of url to property list." + "Convert QUERY key=value pairs in the URL to a property list." (if query (apply 'append (mapcar (lambda (x) (let ((c (split-string x "="))) @@ -422,18 +475,26 @@ Now template ?b will be used." (split-string query "&"))))) (defun org-protocol-do-capture (info) - "Support `org-capture'." - (let* ((parts (org-protocol-split-data info t org-protocol-data-separator)) - (template (or (and (>= 2 (length (car parts))) (pop parts)) + "Perform the actual capture based on INFO." + (let* ((temp-parts (org-protocol-parse-parameters info)) + (parts + (cond + ((and (listp info) (symbolp (car info))) info) + ((= (length (car temp-parts)) 1) ;; First parameter is exactly one character long + (org-protocol-assign-parameters temp-parts '(:template :url :title :body))) + (t + (org-protocol-assign-parameters temp-parts '(:url :title :body))))) + (template (or (plist-get parts :template) org-protocol-default-template-key)) - (url (org-protocol-sanitize-uri (car parts))) - (type (if (string-match "^\\([a-z]+\\):" url) - (match-string 1 url))) - (title (or (cadr parts) "")) - (region (or (caddr parts) "")) - (orglink (org-make-link-string - url (if (string-match "[^[:space:]]" title) title url))) - (query (or (org-protocol-convert-query-to-plist (cadddr parts)) "")) + (url (and (plist-get parts :url) (org-protocol-sanitize-uri (plist-get parts :url)))) + (type (and url (if (string-match "^\\([a-z]+\\):" url) + (match-string 1 url)))) + (title (or (plist-get parts :title) "")) + (region (or (plist-get parts :body) "")) + (orglink (if url + (org-make-link-string + url (if (string-match "[^[:space:]]" title) title url)) + title)) (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link (setq org-stored-links (cons (list url title) org-stored-links)) @@ -443,24 +504,24 @@ Now template ?b will be used." :description title :annotation orglink :initial region - :query query) + :query parts) (raise-frame) (funcall 'org-capture nil template))) (defun org-protocol-open-source (fname) - "Process an org-protocol://open-source:// style url. + "Process an org-protocol://open-source?url= style URL with FNAME. Change a filename by mapping URLs to local filenames as set in `org-protocol-project-alist'. The location for a browser's bookmark should look like this: - javascript:location.href=\\='org-protocol://open-source://\\='+ \\ + javascript:location.href = \\='org-protocol://open-source?url=\\=' + \\ encodeURIComponent(location.href)" ;; As we enter this function for a match on our protocol, the return value ;; defaults to nil. (let ((result nil) - (f (org-link-unescape fname))) + (f (plist-get (org-protocol-parse-parameters fname nil '(:url)) :url))) (catch 'result (dolist (prolist org-protocol-project-alist) (let* ((base-url (plist-get (cdr prolist) :base-url)) @@ -490,13 +551,12 @@ The location for a browser's bookmark should look like this: (let ((rewrites (plist-get (cdr prolist) :rewrites))) (when rewrites (message "Rewrites found: %S" rewrites) - (mapc - (lambda (rewrite) - "Try to match a rewritten URL and map it to a real file." - ;; Compare redirects without suffix: - (if (string-match (car rewrite) f2) - (throw 'result (concat wdir (cdr rewrite))))) - rewrites)))) + (dolist (rewrite rewrites) + ;; Try to match a rewritten URL and map it to + ;; a real file. Compare redirects without + ;; suffix. + (when (string-match-p (car rewrite) f2) + (throw 'result (concat wdir (cdr rewrite)))))))) ;; -- end of redirects -- (if (file-readable-p the-file) @@ -509,22 +569,30 @@ The location for a browser's bookmark should look like this: ;;; Core functions: -(defun org-protocol-check-filename-for-protocol (fname restoffiles client) - "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname. +(defun org-protocol-check-filename-for-protocol (fname restoffiles _client) + "Check if `org-protocol-the-protocol' and a valid protocol are used in FNAME. Sub-protocols are registered in `org-protocol-protocol-alist' and -`org-protocol-protocol-alist-default'. -This is, how the matching is done: +`org-protocol-protocol-alist-default'. This is how the matching is done: - (string-match \"protocol:/+sub-protocol:/+\" ...) + (string-match \"protocol:/+sub-protocol\\\\(://\\\\|\\\\?\\\\)\" ...) protocol and sub-protocol are regexp-quoted. -If a matching protocol is found, the protocol is stripped from fname and the -result is passed to the protocols function as the only parameter. If the -function returns nil, the filename is removed from the list of filenames -passed from emacsclient to the server. -If the function returns a non nil value, that value is passed to the server -as filename." +Old-style links such as \"protocol://sub-protocol://param1/param2\" are +also recognized. + +If a matching protocol is found, the protocol is stripped from +fname and the result is passed to the protocol function as the +first parameter. The second parameter will be non-nil if FNAME +uses key=val&key2=val2-type arguments, or nil if FNAME uses +val/val2-type arguments. If the function returns nil, the +filename is removed from the list of filenames passed from +emacsclient to the server. If the function returns a non-nil +value, that value is passed to the server as filename. + +If the handler function is greedy, RESTOFFILES will also be passed to it. + +CLIENT is ignored." (let ((sub-protocols (append org-protocol-protocol-alist org-protocol-protocol-alist-default))) (catch 'fname @@ -532,21 +600,27 @@ as filename." (when (string-match the-protocol fname) (dolist (prolist sub-protocols) (let ((proto (concat the-protocol - (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) + (regexp-quote (plist-get (cdr prolist) :protocol)) "\\(:/+\\|\\?\\)"))) (when (string-match proto fname) (let* ((func (plist-get (cdr prolist) :function)) (greedy (plist-get (cdr prolist) :greedy)) (split (split-string fname proto)) - (result (if greedy restoffiles (cadr split)))) + (result (if greedy restoffiles (cadr split))) + (new-style (string= (match-string 1 fname) "?"))) (when (plist-get (cdr prolist) :kill-client) (message "Greedy org-protocol handler. Killing client.") (server-edit)) (when (fboundp func) (unless greedy - (throw 'fname (funcall func result))) - (funcall func result) + (throw 'fname + (condition-case nil + (funcall func (org-protocol-parse-parameters result new-style)) + (error + (warn "Please update your org protocol handler to deal with new-style links.") + (funcall func result))))) + ;; Greedy protocol handlers are responsible for parsing their own filenames + (funcall func result) (throw 'fname t)))))))) - ;; (message "fname: %s" fname) fname))) (defadvice server-visit-files (before org-protocol-detect-protocol-server activate) @@ -572,7 +646,7 @@ as filename." ;;; Org specific functions: (defun org-protocol-create-for-org () - "Create a org-protocol project for the current file's Org-mode project. + "Create a Org protocol project for the current file's project. The visited file needs to be part of a publishing project in `org-publish-project-alist' for this to work. The function delegates most of the work to `org-protocol-create'." @@ -580,8 +654,8 @@ delegates most of the work to `org-protocol-create'." (require 'org-publish) (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) (if all (org-protocol-create (cdr all)) - (message "Not in an org-project. Did mean %s?" - (substitute-command-keys"\\[org-protocol-create]"))))) + (message "Not in an org-project. Did you mean `%s'?" + (substitute-command-keys "`\\[org-protocol-create]'"))))) (defun org-protocol-create (&optional project-plist) "Create a new org-protocol project interactively. @@ -600,19 +674,18 @@ the cdr of an element in `org-publish-project-alist', reuse (working-suffix (if (plist-get project-plist :base-extension) (concat "." (plist-get project-plist :base-extension)) ".org")) - (worglet-buffer nil) (insert-default-directory t) (minibuffer-allow-text-properties nil)) (setq base-url (read-string "Base URL of published content: " base-url nil base-url t)) - (if (not (string-match "\\/$" base-url)) - (setq base-url (concat base-url "/"))) + (or (string-suffix-p "/" base-url) + (setq base-url (concat base-url "/"))) (setq working-dir (expand-file-name (read-directory-name "Local working directory: " working-dir working-dir t))) - (if (not (string-match "\\/$" working-dir)) - (setq working-dir (concat working-dir "/"))) + (or (string-suffix-p "/" working-dir) + (setq working-dir (concat working-dir "/"))) (setq strip-suffix (read-string diff --git a/lisp/org-rmail.el b/lisp/org-rmail.el index d737aff..f24e25b 100644 --- a/lisp/org-rmail.el +++ b/lisp/org-rmail.el @@ -1,4 +1,4 @@ -;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode +;;; org-rmail.el --- Support for Links to Rmail Messages -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -24,9 +24,9 @@ ;; ;;; Commentary: -;; This file implements links to Rmail messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. +;; This file implements links to Rmail messages from within Org mode. +;; Org mode loads this module by default - if this is not what you +;; want, configure the variable `org-modules'. ;;; Code: @@ -43,8 +43,7 @@ (defvar rmail-file-name) ; From rmail.el ;; Install the link type -(org-add-link-type "rmail" 'org-rmail-open) -(add-hook 'org-store-link-functions 'org-rmail-store-link) +(org-link-set-parameters "rmail" :follow #'org-rmail-open :store #'org-rmail-store-link) ;; Implementation (defun org-rmail-store-link () @@ -65,20 +64,11 @@ (to (mail-fetch-field "to")) (subject (mail-fetch-field "subject")) (date (mail-fetch-field "date")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) desc link) (org-store-link-props - :type "rmail" :from from :to to + :type "rmail" :from from :to to :date date :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq message-id (org-remove-angle-brackets message-id)) + (setq message-id (org-unbracket-string "<" ">" message-id)) (setq desc (org-email-link-description)) (setq link (concat "rmail:" folder "#" message-id)) (org-add-link-props :link link :description desc) diff --git a/lisp/org-src.el b/lisp/org-src.el index b7bbf31..bcc93ac 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -1,4 +1,4 @@ -;;; org-src.el --- Source code examples in Org +;;; org-src.el --- Source code examples in Org -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. ;; @@ -26,19 +26,21 @@ ;; ;;; Commentary: -;; This file contains the code dealing with source code examples in Org-mode. +;; This file contains the code dealing with source code examples in +;; Org mode. ;;; Code: +(require 'cl-lib) (require 'org-macs) (require 'org-compat) (require 'ob-keys) (require 'ob-comint) -(eval-when-compile (require 'cl)) (declare-function org-base-buffer "org" (buffer)) (declare-function org-do-remove-indentation "org" (&optional n)) (declare-function org-element-at-point "org-element" ()) +(declare-function org-element-class "org-element" (datum &optional parent)) (declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-lineage "org-element" (blob &optional types with-self)) @@ -47,13 +49,9 @@ (declare-function org-footnote-goto-definition "org-footnote" (label &optional location)) (declare-function org-get-indentation "org" (&optional line)) -(declare-function org-pop-to-buffer-same-window "org-compat" - (&optional buffer-or-name norecord label)) -(declare-function org-some "org" (pred seq)) (declare-function org-switch-to-buffer-other-window "org" (&rest args)) -(declare-function org-trim "org" (s)) +(declare-function org-trim "org" (s &optional keep-lead)) -(defvar org-element-all-elements) (defvar org-inhibit-startup) (defcustom org-edit-src-turn-on-auto-save nil @@ -109,11 +107,12 @@ These are the regions where each line starts with a colon." (defcustom org-src-preserve-indentation nil "If non-nil preserve leading whitespace characters on export. +\\<org-mode-map> If non-nil leading whitespace characters in source code blocks are preserved on export, and when switching between the org buffer and the language mode edit buffer. -When this variable is nil, after editing with \\[org-edit-src-code], +When this variable is nil, after editing with `\\[org-edit-src-code]', the minimum (across-lines) number of leading whitespace characters are removed from all lines, and the code block is uniformly indented according to the value of `org-edit-src-content-indentation'." @@ -122,10 +121,12 @@ according to the value of `org-edit-src-content-indentation'." (defcustom org-edit-src-content-indentation 2 "Indentation for the content of a source code block. + This should be the number of spaces added to the indentation of the #+begin line in order to compute the indentation of the block content after -editing it with \\[org-edit-src-code]. Has no effect if -`org-src-preserve-indentation' is non-nil." +editing it with `\\[org-edit-src-code]'. + +It has no effect if `org-src-preserve-indentation' is non-nil." :group 'org-edit-structure :type 'integer) @@ -170,7 +171,7 @@ other-frame Use `switch-to-buffer-other-frame' to display edit buffer. "Hook run after Org switched a source code snippet to its Emacs mode. \\<org-mode-map> This hook will run: -- when editing a source code snippet with \\[org-edit-special] +- when editing a source code snippet with `\\[org-edit-special]' - when formatting a source code snippet for export with htmlize. You may want to use this hook for example to turn off `outline-minor-mode' @@ -195,6 +196,28 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (string "Language name") (symbol "Major mode")))) +(defcustom org-src-block-faces nil + "Alist of faces to be used for source-block. +Each element is a cell of the format + + (\"language\" FACE) + +Where FACE is either a defined face or an anonymous face. + +For instance, the following value would color the background of +emacs-lisp source blocks and python source blocks in purple and +green, respectability. + + \\='((\"emacs-lisp\" (:background \"#EEE2FF\")) + (\"python\" (:background \"#e5ffb8\")))" + :group 'org-edit-structure + :type '(repeat (list (string :tag "language") + (choice + (face :tag "Face") + (sexp :tag "Anonymous face")))) + :version "25.2" + :package-version '(Org . "9.0")) + (defcustom org-src-tab-acts-natively nil "If non-nil, the effect of TAB in a code block is as if it were issued in the language major mode buffer." @@ -292,6 +315,12 @@ where BEG and END are buffer positions and CONTENTS is a string." (search-forward "]"))) (end (or (org-element-property :contents-end datum) beg))) (list beg end (buffer-substring-no-properties beg end)))) + ((eq type 'inline-src-block) + (let ((beg (progn (goto-char (org-element-property :begin datum)) + (search-forward "{" (line-end-position) t))) + (end (progn (goto-char (org-element-property :end datum)) + (search-backward "}" (line-beginning-position) t)))) + (list beg end (buffer-substring-no-properties beg end)))) ((org-element-property :contents-begin datum) (let ((beg (org-element-property :contents-begin datum)) (end (org-element-property :contents-end datum))) @@ -351,7 +380,7 @@ spaces after it as being outside." (org-with-wide-buffer (goto-char (org-element-property :end datum)) (skip-chars-backward " \r\t\n") - (if (memq (org-element-type datum) org-element-all-elements) + (if (eq (org-element-class datum) 'element) (line-end-position) (point)))))) @@ -370,7 +399,7 @@ Assume point is in the corresponding edit buffer." (let ((ind (make-string indentation ?\s))) (goto-char (point-min)) (while (not (eobp)) - (when (org-looking-at-p "[ \t]*\\S-") (insert ind)) + (when (looking-at-p "[ \t]*\\S-") (insert ind)) (forward-line)))) (buffer-string)))) @@ -448,14 +477,14 @@ Leave point in edit buffer." ;; Transmit buffer-local variables for exit function. It must ;; be done after initializing major mode, as this operation ;; may reset them otherwise. - (org-set-local 'org-src--from-org-mode org-mode-p) - (org-set-local 'org-src--beg-marker beg) - (org-set-local 'org-src--end-marker end) - (org-set-local 'org-src--remote remote) - (org-set-local 'org-src--block-indentation ind) - (org-set-local 'org-src--preserve-indentation preserve-ind) - (org-set-local 'org-src--overlay overlay) - (org-set-local 'org-src--allow-write-back write-back) + (setq-local org-src--from-org-mode org-mode-p) + (setq-local org-src--beg-marker beg) + (setq-local org-src--end-marker end) + (setq-local org-src--remote remote) + (setq-local org-src--block-indentation ind) + (setq-local org-src--preserve-indentation preserve-ind) + (setq-local org-src--overlay overlay) + (setq-local org-src--allow-write-back write-back) ;; Start minor mode. (org-src-mode) ;; Move mark and point in edit buffer to the corresponding @@ -488,27 +517,36 @@ as `org-src-fontify-natively' is non-nil." (when (fboundp lang-mode) (let ((string (buffer-substring-no-properties start end)) (modified (buffer-modified-p)) - (org-buffer (current-buffer)) pos next) + (org-buffer (current-buffer))) (remove-text-properties start end '(face nil)) (with-current-buffer (get-buffer-create - (concat " org-src-fontification:" (symbol-name lang-mode))) - (delete-region (point-min) (point-max)) - (insert string " ") ;; so there's a final property change + (format " *org-src-fontification:%s*" lang-mode)) + (erase-buffer) + ;; Add string and a final space to ensure property change. + (insert string " ") (unless (eq major-mode lang-mode) (funcall lang-mode)) (org-font-lock-ensure) - (setq pos (point-min)) - (while (setq next (next-single-property-change pos 'face)) - (put-text-property - (+ start (1- pos)) (1- (+ start next)) 'face - (get-text-property pos 'face) org-buffer) - (setq pos next))) + (let ((pos (point-min)) next) + (while (setq next (next-property-change pos)) + ;; Handle additional properties from font-lock, so as to + ;; preserve, e.g., composition. + (dolist (prop (cons 'face font-lock-extra-managed-props)) + (let ((new-prop (get-text-property pos prop))) + (put-text-property + (+ start (1- pos)) (1- (+ start next)) prop new-prop + org-buffer))) + (setq pos next)))) + ;; Add Org faces. + (let ((src-face (nth 1 (assoc-string lang org-src-block-faces t)))) + (when (or (facep src-face) (listp src-face)) + (font-lock-append-text-property start end 'face src-face)) + (font-lock-append-text-property start end 'face 'org-block)) (add-text-properties start end '(font-lock-fontified t fontified t font-lock-multiline t)) (set-buffer-modified-p modified))))) - ;;; Escape contents @@ -560,7 +598,7 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." "Minor mode for language major mode buffers generated by Org. \\<org-mode-map> This minor mode is turned on in two situations: - - when editing a source code snippet with \\[org-edit-special] + - when editing a source code snippet with `\\[org-edit-special]' - when formatting a source code snippet for export with htmlize. \\{org-src-mode-map} @@ -568,14 +606,14 @@ This minor mode is turned on in two situations: See also `org-src-mode-hook'." nil " OrgSrc" nil (when org-edit-src-persistent-message - (org-set-local - 'header-line-format + (setq-local + header-line-format (substitute-command-keys (if org-src--allow-write-back - "Edit, then exit with \\[org-edit-src-exit] or abort with \ -\\[org-edit-src-abort]" - "Exit with \\[org-edit-src-exit] or abort with \ -\\[org-edit-src-abort]")))) + "Edit, then exit with `\\[org-edit-src-exit]' or abort with \ +`\\[org-edit-src-abort]'" + "Exit with `\\[org-edit-src-exit]' or abort with \ +`\\[org-edit-src-abort]'")))) ;; Possibly activate various auto-save features (for the edit buffer ;; or the source buffer). (when org-edit-src-turn-on-auto-save @@ -600,22 +638,17 @@ See also `org-src-mode-hook'." (setq org-src--auto-save-timer nil))))))))) (defun org-src-mode-configure-edit-buffer () - (when (org-bound-and-true-p org-src--from-org-mode) - (org-add-hook 'kill-buffer-hook #'org-src--remove-overlay nil 'local) - (if (org-bound-and-true-p org-src--allow-write-back) + (when (bound-and-true-p org-src--from-org-mode) + (add-hook 'kill-buffer-hook #'org-src--remove-overlay nil 'local) + (if (bound-and-true-p org-src--allow-write-back) (progn (setq buffer-offer-save t) (setq buffer-file-name (concat (buffer-file-name (marker-buffer org-src--beg-marker)) - "[" (buffer-name) "]")) - (if (featurep 'xemacs) - (progn - (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4 - (setq write-contents-hooks '(org-edit-src-save))) - (setq write-contents-functions '(org-edit-src-save)))) + "[" (buffer-name) "]"))) (setq buffer-read-only t)))) -(org-add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer) +(add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer) @@ -624,7 +657,7 @@ See also `org-src-mode-hook'." (defun org-src-associate-babel-session (info) "Associate edit buffer with comint session." (interactive) - (let ((session (cdr (assoc :session (nth 2 info))))) + (let ((session (cdr (assq :session (nth 2 info))))) (and session (not (string= session "none")) (org-babel-comint-buffer-livep session) (let ((f (intern (format "org-babel-%s-associate-session" @@ -635,16 +668,19 @@ See also `org-src-mode-hook'." (when org-src--babel-info (org-src-associate-babel-session org-src--babel-info))) -(org-add-hook 'org-src-mode-hook #'org-src-babel-configure-edit-buffer) +(add-hook 'org-src-mode-hook #'org-src-babel-configure-edit-buffer) + + +;;; Public API (defmacro org-src-do-at-code-block (&rest body) - "Execute a command from an edit buffer in the Org mode buffer." + "Execute BODY from an edit buffer in the Org mode buffer." + (declare (debug (body))) `(let ((beg-marker org-src--beg-marker)) (when beg-marker (with-current-buffer (marker-buffer beg-marker) (goto-char beg-marker) ,@body)))) -(def-edebug-spec org-src-do-at-code-block (body)) (defun org-src-do-key-sequence-at-code-block (&optional key) "Execute key sequence at code block in the source Org buffer. @@ -670,10 +706,6 @@ Org-babel commands." (org-src-do-at-code-block (call-interactively (lookup-key org-babel-map key))))) - - -;;; Public functions - (defun org-src-edit-buffer-p (&optional buffer) "Non-nil when current buffer is a source editing buffer. If BUFFER is non-nil, test it instead." @@ -683,29 +715,62 @@ If BUFFER is non-nil, test it instead." (local-variable-p 'org-src--end-marker buffer)))) (defun org-src-switch-to-buffer (buffer context) - (case org-src-window-setup - (current-window (org-pop-to-buffer-same-window buffer)) - (other-window + (pcase org-src-window-setup + (`current-window (pop-to-buffer-same-window buffer)) + (`other-window (switch-to-buffer-other-window buffer)) - (other-frame - (case context - (exit + (`other-frame + (pcase context + (`exit (let ((frame (selected-frame))) (switch-to-buffer-other-frame buffer) (delete-frame frame))) - (save + (`save (kill-buffer (current-buffer)) - (org-pop-to-buffer-same-window buffer)) - (t (switch-to-buffer-other-frame buffer)))) - (reorganize-frame + (pop-to-buffer-same-window buffer)) + (_ (switch-to-buffer-other-frame buffer)))) + (`reorganize-frame (when (eq context 'edit) (delete-other-windows)) (org-switch-to-buffer-other-window buffer) (when (eq context 'exit) (delete-other-windows))) - (switch-invisibly (set-buffer buffer)) - (t + (`switch-invisibly (set-buffer buffer)) + (_ (message "Invalid value %s for `org-src-window-setup'" org-src-window-setup) - (org-pop-to-buffer-same-window buffer)))) + (pop-to-buffer-same-window buffer)))) + +(defun org-src-coderef-format (&optional element) + "Return format string for block at point. + +When optional argument ELEMENT is provided, use that block. +Otherwise, assume point is either at a source block, at an +example block. + +If point is in an edit buffer, retrieve format string associated +to the remote source block." + (cond + ((and element (org-element-property :label-fmt element))) + ((org-src-edit-buffer-p) (org-src-do-at-code-block (org-src-coderef-format))) + ((org-element-property :label-fmt (org-element-at-point))) + (t org-coderef-label-format))) + +(defun org-src-coderef-regexp (fmt &optional label) + "Return regexp matching a coderef format string FMT. + +When optional argument LABEL is non-nil, match coderef for that +label only. + +Match group 1 contains the full coderef string with surrounding +white spaces. Match group 2 contains the same string without any +surrounding space. Match group 3 contains the label. + +A coderef format regexp can only match at the end of a line." + (format "\\S-\\([ \t]*\\(%s\\)[ \t]*\\)$" + (replace-regexp-in-string + "%s" + (if label (regexp-quote label) "\\([-a-zA-Z0-9_][-a-zA-Z0-9_ ]*\\)") + (regexp-quote fmt) + nil t))) (defun org-edit-footnote-reference () "Edit definition of footnote reference at point." @@ -765,11 +830,12 @@ If BUFFER is non-nil, test it instead." (defun org-edit-table.el () "Edit \"table.el\" table at point. - +\\<org-src-mode-map> A new buffer is created and the table is copied into it. Then the table is recognized with `table-recognize'. When done -editing, exit with \\[org-edit-src-exit]. The edited text will -then replace the area in the Org mode buffer. +editing, exit with `\\[org-edit-src-exit]'. The edited text will \ +then replace +the area in the Org mode buffer. Throw an error when not at such a table." (interactive) @@ -782,18 +848,20 @@ Throw an error when not at such a table." element (org-src--construct-edit-buffer-name (buffer-name) "Table") #'text-mode t) - (when (org-bound-and-true-p flyspell-mode) (flyspell-mode -1)) + (when (bound-and-true-p flyspell-mode) (flyspell-mode -1)) (table-recognize) t)) (defun org-edit-export-block () "Edit export block at point. - +\\<org-src-mode-map> A new buffer is created and the block is copied into it, and the buffer is switched into an appropriate major mode. See also -`org-src-lang-modes'. When done, exit with -\\[org-edit-src-exit]. The edited text will then replace the -area in the Org mode buffer. +`org-src-lang-modes'. + +When done, exit with `\\[org-edit-src-exit]'. The edited text \ +will then replace +the area in the Org mode buffer. Throw an error when not at an export block." (interactive) @@ -815,7 +883,7 @@ Throw an error when not at an export block." "Edit the source or example block at point. \\<org-src-mode-map> The code is copied to a separate buffer and the appropriate mode -is turned on. When done, exit with \\[org-edit-src-exit]. This \ +is turned on. When done, exit with `\\[org-edit-src-exit]'. This \ will remove the original code in the Org buffer, and replace it with the edited version. See `org-src-window-setup' to configure the display of @@ -850,36 +918,71 @@ name of the sub-editing buffer." `(lambda () (unless ,(or org-src-preserve-indentation (org-element-property :preserve-indent element)) - (untabify (point-min) (point-max)) (when (> org-edit-src-content-indentation 0) - (let ((ind (make-string org-edit-src-content-indentation - ?\s))) - (while (not (eobp)) - (unless (looking-at "[ \t]*$") (insert ind)) - (forward-line))))) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (indent-line-to (+ (org-get-indentation) + org-edit-src-content-indentation))) + (forward-line)))) (org-escape-code-in-region (point-min) (point-max)))) (and code (org-unescape-code-in-string code))) ;; Finalize buffer. - (org-set-local 'org-coderef-label-format - (or (org-element-property :label-fmt element) - org-coderef-label-format)) + (setq-local org-coderef-label-format + (or (org-element-property :label-fmt element) + org-coderef-label-format)) (when (eq type 'src-block) - (org-set-local 'org-src--babel-info babel-info) + (setq-local org-src--babel-info babel-info) (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) (when (fboundp edit-prep-func) (funcall edit-prep-func babel-info)))) t))) +(defun org-edit-inline-src-code () + "Edit inline source code at point." + (interactive) + (let ((context (org-element-context))) + (unless (and (eq (org-element-type context) 'inline-src-block) + (org-src--on-datum-p context)) + (user-error "Not on inline source code")) + (let* ((lang (org-element-property :language context)) + (lang-f (org-src--get-lang-mode lang)) + (babel-info (org-babel-get-src-block-info 'light)) + deactivate-mark) + (unless (functionp lang-f) (error "No such language mode: %s" lang-f)) + (org-src--edit-element + context + (org-src--construct-edit-buffer-name (buffer-name) lang) + lang-f + (lambda () + ;; Inline src blocks are limited to one line. + (while (re-search-forward "\n[ \t]*" nil t) (replace-match " ")) + ;; Trim contents. + (goto-char (point-min)) + (skip-chars-forward " \t") + (delete-region (point-min) (point)) + (goto-char (point-max)) + (skip-chars-backward " \t") + (delete-region (point) (point-max)))) + ;; Finalize buffer. + (setq-local org-src--babel-info babel-info) + (setq-local org-src--preserve-indentation t) + (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) + (when (fboundp edit-prep-func) (funcall edit-prep-func babel-info))) + ;; Return success. + t))) + (defun org-edit-fixed-width-region () "Edit the fixed-width ASCII drawing at point. - +\\<org-src-mode-map> This must be a region where each line starts with a colon followed by a space or a newline character. A new buffer is created and the fixed-width region is copied into it, and the buffer is switched into the major mode defined in -`org-edit-fixed-width-region-mode', which see. When done, exit -with \\[org-edit-src-exit]. The edited text will then replace +`org-edit-fixed-width-region-mode', which see. + +When done, exit with `\\[org-edit-src-exit]'. The edited text \ +will then replace the area in the Org mode buffer." (interactive) (let ((element (org-element-at-point))) @@ -962,7 +1065,7 @@ Throw an error if there is no such buffer." (goto-char beg) (cond ;; Block is hidden; move at start of block. - ((org-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) + ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) (overlays-at (point))) (beginning-of-line 0)) (write-back (org-src--goto-coordinates coordinates beg end)))) diff --git a/lisp/org-table.el b/lisp/org-table.el index e43f0f8..e2bbe87 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -1,4 +1,4 @@ -;;; org-table.el --- The table editor for Org mode +;;; org-table.el --- The Table Editor for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -34,8 +34,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'org) (declare-function org-element-at-point "org-element" ()) @@ -52,20 +51,26 @@ (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) -(declare-function org-export-create-backend "org-export" (&rest rest)) -(declare-function org-export-data-with-backend "org-export" (arg1 arg2 arg3)) -(declare-function org-export-first-sibling-p "org-export" (arg1 arg2)) -(declare-function org-export-get-backend "org-export" (arg1)) -(declare-function org-export-get-environment "org-export" (&optional arg1 arg2 arg3)) -(declare-function org-export-table-has-special-column-p "org-export" (arg1)) -(declare-function org-export-table-row-is-special-p "org-export" (arg1 arg2)) +(declare-function org-export-create-backend "ox" (&rest rest) t) +(declare-function org-export-data-with-backend "ox" (data backend info)) +(declare-function org-export-filter-apply-functions "ox" + (filters value info)) +(declare-function org-export-first-sibling-p "ox" (blob info)) +(declare-function org-export-get-backend "ox" (name)) +(declare-function org-export-get-environment "ox" + (&optional backend subtreep ext-plist)) +(declare-function org-export-install-filters "ox" (info)) +(declare-function org-export-table-has-special-column-p "ox" (table)) +(declare-function org-export-table-row-is-special-p "ox" (table-row info)) (declare-function calc-eval "calc" (str &optional separator &rest args)) (defvar orgtbl-mode) ; defined below (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized (defvar constants-unit-system) +(defvar org-export-filters-alist) (defvar org-table-follow-field-mode) +(defvar sort-fold-case) (defvar orgtbl-after-send-table-hook nil "Hook for functions attaching to `C-c C-c', if the table is sent. @@ -84,7 +89,7 @@ for empty fields). Outside tables, the correct binding of the keys is restored. The default for this option is t if the optimized version is also used in -Org-mode. See the variable `org-enable-table-editor' for details. Changing +Org mode. See the variable `org-enable-table-editor' for details. Changing this variable requires a restart of Emacs to become effective." :group 'org-table :type 'boolean) @@ -139,7 +144,7 @@ table, obtained by prompting the user." (string :tag "Format")))) (defgroup org-table-settings nil - "Settings for tables in Org-mode." + "Settings for tables in Org mode." :tag "Org Table Settings" :group 'org-table) @@ -188,13 +193,13 @@ alignment to the right border applies." :type 'number) (defgroup org-table-editing nil - "Behavior of tables during editing in Org-mode." + "Behavior of tables during editing in Org mode." :tag "Org Table Editing" :group 'org-table) (defcustom org-table-automatic-realign t "Non-nil means automatically re-align table when pressing TAB or RETURN. -When nil, aligning is only done with \\[org-table-align], or after column +When nil, aligning is only done with `\\[org-table-align]', or after column removal/insertion." :group 'org-table-editing :type 'boolean) @@ -240,12 +245,12 @@ this line." :type 'boolean) (defgroup org-table-calculation nil - "Options concerning tables in Org-mode." + "Options concerning tables in Org mode." :tag "Org Table Calculation" :group 'org-table) (defcustom org-table-use-standard-references 'from - "Should org-mode work with table references like B3 instead of @3$2? + "Non-nil means using table references like B3 instead of @3$2. Possible values are: nil never use them from accept as input, do not present for editing @@ -257,9 +262,10 @@ t accept as input and present for editing" (const :tag "Convert user input, don't offer during editing" from))) (defcustom org-table-copy-increment t - "Non-nil means increment when copying current field with \\[org-table-copy-down]." + "Non-nil means increment when copying current field with \ +`\\[org-table-copy-down]'." :group 'org-table-calculation - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(choice (const :tag "Use the difference between the current and the above fields" t) @@ -277,7 +283,7 @@ t accept as input and present for editing" ) "List with Calc mode settings for use in `calc-eval' for table formulas. The list must contain alternating symbols (Calc modes variables and values). -Don't remove any of the default settings, just change the values. Org-mode +Don't remove any of the default settings, just change the values. Org mode relies on the variables to be present in the list." :group 'org-table-calculation :type 'plist) @@ -311,7 +317,7 @@ which should be evaluated as described in the manual and in the documentation string of the command `org-table-eval-formula'. This feature requires the Emacs calc package. When this variable is nil, formula calculation is only available through -the command \\[org-table-eval-formula]." +the command `\\[org-table-eval-formula]'." :group 'org-table-calculation :type 'boolean) @@ -344,7 +350,7 @@ Constants can also be defined on a per-file basis using a line like (defcustom org-table-allow-automatic-line-recalculation t "Non-nil means lines marked with |#| or |*| will be recomputed automatically. \\<org-mode-map>\ -Automatically means when TAB or RET or \\[org-ctrl-c-ctrl-c] \ +Automatically means when `TAB' or `RET' or `\\[org-ctrl-c-ctrl-c]' \ are pressed in the line." :group 'org-table-calculation :type 'boolean) @@ -372,7 +378,7 @@ portability of tables." "Non-nil means that evaluation of a field formula can add new columns if an out-of-bounds field is being set." :group 'org-table-calculation - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(choice (const :tag "Setting an out-of-bounds field generates an error (default)" nil) @@ -381,7 +387,7 @@ columns if an out-of-bounds field is being set." (const :tag "When setting an out-of-bounds field, the user is prompted" prompt))) (defgroup org-table-import-export nil - "Options concerning table import and export in Org-mode." + "Options concerning table import and export in Org mode." :tag "Org Table Import Export" :group 'org-table) @@ -401,7 +407,7 @@ The function can be slow on larger regions; this safety feature prevents it from hanging emacs." :group 'org-table-import-export :type 'integer - :version "25.1" + :version "25.2" :package-version '(Org . "8.3")) (defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" @@ -494,13 +500,13 @@ Field is restored even in case of abnormal exit." ;;;###autoload (defun org-table-create-with-table.el () "Use the table.el package to insert a new table. -If there is already a table at point, convert between Org-mode tables +If there is already a table at point, convert between Org tables and table.el tables." (interactive) (require 'table) (cond ((org-at-table.el-p) - (if (y-or-n-p "Convert table to Org-mode table? ") + (if (y-or-n-p "Convert table to Org table? ") (org-table-convert))) ((org-at-table-p) (when (y-or-n-p "Convert table to table.el table? ") @@ -544,7 +550,7 @@ SIZE is a string Columns x Rows like for example \"3x2\"." (beginning-of-line 1) (newline)) ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) - (dotimes (i rows) (insert line)) + (dotimes (_ rows) (insert line)) (goto-char pos) (if (> rows 1) ;; Insert a hline after the first row. @@ -665,7 +671,7 @@ extension of the given file name, and finally on the variable (when (file-directory-p file) (user-error "This is a directory path, not a file")) (when (and (buffer-file-name (buffer-base-buffer)) - (org-file-equal-p + (file-equal-p (file-truename file) (file-truename (buffer-file-name (buffer-base-buffer))))) (user-error "Please specify a file name that is different from current")) @@ -684,7 +690,7 @@ extension of the given file name, and finally on the variable (or (car (delq nil (mapcar (lambda (f) - (and (org-string-match-p fileext f) f)) + (and (string-match-p fileext f) f)) formats))) org-table-export-default-format) t t) t t))) @@ -723,13 +729,11 @@ This is being used to correctly align a single field after TAB or RET.") (defvar org-table-last-column-widths nil "List of max width of fields in each column. This is being used to correctly align a single field after TAB or RET.") -(defvar org-table-formula-debug nil +(defvar-local org-table-formula-debug nil "Non-nil means debug table formulas. When nil, simply write \"#ERROR\" in corrupted fields.") -(make-variable-buffer-local 'org-table-formula-debug) -(defvar org-table-overlay-coordinates nil +(defvar-local org-table-overlay-coordinates nil "Overlay coordinates after each align of a table.") -(make-variable-buffer-local 'org-table-overlay-coordinates) (defvar org-last-recalc-line nil) (defvar org-table-do-narrow t) ; for dynamic scoping @@ -753,7 +757,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; Table's rows. Separators are replaced by nil. Trailing ;; spaces are also removed. (lines (mapcar (lambda (l) - (and (not (org-string-match-p "\\`[ \t]*|-" l)) + (and (not (string-match-p "\\`[ \t]*|-" l)) (let ((l (org-trim l))) (remove-text-properties 0 (length l) '(display t org-cwidth t) l) @@ -795,9 +799,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (org-add-props x nil 'help-echo (concat - (substitute-command-keys - "Clipped table field, use \\[org-table-edit-field] to \ -edit. Full value is:\n") + "Clipped table field, use `\\[org-table-edit-field]' to \ +edit. Full value is:\n" (substring-no-properties x))) (let ((l (length x)) (f1 (min fmax @@ -811,7 +814,7 @@ edit. Full value is:\n") (if (= (org-string-width x) l) (setq f2 f1) (setq f2 1) (while (< (org-string-width (substring x 0 f2)) f1) - (incf f2))) + (cl-incf f2))) (add-text-properties f2 l (list 'org-cwidth t) x) (add-text-properties (if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2) @@ -831,10 +834,10 @@ edit. Full value is:\n") (unless (equal x "") (setq frac (/ (+ (* frac cnt) - (if (org-string-match-p org-table-number-regexp x) + (if (string-match-p org-table-number-regexp x) 1 0)) - (incf cnt))))) + (cl-incf cnt))))) (push (>= frac org-table-number-fraction) typenums))))) (setq lengths (nreverse lengths)) (setq typenums (nreverse typenums)) @@ -942,41 +945,40 @@ Optional argument NEW may specify text to replace the current field content." ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway ((org-at-table-hline-p)) ((and (not new) - (or (not (equal (marker-buffer org-table-aligned-begin-marker) - (current-buffer))) + (or (not (eq (marker-buffer org-table-aligned-begin-marker) + (current-buffer))) (< (point) org-table-aligned-begin-marker) (>= (point) org-table-aligned-end-marker))) - ;; This is not the same table, force a full re-align + ;; This is not the same table, force a full re-align. (setq org-table-may-need-update t)) - (t ;; realign the current field, based on previous full realign - (let* ((pos (point)) s - (col (org-table-current-column)) - (num (if (> col 0) (nth (1- col) org-table-last-alignment))) - l f n o e) + (t + ;; Realign the current field, based on previous full realign. + (let ((pos (point)) + (col (org-table-current-column))) (when (> col 0) - (skip-chars-backward "^|\n") - (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)") - (progn - (setq s (match-string 1) - o (match-string 0) - l (max 1 - (- (org-string-width - (buffer-substring-no-properties - (match-end 0) (match-beginning 0))) 3)) - e (not (= (match-beginning 2) (match-end 2)))) - (setq f (format (if num " %%%ds %s" " %%-%ds %s") - l (if e "|" (setq org-table-may-need-update t) "")) - n (format f s)) - (if new - (if (<= (org-string-width new) l) - (setq n (format f new)) - (setq n (concat new "|") org-table-may-need-update t))) - (if (equal (string-to-char n) ?-) (setq n (concat " " n))) - (or (equal n o) - (let (org-table-may-need-update) - (replace-match n t t)))) - (setq org-table-may-need-update t)) - (goto-char pos)))))) + (skip-chars-backward "^|") + (if (not (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)")) + (setq org-table-may-need-update t) + (let* ((numbers? (nth (1- col) org-table-last-alignment)) + (cell (match-string 0)) + (field (match-string 1)) + (len (max 1 (- (org-string-width cell) 3))) + (properly-closed? (/= (match-beginning 2) (match-end 2))) + (fmt (format (if numbers? " %%%ds %s" " %%-%ds %s") + len + (if properly-closed? "|" + (setq org-table-may-need-update t) + ""))) + (new-cell + (cond ((not new) (format fmt field)) + ((<= (org-string-width new) len) (format fmt new)) + (t + (setq org-table-may-need-update t) + (format " %s |" new))))) + (unless (equal new-cell cell) + (let (org-table-may-need-update) + (replace-match new-cell t t))) + (goto-char pos)))))))) ;;;###autoload (defun org-table-next-field () @@ -1161,7 +1163,7 @@ to a number. In the case of a timestamp, increment by days." (user-error "No non-empty field found") (if (and org-table-copy-increment (not (equal orig-n 0)) - (string-match "^[-+^/*0-9eE.]+$" txt) + (string-match-p "^[-+^/*0-9eE.]+$" txt) (< (string-to-number txt) 100000000)) (setq txt (calc-eval (concat txt "+" (number-to-string inc))))) (insert txt) @@ -1232,7 +1234,7 @@ Return t when the line exists, nil if it does not exist." "Blank the current table field or active region." (interactive) (org-table-check-inside-data-field) - (if (and (org-called-interactively-p 'any) (org-region-active-p)) + (if (and (called-interactively-p 'any) (org-region-active-p)) (let (org-table-clip) (org-table-cut-region (region-beginning) (region-end))) (skip-chars-backward "^|") @@ -1264,7 +1266,7 @@ is always the old value." (forward-char 1) "")) ;;;###autoload -(defun org-table-field-info (arg) +(defun org-table-field-info (_arg) "Show info about the current field, and highlight any reference at point." (interactive "P") (unless (org-at-table-p) (user-error "Not at a table")) @@ -1304,19 +1306,22 @@ is always the old value." (concat ", formula: " (org-table-formula-to-user (concat - (if (string-match "^[$@]"(car eqn)) "" "$") + (if (or (string-prefix-p "$" (car eqn)) + (string-prefix-p "@" (car eqn))) + "" + "$") (car eqn) "=" (cdr eqn)))) ""))))) (defun org-table-current-column () "Find out which column we are in." (interactive) - (when (org-called-interactively-p 'any) (org-table-check-inside-data-field)) + (when (called-interactively-p 'any) (org-table-check-inside-data-field)) (save-excursion (let ((column 0) (pos (point))) (beginning-of-line) - (while (search-forward "|" pos t) (incf column)) - (when (org-called-interactively-p 'interactive) + (while (search-forward "|" pos t) (cl-incf column)) + (when (called-interactively-p 'interactive) (message "In table column %d" column)) column))) @@ -1325,16 +1330,16 @@ is always the old value." "Find out what table data line we are in. Only data lines count for this." (interactive) - (when (org-called-interactively-p 'any) + (when (called-interactively-p 'any) (org-table-check-inside-data-field)) (save-excursion (let ((c 0) (pos (point))) (goto-char (org-table-begin)) (while (<= (point) pos) - (when (looking-at org-table-dataline-regexp) (incf c)) + (when (looking-at org-table-dataline-regexp) (cl-incf c)) (forward-line)) - (when (org-called-interactively-p 'any) + (when (called-interactively-p 'any) (message "This is table line %d" c)) c))) @@ -1552,19 +1557,21 @@ non-nil, the one above is used." "Insert a new row above the current line into the table. With prefix ARG, insert below the current line." (interactive "P") - (if (not (org-at-table-p)) - (user-error "Not at a table")) - (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) + (unless (org-at-table-p) (user-error "Not at a table")) + (let* ((line (buffer-substring (line-beginning-position) (line-end-position))) (new (org-table-clean-line line))) ;; Fix the first field if necessary (if (string-match "^[ \t]*| *[#$] *|" line) (setq new (replace-match (match-string 0 line) t t new))) (beginning-of-line (if arg 2 1)) + ;; Buffer may not end of a newline character, so ensure + ;; (beginning-of-line 2) moves point to a new line. + (unless (bolp) (insert "\n")) (let (org-table-may-need-update) (insert-before-markers new "\n")) (beginning-of-line 0) - (re-search-forward "| ?" (point-at-eol) t) - (and (or org-table-may-need-update org-table-overlay-coordinates) - (org-table-align)) + (re-search-forward "| ?" (line-end-position) t) + (when (or org-table-may-need-update org-table-overlay-coordinates) + (org-table-align)) (when (or (not org-table-fix-formulas-confirm) (funcall org-table-fix-formulas-confirm "Fix formulas? ")) (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))) @@ -1577,7 +1584,7 @@ With prefix ABOVE, insert above the current line." (if (not (org-at-table-p)) (user-error "Not at a table")) (when (eobp) (insert "\n") (backward-char 1)) - (if (not (string-match "|[ \t]*$" (org-current-line-string))) + (if (not (string-match-p "|[ \t]*$" (org-current-line-string))) (org-table-align)) (let ((line (org-table-clean-line (buffer-substring (point-at-bol) (point-at-eol)))) @@ -1676,7 +1683,7 @@ numeric compare based on the type of the first key in the table." ;; Set appropriate case sensitivity and column used for sorting. (let ((column (let ((c (org-table-current-column))) (cond ((> c 0) c) - ((org-called-interactively-p 'any) + ((called-interactively-p 'any) (read-number "Use column N for sorting: ")) (t 1)))) (sorting-type @@ -1711,27 +1718,27 @@ numeric compare based on the type of the first key in the table." (extract-key-from-field ;; Function to be called on the contents of the field ;; used for sorting in the current row. - (case sorting-type + (cl-case sorting-type ((?n ?N) #'string-to-number) ((?a ?A) #'org-sort-remove-invisible) ((?t ?T) (lambda (f) (cond ((string-match org-ts-regexp-both f) - (org-float-time + (float-time (org-time-string-to-time (match-string 0 f)))) ((string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" f) (org-hh:mm-string-to-minutes f)) (t 0)))) ((?f ?F) (or getkey-func - (and (org-called-interactively-p 'any) + (and (called-interactively-p 'any) (intern (completing-read "Sort using function: " obarray #'fboundp t))) (error "Missing key extractor to sort rows"))) (t (user-error "Invalid sorting type `%c'" sorting-type)))) (predicate - (case sorting-type + (cl-case sorting-type ((?n ?N ?t ?T) #'<) ((?a ?A) #'string<) ((?f ?F) compare-func)))) @@ -1821,24 +1828,24 @@ lines." (dolist (field row) (org-table-goto-column c nil 'force) (org-table-get-field nil field) - (incf c))) + (cl-incf c))) (forward-line))) (org-table-align))) ;;;###autoload (defun org-table-convert () "Convert from `org-mode' table to table.el and back. -Obviously, this only works within limits. When an Org-mode table is -converted to table.el, all horizontal separator lines get lost, because -table.el uses these as cell boundaries and has no notion of horizontal lines. -A table.el table can be converted to an Org-mode table only if it does not -do row or column spanning. Multiline cells will become multiple cells. -Beware, Org-mode does not test if the table can be successfully converted - it -blindly applies a recipe that works for simple tables." +Obviously, this only works within limits. When an Org table is converted +to table.el, all horizontal separator lines get lost, because table.el uses +these as cell boundaries and has no notion of horizontal lines. A table.el +table can be converted to an Org table only if it does not do row or column +spanning. Multiline cells will become multiple cells. Beware, Org mode +does not test if the table can be successfully converted - it blindly +applies a recipe that works for simple tables." (interactive) (require 'table) (if (org-at-table.el-p) - ;; convert to Org-mode table + ;; convert to Org table (let ((beg (copy-marker (org-table-begin t))) (end (copy-marker (org-table-end t)))) (table-unrecognize-region beg end) @@ -1892,10 +1899,10 @@ Note that horizontal lines disappear." (let* ((table (delete 'hline (org-table-to-lisp))) (dline_old (org-table-current-line)) (col_old (org-table-current-column)) - (contents (mapcar (lambda (p) + (contents (mapcar (lambda (_) (let ((tp table)) (mapcar - (lambda (rown) + (lambda (_) (prog1 (pop (car tp)) (setq tp (cdr tp)))) @@ -1983,9 +1990,10 @@ blank, and the content is appended to the field above." ;;;###autoload (defun org-table-edit-field (arg) "Edit table field in a different window. -This is mainly useful for fields that contain hidden parts. -When called with a \\[universal-argument] prefix, just make the full field visible so that -it can be edited in place." +This is mainly useful for fields that contain hidden parts. When called +with a `\\[universal-argument]' prefix, just make the full field \ +visible so that it can be +edited in place." (interactive "P") (cond ((equal arg '(16)) @@ -2025,9 +2033,9 @@ it can be edited in place." '(invisible t org-cwidth t display t intangible t)) (goto-char p) - (org-set-local 'org-finish-function 'org-table-finish-edit-field) - (org-set-local 'org-window-configuration cw) - (org-set-local 'org-field-marker pos) + (setq-local org-finish-function 'org-table-finish-edit-field) + (setq-local org-window-configuration cw) + (setq-local org-field-marker pos) (message "Edit and finish with C-c C-c"))))) (defun org-table-finish-edit-field () @@ -2060,8 +2068,8 @@ current field. The mode exits automatically when the cursor leaves the table (but see `org-table-exit-follow-field-mode-when-leaving-table')." nil " TblFollow" nil (if org-table-follow-field-mode - (org-add-hook 'post-command-hook 'org-table-follow-fields-with-editor - 'append 'local) + (add-hook 'post-command-hook 'org-table-follow-fields-with-editor + 'append 'local) (remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local) (let* ((buf (get-buffer "*Org Table Edit Field*")) (win (and buf (get-buffer-window buf)))) @@ -2136,11 +2144,10 @@ If NLAST is a number, only the NLAST fields will actually be summed." s diff) (format "%.0f:%02.0f:%02.0f" h m s)))) (kill-new sres) - (if (org-called-interactively-p 'interactive) - (message "%s" - (substitute-command-keys - (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" - (length numbers) sres)))) + (when (called-interactively-p 'interactive) + (message "%s" (substitute-command-keys + (format "Sum of %d items: %-20s \ +\(\\[yank] will insert result into buffer)" (length numbers) sres)))) sres)))) (defun org-table-get-number-for-summing (s) @@ -2184,7 +2191,7 @@ with \"=\" or \":=\"." (assoc ref stored-list) (assoc scol stored-list)))) (cond (key (car ass)) - (ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") + (ass (concat (if (string-match-p "^[0-9]+$" (car ass)) "=" ":=") (cdr ass)))))) (noerror nil) (t (error "No formula active for the current field"))))) @@ -2200,22 +2207,15 @@ When NAMED is non-nil, look for a named equation." (ref (format "@%d$%d" (org-table-current-dline) (org-table-current-column))) - (refass (assoc ref stored-list)) - (nameass (assoc name stored-list)) (scol (cond ((not named) (format "$%d" (org-table-current-column))) ((and name (not (string-match "\\`LR[0-9]+\\'" name))) name) (t ref))) - (dummy (and (or nameass refass) - (not named) - (not (y-or-n-p "Replace existing field formula with \ -column formula? " )) - (message "Formula not replaced"))) (name (or name ref)) (org-table-may-need-update nil) (stored (cdr (assoc scol stored-list))) (eq (cond - ((and stored equation (string-match "^ *=? *$" equation)) + ((and stored equation (string-match-p "^ *=? *$" equation)) stored) ((stringp equation) equation) @@ -2307,7 +2307,7 @@ LOCATION is a buffer position, consider the formulas there." (goto-char (org-table-end))) (let ((case-fold-search t)) (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") - (let ((strings (org-split-string (org-match-string-no-properties 2) + (let ((strings (org-split-string (match-string-no-properties 2) " *:: *")) eq-alist seen) (dolist (string strings (nreverse eq-alist)) @@ -2319,7 +2319,7 @@ LOCATION is a buffer position, consider the formulas there." (cond ((not (match-end 2)) m) ;; Is it a column reference? - ((org-string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m) + ((string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m) ;; Since named columns are not possible in ;; LHS, assume this is a named field. (t (match-string 2 string))))) @@ -2386,11 +2386,8 @@ If yes, store the formula and apply it." (when (string-match "^:?=\\(.*[^=]\\)$" field) (setq named (equal (string-to-char field) ?:) eq (match-string 1 field)) - (if (or (fboundp 'calc-eval) - (equal (substring eq 0 (min 2 (length eq))) "'(")) - (org-table-eval-formula (if named '(4) nil) - (org-table-formula-from-user eq)) - (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) + (org-table-eval-formula (and named '(4)) + (org-table-formula-from-user eq)))))) (defvar org-recalc-commands nil "List of commands triggering the recalculation of a line. @@ -2472,7 +2469,7 @@ of the new mark." (when l1 (set-marker l1 nil)) (when l2 (set-marker l2 nil)) (set-marker l nil) - (when (org-called-interactively-p 'interactive) + (when (called-interactively-p 'interactive) (message "%s" (cdr (assoc newchar org-recalc-marks)))))) ;;;###autoload @@ -2500,7 +2497,7 @@ This function sets up the following dynamically scoped variables: (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)) (let ((c 1)) (dolist (name (org-split-string (match-string 1) " *| *")) - (incf c) + (cl-incf c) (when (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" name) (push (cons name (int-to-string c)) org-table-column-names))))) (setq org-table-column-names (nreverse org-table-column-names)) @@ -2529,13 +2526,13 @@ This function sets up the following dynamically scoped variables: (let ((fields1 (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") (org-split-string (match-string 1) " *| *"))) - (line (incf (cdr last) (count-lines (car last) (point)))) + (line (cl-incf (cdr last) (count-lines (car last) (point)))) (col 1)) (setcar last (point)) ; Update last known position. (while (and fields fields1) (let ((field (pop fields)) (v (pop fields1))) - (incf col) + (cl-incf col) (when (and (stringp field) (stringp v) (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" @@ -2553,7 +2550,7 @@ This function sets up the following dynamically scoped variables: (push (if (match-end 1) 'hline 'dline) types) (if (match-end 1) (push l hlines) (push l dlines)) (forward-line) - (incf l)) + (cl-incf l)) (push 'hline types) ; Add an imaginary extra hline to the end. (setq org-table-current-line-types (apply #'vector (nreverse types))) (setq org-table-dlines (apply #'vector (cons nil (nreverse dlines)))) @@ -2640,20 +2637,18 @@ This function assumes the table is already analyzed (i.e., using suppress-store suppress-analysis) "Replace the table field value at the cursor by the result of a calculation. -This function makes use of Dave Gillespie's Calc package, in my view the -most exciting program ever written for GNU Emacs. So you need to have Calc -installed in order to use this function. - In a table, this command replaces the value in the current field with the result of a formula. It also installs the formula as the \"current\" column formula, by storing it in a special line below the table. When called -with a `C-u' prefix, the current field must be a named field, and the -formula is installed as valid in only this specific field. +with a `\\[universal-argument]' prefix the formula is installed as a \ +field formula. -When called with two `C-u' prefixes, insert the active equation -for the field back into the current field, so that it can be -edited there. This is useful in order to use \\[org-table-show-reference] -to check the referenced fields. +When called with a `\\[universal-argument] \\[universal-argument]' prefix, \ +insert the active equation for the field +back into the current field, so that it can be edited there. This is \ +useful +in order to use \\<org-table-fedit-map>`\\[org-table-show-reference]' to \ +check the referenced fields. When called, the command first prompts for a formula, which is read in the minibuffer. Previously entered formulas are available through the @@ -2662,7 +2657,7 @@ These stored formulas are adapted correctly when moving, inserting, or deleting columns with the corresponding commands. The formula can be any algebraic expression understood by the Calc package. -For details, see the Org-mode manual. +For details, see the Org mode manual. This function can also be called from Lisp programs and offers additional arguments: EQUATION can be the formula to apply. If this @@ -2672,7 +2667,8 @@ SUPPRESS-CONST suppresses the interpretation of constants in the formula, assuming that this has been done already outside the function. SUPPRESS-STORE means the formula should not be stored, either because it is already stored, or because it is a modified equation that should -not overwrite the stored one." +not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to +`org-table-analyze'." (interactive "P") (org-table-check-inside-data-field) (or suppress-analysis (org-table-analyze)) @@ -2737,9 +2733,10 @@ not overwrite the stored one." (setq fmt (replace-match "" t t fmt))) (unless (string-match "\\S-" fmt) (setq fmt nil)))) - (if (and (not suppress-const) org-table-formula-use-constants) - (setq formula (org-table-formula-substitute-names formula))) + (when (and (not suppress-const) org-table-formula-use-constants) + (setq formula (org-table-formula-substitute-names formula))) (setq orig (or (get-text-property 1 :orig-formula formula) "?")) + (setq formula (org-table-formula-handle-first/last-rc formula)) (while (> ndown 0) (setq fields (org-split-string (org-trim @@ -2823,11 +2820,12 @@ not overwrite the stored one." (replace-match (save-match-data (org-table-make-reference - (org-sublist fields - (+ (if (match-end 2) n0 0) - (string-to-number (match-string 1 form))) - (+ (if (match-end 4) n0 0) - (string-to-number (match-string 3 form)))) + (cl-subseq fields + (+ (if (match-end 2) n0 0) + (string-to-number (match-string 1 form)) + -1) + (+ (if (match-end 4) n0 0) + (string-to-number (match-string 3 form)))) keep-empty numbers lispp)) t t form))) (setq form0 form) @@ -2854,20 +2852,23 @@ not overwrite the stored one." ev (if duration (org-table-time-seconds-to-string (string-to-number ev) duration-output-format) ev)) - (or (fboundp 'calc-eval) - (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")) - ;; Use <...> time-stamps so that Calc can handle them - (while (string-match (concat "\\[" org-ts-regexp1 "\\]") form) - (setq form (replace-match "<\\1>" nil nil form))) - ;; I18n-ize local time-stamps by setting (system-time-locale "C") - (when (string-match org-ts-regexp2 form) - (let* ((ts (match-string 0 form)) - (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts)))) - (system-time-locale "C") - (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)) - (cdr org-time-stamp-formats)) - (car org-time-stamp-formats)))) - (setq form (replace-match (format-time-string tf tsp) t t form)))) + + ;; Use <...> time-stamps so that Calc can handle them. + (setq form + (replace-regexp-in-string org-ts-regexp-inactive "<\\1>" form)) + ;; Internationalize local time-stamps by setting locale to + ;; "C". + (setq form + (replace-regexp-in-string + org-ts-regexp + (lambda (ts) + (let ((system-time-locale "C")) + (format-time-string + (org-time-stamp-format + (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)) + (apply #'encode-time + (save-match-data (org-parse-time-string ts)))))) + form t t)) (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) form @@ -2895,7 +2896,7 @@ $1-> %s\n" orig formula form0 form)) (if fmt (format fmt (string-to-number ev)) ev))))) (setq bw (get-buffer-window "*Substitution History*")) (org-fit-window-to-buffer bw) - (unless (and (org-called-interactively-p 'any) (not ndown)) + (unless (and (called-interactively-p 'any) (not ndown)) (unless (let (inhibit-redisplay) (y-or-n-p "Debugging Formula. Continue to next? ")) (org-table-align) @@ -2931,7 +2932,7 @@ When CORNERS-ONLY is set, only return the corners of the range as a list (line1 column1 line2 column2) where line1 and line2 are line numbers relative to beginning of table, or TBEG, and column1 and column2 are table column numbers." - (let* ((desc (if (org-string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc) + (let* ((desc (if (string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc) (replace-regexp-in-string "\\$" "@0$" desc) desc)) (col (or col (org-table-current-column))) @@ -2979,7 +2980,7 @@ and column2 are table column numbers." (forward-line (- first-row thisline)) (while (not (looking-at org-table-dataline-regexp)) (forward-line) - (incf first-row)) + (cl-incf first-row)) (org-table-goto-column first-column) (let ((beg (point))) (forward-line (- last-row first-row)) @@ -3017,7 +3018,7 @@ The cursor is currently in relative line number CLINE." (when (and hn (not hdir)) (setq cline 0) (setq hdir "+") - (when (eq (aref org-table-current-line-types 0) 'hline) (decf hn))) + (when (eq (aref org-table-current-line-types 0) 'hline) (cl-decf hn))) (when (and (not hn) on (not odir)) (user-error "Should never happen")) (when hn (setq cline @@ -3036,7 +3037,7 @@ search, as a string." (let ((l (length org-table-current-line-types))) (catch :exit (dotimes (_ n) - (while (and (incf i (if backwards -1 1)) + (while (and (cl-incf i (if backwards -1 1)) (>= i 0) (< i l) (not (eq (aref org-table-current-line-types i) type)) @@ -3048,7 +3049,7 @@ search, as a string." ((eq org-table-relative-ref-may-cross-hline t)) ((eq org-table-relative-ref-may-cross-hline 'error) (user-error "Row descriptor %s crosses hline" desc)) - (t (decf i (if backwards -1 1)) ; Step back. + (t (cl-decf i (if backwards -1 1)) ; Step back. (throw :exit nil))))))) (cond ((or (< i 0) (>= i l)) (user-error "Row descriptor %s leads outside table" desc)) @@ -3126,10 +3127,13 @@ T1 is nil, always messages." ;;;###autoload (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. + With prefix arg ALL, do this for all lines in the table. -With the prefix argument ALL is `(16)' \ -\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if -it is the symbol `iterate', recompute the table until it no longer changes. + +When called with a `\\[universal-argument] \\[universal-argument]' prefix, or \ +if ALL is the symbol `iterate', +recompute the table until it no longer changes. + If NOALIGN is not nil, do not re-align the table after the computations are done. This is typically used internally to save time, if it is known that the table will be realigned a little later anyway." @@ -3172,7 +3176,7 @@ existing formula for column %s" new)) new)) (t old-lhs))))) - (if (org-string-match-p "\\`\\$[0-9]+\\'" lhs) + (if (string-match-p "\\`\\$[0-9]+\\'" lhs) (push (cons lhs rhs) eqlcol) (push (cons lhs rhs) eqlfield)))) (setq eqlcol (nreverse eqlcol)) @@ -3193,8 +3197,8 @@ existing formula for column %s" (re-search-forward org-table-hline-regexp end t) (re-search-forward org-table-dataline-regexp end t)) (setq beg (match-beginning 0))) - ;; Just leave BEG where it is. - (t (setq beg (line-beginning-position))))) + ;; Just leave BEG at the start of the table. + (t nil))) (setq beg (line-beginning-position) end (copy-marker (line-beginning-position 2)))) (goto-char beg) @@ -3233,7 +3237,7 @@ existing formula for column %s" (while (re-search-forward line-re end t) (unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1)) ;; Unprotected line, recalculate. - (incf cnt) + (cl-incf cnt) (when all (setq log-last-time (org-table-message-once-per-second @@ -3264,19 +3268,19 @@ existing formula for column %s" ;; `org-table-formula-create-columns' allows it. (let ((column-count (progn (end-of-line) (1- (org-table-current-column))))) - `(lambda (column) - (when (> column 1000) - (user-error "Formula column target too large")) - (and (> column ,column-count) - (or (eq org-table-formula-create-columns t) - (and (eq org-table-formula-create-columns 'warn) - (progn - (org-display-warning - "Out-of-bounds formula added columns") - t)) - (and (eq org-table-formula-create-columns 'prompt) - (yes-or-no-p - "Out-of-bounds formula. Add columns? "))))))) + (lambda (column) + (when (> column 1000) + (user-error "Formula column target too large")) + (and (> column column-count) + (or (eq org-table-formula-create-columns t) + (and (eq org-table-formula-create-columns 'warn) + (progn + (org-display-warning + "Out-of-bounds formula added columns") + t)) + (and (eq org-table-formula-create-columns 'prompt) + (yes-or-no-p + "Out-of-bounds formula. Add columns? "))))))) (org-table-eval-formula nil formula t t t t)))) ;; Clean up markers and internal text property. (remove-text-properties (point-min) (point-max) '(org-untouchable t)) @@ -3316,10 +3320,15 @@ with the prefix ARG." (defun org-table-recalculate-buffer-tables () "Recalculate all tables in the current buffer." (interactive) - (save-excursion - (save-restriction - (widen) - (org-table-map-tables (lambda () (org-table-recalculate t)) t)))) + (org-with-wide-buffer + (org-table-map-tables + (lambda () + ;; Reason for separate `org-table-align': When repeating + ;; (org-table-recalculate t) `org-table-may-need-update' gets in + ;; the way. + (org-table-recalculate t t) + (org-table-align)) + t))) ;;;###autoload (defun org-table-iterate-buffer-tables () @@ -3329,19 +3338,19 @@ with the prefix ARG." (i imax) (checksum (md5 (buffer-string))) c1) - (save-excursion - (save-restriction - (widen) - (catch 'exit - (while (> i 0) - (setq i (1- i)) - (org-table-map-tables (lambda () (org-table-recalculate t)) t) - (if (equal checksum (setq c1 (md5 (buffer-string)))) - (progn - (message "Convergence after %d iterations" (- imax i)) - (throw 'exit t)) - (setq checksum c1))) - (user-error "No convergence after %d iterations" imax)))))) + (org-with-wide-buffer + (catch 'exit + (while (> i 0) + (setq i (1- i)) + (org-table-map-tables (lambda () (org-table-recalculate t t)) t) + (if (equal checksum (setq c1 (md5 (buffer-string)))) + (progn + (org-table-map-tables #'org-table-align t) + (message "Convergence after %d iterations" (- imax i)) + (throw 'exit t)) + (setq checksum c1))) + (org-table-map-tables #'org-table-align t) + (user-error "No convergence after %d iterations" imax))))) (defun org-table-calc-current-TBLFM (&optional arg) "Apply the #+TBLFM in the line at point to the table." @@ -3385,13 +3394,13 @@ function assumes the table is already analyzed (i.e., using (let ((lhs (car e)) (rhs (cdr e))) (cond - ((org-string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs) + ((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs) ;; This just refers to one fixed field. (push e res)) - ((org-string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs) + ((string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs) ;; This just refers to one fixed named field. (push e res)) - ((org-string-match-p "\\`\\$[0-9]+\\'" lhs) + ((string-match-p "\\`\\$[0-9]+\\'" lhs) ;; Column formulas are treated specially and are not ;; expanded. (push e res)) @@ -3407,12 +3416,12 @@ function assumes the table is already analyzed (i.e., using (c1 (nth 1 range)) (r2 (org-table-line-to-dline (nth 2 range) 'above)) (c2 (nth 3 range))) - (loop for ir from r1 to r2 do - (loop for ic from c1 to c2 do - (push - (cons (propertize (format "@%d$%d" ir ic) :orig-eqn e) - rhs) - res)))))))))) + (cl-loop for ir from r1 to r2 do + (cl-loop for ic from c1 to c2 do + (push (cons (propertize + (format "@%d$%d" ir ic) :orig-eqn e) + rhs) + res)))))))))) (defun org-table-formula-handle-first/last-rc (s) "Replace @<, @>, $<, $> with first/last row/column of the table. @@ -3438,7 +3447,7 @@ borders of the table using the @< @> $< $> makers." (- nmax len -1))) (if (or (< n 1) (> n nmax)) (user-error "Reference \"%s\" in expression \"%s\" points outside table" - (match-string 0 s) s)) + (match-string 0 s) s)) (setq start (match-beginning 0)) (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s))))) s) @@ -3447,7 +3456,7 @@ borders of the table using the @< @> $< $> makers." "Replace $const with values in string F." (let ((start 0) (pp (/= (string-to-char f) ?')) - (duration (org-string-match-p ";.*[Tt].*\\'" f)) + (duration (string-match-p ";.*[Tt].*\\'" f)) (new (replace-regexp-in-string ; Check for column names. org-table-column-name-regexp (lambda (m) @@ -3460,7 +3469,7 @@ borders of the table using the @< @> $< $> makers." "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)" new start)) (if (match-end 2) (setq start (match-end 2)) - (incf start) + (cl-incf start) ;; When a duration is expected, convert value on the fly. (let ((value (save-match-data @@ -3471,7 +3480,7 @@ borders of the table using the @< @> $< $> makers." (when value (setq new (replace-match (concat (and pp "(") value (and pp ")")) t t new)))))) - (if org-table-formula-debug (org-propertize new :orig-formula f)) new)) + (if org-table-formula-debug (propertize new :orig-formula f) new))) (defun org-table-get-constant (const) "Find the value for a parameter or constant in a formula. @@ -3567,13 +3576,13 @@ Parameters get priority." ;; Keep global-font-lock-mode from turning on font-lock-mode (let ((font-lock-global-modes '(not fundamental-mode))) (fundamental-mode)) - (org-set-local 'font-lock-global-modes (list 'not major-mode)) - (org-set-local 'org-pos pos) - (org-set-local 'org-table--fedit-source source) - (org-set-local 'org-window-configuration wc) - (org-set-local 'org-selected-window sel-win) + (setq-local font-lock-global-modes (list 'not major-mode)) + (setq-local org-pos pos) + (setq-local org-table--fedit-source source) + (setq-local org-window-configuration wc) + (setq-local org-selected-window sel-win) (use-local-map org-table-fedit-map) - (org-add-hook 'post-command-hook #'org-table-fedit-post-command t t) + (add-hook 'post-command-hook #'org-table-fedit-post-command t t) (easy-menu-add org-table-fedit-menu) (setq startline (org-current-line)) (dolist (entry eql) @@ -3597,8 +3606,7 @@ Parameters get priority." (when (eq org-table-use-standard-references t) (org-table-fedit-toggle-ref-type)) (org-goto-line startline) - (message - (substitute-command-keys "\\<org-mode-map>\ + (message "%s" (substitute-command-keys "\\<org-mode-map>\ Edit formulas, finish with `\\[org-ctrl-c-ctrl-c]' or `\\[org-edit-special]'. \ See menu for more commands."))))) @@ -3731,7 +3739,7 @@ minutes or seconds." (format "%.1f" (/ (float secs0) 60))) ((eq output-format 'seconds) (format "%d" secs0)) - (t (org-format-seconds "%.2h:%.2m:%.2s" secs0))))) + (t (format-seconds "%.2h:%.2m:%.2s" secs0))))) (if (< secs 0) (concat "-" res) res))) (defun org-table-fedit-convert-buffer (function) @@ -3748,7 +3756,7 @@ minutes or seconds." (defun org-table-fedit-toggle-ref-type () "Convert all references in the buffer from B3 to @3$2 and back." (interactive) - (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an)) + (setq-local org-table-buffer-is-an (not org-table-buffer-is-an)) (org-table-fedit-convert-buffer (if org-table-buffer-is-an 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc)) @@ -3961,8 +3969,8 @@ When LOCAL is non-nil, show references for the table at point." (when (and match (not (equal (match-beginning 0) (point-at-bol)))) (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) 'secondary-selection)) - (org-add-hook 'before-change-functions - #'org-table-remove-rectangle-highlight) + (add-hook 'before-change-functions + #'org-table-remove-rectangle-highlight) (when (eq what 'name) (setq var (substring match 1))) (when (eq what 'range) (unless (eq (string-to-char match) ?@) (setq match (concat "@" match))) @@ -3991,10 +3999,10 @@ When LOCAL is non-nil, show references for the table at point." (when dest (setq name (substring dest 1)) (cond - ((org-string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest) + ((string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest) (org-table-goto-field dest)) - ((org-string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" - dest) + ((string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" + dest) (org-table-goto-field dest)) (t (org-table-goto-column (string-to-number name)))) (move-marker pos (point)) @@ -4148,16 +4156,15 @@ FACE, when non-nil, for the highlight." (goto-char (car start-coordinates))) (add-hook 'before-change-functions #'org-table-remove-rectangle-highlight)) -(defun org-table-remove-rectangle-highlight (&rest ignore) +(defun org-table-remove-rectangle-highlight (&rest _ignore) "Remove the rectangle overlays." (unless org-inhibit-highlight-removal (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) (mapc 'delete-overlay org-table-rectangle-overlays) (setq org-table-rectangle-overlays nil))) -(defvar org-table-coordinate-overlays nil +(defvar-local org-table-coordinate-overlays nil "Collects the coordinate grid overlays, so that they can be removed.") -(make-variable-buffer-local 'org-table-coordinate-overlays) (defun org-table-overlay-coordinates () "Add overlays to the table at point, to show row/column coordinates." @@ -4212,19 +4219,20 @@ FACE, when non-nil, for the highlight." ;;; The orgtbl minor mode ;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode table editor. - -;; This is really a hack, because the org-mode table editor uses several -;; keys which normally belong to the major mode, for example the TAB and -;; RET keys. Here is how it works: The minor mode defines all the keys -;; necessary to operate the table editor, but wraps the commands into a -;; function which tests if the cursor is currently inside a table. If that -;; is the case, the table editor command is executed. However, when any of -;; those keys is used outside a table, the function uses `key-binding' to -;; look up if the key has an associated command in another currently active -;; keymap (minor modes, major mode, global), and executes that command. -;; There might be problems if any of the keys used by the table editor is -;; otherwise used as a prefix key. +;; integrate the Org table editor. + +;; This is really a hack, because the Org table editor uses several +;; keys which normally belong to the major mode, for example the TAB +;; and RET keys. Here is how it works: The minor mode defines all the +;; keys necessary to operate the table editor, but wraps the commands +;; into a function which tests if the cursor is currently inside +;; a table. If that is the case, the table editor command is +;; executed. However, when any of those keys is used outside a table, +;; the function uses `key-binding' to look up if the key has an +;; associated command in another currently active keymap (minor modes, +;; major mode, global), and executes that command. There might be +;; problems if any of the keys used by the table editor is otherwise +;; used as a prefix key. ;; Another challenge is that the key binding for TAB can be tab or \C-i, ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode @@ -4274,16 +4282,16 @@ FACE, when non-nil, for the highlight." ;; FIXME: maybe it should use emulation-mode-map-alists? (and c (setq minor-mode-map-alist (cons c (delq c minor-mode-map-alist))))) - (org-set-local (quote org-table-may-need-update) t) - (org-add-hook 'before-change-functions 'org-before-change-function - nil 'local) - (org-set-local 'org-old-auto-fill-inhibit-regexp - auto-fill-inhibit-regexp) - (org-set-local 'auto-fill-inhibit-regexp - (if auto-fill-inhibit-regexp - (concat orgtbl-line-start-regexp "\\|" - auto-fill-inhibit-regexp) - orgtbl-line-start-regexp)) + (setq-local org-table-may-need-update t) + (add-hook 'before-change-functions 'org-before-change-function + nil 'local) + (setq-local org-old-auto-fill-inhibit-regexp + auto-fill-inhibit-regexp) + (setq-local auto-fill-inhibit-regexp + (if auto-fill-inhibit-regexp + (concat orgtbl-line-start-regexp "\\|" + auto-fill-inhibit-regexp) + orgtbl-line-start-regexp)) (add-to-invisibility-spec '(org-cwidth)) (when (fboundp 'font-lock-add-keywords) (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) @@ -4383,27 +4391,26 @@ to execute outside of tables." cmd (orgtbl-make-binding fun nfunc key)) (org-defkey orgtbl-mode-map key cmd)) - ;; Special treatment needed for TAB and RET + ;; Special treatment needed for TAB, RET and DEL (org-defkey orgtbl-mode-map [(return)] (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) (org-defkey orgtbl-mode-map "\C-m" (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) - (org-defkey orgtbl-mode-map [(tab)] (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) (org-defkey orgtbl-mode-map "\C-i" (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) - (org-defkey orgtbl-mode-map [(shift tab)] (orgtbl-make-binding 'org-table-previous-field 104 [(shift tab)] [(tab)] "\C-i")) + (org-defkey orgtbl-mode-map [backspace] + (orgtbl-make-binding 'org-delete-backward-char 109 + [backspace] (kbd "DEL"))) - - (unless (featurep 'xemacs) - (org-defkey orgtbl-mode-map [S-iso-lefttab] - (orgtbl-make-binding 'org-table-previous-field 107 - [S-iso-lefttab] [backtab] [(shift tab)] - [(tab)] "\C-i"))) + (org-defkey orgtbl-mode-map [S-iso-lefttab] + (orgtbl-make-binding 'org-table-previous-field 107 + [S-iso-lefttab] [backtab] [(shift tab)] + [(tab)] "\C-i")) (org-defkey orgtbl-mode-map [backtab] (orgtbl-make-binding 'org-table-previous-field 108 @@ -4522,7 +4529,7 @@ With prefix arg, also recompute table." (t (let (orgtbl-mode) (call-interactively (key-binding "\C-c\C-c"))))))) -(defun orgtbl-create-or-convert-from-region (arg) +(defun orgtbl-create-or-convert-from-region (_arg) "Create table or convert region to table, if no conflicting binding. This installs the table binding `C-c |', but only if there is no conflicting binding to this key outside orgtbl-mode." @@ -4566,11 +4573,9 @@ overwritten, and the table is not marked as requiring realignment." (org-table-blank-field)) t) (eq N 1) - (looking-at "[^|\n]* +|")) + (looking-at "[^|\n]* \\( \\)|")) (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (org-delete-backward-char 1) - (goto-char (match-beginning 0)) + (delete-region (match-beginning 1) (match-end 1)) (self-insert-command N)) (setq org-table-may-need-update t) (let* (orgtbl-mode @@ -4616,20 +4621,24 @@ a radio table." (beginning-of-line 0))) rtn))) -(defun orgtbl-send-replace-tbl (name txt) - "Find and replace table NAME with TXT." +(defun orgtbl-send-replace-tbl (name text) + "Find and replace table NAME with TEXT." (save-excursion (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t) - (user-error "Don't know where to insert translated table")) - (let ((beg (line-beginning-position 2))) - (unless (re-search-forward - (concat "END +RECEIVE +ORGTBL +" name) nil t) - (user-error "Cannot find end of insertion region")) - (beginning-of-line) - (delete-region beg (point))) - (insert txt "\n"))) + (let* ((location-flag nil) + (name (regexp-quote name)) + (begin-re (format "BEGIN +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name)) + (end-re (format "END +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name))) + (while (re-search-forward begin-re nil t) + (unless location-flag (setq location-flag t)) + (let ((beg (line-beginning-position 2))) + (unless (re-search-forward end-re nil t) + (user-error "Cannot find end of receiver location at %d" beg)) + (beginning-of-line) + (delete-region beg (point)) + (insert text "\n"))) + (unless location-flag + (user-error "No valid receiver location found in the buffer"))))) ;;;###autoload (defun org-table-to-lisp (&optional txt) @@ -4654,7 +4663,7 @@ for this table." (catch 'exit (unless (org-at-table-p) (user-error "Not at a table")) ;; when non-interactive, we assume align has just happened. - (when (org-called-interactively-p 'any) (org-table-align)) + (when (called-interactively-p 'any) (org-table-align)) (let ((dests (orgtbl-gather-send-defs)) (table (org-table-to-lisp (buffer-substring-no-properties (org-table-begin) @@ -4670,7 +4679,7 @@ for this table." (unless (fboundp transform) (user-error "No such transformation function %s" transform)) (orgtbl-send-replace-tbl name (funcall transform table params))) - (incf ntbl)) + (cl-incf ntbl)) (message "Table converted and installed at %d receiver location%s" ntbl (if (> ntbl 1) "s" "")) (and (> ntbl 0) ntbl)))) @@ -4806,7 +4815,7 @@ strings, or the current cell) returning a string: a property list with column numbers and format strings, or functions, e.g., - \(:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c)))) + (:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c)))) :hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt @@ -4852,10 +4861,21 @@ This may be either a string or a function of two arguments: ((consp e) (princ "| ") (dolist (c e) (princ c) (princ " |")) (princ "\n"))))) + ;; Add back-end specific filters, but not user-defined ones. In + ;; particular, make sure to call parse-tree filters on the + ;; table. + (setq info + (let ((org-export-filters-alist nil)) + (org-export-install-filters + (org-combine-plists + (org-export-get-environment backend nil params) + `(:back-end ,(org-export-get-backend backend)))))) (setq data - (org-element-map (org-element-parse-buffer) 'table - #'identity nil t)) - (setq info (org-export-get-environment backend nil params))) + (org-export-filter-apply-functions + (plist-get info :filter-parse-tree) + (org-element-map (org-element-parse-buffer) 'table + #'identity nil t) + info))) (when (and backend (symbolp backend) (not (org-export-get-backend backend))) (user-error "Unknown :backend value")) (when (or (not backend) (plist-get info :raw)) (require 'ox-org)) @@ -4868,7 +4888,7 @@ This may be either a string or a function of two arguments: (lambda (row) (if (>= n skip) t (org-element-extract-element row) - (incf n) + (cl-incf n) nil)) nil t)))) ;; Handle :skipcols parameter. @@ -4885,7 +4905,7 @@ This may be either a string or a function of two arguments: (org-element-contents row))) (when (memq c skipcols) (org-element-extract-element cell)) - (incf c)))))))))) + (cl-incf c)))))))))) ;; Since we are going to export using a low-level mechanism, ;; ignore special column and special rows manually. (let ((special? (org-export-table-has-special-column-p data)) @@ -4898,9 +4918,9 @@ This may be either a string or a function of two arguments: (push datum ignore)))) (setq info (plist-put info :ignore-list ignore))) ;; We use a low-level mechanism to export DATA so as to skip all - ;; usual pre-processing and post-processing, i.e., hooks, filters, - ;; Babel code evaluation, include keywords and macro expansion, - ;; and filters. + ;; usual pre-processing and post-processing, i.e., hooks, Babel + ;; code evaluation, include keywords and macro expansion. Only + ;; back-end specific filters are retained. (let ((output (org-export-data-with-backend data custom-backend info))) ;; Remove final newline. (if (org-string-nw-p output) (substring-no-properties output 0 -1) "")))) @@ -5189,7 +5209,7 @@ supported. It is also possible to use the following one: params))) (columns (let ((w (plist-get params :columns))) (cond ((not w) nil) - ((org-string-match-p "{\\|@columnfractions " w) w) + ((string-match-p "{\\|@columnfractions " w) w) (t (concat "@columnfractions " w)))))) (if (not columns) output (replace-regexp-in-string @@ -5255,7 +5275,7 @@ supported. It is also possible to use the following ones: params))) ;; Put the cursor in a column containing numerical values -;; of an Org-Mode table, +;; of an Org table, ;; type C-c " a ;; A new column is added with a bar plot. ;; When the table is refreshed (C-u C-c *), @@ -5263,35 +5283,38 @@ supported. It is also possible to use the following ones: (defun orgtbl-ascii-draw (value min max &optional width characters) "Draw an ascii bar in a table. -VALUE is a the value to plot, the width of the bar to draw. A -value equal to MIN will be displayed as empty (zero width bar). -A value equal to MAX will draw a bar filling all the WIDTH. -WIDTH is the expected width in characters of the column. -CHARACTERS is a string that will compose the bar, with shades of -grey from pure white to pure black. It defaults to a 10 -characters string of regular ascii characters." - (let* ((characters (or characters " .:;c!lhVHW")) - (width (or width 12)) - (value (if (numberp value) value (string-to-number value))) - (value (* (/ (- (+ value 0.0) min) (- max min)) width))) - (cond - ((< value 0) "too small") - ((> value width) "too large") - (t - (let ((len (1- (length characters)))) - (concat - (make-string (floor value) (elt characters len)) - (string (elt characters - (floor (* (- value (floor value)) len)))))))))) +VALUE is the value to plot, it determines the width of the bar to draw. +MIN is the value that will be displayed as empty (zero width bar). +MAX is the value that will draw a bar filling all the WIDTH. +WIDTH is the span in characters from MIN to MAX. +CHARACTERS is a string that will compose the bar, with shades of grey +from pure white to pure black. It defaults to a 10 characters string +of regular ascii characters." + (let* ((width (ceiling (or width 12))) + (characters (or characters " .:;c!lhVHW")) + (len (1- (length characters))) + (value (float (if (numberp value) + value (string-to-number value)))) + (relative (/ (- value min) (- max min))) + (steps (round (* relative width len)))) + (cond ((< steps 0) "too small") + ((> steps (* width len)) "too large") + (t (let* ((int-division (/ steps len)) + (remainder (- steps (* int-division len)))) + (concat (make-string int-division (elt characters len)) + (string (elt characters remainder)))))))) ;;;###autoload (defun orgtbl-ascii-plot (&optional ask) - "Draw an ascii bar plot in a column. -With cursor in a column containing numerical values, this -function will draw a plot in a new column. + "Draw an ASCII bar plot in a column. + +With cursor in a column containing numerical values, this function +will draw a plot in a new column. + ASK, if given, is a numeric prefix to override the default 12 -characters width of the plot. ASK may also be the -\\[universal-argument] prefix, which will prompt for the width." +characters width of the plot. ASK may also be the `\\[universal-argument]' \ +prefix, +which will prompt for the width." (interactive "P") (let ((col (org-table-current-column)) (min 1e999) ; 1e999 will be converted to infinity @@ -5430,15 +5453,15 @@ distinguished from a plain table name or ID." (save-match-data (let ((eq (org-table-formula-handle-first/last-rc (match-string 1 m)))) (org-table-get-range - (if (org-string-match-p "\\`\\$[0-9]+\\'" eq) + (if (string-match-p "\\`\\$[0-9]+\\'" eq) (concat "@0" eq) eq))))) form t t 1))) (defmacro org-define-lookup-function (mode) (let ((mode-str (symbol-name mode)) - (first-p (equal mode 'first)) - (all-p (equal mode 'all))) + (first-p (eq mode 'first)) + (all-p (eq mode 'all))) (let ((plural-str (if all-p "s" ""))) `(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate) ,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST. @@ -5451,16 +5474,13 @@ This function is generated by a call to the macro `org-define-lookup-function'." (sl s-list) (rl (or r-list s-list)) (ret nil)))) - (if first-p (add-to-list 'lvars '(match-p nil))) - lvars) + (if first-p (cons '(match-p nil) lvars) lvars)) (while ,(if first-p '(and (not match-p) sl) 'sl) - (progn - (if (funcall p val (car sl)) - (progn - ,(if first-p '(setq match-p t)) - (let ((rval (car rl))) - (setq ret ,(if all-p '(append ret (list rval)) 'rval))))) - (setq sl (cdr sl) rl (cdr rl)))) + (when (funcall p val (car sl)) + ,(when first-p '(setq match-p t)) + (let ((rval (car rl))) + (setq ret ,(if all-p '(append ret (list rval)) 'rval)))) + (setq sl (cdr sl) rl (cdr rl))) ret))))) (org-define-lookup-function first) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index c363ff3..2d2ee21 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -1,4 +1,4 @@ -;;; org-timer.el --- Timer code for Org mode +;;; org-timer.el --- Timer code for Org mode -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. @@ -35,7 +35,7 @@ ;;; Code: -(require 'org) +(require 'cl-lib) (require 'org-clock) (declare-function org-agenda-error "org-agenda" ()) @@ -69,14 +69,14 @@ the value of the timer." "The default timer when a timer is set, in minutes or hh:mm:ss format. When 0, the user is prompted for a value." :group 'org-time - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type 'string) (defcustom org-timer-display 'mode-line - "When a timer is running, org-mode can display it in the mode -line and/or frame title. -Allowed values are: + "Define where running timer is displayed, if at all. +When a timer is running, Org can display it in the mode line +and/or frame title. Allowed values are: both displays in both mode line and frame title mode-line displays only in mode line (default) @@ -141,10 +141,10 @@ the region 0:00:00." (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) (setq org-timer-start-time (seconds-to-time - ;; Pass `current-time' result to `org-float-time' - ;; (instead of calling without arguments) so that only + ;; Pass `current-time' result to `float-time' (instead + ;; of calling without arguments) so that only ;; `current-time' has to be overriden in tests. - (- (org-float-time (current-time)) delta)))) + (- (float-time (current-time)) delta)))) (setq org-timer-pause-time nil) (org-timer-set-mode-line 'on) (message "Timer start time set to %s, current value is %s" @@ -160,8 +160,8 @@ With prefix arg STOP, stop it entirely." (stop (org-timer-stop)) ((not org-timer-start-time) (error "No timer is running")) (org-timer-pause-time - (let ((start-secs (org-float-time org-timer-start-time)) - (pause-secs (org-float-time org-timer-pause-time))) + (let ((start-secs (float-time org-timer-start-time)) + (pause-secs (float-time org-timer-pause-time))) (if org-timer-countdown-timer (let ((new-secs (- start-secs pause-secs))) (setq org-timer-countdown-timer @@ -170,10 +170,10 @@ With prefix arg STOP, stop it entirely." (setq org-timer-start-time (time-add (current-time) (seconds-to-time new-secs)))) (setq org-timer-start-time - ;; Pass `current-time' result to `org-float-time' - ;; (instead of calling without arguments) so that only + ;; Pass `current-time' result to `float-time' (instead + ;; of calling without arguments) so that only ;; `current-time' has to be overriden in tests. - (seconds-to-time (- (org-float-time (current-time)) + (seconds-to-time (- (float-time (current-time)) (- pause-secs start-secs))))) (setq org-timer-pause-time nil) (org-timer-set-mode-line 'on) @@ -204,22 +204,25 @@ With prefix arg STOP, stop it entirely." (message "Timer stopped")) ;;;###autoload -(defun org-timer (&optional restart no-insert-p) +(defun org-timer (&optional restart no-insert) "Insert a H:MM:SS string from the timer into the buffer. -The first time this command is used, the timer is started. When used with -a \\[universal-argument] prefix, force restarting the timer. -When used with a double prefix argument \\[universal-argument], change all the timer string -in the region by a fixed amount. This can be used to recalibrate a timer -that was not started at the correct moment. +The first time this command is used, the timer is started. -If NO-INSERT-P is non-nil, return the string instead of inserting +When used with a `\\[universal-argument]' prefix, force restarting the timer. + +When used with a `\\[universal-argument] \\[universal-argument]' \ +prefix, change all the timer strings +in the region by a fixed amount. This can be used to re-calibrate +a timer that was not started at the correct moment. + +If NO-INSERT is non-nil, return the string instead of inserting it in the buffer." (interactive "P") (if (equal restart '(16)) (org-timer-start restart) (when (or (equal restart '(4)) (not org-timer-start-time)) (org-timer-start)) - (if no-insert-p + (if no-insert (org-timer-value-string) (insert (org-timer-value-string))))) @@ -230,14 +233,14 @@ it in the buffer." (abs (floor (org-timer-seconds)))))) (defun org-timer-seconds () - ;; Pass `current-time' result to `org-float-time' (instead of - ;; calling without arguments) so that only `current-time' has to be + ;; Pass `current-time' result to `float-time' (instead of calling + ;; without arguments) so that only `current-time' has to be ;; overriden in tests. (if org-timer-countdown-timer - (- (org-float-time org-timer-start-time) - (org-float-time (or org-timer-pause-time (current-time)))) - (- (org-float-time (or org-timer-pause-time (current-time))) - (org-float-time org-timer-start-time)))) + (- (float-time org-timer-start-time) + (float-time (or org-timer-pause-time (current-time)))) + (- (float-time (or org-timer-pause-time (current-time))) + (float-time org-timer-start-time)))) ;;;###autoload (defun org-timer-change-times-in-region (beg end delta) @@ -343,43 +346,43 @@ VALUE can be `on', `off', or `paused'." (or (memq 'org-timer-mode-line-string frame-title-format) (setq frame-title-format (append frame-title-format '(org-timer-mode-line-string))))) - (cond - ((equal value 'off) - (when org-timer-mode-line-timer - (cancel-timer org-timer-mode-line-timer) - (setq org-timer-mode-line-timer nil)) - (when (or (eq org-timer-display 'mode-line) - (eq org-timer-display 'both)) - (setq global-mode-string - (delq 'org-timer-mode-line-string global-mode-string))) - (when (or (eq org-timer-display 'frame-title) - (eq org-timer-display 'both)) - (setq frame-title-format - (delq 'org-timer-mode-line-string frame-title-format))) - (force-mode-line-update)) - ((equal value 'paused) - (when org-timer-mode-line-timer - (cancel-timer org-timer-mode-line-timer) - (setq org-timer-mode-line-timer nil))) - ((equal value 'on) - (when (or (eq org-timer-display 'mode-line) - (eq org-timer-display 'both)) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-timer-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-timer-mode-line-string))))) - (when (or (eq org-timer-display 'frame-title) - (eq org-timer-display 'both)) - (or (memq 'org-timer-mode-line-string frame-title-format) - (setq frame-title-format - (append frame-title-format '(org-timer-mode-line-string))))) - (org-timer-update-mode-line) - (when org-timer-mode-line-timer - (cancel-timer org-timer-mode-line-timer) - (setq org-timer-mode-line-timer nil)) - (when org-timer-display - (setq org-timer-mode-line-timer - (run-with-timer 1 1 'org-timer-update-mode-line)))))) + (cl-case value + (off + (when org-timer-mode-line-timer + (cancel-timer org-timer-mode-line-timer) + (setq org-timer-mode-line-timer nil)) + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (setq global-mode-string + (delq 'org-timer-mode-line-string global-mode-string))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (setq frame-title-format + (delq 'org-timer-mode-line-string frame-title-format))) + (force-mode-line-update)) + (paused + (when org-timer-mode-line-timer + (cancel-timer org-timer-mode-line-timer) + (setq org-timer-mode-line-timer nil))) + (on + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-timer-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-timer-mode-line-string))))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (or (memq 'org-timer-mode-line-string frame-title-format) + (setq frame-title-format + (append frame-title-format '(org-timer-mode-line-string))))) + (org-timer-update-mode-line) + (when org-timer-mode-line-timer + (cancel-timer org-timer-mode-line-timer) + (setq org-timer-mode-line-timer nil)) + (when org-timer-display + (setq org-timer-mode-line-timer + (run-with-timer 1 1 'org-timer-update-mode-line)))))) (defun org-timer-update-mode-line () "Update the timer time in the mode line." @@ -434,10 +437,10 @@ using three `C-u' prefix arguments." (number-to-string org-timer-default-timer) org-timer-default-timer)) (effort-minutes (ignore-errors (org-get-at-eol 'effort-minutes 1))) - (minutes (or (and (not (equal opt '(64))) + (minutes (or (and (numberp opt) (number-to-string opt)) + (and (not (equal opt '(64))) effort-minutes (number-to-string effort-minutes)) - (and (numberp opt) (number-to-string opt)) (and (consp opt) default-timer) (and (stringp opt) opt) (read-from-minibuffer @@ -447,8 +450,7 @@ using three `C-u' prefix arguments." (setq minutes (concat minutes ":00"))) (if (not (string-match "[0-9]+" minutes)) (org-timer-show-remaining-time) - (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes))) - (hl (org-timer--get-timer-title))) + (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes)))) (if (and org-timer-countdown-timer (not (or (equal opt '(16)) (y-or-n-p "Replace current timer? ")))) diff --git a/lisp/org-version.el b/lisp/org-version.el index 145290b..12b5274 100644 --- a/lisp/org-version.el +++ b/lisp/org-version.el @@ -3,15 +3,15 @@ ;;; Code: ;;;###autoload (defun org-release () - "The release version of org-mode. - Inserted by installing org-mode or when a release is made." - (let ((org-release "8.3.4")) + "The release version of Org. +Inserted by installing Org mode or when a release is made." + (let ((org-release "9.0")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of org-mode. - Inserted by installing org-mode or when a release is made." - (let ((org-git-version "8.3.4-dist")) +Inserted by installing Org or when a release is made." + (let ((org-git-version "9.0-dist")) org-git-version)) ;;;###autoload (defvar org-odt-data-dir "/usr/share/emacs/etc/org" diff --git a/lisp/org-w3m.el b/lisp/org-w3m.el index 894dbef..2f40169 100644 --- a/lisp/org-w3m.el +++ b/lisp/org-w3m.el @@ -1,4 +1,4 @@ -;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode +;;; org-w3m.el --- Support from Copy and Paste From w3m -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. @@ -25,9 +25,9 @@ ;;; Commentary: ;; This file implements copying HTML content from a w3m buffer and -;; transforming the text on the fly so that it can be pasted into -;; an org-mode buffer with hot links. It will also work for regions -;; in gnus buffers that have been washed with w3m. +;; transforming the text on the fly so that it can be pasted into an +;; Org buffer with hot links. It will also work for regions in gnus +;; buffers that have been washed with w3m. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -35,7 +35,7 @@ ;; Richard Riley <rileyrgdev at googlemail dot com> ;; -;; The idea of transforming the HTML content with org-mode style is +;; The idea of transforming the HTML content with Org syntax is ;; proposed by Richard, I'm just coding it. ;; @@ -46,7 +46,7 @@ (defvar w3m-current-url) (defvar w3m-current-title) -(add-hook 'org-store-link-functions 'org-w3m-store-link) +(org-link-set-parameters "w3m" :store #'org-w3m-store-link) (defun org-w3m-store-link () "Store a link to a w3m buffer." (when (eq major-mode 'w3m-mode) @@ -60,7 +60,7 @@ "Copy current buffer content or active region with `org-mode' style links. This will encode `link-title' and `link-location' with `org-make-link-string', and insert the transformed test into the kill ring, -so that it can be yanked into an Org-mode buffer with links working correctly." +so that it can be yanked into an Org buffer with links working correctly." (interactive) (let* ((regionp (org-region-active-p)) (transform-start (point-min)) @@ -107,7 +107,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (concat return-content (buffer-substring (point) transform-end)))) (org-kill-new return-content) - (message "Transforming links...done, use C-y to insert text into Org-mode file") + (message "Transforming links...done, use C-y to insert text into Org file") (message "Copy with link transformation complete.")))) (defun org-w3m-get-anchor-start () diff --git a/lisp/org.el b/lisp/org.el index af68539..e2cc3ab 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1,4 +1,4 @@ -;;; org.el --- Outline-based notes management and organizer +;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*- ;; Carstens outline-mode for keeping track of everything. ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -25,23 +25,24 @@ ;; ;;; Commentary: ;; -;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing +;; Org is a mode for keeping notes, maintaining ToDo lists, and doing ;; project planning with a fast and effective plain-text system. ;; -;; Org-mode develops organizational tasks around NOTES files that contain -;; information about projects as plain text. Org-mode is implemented on -;; top of outline-mode, which makes it possible to keep the content of -;; large files well structured. Visibility cycling and structure editing -;; help to work with the tree. Tables are easily created with a built-in -;; table editor. Org-mode supports ToDo items, deadlines, time stamps, -;; and scheduling. It dynamically compiles entries into an agenda that -;; utilizes and smoothly integrates much of the Emacs calendar and diary. -;; Plain text URL-like links connect to websites, emails, Usenet -;; messages, BBDB entries, and any files related to the projects. For -;; printing and sharing of notes, an Org-mode file can be exported as a -;; structured ASCII file, as HTML, or (todo and agenda items only) as an -;; iCalendar file. It can also serve as a publishing tool for a set of -;; linked webpages. +;; Org mode develops organizational tasks around NOTES files that +;; contain information about projects as plain text. Org mode is +;; implemented on top of outline-mode, which makes it possible to keep +;; the content of large files well structured. Visibility cycling and +;; structure editing help to work with the tree. Tables are easily +;; created with a built-in table editor. Org mode supports ToDo +;; items, deadlines, time stamps, and scheduling. It dynamically +;; compiles entries into an agenda that utilizes and smoothly +;; integrates much of the Emacs calendar and diary. Plain text +;; URL-like links connect to websites, emails, Usenet messages, BBDB +;; entries, and any files related to the projects. For printing and +;; sharing of notes, an Org file can be exported as a structured ASCII +;; file, as HTML, or (todo and agenda items only) as an iCalendar +;; file. It can also serve as a publishing tool for a set of linked +;; webpages. ;; ;; Installation and Activation ;; --------------------------- @@ -51,11 +52,11 @@ ;; ;; Documentation ;; ------------- -;; The documentation of Org-mode can be found in the TeXInfo file. The +;; The documentation of Org mode can be found in the TeXInfo file. The ;; distribution also contains a PDF version of it. At the homepage of -;; Org-mode, you can read the same text online as HTML. There is also an +;; Org mode, you can read the same text online as HTML. There is also an ;; excellent reference card made by Philip Rooke. This card can be found -;; in the etc/ directory of Emacs 22. +;; in the doc/ directory. ;; ;; A list of recent changes can be found at ;; http://orgmode.org/Changes.html @@ -63,21 +64,20 @@ ;;; Code: (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param -(defvar org-table-formula-constants-local nil +(defvar-local org-table-formula-constants-local nil "Local version of `org-table-formula-constants'.") -(make-variable-buffer-local 'org-table-formula-constants-local) ;;;; Require other packages -(eval-when-compile - (require 'cl) - (require 'gnus-sum)) +(require 'cl-lib) + +(eval-when-compile (require 'gnus-sum)) (require 'calendar) (require 'find-func) (require 'format-spec) -(or (equal this-command 'eval-buffer) +(or (eq this-command 'eval-buffer) (condition-case nil (load (concat (file-name-directory load-file-name) "org-loaddefs.el") @@ -110,24 +110,17 @@ sure that we are at the beginning of the line.") "Matches a headline, putting stars and text into groups. Stars are put in group 1 and the trimmed body in group 2.") -;; Emacs 22 calendar compatibility: Make sure the new variables are available -(unless (boundp 'calendar-view-holidays-initially-flag) - (org-defvaralias 'calendar-view-holidays-initially-flag - 'view-calendar-holidays-initially)) -(unless (boundp 'calendar-view-diary-initially-flag) - (org-defvaralias 'calendar-view-diary-initially-flag - 'view-diary-entries-initially)) -(unless (boundp 'diary-fancy-buffer) - (org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer)) - +(declare-function calendar-check-holidays "holidays" (date)) (declare-function cdlatex-environment "ext:cdlatex" (environment item)) +(declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) (declare-function org-add-archive-files "org-archive" (files)) (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) -(declare-function org-agenda-list "org-agenda" (&optional arg start-day span)) +(declare-function org-agenda-list "org-agenda" + (&optional arg start-day span with-hour)) (declare-function org-agenda-redo "org-agenda" (&optional all)) -(declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body)) +(declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body) t) (declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang)) -(declare-function org-beamer-mode "ox-beamer" ()) +(declare-function org-beamer-mode "ox-beamer" (&optional prefix) t) (declare-function org-clock-get-last-clock-out-time "org-clock" ()) (declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) (declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove)) @@ -143,7 +136,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-element-contents "org-element" (element)) (declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-copy "org-element" (datum)) -(declare-function org-element-interpret-data "org-element" (data &optional parent)) +(declare-function org-element-interpret-data "org-element" (data)) (declare-function org-element-lineage "org-element" (blob &optional types with-self)) (declare-function org-element-nested-p "org-element" (elem-a elem-b)) (declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) @@ -158,12 +151,13 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) (declare-function org-plot/gnuplot "org-plot" (&optional params)) -(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (declare-function org-table-align "org-table" ()) (declare-function org-table-begin "org-table" (&optional table-type)) (declare-function org-table-beginning-of-field "org-table" (&optional n)) (declare-function org-table-blank-field "org-table" ()) (declare-function org-table-calc-current-TBLFM "org-table" (&optional arg)) +(declare-function org-table-copy-region "org-table" (beg end &optional cut)) +(declare-function org-table-cut-region "org-table" (beg end)) (declare-function org-table-edit-field "org-table" (arg)) (declare-function org-table-end "org-table" (&optional table-type)) (declare-function org-table-end-of-field "org-table" (&optional n)) @@ -173,6 +167,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-table-maybe-recalculate-line "org-table" ()) (declare-function org-table-next-row "org-table" ()) (declare-function org-table-paste-rectangle "org-table" ()) +(declare-function org-table-recalculate "org-table" (&optional all noalign)) (declare-function org-table-wrap-region "org-table" (arg)) (declare-function org-tags-view "org-agenda" (&optional todo-only match)) (declare-function orgtbl-ascii-plot "org-table" (&optional ask)) @@ -186,10 +181,12 @@ Stars are put in group 1 and the trimmed body in group 2.") "Get text property PROPERTY at the beginning of line." (get-text-property (point-at-bol) property)) -(defsubst org-trim (s) - "Remove whitespace at the beginning and the end of string S." +(defsubst org-trim (s &optional keep-lead) + "Remove whitespace at the beginning and the end of string S. +When optional argument KEEP-LEAD is non-nil, removing blank lines +at the beginning of the string does not affect leading indentation." (replace-regexp-in-string - "\\`[ \t\n\r]+" "" + (if keep-lead "\\`\\([ \t]*\n\\)+" "\\`[ \t\n\r]+") "" (replace-regexp-in-string "[ \t\n\r]+\\'" "" s))) ;; load languages based on value of `org-babel-load-languages' @@ -199,22 +196,19 @@ Stars are put in group 1 and the trimmed body in group 2.") (defun org-babel-do-load-languages (sym value) "Load the languages defined in `org-babel-load-languages'." (set-default sym value) - (mapc (lambda (pair) - (let ((active (cdr pair)) (lang (symbol-name (car pair)))) - (if active - (progn - (require (intern (concat "ob-" lang)))) - (progn - (funcall 'fmakunbound - (intern (concat "org-babel-execute:" lang))) - (funcall 'fmakunbound - (intern (concat "org-babel-expand-body:" lang))))))) - org-babel-load-languages)) + (dolist (pair org-babel-load-languages) + (let ((active (cdr pair)) (lang (symbol-name (car pair)))) + (if active + (require (intern (concat "ob-" lang))) + (funcall 'fmakunbound + (intern (concat "org-babel-execute:" lang))) + (funcall 'fmakunbound + (intern (concat "org-babel-expand-body:" lang))))))) (declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang)) ;;;###autoload (defun org-babel-load-file (file &optional compile) - "Load Emacs Lisp source code blocks in the Org-mode FILE. + "Load Emacs Lisp source code blocks in the Org FILE. This function exports the source code using `org-babel-tangle' and then loads the resulting file using `load-file'. With prefix arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp @@ -227,7 +221,7 @@ file to byte-code before it is loaded." (file-attributes file))))))) (base-name (file-name-sans-extension file)) (exported-file (concat base-name ".el"))) - ;; tangle if the org-mode file is newer than the elisp file + ;; tangle if the Org file is newer than the elisp file (unless (and (file-exists-p exported-file) (> (funcall age file) (funcall age exported-file))) ;; Tangle-file traversal returns reversed list of tangled files @@ -242,7 +236,7 @@ file to byte-code before it is loaded." exported-file))) (defcustom org-babel-load-languages '((emacs-lisp . t)) - "Languages which can be evaluated in Org-mode buffers. + "Languages which can be evaluated in Org buffers. This list can be used to load support for any of the languages below, note that each language will depend on a different set of system executables and/or Emacs modes. When a language is @@ -300,6 +294,7 @@ requirements) is loaded." (const :tag "Shen" shen) (const :tag "Sql" sql) (const :tag "Sqlite" sqlite) + (const :tag "Stan" stan) (const :tag "ebnf2ps" ebnf2ps)) :value-type (boolean :tag "Activate" :value t))) @@ -318,34 +313,37 @@ identifier." ;;;###autoload (defun org-version (&optional here full message) - "Show the org-mode version. + "Show the Org version. Interactively, or when MESSAGE is non-nil, show it in echo area. With prefix argument, or when HERE is non-nil, insert it at point. In non-interactive uses, a reduced version string is output unless FULL is given." (interactive (list current-prefix-arg t (not current-prefix-arg))) - (let* ((org-dir (ignore-errors (org-find-library-dir "org"))) - (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) - (load-suffixes (list ".el")) - (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs"))) - (org-trash (or - (and (fboundp 'org-release) (fboundp 'org-git-version)) - (org-load-noerror-mustsuffix (concat org-dir "org-version")))) - (load-suffixes save-load-suffixes) - (org-version (org-release)) - (git-version (org-git-version)) - (version (format "Org-mode version %s (%s @ %s)" - org-version - git-version - (if org-install-dir - (if (string= org-dir org-install-dir) - org-install-dir - (concat "mixed installation! " org-install-dir " and " org-dir)) - "org-loaddefs.el can not be found!"))) - (version1 (if full version org-version))) - (when here (insert version1)) - (when message (message "%s" version1)) - version1)) + (let ((org-dir (ignore-errors (org-find-library-dir "org"))) + (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) + (load-suffixes (list ".el")) + (org-install-dir + (ignore-errors (org-find-library-dir "org-loaddefs")))) + (unless (and (fboundp 'org-release) (fboundp 'org-git-version)) + (org-load-noerror-mustsuffix (concat org-dir "org-version"))) + (let* ((load-suffixes save-load-suffixes) + (release (org-release)) + (git-version (org-git-version)) + (version (format "Org mode version %s (%s @ %s)" + release + git-version + (if org-install-dir + (if (string= org-dir org-install-dir) + org-install-dir + (concat "mixed installation! " + org-install-dir + " and " + org-dir)) + "org-loaddefs.el can not be found!"))) + (version1 (if full version release))) + (when here (insert version1)) + (when message (message "%s" version1)) + version1))) (defconst org-version (org-version)) @@ -375,15 +373,17 @@ FULL is given." (defvar org-deadline-string "DEADLINE:" "String to mark deadline entries. -A deadline is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-deadline].") +\\<org-mode-map> +A deadline is this string, followed by a time stamp. It must be +a word, terminated by a colon. You can insert a schedule keyword +and a timestamp with `\\[org-deadline]'.") (defvar org-scheduled-string "SCHEDULED:" "String to mark scheduled TODO entries. -A schedule is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-schedule].") +\\<org-mode-map> +A schedule is this string, followed by a time stamp. It must be +a word, terminated by a colon. You can insert a schedule keyword +and a timestamp with `\\[org-schedule]'.") (defconst org-ds-keyword-length (+ 2 @@ -524,8 +524,9 @@ not contribute to the agenda listings.") (defconst org-comment-string "COMMENT" "Entries starting with this keyword will never be exported. +\\<org-mode-map> An entry can be toggled between COMMENT and normal with -\\[org-toggle-comment].") +`\\[org-toggle-comment]'.") ;;;; LaTeX Environments and Fragments @@ -633,7 +634,7 @@ After a match, group 1 contains the repeat expression.") :group 'calendar) (defcustom org-mode-hook nil - "Mode hook for Org-mode, run after the mode was turned on." + "Mode hook for Org mode, run after the mode was turned on." :group 'org :type 'hook) @@ -655,10 +656,9 @@ After a match, group 1 contains the repeat expression.") (defun org-load-modules-maybe (&optional force) "Load all extensions listed in `org-modules'." (when (or force (not org-modules-loaded)) - (mapc (lambda (ext) - (condition-case nil (require ext) - (error (message "Problems while trying to load feature `%s'" ext)))) - org-modules) + (dolist (ext org-modules) + (condition-case nil (require ext) + (error (message "Problems while trying to load feature `%s'" ext)))) (setq org-modules-loaded t))) (defun org-set-modules (var value) @@ -694,6 +694,7 @@ For export specific modules, see also `org-export-backends'." (const :tag " crypt: Encryption of subtrees" org-crypt) (const :tag " ctags: Access to Emacs tags with links" org-ctags) (const :tag " docview: Links to doc-view buffers" org-docview) + (const :tag " eww: Store link to url of eww" org-eww) (const :tag " gnus: Links to GNUS folders/messages" org-gnus) (const :tag " habit: Track your consistency with habits" org-habit) (const :tag " id: Global IDs for identifying entries" org-id) @@ -704,41 +705,40 @@ For export specific modules, see also `org-export-backends'." (const :tag " mouse: Additional mouse support" org-mouse) (const :tag " protocol: Intercept calls from emacsclient" org-protocol) (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) - (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) + (const :tag " w3m: Special cut/paste from w3m to Org mode." org-w3m) (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) - (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark) + (const :tag "C bookmark: Org links to bookmarks" org-bookmark) (const :tag "C bullets: Add overlays to headlines stars" org-bullets) (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) (const :tag "C collector: Collect properties into tables" org-collector) - (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) - (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill) - (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol) + (const :tag "C depend: TODO dependencies for Org mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) + (const :tag "C drill: Flashcards and spaced repetition for Org mode" org-drill) + (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol) (const :tag "C eshell Support for links to working directories in eshell" org-eshell) (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) (const :tag "C eval: Include command output as text" org-eval) - (const :tag "C eww: Store link to url of eww" org-eww) - (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry) + (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry) (const :tag "C favtable: Lookup table of favorite references and links" org-favtable) (const :tag "C git-link: Provide org links to specific file version" org-git-link) (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query) - (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice) + (const :tag "C invoice: Help manage client invoices in Org mode" org-invoice) (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link) - (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) - (const :tag "C man: Support for links to manpages in Org-mode" org-man) + (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix) + (const :tag "C man: Support for links to manpages in Org mode" org-man) (const :tag "C mew: Links to Mew folders/messages" org-mew) (const :tag "C mtags: Support for muse-like tags" org-mtags) (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch) (const :tag "C panel: Simple routines for us with bad memory" org-panel) - (const :tag "C registry: A registry for Org-mode links" org-registry) - (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) + (const :tag "C registry: A registry for Org links" org-registry) + (const :tag "C screen: Visit screen sessions through Org links" org-screen) (const :tag "C secretary: Team management with org-mode" org-secretary) - (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) - (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) - (const :tag "C track: Keep up with Org-mode development" org-track) + (const :tag "C sqlinsert: Convert Org tables to SQL insertions" orgtbl-sqlinsert) + (const :tag "C toc: Table of contents for Org buffer" org-toc) + (const :tag "C track: Keep up with Org mode development" org-track) (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) (const :tag "C vm: Links to VM folders/messages" org-vm) (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes) @@ -747,8 +747,8 @@ For export specific modules, see also `org-export-backends'." (defvar org-export-registered-backends) ; From ox.el. (declare-function org-export-derived-backend-p "ox" (backend &rest backends)) -(declare-function org-export-backend-name "ox" (backend)) -(defcustom org-export-backends '(ascii html icalendar latex) +(declare-function org-export-backend-name "ox" (backend) t) +(defcustom org-export-backends '(ascii html icalendar latex odt) "List of export back-ends that should be always available. If a description starts with <C>, the file is not part of Emacs @@ -766,7 +766,7 @@ value of the variable, after updating it: (progn (setq org-export-registered-backends - (org-remove-if-not + (cl-remove-if-not (lambda (backend) (let ((name (org-export-backend-name backend))) (or (memq name val) @@ -789,8 +789,8 @@ Adding a back-end to this list will also pull the back-end it depends on, if any." :group 'org :group 'org-export - :version "24.4" - :package-version '(Org . "8.0") + :version "25.2" + :package-version '(Org . "9.0") :initialize 'custom-initialize-set :set (lambda (var val) (if (not (featurep 'ox)) (set-default var val) @@ -798,7 +798,7 @@ depends on, if any." ;; a parent of any back-end in the new value) is removed from the ;; list of registered back-ends. (setq org-export-registered-backends - (org-remove-if-not + (cl-remove-if-not (lambda (backend) (let ((name (org-export-backend-name backend))) (or (memq name val) @@ -840,12 +840,10 @@ depends on, if any." (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler))) (eval-after-load 'ox - '(mapc - (lambda (backend) - (condition-case nil (require (intern (format "ox-%s" backend))) - (error (message "Problems while trying to load export back-end `%s'" - backend)))) - org-export-backends)) + '(dolist (backend org-export-backends) + (condition-case nil (require (intern (format "ox-%s" backend))) + (error (message "Problems while trying to load export back-end `%s'" + backend))))) (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. @@ -853,7 +851,7 @@ depends on, if any." In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start selecting a region, or enlarge regions started in this way. -In Org-mode, in special contexts, these same keys are used for +In Org mode, in special contexts, these same keys are used for other purposes, important enough to compete with shift selection. Org tries to balance these needs by supporting `shift-select-mode' outside these special contexts, under control of this variable. @@ -868,7 +866,7 @@ cursor keys will then execute Org commands in the following contexts: Outside these contexts, the commands will throw an error. When this variable is t and the cursor is not in a special -context, Org-mode will support shift-selection for making and +context, Org mode will support shift-selection for making and enlarging regions. To make this more effective, the bullet cycling will no longer happen anywhere in an item line, but only if the cursor is exactly on the bullet. @@ -885,10 +883,7 @@ can be used to switch TODO sets, and properties can be edited by hand or in column view. However, when the cursor is on a timestamp, shift-cursor commands -will still edit the time stamp - this is just too good to give up. - -XEmacs user should have this variable set to nil, because -`shift-select-mode' is in Emacs 23 or later only." +will still edit the time stamp - this is just too good to give up." :group 'org :type '(choice (const :tag "Never" nil) @@ -922,12 +917,12 @@ already archived entries." :group 'org-archive) (defgroup org-startup nil - "Options concerning startup of Org-mode." + "Options concerning startup of Org mode." :tag "Org Startup" :group 'org) (defcustom org-startup-folded t - "Non-nil means entering Org-mode will switch to OVERVIEW. + "Non-nil means entering Org mode will switch to OVERVIEW. This can also be configured on a per-file basis by adding one of the following lines anywhere in the buffer: @@ -947,9 +942,18 @@ option, set `org-agenda-inhibit-startup' to nil." (const :tag "show everything, even drawers" showeverything))) (defcustom org-startup-truncated t - "Non-nil means entering Org-mode will set `truncate-lines'. + "Non-nil means entering Org mode will set `truncate-lines'. This is useful since some lines containing links can be very long and -uninteresting. Also tables look terrible when wrapped." +uninteresting. Also tables look terrible when wrapped. + +The variable `org-startup-truncated' allows to configure +truncation for Org mode different to the other modes that use the +variable `truncate-lines' and as a shortcut instead of putting +the variable `truncate-lines' into the `org-mode-hook'. If one +wants to configure truncation for Org mode not statically but +dynamically e. g. in a hook like `ediff-prepare-buffer-hook' then +the variable `truncate-lines' has to be used because in such a +case it is too late to set the variable `org-startup-truncated'." :group 'org-startup :type 'boolean) @@ -1042,26 +1046,26 @@ the following lines anywhere in the buffer: :type 'boolean) (defcustom org-insert-mode-line-in-empty-file nil - "Non-nil means insert the first line setting Org-mode in empty files. + "Non-nil means insert the first line setting Org mode in empty files. When the function `org-mode' is called interactively in an empty file, this -normally means that the file name does not automatically trigger Org-mode. -To ensure that the file will always be in Org-mode in the future, a -line enforcing Org-mode will be inserted into the buffer, if this option +normally means that the file name does not automatically trigger Org mode. +To ensure that the file will always be in Org mode in the future, a +line enforcing Org mode will be inserted into the buffer, if this option has been set." :group 'org-startup :type 'boolean) (defcustom org-replace-disputed-keys nil "Non-nil means use alternative key bindings for some keys. -Org-mode uses S-<cursor> keys for changing timestamps and priorities. +Org mode uses S-<cursor> keys for changing timestamps and priorities. These keys are also used by other packages like shift-selection-mode' \(built into Emacs 23), `CUA-mode' or `windmove.el'. -If you want to use Org-mode together with one of these other modes, -or more generally if you would like to move some Org-mode commands to +If you want to use Org mode together with one of these other modes, +or more generally if you would like to move some Org mode commands to other keys, set this variable and configure the keys with the variable `org-disputed-keys'. -This option is only relevant at load-time of Org-mode, and must be set +This option is only relevant at load-time of Org mode, and must be set *before* org.el is loaded. Changing it requires a restart of Emacs to become effective." :group 'org-startup @@ -1069,18 +1073,13 @@ become effective." (defcustom org-use-extra-keys nil "Non-nil means use extra key sequence definitions for certain commands. -This happens automatically if you run XEmacs or if `window-system' -is nil. This variable lets you do the same manually. You must -set it before loading org. - -Example: on Carbon Emacs 22 running graphically, with an external -keyboard on a Powerbook, the default way of setting M-left might -not work for either Alt or ESC. Setting this variable will make -it work for ESC." +This happens automatically if `window-system' is nil. This +variable lets you do the same manually. You must set it before +loading Org." :group 'org-startup :type 'boolean) -(org-defvaralias 'org-CUA-compatible 'org-replace-disputed-keys) +(defvaralias 'org-CUA-compatible 'org-replace-disputed-keys) (defcustom org-disputed-keys '(([(shift up)] . [(meta p)]) @@ -1089,59 +1088,49 @@ it work for ESC." ([(shift right)] . [(meta +)]) ([(control shift right)] . [(meta shift +)]) ([(control shift left)] . [(meta shift -)])) - "Keys for which Org-mode and other modes compete. + "Keys for which Org mode and other modes compete. This is an alist, cars are the default keys, second element specifies the alternative to use when `org-replace-disputed-keys' is t. Keys can be specified in any syntax supported by `define-key'. -The value of this option takes effect only at Org-mode's startup, +The value of this option takes effect only at Org mode startup, therefore you'll have to restart Emacs to apply it after changing." :group 'org-startup :type 'alist) (defun org-key (key) "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. -Or return the original if not disputed. -Also apply the translations defined in `org-xemacs-key-equivalents'." +Or return the original if not disputed." (when org-replace-disputed-keys (let* ((nkey (key-description key)) - (x (org-find-if (lambda (x) - (equal (key-description (car x)) nkey)) - org-disputed-keys))) + (x (cl-find-if (lambda (x) (equal (key-description (car x)) nkey)) + org-disputed-keys))) (setq key (if x (cdr x) key)))) - (when (featurep 'xemacs) - (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key))) key) -(defun org-find-if (predicate seq) - (catch 'exit - (while seq - (if (funcall predicate (car seq)) - (throw 'exit (car seq)) - (pop seq))))) - (defun org-defkey (keymap key def) "Define a key, possibly translated, as returned by `org-key'." (define-key keymap (org-key key) def)) (defcustom org-ellipsis nil - "The ellipsis to use in the Org-mode outline. + "The ellipsis to use in the Org mode outline. + When nil, just use the standard three dots. When a string, use that string instead. -When a face, use the standard 3 dots, but with the specified face. -The change affects only Org-mode (which will then use its own display table). -Changing this requires executing \\[org-mode] in a buffer to become + +The change affects only Org mode (which will then use its own display table). +Changing this requires executing `\\[org-mode]' in a buffer to become effective." :group 'org-startup :type '(choice (const :tag "Default" nil) - (face :tag "Face" :value org-warning) - (string :tag "String" :value "...#"))) + (string :tag "String" :value "...#")) + :safe #'string-or-null-p) (defvar org-display-table nil "The display table for org-mode, in case `org-ellipsis' is non-nil.") (defgroup org-keywords nil - "Keywords in Org-mode." + "Keywords in Org mode." :tag "Org Keywords" :group 'org) @@ -1154,7 +1143,7 @@ effective." :type 'boolean) (defgroup org-structure nil - "Options concerning the general structure of Org-mode files." + "Options concerning the general structure of Org files." :tag "Org Structure" :group 'org) @@ -1163,8 +1152,9 @@ effective." :tag "Org Reveal Location" :group 'org-structure) -(defcustom org-show-context-detail '((isearch . lineage) +(defcustom org-show-context-detail '((agenda . local) (bookmark-jump . lineage) + (isearch . lineage) (default . ancestors)) "Alist between context and visibility span when revealing a location. @@ -1174,8 +1164,8 @@ around point. How much is shown depends on the initial action, or context. Valid contexts are agenda when exposing an entry from the agenda - org-goto when using the command `org-goto' (\\[org-goto]) - occur-tree when using the command `org-occur' (\\[org-sparse-tree] /) + org-goto when using the command `org-goto' (`\\[org-goto]') + occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /') tags-tree when constructing a sparse tree based on tags matches link-search when exposing search matches associated with a link mark-goto when exposing the jump goal of a mark @@ -1210,11 +1200,11 @@ As special cases, a nil or t value means show all contexts in Some views can make displayed information very compact, but also make it harder to edit the location of the match. In such -a case, use the command `org-reveal' (\\[org-reveal]) to show +a case, use the command `org-reveal' (`\\[org-reveal]') to show more context." :group 'org-reveal-location - :version "25.1" - :package-version '(Org . "8.3") + :version "25.2" + :package-version '(Org . "9.0") :type '(choice (const :tag "Canonical" t) (const :tag "Minimal" nil) @@ -1240,8 +1230,10 @@ more context." (defcustom org-indirect-buffer-display 'other-window "How should indirect tree buffers be displayed? + This applies to indirect buffers created with the commands -\\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer]. +`org-tree-to-indirect-buffer' and `org-agenda-tree-to-indirect-buffer'. + Valid values are: current-window Display in the current window other-window Just display in another window. @@ -1311,7 +1303,7 @@ is not set." :type 'plist) (defgroup org-cycle nil - "Options concerning visibility cycling in Org-mode." + "Options concerning visibility cycling in Org mode." :tag "Org Cycle" :group 'org-structure) @@ -1336,7 +1328,7 @@ than its value." (integer :tag "Maximum level"))) (defcustom org-hide-block-startup nil - "Non-nil means entering Org-mode will fold all blocks. + "Non-nil means entering Org mode will fold all blocks. This can also be set in on a per-file basis with #+STARTUP: hideblocks @@ -1347,12 +1339,17 @@ This can also be set in on a per-file basis with (defcustom org-cycle-global-at-bob nil "Cycle globally if cursor is at beginning of buffer and not at a headline. -This makes it possible to do global cycling without having to use S-TAB or -\\[universal-argument] TAB. For this special case to work, the first line -of the buffer must not be a headline -- it may be empty or some other text. + +This makes it possible to do global cycling without having to use `S-TAB' +or `\\[universal-argument] TAB'. For this special case to work, the first \ +line of the buffer +must not be a headline -- it may be empty or some other text. + When used in this way, `org-cycle-hook' is disabled temporarily to make -sure the cursor stays at the beginning of the buffer. When this option is -nil, don't do anything special at the beginning of the buffer." +sure the cursor stays at the beginning of the buffer. + +When this option is nil, don't do anything special at the beginning of +the buffer." :group 'org-cycle :type 'boolean) @@ -1391,7 +1388,7 @@ visibility is cycled." "Number of empty lines needed to keep an empty line between collapsed trees. If you leave an empty line between the end of a subtree and the following headline, this empty line is hidden when the subtree is folded. -Org-mode will leave (exactly) one empty line visible if the number of +Org mode will leave (exactly) one empty line visible if the number of empty lines is equal or larger to the number given in this variable. So the default 2 means at least 2 empty lines after the end of a subtree are needed to produce free space between a collapsed subtree and the @@ -1427,11 +1424,11 @@ argument is a symbol. After a global state change, it can have the values the values `folded', `children', or `subtree'." :group 'org-cycle :type 'hook - :version "25.1" + :version "25.2" :package-version '(Org . "8.3")) (defgroup org-edit-structure nil - "Options concerning structure editing in Org-mode." + "Options concerning structure editing in Org mode." :tag "Org Edit Structure" :group 'org-structure) @@ -1514,7 +1511,7 @@ This may also be a cons cell where the behavior for `C-a' and (const :tag "off" nil) (const :tag "on: before tags first" t) (const :tag "reversed: after tags first" reversed))))) -(org-defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) +(defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) (defcustom org-special-ctrl-k nil "Non-nil means `C-k' will behave specially in headlines. @@ -1614,9 +1611,11 @@ default the value to be used for all contexts not explicitly (defcustom org-insert-heading-respect-content nil "Non-nil means insert new headings after the current subtree. +\\<org-mode-map> When nil, the new heading is created directly after the current line. -The commands \\[org-insert-heading-respect-content] and \\[org-insert-todo-heading-respect-content] turn -this variable on for the duration of the command." +The commands `\\[org-insert-heading-respect-content]' and \ +`\\[org-insert-todo-heading-respect-content]' turn this variable on +for the duration of the command." :group 'org-structure :type 'boolean) @@ -1626,11 +1625,7 @@ this variable on for the duration of the command." The value is an alist, with `heading' and `plain-list-item' as CAR, and a boolean flag as CDR. The cdr may also be the symbol `auto', in which case Org will look at the surrounding headings/items and try to -make an intelligent decision whether to insert a blank line or not. - -For plain lists, if `org-list-empty-line-terminates-plain-lists' is set, -the setting here is ignored and no empty line is inserted to avoid breaking -the list structure." +make an intelligent decision whether to insert a blank line or not." :group 'org-edit-structure :type '(list (cons (const heading) @@ -1668,7 +1663,7 @@ When nil, you can use these keybindings to navigate the buffer: :type 'boolean) (defgroup org-sparse-trees nil - "Options concerning sparse trees in Org-mode." + "Options concerning sparse trees in Org mode." :tag "Org Sparse Trees" :group 'org-structure) @@ -1691,6 +1686,16 @@ The highlights created by `org-toggle-latex-fragment' always need :group 'org-time :type 'boolean) +(defcustom org-occur-case-fold-search t + "Non-nil means `org-occur' should be case-insensitive. +If set to `smart' the search will be case-insensitive only if it +doesn't specify any upper case character." + :group 'org-sparse-trees + :version "25.2" + :type '(choice + (const :tag "Case-sensitive" nil) + (const :tag "Case-insensitive" t) + (const :tag "Case-insensitive for lower case searches only" 'smart))) (defcustom org-occur-hook '(org-first-headline-recenter) "Hook that is run after `org-occur' has constructed a sparse tree. @@ -1700,18 +1705,18 @@ as possible." :type 'hook) (defgroup org-imenu-and-speedbar nil - "Options concerning imenu and speedbar in Org-mode." + "Options concerning imenu and speedbar in Org mode." :tag "Org Imenu and Speedbar" :group 'org-structure) (defcustom org-imenu-depth 2 - "The maximum level for Imenu access to Org-mode headlines. + "The maximum level for Imenu access to Org headlines. This also applied for speedbar access." :group 'org-imenu-and-speedbar :type 'integer) (defgroup org-table nil - "Options concerning tables in Org-mode." + "Options concerning tables in Org mode." :tag "Org Table" :group 'org) @@ -1728,12 +1733,12 @@ do the following: TAB or RET are pressed to move to another field. With optimization this happens only if changes to a field might have changed the column width. Optimization requires replacing the functions `self-insert-command', -`delete-char', and `backward-delete-char' in Org-mode buffers, with a -slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is -very good at guessing when a re-align will be necessary, but you can always -force one with \\[org-ctrl-c-ctrl-c]. +`delete-char', and `backward-delete-char' in Org buffers, with a +slight (in fact: unnoticeable) speed impact for normal typing. Org is very +good at guessing when a re-align will be necessary, but you can always +force one with `\\[org-ctrl-c-ctrl-c]'. -If you would like to use the optimized version in Org-mode, but the +If you would like to use the optimized version in Org mode, but the un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. This variable can be used to turn on and off the table editor during a session, @@ -1746,8 +1751,7 @@ See also the variable `org-table-auto-blank-field'." (const :tag "on" t) (const :tag "on, optimized" optimized))) -(defcustom org-self-insert-cluster-for-undo (or (featurep 'xemacs) - (version<= emacs-version "24.1")) +(defcustom org-self-insert-cluster-for-undo nil "Non-nil means cluster self-insert commands for undo when possible. If this is set, then, like in the Emacs command loop, 20 consecutive characters will be undone together. @@ -1763,24 +1767,95 @@ calls `table-recognize-table'." :type 'boolean) (defgroup org-link nil - "Options concerning links in Org-mode." + "Options concerning links in Org mode." :tag "Org Link" :group 'org) -(defvar org-link-abbrev-alist-local nil +(defvar-local org-link-abbrev-alist-local nil "Buffer-local version of `org-link-abbrev-alist', which see. The value of this is taken from the #+LINK lines.") -(make-variable-buffer-local 'org-link-abbrev-alist-local) + +(defcustom org-link-parameters + '(("doi" :follow org--open-doi-link) + ("elisp" :follow org--open-elisp-link) + ("file" :complete org-file-complete-link) + ("ftp" :follow (lambda (path) (browse-url (concat "ftp:" path)))) + ("help" :follow org--open-help-link) + ("http" :follow (lambda (path) (browse-url (concat "http:" path)))) + ("https" :follow (lambda (path) (browse-url (concat "https:" path)))) + ("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path)))) + ("message" :follow (lambda (path) (browse-url (concat "message:" path)))) + ("news" :follow (lambda (path) (browse-url (concat "news:" path)))) + ("shell" :follow org--open-shell-link)) + "An alist of properties that defines all the links in Org mode. +The key in each association is a string of the link type. +Subsequent optional elements make up a p-list of link properties. + +:follow - A function that takes the link path as an argument. + +:export - A function that takes the link path, description and +export-backend as arguments. + +:store - A function responsible for storing the link. See the +function `org-store-link-functions'. + +:complete - A function that inserts a link with completion. The +function takes one optional prefix arg. + +:face - A face for the link, or a function that returns a face. +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'. + +:display - `full' will not fold the link in descriptive +display. Default is `org-link'. + +:help-echo - A string or function that takes (window object position) +as arguments and returns a string. + +:keymap - A keymap that is active on the link. The default is +`org-mouse-map'. + +:htmlize-link - A function for the htmlize-link. Defaults +to (list :uri \"type:path\") + +:activate-func - A function to run at the end of font-lock +activation. The function must accept (link-start link-end path bracketp) +as arguments." + :group 'org-link + :type '(alist :tag "Link display parameters" + :value-type plist)) + +(defun org-link-get-parameter (type key) + "Get TYPE link property for KEY. +TYPE is a string and KEY is a plist keyword." + (plist-get + (cdr (assoc type org-link-parameters)) + key)) + +(defun org-link-set-parameters (type &rest parameters) + "Set link TYPE properties to PARAMETERS. + PARAMETERS should be :key val pairs." + (let ((data (assoc type org-link-parameters))) + (if data (setcdr data (org-combine-plists (cdr data) parameters)) + (push (cons type parameters) org-link-parameters) + (org-make-link-regexps) + (org-element-update-syntax)))) + +(defun org-link-types () + "Return a list of known link types." + (mapcar #'car org-link-parameters)) (defcustom org-link-abbrev-alist nil "Alist of link abbreviations. The car of each element is a string, to be replaced at the start of a link. The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated -links in Org-mode buffers can have an optional tag after a double colon, e.g. +links in Org buffers can have an optional tag after a double colon, e.g., [[linkkey:tag][description]] -The `linkkey' must be a word word, starting with a letter, followed +The `linkkey' must be a single word, starting with a letter, followed by letters, numbers, `-' or `_'. If REPLACE is a string, the tag will simply be appended to create the link. @@ -1834,7 +1909,7 @@ adaptive Use relative path for files in the current directory and sub- (defvaralias 'org-activate-links 'org-highlight-links) (defcustom org-highlight-links '(bracket angle plain radio tag date footnote) - "Types of links that should be highlighted in Org-mode files. + "Types of links that should be highlighted in Org files. This is a list of symbols, each one of them leading to the highlighting of a certain link type. @@ -1877,7 +1952,7 @@ return the description to use." :type '(choice (const nil) (function))) (defgroup org-link-store nil - "Options concerning storing links in Org-mode." + "Options concerning storing links in Org mode." :tag "Org Store Link" :group 'org-link) @@ -1922,32 +1997,36 @@ It should match if the message is from the user him/herself." (defcustom org-context-in-file-links t "Non-nil means file links from `org-store-link' contain context. -A search string will be added to the file name with :: as separator and -used to find the context when the link is activated by the command +\\<org-mode-map> +A search string will be added to the file name with :: as separator +and used to find the context when the link is activated by the command `org-open-at-point'. When this option is t, the entire active region will be placed in the search string of the file link. If set to a positive integer, only the first n lines of context will be stored. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') +Using a prefix arg to the command `org-store-link' (`\\[universal-argument] \ +\\[org-store-link]') negates this setting for the duration of the command." :group 'org-link-store :type '(choice boolean integer)) (defcustom org-keep-stored-link-after-insertion nil "Non-nil means keep link in list for entire session. - +\\<org-mode-map> The command `org-store-link' adds a link pointing to the current location to an internal list. These links accumulate during a session. The command `org-insert-link' can be used to insert links into any -Org-mode file (offering completion for all stored links). When this -option is nil, every link which has been inserted once using \\[org-insert-link] -will be removed from the list, to make completing the unused links -more efficient." +Org file (offering completion for all stored links). + +When this option is nil, every link which has been inserted once using +`\\[org-insert-link]' will be removed from the list, to make completing the \ +unused +links more efficient." :group 'org-link-store :type 'boolean) (defgroup org-link-follow nil - "Options concerning following links in Org-mode." + "Options concerning following links in Org mode." :tag "Org Follow Link" :group 'org-link) @@ -1987,8 +2066,8 @@ In tables, the special behavior of RET has precedence." (defcustom org-mouse-1-follows-link (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) "Non-nil means mouse-1 on a link will follow the link. -A longer mouse click will still set point. Does not work on XEmacs. -Needs to be set before org.el is loaded." +A longer mouse click will still set point. Needs to be set +before org.el is loaded." :group 'org-link-follow :version "24.4" :package-version '(Org . "8.3") @@ -2074,7 +2153,7 @@ another window." "Non-nil means use indirect buffer to display infile links. Activating internal links (from one location in a file to another location in the same file) normally just jumps to the location. When the link is -activated with a \\[universal-argument] prefix (or with mouse-3), the link \ +activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \ is displayed in another window. When this option is set, the other window actually displays an indirect buffer clone of the current buffer, to avoid any visibility @@ -2104,7 +2183,7 @@ Shell links can be dangerous: just think about a link [[shell:rm -rf ~/*][Google Search]] -This link would show up in your Org-mode document as \"Google Search\", +This link would show up in your Org document as \"Google Search\", but really it would remove your entire home directory. Therefore we advise against setting this variable to nil. Just change it to `y-or-n-p' if you want to confirm with a @@ -2130,7 +2209,7 @@ Elisp links can be dangerous: just think about a link [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] -This link would show up in your Org-mode document as \"Google Search\", +This link would show up in your Org document as \"Google Search\", but really it would remove your entire home directory. Therefore we advise against setting this variable to nil. Just change it to `y-or-n-p' if you want to confirm with a @@ -2159,30 +2238,23 @@ See `org-file-apps'.") (defconst org-file-apps-defaults-macosx '((remote . emacs) - (t . "open %s") (system . "open %s") ("ps.gz" . "gv %s") ("eps.gz" . "gv %s") ("dvi" . "xdvi %s") - ("fig" . "xfig %s")) + ("fig" . "xfig %s") + (t . "open %s")) "Default file applications on a MacOS X system. The system \"open\" is known as a default, but we use X11 applications for some files for which the OS does not have a good default. See `org-file-apps'.") (defconst org-file-apps-defaults-windowsnt - (list - '(remote . emacs) - (cons t - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file)) - (cons 'system - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file))) + (list '(remote . emacs) + (cons 'system (lambda (file _path) + (with-no-warnings (w32-shell-execute "open" file)))) + (cons t (lambda (file _path) + (with-no-warnings (w32-shell-execute "open" file))))) "Default file applications on a Windows NT system. The system \"open\" is used for most files. See `org-file-apps'.") @@ -2193,11 +2265,15 @@ See `org-file-apps'.") ("\\.x?html?\\'" . default) ("\\.pdf\\'" . default)) "External applications for opening `file:path' items in a document. -Org-mode uses system defaults for different file types, but +\\<org-mode-map>\ + +Org mode uses system defaults for different file types, but you can use this variable to set the application for a given file extension. The entries in this list are cons cells where the car identifies -files and the cdr the corresponding command. Possible values for the -file identifier are +files and the cdr the corresponding command. + +Possible values for the file identifier are: + \"string\" A string as a file identifier can be interpreted in different ways, depending on its contents: @@ -2210,8 +2286,8 @@ file identifier are filename matches the regexp. If you want to use groups here, use shy groups. - Example: (\"\\.x?html\\\\='\" . \"firefox %s\") - (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\") + Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\") + (\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\") to open *.html and *.xhtml with firefox. - Regular expression which contains (non-shy) groups: @@ -2223,10 +2299,11 @@ file identifier are that does not use any of the group matches, this case is handled identically to the second one (i.e. match against file name only). - In a custom lisp form, you can access the group matches with + In a custom function, you can access the group matches with (match-string n link). - Example: (\"\\.pdf::\\(\\d+\\)\\\\='\" . \"evince -p %1 %s\") + Example: (\"\\\\.pdf::\\\\(\\\\d+\\\\)\\\\\\='\" . \ +\"evince -p %1 %s\") to open [[file:document.pdf::5]] with evince at page 5. `directory' Matches a directory @@ -2238,28 +2315,32 @@ file identifier are command `emacs' will open most files in Emacs. Beware that this will also open html files inside Emacs, unless you add (\"html\" . default) to the list as well. - t Default for files not matched by any of the other options. `system' The system command to open files, like `open' on Windows and Mac OS X, and mailcap under GNU/Linux. This is the command - that will be selected if you call `C-c C-o' with a double - \\[universal-argument] \\[universal-argument] prefix. + that will be selected if you call `org-open-at-point' with a + double prefix argument (`\\[universal-argument] \ +\\[universal-argument] \\[org-open-at-point]'). + t Default for files not matched by any of the other options. Possible values for the command are: + `emacs' The file will be visited by the current Emacs process. `default' Use the default application for this file type, which is the association for t in the list, most likely in the system-specific - part. - This can be used to overrule an unwanted setting in the + part. This can be used to overrule an unwanted setting in the system-specific variable. `system' Use the system command for opening files, like \"open\". This command is specified by the entry whose car is `system'. Most likely, the system-specific version of this variable does define this command, but you can overrule/replace it here. +`mailcap' Use command specified in the mailcaps. string A command to be executed by a shell; %s will be replaced by the path to the file. - sexp A Lisp form which will be evaluated. The file path will - be available in the Lisp variable `file'. + function A Lisp function, which will be called with two arguments: + the file path and the original link string, without the + \"file:\" prefix. + For more examples, see the system specific constants `org-file-apps-defaults-macosx' `org-file-apps-defaults-windowsnt' @@ -2279,7 +2360,7 @@ For more examples, see the system specific constants (const :tag "Use default" default) (const :tag "Use the system command" system) (string :tag "Command") - (sexp :tag "Lisp form"))))) + (function :tag "Function"))))) (defcustom org-doi-server-url "http://dx.doi.org/" "The URL of the DOI server." @@ -2288,7 +2369,7 @@ For more examples, see the system specific constants :group 'org-link-follow) (defgroup org-refile nil - "Options concerning refiling entries in Org-mode." + "Options concerning refiling entries in Org mode." :tag "Org Refile" :group 'org) @@ -2377,7 +2458,7 @@ will temporarily be changed to `time'." (const :tag "Record timestamp with note." note))) (defcustom org-refile-targets nil - "Targets for refiling entries with \\[org-refile]. + "Targets for refiling entries with `\\[org-refile]'. This is a list of cons cells. Each cell contains: - a specification of the files to be considered, either a list of files, or a symbol whose function or variable value will be used to retrieve @@ -2472,13 +2553,13 @@ When `full-file-path', include the full file path." (defcustom org-outline-path-complete-in-steps t "Non-nil means complete the outline path in hierarchical steps. -When Org-mode uses the refile interface to select an outline path -\(see variable `org-refile-use-outline-path'), the completion of -the path can be done in a single go, or it can be done in steps down -the headline hierarchy. Going in steps is probably the best if you -do not use a special completion package like `ido' or `icicles'. -However, when using these packages, going in one step can be very -fast, while still showing the whole path to the entry." +When Org uses the refile interface to select an outline path (see +`org-refile-use-outline-path'), the completion of the path can be +done in a single go, or it can be done in steps down the headline +hierarchy. Going in steps is probably the best if you do not use +a special completion package like `ido' or `icicles'. However, +when using these packages, going in one step can be very fast, +while still showing the whole path to the entry." :group 'org-refile :type 'boolean) @@ -2511,12 +2592,12 @@ converted to a headline before refiling." :type 'boolean) (defgroup org-todo nil - "Options concerning TODO items in Org-mode." + "Options concerning TODO items in Org mode." :tag "Org TODO" :group 'org) (defgroup org-progress nil - "Options concerning Progress logging in Org-mode." + "Options concerning Progress logging in Org mode." :tag "Org Progress" :group 'org-time) @@ -2534,12 +2615,12 @@ Each sequence starts with a symbol, either `sequence' or `type', indicating if the keywords should be interpreted as a sequence of action steps, or as different types of TODO items. The first keywords are states requiring action - these states will select a headline -for inclusion into the global TODO list Org-mode produces. If one of -the \"keywords\" is the vertical bar, \"|\", the remaining keywords +for inclusion into the global TODO list Org produces. If one of the +\"keywords\" is the vertical bar, \"|\", the remaining keywords signify that no further action is necessary. If \"|\" is not found, the last keyword is treated as the only DONE state of the sequence. -The command \\[org-todo] cycles an entry through these states, and one +The command `\\[org-todo]' cycles an entry through these states, and one additional state where no keyword is present. For details about this cycling, see the manual. @@ -2590,9 +2671,8 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'." (repeat (string :tag "Keyword")))))) -(defvar org-todo-keywords-1 nil +(defvar-local org-todo-keywords-1 nil "All TODO and DONE keywords active in a buffer.") -(make-variable-buffer-local 'org-todo-keywords-1) (defvar org-todo-keywords-for-agenda nil) (defvar org-done-keywords-for-agenda nil) (defvar org-todo-keyword-alist-for-agenda nil) @@ -2600,25 +2680,20 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'." "Alist of all tags from all agenda files.") (defvar org-tag-groups-alist-for-agenda nil "Alist of all groups tags from all current agenda files.") -(defvar org-tag-groups-alist nil) -(make-variable-buffer-local 'org-tag-groups-alist) +(defvar-local org-tag-groups-alist nil) (defvar org-agenda-contributing-files nil) -(defvar org-not-done-keywords nil) -(make-variable-buffer-local 'org-not-done-keywords) -(defvar org-done-keywords nil) -(make-variable-buffer-local 'org-done-keywords) -(defvar org-todo-heads nil) -(make-variable-buffer-local 'org-todo-heads) -(defvar org-todo-sets nil) -(make-variable-buffer-local 'org-todo-sets) -(defvar org-todo-log-states nil) -(make-variable-buffer-local 'org-todo-log-states) -(defvar org-todo-kwd-alist nil) -(make-variable-buffer-local 'org-todo-kwd-alist) -(defvar org-todo-key-alist nil) -(make-variable-buffer-local 'org-todo-key-alist) -(defvar org-todo-key-trigger nil) -(make-variable-buffer-local 'org-todo-key-trigger) +(defvar-local org-current-tag-alist nil + "Alist of all tag groups in current buffer. +This variable takes into consideration `org-tag-alist', +`org-tag-persistent-alist' and TAGS keywords in the buffer.") +(defvar-local org-not-done-keywords nil) +(defvar-local org-done-keywords nil) +(defvar-local org-todo-heads nil) +(defvar-local org-todo-sets nil) +(defvar-local org-todo-log-states nil) +(defvar-local org-todo-kwd-alist nil) +(defvar-local org-todo-key-alist nil) +(defvar-local org-todo-key-trigger nil) (defcustom org-todo-interpretation 'sequence "Controls how TODO keywords are interpreted. @@ -2633,7 +2708,7 @@ more information." (defcustom org-use-fast-todo-selection t "\\<org-mode-map>\ -Non-nil means use the fast todo selection scheme with \\[org-todo]. +Non-nil means use the fast todo selection scheme with `\\[org-todo]'. This variable describes if and under what circumstances the cycling mechanism for TODO keywords will be replaced by a single-key, direct selection scheme. @@ -2642,7 +2717,7 @@ When nil, fast selection is never used. When the symbol `prefix', it will be used when `org-todo' is called with a prefix argument, i.e. `\\[universal-argument] \\[org-todo]' \ -in an Org-mode buffer, and +in an Org buffer, and `\\[universal-argument] t' in an agenda buffer. When t, fast selection is used by default. In this case, the prefix @@ -2762,7 +2837,7 @@ to change is while Emacs is running is through the customize interface." (defcustom org-treat-insert-todo-heading-as-state-change nil "Non-nil means inserting a TODO heading is treated as state change. -So when the command \\[org-insert-todo-heading] is used, state change +So when the command `\\[org-insert-todo-heading]' is used, state change logging will apply if appropriate. When nil, the new TODO item will be inserted directly, and no logging will take place." :group 'org-todo @@ -2966,7 +3041,7 @@ function `org-log-into-drawer' instead." (const :tag "LOGBOOK" t) (string :tag "Other"))) -(org-defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer) +(defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer) (defun org-log-into-drawer () "Name of the log drawer, as a string, or nil. @@ -3045,7 +3120,7 @@ property to one or more of these keywords." (defgroup org-priorities nil - "Priorities in Org-mode." + "Priorities in Org mode." :tag "Org Priorities" :group 'org-todo) @@ -3103,7 +3178,7 @@ as an argument and return the numeric priority." (function))) (defgroup org-time nil - "Options concerning time stamps and deadlines in Org-mode." + "Options concerning time stamps and deadlines in Org mode." :tag "Org Time" :group 'org) @@ -3244,7 +3319,7 @@ in minutes (even for durations longer than an hour)." (const t))))) (defcustom org-time-clocksum-use-fractional nil - "When non-nil, \\[org-clock-display] uses fractional times. + "When non-nil, `\\[org-clock-display]' uses fractional times. See `org-time-clocksum-format' for more on time clock formats." :group 'org-time :group 'org-clock @@ -3252,7 +3327,7 @@ See `org-time-clocksum-format' for more on time clock formats." :type 'boolean) (defcustom org-time-clocksum-use-effort-durations nil - "When non-nil, \\[org-clock-display] uses effort durations. + "When non-nil, `\\[org-clock-display]' uses effort durations. E.g. by default, one day is considered to be a 8 hours effort, so a task that has been clocked for 16 hours will be displayed as during 2 days in the clock display or in the clocktable. @@ -3328,8 +3403,8 @@ This affects the following situations: For example, if it is April and you enter \"feb 2\", this will be read as Feb 2, *next* year. \"May 5\", however, will be this year. 2. The user gives a day, but no month. - For example, if today is the 15th, and you enter \"3\", Org-mode will - read this as the third of *next* month. However, if you enter \"17\", + For example, if today is the 15th, and you enter \"3\", Org will read + this as the third of *next* month. However, if you enter \"17\", it will be considered as *this* month. If you set this variable to the symbol `time', then also the following @@ -3408,22 +3483,9 @@ minibuffer will also be active, and you can simply enter the date as well. When nil, only the minibuffer will be available." :group 'org-time :type 'boolean) -(org-defvaralias 'org-popup-calendar-for-date-prompt +(defvaralias 'org-popup-calendar-for-date-prompt 'org-read-date-popup-calendar) -(make-obsolete-variable - 'org-read-date-minibuffer-setup-hook - "Set `org-read-date-minibuffer-local-map' instead." "24.4") -(defcustom org-read-date-minibuffer-setup-hook nil - "Hook to be used to set up keys for the date/time interface. -Add key definitions to `minibuffer-local-map', which will be a -temporary copy. - -WARNING: This option is obsolete, you should use -`org-read-date-minibuffer-local-map' to set up keys." - :group 'org-time - :type 'hook) - (defcustom org-extend-today-until 0 "The hour when your day really ends. Must be an integer. This has influence for the following applications: @@ -3471,58 +3533,76 @@ moved to the new date." :type 'boolean) (defgroup org-tags nil - "Options concerning tags in Org-mode." + "Options concerning tags in Org mode." :tag "Org Tags" :group 'org) (defcustom org-tag-alist nil - "List of tags allowed in Org-mode files. -When this list is nil, Org-mode will base TAG input on what is already in the -buffer. -The value of this variable is an alist, the car of each entry must be a -keyword as a string, the cdr may be a character that is used to select -that tag through the fast-tag-selection interface. -See the manual for details." + "Default tags available in Org files. + +The value of this variable is an alist. Associations either: + + (TAG) + (TAG . SELECT) + (SPECIAL) + +where TAG is a tag as a string, SELECT is a character, used to +select that tag through the fast tag selection interface, and +SPECIAL is one of the following keywords: `:startgroup', +`:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or +`:newline'. These keywords are used to define a hierarchy of +tags. See manual for details. + +When this variable is nil, Org mode bases tag input on what is +already in the buffer. The value can be overridden locally by +using a TAGS keyword, e.g., + + #+TAGS: tag1 tag2 + +See also `org-tag-persistent-alist' to sidestep this behavior." :group 'org-tags :type '(repeat (choice (cons (string :tag "Tag name") (character :tag "Access char")) - (list :tag "Start radio group" - (const :startgroup) - (option (string :tag "Group description"))) - (list :tag "Start tag group, non distinct" - (const :startgrouptag) - (option (string :tag "Group description"))) - (list :tag "Group tags delimiter" - (const :grouptags)) - (list :tag "End radio group" - (const :endgroup) - (option (string :tag "Group description"))) - (list :tag "End tag group, non distinct" - (const :endgrouptag) - (option (string :tag "Group description"))) + (const :tag "Start radio group" (:startgroup)) + (const :tag "Start tag group, non distinct" (:startgrouptag)) + (const :tag "Group tags delimiter" (:grouptags)) + (const :tag "End radio group" (:endgroup)) + (const :tag "End tag group, non distinct" (:endgrouptag)) (const :tag "New line" (:newline))))) (defcustom org-tag-persistent-alist nil - "List of tags that will always appear in all Org-mode files. -This is in addition to any in buffer settings or customizations -of `org-tag-alist'. -When this list is nil, Org-mode will base TAG input on `org-tag-alist'. -The value of this variable is an alist, the car of each entry must be a -keyword as a string, the cdr may be a character that is used to select -that tag through the fast-tag-selection interface. -See the manual for details. -To disable these tags on a per-file basis, insert anywhere in the file: - #+STARTUP: noptag" + "Tags always available in Org files. + +The value of this variable is an alist. Associations either: + + (TAG) + (TAG . SELECT) + (SPECIAL) + +where TAG is a tag as a string, SELECT is a character, used to +select that tag through the fast tag selection interface, and +SPECIAL is one of the following keywords: `:startgroup', +`:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or +`:newline'. These keywords are used to define a hierarchy of +tags. See manual for details. + +Unlike to `org-tag-alist', tags defined in this variable do not +depend on a local TAGS keyword. Instead, to disable these tags +on a per-file basis, insert anywhere in the file: + + #+STARTUP: noptag" :group 'org-tags :type '(repeat (choice - (cons (string :tag "Tag name") - (character :tag "Access char")) + (cons (string :tag "Tag name") + (character :tag "Access char")) (const :tag "Start radio group" (:startgroup)) + (const :tag "Start tag group, non distinct" (:startgrouptag)) (const :tag "Group tags delimiter" (:grouptags)) (const :tag "End radio group" (:endgroup)) + (const :tag "End tag group, non distinct" (:endgrouptag)) (const :tag "New line" (:newline))))) (defcustom org-complete-tags-always-offer-all-agenda-tags nil @@ -3533,9 +3613,7 @@ tags in that file can be created dynamically (there are none). (add-hook \\='org-capture-mode-hook (lambda () - (set (make-local-variable - \\='org-complete-tags-always-offer-all-agenda-tags) - t)))" + (setq-local org-complete-tags-always-offer-all-agenda-tags t)))" :group 'org-tags :version "24.1" :type 'boolean) @@ -3577,7 +3655,7 @@ displaying the tags menu is not even shown, until you press C-c again." "Non-nil means fast tags selection interface will also offer TODO states. This is an undocumented feature, you should not rely on it.") -(defcustom org-tags-column (if (featurep 'xemacs) -76 -77) +(defcustom org-tags-column -77 "The column to which tags should be indented in a headline. If this number is positive, it specifies the column. If it is negative, it means that the tags should be flushright to that column. For example, @@ -3674,7 +3752,7 @@ is better to limit inheritance to certain tags using the variables "Hook that is run after the tags in a line have changed.") (defgroup org-properties nil - "Options concerning properties in Org-mode." + "Options concerning properties in Org mode." :tag "Org Properties" :group 'org) @@ -3769,19 +3847,6 @@ ellipses string, only part of the ellipses string will be shown." :group 'org-properties :type 'string) -(defcustom org-columns-modify-value-for-display-function nil - "Function that modifies values for display in column view. -For example, it can be used to cut out a certain part from a time stamp. -The function must take 2 arguments: - -column-title The title of the column (*not* the property name) -value The value that should be modified. - -The function should return the value that should be displayed, -or nil if the normal value should be used." - :group 'org-properties - :type '(choice (const nil) (function))) - (defconst org-global-properties-fixed '(("VISIBILITY_ALL" . "folded children content all") ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto")) @@ -3812,18 +3877,17 @@ You can set buffer-local values for the same purpose in the variable (cons (string :tag "Property") (string :tag "Value")))) -(defvar org-file-properties nil +(defvar-local org-file-properties nil "List of property/value pairs that can be inherited by any entry. Valid for the current buffer. This variable is populated from #+PROPERTY lines.") -(make-variable-buffer-local 'org-file-properties) (defgroup org-agenda nil - "Options concerning agenda views in Org-mode." + "Options concerning agenda views in Org mode." :tag "Org Agenda" :group 'org) -(defvar org-category nil +(defvar-local org-category nil "Variable used by org files to set a category for agenda display. Such files should use a file variable to set it, for example @@ -3835,22 +3899,22 @@ or contain a special line If the file does not specify a category, then file's base name is used instead.") -(make-variable-buffer-local 'org-category) (put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x)))) (defcustom org-agenda-files nil "The files to be used for agenda display. -Entries may be added to this list with \\[org-agenda-file-to-front] and removed with -\\[org-remove-file]. You can also use customize to edit the list. -If an entry is a directory, all files in that directory that are matched by -`org-agenda-file-regexp' will be part of the file list. +If an entry is a directory, all files in that directory that are matched +by `org-agenda-file-regexp' will be part of the file list. If the value of the variable is not a list but a single file name, then -the list of agenda files is actually stored and maintained in that file, one -agenda file per line. In this file paths can be given relative to +the list of agenda files is actually stored and maintained in that file, +one agenda file per line. In this file paths can be given relative to `org-directory'. Tilde expansion and environment variable substitution -are also made." +are also made. + +Entries may be added to this list with `\\[org-agenda-file-to-front]' +and removed with `\\[org-remove-file]'." :group 'org-agenda :type '(choice (repeat :tag "List of files and directories" file) @@ -3881,7 +3945,7 @@ scope." (const :tag "Agenda Archives" agenda-archives) (repeat :inline t (file)))) -(org-defvaralias 'org-agenda-multi-occur-extra-files +(defvaralias 'org-agenda-multi-occur-extra-files 'org-agenda-text-search-extra-files) (defcustom org-agenda-skip-unavailable-files nil @@ -3901,7 +3965,7 @@ forth between agenda and calendar." (defcustom org-calendar-insert-diary-entry-key [?i] "The key to be installed in `calendar-mode-map' for adding diary entries. This option is irrelevant until `org-agenda-diary-file' has been configured -to point to an Org-mode file. When that is the case, the command +to point to an Org file. When that is the case, the command `org-agenda-diary-entry' will be bound to the key given here, by default `i'. In the calendar, `i' normally adds entries to `diary-file'. So if you want to continue doing this, you need to change this to a different @@ -3931,7 +3995,7 @@ points to a file, `org-agenda-diary-entry' will be used instead." 'org-agenda-diary-entry)))))) (defgroup org-latex nil - "Options for embedding LaTeX code into Org-mode." + "Options for embedding LaTeX code into Org mode." :tag "Org LaTeX" :group 'org) @@ -4003,27 +4067,114 @@ When using LaTeXML set this option to (const :tag "None" nil) (string :tag "\nShell command"))) -(defcustom org-latex-create-formula-image-program 'dvipng - "Program to convert LaTeX fragments with. - -dvipng Process the LaTeX fragments to dvi file, then convert - dvi files to png files using dvipng. - This will also include processing of non-math environments. -imagemagick Convert the LaTeX fragments to pdf files and use imagemagick - to convert pdf files to png files" +(defcustom org-preview-latex-default-process 'dvipng + "The default process to convert LaTeX fragments to image files. +All available processes and theirs documents can be found in +`org-preview-latex-process-alist', which see." :group 'org-latex - :version "24.1" - :type '(choice - (const :tag "dvipng" dvipng) - (const :tag "imagemagick" imagemagick))) + :version "25.2" + :package-version '(Org . "9.0") + :type 'symbol) + +(defcustom org-preview-latex-process-alist + '((dvipng + :programs ("latex" "dvipng" "gs") + :description "dvi > png" + :message "you need to install the programs: latex, dvipng and ghostscript." + :image-input-type "dvi" + :image-output-type "png" + :image-size-adjust (1.0 . 1.0) + :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f") + :image-converter ("dvipng -fg %F -bg %B -D %D -T tight -o %b.png %f")) + (dvisvgm + :programs ("latex" "dvisvgm" "gs") + :description "dvi > svg" + :message "you need to install the programs: latex, dvisvgm and ghostscript." + :use-xcolor t + :image-input-type "dvi" + :image-output-type "svg" + :image-size-adjust (1.7 . 1.5) + :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f") + :image-converter ("dvisvgm %f -n -b min -c %S -o %b.svg")) + (imagemagick + :programs ("latex" "convert" "gs") + :description "pdf > png" + :message + "you need to install the programs: latex, imagemagick and ghostscript." + :use-xcolor t + :image-input-type "pdf" + :image-output-type "png" + :image-size-adjust (1.0 . 1.0) + :latex-compiler ("pdflatex -interaction nonstopmode -output-directory %o %f") + :image-converter + ("convert -density %D -trim -antialias %f -quality 100 %b.png"))) + "Definitions of external processes for LaTeX previewing. +Org mode can use some external commands to generate TeX snippet's images for +previewing or inserting into HTML files, e.g., \"dvipng\". This variable tells +`org-create-formula-image' how to call them. + +The value is an alist with the pattern (NAME . PROPERTIES). NAME is a symbol. +PROPERTIES accepts the following attributes: + + :programs list of strings, required programs. + :description string, describe the process. + :message string, message it when required programs cannot be found. + :image-input-type string, input file type of image converter (e.g., \"dvi\"). + :image-output-type string, output file type of image converter (e.g., \"png\"). + :use-xcolor boolean, when non-nil, LaTeX \"xcolor\" macro is used to + deal with background and foreground color of image. + Otherwise, dvipng style background and foregroud color + format are generated. You may then refer to them in + command options with \"%F\" and \"%B\". + :image-size-adjust cons of numbers, the car element is used to adjust LaTeX + image size showed in buffer and the cdr element is for + HTML file. This option is only useful for process + developers, users should use variable + `org-format-latex-options' instead. + :post-clean list of strings, files matched are to be cleaned up once + the image is generated. When nil, the files with \".dvi\", + \".xdv\", \".pdf\", \".tex\", \".aux\", \".log\", \".svg\", + \".png\", \".jpg\", \".jpeg\" or \".out\" extension will + be cleaned up. + :latex-header list of strings, the LaTeX header of the snippet file. + When nil, the fallback value is used instead, which is + controlled by `org-format-latex-header', + `org-latex-default-packages-alist' and + `org-latex-packages-alist', which see. + :latex-compiler list of LaTeX commands, as strings. Each of them is given + to the shell. Place-holders \"%t\", \"%b\" and \"%o\" are + replaced with values defined below. + :image-converter list of image converter commands strings. Each of them is + given to the shell and supports any of the following + place-holders defined below. + +Place-holders used by `:image-converter' and `:latex-compiler': + + %f input file name. + %b base name of input file. + %o base directory of input file. + +Place-holders only used by `:image-converter': + + %F foreground of image + %B background of image + %D dpi, which is used to adjust image size by some processing commands. + %S the image size scale ratio, which is used to adjust image size by some + processing commands." + :group 'org-latex + :version "25.2" + :package-version '(Org . "9.0") + :type '(alist :tag "LaTeX to image backends" + :value-type (plist))) -(defcustom org-latex-preview-ltxpng-directory "ltxpng/" +(defcustom org-preview-latex-image-directory "ltximg/" "Path to store latex preview images. A relative path here creates many directories relative to the processed org files paths. An absolute path puts all preview images at the same place." :group 'org-latex - :version "24.3" + :version "25.2" + :package-version '(Org . "9.0") :type 'string) (defun org-format-latex-mathml-available-p () @@ -4083,9 +4234,8 @@ header, or they will be appended." (default-value var))) (defcustom org-latex-default-packages-alist - '(("AUTO" "inputenc" t) - ("T1" "fontenc" t) - ("" "fixltx2e" nil) + '(("AUTO" "inputenc" t ("pdflatex")) + ("T1" "fontenc" t ("pdflatex")) ("" "graphicx" t) ("" "grffile" t) ("" "longtable" nil) @@ -4106,7 +4256,6 @@ The packages in this list are needed by one part or another of Org mode to function properly: - inputenc, fontenc: for basic font and character selection -- fixltx2e: Important patches of LaTeX itself - graphicx: for including images - grffile: allow periods and spaces in graphics file names - longtable: For multipage tables @@ -4128,18 +4277,21 @@ a string. A cell is of the format - (\"options\" \"package\" SNIPPET-FLAG) + (\"options\" \"package\" SNIPPET-FLAG COMPILERS) If SNIPPET-FLAG is non-nil, the package also needs to be included when compiling LaTeX snippets into images for inclusion into -non-LaTeX output. +non-LaTeX output. COMPILERS is a list of compilers that should +include the package, see `org-latex-compiler'. If the document +compiler is not in the list, and the list is non-nil, the package +will not be inserted in the final document. A string will be inserted as-is in the header of the document." :group 'org-latex :group 'org-export-latex :set 'org-set-packages-alist :get 'org-get-packages-alist - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(repeat (choice @@ -4184,7 +4336,7 @@ Make sure that you only list packages here which: (string :tag "A line of LaTeX")))) (defgroup org-appearance nil - "Settings for Org-mode appearance." + "Settings for Org mode appearance." :tag "Org Appearance" :group 'org) @@ -4366,7 +4518,7 @@ After a match, the match groups contain these elements: ;; set this option proved cumbersome. See this message/thread: ;; http://article.gmane.org/gmane.emacs.orgmode/68681 (defvar org-emphasis-regexp-components - '(" \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n,\"'" "." 1) + '(" \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1) "Components used to build the regular expression for emphasis. This is a list with five entries. Terminology: In an emphasis string like \" *strong word* \", we call the initial space PREMATCH, the final @@ -4384,17 +4536,17 @@ newline The maximum number of newlines allowed in an emphasis exp. You need to reload Org or to restart Emacs after customizing this.") (defcustom org-emphasis-alist - `(("*" bold) + '(("*" bold) ("/" italic) ("_" underline) ("=" org-verbatim verbatim) ("~" org-code verbatim) - ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t)))) + ("+" (:strike-through t))) "Alist of characters and faces to emphasize text. Text starting and ending with a special character will be emphasized, for example *bold*, _underlined_ and /italic/. This variable sets the marker characters and the face to be used by font-lock for highlighting -in Org-mode Emacs buffers. +in Org buffers. You need to reload Org or to restart Emacs after customizing this." :group 'org-appearance @@ -4409,98 +4561,68 @@ You need to reload Org or to restart Emacs after customizing this." (plist :tag "Face property list")) (option (const verbatim))))) -(defvar org-protecting-blocks - '("src" "example" "latex" "ascii" "html" "ditaa" "dot" "r" "R") +(defvar org-protecting-blocks '("src" "example" "export") "Blocks that contain text that is quoted, i.e. not processed as Org syntax. This is needed for font-lock setup.") -;;; Miscellaneous options - -(defgroup org-completion nil - "Completion in Org-mode." - :tag "Org Completion" - :group 'org) - -(defcustom org-completion-use-ido nil - "Non-nil means use ido completion wherever possible. -Note that `ido-mode' must be active for this variable to be relevant. -If you decide to turn this variable on, you might well want to turn off -`org-outline-path-complete-in-steps'. -See also `org-completion-use-iswitchb'." - :group 'org-completion - :type 'boolean) - -(defcustom org-completion-use-iswitchb nil - "Non-nil means use iswitchb completion wherever possible. -Note that `iswitchb-mode' must be active for this variable to be relevant. -If you decide to turn this variable on, you might well want to turn off -`org-outline-path-complete-in-steps'. -Note that this variable has only an effect if `org-completion-use-ido' is nil." - :group 'org-completion - :type 'boolean) - -(defcustom org-completion-fallback-command 'hippie-expand - "The expansion command called by \\[pcomplete] in normal context. -Normal means, no org-mode-specific context." - :group 'org-completion - :type 'function) - ;;; Functions and variables from their packages ;; Declared here to avoid compiler warnings - -;; XEmacs only -(defvar outline-mode-menu-heading) -(defvar outline-mode-menu-show) -(defvar outline-mode-menu-hide) -(defvar zmacs-regions) ; XEmacs regions - -;; Emacs only (defvar mark-active) ;; Various packages -(declare-function calendar-iso-to-absolute "cal-iso" (date)) -(declare-function calendar-forward-day "cal-move" (arg)) -(declare-function calendar-goto-date "cal-move" (date)) -(declare-function calendar-goto-today "cal-move" ()) -(declare-function calendar-iso-from-absolute "cal-iso" (date)) -(defvar calc-embedded-close-formula) -(defvar calc-embedded-open-formula) -(declare-function cdlatex-tab "ext:cdlatex" ()) +(declare-function calc-eval "calc" (str &optional separator &rest args)) +(declare-function calendar-forward-day "cal-move" (arg)) +(declare-function calendar-goto-date "cal-move" (date)) +(declare-function calendar-goto-today "cal-move" ()) +(declare-function calendar-iso-from-absolute "cal-iso" (date)) +(declare-function calendar-iso-to-absolute "cal-iso" (date)) (declare-function cdlatex-compute-tables "ext:cdlatex" ()) -(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) -(defvar font-lock-unfontify-region-function) -(declare-function iswitchb-read-buffer "iswitchb" - (prompt &optional default require-match start matches-set)) -(defvar iswitchb-temp-buflist) -(declare-function org-gnus-follow-link "org-gnus" (&optional group article)) -(defvar org-agenda-tags-todo-honor-ignore-options) -(declare-function org-agenda-skip "org-agenda" ()) -(declare-function - org-agenda-format-item "org-agenda" - (extra txt &optional level category tags dotime noprefix remove-re habitp)) -(declare-function org-agenda-new-marker "org-agenda" (&optional pos)) -(declare-function org-agenda-change-all-lines "org-agenda" +(declare-function cdlatex-tab "ext:cdlatex" ()) +(declare-function dired-get-filename + "dired" + (&optional localp no-error-if-not-filep)) +(declare-function iswitchb-read-buffer + "iswitchb" + (prompt &optional + default require-match _predicate start matches-set)) +(declare-function org-agenda-change-all-lines + "org-agenda" (newhead hdmarker &optional fixface just-this)) -(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) +(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item + "org-agenda" + (&optional end)) +(declare-function org-agenda-copy-local-variable "org-agenda" (var)) +(declare-function org-agenda-format-item + "org-agenda" + (extra txt &optional level category tags dotime + remove-re habitp)) (declare-function org-agenda-maybe-redo "org-agenda" ()) -(declare-function org-agenda-save-markers-for-cut-and-paste "org-agenda" +(declare-function org-agenda-new-marker "org-agenda" (&optional pos)) +(declare-function org-agenda-save-markers-for-cut-and-paste + "org-agenda" (beg end)) -(declare-function org-agenda-copy-local-variable "org-agenda" (var)) -(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item - "org-agenda" (&optional end)) -(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) -(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) +(declare-function org-agenda-skip "org-agenda" ()) +(declare-function org-attach-reveal "org-attach" (&optional if-exists)) +(declare-function org-gnus-follow-link "org-gnus" (&optional group article)) +(declare-function org-indent-mode "org-indent" (&optional arg)) (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) (declare-function org-inlinetask-goto-end "org-inlinetask" ()) -(declare-function org-indent-mode "org-indent" (&optional arg)) -(declare-function parse-time-string "parse-time" (string)) -(declare-function org-attach-reveal "org-attach" (&optional if-exists)) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) (declare-function orgtbl-send-table "org-table" (&optional maybe)) +(declare-function parse-time-string "parse-time" (string)) +(declare-function speedbar-line-directory "speedbar" (&optional depth)) + +(defvar align-mode-rules-list) +(defvar calc-embedded-close-formula) +(defvar calc-embedded-open-formula) +(defvar calc-embedded-open-mode) +(defvar font-lock-unfontify-region-function) +(defvar iswitchb-temp-buflist) +(defvar org-agenda-tags-todo-honor-ignore-options) (defvar remember-data-file) (defvar texmathp-why) -(declare-function speedbar-line-directory "speedbar" (&optional depth)) -(declare-function table--at-cell-p "table" (position &optional object at-column)) -(declare-function calc-eval "calc" (str &optional separator &rest args)) ;;;###autoload (defun turn-on-orgtbl () @@ -4516,11 +4638,10 @@ If `org-enable-table-editor' is nil, return nil unconditionally." org-enable-table-editor (save-excursion (beginning-of-line) - (org-looking-at-p (if table-type "[ \t]*[|+]" "[ \t]*|"))) + (looking-at-p (if table-type "[ \t]*[|+]" "[ \t]*|"))) (or (not (derived-mode-p 'org-mode)) (let ((e (org-element-lineage (org-element-at-point) '(table) t))) (and e (or table-type (eq (org-element-property :type e) 'org))))))) -(defsubst org-table-p () (org-at-table-p)) (defun org-at-table.el-p () "Non-nil when point is at a table.el table." @@ -4529,24 +4650,6 @@ If `org-enable-table-editor' is nil, return nil unconditionally." (and (eq (org-element-type element) 'table) (eq (org-element-property :type element) 'table.el))))) -(defun org-table-recognize-table.el () - "If there is a table.el table nearby, recognize it and move into it." - (when (and org-table-tab-recognizes-table.el (org-at-table.el-p)) - (beginning-of-line) - (unless (or (looking-at org-table-dataline-regexp) - (not (looking-at org-table1-hline-regexp))) - (forward-line) - (when (looking-at org-table-any-border-regexp) - (forward-line -2))) - (if (re-search-forward "|" (org-table-end t) t) - (progn - (require 'table) - (if (table--at-cell-p (point)) t - (message "recognizing table.el table...") - (table-recognize-table) - (message "recognizing table.el table...done"))) - (error "This should not happen")))) - (defun org-at-table-hline-p () "Non-nil when point is inside a hline in a table. Assume point is already in a table. If `org-enable-table-editor' @@ -4558,22 +4661,20 @@ is nil, return nil unconditionally." (defun org-table-map-tables (function &optional quietly) "Apply FUNCTION to the start of all tables in the buffer." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward org-table-any-line-regexp nil t) - (unless quietly - (message "Mapping tables: %d%%" - (floor (* 100.0 (point)) (buffer-size)))) - (beginning-of-line 1) - (when (and (looking-at org-table-line-regexp) - ;; Exclude tables in src/example/verbatim/clocktable blocks - (not (org-in-block-p '("src" "example" "verbatim" "clocktable")))) - (save-excursion (funcall function)) - (or (looking-at org-table-line-regexp) - (forward-char 1))) - (re-search-forward org-table-any-border-regexp nil 1)))) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward org-table-any-line-regexp nil t) + (unless quietly + (message "Mapping tables: %d%%" + (floor (* 100.0 (point)) (buffer-size)))) + (beginning-of-line 1) + (when (and (looking-at org-table-line-regexp) + ;; Exclude tables in src/example/verbatim/clocktable blocks + (not (org-in-block-p '("src" "example" "verbatim" "clocktable")))) + (save-excursion (funcall function)) + (or (looking-at org-table-line-regexp) + (forward-char 1))) + (re-search-forward org-table-any-border-regexp nil 1))) (unless quietly (message "Mapping tables: done"))) (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end)) @@ -4624,7 +4725,7 @@ If yes, offer to stop it and to save the buffer with the changes." (add-hook 'kill-emacs-hook 'org-clock-save)) (defgroup org-archive nil - "Options concerning archiving in Org-mode." + "Options concerning archiving in Org mode." :tag "Org Archive" :group 'org-structure) @@ -4639,7 +4740,7 @@ When the filename is omitted, archiving happens in the same file. %s in the filename will be replaced by the current file name (without the directory part). Archiving to a different file is useful to keep archived entries from contributing to the -Org-mode Agenda. +Org Agenda. The archived entries will be filed as subtrees of the specified headline. When the headline is omitted, the subtrees are simply @@ -4736,7 +4837,7 @@ Otherwise, these types are allowed: (const :tag "Only scheduled timestamps" scheduled) (const :tag "Only deadline timestamps" deadline) (const :tag "Only closed timestamps" closed)) - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :group 'org-sparse-trees) @@ -4750,9 +4851,10 @@ Otherwise, these types are allowed: (end (if globalp (point-max) (org-end-of-subtree t)))) (org-hide-archived-subtrees beg end) (goto-char beg) - (if (looking-at (concat ".*:" org-archive-tag ":")) - (message "%s" (substitute-command-keys - "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) + (when (looking-at-p (concat ".*:" org-archive-tag ":")) + (message "%s" (substitute-command-keys + "Subtree is archived and stays closed. Use \ +`\\[org-force-cycle-archived]' to cycle it anyway."))))))) (defun org-force-cycle-archived () "Cycle subtree even if it is archived." @@ -4788,7 +4890,6 @@ Otherwise, these types are allowed: ;; Declare Column View Code -(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf)) (declare-function org-columns-get-format-and-top-level "org-colview" ()) (declare-function org-columns-compute "org-colview" (property)) @@ -4801,36 +4902,33 @@ Otherwise, these types are allowed: ;;; Variables for pre-computed regular expressions, all buffer local -(defvar org-todo-regexp nil +(defvar-local org-todo-regexp nil "Matches any of the TODO state keywords.") -(make-variable-buffer-local 'org-todo-regexp) -(defvar org-not-done-regexp nil +(defvar-local org-not-done-regexp nil "Matches any of the TODO state keywords except the last one.") -(make-variable-buffer-local 'org-not-done-regexp) -(defvar org-not-done-heading-regexp nil +(defvar-local org-not-done-heading-regexp nil "Matches a TODO headline that is not done.") -(make-variable-buffer-local 'org-not-done-heading-regexp) -(defvar org-todo-line-regexp nil +(defvar-local org-todo-line-regexp nil "Matches a headline and puts TODO state into group 2 if present.") -(make-variable-buffer-local 'org-todo-line-regexp) -(defvar org-complex-heading-regexp nil +(defvar-local org-complex-heading-regexp nil "Matches a headline and puts everything into groups: + group 1: the stars group 2: The todo keyword, maybe group 3: Priority cookie group 4: True headline -group 5: Tags") -(make-variable-buffer-local 'org-complex-heading-regexp) -(defvar org-complex-heading-regexp-format nil +group 5: Tags + +Since TODO keywords are case-sensitive, `case-fold-search' is +expected to be bound to nil when matching this regexp.") +(defvar-local org-complex-heading-regexp-format nil "Printf format to make regexp to match an exact headline. This regexp will match the headline of any node which has the exact headline text that is put into the format, but may have any TODO state, priority and tags.") -(make-variable-buffer-local 'org-complex-heading-regexp-format) -(defvar org-todo-line-tags-regexp nil +(defvar-local org-todo-line-tags-regexp nil "Matches a headline and puts TODO state into group 2 if present. Also put tags into group 4 if tags are present.") -(make-variable-buffer-local 'org-todo-line-tags-regexp) (defconst org-plain-time-of-day-regexp (concat @@ -4971,24 +5069,44 @@ related expressions." '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS" "LINK" "OPTIONS" "PRIORITIES" "PROPERTY" "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO"))))))) - (org--setup-process-tags - (cdr (assq 'tags alist)) (cdr (assq 'filetags alist))) + ;; Startup options. Get this early since it does change + ;; behavior for other options (e.g., tags). + (let ((startup (cdr (assq 'startup alist)))) + (dolist (option startup) + (let ((entry (assoc-string option org-startup-options t))) + (when entry + (let ((var (nth 1 entry)) + (val (nth 2 entry))) + (if (not (nth 3 entry)) (set (make-local-variable var) val) + (unless (listp (symbol-value var)) + (set (make-local-variable var) nil)) + (add-to-list var val))))))) + (setq-local org-file-tags + (mapcar #'org-add-prop-inherited + (cdr (assq 'filetags alist)))) + (setq org-current-tag-alist + (append org-tag-persistent-alist + (let ((tags (cdr (assq 'tags alist)))) + (if tags (org-tag-string-to-alist tags) + org-tag-alist)))) + (setq org-tag-groups-alist + (org-tag-alist-to-groups org-current-tag-alist)) (unless tags-only ;; File properties. - (org-set-local 'org-file-properties (cdr (assq 'property alist))) + (setq-local org-file-properties (cdr (assq 'property alist))) ;; Archive location. (let ((archive (cdr (assq 'archive alist)))) - (when archive (org-set-local 'org-archive-location archive))) + (when archive (setq-local org-archive-location archive))) ;; Category. (let ((cat (org-string-nw-p (cdr (assq 'category alist))))) (when cat - (org-set-local 'org-category (intern cat)) - (org-set-local 'org-file-properties - (org--update-property-plist - "CATEGORY" cat org-file-properties)))) + (setq-local org-category (intern cat)) + (setq-local org-file-properties + (org--update-property-plist + "CATEGORY" cat org-file-properties)))) ;; Columns. (let ((column (cdr (assq 'columns alist)))) - (when column (org-set-local 'org-columns-default-format column))) + (when column (setq-local org-columns-default-format column))) ;; Constants. (setq org-table-formula-constants-local (cdr (assq 'constants alist))) ;; Link abbreviations. @@ -4997,33 +5115,22 @@ related expressions." ;; Priorities. (let ((priorities (cdr (assq 'priorities alist)))) (when priorities - (org-set-local 'org-highest-priority (nth 0 priorities)) - (org-set-local 'org-lowest-priority (nth 1 priorities)) - (org-set-local 'org-default-priority (nth 2 priorities)))) + (setq-local org-highest-priority (nth 0 priorities)) + (setq-local org-lowest-priority (nth 1 priorities)) + (setq-local org-default-priority (nth 2 priorities)))) ;; Scripts. (let ((scripts (assq 'scripts alist))) (when scripts - (org-set-local 'org-use-sub-superscripts (cdr scripts)))) - ;; Startup options. - (let ((startup (cdr (assq 'startup alist)))) - (dolist (option startup) - (let ((entry (assoc-string option org-startup-options t))) - (when entry - (let ((var (nth 1 entry)) - (val (nth 2 entry))) - (if (not (nth 3 entry)) (org-set-local var val) - (unless (listp (symbol-value var)) - (org-set-local var nil)) - (add-to-list var val))))))) + (setq-local org-use-sub-superscripts (cdr scripts)))) ;; TODO keywords. - (org-set-local 'org-todo-kwd-alist nil) - (org-set-local 'org-todo-key-alist nil) - (org-set-local 'org-todo-key-trigger nil) - (org-set-local 'org-todo-keywords-1 nil) - (org-set-local 'org-done-keywords nil) - (org-set-local 'org-todo-heads nil) - (org-set-local 'org-todo-sets nil) - (org-set-local 'org-todo-log-states nil) + (setq-local org-todo-kwd-alist nil) + (setq-local org-todo-key-alist nil) + (setq-local org-todo-key-trigger nil) + (setq-local org-todo-keywords-1 nil) + (setq-local org-done-keywords nil) + (setq-local org-todo-heads nil) + (setq-local org-todo-sets nil) + (setq-local org-todo-log-states nil) (let ((todo-sequences (or (nreverse (cdr (assq 'todo alist))) (let ((d (default-value 'org-todo-keywords))) @@ -5071,9 +5178,9 @@ related expressions." ;; Compute the regular expressions and other local variables. ;; Using `org-outline-regexp-bol' would complicate them much, ;; because of the fixed white space at the end of that string. - (if (not org-done-keywords) - (setq org-done-keywords - (and org-todo-keywords-1 (last org-todo-keywords-1)))) + (unless org-done-keywords + (setq org-done-keywords + (and org-todo-keywords-1 (last org-todo-keywords-1)))) (setq org-not-done-keywords (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) @@ -5088,7 +5195,7 @@ related expressions." "\\(?: +" org-todo-regexp "\\)?" "\\(?: +\\(\\[#.\\]\\)\\)?" "\\(?: +\\(.*?\\)\\)??" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?") + "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?" "[ \t]*$") org-complex-heading-regexp-format (concat "^\\(\\*+\\)" @@ -5100,13 +5207,13 @@ related expressions." "\\(%s\\)" "\\(?: *\\[[0-9%%/]+\\]\\)*" "\\)" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?") + "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?" "[ \t]*$") org-todo-line-tags-regexp (concat "^\\(\\*+\\)" "\\(?: +" org-todo-regexp "\\)?" "\\(?: +\\(.*?\\)\\)??" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?") + "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?" "[ \t]*$")) (org-compute-latex-and-related-regexp))))) @@ -5158,8 +5265,8 @@ Return value contains the following keys: `archive', `category', ((equal key "LINK") (when (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value) (let ((links (assq 'link alist)) - (pair (cons (org-match-string-no-properties 1 value) - (org-match-string-no-properties 2 value)))) + (pair (cons (match-string-no-properties 1 value) + (match-string-no-properties 2 value)))) (if links (push pair (cdr links)) (push (list 'link pair) alist))))) ((equal key "OPTIONS") @@ -5176,8 +5283,8 @@ Return value contains the following keys: `archive', `category', (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value) (let* ((property (assq 'property alist)) (value (org--update-property-plist - (org-match-string-no-properties 1 value) - (org-match-string-no-properties 2 value) + (match-string-no-properties 1 value) + (match-string-no-properties 2 value) (cdr property)))) (if property (setcdr property value) (push (cons 'property value) alist))))) @@ -5190,11 +5297,8 @@ Return value contains the following keys: `archive', `category', ((equal key "TAGS") (let ((tag-cell (assq 'tags alist))) (if tag-cell - (setcdr tag-cell - (append (cdr tag-cell) - '("\\n") - (org-split-string value))) - (push (cons 'tags (org-split-string value)) alist)))) + (setcdr tag-cell (concat (cdr tag-cell) "\n" value)) + (push (cons 'tags value) alist)))) ((member key '("TODO" "SEQ_TODO" "TYP_TODO")) (let ((todo (assq 'todo alist)) (value (cons (if (equal key "TYP_TODO") 'type 'sequence) @@ -5205,7 +5309,7 @@ Return value contains the following keys: `archive', `category', (unless buffer-read-only ; Do not check in Gnus messages. (let ((f (and (org-string-nw-p value) (expand-file-name - (org-remove-double-quotes value))))) + (org-unbracket-string "\"" "\"" value))))) (when (and f (file-readable-p f) (not (member f files))) (with-temp-buffer (setq default-directory (file-name-directory f)) @@ -5218,67 +5322,93 @@ Return value contains the following keys: `archive', `category', regexp (cons f files) alist))))))))))))))) alist) -(defun org--setup-process-tags (tags filetags) - "Precompute variables used for tags. -TAGS is a list of tags and tag group symbols, as strings. -FILETAGS is a list of tags, as strings." - ;; Process the file tags. - (org-set-local 'org-file-tags - (mapcar #'org-add-prop-inherited filetags)) - ;; Provide default tags if no local tags are found. - (when (and (not tags) org-tag-alist) - (setq tags - (mapcar (lambda (tag) - (case (car tag) - (:startgroup "{") - (:endgroup "}") - (:startgrouptag "[") - (:endgrouptag "]") - (:grouptags ":") - (:newline "\\n") - (otherwise (concat (car tag) - (and (characterp (cdr tag)) - (format "(%c)" (cdr tag))))))) - org-tag-alist))) - ;; Process the tags. - (org-set-local 'org-tag-groups-alist nil) - (org-set-local 'org-tag-alist nil) - (let (group-flag) - (while tags - (let ((e (car tags))) - (setq tags (cdr tags)) - (cond - ((equal e "{") - (push '(:startgroup) org-tag-alist) - (when (equal (nth 1 tags) ":") (setq group-flag t))) - ((equal e "}") - (push '(:endgroup) org-tag-alist) - (setq group-flag nil)) - ((equal e "[") - (push '(:startgrouptag) org-tag-alist) - (when (equal (nth 1 tags) ":") (setq group-flag t))) - ((equal e "]") - (push '(:endgrouptag) org-tag-alist) - (setq group-flag nil)) - ((equal e ":") - (push '(:grouptags) org-tag-alist) - (setq group-flag 'append)) - ((equal e "\\n") (push '(:newline) org-tag-alist)) - ((string-match - (org-re (concat "\\`\\([[:alnum:]_@#%]+" - "\\|{.+?}\\)" ; regular expression - "\\(?:(\\(.\\))\\)?\\'")) e) - (let ((tag (match-string 1 e)) - (key (and (match-beginning 2) - (string-to-char (match-string 2 e))))) - (cond ((eq group-flag 'append) - (setcar org-tag-groups-alist - (append (car org-tag-groups-alist) (list tag)))) - (group-flag (push (list tag) org-tag-groups-alist))) - ;; Push all tags in groups, no matter if they already exist. - (unless (and (not group-flag) (assoc tag org-tag-alist)) - (push (cons tag key) org-tag-alist)))))))) - (setq org-tag-alist (nreverse org-tag-alist))) +(defun org-tag-string-to-alist (s) + "Return tag alist associated to string S. +S is a value for TAGS keyword or produced with +`org-tag-alist-to-string'. Return value is an alist suitable for +`org-tag-alist' or `org-tag-persistent-alist'." + (let ((lines (mapcar #'split-string (split-string s "\n" t))) + (tag-re (concat "\\`\\([[:alnum:]_@#%]+" + "\\|{.+?}\\)" ; regular expression + "\\(?:(\\(.\\))\\)?\\'")) + alist group-flag) + (dolist (tokens lines (cdr (nreverse alist))) + (push '(:newline) alist) + (while tokens + (let ((token (pop tokens))) + (pcase token + ("{" + (push '(:startgroup) alist) + (when (equal (nth 1 tokens) ":") (setq group-flag t))) + ("}" + (push '(:endgroup) alist) + (setq group-flag nil)) + ("[" + (push '(:startgrouptag) alist) + (when (equal (nth 1 tokens) ":") (setq group-flag t))) + ("]" + (push '(:endgrouptag) alist) + (setq group-flag nil)) + (":" + (push '(:grouptags) alist)) + ((guard (string-match tag-re token)) + (let ((tag (match-string 1 token)) + (key (and (match-beginning 2) + (string-to-char (match-string 2 token))))) + ;; Push all tags in groups, no matter if they already + ;; appear somewhere else in the list. + (when (or group-flag (not (assoc tag alist))) + (push (cons tag key) alist)))))))))) + +(defun org-tag-alist-to-string (alist &optional skip-key) + "Return tag string associated to ALIST. + +ALIST is an alist, as defined in `org-tag-alist' or +`org-tag-persistent-alist', or produced with +`org-tag-string-to-alist'. + +Return value is a string suitable as a value for \"TAGS\" +keyword. + +When optional argument SKIP-KEY is non-nil, skip selection keys +next to tags." + (mapconcat (lambda (token) + (pcase token + (`(:startgroup) "{") + (`(:endgroup) "}") + (`(:startgrouptag) "[") + (`(:endgrouptag) "]") + (`(:grouptags) ":") + (`(:newline) "\\n") + ((and + (guard (not skip-key)) + `(,(and tag (pred stringp)) . ,(and key (pred characterp)))) + (format "%s(%c)" tag key)) + (`(,(and tag (pred stringp)) . ,_) tag) + (_ (user-error "Invalid tag token: %S" token)))) + alist + " ")) + +(defun org-tag-alist-to-groups (alist) + "Return group alist from tag ALIST. +ALIST is an alist, as defined in `org-tag-alist' or +`org-tag-persistent-alist', or produced with +`org-tag-string-to-alist'. Return value is an alist following +the pattern (GROUP-TAG TAGS) where GROUP-TAG is the tag, as +a string, summarizing TAGS, as a list of strings." + (let (groups group-status current-group) + (dolist (token alist (nreverse groups)) + (pcase token + (`(,(or :startgroup :startgrouptag)) (setq group-status t)) + (`(,(or :endgroup :endgrouptag)) + (when (eq group-status 'append) + (push (nreverse current-group) groups)) + (setq group-status nil)) + (`(:grouptags) (setq group-status 'append)) + ((and `(,tag . ,_) (guard group-status)) + (if (eq group-status 'append) (push tag current-group) + (setq current-group (list tag)))) + (_ nil))))) (defun org-file-contents (file &optional noerror) "Return the contents of FILE, as a string." @@ -5295,12 +5425,10 @@ FILETAGS is a list of tags, as strings." (defun org-extract-log-state-settings (x) "Extract the log state setting from a TODO keyword string. This will extract info from a string like \"WAIT(w@/!)\"." - (let (kw key log1 log2) - (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) - (setq kw (match-string 1 x) - key (and (match-end 2) (match-string 2 x)) - log1 (and (match-end 3) (match-string 3 x)) - log2 (and (match-end 4) (match-string 4 x))) + (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) + (let ((kw (match-string 1 x)) + (log1 (and (match-end 3) (match-string 3 x))) + (log2 (and (match-end 4) (match-string 4 x)))) (and (or log1 log2) (list kw (and log1 (if (equal log1 "!") 'time 'note)) @@ -5330,7 +5458,7 @@ Respect keys that are already there." (pop clist)) (unless clist (while (rassoc alt used) - (incf alt))) + (cl-incf alt))) (push (cons (car e) (or (car clist) alt)) new)))) (nreverse new))) @@ -5343,13 +5471,7 @@ Respect keys that are already there." (defvar org-finish-function nil "Function to be called when `C-c C-c' is used. This is for getting out of special buffers like capture.") - - -;; FIXME: Occasionally check by commenting these, to make sure -;; no other functions uses these, forgetting to let-bind them. -(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el (defvar org-last-state) -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el ;; Defined somewhere in this file, but used before definition. (defvar org-entities) ;; defined in org-entities.el @@ -5357,7 +5479,7 @@ This is for getting out of special buffers like capture.") (defvar org-org-menu) (defvar org-tbl-menu) -;;;; Define the Org-mode +;;;; Define the Org mode ;; We use a before-change function to check if a table might need ;; an update. @@ -5365,7 +5487,7 @@ This is for getting out of special buffers like capture.") "Indicates that a table might need an update. This variable is set by `org-before-change-function'. `org-table-align' sets it back to nil.") -(defun org-before-change-function (beg end) +(defun org-before-change-function (_beg _end) "Every change indicates that a table might need an update." (setq org-table-may-need-update t)) (defvar org-mode-map) @@ -5379,9 +5501,6 @@ This variable is set by `org-before-change-function'. (defvar buffer-face-mode-face) (require 'outline) -(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22")) -(require 'noutline "noutline" 'noerror) ;; stock XEmacs does not have it ;; Other stuff we need. (require 'time-date) @@ -5408,15 +5527,15 @@ This variable is set by `org-before-change-function'. "Outline-based notes management and organizer, alias \"Carsten's outline-mode for keeping track of everything.\" -Org-mode develops organizational tasks around a NOTES file which -contains information about projects as plain text. Org-mode is -implemented on top of outline-mode, which is ideal to keep the content +Org mode develops organizational tasks around a NOTES file which +contains information about projects as plain text. Org mode is +implemented on top of Outline mode, which is ideal to keep the content of large files well structured. It supports ToDo items, deadlines and time stamps, which magically appear in the diary listing of the Emacs calendar. Tables are easily created with a built-in table editor. Plain text URL-like links connect to websites, emails (VM), Usenet messages (Gnus), BBDB entries, and any files related to the project. -For printing and sharing of notes, an Org-mode file (or a part of it) +For printing and sharing of notes, an Org file (or a part of it) can be exported as a structured ASCII or HTML file. The following commands are available: @@ -5426,29 +5545,18 @@ The following commands are available: ;; Get rid of Outline menus, they are not needed ;; Need to do this here because define-derived-mode sets up ;; the keymap so late. Still, it is a waste to call this each time - ;; we switch another buffer into org-mode. - (if (featurep 'xemacs) - (when (boundp 'outline-mode-menu-heading) - ;; Assume this is Greg's port, it uses easymenu - (easy-menu-remove outline-mode-menu-heading) - (easy-menu-remove outline-mode-menu-show) - (easy-menu-remove outline-mode-menu-hide)) - (define-key org-mode-map [menu-bar headings] 'undefined) - (define-key org-mode-map [menu-bar hide] 'undefined) - (define-key org-mode-map [menu-bar show] 'undefined)) + ;; we switch another buffer into Org mode. + (define-key org-mode-map [menu-bar headings] 'undefined) + (define-key org-mode-map [menu-bar hide] 'undefined) + (define-key org-mode-map [menu-bar show] 'undefined) (org-load-modules-maybe) - (when (featurep 'xemacs) - (easy-menu-add org-org-menu) - (easy-menu-add org-tbl-menu)) (org-install-agenda-files-menu) - (if org-descriptive-links (add-to-invisibility-spec '(org-link))) + (when org-descriptive-links (add-to-invisibility-spec '(org-link))) (add-to-invisibility-spec '(org-cwidth)) (add-to-invisibility-spec '(org-hide-block . t)) - (when (featurep 'xemacs) - (org-set-local 'line-move-ignore-invisible t)) - (org-set-local 'outline-regexp org-outline-regexp) - (org-set-local 'outline-level 'org-outline-level) + (setq-local outline-regexp org-outline-regexp) + (setq-local outline-level 'org-outline-level) (setq bidi-paragraph-direction 'left-to-right) (when (and org-ellipsis (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) @@ -5457,10 +5565,8 @@ The following commands are available: (setq org-display-table (make-display-table))) (set-display-table-slot org-display-table 4 - (vconcat (mapcar - (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) - org-ellipsis))) - (if (stringp org-ellipsis) org-ellipsis "...")))) + (vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis)) + (if (stringp org-ellipsis) org-ellipsis "...")))) (setq buffer-display-table org-display-table)) (org-set-regexps-and-options) (org-set-font-lock-defaults) @@ -5468,29 +5574,25 @@ The following commands are available: ;; tag faces set outside customize.... force initialization. (org-set-tag-faces 'org-tag-faces org-tag-faces)) ;; Calc embedded - (org-set-local 'calc-embedded-open-mode "# ") + (setq-local calc-embedded-open-mode "# ") ;; Modify a few syntax entries (modify-syntax-entry ?@ "w") (modify-syntax-entry ?\" "\"") (modify-syntax-entry ?\\ "_") (modify-syntax-entry ?~ "_") - (if org-startup-truncated (setq truncate-lines t)) - (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) - (org-set-local 'font-lock-unfontify-region-function - 'org-unfontify-region) + (setq-local font-lock-unfontify-region-function 'org-unfontify-region) ;; Activate before-change-function - (org-set-local 'org-table-may-need-update t) - (org-add-hook 'before-change-functions 'org-before-change-function nil - 'local) + (setq-local org-table-may-need-update t) + (add-hook 'before-change-functions 'org-before-change-function nil 'local) ;; Check for running clock before killing a buffer - (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) + (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) ;; Initialize macros templates. (org-macro-initialize-templates) ;; Initialize radio targets. (org-update-radio-target-regexp) ;; Indentation. - (org-set-local 'indent-line-function 'org-indent-line) - (org-set-local 'indent-region-function 'org-indent-region) + (setq-local indent-line-function 'org-indent-line) + (setq-local indent-region-function 'org-indent-region) ;; Filling and auto-filling. (org-setup-filling) ;; Comments. @@ -5498,15 +5600,15 @@ The following commands are available: ;; Initialize cache. (org-element-cache-reset) ;; Beginning/end of defun - (org-set-local 'beginning-of-defun-function 'org-backward-element) - (org-set-local 'end-of-defun-function - (lambda () - (if (not (org-at-heading-p)) - (org-forward-element) - (org-forward-element) - (forward-char -1)))) + (setq-local beginning-of-defun-function 'org-backward-element) + (setq-local end-of-defun-function + (lambda () + (if (not (org-at-heading-p)) + (org-forward-element) + (org-forward-element) + (forward-char -1)))) ;; Next error for sparse trees - (org-set-local 'next-error-function 'org-occur-next-match) + (setq-local next-error-function 'org-occur-next-match) ;; Make sure dependence stuff works reliably, even for users who set it ;; too late :-( (if org-enforce-todo-dependencies @@ -5521,72 +5623,60 @@ The following commands are available: 'org-block-todo-from-checkboxes)) ;; Align options lines - (org-set-local - 'align-mode-rules-list + (setq-local + align-mode-rules-list '((org-in-buffer-settings (regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") (modes . '(org-mode))))) ;; Imenu - (org-set-local 'imenu-create-index-function - 'org-imenu-get-tree) + (setq-local imenu-create-index-function 'org-imenu-get-tree) ;; Make isearch reveal context - (if (or (featurep 'xemacs) - (not (boundp 'outline-isearch-open-invisible-function))) - ;; Emacs 21 and XEmacs make use of the hook - (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) - ;; Emacs 22 deals with this through a special variable - (org-set-local 'outline-isearch-open-invisible-function - (lambda (&rest ignore) (org-show-context 'isearch)))) + (setq-local outline-isearch-open-invisible-function + (lambda (&rest _) (org-show-context 'isearch))) ;; Setup the pcomplete hooks - (set (make-local-variable 'pcomplete-command-completion-function) - 'org-pcomplete-initial) - (set (make-local-variable 'pcomplete-command-name-function) - 'org-command-at-point) - (set (make-local-variable 'pcomplete-default-completion-function) - 'ignore) - (set (make-local-variable 'pcomplete-parse-arguments-function) - 'org-parse-arguments) - (set (make-local-variable 'pcomplete-termination-string) "") - (when (>= emacs-major-version 23) - (set (make-local-variable 'buffer-face-mode-face) 'org-default)) - - ;; If empty file that did not turn on org-mode automatically, make it to. - (if (and org-insert-mode-line-in-empty-file - (org-called-interactively-p 'any) - (= (point-min) (point-max))) - (insert "# -*- mode: org -*-\n\n")) + (setq-local pcomplete-command-completion-function 'org-pcomplete-initial) + (setq-local pcomplete-command-name-function 'org-command-at-point) + (setq-local pcomplete-default-completion-function 'ignore) + (setq-local pcomplete-parse-arguments-function 'org-parse-arguments) + (setq-local pcomplete-termination-string "") + (setq-local buffer-face-mode-face 'org-default) + + ;; If empty file that did not turn on Org mode automatically, make + ;; it to. + (when (and org-insert-mode-line-in-empty-file + (called-interactively-p 'any) + (= (point-min) (point-max))) + (insert "# -*- mode: org -*-\n\n")) (unless org-inhibit-startup (org-unmodified - (and org-startup-with-beamer-mode (org-beamer-mode)) + (when org-startup-with-beamer-mode (org-beamer-mode)) (when org-startup-align-all-tables - (org-table-map-tables 'org-table-align 'quietly)) - (when org-startup-with-inline-images - (org-display-inline-images)) - (when org-startup-with-latex-preview - (org-toggle-latex-fragment)) - (unless org-inhibit-startup-visibility-stuff - (org-set-startup-visibility)) + (org-table-map-tables #'org-table-align t)) + (when org-startup-with-inline-images (org-display-inline-images)) + (when org-startup-with-latex-preview (org-toggle-latex-fragment)) + (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility)) + (when org-startup-truncated (setq truncate-lines t)) + (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) (org-refresh-effort-properties))) - ;; Try to set org-hide correctly + ;; Try to set `org-hide' face correctly. (let ((foreground (org-find-invisible-foreground))) - (if foreground - (set-face-foreground 'org-hide foreground)))) + (when foreground + (set-face-foreground 'org-hide foreground)))) ;; Update `customize-package-emacs-version-alist' (add-to-list 'customize-package-emacs-version-alist '(Org ("6.21b" . "23.1") ("6.33x" . "23.2") ("7.8.11" . "24.1") ("7.9.4" . "24.3") - ("8.2.6" . "24.4") ("8.3" . "25.1"))) + ("8.2.6" . "24.4") ("8.2.10" . "24.5") + ("9.0" . "25.2"))) (defvar org-mode-transpose-word-syntax-table (let ((st (make-syntax-table text-mode-syntax-table))) - (mapc (lambda(c) (modify-syntax-entry - (string-to-char (car c)) "w p" st)) - org-emphasis-alist) - st)) + (dolist (c org-emphasis-alist st) + (modify-syntax-entry (string-to-char (car c)) "w p" st)))) (when (fboundp 'abbrev-table-put) (abbrev-table-put org-mode-abbrev-table @@ -5601,7 +5691,7 @@ The following commands are available: (mapcar (lambda (alist) (when (boundp alist) - (cdr (assoc 'background-color (symbol-value alist))))) + (cdr (assq 'background-color (symbol-value alist))))) '(default-frame-alist initial-frame-alist window-system-default-frame-alist)) (list (face-foreground 'org-hide)))))) (car (remove nil candidates)))) @@ -5620,8 +5710,8 @@ the rounding returns a past time." (apply 'encode-time (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) (nthcdr 2 time)))) - (if (and past (< (org-float-time (time-subtract (current-time) res)) 0)) - (seconds-to-time (- (org-float-time res) (* r 60))) + (if (and past (< (float-time (time-subtract (current-time) res)) 0)) + (seconds-to-time (- (float-time res) (* r 60))) res)))) (defun org-today () @@ -5644,9 +5734,6 @@ the rounding returns a past time." (require 'font-lock) (defconst org-non-link-chars "]\t\n\r<>") -(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "file+emacs" - "file+sys" "news" "shell" "elisp" "doi" "message" - "help")) (defvar org-link-types-re nil "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil @@ -5713,8 +5800,8 @@ stacked delimiters is N. Escaping delimiters is not possible." (defun org-make-link-regexps () "Update the link regular expressions. -This should be called after the variable `org-link-types' has changed." - (let ((types-re (regexp-opt org-link-types t))) +This should be called after the variable `org-link-parameters' has changed." + (let ((types-re (regexp-opt (org-link-types) t))) (setq org-link-types-re (concat "\\`" types-re ":") org-link-re-with-space @@ -5737,7 +5824,7 @@ This should be called after the variable `org-link-types' has changed." org-plain-link-re (concat "\\<" types-re ":" - (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")) + "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)") ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") org-bracket-link-regexp "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" @@ -5752,7 +5839,7 @@ This should be called after the variable `org-link-types' has changed." org-bracket-link-analytic-regexp++ (concat "\\[\\[" - "\\(" (regexp-opt (cons "coderef" org-link-types) t) ":\\)?" + "\\(" (regexp-opt (cons "coderef" (org-link-types)) t) ":\\)?" "\\([^]]+\\)" "\\]" "\\(\\[" "\\([^]]+\\)" "\\]\\)?" @@ -5772,28 +5859,26 @@ This should be called after the variable `org-link-types' has changed." (while (and (not rtn) (re-search-forward org-emph-re limit t)) (let* ((border (char-after (match-beginning 3))) (bre (regexp-quote (char-to-string border)))) - (if (and (not (= border (char-after (match-beginning 4)))) - (not (save-match-data - (string-match (concat bre ".*" bre) - (replace-regexp-in-string - "\n" " " - (substring (match-string 2) 1 -1)))))) - (progn - (setq rtn t) - (setq a (assoc (match-string 3) org-emphasis-alist)) - (font-lock-prepend-text-property (match-beginning 2) (match-end 2) - 'face - (nth 1 a)) - (and (nth 2 a) - (org-remove-flyspell-overlays-in - (match-beginning 0) (match-end 0))) - (add-text-properties (match-beginning 2) (match-end 2) - '(font-lock-multiline t org-emphasis t)) - (when org-hide-emphasis-markers - (add-text-properties (match-end 4) (match-beginning 5) - '(invisible org-link)) - (add-text-properties (match-beginning 3) (match-end 3) - '(invisible org-link)))))) + (when (and (not (= border (char-after (match-beginning 4)))) + (not (string-match-p (concat bre ".*" bre) + (replace-regexp-in-string + "\n" " " + (substring (match-string 2) 1 -1))))) + (setq rtn t) + (setq a (assoc (match-string 3) org-emphasis-alist)) + (font-lock-prepend-text-property (match-beginning 2) (match-end 2) + 'face + (nth 1 a)) + (and (nth 2 a) + (org-remove-flyspell-overlays-in + (match-beginning 0) (match-end 0))) + (add-text-properties (match-beginning 2) (match-end 2) + '(font-lock-multiline t org-emphasis t)) + (when org-hide-emphasis-markers + (add-text-properties (match-end 4) (match-beginning 5) + '(invisible org-link)) + (add-text-properties (match-beginning 3) (match-end 3) + '(invisible org-link))))) (goto-char (1+ (match-beginning 0)))) rtn)) @@ -5808,19 +5893,20 @@ If CHAR is not given (for example in an interactive call) it will be prompted for." (interactive) (let ((erc org-emphasis-regexp-components) - (prompt "") - (string "") beg end move c s) + (string "") beg end move s) (if (org-region-active-p) - (setq beg (region-beginning) end (region-end) + (setq beg (region-beginning) + end (region-end) string (buffer-substring beg end)) (setq move t)) (unless char (message "Emphasis marker or tag: [%s]" - (mapconcat (lambda(e) (car e)) org-emphasis-alist "")) + (mapconcat #'car org-emphasis-alist "")) (setq char (read-char-exclusive))) - (if (equal char ?\ ) - (setq s "" move nil) + (if (equal char ?\s) + (setq s "" + move nil) (unless (assoc (char-to-string char) org-emphasis-alist) (user-error "No such emphasis marker: \"%c\"" char)) (setq s (char-to-string char))) @@ -5829,7 +5915,7 @@ prompted for." (assoc (substring string 0 1) org-emphasis-alist)) (setq string (substring string 1 -1))) (setq string (concat s string s)) - (if beg (delete-region beg end)) + (when beg (delete-region beg end)) (unless (or (bolp) (string-match (concat "[" (nth 0 erc) "\n]") (char-to-string (char-before (point))))) @@ -5851,29 +5937,69 @@ prompted for." "Add link properties for plain links." (when (and (re-search-forward org-plain-link-re limit t) (not (org-in-src-block-p))) - (let ((face (get-text-property (max (1- (match-beginning 0)) (point-min)) - 'face)) - (link (org-match-string-no-properties 0))) + + (let* ((face (get-text-property (max (1- (match-beginning 0)) (point-min)) + 'face)) + (link (match-string-no-properties 0)) + (type (match-string-no-properties 1)) + (path (match-string-no-properties 2)) + (link-start (match-beginning 0)) + (link-end (match-end 0)) + (link-face (org-link-get-parameter type :face)) + (help-echo (org-link-get-parameter type :help-echo)) + (htmlize-link (org-link-get-parameter type :htmlize-link)) + (activate-func (org-link-get-parameter type :activate-func))) (unless (if (consp face) (memq 'org-tag face) (eq 'org-tag face)) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'face 'org-link - 'htmlize-link `(:uri ,link) - 'keymap org-mouse-map)) + (list + 'mouse-face (or (org-link-get-parameter type :mouse-face) + 'highlight) + 'face (cond + ;; A function that returns a face + ((functionp link-face) + (funcall link-face path)) + ;; a face + ((facep link-face) + link-face) + ;; An anonymous face + ((consp link-face) + link-face) + ;; default + (t + 'org-link)) + 'help-echo (cond + ((stringp help-echo) + help-echo) + ((functionp help-echo) + help-echo) + (t + (concat "LINK: " + (save-match-data + (org-link-unescape link))))) + 'htmlize-link (cond + ((functionp htmlize-link) + (funcall htmlize-link path)) + (t + `(:uri ,link))) + 'keymap (or (org-link-get-parameter type :keymap) + org-mouse-map) + 'org-link-start (match-beginning 0))) (org-rear-nonsticky-at (match-end 0)) + (when activate-func + (funcall activate-func link-start link-end path nil)) t)))) (defun org-activate-code (limit) - (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - t))) + (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + t)) (defcustom org-src-fontify-natively t - "When non-nil, fontify code in code blocks." + "When non-nil, fontify code in code blocks. +See also the `org-block' face." :type 'boolean :version "24.4" :package-version '(Org . "8.3") @@ -5891,95 +6017,106 @@ by a #." (defun org-fontify-meta-lines-and-blocks (limit) (condition-case nil (org-fontify-meta-lines-and-blocks-1 limit) - (error (message "org-mode fontification error")))) + (error (message "org-mode fontification error in %S at %d" + (current-buffer) + (line-number-at-pos))))) (defun org-fontify-meta-lines-and-blocks-1 (limit) "Fontify #+ lines and blocks." (let ((case-fold-search t)) - (if (re-search-forward - "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" - limit t) - (let ((beg (match-beginning 0)) - (block-start (match-end 0)) - (block-end nil) - (lang (match-string 7)) - (beg1 (line-beginning-position 2)) - (dc1 (downcase (match-string 2))) - (dc3 (downcase (match-string 3))) - end end1 quoting block-type ovl) - (cond - ((and (match-end 4) (equal dc3 "+begin")) - ;; Truly a block - (setq block-type (downcase (match-string 5)) - quoting (member block-type org-protecting-blocks)) - (when (re-search-forward - (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") - nil t) ;; on purpose, we look further than LIMIT - (setq end (min (point-max) (match-end 0)) - end1 (min (point-max) (1- (match-beginning 0)))) - (setq block-end (match-beginning 0)) - (when quoting - (org-remove-flyspell-overlays-in beg1 end1) - (remove-text-properties beg end - '(display t invisible t intangible t))) - (add-text-properties - beg end '(font-lock-fontified t font-lock-multiline t)) - (add-text-properties beg beg1 '(face org-meta-line)) - (org-remove-flyspell-overlays-in beg beg1) - (add-text-properties ; For end_src - end1 (min (point-max) (1+ end)) '(face org-meta-line)) - (org-remove-flyspell-overlays-in end1 end) - (cond - ((and lang (not (string= lang "")) org-src-fontify-natively) - (org-src-font-lock-fontify-block lang block-start block-end) - (add-text-properties beg1 block-end '(src-block t))) - (quoting - (add-text-properties beg1 (min (point-max) (1+ end1)) - '(face org-block))) ; end of source block - ((not org-fontify-quote-and-verse-blocks)) - ((string= block-type "quote") - (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote))) - ((string= block-type "verse") - (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse)))) - (add-text-properties beg beg1 '(face org-block-begin-line)) - (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) - '(face org-block-end-line)) - t)) - ((member dc1 '("+title:" "+author:" "+email:" "+date:")) - (org-remove-flyspell-overlays-in - (match-beginning 0) - (if (equal "+title:" dc1) (match-end 2) (match-end 0))) - (add-text-properties - beg (match-end 3) - (if (member (intern (substring dc1 1 -1)) org-hidden-keywords) - '(font-lock-fontified t invisible t) - '(font-lock-fontified t face org-document-info-keyword))) - (add-text-properties - (match-beginning 6) (min (point-max) (1+ (match-end 6))) - (if (string-equal dc1 "+title:") - '(font-lock-fontified t face org-document-title) - '(font-lock-fontified t face org-document-info)))) - ((equal dc1 "+caption:") - (org-remove-flyspell-overlays-in (match-end 2) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - (add-text-properties (match-beginning 1) (match-end 3) - '(font-lock-fontified t face org-meta-line)) - (add-text-properties (match-beginning 6) (+ (match-end 6) 1) - '(font-lock-fontified t face org-block)) - t) - ((member dc3 '(" " "")) - (org-remove-flyspell-overlays-in beg (match-end 0)) + (when (re-search-forward + "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" + limit t) + (let ((beg (match-beginning 0)) + (block-start (match-end 0)) + (block-end nil) + (lang (match-string 7)) + (beg1 (line-beginning-position 2)) + (dc1 (downcase (match-string 2))) + (dc3 (downcase (match-string 3))) + end end1 quoting block-type) + (cond + ((and (match-end 4) (equal dc3 "+begin")) + ;; Truly a block + (setq block-type (downcase (match-string 5)) + quoting (member block-type org-protecting-blocks)) + (when (re-search-forward + (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") + nil t) ;; on purpose, we look further than LIMIT + (setq end (min (point-max) (match-end 0)) + end1 (min (point-max) (1- (match-beginning 0)))) + (setq block-end (match-beginning 0)) + (when quoting + (org-remove-flyspell-overlays-in beg1 end1) + (remove-text-properties beg end + '(display t invisible t intangible t))) (add-text-properties - beg (match-end 0) - '(font-lock-fontified t face font-lock-comment-face))) - (t ;; just any other in-buffer setting, but not indented - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - (add-text-properties beg (match-end 0) - '(font-lock-fontified t face org-meta-line)) - t)))))) + beg end '(font-lock-fontified t font-lock-multiline t)) + (add-text-properties beg beg1 '(face org-meta-line)) + (org-remove-flyspell-overlays-in beg beg1) + (add-text-properties ; For end_src + end1 (min (point-max) (1+ end)) '(face org-meta-line)) + (org-remove-flyspell-overlays-in end1 end) + (cond + ((and lang (not (string= lang "")) org-src-fontify-natively) + (org-src-font-lock-fontify-block lang block-start block-end) + (add-text-properties beg1 block-end '(src-block t))) + (quoting + (add-text-properties beg1 (min (point-max) (1+ end1)) + (list 'face + (list :inherit + (let ((face-name + (intern (format "org-block-%s" lang)))) + (append (and (facep face-name) (list face-name)) + '(org-block))))))) ; end of source block + ((not org-fontify-quote-and-verse-blocks)) + ((string= block-type "quote") + (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote))) + ((string= block-type "verse") + (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse)))) + (add-text-properties beg beg1 '(face org-block-begin-line)) + (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) + '(face org-block-end-line)) + t)) + ((member dc1 '("+title:" "+author:" "+email:" "+date:")) + (org-remove-flyspell-overlays-in + (match-beginning 0) + (if (equal "+title:" dc1) (match-end 2) (match-end 0))) + (add-text-properties + beg (match-end 3) + (if (member (intern (substring dc1 1 -1)) org-hidden-keywords) + '(font-lock-fontified t invisible t) + '(font-lock-fontified t face org-document-info-keyword))) + (add-text-properties + (match-beginning 6) (min (point-max) (1+ (match-end 6))) + (if (string-equal dc1 "+title:") + '(font-lock-fontified t face org-document-title) + '(font-lock-fontified t face org-document-info)))) + ((string-prefix-p "+caption" dc1) + (org-remove-flyspell-overlays-in (match-end 2) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + ;; Handle short captions. + (save-excursion + (beginning-of-line) + (looking-at "\\([ \t]*#\\+caption\\(?:\\[.*\\]\\)?:\\)[ \t]*")) + (add-text-properties (line-beginning-position) (match-end 1) + '(font-lock-fontified t face org-meta-line)) + (add-text-properties (match-end 0) (line-end-position) + '(font-lock-fontified t face org-block)) + t) + ((member dc3 '(" " "")) + (org-remove-flyspell-overlays-in beg (match-end 0)) + (add-text-properties + beg (match-end 0) + '(font-lock-fontified t face font-lock-comment-face))) + (t ;; just any other in-buffer setting, but not indented + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + (add-text-properties beg (match-end 0) + '(font-lock-fontified t face org-meta-line)) + t)))))) (defun org-fontify-drawers (limit) "Fontify drawers." @@ -6006,16 +6143,15 @@ by a #." (defun org-activate-angle-links (limit) "Add text properties for angle links." - (if (and (re-search-forward org-angle-link-re limit t) - (not (org-in-src-block-p))) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'keymap org-mouse-map - 'font-lock-multiline t)) - (org-rear-nonsticky-at (match-end 0)) - t))) + (when (and (re-search-forward org-angle-link-re limit t) + (not (org-in-src-block-p))) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'keymap org-mouse-map + 'font-lock-multiline t)) + (org-rear-nonsticky-at (match-end 0)) + t)) (defun org-activate-footnote-links (limit) "Add text properties for footnotes." @@ -6042,58 +6178,111 @@ by a #." (defun org-activate-bracket-links (limit) "Add text properties for bracketed links." - (if (and (re-search-forward org-bracket-link-regexp limit t) - (not (org-in-src-block-p))) - (let* ((hl (org-match-string-no-properties 1)) - (help (concat "LINK: " (save-match-data (org-link-unescape hl)))) - (ip (org-maybe-intangible - (list 'invisible 'org-link - 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help - 'htmlize-link `(:uri ,hl)))) - (vp (list 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help - 'htmlize-link `(:uri ,hl)))) - ;; We need to remove the invisible property here. Table narrowing - ;; may have made some of this invisible. - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(invisible nil)) - (if (match-end 3) - (progn - (add-text-properties (match-beginning 0) (match-beginning 3) ip) - (org-rear-nonsticky-at (match-beginning 3)) - (add-text-properties (match-beginning 3) (match-end 3) vp) - (org-rear-nonsticky-at (match-end 3)) - (add-text-properties (match-end 3) (match-end 0) ip) - (org-rear-nonsticky-at (match-end 0))) - (add-text-properties (match-beginning 0) (match-beginning 1) ip) - (org-rear-nonsticky-at (match-beginning 1)) - (add-text-properties (match-beginning 1) (match-end 1) vp) - (org-rear-nonsticky-at (match-end 1)) - (add-text-properties (match-end 1) (match-end 0) ip) - (org-rear-nonsticky-at (match-end 0))) - t))) + (when (and (re-search-forward org-bracket-link-regexp limit t) + (not (org-in-src-block-p))) + (let* ((hl (save-match-data + (org-link-expand-abbrev (match-string-no-properties 1)))) + (type (save-match-data + (and (string-match org-plain-link-re hl) + (match-string-no-properties 1 hl)))) + (path (save-match-data + (and (string-match org-plain-link-re hl) + (match-string-no-properties 2 hl)))) + (link-start (match-beginning 0)) + (link-end (match-end 0)) + (bracketp t) + (help-echo (org-link-get-parameter type :help-echo)) + (help (cond + ((stringp help-echo) + help-echo) + ((functionp help-echo) + help-echo) + (t + (concat "LINK: " + (save-match-data + (org-link-unescape hl)))))) + (link-face (org-link-get-parameter type :face)) + (face (cond + ;; A function that returns a face + ((functionp link-face) + (funcall link-face path)) + ;; a face + ((facep link-face) + link-face) + ;; An anonymous face + ((consp link-face) + link-face) + ;; default + (t + 'org-link))) + (keymap (or (org-link-get-parameter type :keymap) + org-mouse-map)) + (mouse-face (or (org-link-get-parameter type :mouse-face) + 'highlight)) + (htmlize (org-link-get-parameter type :htmlize-link)) + (htmlize-link (cond + ((functionp htmlize) + (funcall htmlize)) + (t + `(:uri ,(format "%s:%s" type path))))) + (activate-func (org-link-get-parameter type :activate-func)) + ;; invisible part + (ip (list 'invisible (or + (org-link-get-parameter type :display) + 'org-link) + 'face face + 'keymap keymap + 'mouse-face mouse-face + 'font-lock-multiline t + 'help-echo help + 'htmlize-link htmlize-link)) + ;; visible part + (vp (list 'keymap keymap + 'face face + 'mouse-face mouse-face + 'font-lock-multiline t + 'help-echo help + 'htmlize-link htmlize-link))) + ;; We need to remove the invisible property here. Table narrowing + ;; may have made some of this invisible. + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(invisible nil)) + (if (match-end 3) + (progn + (add-text-properties (match-beginning 0) (match-beginning 3) ip) + (org-rear-nonsticky-at (match-beginning 3)) + (add-text-properties (match-beginning 3) (match-end 3) vp) + (org-rear-nonsticky-at (match-end 3)) + (add-text-properties (match-end 3) (match-end 0) ip) + (org-rear-nonsticky-at (match-end 0))) + (add-text-properties (match-beginning 0) (match-beginning 1) ip) + (org-rear-nonsticky-at (match-beginning 1)) + (add-text-properties (match-beginning 1) (match-end 1) vp) + (org-rear-nonsticky-at (match-end 1)) + (add-text-properties (match-end 1) (match-end 0) ip) + (org-rear-nonsticky-at (match-end 0))) + (when activate-func + (funcall activate-func link-start link-end path bracketp)) + t))) (defun org-activate-dates (limit) "Add text properties for dates." - (if (and (re-search-forward org-tsr-regexp-both limit t) - (not (equal (char-before (match-beginning 0)) 91))) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 0)) - (when org-display-custom-times - (if (match-end 3) - (org-display-custom-time (match-beginning 3) (match-end 3))) - (org-display-custom-time (match-beginning 1) (match-end 1))) - t))) + (when (and (re-search-forward org-tsr-regexp-both limit t) + (not (equal (char-before (match-beginning 0)) 91))) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 0)) + (when org-display-custom-times + (if (match-end 3) + (org-display-custom-time (match-beginning 3) (match-end 3)) + (org-display-custom-time (match-beginning 1) (match-end 1)))) + t)) -(defvar org-target-link-regexp nil +(defvar-local org-target-link-regexp nil "Regular expression matching radio targets in plain text.") -(make-variable-buffer-local 'org-target-link-regexp) (defconst org-target-regexp (let ((border "[^<>\n\r \t]")) (format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>" @@ -6111,16 +6300,15 @@ by a #." "Add text properties for target matches." (when org-target-link-regexp (let ((case-fold-search t)) - (if (re-search-forward org-target-link-regexp limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) - (add-text-properties (match-beginning 1) (match-end 1) - (list 'mouse-face 'highlight - 'keymap org-mouse-map - 'help-echo "Radio target link" - 'org-linked-text t)) - (org-rear-nonsticky-at (match-end 1)) - t))))) + (when (re-search-forward org-target-link-regexp limit t) + (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) + (add-text-properties (match-beginning 1) (match-end 1) + (list 'mouse-face 'highlight + 'keymap org-mouse-map + 'help-echo "Radio target link" + 'org-linked-text t)) + (org-rear-nonsticky-at (match-end 1)) + t)))) (defun org-update-radio-target-regexp () "Find all radio targets in this file and update the regular expression. @@ -6138,7 +6326,8 @@ Also refresh fontification if needed." (backward-char) (let ((obj (org-element-context))) (when (eq (org-element-type obj) 'radio-target) - (add-to-list 'rtn (org-element-property :value obj))))) + (cl-pushnew (org-element-property :value obj) rtn + :test #'equal)))) rtn)))) (setq org-target-link-regexp (and targets @@ -6177,7 +6366,7 @@ Also refresh fontification if needed." 'org-cwidth t)) (when s (setq e (next-single-property-change s 'org-cwidth)) - (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth))) + (add-text-properties s e '(invisible org-cwidth)) (goto-char e) t))) @@ -6187,8 +6376,8 @@ Also refresh fontification if needed." (defun org-compute-latex-and-related-regexp () "Compute regular expression for LaTeX, entities and sub/superscript. Result depends on variable `org-highlight-latex-and-related'." - (org-set-local - 'org-latex-and-related-regexp + (setq-local + org-latex-and-related-regexp (let* ((re-sub (cond ((not (memq 'script org-highlight-latex-and-related)) nil) ((eq org-use-sub-superscripts '{}) @@ -6214,9 +6403,13 @@ done, nil otherwise." (when (org-string-nw-p org-latex-and-related-regexp) (catch 'found (while (re-search-forward org-latex-and-related-regexp limit t) - (unless (memq (car-safe (get-text-property (1+ (match-beginning 0)) - 'face)) - '(org-code org-verbatim underline)) + (unless + (cl-some + (lambda (f) + (memq f '(org-code org-verbatim underline org-special-keyword))) + (save-excursion + (goto-char (1+ (match-beginning 0))) + (face-at-point nil t))) (let ((offset (if (memq (char-after (1+ (match-beginning 0))) '(?_ ?^)) 1 @@ -6237,7 +6430,7 @@ done, nil otherwise." (defun org-activate-tags (limit) (when (re-search-forward - (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") limit t) + "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" limit t) (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) (add-text-properties (match-beginning 1) (match-end 1) (list 'mouse-face 'highlight @@ -6298,6 +6491,8 @@ There are four matching groups: (defvar org-font-lock-hook nil "Functions to be called for special font lock stuff.") +(defvar org-font-lock-extra-keywords nil) ;Dynamically scoped. + (defvar org-font-lock-set-keywords-hook nil "Functions that can manipulate `org-font-lock-extra-keywords'. This is called after `org-font-lock-extra-keywords' is defined, but before @@ -6338,13 +6533,13 @@ needs to be inserted at a specific position in the font-lock sequence.") '(1 'org-special-keyword t) '(3 'org-property-value t)) ;; Links - (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) - (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) - (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) - (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) - (if (memq 'radio lk) '(org-activate-target-links (1 'org-link t))) - (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) - (if (memq 'footnote lk) '(org-activate-footnote-links)) + (when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) + (when (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) + (when (memq 'plain lk) '(org-activate-plain-links (0 'org-link))) + (when (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link))) + (when (memq 'radio lk) '(org-activate-target-links (1 'org-link t))) + (when (memq 'date lk) '(org-activate-dates (0 'org-date t))) + (when (memq 'footnote lk) '(org-activate-footnote-links)) ;; Targets. (list org-any-target-regexp '(0 'org-target t)) ;; Diary sexps. @@ -6370,27 +6565,24 @@ needs to be inserted at a specific position in the font-lock sequence.") ;; Tags '(org-font-lock-add-tag-faces) ;; Tags groups - (if (and org-group-tags org-tag-groups-alist) - (list (concat org-outline-regexp-bol ".+\\(:" - (regexp-opt (mapcar 'car org-tag-groups-alist)) - ":\\).*$") - '(1 'org-tag-group prepend))) + (when (and org-group-tags org-tag-groups-alist) + (list (concat org-outline-regexp-bol ".+\\(:" + (regexp-opt (mapcar 'car org-tag-groups-alist)) + ":\\).*$") + '(1 'org-tag-group prepend))) ;; Special keywords (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) ;; Emphasis - (if em - (if (featurep 'xemacs) - '(org-do-emphasis-faces (0 nil append)) - '(org-do-emphasis-faces))) + (when em '(org-do-emphasis-faces)) ;; Checkboxes '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" 1 'org-checkbox prepend) - (if (cdr (assq 'checkbox org-list-automatic-rules)) - '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" - (0 (org-get-checkbox-statistics-face) t))) + (when (cdr (assq 'checkbox org-list-automatic-rules)) + '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" + (0 (org-get-checkbox-statistics-face) t))) ;; Description list items '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)" 1 'org-list-dt prepend) @@ -6416,26 +6608,26 @@ needs to be inserted at a specific position in the font-lock sequence.") (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) (run-hooks 'org-font-lock-set-keywords-hook) ;; Now set the full font-lock-keywords - (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) - (org-set-local 'font-lock-defaults - '(org-font-lock-keywords t nil nil backward-paragraph)) - (kill-local-variable 'font-lock-keywords) nil)) + (setq-local org-font-lock-keywords org-font-lock-extra-keywords) + (setq-local font-lock-defaults + '(org-font-lock-keywords t nil nil backward-paragraph)) + (kill-local-variable 'font-lock-keywords) + nil)) (defun org-toggle-pretty-entities () "Toggle the composition display of entities as UTF8 characters." (interactive) - (org-set-local 'org-pretty-entities (not org-pretty-entities)) + (setq-local org-pretty-entities (not org-pretty-entities)) (org-restart-font-lock) (if org-pretty-entities (message "Entities are now displayed as UTF8 characters") (save-restriction (widen) - (org-decompose-region (point-min) (point-max)) + (decompose-region (point-min) (point-max)) (message "Entities are now displayed as plain text")))) -(defvar org-custom-properties-overlays nil +(defvar-local org-custom-properties-overlays nil "List of overlays used for custom properties.") -(make-variable-buffer-local 'org-custom-properties-overlays) (defun org-toggle-custom-properties-visibility () "Display or hide properties in `org-custom-properties'." @@ -6475,24 +6667,23 @@ needs to be inserted at a specific position in the font-lock sequence.") (while (re-search-forward "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)" limit t) - (if (and (not (org-at-comment-p)) - (setq ee (org-entity-get (match-string 1))) - (= (length (nth 6 ee)) 1)) - (let* - ((end (if (equal (match-string 2) "{}") + (when (and (not (org-at-comment-p)) + (setq ee (org-entity-get (match-string 1))) + (= (length (nth 6 ee)) 1)) + (let* ((end (if (equal (match-string 2) "{}") (match-end 2) (match-end 1)))) - (add-text-properties - (match-beginning 0) end - (list 'font-lock-fontified t)) - (compose-region (match-beginning 0) end - (nth 6 ee) nil) - (backward-char 1) - (throw 'match t)))) + (add-text-properties + (match-beginning 0) end + (list 'font-lock-fontified t)) + (compose-region (match-beginning 0) end + (nth 6 ee) nil) + (backward-char 1) + (throw 'match t)))) nil)))) (defun org-fontify-like-in-org-mode (s &optional odd-levels) - "Fontify string S like in Org-mode." + "Fontify string S like in Org mode." (with-temp-buffer (insert s) (let ((org-odd-levels-only odd-levels)) @@ -6506,14 +6697,14 @@ needs to be inserted at a specific position in the font-lock sequence.") (defun org-get-level-face (n) "Get the right face for match N in font-lock matching of headlines." (setq org-l (- (match-end 2) (match-beginning 1) 1)) - (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) + (when org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) (if org-cycle-level-faces (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces))) (cond ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) ((eq n 2) org-f) - (t (if org-level-color-stars-only nil org-f)))) + (t (unless org-level-color-stars-only org-f)))) (defun org-face-from-face-or-color (context inherit face-or-color) "Create a face list that inherits INHERIT, but sets the foreground color. @@ -6527,7 +6718,7 @@ When FACE-OR-COLOR is not a string, just return it." (defun org-get-todo-face (kwd) "Get the right face for a TODO keyword KWD. If KWD is a number, get the corresponding match group." - (if (numberp kwd) (setq kwd (match-string kwd))) + (when (numberp kwd) (setq kwd (match-string kwd))) (or (org-face-from-face-or-color 'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces))) (and (member kwd org-done-keywords) 'org-done) @@ -6565,14 +6756,14 @@ If TAG is a number, get the corresponding match group." 'font-lock-fontified t)) (backward-char 1)))) -(defun org-unfontify-region (beg end &optional maybe_loudly) +(defun org-unfontify-region (beg end &optional _maybe_loudly) "Remove fontification and activation overlays from links." (font-lock-default-unfontify-region beg end) (let* ((buffer-undo-list t) (inhibit-read-only t) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) - (org-decompose-region beg end) + (decompose-region beg end) (remove-text-properties beg end '(mouse-face t keymap t org-linked-text t invisible t intangible t @@ -6593,59 +6784,56 @@ and subscripts." (while (< beg end) (setq next (next-single-property-change beg 'display nil end) prop (get-text-property beg 'display)) - (if (member prop org-script-display) - (put-text-property beg next 'display nil)) + (when (member prop org-script-display) + (put-text-property beg next 'display nil)) (setq beg next)))) (defun org-raise-scripts (limit) "Add raise properties to sub/superscripts." - (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts) - (if (re-search-forward - (if (eq org-use-sub-superscripts t) - org-match-substring-regexp - org-match-substring-with-braces-regexp) - limit t) - (let* ((pos (point)) table-p comment-p - (mpos (match-beginning 3)) - (emph-p (get-text-property mpos 'org-emphasis)) - (link-p (get-text-property mpos 'mouse-face)) - (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) - (goto-char (point-at-bol)) - (setq table-p (org-looking-at-p org-table-dataline-regexp) - comment-p (org-looking-at-p "^[ \t]*#[ +]")) - (goto-char pos) - ;; Handle a_b^c - (if (member (char-after) '(?_ ?^)) (goto-char (1- pos))) - (if (or comment-p emph-p link-p keyw-p) - t - (put-text-property (match-beginning 3) (match-end 0) - 'display - (if (equal (char-after (match-beginning 2)) ?^) - (nth (if table-p 3 1) org-script-display) - (nth (if table-p 2 0) org-script-display))) - (add-text-properties (match-beginning 2) (match-end 2) - (list 'invisible t - 'org-dwidth t 'org-dwidth-n 1)) - (if (and (eq (char-after (match-beginning 3)) ?{) - (eq (char-before (match-end 3)) ?})) - (progn - (add-text-properties - (match-beginning 3) (1+ (match-beginning 3)) - (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)) - (add-text-properties - (1- (match-end 3)) (match-end 3) - (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))) - t))))) + (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts + (re-search-forward + (if (eq org-use-sub-superscripts t) + org-match-substring-regexp + org-match-substring-with-braces-regexp) + limit t)) + (let* ((pos (point)) table-p comment-p + (mpos (match-beginning 3)) + (emph-p (get-text-property mpos 'org-emphasis)) + (link-p (get-text-property mpos 'mouse-face)) + (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) + (goto-char (point-at-bol)) + (setq table-p (looking-at-p org-table-dataline-regexp) + comment-p (looking-at-p "^[ \t]*#[ +]")) + (goto-char pos) + ;; Handle a_b^c + (when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) + (unless (or comment-p emph-p link-p keyw-p) + (put-text-property (match-beginning 3) (match-end 0) + 'display + (if (equal (char-after (match-beginning 2)) ?^) + (nth (if table-p 3 1) org-script-display) + (nth (if table-p 2 0) org-script-display))) + (add-text-properties (match-beginning 2) (match-end 2) + (list 'invisible t + 'org-dwidth t 'org-dwidth-n 1)) + (if (and (eq (char-after (match-beginning 3)) ?{) + (eq (char-before (match-end 3)) ?})) + (progn + (add-text-properties + (match-beginning 3) (1+ (match-beginning 3)) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)) + (add-text-properties + (1- (match-end 3)) (match-end 3) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))))) + t))) ;;;; Visibility cycling, including org-goto and indirect buffer ;;; Cycling -(defvar org-cycle-global-status nil) -(make-variable-buffer-local 'org-cycle-global-status) +(defvar-local org-cycle-global-status nil) (put 'org-cycle-global-status 'org-state t) -(defvar org-cycle-subtree-status nil) -(make-variable-buffer-local 'org-cycle-subtree-status) +(defvar-local org-cycle-subtree-status nil) (put 'org-cycle-subtree-status 'org-state t) (defvar org-inlinetask-min-level) @@ -6657,53 +6845,58 @@ and subscripts." ;;;###autoload (defun org-cycle (&optional arg) - "TAB-action and visibility cycling for Org-mode. + "TAB-action and visibility cycling for Org mode. -This is the command invoked in Org-mode by the TAB key. Its main purpose -is outline visibility cycling, but it also invokes other actions +This is the command invoked in Org mode by the `TAB' key. Its main +purpose is outline visibility cycling, but it also invokes other actions in special contexts. -- When this function is called with a prefix argument, rotate the entire - buffer through 3 states (global cycling) +When this function is called with a `\\[universal-argument]' prefix, rotate \ +the entire +buffer through 3 states (global cycling) 1. OVERVIEW: Show only top-level headlines. 2. CONTENTS: Show all headlines of all levels, but no body text. 3. SHOW ALL: Show everything. - With a double \\[universal-argument] prefix argument, \ + +With a `\\[universal-argument] \\[universal-argument]' prefix argument, \ switch to the startup visibility, - determined by the variable `org-startup-folded', and by any VISIBILITY - properties in the buffer. - With a triple \\[universal-argument] prefix argument, \ -show the entire buffer, including any drawers. +determined by the variable `org-startup-folded', and by any VISIBILITY +properties in the buffer. -- When inside a table, re-align the table and move to the next field. +With a `\\[universal-argument] \\[universal-argument] \ +\\[universal-argument]' prefix argument, show the entire buffer, including +any drawers. -- When point is at the beginning of a headline, rotate the subtree started - by this line through 3 different states (local cycling) +When inside a table, re-align the table and move to the next field. + +When point is at the beginning of a headline, rotate the subtree started +by this line through 3 different states (local cycling) 1. FOLDED: Only the main headline is shown. 2. CHILDREN: The main headline and the direct children are shown. From this state, you can move to one of the children and zoom in further. 3. SUBTREE: Show the entire subtree, including body text. - If there is no subtree, switch directly from CHILDREN to FOLDED. - -- When point is at the beginning of an empty headline and the variable - `org-cycle-level-after-item/entry-creation' is set, cycle the level - of the headline by demoting and promoting it to likely levels. This - speeds up creation document structure by pressing TAB once or several - times right after creating a new headline. - -- When there is a numeric prefix, go up to a heading with level ARG, do - a `show-subtree' and return to the previous cursor position. If ARG - is negative, go up that many levels. - -- When point is not at the beginning of a headline, execute the global - binding for TAB, which is re-indenting the line. See the option - `org-cycle-emulate-tab' for details. - -- Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg - (\\[universal-argument] TAB, same as S-TAB) also when called without prefix arg. - But only if also the variable `org-cycle-global-at-bob' is t." +If there is no subtree, switch directly from CHILDREN to FOLDED. + +When point is at the beginning of an empty headline and the variable +`org-cycle-level-after-item/entry-creation' is set, cycle the level +of the headline by demoting and promoting it to likely levels. This +speeds up creation document structure by pressing `TAB' once or several +times right after creating a new headline. + +When there is a numeric prefix, go up to a heading with level ARG, do +a `show-subtree' and return to the previous cursor position. If ARG +is negative, go up that many levels. + +When point is not at the beginning of a headline, execute the global +binding for `TAB', which is re-indenting the line. See the option +`org-cycle-emulate-tab' for details. + +As a special case, if point is at the beginning of the buffer and there is +no headline in line 1, this function will act as if called with prefix arg +\(`\\[universal-argument] TAB', same as `S-TAB') also when called without \ +prefix arg, but only +if the variable `org-cycle-global-at-bob' is t." (interactive "P") (org-load-modules-maybe) (unless (or (run-hook-with-args-until-success 'org-tab-first-hook) @@ -6732,10 +6925,6 @@ show the entire buffer, including any drawers. org-cycle-hook)) (pos (point))) - (if (or bob-special (equal arg '(4))) - ;; special case: use global cycling - (setq arg t)) - (cond ((equal arg '(16)) @@ -6747,6 +6936,11 @@ show the entire buffer, including any drawers. (outline-show-all) (org-unlogged-message "Entire buffer visible, including drawers")) + ((equal arg '(4)) (org-cycle-internal-global)) + + ;; Try hiding block at point. + ((org-hide-block-toggle-maybe)) + ;; Try cdlatex TAB completion ((org-try-cdlatex-tab)) @@ -6754,16 +6948,15 @@ show the entire buffer, including any drawers. ((org-at-table-p 'any) (if (org-at-table.el-p) (message "%s" (substitute-command-keys "\\<org-mode-map>\ -Use \\[org-edit-special] to edit table.el tables")) +Use `\\[org-edit-special]' to edit table.el tables")) (if arg (org-table-edit-field t) (org-table-justify-field-maybe) (call-interactively 'org-table-next-field)))) - ((run-hook-with-args-until-success - 'org-tab-after-check-for-table-hook)) + ((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook)) ;; Global cycling: delegate to `org-cycle-internal-global'. - ((eq arg t) (org-cycle-internal-global)) + (bob-special (org-cycle-internal-global)) ;; Drawers: delegate to `org-flag-drawer'. ((save-excursion @@ -6886,15 +7079,10 @@ Use \\[org-edit-special] to edit table.el tables")) (org-list-search-forward (org-item-beginning-re) eos t))))) ;; Determine end invisible part of buffer (EOL) (beginning-of-line 2) - ;; XEmacs doesn't have `next-single-char-property-change' - (if (featurep 'xemacs) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (goto-char (next-single-char-property-change (point) 'invisible)) - (and (eolp) (beginning-of-line 2)))) + (while (and (not (eobp)) ;This is like `next-line'. + (get-char-property (1- (point)) 'invisible)) + (goto-char (next-single-char-property-change (point) 'invisible)) + (and (eolp) (beginning-of-line 2))) (setq eol (point))) ;; Find out what to do next and set `this-command' (cond @@ -6907,7 +7095,7 @@ Use \\[org-edit-special] to edit table.el tables")) (save-excursion (goto-char eos) (outline-next-heading) - (if (outline-invisible-p) (org-flag-heading nil)))) + (when (outline-invisible-p) (org-flag-heading nil)))) ((and (or (>= eol eos) (not (string-match "\\S-" (buffer-substring eol eos)))) (or has-children @@ -6919,7 +7107,7 @@ Use \\[org-edit-special] to edit table.el tables")) (if (org-at-item-p) (org-list-set-item-visibility (point-at-bol) struct 'children) (org-show-entry) - (org-with-limited-levels (outline-show-children)) + (org-with-limited-levels (org-show-children)) ;; FIXME: This slows down the func way too much. ;; How keep drawers hidden in subtree anyway? ;; (when (memq 'org-cycle-hide-drawers org-cycle-hook) @@ -6934,14 +7122,14 @@ Use \\[org-edit-special] to edit table.el tables")) (let* ((struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) (end (org-list-get-bottom-point struct))) - (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded)) - (org-list-get-all-items (point) struct prevs)) + (dolist (e (org-list-get-all-items (point) struct prevs)) + (org-list-set-item-visibility e struct 'folded)) (goto-char (if (< end eos) end eos))))))) (org-unlogged-message "CHILDREN") (save-excursion (goto-char eos) (outline-next-heading) - (if (outline-invisible-p) (org-flag-heading nil))) + (when (outline-invisible-p) (org-flag-heading nil))) (setq org-cycle-subtree-status 'children) (unless (org-before-first-heading-p) (run-hook-with-args 'org-cycle-hook 'children))) @@ -6970,7 +7158,7 @@ Use \\[org-edit-special] to edit table.el tables")) ;;;###autoload (defun org-global-cycle (&optional arg) "Cycle the global visibility. For details see `org-cycle'. -With \\[universal-argument] prefix arg, switch to startup visibility. +With `\\[universal-argument]' prefix ARG, switch to startup visibility. With a numeric prefix, show all headlines up to that level." (interactive "P") (let ((org-cycle-include-plain-lists @@ -6997,7 +7185,7 @@ With a numeric prefix, show all headlines up to that level." (eq org-startup-folded nil)) (outline-show-all))) (unless (eq org-startup-folded 'showeverything) - (if org-hide-block-startup (org-hide-block-all)) + (when org-hide-block-startup (org-hide-block-all)) (org-set-visibility-according-to-property 'no-cleanup) (org-cycle-hide-archived-subtrees 'all) (org-cycle-hide-drawers 'all) @@ -7006,33 +7194,32 @@ With a numeric prefix, show all headlines up to that level." (defun org-set-visibility-according-to-property (&optional no-cleanup) "Switch subtree visibilities according to :VISIBILITY: property." (interactive) - (let (org-show-entry-below) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*:VISIBILITY:" nil t) - (if (not (org-at-property-p)) (outline-next-heading) - (let ((state (match-string 3))) - (save-excursion - (org-back-to-heading t) - (outline-hide-subtree) - (org-reveal) - (cond - ((equal state "folded") - (outline-hide-subtree)) - ((equal state "children") - (org-show-hidden-entry) - (outline-show-children)) - ((equal state "content") - (save-excursion - (save-restriction - (org-narrow-to-subtree) - (org-content)))) - ((member state '("all" "showall")) - (outline-show-subtree))))))) - (unless no-cleanup - (org-cycle-hide-archived-subtrees 'all) - (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines 'all))))) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*:VISIBILITY:" nil t) + (if (not (org-at-property-p)) (outline-next-heading) + (let ((state (match-string 3))) + (save-excursion + (org-back-to-heading t) + (outline-hide-subtree) + (org-reveal) + (cond + ((equal state "folded") + (outline-hide-subtree)) + ((equal state "children") + (org-show-hidden-entry) + (org-show-children)) + ((equal state "content") + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (org-content)))) + ((member state '("all" "showall")) + (outline-show-subtree))))))) + (unless no-cleanup + (org-cycle-hide-archived-subtrees 'all) + (org-cycle-hide-drawers 'all) + (org-cycle-show-empty-lines 'all)))) ;; This function uses outline-regexp instead of the more fundamental ;; org-outline-regexp so that org-cycle-global works outside of Org @@ -7048,10 +7235,9 @@ results." (let ((level (save-excursion (goto-char (point-min)) - (if (re-search-forward (concat "^" outline-regexp) nil t) - (progn - (goto-char (match-beginning 0)) - (funcall outline-level)))))) + (when (re-search-forward (concat "^" outline-regexp) nil t) + (goto-char (match-beginning 0)) + (funcall outline-level))))) (and level (outline-hide-sublevels level))))) (defun org-content (&optional arg) @@ -7070,9 +7256,9 @@ With numerical argument N, show content up to level N." t) (looking-at org-outline-regexp)) (if (integerp arg) - (outline-show-children (1- arg)) + (org-show-children (1- arg)) (outline-show-branches)) - (if (bobp) (throw 'exit nil)))))) + (when (bobp) (throw 'exit nil)))))) (defun org-optimize-window-after-visibility-change (state) "Adjust the window after a change in outline visibility. @@ -7087,13 +7273,11 @@ This function is the default value of the hook `org-cycle-hook'." (defun org-remove-empty-overlays-at (pos) "Remove outline overlays that do not contain non-white stuff." - (mapc - (lambda (o) - (and (eq 'outline (overlay-get o 'invisible)) - (not (string-match "\\S-" (buffer-substring (overlay-start o) - (overlay-end o)))) - (delete-overlay o))) - (overlays-at pos))) + (dolist (o (overlays-at pos)) + (and (eq 'outline (overlay-get o 'invisible)) + (not (string-match "\\S-" (buffer-substring (overlay-start o) + (overlay-end o)))) + (delete-overlay o)))) (defun org-clean-visibility-after-subtree-move () "Fix visibility issues after moving a subtree." @@ -7111,7 +7295,7 @@ This function is the default value of the hook `org-cycle-hook'." (point-at-eol) (point)))) (level (looking-at "\\*+")) - (re (if level (concat "^" (regexp-quote (match-string 0)) " ")))) + (re (when level (concat "^" (regexp-quote (match-string 0)) " ")))) (save-excursion (save-restriction (narrow-to-region beg end) @@ -7119,10 +7303,10 @@ This function is the default value of the hook `org-cycle-hook'." ;; Properly fold already folded siblings (goto-char (point-min)) (while (re-search-forward re nil t) - (if (and (not (outline-invisible-p)) - (save-excursion - (goto-char (point-at-eol)) (outline-invisible-p))) - (outline-hide-entry)))) + (when (and (not (outline-invisible-p)) + (save-excursion + (goto-char (point-at-eol)) (outline-invisible-p))) + (outline-hide-entry)))) (org-cycle-show-empty-lines 'overview) (org-cycle-hide-drawers 'overview))))) @@ -7166,9 +7350,9 @@ are at least `org-cycle-separator-lines' empty lines before the headline." (goto-char (point-max)) (outline-previous-heading) (outline-end-of-heading) - (if (and (looking-at "[ \t\n]+") - (= (match-end 0) (point-max))) - (outline-flag-region (point) (match-end 0) nil)))) + (when (and (looking-at "[ \t\n]+") + (= (match-end 0) (point-max))) + (outline-flag-region (point) (match-end 0) nil)))) (defun org-show-empty-lines-in-parent () "Move to the parent and re-show empty lines before visible headlines." @@ -7177,16 +7361,14 @@ are at least `org-cycle-separator-lines' empty lines before the headline." (org-cycle-show-empty-lines context)))) (defun org-files-list () - "Return `org-agenda-files' list, plus all open org-mode files. + "Return `org-agenda-files' list, plus all open Org files. This is useful for operations that need to scan all of a user's open and agenda-wise Org files." (let ((files (mapcar 'expand-file-name (org-agenda-files)))) (dolist (buf (buffer-list)) (with-current-buffer buf - (if (and (derived-mode-p 'org-mode) (buffer-file-name)) - (let ((file (expand-file-name (buffer-file-name)))) - (unless (member file files) - (push file files)))))) + (when (and (derived-mode-p 'org-mode) (buffer-file-name)) + (cl-pushnew (expand-file-name (buffer-file-name)) files)))) files)) (defsubst org-entry-beginning-position () @@ -7226,23 +7408,24 @@ specifying which drawers should not be hidden." Otherwise make it visible. When optional argument ELEMENT is a parsed drawer, as returned by `org-element-at-point', hide or show that drawer instead." - (when (save-excursion - (beginning-of-line) - (org-looking-at-p org-drawer-regexp)) - (let ((drawer (or element (org-element-at-point)))) - (when (memq (org-element-type drawer) '(drawer property-drawer)) - (let ((post (org-element-property :post-affiliated drawer))) - (save-excursion - (outline-flag-region - (progn (goto-char post) (line-end-position)) - (progn (goto-char (org-element-property :end drawer)) - (skip-chars-backward " \r\t\n") - (line-end-position)) - flag)) - ;; When the drawer is hidden away, make sure point lies in - ;; a visible part of the buffer. - (when (and flag (> (line-beginning-position) post)) - (goto-char post))))))) + (let ((drawer (or element + (and (save-excursion + (beginning-of-line) + (looking-at-p org-drawer-regexp)) + (org-element-at-point))))) + (when (memq (org-element-type drawer) '(drawer property-drawer)) + (let ((post (org-element-property :post-affiliated drawer))) + (save-excursion + (outline-flag-region + (progn (goto-char post) (line-end-position)) + (progn (goto-char (org-element-property :end drawer)) + (skip-chars-backward " \r\t\n") + (line-end-position)) + flag)) + ;; When the drawer is hidden away, make sure point lies in + ;; a visible part of the buffer. + (when (and flag (> (line-beginning-position) post)) + (goto-char post)))))) (defun org-subtree-end-visible-p () "Is the end of the current subtree visible?" @@ -7251,9 +7434,11 @@ show that drawer instead." (defun org-first-headline-recenter () "Move cursor to the first headline and recenter the headline." - (goto-char (point-min)) - (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t) - (set-window-start (selected-window) (point-at-bol)))) + (let ((window (get-buffer-window))) + (when window + (goto-char (point-min)) + (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t) + (set-window-start window (line-beginning-position)))))) ;;; Saving and restoring visibility @@ -7264,38 +7449,30 @@ The return value is a list of cons cells, with start and stop positions for each overlay. If USE-MARKERS is set, return the positions as markers." (let (beg end) - (save-excursion - (save-restriction - (widen) - (delq nil - (mapcar (lambda (o) - (when (eq (overlay-get o 'invisible) 'outline) - (setq beg (overlay-start o) - end (overlay-end o)) - (and beg end (> end beg) - (if use-markers - (cons (copy-marker beg) - (copy-marker end t)) - (cons beg end))))) - (overlays-in (point-min) (point-max)))))))) + (org-with-wide-buffer + (delq nil + (mapcar (lambda (o) + (when (eq (overlay-get o 'invisible) 'outline) + (setq beg (overlay-start o) + end (overlay-end o)) + (and beg end (> end beg) + (if use-markers + (cons (copy-marker beg) + (copy-marker end t)) + (cons beg end))))) + (overlays-in (point-min) (point-max))))))) (defun org-set-outline-overlay-data (data) "Create visibility overlays for all positions in DATA. DATA should have been made by `org-outline-overlay-data'." - (let (o) - (save-excursion - (save-restriction - (widen) - (outline-show-all) - (mapc (lambda (c) - (outline-flag-region (car c) (cdr c) t)) - data))))) + (org-with-wide-buffer + (outline-show-all) + (dolist (c data) (outline-flag-region (car c) (cdr c) t)))) ;;; Folding of blocks -(defvar org-hide-block-overlays nil +(defvar-local org-hide-block-overlays nil "Overlays hiding blocks.") -(make-variable-buffer-local 'org-hide-block-overlays) (defun org-block-map (function &optional start end) "Call FUNCTION at the head of all source blocks in the current buffer. @@ -7323,7 +7500,7 @@ Optional arguments START and END can be used to limit the range." (defun org-show-block-all () "Unfold all blocks in the current buffer." (interactive) - (mapc 'delete-overlay org-hide-block-overlays) + (mapc #'delete-overlay org-hide-block-overlays) (setq org-hide-block-overlays nil)) (defun org-hide-block-toggle-maybe () @@ -7387,12 +7564,10 @@ a block. Return a non-nil value when toggling is successful." (when (eq (overlay-get ov 'invisible) 'org-hide-block) (delete-overlay ov)))))))) -;; org-tab-after-check-for-cycling-hook -(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe) ;; Remove overlays when changing major mode (add-hook 'org-mode-hook - (lambda () (org-add-hook 'change-major-mode-hook - 'org-show-block-all 'append 'local))) + (lambda () (add-hook 'change-major-mode-hook + 'org-show-block-all 'append 'local))) ;;; Org-goto @@ -7476,23 +7651,23 @@ With a prefix argument, use the alternative interface: e.g., if (selected-point (if (eq interface 'outline) (car (org-get-location (current-buffer) org-goto-help)) - (let ((pa (org-refile-get-location "Goto" nil nil t))) + (let ((pa (org-refile-get-location "Goto"))) (org-refile-check-position pa) (nth 3 pa))))) (if selected-point (progn (org-mark-ring-push org-goto-start-pos) (goto-char selected-point) - (if (or (outline-invisible-p) (org-invisible-p2)) - (org-show-context 'org-goto))) + (when (or (outline-invisible-p) (org-invisible-p2)) + (org-show-context 'org-goto))) (message "Quit")))) (defvar org-goto-selected-point nil) ; dynamically scoped parameter (defvar org-goto-exit-command nil) ; dynamically scoped parameter (defvar org-goto-local-auto-isearch-map) ; defined below -(defun org-get-location (buf help) - "Let the user select a location in the Org-mode buffer BUF. +(defun org-get-location (_buf help) + "Let the user select a location in current buffer. This function uses a recursive edit. It returns the selected position or nil." (org-no-popups @@ -7505,7 +7680,7 @@ or nil." (save-window-excursion (delete-other-windows) (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (org-pop-to-buffer-same-window + (pop-to-buffer-same-window (condition-case nil (make-indirect-buffer (current-buffer) "*org-goto*") (error (make-indirect-buffer (current-buffer) "*org-goto*")))) @@ -7568,11 +7743,11 @@ or nil." (isearch-mode t) (isearch-process-search-char (string-to-char keys))))) -(defun org-goto-ret (&optional arg) +(defun org-goto-ret (&optional _arg) "Finish `org-goto' by going to the new location." (interactive "P") - (setq org-goto-selected-point (point) - org-goto-exit-command 'return) + (setq org-goto-selected-point (point)) + (setq org-goto-exit-command 'return) (throw 'exit nil)) (defun org-goto-left () @@ -7611,17 +7786,18 @@ or nil." (defun org-tree-to-indirect-buffer (&optional arg) "Create indirect buffer and narrow it to current subtree. + With a numerical prefix ARG, go up to this level and then take that tree. If ARG is negative, go up that many levels. If `org-indirect-buffer-display' is not `new-frame', the command removes the indirect buffer previously made with this command, to avoid proliferation of indirect buffers. However, when you call the command with a \ -\\[universal-argument] prefix, or -when `org-indirect-buffer-display' is `new-frame', the last buffer -is kept so that you can work with several indirect buffers at the same time. -If `org-indirect-buffer-display' is `dedicated-frame', the \ -\\[universal-argument] prefix also +`\\[universal-argument]' prefix, or +when `org-indirect-buffer-display' is `new-frame', the last buffer is kept +so that you can work with several indirect buffers at the same time. If +`org-indirect-buffer-display' is `dedicated-frame', the \ +`\\[universal-argument]' prefix also requests that a new frame be made for the new buffer, so that the dedicated frame is not changed." (interactive "P") @@ -7633,18 +7809,18 @@ frame is not changed." (org-back-to-heading t) (when (numberp arg) (setq level (org-outline-level)) - (if (< arg 0) (setq arg (+ level arg))) + (when (< arg 0) (setq arg (+ level arg))) (while (> (setq level (org-outline-level)) arg) (org-up-heading-safe))) (setq beg (point) - heading (org-get-heading)) + heading (org-get-heading 'no-tags)) (org-end-of-subtree t t) - (if (org-at-heading-p) (backward-char 1)) + (when (org-at-heading-p) (backward-char 1)) (setq end (point))) - (if (and (buffer-live-p org-last-indirect-buffer) - (not (eq org-indirect-buffer-display 'new-frame)) - (not arg)) - (kill-buffer org-last-indirect-buffer)) + (when (and (buffer-live-p org-last-indirect-buffer) + (not (eq org-indirect-buffer-display 'new-frame)) + (not arg)) + (kill-buffer org-last-indirect-buffer)) (setq ibuf (org-get-indirect-buffer cbuf heading) org-last-indirect-buffer ibuf) (cond @@ -7652,7 +7828,7 @@ frame is not changed." (and arg (eq org-indirect-buffer-display 'dedicated-frame))) (select-frame (make-frame)) (delete-other-windows) - (org-pop-to-buffer-same-window ibuf) + (pop-to-buffer-same-window ibuf) (org-set-frame-title heading)) ((eq org-indirect-buffer-display 'dedicated-frame) (raise-frame @@ -7661,15 +7837,13 @@ frame is not changed." org-indirect-dedicated-frame) (setq org-indirect-dedicated-frame (make-frame))))) (delete-other-windows) - (org-pop-to-buffer-same-window ibuf) + (pop-to-buffer-same-window ibuf) (org-set-frame-title (concat "Indirect: " heading))) ((eq org-indirect-buffer-display 'current-window) - (org-pop-to-buffer-same-window ibuf)) + (pop-to-buffer-same-window ibuf)) ((eq org-indirect-buffer-display 'other-window) (pop-to-buffer ibuf)) (t (error "Invalid value"))) - (if (featurep 'xemacs) - (save-excursion (org-mode) (turn-on-font-lock))) (narrow-to-region beg end) (outline-show-all) (goto-char pos) @@ -7692,64 +7866,66 @@ frame is not changed." (defun org-set-frame-title (title) "Set the title of the current frame to the string TITLE." - ;; FIXME: how to name a single frame in XEmacs??? - (unless (featurep 'xemacs) - (modify-frame-parameters (selected-frame) (list (cons 'name title))))) + (modify-frame-parameters (selected-frame) (list (cons 'name title)))) ;;;; Structure editing ;;; Inserting headlines -(defun org-previous-line-empty-p (&optional next) - "Is the previous line a blank line? -When NEXT is non-nil, check the next line instead." +(defun org--line-empty-p (n) + "Is the Nth next line empty? + +Counts the current line as N = 1 and the previous line as N = 0; +see `beginning-of-line'." (save-excursion (and (not (bobp)) - (or (beginning-of-line (if next 2 0)) t) + (or (beginning-of-line n) t) (save-match-data (looking-at "[ \t]*$"))))) -(defun org-insert-heading (&optional arg invisible-ok top-level) +(defun org-previous-line-empty-p () + "Is the previous line a blank line? +When NEXT is non-nil, check the next line instead." + (org--line-empty-p 0)) + +(defun org-next-line-empty-p () + "Is the previous line a blank line? +When NEXT is non-nil, check the next line instead." + (org--line-empty-p 2)) + +(defun org-insert-heading (&optional arg invisible-ok top) "Insert a new heading or an item with the same depth at point. If point is at the beginning of a heading or a list item, insert -a new heading or a new item above the current one. If point is -at the beginning of a normal line, turn the line into a heading. - -If point is in the middle of a headline or a list item, split the -headline or the item and create a new headline/item with the text -in the current line after point \(see `org-M-RET-may-split-line' -on how to modify this behavior). - -With one universal prefix argument, set the user option -`org-insert-heading-respect-content' to t for the duration of -the command. This modifies the behavior described above in this -ways: on list items and at the beginning of normal lines, force -the insertion of a heading after the current subtree. - -With two universal prefix arguments, insert the heading at the -end of the grandparent subtree. For example, if point is within -a 2nd-level heading, then it will insert a 2nd-level heading at -the end of the 1st-level parent heading. - -If point is at the beginning of a headline, insert a sibling -before the current headline. If point is not at the beginning, -split the line and create a new headline with the text in the -current line after point \(see `org-M-RET-may-split-line' on how -to modify this behavior). - -If point is at the beginning of a normal line, turn this line -into a heading. +a new heading or a new item above the current one. When at the +beginning of a regular line of text, turn it into a heading. + +If point is in the middle of a line, split it and create a new +headline/item with the text in the current line after point (see +`org-M-RET-may-split-line' on how to modify this behavior). As +a special case, on a headline, splitting can only happen on the +title itself. E.g., this excludes breaking stars or tags. + +With a `\\[universal-argument]' prefix, set \ +`org-insert-heading-respect-content' to +a non-nil value for the duration of the command. This forces the +insertion of a heading after the current subtree, independently +on the location of point. + +With a `\\[universal-argument] \\[universal-argument]' prefix, \ +insert the heading at the end of the tree +above the current heading. For example, if point is within a +2nd-level heading, then it will insert a 2nd-level heading at +the end of the 1st-level parent subtree. When INVISIBLE-OK is set, stop at invisible headlines when going back. This is important for non-interactive uses of the command. -When optional argument TOP-LEVEL is non-nil, insert a level 1 -heading, unconditionally." +When optional argument TOP is non-nil, insert a level 1 heading, +unconditionally." (interactive "P") - (if (org-called-interactively-p 'any) (org-reveal)) - (let ((itemp (and (not top-level) (org-in-item-p))) + (let ((itemp (and (not top) (org-in-item-p))) (may-split (org-get-alist-option org-M-RET-may-split-line 'headline)) (respect-content (or org-insert-heading-respect-content (equal arg '(4)))) @@ -7797,13 +7973,13 @@ heading, unconditionally." (if (org-before-first-heading-p) "*" (save-excursion (org-back-to-heading t) - (if (org-previous-line-empty-p) (setq empty-line-p t)) + (when (org-previous-line-empty-p) (setq empty-line-p t)) (looking-at org-outline-regexp) (make-string (1- (length (match-string 0))) ?*)))) (stars (save-excursion (condition-case nil - (if top-level "* " + (if top "* " (org-back-to-heading invisible-ok) (when (and (not on-heading) (featurep 'org-inlinetask) @@ -7822,25 +7998,23 @@ heading, unconditionally." (org-backward-heading-same-level 1 invisible-ok)) (= (point) (match-beginning 0))) - (not (org-previous-line-empty-p t))) + (not (org-next-line-empty-p))) (setq empty-line-p (or empty-line-p (org-previous-line-empty-p)))) (match-string 0)) (error (or fix-level "* "))))) (blank-a (cdr (assq 'heading org-blank-before-new-entry))) - (blank (if (eq blank-a 'auto) empty-line-p blank-a)) - pos hide-previous previous-pos) + (blank (if (eq blank-a 'auto) empty-line-p blank-a))) ;; If we insert after content, move there and clean up ;; whitespace. - (when (and respect-content - (not (org-looking-at-p org-outline-regexp-bol))) + (when respect-content (if (not (org-before-first-heading-p)) (org-end-of-subtree nil t) (re-search-forward org-outline-regexp-bol) (beginning-of-line 0)) (skip-chars-backward " \r\t\n") - (and (not (org-looking-back "^\\*+" (line-beginning-position))) + (and (not (looking-back "^\\*+" (line-beginning-position))) (looking-at "[ \t]+") (replace-match "")) (unless (eobp) (forward-char 1)) (when (looking-at "^\\*") @@ -7850,13 +8024,14 @@ heading, unconditionally." ;; If we are splitting, grab the text that should be moved ;; to the new headline. (when may-split - (if (org-on-heading-p) + (if (org-at-heading-p) ;; This is a heading: split intelligently (keeping ;; tags). (let ((pos (point))) (beginning-of-line) - (unless (looking-at org-complex-heading-regexp) - (error "This should not happen")) + (let ((case-fold-search nil)) + (unless (looking-at org-complex-heading-regexp) + (error "This should not happen"))) (when (and (match-beginning 4) (> pos (match-beginning 4)) (< pos (match-end 4))) @@ -7913,20 +8088,23 @@ When NO-TAGS is non-nil, don't include tags. When NO-TODO is non-nil, don't include TODO keywords." (save-excursion (org-back-to-heading t) - (cond - ((and no-tags no-todo) - (looking-at org-complex-heading-regexp) - (match-string 4)) - (no-tags - (looking-at (concat org-outline-regexp - "\\(.*?\\)" - "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$")) - (match-string 1)) - (no-todo - (looking-at org-todo-line-regexp) - (match-string 3)) - (t (looking-at org-heading-regexp) - (match-string 2))))) + (let ((case-fold-search nil)) + (cond + ((and no-tags no-todo) + (looking-at org-complex-heading-regexp) + ;; Return value has to be a string, but match group 4 is + ;; optional. + (or (match-string 4) "")) + (no-tags + (looking-at (concat org-outline-regexp + "\\(.*?\\)" + "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$")) + (match-string 1)) + (no-todo + (looking-at org-todo-line-regexp) + (match-string 3)) + (t (looking-at org-heading-regexp) + (match-string 2)))))) (defvar orgstruct-mode) ; defined below @@ -7941,24 +8119,24 @@ This is a list with the following elements: - the tags string, or nil." (save-excursion (org-back-to-heading t) - (if (let (case-fold-search) - (looking-at - (if orgstruct-mode - org-heading-regexp - org-complex-heading-regexp))) - (if orgstruct-mode - (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - nil - nil - (match-string 2) - nil) - (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - (org-match-string-no-properties 2) - (and (match-end 3) (aref (match-string 3) 2)) - (org-match-string-no-properties 4) - (org-match-string-no-properties 5)))))) + (when (let (case-fold-search) + (looking-at + (if orgstruct-mode + org-heading-regexp + org-complex-heading-regexp))) + (if orgstruct-mode + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + nil + nil + (match-string 2) + nil) + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + (match-string-no-properties 2) + (and (match-end 3) (aref (match-string 3) 2)) + (match-string-no-properties 4) + (match-string-no-properties 5)))))) (defun org-get-entry () "Get the entry text, after heading, entire subtree." @@ -7966,6 +8144,24 @@ This is a list with the following elements: (org-back-to-heading t) (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) +(defun org-edit-headline (&optional heading) + "Edit the current headline. +Set it to HEADING when provided." + (interactive) + (org-with-wide-buffer + (org-back-to-heading t) + (let ((case-fold-search nil)) + (when (looking-at org-complex-heading-regexp) + (let* ((old (match-string-no-properties 4)) + (new (save-match-data + (org-trim (or heading (read-string "Edit: " old)))))) + (unless (equal old new) + (if old (replace-match new t t nil 4) + (goto-char (or (match-end 3) (match-end 2) (match-end 1))) + (insert " " new)) + (org-set-tags nil t) + (when (looking-at "[ \t]*$") (replace-match "")))))))) + (defun org-insert-heading-after-current () "Insert a new heading with same level as current, after current subtree." (interactive) @@ -7986,9 +8182,14 @@ This is a list with the following elements: (defun org-insert-todo-heading (arg &optional force-heading) "Insert a new heading with the same level and TODO state as current heading. -If the heading has no TODO state, or if the state is DONE, use the first -state (TODO by default). Also with one prefix arg, force first state. With -two prefix args, force inserting at the end of the parent subtree." + +If the heading has no TODO state, or if the state is DONE, use +the first state (TODO by default). Also with one prefix arg, +force first state. With two prefix args, force inserting at the +end of the parent subtree. + +When called at a plain list item, insert a new item with an +unchecked check box." (interactive "P") (when (or force-heading (not (org-insert-item 'checkbox))) (org-insert-heading (or (and (equal arg '(16)) '(16)) @@ -7997,18 +8198,17 @@ two prefix args, force inserting at the end of the parent subtree." (org-back-to-heading) (outline-previous-heading) (looking-at org-todo-line-regexp)) - (let* - ((new-mark-x - (if (or (equal arg '(4)) - (not (match-beginning 2)) - (member (match-string 2) org-done-keywords)) - (car org-todo-keywords-1) - (match-string 2))) - (new-mark - (or - (run-hook-with-args-until-success - 'org-todo-get-default-hook new-mark-x nil) - new-mark-x))) + (let* ((new-mark-x + (if (or (equal arg '(4)) + (not (match-beginning 2)) + (member (match-string 2) org-done-keywords)) + (car org-todo-keywords-1) + (match-string 2))) + (new-mark + (or + (run-hook-with-args-until-success + 'org-todo-get-default-hook new-mark-x nil) + new-mark-x))) (beginning-of-line 1) (and (looking-at org-outline-regexp) (goto-char (match-end 0)) (if org-treat-insert-todo-heading-as-state-change @@ -8139,13 +8339,6 @@ even level numbers will become the next higher odd number." ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) (max 1 (+ level (or change 0))))) -(if (boundp 'define-obsolete-function-alias) - (if (or (featurep 'xemacs) (< emacs-major-version 23)) - (define-obsolete-function-alias 'org-get-legal-level - 'org-get-valid-level) - (define-obsolete-function-alias 'org-get-legal-level - 'org-get-valid-level "23.1"))) - (defun org-promote () "Promote the current heading higher up the tree." (org-with-wide-buffer @@ -8193,32 +8386,32 @@ After top level, it switches back to sibling level." (cond ;; If first headline in file, promote to top-level. ((= prev-level 0) - (loop repeat (/ (- cur-level 1) (org-level-increment)) - do (org-do-promote))) + (cl-loop repeat (/ (- cur-level 1) (org-level-increment)) + do (org-do-promote))) ;; If same level as prev, demote one. ((= prev-level cur-level) (org-do-demote)) ;; If parent is top-level, promote to top level if not already. ((= prev-level 1) - (loop repeat (/ (- cur-level 1) (org-level-increment)) - do (org-do-promote))) + (cl-loop repeat (/ (- cur-level 1) (org-level-increment)) + do (org-do-promote))) ;; If top-level, return to prev-level. ((= cur-level 1) - (loop repeat (/ (- prev-level 1) (org-level-increment)) - do (org-do-demote))) + (cl-loop repeat (/ (- prev-level 1) (org-level-increment)) + do (org-do-demote))) ;; If less than prev-level, promote one. ((< cur-level prev-level) (org-do-promote)) ;; If deeper than prev-level, promote until higher than ;; prev-level. ((> cur-level prev-level) - (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment))) - do (org-do-promote)))) + (cl-loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment))) + do (org-do-promote)))) t)))) (defun org-map-tree (fun) "Call FUN for every heading underneath the current one." - (org-back-to-heading) + (org-back-to-heading t) (let ((level (funcall outline-level))) (save-excursion (funcall fun) @@ -8234,9 +8427,9 @@ After top level, it switches back to sibling level." (save-excursion (setq end (copy-marker end)) (goto-char beg) - (if (and (re-search-forward org-outline-regexp-bol nil t) - (< (point) end)) - (funcall fun)) + (when (and (re-search-forward org-outline-regexp-bol nil t) + (< (point) end)) + (funcall fun)) (while (and (progn (outline-next-heading) (< (point) end)) @@ -8272,7 +8465,7 @@ Assume point is at a heading or an inlinetask beginning." (point))) (forward-line) ;; Indent properly planning info and property drawer. - (when (org-looking-at-p org-planning-line-re) + (when (looking-at-p org-planning-line-re) (org-indent-line) (forward-line)) (when (looking-at org-property-drawer-re) @@ -8293,12 +8486,12 @@ Assume point is at a heading or an inlinetask beginning." (save-excursion (while (not (eobp)) (cond - ((org-looking-at-p "[ \t]*$") (forward-line)) - ((and (org-looking-at-p org-footnote-definition-re) + ((looking-at-p "[ \t]*$") (forward-line)) + ((and (looking-at-p org-footnote-definition-re) (let ((e (org-element-at-point))) (and (eq (org-element-type e) 'footnote-definition) (goto-char (org-element-property :end e)))))) - ((org-looking-at-p org-outline-regexp) (forward-line)) + ((looking-at-p org-outline-regexp) (forward-line)) ;; Give up if shifting would move before column 0 or ;; if it would introduce a headline or a footnote ;; definition. @@ -8306,13 +8499,13 @@ Assume point is at a heading or an inlinetask beginning." (skip-chars-forward " \t") (let ((ind (current-column))) (when (or (< ind diff) - (and (= ind diff) (org-looking-at-p forbidden-re))) + (and (= ind diff) (looking-at-p forbidden-re))) (throw 'no-shift nil))) ;; Ignore contents of example blocks and source ;; blocks if their indentation is meant to be ;; preserved. Jump to block's closing line. (beginning-of-line) - (or (and (org-looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)") + (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)") (let ((e (org-element-at-point))) (and (memq (org-element-type e) '(example-block src-block)) @@ -8328,16 +8521,16 @@ Assume point is at a heading or an inlinetask beginning." ;; when indentation is meant to be preserved. (while (not (eobp)) (cond - ((and (org-looking-at-p org-footnote-definition-re) + ((and (looking-at-p org-footnote-definition-re) (let ((e (org-element-at-point))) (and (eq (org-element-type e) 'footnote-definition) (goto-char (org-element-property :end e)))))) - ((org-looking-at-p org-outline-regexp) (forward-line)) - ((org-looking-at-p "[ \t]*$") (forward-line)) + ((looking-at-p org-outline-regexp) (forward-line)) + ((looking-at-p "[ \t]*$") (forward-line)) (t - (org-indent-line-to (+ (org-get-indentation) diff)) + (indent-line-to (+ (org-get-indentation) diff)) (beginning-of-line) - (or (and (org-looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)") + (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)") (let ((e (org-element-at-point))) (and (memq (org-element-type e) '(example-block src-block)) @@ -8350,7 +8543,7 @@ Assume point is at a heading or an inlinetask beginning." (forward-line))))))))) (defun org-convert-to-odd-levels () - "Convert an org-mode file with all levels allowed to one with odd levels. + "Convert an Org file with all levels allowed to one with odd levels. This will leave level 1 alone, convert level 2 to level 3, level 3 to level 5 etc." (interactive) @@ -8366,7 +8559,7 @@ level 5 etc." (end-of-line 1)))))) (defun org-convert-to-oddeven-levels () - "Convert an org-mode file with only odd levels to one with odd/even levels. + "Convert an Org file with only odd levels to one with odd/even levels. This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a section with an even level, conversion would destroy the structure of the file. An error is signaled in this @@ -8437,12 +8630,12 @@ case." (progn (goto-char beg0) (user-error "Cannot move past superior level or buffer limit"))) (setq cnt (1- cnt))) - (if (> arg 0) - ;; Moving forward - still need to move over subtree - (progn (org-end-of-subtree t t) - (save-excursion - (org-back-over-empty-lines) - (or (bolp) (newline))))) + (when (> arg 0) + ;; Moving forward - still need to move over subtree + (org-end-of-subtree t t) + (save-excursion + (org-back-over-empty-lines) + (or (bolp) (newline)))) (setq ne-ins (org-back-over-empty-lines)) (move-marker ins-point (point)) (setq txt (buffer-substring beg end)) @@ -8473,7 +8666,7 @@ case." (if folded (outline-hide-subtree) (org-show-entry) - (outline-show-children) + (org-show-children) (org-cycle-hide-drawers 'children)) (org-clean-visibility-after-subtree-move) ;; move back to the initial column we were at @@ -8505,7 +8698,7 @@ of some markers in the region, even if CUT is non-nil. This is useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (interactive "p") (let (beg end folded (beg0 (point))) - (if (org-called-interactively-p 'any) + (if (called-interactively-p 'any) (org-back-to-heading nil) ; take what looks like a subtree (org-back-to-heading t)) ; take what is really there (setq beg (point)) @@ -8610,22 +8803,22 @@ When REMOVE is non-nil, remove the subtree from the clipboard." (org-odd-levels-only nil) beg end newend) ;; Remove the forced level indicator - (if force-level - (delete-region (point-at-bol) (point))) + (when force-level + (delete-region (point-at-bol) (point))) ;; Paste (beginning-of-line (if (bolp) 1 2)) (setq beg (point)) (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) (insert-before-markers txt) - (unless (string-match "\n\\'" txt) (insert "\n")) + (unless (string-suffix-p "\n" txt) (insert "\n")) (setq newend (point)) (org-reinstall-markers-in-region beg) (setq end (point)) (goto-char beg) (skip-chars-forward " \t\n\r") (setq beg (point)) - (if (and (outline-invisible-p) visp) - (save-excursion (outline-show-heading))) + (when (and (outline-invisible-p) visp) + (save-excursion (outline-show-heading))) ;; Shift if necessary (unless (= shift 0) (save-restriction @@ -8635,14 +8828,14 @@ When REMOVE is non-nil, remove the subtree from the clipboard." (setq shift (+ delta shift))) (goto-char (point-min)) (setq newend (point-max)))) - (when (or (org-called-interactively-p 'interactive) for-yank) + (when (or (called-interactively-p 'interactive) for-yank) (message "Clipboard pasted as level %d subtree" new-level)) - (if (and (not for-yank) ; in this case, org-yank will decide about folding - kill-ring - (eq org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (outline-hide-subtree)) + (when (and (not for-yank) ; in this case, org-yank will decide about folding + kill-ring + (eq org-subtree-clip (current-kill 0)) + org-subtree-clip-folded) + ;; The tree was folded before it was killed/copied + (outline-hide-subtree)) (and for-yank (goto-char newend)) (and remove (setq kill-ring (cdr kill-ring)))))) @@ -8694,15 +8887,14 @@ called immediately, to move the markers with the entries." "Check if MARKER is between BEG and END. If yes, remember the marker and the distance to BEG." (when (and (marker-buffer marker) - (equal (marker-buffer marker) (current-buffer))) - (if (and (>= marker beg) (< marker end)) - (push (cons marker (- marker beg)) org-markers-to-move)))) + (equal (marker-buffer marker) (current-buffer)) + (>= marker beg) (< marker end)) + (push (cons marker (- marker beg)) org-markers-to-move))) (defun org-reinstall-markers-in-region (beg) "Move all remembered markers to their position relative to BEG." - (mapc (lambda (x) - (move-marker (car x) (+ beg (cdr x)))) - org-markers-to-move) + (dolist (x org-markers-to-move) + (move-marker (car x) (+ beg (cdr x)))) (setq org-markers-to-move nil)) (defun org-narrow-to-subtree () @@ -8714,7 +8906,7 @@ If yes, remember the marker and the distance to BEG." (narrow-to-region (progn (org-back-to-heading t) (point)) (progn (org-end-of-subtree t t) - (if (and (org-at-heading-p) (not (eobp))) (backward-char 1)) + (when (and (org-at-heading-p) (not (eobp))) (backward-char 1)) (point))))))) (defun org-narrow-to-block () @@ -8743,6 +8935,9 @@ stamps in the subtree shifted for each clone produced. If SHIFT is nil or the empty string, time stamps will be left alone. The ID property of the original subtree is removed. +In each clone, all the CLOCK entries will be removed. This +prevents Org from considering that the clocked times overlap. + If the original subtree did contain time stamps with a repeater, the following will happen: - the repeater will be removed in each clone @@ -8778,16 +8973,16 @@ with the original repeater." shift-n shift-what doshift nmin nmax) (unless (wholenump n) (user-error "Invalid number of replications %s" n)) - (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) - (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'" - shift))) - (user-error "Invalid shift specification %s" shift)) + (when (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) + (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'" + shift))) + (user-error "Invalid shift specification %s" shift)) (when doshift (setq shift-n (string-to-number (match-string 1 shift)) shift-what (cdr (assoc (match-string 2 shift) '(("d" . day) ("w" . week) ("m" . month) ("y" . year)))))) - (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day)) + (when (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day)) (setq nmin 1 nmax n) (org-back-to-heading t) (setq beg (point)) @@ -8802,35 +8997,35 @@ with the original repeater." (setq end beg) (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) (goto-char end) - (loop for n from nmin to nmax do - ;; prepare clone - (with-temp-buffer - (insert template) - (org-mode) - (goto-char (point-min)) - (org-show-subtree) - (and idprop (if org-clone-delete-id - (org-entry-delete nil "ID") - (org-id-get-create t))) - (unless (= n 0) - (while (re-search-forward org-clock-re nil t) - (kill-whole-line)) - (goto-char (point-min)) - (while (re-search-forward drawer-re nil t) - (org-remove-empty-drawer-at (point)))) - (goto-char (point-min)) - (when doshift - (while (re-search-forward org-ts-regexp-both nil t) - (org-timestamp-change (* n shift-n) shift-what)) - (unless (= n n-no-remove) - (goto-char (point-min)) - (while (re-search-forward org-ts-regexp nil t) - (save-excursion - (goto-char (match-beginning 0)) - (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") - (delete-region (match-beginning 1) (match-end 1))))))) - (setq task (buffer-string))) - (insert task)) + (cl-loop for n from nmin to nmax do + ;; prepare clone + (with-temp-buffer + (insert template) + (org-mode) + (goto-char (point-min)) + (org-show-subtree) + (and idprop (if org-clone-delete-id + (org-entry-delete nil "ID") + (org-id-get-create t))) + (unless (= n 0) + (while (re-search-forward org-clock-re nil t) + (kill-whole-line)) + (goto-char (point-min)) + (while (re-search-forward drawer-re nil t) + (org-remove-empty-drawer-at (point)))) + (goto-char (point-min)) + (when doshift + (while (re-search-forward org-ts-regexp-both nil t) + (org-timestamp-change (* n shift-n) shift-what)) + (unless (= n n-no-remove) + (goto-char (point-min)) + (while (re-search-forward org-ts-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") + (delete-region (match-beginning 1) (match-end 1))))))) + (setq task (buffer-string))) + (insert task)) (goto-char beg))) ;;; Outline Sorting @@ -8927,7 +9122,7 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." (setq end (region-end) what "region") (goto-char (region-beginning)) - (if (not (org-at-heading-p)) (outline-next-heading)) + (unless (org-at-heading-p) (outline-next-heading)) (setq start (point))) ((or (org-at-heading-p) (ignore-errors (progn (org-back-to-heading) t))) @@ -8967,9 +9162,9 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." re (concat "^" (regexp-quote stars) " +") re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]") txt (buffer-substring beg end)) - (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) - (if (and (not (equal stars "*")) (string-match re2 txt)) - (user-error "Region to sort contains a level above the first entry")) + (unless (equal (substring txt -1) "\n") (setq txt (concat txt "\n"))) + (when (and (not (equal stars "*")) (string-match re2 txt)) + (user-error "Region to sort contains a level above the first entry")) (unless sorting-type (message @@ -8982,16 +9177,16 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." (unless getkey-func (and (= (downcase sorting-type) ?f) (setq getkey-func - (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)) + (completing-read "Sort using function: " + obarray 'fboundp t nil nil)) (setq getkey-func (intern getkey-func)))) (and (= (downcase sorting-type) ?r) (not property) (setq property - (org-icompleting-read "Property: " - (mapcar 'list (org-buffer-property-keys t)) - nil t)))) + (completing-read "Property: " + (mapcar #'list (org-buffer-property-keys t)) + nil t)))) (when (member sorting-type '(?k ?K)) (org-clock-sum)) (message "Sorting entries...") @@ -9035,24 +9230,24 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." (if (or (re-search-forward org-ts-regexp end t) (re-search-forward org-ts-regexp-both end t)) (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) + (float-time now)))) ((= dcst ?c) (let ((end (save-excursion (outline-next-heading) (point)))) (if (re-search-forward (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") end t) (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) + (float-time now)))) ((= dcst ?s) (let ((end (save-excursion (outline-next-heading) (point)))) (if (re-search-forward org-scheduled-time-regexp end t) (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) + (float-time now)))) ((= dcst ?d) (let ((end (save-excursion (outline-next-heading) (point)))) (if (re-search-forward org-deadline-time-regexp end t) (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) + (float-time now)))) ((= dcst ?p) (if (re-search-forward org-priority-regexp (point-at-eol) t) (string-to-char (match-string 2)) @@ -9060,15 +9255,15 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." ((= dcst ?r) (or (org-entry-get nil property) "")) ((= dcst ?o) - (if (looking-at org-complex-heading-regexp) - (let* ((m (match-string 2)) - (s (if (member m org-done-keywords) '- '+))) - (- 99 (funcall s (length (member m org-todo-keywords-1))))))) + (when (looking-at org-complex-heading-regexp) + (let* ((m (match-string 2)) + (s (if (member m org-done-keywords) '- '+))) + (- 99 (funcall s (length (member m org-todo-keywords-1))))))) ((= dcst ?f) (if getkey-func (progn (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) + (when (stringp tmp) (setq tmp (funcall case-func tmp))) tmp) (error "Invalid key function `%s'" getkey-func))) (t (error "Invalid sorting type `%c'" sorting-type)))) @@ -9089,15 +9284,15 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." ;;; The orgstruct minor mode ;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode structure editing commands. +;; integrate the Org mode structure editing commands. -;; This is really a hack, because the org-mode structure commands use +;; This is really a hack, because the Org mode structure commands use ;; keys which normally belong to the major mode. Here is how it ;; works: The minor mode defines all the keys necessary to operate the ;; structure commands, but wraps the commands into a function which ;; tests if the cursor is currently at a headline or a plain list ;; item. If that is the case, the structure command is used, -;; temporarily setting many Org-mode variables like regular +;; temporarily setting many Org mode variables like regular ;; expressions for filling etc. However, when any of those keys is ;; used at a different location, function uses `key-binding' to look ;; up if the key has an associated command in another currently active @@ -9129,10 +9324,10 @@ orgstruct(++)-mode." ;;;###autoload (define-minor-mode orgstruct-mode "Toggle the minor mode `orgstruct-mode'. -This mode is for using Org-mode structure commands in other -modes. The following keys behave as if Org-mode were active, if +This mode is for using Org mode structure commands in other +modes. The following keys behave as if Org mode were active, if the cursor is on a headline, or on a plain list item (both as -defined by Org-mode)." +defined by Org mode)." nil " OrgStruct" (make-sparse-keymap) (funcall (if orgstruct-mode 'add-to-invisibility-spec @@ -9149,40 +9344,38 @@ defined by Org-mode)." "Unconditionally turn on `orgstruct-mode'." (orgstruct-mode 1)) -(defvar org-fb-vars nil) -(make-variable-buffer-local 'org-fb-vars) +(defvar-local orgstruct-is-++ nil + "Is `orgstruct-mode' in ++ version in the current-buffer?") +(defvar-local org-fb-vars nil) (defun orgstruct++-mode (&optional arg) "Toggle `orgstruct-mode', the enhanced version of it. In addition to setting orgstruct-mode, this also exports all -indentation and autofilling variables from org-mode into the +indentation and autofilling variables from Org mode into the buffer. It will also recognize item context in multiline items." (interactive "P") (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) (if (< arg 1) (progn (orgstruct-mode -1) - (mapc (lambda(v) - (org-set-local (car v) - (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v)))) - org-fb-vars)) + (dolist (v org-fb-vars) + (set (make-local-variable (car v)) + (if (eq (car-safe (cadr v)) 'quote) + (cl-cadadr v) + (nth 1 v))))) (orgstruct-mode 1) (setq org-fb-vars nil) (unless org-local-vars (setq org-local-vars (org-get-local-variables))) (let (var val) - (mapc - (lambda (x) - (when (string-match - "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)" - (symbol-name (car x))) - (setq var (car x) val (nth 1 x)) - (push (list var `(quote ,(eval var))) org-fb-vars) - (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) - org-local-vars) - (org-set-local 'orgstruct-is-++ t)))) - -(defvar orgstruct-is-++ nil - "Is `orgstruct-mode' in ++ version in the current-buffer?") -(make-variable-buffer-local 'orgstruct-is-++) + (dolist (x org-local-vars) + (when (string-match + "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\ +\\|fill-prefix\\|indent-\\)" + (symbol-name (car x))) + (setq var (car x) val (nth 1 x)) + (push (list var `(quote ,(eval var))) org-fb-vars) + (set (make-local-variable var) + (if (eq (car-safe val) 'quote) (nth 1 val) val)))) + (setq-local orgstruct-is-++ t)))) ;;;###autoload (defun turn-on-orgstruct++ () @@ -9211,6 +9404,7 @@ buffer. It will also recognize item context in multiline items." org-ctrl-c-minus org-ctrl-c-star org-cycle + org-force-cycle-archived org-forward-heading-same-level org-insert-heading org-insert-heading-respect-content @@ -9230,6 +9424,7 @@ buffer. It will also recognize item context in multiline items." org-shifttab org-shifttab org-shiftup + org-show-children org-show-subtree org-sort org-up-element @@ -9237,8 +9432,7 @@ buffer. It will also recognize item context in multiline items." outline-next-visible-heading outline-previous-visible-heading outline-promote - outline-up-heading - outline-show-children)) + outline-up-heading)) (let ((f (or (car-safe cell) cell)) (disable-when-heading-prefix (cdr-safe cell))) (when (fboundp f) @@ -9257,7 +9451,7 @@ buffer. It will also recognize item context in multiline items." (regexp-quote (cdr rep)) (car rep) (key-description binding))))) - (pushnew binding new-bindings :test 'equal))) + (cl-pushnew binding new-bindings :test 'equal))) (dolist (binding new-bindings) (let ((key (lookup-key orgstruct-mode-map binding))) (when (or (not key) (numberp key)) @@ -9364,9 +9558,9 @@ definitions." ;; normalize contexts (mapcar (lambda(c) (cond ((listp (cadr c)) - (list (car c) (car c) (cadr c))) + (list (car c) (car c) (nth 1 c))) ((string= "" (cadr c)) - (list (car c) (car c) (caddr c))) + (list (car c) (car c) (nth 2 c))) (t c))) contexts)) (a alist) r s) @@ -9380,7 +9574,7 @@ definitions." (setq vrules (org-contextualize-validate-key (car c) contexts))) (mapc (lambda (vr) - (when (not (equal (car vr) (cadr vr))) + (unless (equal (car vr) (cadr vr)) (setq repl vr))) vrules) (if (not repl) (push c r) @@ -9397,39 +9591,37 @@ definitions." (delete-dups (mapcar (lambda (x) (let ((tpl (car x))) - (when (not (delq - nil - (mapcar (lambda (y) - (equal y tpl)) - s))) + (unless (delq + nil + (mapcar (lambda (y) + (equal y tpl)) + s)) x))) (reverse r)))))) (defun org-contextualize-validate-key (key contexts) "Check CONTEXTS for agenda or capture KEY." - (let (rr res) + (let (res) (dolist (r contexts) - (mapc - (lambda (rr) - (when - (and (equal key (car r)) - (if (functionp rr) (funcall rr) - (or (and (eq (car rr) 'in-file) - (buffer-file-name) - (string-match (cdr rr) (buffer-file-name))) - (and (eq (car rr) 'in-mode) - (string-match (cdr rr) (symbol-name major-mode))) - (and (eq (car rr) 'in-buffer) - (string-match (cdr rr) (buffer-name))) - (when (and (eq (car rr) 'not-in-file) - (buffer-file-name)) - (not (string-match (cdr rr) (buffer-file-name)))) - (when (eq (car rr) 'not-in-mode) - (not (string-match (cdr rr) (symbol-name major-mode)))) - (when (eq (car rr) 'not-in-buffer) - (not (string-match (cdr rr) (buffer-name))))))) - (push r res))) - (car (last r)))) + (dolist (rr (car (last r))) + (when + (and (equal key (car r)) + (if (functionp rr) (funcall rr) + (or (and (eq (car rr) 'in-file) + (buffer-file-name) + (string-match (cdr rr) (buffer-file-name))) + (and (eq (car rr) 'in-mode) + (string-match (cdr rr) (symbol-name major-mode))) + (and (eq (car rr) 'in-buffer) + (string-match (cdr rr) (buffer-name))) + (when (and (eq (car rr) 'not-in-file) + (buffer-file-name)) + (not (string-match (cdr rr) (buffer-file-name)))) + (when (eq (car rr) 'not-in-mode) + (not (string-match (cdr rr) (symbol-name major-mode)))) + (when (eq (car rr) 'not-in-buffer) + (not (string-match (cdr rr) (buffer-name))))))) + (push r res)))) (delete-dups (delq nil res)))) (defun org-context-p (&rest contexts) @@ -9447,45 +9639,47 @@ Possible values in the list of contexts are `table', `headline', and `item'." (org-in-item-p))) (goto-char pos)))) +(defconst org-unique-local-variables + '(org-element--cache + org-element--cache-objects + org-element--cache-sync-keys + org-element--cache-sync-requests + org-element--cache-sync-timer) + "List of local variables that cannot be transferred to another buffer.") + (defun org-get-local-variables () "Return a list of all local variables in an Org mode buffer." - (let (varlist) - (with-current-buffer (get-buffer-create "*Org tmp*") - (erase-buffer) - (org-mode) - (setq varlist (buffer-local-variables))) - (kill-buffer "*Org tmp*") - (delq nil - (mapcar - (lambda (x) - (setq x - (if (symbolp x) - (list x) - (list (car x) (cdr x)))) - (if (and (not (get (car x) 'org-state)) - (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" - (symbol-name (car x)))) - x nil)) - varlist)))) + (delq nil + (mapcar + (lambda (x) + (let* ((binding (if (symbolp x) (list x) (list (car x) (cdr x)))) + (name (car binding))) + (and (not (get name 'org-state)) + (not (memq name org-unique-local-variables)) + (string-match-p + "\\`\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|\ +auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" + (symbol-name name)) + binding))) + (with-temp-buffer + (org-mode) + (buffer-local-variables))))) (defun org-clone-local-variables (from-buffer &optional regexp) "Clone local variables from FROM-BUFFER. Optional argument REGEXP selects variables to clone." - (mapc - (lambda (pair) - (and (symbolp (car pair)) - (or (null regexp) - (string-match regexp (symbol-name (car pair)))) - (set (make-local-variable (car pair)) - (cdr pair)))) - (buffer-local-variables from-buffer))) + (dolist (pair (buffer-local-variables from-buffer)) + (let ((name (car pair))) + (when (and (symbolp name) + (not (memq name org-unique-local-variables)) + (or (null regexp) (string-match regexp (symbol-name name)))) + (set (make-local-variable name) (cdr pair)))))) ;;;###autoload (defun org-run-like-in-org-mode (cmd) - "Run a command, pretending that the current buffer is in Org-mode. + "Run a command, pretending that the current buffer is in Org mode. This will temporarily bind local variables that are typically bound in -Org-mode to the values they have in Org-mode, and then interactively +Org mode to the values they have in Org mode, and then interactively call CMD." (org-load-modules-maybe) (unless org-local-vars @@ -9502,7 +9696,7 @@ call CMD." (defun org-get-category (&optional pos force-refresh) "Get the category applying to position POS." (save-match-data - (if force-refresh (org-refresh-category-properties)) + (when force-refresh (org-refresh-category-properties)) (let ((pos (or pos (point)))) (or (get-text-property pos 'org-category) (progn (org-refresh-category-properties) @@ -9519,12 +9713,10 @@ the value of the drawer property." (let ((case-fold-search t) (inhibit-read-only t)) (org-with-silent-modifications - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t) - (org-refresh-property tprop (org-match-string-no-properties 1)))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t) + (org-refresh-property tprop (match-string-no-properties 1))))))) (defun org-refresh-property (tprop p) "Refresh the buffer text property TPROP from the drawer property P. @@ -9576,7 +9768,7 @@ The refresh happens only for the current tree (not subtree)." (goto-char (point-min)) (let ((regexp (org-re-property "CATEGORY"))) (while (re-search-forward regexp nil t) - (let ((value (org-match-string-no-properties 3))) + (let ((value (match-string-no-properties 3))) (when (org-at-property-p) (put-text-property (save-excursion (org-back-to-heading t) (point)) @@ -9588,22 +9780,20 @@ The refresh happens only for the current tree (not subtree)." "Refresh stats text properties in the buffer." (let (stats) (org-with-silent-modifications - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward - (concat org-outline-regexp-bol ".*" - "\\(?:\\[\\([0-9]+\\)%\\|\\([0-9]+\\)/\\([0-9]+\\)\\]\\)") - nil t) - (setq stats (cond ((equal (match-string 3) "0") 0) - ((match-string 2) - (/ (* (string-to-number (match-string 2)) 100) - (string-to-number (match-string 3)))) - (t (string-to-number (match-string 1))))) - (org-back-to-heading t) - (put-text-property (point) (progn (org-end-of-subtree t t) (point)) - 'org-stats stats))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + (concat org-outline-regexp-bol ".*" + "\\(?:\\[\\([0-9]+\\)%\\|\\([0-9]+\\)/\\([0-9]+\\)\\]\\)") + nil t) + (setq stats (cond ((equal (match-string 3) "0") 0) + ((match-string 2) + (/ (* (string-to-number (match-string 2)) 100) + (string-to-number (match-string 3)))) + (t (string-to-number (match-string 1))))) + (org-back-to-heading t) + (put-text-property (point) (progn (org-end-of-subtree t t) (point)) + 'org-stats stats)))))) (defun org-refresh-effort-properties () "Refresh effort properties" @@ -9650,78 +9840,53 @@ The refresh happens only for the current tree (not subtree)." (defvar org-store-link-plist nil "Plist with info about the most recently link created with `org-store-link'.") -(defvar org-link-protocols nil - "Link protocols added to Org-mode using `org-add-link-type'.") +(defun org-store-link-functions () + "Return a list of functions that are called to create and store a link. +The functions defined in the :store property of +`org-link-parameters'. -(defvar org-store-link-functions nil - "List of functions that are called to create and store a link. Each function will be called in turn until one returns a non-nil -value. Each function should check if it is responsible for creating -this link (for example by looking at the major mode). -If not, it must exit and return nil. -If yes, it should return a non-nil value after a calling -`org-store-link-props' with a list of properties and values. -Special properties are: +value. Each function should check if it is responsible for +creating this link (for example by looking at the major mode). +If not, it must exit and return nil. If yes, it should return +a non-nil value after calling `org-store-link-props' with a list +of properties and values. Special properties are: :type The link prefix, like \"http\". This must be given. :link The link, like \"http://www.astro.uva.nl/~dominik\". This is obligatory as well. :description Optional default description for the second pair - of brackets in an Org-mode link. The user can still change - this when inserting this link into an Org-mode buffer. + of brackets in an Org mode link. The user can still change + this when inserting this link into an Org mode buffer. In addition to these, any additional properties can be specified -and then used in capture templates.") - -(defun org-add-link-type (type &optional follow export) - "Add TYPE to the list of `org-link-types'. -Re-compute all regular expressions depending on `org-link-types' - -FOLLOW and EXPORT are two functions. - -FOLLOW should take the link path as the single argument and do whatever -is necessary to follow the link, for example find a file or display -a mail message. - -EXPORT should format the link path for export to one of the export formats. -It should be a function accepting three arguments: - - path the path of the link, the text after the prefix (like \"http:\") - desc the description of the link, if any - format the export format, a symbol like `html' or `latex' or `ascii'. - -The function may use the FORMAT information to return different values -depending on the format. The return value will be put literally into -the exported file. If the return value is nil, this means Org should -do what it normally does with links which do not have EXPORT defined. - -Org mode has a built-in default for exporting links. If you are happy with -this default, there is no need to define an export function for the link -type. For a simple example of an export function, see `org-bbdb.el'." - (add-to-list 'org-link-types type t) - (org-make-link-regexps) - (org-element-update-syntax) - (if (assoc type org-link-protocols) - (setcdr (assoc type org-link-protocols) (list follow export)) - (push (list type follow export) org-link-protocols))) +and then used in capture templates." + (cl-loop for link in org-link-parameters + with store-func + do (setq store-func (org-link-get-parameter (car link) :store)) + if store-func + collect store-func)) (defvar org-agenda-buffer-name) ; Defined in org-agenda.el (defvar org-id-link-to-org-use-id) ; Defined in org-id.el ;;;###autoload (defun org-store-link (arg) - "\\<org-mode-map>Store an org-link to the current location. + "Store an org-link to the current location. +\\<org-mode-map> This link is added to `org-stored-links' and can later be inserted -into an Org buffer with \\[org-insert-link]. +into an Org buffer with `org-insert-link' (`\\[org-insert-link]'). -For some link types, a prefix ARG is interpreted. +For some link types, a `\\[universal-argument]' prefix ARG is interpreted. For links to Usenet articles, ARG negates `org-gnus-prefer-web-links'. For file links, ARG negates `org-context-in-file-links'. -A double prefix ARG force skipping storing functions that are not -part of Org's core. +A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \ +skipping storing functions that are not +part of Org core. -A triple prefix ARG force storing a link for each line in the +A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ +prefix ARG forces storing a link for each line in the active region." (interactive "P") (org-load-modules-maybe) @@ -9736,118 +9901,111 @@ active region." (call-interactively 'org-store-link)) (move-beginning-of-line 2) (set-mark (point))))) - (org-with-limited-levels - (setq org-store-link-plist nil) - (let (link cpltxt desc description search - txt custom-id agenda-link sfuns sfunsn) - (cond + (setq org-store-link-plist nil) + (let (link cpltxt desc description search + txt custom-id agenda-link sfuns sfunsn) + (cond - ;; Store a link using an external link type - ((and (not (equal arg '(16))) - (setq sfuns - (delq - nil (mapcar (lambda (f) - (let (fs) (if (funcall f) (push f fs)))) - org-store-link-functions)) - sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns)) - (or (and (cdr sfuns) - (funcall (intern - (completing-read - "Which function for creating the link? " - sfunsn nil t (car sfunsn))))) - (funcall (caar sfuns))) - (setq link (plist-get org-store-link-plist :link) - desc (or (plist-get org-store-link-plist - :description) - link)))) - - ;; Store a link from a source code buffer. - ((org-src-edit-buffer-p) - (cond - ((save-excursion - (beginning-of-line) - (looking-at (concat (format org-coderef-label-format "\\(.*?\\)") - "[ \t]*$"))) - (setq link (format "(%s)" (org-match-string-no-properties 1)))) - ((org-called-interactively-p 'any) - (let (label) - (while (or (not label) - (org-with-wide-buffer - (goto-char (point-min)) - (re-search-forward - (regexp-quote (format org-coderef-label-format label)) - nil t))) - (when label (message "Label exists already") (sit-for 2)) - (setq label (read-string "Code line label: " label))) - (end-of-line) - (setq link (format org-coderef-label-format label)) - (let ((gc (- 79 (length link)))) - (if (< (current-column) gc) (org-move-to-column gc t) - (insert " "))) - (insert link) - (setq link (concat "(" label ")") desc nil))) - (t (setq link nil)))) - - ;; We are in the agenda, link to referenced location - ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) - (let ((m (or (get-text-property (point) 'org-hd-marker) - (get-text-property (point) 'org-marker)))) - (when m - (org-with-point-at m - (setq agenda-link - (if (org-called-interactively-p 'any) - (call-interactively 'org-store-link) - (org-store-link nil))))))) - - ((eq major-mode 'calendar-mode) - (let ((cd (calendar-cursor-to-date))) - (setq link - (format-time-string - (car org-time-stamp-formats) - (apply 'encode-time - (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) - nil nil nil)))) - (org-store-link-props :type "calendar" :date cd))) - - ((eq major-mode 'help-mode) - (setq link (concat "help:" (save-excursion - (goto-char (point-min)) - (looking-at "^[^ ]+") - (match-string 0)))) - (org-store-link-props :type "help")) - - ((eq major-mode 'w3-mode) - (setq cpltxt (if (and (buffer-name) - (not (string-match "Untitled" (buffer-name)))) - (buffer-name) - (url-view-url t)) - link (url-view-url t)) - (org-store-link-props :type "w3" :url (url-view-url t))) - - ((eq major-mode 'image-mode) - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name)) - link cpltxt) - (org-store-link-props :type "image" :file buffer-file-name)) - - ;; In dired, store a link to the file of the current line - ((derived-mode-p 'dired-mode) - (let ((file (dired-get-filename nil t))) - (setq file (if file - (abbreviate-file-name - (expand-file-name (dired-get-filename nil t))) - ;; otherwise, no file so use current directory. - default-directory)) - (setq cpltxt (concat "file:" file) - link cpltxt))) - - ((setq search (run-hook-with-args-until-success - 'org-create-file-search-functions)) - (setq link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (setq cpltxt (or description link))) - - ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + ;; Store a link using an external link type + ((and (not (equal arg '(16))) + (setq sfuns + (delq + nil (mapcar (lambda (f) + (let (fs) (if (funcall f) (push f fs)))) + (org-store-link-functions))) + sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns)) + (or (and (cdr sfuns) + (funcall (intern + (completing-read + "Which function for creating the link? " + sfunsn nil t (car sfunsn))))) + (funcall (caar sfuns))) + (setq link (plist-get org-store-link-plist :link) + desc (or (plist-get org-store-link-plist + :description) + link)))) + + ;; Store a link from a source code buffer. + ((org-src-edit-buffer-p) + (let ((coderef-format (org-src-coderef-format))) + (cond ((save-excursion + (beginning-of-line) + (looking-at (org-src-coderef-regexp coderef-format))) + (setq link (format "(%s)" (match-string-no-properties 3)))) + ((called-interactively-p 'any) + (let ((label (read-string "Code line label: "))) + (end-of-line) + (setq link (format coderef-format label)) + (let ((gc (- 79 (length link)))) + (if (< (current-column) gc) + (org-move-to-column gc t) + (insert " "))) + (insert link) + (setq link (concat "(" label ")")) + (setq desc nil))) + (t (setq link nil))))) + + ;; We are in the agenda, link to referenced location + ((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name)) + (let ((m (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker)))) + (when m + (org-with-point-at m + (setq agenda-link + (if (called-interactively-p 'any) + (call-interactively 'org-store-link) + (org-store-link nil))))))) + + ((eq major-mode 'calendar-mode) + (let ((cd (calendar-cursor-to-date))) + (setq link + (format-time-string + (car org-time-stamp-formats) + (apply 'encode-time + (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) + nil nil nil)))) + (org-store-link-props :type "calendar" :date cd))) + + ((eq major-mode 'help-mode) + (setq link (concat "help:" (save-excursion + (goto-char (point-min)) + (looking-at "^[^ ]+") + (match-string 0)))) + (org-store-link-props :type "help")) + + ((eq major-mode 'w3-mode) + (setq cpltxt (if (and (buffer-name) + (not (string-match "Untitled" (buffer-name)))) + (buffer-name) + (url-view-url t)) + link (url-view-url t)) + (org-store-link-props :type "w3" :url (url-view-url t))) + + ((eq major-mode 'image-mode) + (setq cpltxt (concat "file:" + (abbreviate-file-name buffer-file-name)) + link cpltxt) + (org-store-link-props :type "image" :file buffer-file-name)) + + ;; In dired, store a link to the file of the current line + ((derived-mode-p 'dired-mode) + (let ((file (dired-get-filename nil t))) + (setq file (if file + (abbreviate-file-name + (expand-file-name (dired-get-filename nil t))) + ;; otherwise, no file so use current directory. + default-directory)) + (setq cpltxt (concat "file:" file) + link cpltxt))) + + ((setq search (run-hook-with-args-until-success + 'org-create-file-search-functions)) + (setq link (concat "file:" (abbreviate-file-name buffer-file-name) + "::" search)) + (setq cpltxt (or description link))) + + ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + (org-with-limited-levels (setq custom-id (org-entry-get nil "CUSTOM_ID")) (cond ;; Store a link using the target at point @@ -9860,7 +10018,7 @@ active region." link cpltxt)) ((and (featurep 'org-id) (or (eq org-id-link-to-org-use-id t) - (and (org-called-interactively-p 'any) + (and (called-interactively-p 'any) (or (eq org-id-link-to-org-use-id 'create-if-interactive) (and (eq org-id-link-to-org-use-id 'create-if-interactive-and-no-custom-id) @@ -9884,14 +10042,11 @@ active region." (buffer-file-name (buffer-base-buffer))))) ;; Add a context search string (when (org-xor org-context-in-file-links arg) - (let* ((ee (org-element-at-point)) - (et (org-element-type ee)) - (ev (plist-get (cadr ee) :value)) - (ek (plist-get (cadr ee) :key)) - (eok (and (stringp ek) (string-match "name" ek)))) + (let* ((element (org-element-at-point)) + (name (org-element-property :name element))) (setq txt (cond ((org-at-heading-p) nil) - ((and (eq et 'keyword) eok) ev) + (name) ((org-region-active-p) (buffer-substring (region-beginning) (region-end))))) (when (or (null txt) (string-match "\\S-" txt)) @@ -9900,74 +10055,79 @@ active region." (condition-case nil (org-make-org-heading-search-string txt) (error ""))) - desc (or (and (eq et 'keyword) eok ev) + desc (or name (nth 4 (ignore-errors (org-heading-components))) "NONE"))))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link cpltxt)))) - - ((buffer-file-name (buffer-base-buffer)) - ;; Just link to this file here. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context string. - (when (org-xor org-context-in-file-links arg) - (setq txt (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)) - (buffer-substring (point-at-bol) (point-at-eol)))) - ;; Only use search option if there is some text. - (when (string-match "\\S-" txt) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE"))) - (setq link cpltxt)) - - ((org-called-interactively-p 'interactive) - (user-error "No method for storing a link from this buffer")) - - (t (setq link nil))) - - ;; We're done setting link and desc, clean up - (if (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt) - desc (or desc cpltxt)) - (cond ((equal desc "NONE") (setq desc nil)) - ((and desc (string-match org-bracket-link-analytic-regexp desc)) - (let ((d0 (match-string 3 desc)) - (p0 (match-string 5 desc))) - (setq desc - (replace-regexp-in-string - org-bracket-link-regexp - (concat (or p0 d0) - (if (equal (length (match-string 0 desc)) - (length desc)) "*" "")) desc))))) - - ;; Return the link - (if (not (and (or (org-called-interactively-p 'any) - executing-kbd-macro) - link)) - (or agenda-link (and link (org-make-link-string link desc))) - (push (list link desc) org-stored-links) - (message "Stored: %s" (or desc link)) - (when custom-id - (setq link (concat "file:" (abbreviate-file-name - (buffer-file-name)) "::#" custom-id)) - (push (list link desc) org-stored-links)) - (car org-stored-links)))))) + (when (string-match "::\\'" cpltxt) + (setq cpltxt (substring cpltxt 0 -2))) + (setq link cpltxt))))) + + ((buffer-file-name (buffer-base-buffer)) + ;; Just link to this file here. + (setq cpltxt (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) + ;; Add a context string. + (when (org-xor org-context-in-file-links arg) + (setq txt (if (org-region-active-p) + (buffer-substring (region-beginning) (region-end)) + (buffer-substring (point-at-bol) (point-at-eol)))) + ;; Only use search option if there is some text. + (when (string-match "\\S-" txt) + (setq cpltxt + (concat cpltxt "::" (org-make-org-heading-search-string txt)) + desc "NONE"))) + (setq link cpltxt)) + + ((called-interactively-p 'interactive) + (user-error "No method for storing a link from this buffer")) + + (t (setq link nil))) + + ;; We're done setting link and desc, clean up + (when (consp link) (setq cpltxt (car link) link (cdr link))) + (setq link (or link cpltxt) + desc (or desc cpltxt)) + (cond ((not desc)) + ((equal desc "NONE") (setq desc nil)) + (t (setq desc + (replace-regexp-in-string + org-bracket-link-analytic-regexp + (lambda (m) (or (match-string 5 m) (match-string 3 m))) + desc)))) + ;; Return the link + (if (not (and (or (called-interactively-p 'any) + executing-kbd-macro) + link)) + (or agenda-link (and link (org-make-link-string link desc))) + (push (list link desc) org-stored-links) + (message "Stored: %s" (or desc link)) + (when custom-id + (setq link (concat "file:" (abbreviate-file-name + (buffer-file-name)) "::#" custom-id)) + (push (list link desc) org-stored-links)) + (car org-stored-links))))) (defun org-store-link-props (&rest plist) - "Store link properties, extract names and addresses." - (let (x adr) - (when (setq x (plist-get plist :from)) - (setq adr (mail-extract-address-components x)) - (setq plist (plist-put plist :fromname (car adr))) - (setq plist (plist-put plist :fromaddress (nth 1 adr)))) - (when (setq x (plist-get plist :to)) - (setq adr (mail-extract-address-components x)) - (setq plist (plist-put plist :toname (car adr))) - (setq plist (plist-put plist :toaddress (nth 1 adr))))) + "Store link properties, extract names, addresses and dates." + (let ((x (plist-get plist :from))) + (when x + (let ((adr (mail-extract-address-components x))) + (setq plist (plist-put plist :fromname (car adr))) + (setq plist (plist-put plist :fromaddress (nth 1 adr)))))) + (let ((x (plist-get plist :to))) + (when x + (let ((adr (mail-extract-address-components x))) + (setq plist (plist-put plist :toname (car adr))) + (setq plist (plist-put plist :toaddress (nth 1 adr)))))) + (let ((x (ignore-errors (date-to-time (plist-get plist :date))))) + (when x + (setq plist (plist-put plist :date-timestamp + (format-time-string + (org-time-stamp-format t) x))) + (setq plist (plist-put plist :date-timestamp-inactive + (format-time-string + (org-time-stamp-format t t) x))))) (let ((from (plist-get plist :from)) (to (plist-get plist :to))) (when (and from to org-from-is-user-regexp) @@ -10042,7 +10202,7 @@ according to FMT (default from `org-email-link-description-format')." ;; square brackets). File links however, are ;; encoded since, e.g., spaces are significant. ((or (file-name-absolute-p link) - (org-string-match-p "\\`\\.\\.?/\\|[][]" link)) + (string-match-p "\\`\\.\\.?/\\|[][]" link)) (org-link-escape link)) (t link))) (description @@ -10061,15 +10221,6 @@ according to FMT (default from `org-email-link-description-format')." "List of characters that should be escaped in a link when stored to Org. This is the list that is used for internal purposes.") -(defconst org-link-escape-chars-browser - ;;%20 %22 - '(?\s ?\") - "List of characters to be escaped before handing over to the browser. -If you consider using this constant then you probably want to use -the function `org-link-escape-browser' instead. See there why -this constant is a candidate to be removed once Org drops support -for Emacs 24.1 and 24.2.") - (defun org-link-escape (text &optional table merge) "Return percent escaped representation of TEXT. TEXT is a string with the text to escape. @@ -10092,29 +10243,6 @@ If optional argument MERGE is set, merge TABLE into (char-to-string c))) text ""))) -(defun org-link-escape-browser (text) - "Escape some characters before handing over to the browser. -This function is a candidate to be removed together with the -constant `org-link-escape-chars-browser' once Org drops support -for Emacs 24.1 and 24.2. All calls to this function will have to -be replaced with `url-encode-url' which is available since Emacs -24.3.1." - ;; Example with the Org link - ;; [[http://lists.gnu.org/archive/cgi-bin/namazu.cgi?idxname=emacs-orgmode&query=%252Bsubject:"Release+8.2"]] - ;; to open the browser with +subject:"Release 8.2" filled into the - ;; query field: In this case the variable TEXT contains the - ;; unescaped [...]=%2Bsubject:"Release+8.2". Then `url-encode-url' - ;; converts correctly to [...]=%2Bsubject:%22Release+8.2%22 or - ;; `org-link-escape' with `org-link-escape-chars-browser' converts - ;; wrongly to [...]=%252Bsubject:%22Release+8.2%22. - (if (fboundp 'url-encode-url) - (url-encode-url text) - (if (org-string-match-p - (concat "[[:nonascii:]" org-link-escape-chars-browser "]") - text) - (org-link-escape text org-link-escape-chars-browser) - text))) - (defun org-link-unescape (str) "Unhex hexified Unicode parts in string STR. E.g. `%C3%B6' becomes the german o-Umlaut. This is the @@ -10145,13 +10273,13 @@ Note: this function also decodes single byte encodings like ((>= val 192) (cons 2 192)) (t (cons 0 0))) (cons 6 128)))) - (if (>= val 192) (setq eat (car shift-xor))) + (when (>= val 192) (setq eat (car shift-xor))) (setq val (logxor val (cdr shift-xor))) (setq sum (+ (lsh sum (car shift-xor)) val)) - (if (> eat 0) (setq eat (- eat 1))) + (when (> eat 0) (setq eat (- eat 1))) (cond ((= 0 eat) ;multi byte - (setq ret (concat ret (org-char-to-string sum))) + (setq ret (concat ret (char-to-string sum))) (setq sum 0)) ((not bytes) ; single byte(s) (setq ret (org-link-unescape-single-byte-sequence hex)))))) @@ -10193,8 +10321,8 @@ The cdr of LINK must be either a link description or nil." ;;;###autoload (defun org-insert-link-global () - "Insert a link like Org-mode does. -This command can be called in any mode to insert a link in Org-mode syntax." + "Insert a link like Org mode does. +This command can be called in any mode to insert a link in Org syntax." (interactive) (org-load-modules-maybe) (org-run-like-in-org-mode 'org-insert-link)) @@ -10207,7 +10335,7 @@ When `ARG' is a number, insert the last N link(s). prepend or to append." (interactive "P") (let ((org-keep-stored-link-after-insertion (equal arg '(4))) - (links (copy-seq org-stored-links)) + (links (copy-sequence org-stored-links)) (pr (or pre "- ")) (po (or post "\n")) (cnt 1) l) @@ -10249,73 +10377,73 @@ prepend or to append." (put-text-property 0 (length l) 'face 'font-lock-comment-face l)) (delq nil (append a b))))) -(defvar org-link-links-in-this-file nil) +(defvar org--links-history nil) (defun org-insert-link (&optional complete-file link-location default-description) "Insert a link. At the prompt, enter the link. -Completion can be used to insert any of the link protocol prefixes like -http or ftp in use. +Completion can be used to insert any of the link protocol prefixes in use. The history can be used to select a link previously stored with `org-store-link'. When the empty string is entered (i.e. if you just -press RET at the prompt), the link defaults to the most recently -stored link. As SPC triggers completion in the minibuffer, you need to -use M-SPC or C-q SPC to force the insertion of a space character. +press `RET' at the prompt), the link defaults to the most recently +stored link. As `SPC' triggers completion in the minibuffer, you need to +use `M-SPC' or `C-q SPC' to force the insertion of a space character. You will also be prompted for a description, and if one is given, it will be displayed in the buffer instead of the link. -If there is already a link at point, this command will allow you to edit link -and description parts. +If there is already a link at point, this command will allow you to edit +link and description parts. -With a \\[universal-argument] prefix, prompts for a file to link to. The file name can -be selected using completion. The path to the file will be relative to the +With a `\\[universal-argument]' prefix, prompts for a file to link to. The \ +file name can be +selected using completion. The path to the file will be relative to the current directory if the file is in the current directory or a subdirectory. Otherwise, the link will be the absolute path as completed in the minibuffer \(i.e. normally ~/path/to/file). You can configure this behavior using the option `org-link-file-path-type'. -With two \\[universal-argument] prefixes, enforce an absolute path even if the file is in +With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \ +absolute path even if the file is in the current directory or below. -With three \\[universal-argument] prefixes, negate the meaning of -`org-keep-stored-link-after-insertion'. +A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ +prefix negates `org-keep-stored-link-after-insertion'. If `org-make-link-description-function' is non-nil, this function will be called with the link target, and the result will be the default link description. -If the LINK-LOCATION parameter is non-nil, this value will be -used as the link location instead of reading one interactively. +If the LINK-LOCATION parameter is non-nil, this value will be used as +the link location instead of reading one interactively. -If the DEFAULT-DESCRIPTION parameter is non-nil, this value will -be used as the default description." +If the DEFAULT-DESCRIPTION parameter is non-nil, this value will be used +as the default description." (interactive "P") (let* ((wcf (current-window-configuration)) (origbuf (current-buffer)) - (region (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)))) + (region (when (org-region-active-p) + (buffer-substring (region-beginning) (region-end)))) (remove (and region (list (region-beginning) (region-end)))) (desc region) - tmphist ; byte-compile incorrectly complains about this (link link-location) (abbrevs org-link-abbrev-alist-local) - entry file all-prefixes auto-desc) + entry all-prefixes auto-desc) (cond - (link-location) ; specified by arg, just use it. + (link-location) ; specified by arg, just use it. ((org-in-regexp org-bracket-link-regexp 1) ;; We do have a link at point, and we are going to edit it. (setq remove (list (match-beginning 0) (match-end 0))) - (setq desc (if (match-end 3) (org-match-string-no-properties 3))) + (setq desc (when (match-end 3) (match-string-no-properties 3))) (setq link (read-string "Link: " (org-link-unescape - (org-match-string-no-properties 1))))) + (match-string-no-properties 1))))) ((or (org-in-regexp org-angle-link-re) (org-in-regexp org-plain-link-re)) ;; Convert to bracket link (setq remove (list (match-beginning 0) (match-end 0)) link (read-string "Link: " - (org-remove-angle-brackets (match-string 0))))) + (org-unbracket-string "<" ">" (match-string 0))))) ((member complete-file '((4) (16))) ;; Completing read for file names. (setq link (org-file-complete-link complete-file))) @@ -10338,50 +10466,49 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (unless (pos-visible-in-window-p (point-max)) (org-fit-window-to-buffer)) (and (window-live-p cw) (select-window cw))) - ;; Fake a link history, containing the stored links. - (setq tmphist (append (mapcar 'car org-stored-links) - org-insert-link-history)) (setq all-prefixes (append (mapcar 'car abbrevs) (mapcar 'car org-link-abbrev-alist) - org-link-types)) + (org-link-types))) (unwind-protect - (progn + ;; Fake a link history, containing the stored links. + (let ((org--links-history + (append (mapcar #'car org-stored-links) + org-insert-link-history))) (setq link (org-completing-read "Link: " (append - (mapcar (lambda (x) (concat x ":")) - all-prefixes) - (mapcar 'car org-stored-links)) + (mapcar (lambda (x) (concat x ":")) all-prefixes) + (mapcar #'car org-stored-links)) nil nil nil - 'tmphist + 'org--links-history (caar org-stored-links))) - (if (not (string-match "\\S-" link)) - (user-error "No link selected")) - (mapc (lambda(l) - (when (equal link (cadr l)) (setq link (car l) auto-desc t))) - org-stored-links) - (if (or (member link all-prefixes) - (and (equal ":" (substring link -1)) - (member (substring link 0 -1) all-prefixes) - (setq link (substring link 0 -1)))) - (setq link (with-current-buffer origbuf - (org-link-try-special-completion link))))) + (unless (org-string-nw-p link) (user-error "No link selected")) + (dolist (l org-stored-links) + (when (equal link (cadr l)) + (setq link (car l)) + (setq auto-desc t))) + (when (or (member link all-prefixes) + (and (equal ":" (substring link -1)) + (member (substring link 0 -1) all-prefixes) + (setq link (substring link 0 -1)))) + (setq link (with-current-buffer origbuf + (org-link-try-special-completion link))))) (set-window-configuration wcf) (kill-buffer "*Org Links*")) (setq entry (assoc link org-stored-links)) (or entry (push link org-insert-link-history)) (setq desc (or desc (nth 1 entry))))) - (if (funcall (if (equal complete-file '(64)) 'not 'identity) - (not org-keep-stored-link-after-insertion)) - (setq org-stored-links (delq (assoc link org-stored-links) - org-stored-links))) + (when (funcall (if (equal complete-file '(64)) 'not 'identity) + (not org-keep-stored-link-after-insertion)) + (setq org-stored-links (delq (assoc link org-stored-links) + org-stored-links))) - (if (and (string-match org-plain-link-re link) - (not (string-match org-ts-regexp link))) - ;; URL-like link, normalize the use of angular brackets. - (setq link (org-remove-angle-brackets link))) + (when (and (string-match org-plain-link-re link) + (not (string-match org-ts-regexp link))) + ;; URL-like link, normalize the use of angular brackets. + (setq link (org-unbracket-string "<" ">" link))) ;; Check if we are linking to the current file with a search ;; option If yes, simplify the link by using only the search @@ -10392,9 +10519,9 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (case-fold-search nil) (search (match-string 2 link))) (save-match-data - (if (equal (file-truename buffer-file-name) (file-truename path)) - ;; We are linking to this same file, with a search option - (setq link search))))) + (when (equal (file-truename buffer-file-name) (file-truename path)) + ;; We are linking to this same file, with a search option + (setq link search))))) ;; Check if we can/should use a relative path. If yes, simplify the link (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link) @@ -10422,8 +10549,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (match-end 0))) (setq path (abbreviate-file-name (expand-file-name path))))))) (setq link (concat type path)) - (if (equal desc origpath) - (setq desc path)))) + (when (equal desc origpath) + (setq desc path)))) (if org-make-link-description-function (setq desc @@ -10438,21 +10565,21 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (read-string "Description: " desc))))) (unless (string-match "\\S-" desc) (setq desc nil)) - (if remove (apply 'delete-region remove)) + (when remove (apply 'delete-region remove)) (insert (org-make-link-string link desc)) ;; Redisplay so as the new link has proper invisible characters. (sit-for 0))) (defun org-link-try-special-completion (type) "If there is completion support for link type TYPE, offer it." - (let ((fun (intern (concat "org-" type "-complete-link")))) + (let ((fun (org-link-get-parameter type :complete))) (if (functionp fun) (funcall fun) (read-string "Link (no completion support): " (concat type ":"))))) (defun org-file-complete-link (&optional arg) "Create a file link using completion." - (let ((file (org-iread-file-name "File: ")) + (let ((file (read-file-name "File: ")) (pwd (file-name-as-directory (expand-file-name "."))) (pwd1 (file-name-as-directory (abbreviate-file-name (expand-file-name "."))))) @@ -10469,19 +10596,6 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (match-string 1 (expand-file-name file)))) (t (concat "file:" file))))) -(defun org-iread-file-name (&rest args) - "Read-file-name using `ido-mode' speedup if available. -ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'. -See `read-file-name' for a description of parameters." - (org-without-partial-completion - (if (and org-completion-use-ido - (fboundp 'ido-read-file-name) - (org-bound-and-true-p ido-mode) - (listp (nth 1 args))) - (let ((ido-enter-matching-directory nil)) - (apply #'ido-read-file-name args)) - (apply #'read-file-name args)))) - (defun org-completing-read (&rest args) "Completing-read with SPACE being a normal character." (let ((enable-recursive-minibuffers t) @@ -10489,42 +10603,9 @@ See `read-file-name' for a description of parameters." (copy-keymap minibuffer-local-completion-map))) (org-defkey minibuffer-local-completion-map " " 'self-insert-command) (org-defkey minibuffer-local-completion-map "?" 'self-insert-command) - (org-defkey minibuffer-local-completion-map (kbd "C-c !") 'org-time-stamp-inactive) - (apply 'org-icompleting-read args))) - -(defun org-completing-read-no-i (&rest args) - (let (org-completion-use-ido org-completion-use-iswitchb) - (apply 'org-completing-read args))) - -(defun org-iswitchb-completing-read (prompt choices &rest args) - "Use iswitch as a completing-read replacement to choose from choices. -PROMPT is a string to prompt with. CHOICES is a list of strings to choose -from." - (let* ((iswitchb-use-virtual-buffers nil) - (iswitchb-make-buflist-hook - (lambda () - (setq iswitchb-temp-buflist choices)))) - (iswitchb-read-buffer prompt))) - -(defun org-icompleting-read (&rest args) - "Completing-read using `ido-mode' or `iswitchb' speedups if available. -Should be called like `completing-read'." - (org-without-partial-completion - (if (not (listp (nth 1 args))) - ;; Ido only supports lists as the COLLECTION argument. Use - ;; default completion function when second argument is not - ;; a list. - (apply #'completing-read args) - (let ((ido-enter-matching-directory nil)) - (apply (cond ((and org-completion-use-ido - (fboundp 'ido-completing-read) - (org-bound-and-true-p ido-mode)) - #'ido-completing-read) - ((and org-completion-use-iswitchb - (org-bound-and-true-p iswitchb-mode)) - #'org-iswitchb-completing-read) - (t #'completing-read)) - args))))) + (org-defkey minibuffer-local-completion-map (kbd "C-c !") + 'org-time-stamp-inactive) + (apply #'completing-read args))) ;;; Opening/following a link @@ -10544,8 +10625,8 @@ handle this as a special case. When the function does handle the link, it must return a non-nil value. If it decides that it is not responsible for this link, it must return -nil to indicate that that Org-mode can continue with other options -like exact and fuzzy text search.") +nil to indicate that that Org can continue with other options like +exact and fuzzy text search.") (defun org-next-link (&optional search-backward) "Move forward to the next link. @@ -10557,7 +10638,7 @@ If the link is in hidden text, expose it." (setq org-link-search-failed nil) (let* ((pos (point)) (ct (org-context)) - (a (assoc :link ct)) + (a (assq :link ct)) (srch-fun (if search-backward 're-search-backward 're-search-forward))) (cond (a (goto-char (nth (if search-backward 1 2) a))) ((looking-at org-any-link-re) @@ -10566,7 +10647,7 @@ If the link is in hidden text, expose it." (if (funcall srch-fun org-any-link-re nil t) (progn (goto-char (match-beginning 0)) - (if (outline-invisible-p) (org-show-context))) + (when (outline-invisible-p) (org-show-context))) (goto-char pos) (setq org-link-search-failed t) (message "No further link found")))) @@ -10601,7 +10682,7 @@ This is still an experimental function, your mileage may vary." ;; A typical message link. Planner has the id after the final slash, ;; we separate it with a hash mark (setq path (concat (match-string 1 path) "#" - (org-remove-angle-brackets (match-string 2 path)))))) + (org-unbracket-string "<" ">" (match-string 2 path)))))) (cons type path)) (defun org-find-file-at-mouse (ev) @@ -10615,8 +10696,8 @@ This is still an experimental function, your mileage may vary." See the docstring of `org-open-file' for details." (interactive "e") (mouse-set-point ev) - (if (eq major-mode 'org-agenda-mode) - (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)) + (when (eq major-mode 'org-agenda-mode) + (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)) (org-open-at-point)) (defvar org-window-config-before-follow-link nil @@ -10625,15 +10706,22 @@ This is saved in case the need arises to restore it.") ;;;###autoload (defun org-open-at-point-global () - "Follow a link like Org-mode does. -This command can be called in any mode to follow a link that has -Org-mode syntax." + "Follow a link or time-stamp like Org mode does. +This command can be called in any mode to follow an external link +or a time-stamp that has Org mode syntax. Its behavior is +undefined when called on internal links (e.g., fuzzy links). +Raise an error when there is nothing to follow. " (interactive) - (org-run-like-in-org-mode 'org-open-at-point)) + (cond ((org-in-regexp org-any-link-re) + (org-open-link-from-string (match-string-no-properties 0))) + ((or (org-in-regexp org-ts-regexp-both nil t) + (org-in-regexp org-tsr-regexp-both nil t)) + (org-follow-timestamp-link)) + (t (user-error "No link found")))) ;;;###autoload (defun org-open-link-from-string (s &optional arg reference-buffer) - "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." (interactive "sLink: \nP") (let ((reference-buffer (or reference-buffer (current-buffer)))) (with-temp-buffer @@ -10654,8 +10742,61 @@ Functions in this hook must return t if they identify and follow a link at point. If they don't find anything interesting at point, they must return nil.") -(defvar org-link-search-inhibit-query nil) ;; dynamically scoped -(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el +(defvar org-link-search-inhibit-query nil) +(defvar clean-buffer-list-kill-buffer-names) ;Defined in midnight.el +(defun org--open-doi-link (path) + "Open a \"doi\" type link. +PATH is a the path to search for, as a string." + (browse-url (url-encode-url (concat org-doi-server-url path)))) + +(defun org--open-elisp-link (path) + "Open a \"elisp\" type link. +PATH is the sexp to evaluate, as a string." + (let ((cmd path)) + (if (or (and (org-string-nw-p + org-confirm-elisp-link-not-regexp) + (string-match-p org-confirm-elisp-link-not-regexp cmd)) + (not org-confirm-elisp-link-function) + (funcall org-confirm-elisp-link-function + (format "Execute \"%s\" as elisp? " + (org-add-props cmd nil 'face 'org-warning)))) + (message "%s => %s" cmd + (if (eq (string-to-char cmd) ?\() + (eval (read cmd)) + (call-interactively (read cmd)))) + (user-error "Abort")))) + +(defun org--open-help-link (path) + "Open a \"help\" type link. +PATH is a symbol name, as a string." + (pcase (intern path) + ((and (pred fboundp) variable) (describe-function variable)) + ((and (pred boundp) function) (describe-variable function)) + (name (user-error "Unknown function or variable: %s" name)))) + +(defun org--open-shell-link (path) + "Open a \"shell\" type link. +PATH is the command to execute, as a string." + (let ((buf (generate-new-buffer "*Org Shell Output*")) + (cmd path)) + (if (or (and (org-string-nw-p + org-confirm-shell-link-not-regexp) + (string-match + org-confirm-shell-link-not-regexp cmd)) + (not org-confirm-shell-link-function) + (funcall org-confirm-shell-link-function + (format "Execute \"%s\" in shell? " + (org-add-props cmd nil + 'face 'org-warning)))) + (progn + (message "Executing %s" cmd) + (shell-command cmd buf) + (when (featurep 'midnight) + (setq clean-buffer-list-kill-buffer-names + (cons (buffer-name buf) + clean-buffer-list-kill-buffer-names)))) + (user-error "Abort")))) + (defun org-open-at-point (&optional arg reference-buffer) "Open link, timestamp, footnote or tags at point. @@ -10706,19 +10847,17 @@ link in a property drawer line." ;; Exception: open timestamps and links in properties ;; drawers, keywords and comments. ((memq type '(comment comment-block keyword node-property)) - (cond ((org-in-regexp org-any-link-re) - (org-open-link-from-string (match-string-no-properties 0))) - ((or (org-at-timestamp-p t) (org-at-date-range-p t)) - (org-follow-timestamp-link)) - (t (user-error "No link found")))) + (call-interactively #'org-open-at-point-global)) ;; On a headline or an inlinetask, but not on a timestamp, ;; a link, a footnote reference or on tags. ((and (memq type '(headline inlinetask)) ;; Not on tags. - (progn (save-excursion (beginning-of-line) - (looking-at org-complex-heading-regexp)) - (or (not (match-beginning 5)) - (< (point) (match-beginning 5))))) + (let ((case-fold-search nil)) + (save-excursion + (beginning-of-line) + (looking-at org-complex-heading-regexp)) + (or (not (match-beginning 5)) + (< (point) (match-beginning 5))))) (let* ((data (org-offer-links-in-entry (current-buffer) (point) arg)) (links (car data)) (links-end (cdr data))) @@ -10736,30 +10875,30 @@ link in a property drawer line." (>= (point) (org-element-property :begin value)) (<= (point) (org-element-property :end value))) (org-follow-timestamp-link)) - ;; Do nothing on white spaces after an object, unless point - ;; is right after it. - ((> (point) - (save-excursion - (goto-char (org-element-property :end context)) - (skip-chars-backward " \t") - (point))) + ;; Do nothing on white spaces after an object. + ((>= (point) + (save-excursion + (goto-char (org-element-property :end context)) + (skip-chars-backward " \t") + (point))) (user-error "No link found")) ((eq type 'timestamp) (org-follow-timestamp-link)) ;; On tags within a headline or an inlinetask. ((and (memq type '(headline inlinetask)) - (progn (save-excursion (beginning-of-line) - (looking-at org-complex-heading-regexp)) - (and (match-beginning 5) - (>= (point) (match-beginning 5))))) + (let ((case-fold-search nil)) + (save-excursion (beginning-of-line) + (looking-at org-complex-heading-regexp)) + (and (match-beginning 5) + (>= (point) (match-beginning 5))))) (org-tags-view arg (substring (match-string 5) 0 -1))) ((eq type 'link) ;; When link is located within the description of another ;; link (e.g., an inline image), always open the parent ;; link. - (let*((link (let ((up (org-element-property :parent context))) - (if (eq (org-element-type up) 'link) up context))) - (type (org-element-property :type link)) - (path (org-link-unescape (org-element-property :path link)))) + (let* ((link (let ((up (org-element-property :parent context))) + (if (eq (org-element-type up) 'link) up context))) + (type (org-element-property :type link)) + (path (org-link-unescape (org-element-property :path link)))) ;; Switch back to REFERENCE-BUFFER needed when called in ;; a temporary buffer through `org-open-link-from-string'. (with-current-buffer (or reference-buffer (current-buffer)) @@ -10767,21 +10906,19 @@ link in a property drawer line." ((equal type "file") (if (string-match "[*?{]" (file-name-nondirectory path)) (dired path) - ;; Look into `org-link-protocols' in order to find + ;; Look into `org-link-parameters' in order to find ;; a DEDICATED-FUNCTION to open file. The function ;; will be applied on raw link instead of parsed ;; link due to the limitation in `org-add-link-type' ;; ("open" function called with a single argument). ;; If no such function is found, fallback to ;; `org-open-file'. - ;; - ;; Note : "file+emacs" and "file+sys" types are - ;; hard-coded in order to escape the previous - ;; limitation. (let* ((option (org-element-property :search-option link)) (app (org-element-property :application link)) (dedicated-function - (nth 1 (assoc app org-link-protocols)))) + (org-link-get-parameter + (if app (concat type "+" app) type) + :follow))) (if dedicated-function (funcall dedicated-function (concat path @@ -10792,62 +10929,12 @@ link in a property drawer line." ((equal app "emacs") 'emacs) ((equal app "sys") 'system)) (cond ((not option) nil) - ((org-string-match-p "\\`[0-9]+\\'" option) + ((string-match-p "\\`[0-9]+\\'" option) (list (string-to-number option))) (t (list nil (org-link-unescape option))))))))) - ((assoc type org-link-protocols) - (funcall (nth 1 (assoc type org-link-protocols)) path)) - ((equal type "help") - (let ((f-or-v (intern path))) - (cond ((fboundp f-or-v) (describe-function f-or-v)) - ((boundp f-or-v) (describe-variable f-or-v)) - (t (error "Not a known function or variable"))))) - ((member type '("http" "https" "ftp" "mailto" "news")) - (browse-url (org-link-escape-browser (concat type ":" path)))) - ((equal type "doi") - (browse-url - (org-link-escape-browser (concat org-doi-server-url path)))) - ((equal type "message") (browse-url (concat type ":" path))) - ((equal type "shell") - (let ((buf (generate-new-buffer "*Org Shell Output*")) - (cmd path)) - (if (or (and (org-string-nw-p - org-confirm-shell-link-not-regexp) - (string-match - org-confirm-shell-link-not-regexp cmd)) - (not org-confirm-shell-link-function) - (funcall org-confirm-shell-link-function - (format "Execute \"%s\" in shell? " - (org-add-props cmd nil - 'face 'org-warning)))) - (progn - (message "Executing %s" cmd) - (shell-command cmd buf) - (when (featurep 'midnight) - (setq clean-buffer-list-kill-buffer-names - (cons (buffer-name buf) - clean-buffer-list-kill-buffer-names)))) - (user-error "Abort")))) - ((equal type "elisp") - (let ((cmd path)) - (if (or (and (org-string-nw-p - org-confirm-elisp-link-not-regexp) - (org-string-match-p - org-confirm-elisp-link-not-regexp cmd)) - (not org-confirm-elisp-link-function) - (funcall org-confirm-elisp-link-function - (format "Execute \"%s\" as elisp? " - (org-add-props cmd nil - 'face 'org-warning)))) - (message "%s => %s" cmd - (if (eq (string-to-char cmd) ?\() - (eval (read cmd)) - (call-interactively (read cmd)))) - (user-error "Abort")))) - ((equal type "id") - (require 'org-id) - (funcall (nth 1 (assoc "id" org-link-protocols)) path)) + ((functionp (org-link-get-parameter type :follow)) + (funcall (org-link-get-parameter type :follow) path)) ((member type '("coderef" "custom-id" "fuzzy" "radio")) (unless (run-hook-with-args-until-success 'org-open-link-functions path) @@ -10897,57 +10984,54 @@ If NTH is an integer, return the NTH link found. If ZERO is a string, check also this string for a link, and if there is one, return it." (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (let ((cnt ?0) - (in-emacs (if (integerp nth) nil nth)) - have-zero end links link c) - (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) - (push (match-string 0 zero) links) - (setq cnt (1- cnt) have-zero t)) - (save-excursion - (org-back-to-heading t) - (setq end (save-excursion (outline-next-heading) (point))) - (while (re-search-forward org-any-link-re end t) - (push (match-string 0) links)) - (setq links (org-uniquify (reverse links)))) - (cond - ((null links) - (message "No links")) - ((equal (length links) 1) - (setq link (car links))) - ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) - (setq link (nth (if have-zero nth (1- nth)) links))) - (t ; we have to select a link - (save-excursion - (save-window-excursion - (delete-other-windows) - (with-output-to-temp-buffer "*Select Link*" - (mapc (lambda (l) - (if (not (string-match org-bracket-link-regexp l)) - (princ (format "[%c] %s\n" (incf cnt) - (org-remove-angle-brackets l))) - (if (match-end 3) - (princ (format "[%c] %s (%s)\n" (incf cnt) - (match-string 3 l) (match-string 1 l))) - (princ (format "[%c] %s\n" (incf cnt) - (match-string 1 l)))))) - links)) - (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) - (message "Select link to open, RET to open all:") - (setq c (read-char-exclusive)) - (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) - (when (equal c ?q) (user-error "Abort")) - (if (equal c ?\C-m) - (setq link links) - (setq nth (- c ?0)) - (if have-zero (setq nth (1+ nth))) - (unless (and (integerp nth) (>= (length links) nth)) - (user-error "Invalid link selection")) - (setq link (nth (1- nth) links))))) - (cons link end)))))) + (org-with-wide-buffer + (goto-char marker) + (let ((cnt ?0) + have-zero end links link c) + (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) + (push (match-string 0 zero) links) + (setq cnt (1- cnt) have-zero t)) + (save-excursion + (org-back-to-heading t) + (setq end (save-excursion (outline-next-heading) (point))) + (while (re-search-forward org-any-link-re end t) + (push (match-string 0) links)) + (setq links (org-uniquify (reverse links)))) + (cond + ((null links) + (message "No links")) + ((equal (length links) 1) + (setq link (car links))) + ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) + (setq link (nth (if have-zero nth (1- nth)) links))) + (t ; we have to select a link + (save-excursion + (save-window-excursion + (delete-other-windows) + (with-output-to-temp-buffer "*Select Link*" + (dolist (l links) + (cond + ((not (string-match org-bracket-link-regexp l)) + (princ (format "[%c] %s\n" (cl-incf cnt) + (org-unbracket-string "<" ">" l)))) + ((match-end 3) + (princ (format "[%c] %s (%s)\n" (cl-incf cnt) + (match-string 3 l) (match-string 1 l)))) + (t (princ (format "[%c] %s\n" (cl-incf cnt) + (match-string 1 l))))))) + (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) + (message "Select link to open, RET to open all:") + (setq c (read-char-exclusive)) + (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) + (when (equal c ?q) (user-error "Abort")) + (if (equal c ?\C-m) + (setq link links) + (setq nth (- c ?0)) + (when have-zero (setq nth (1+ nth))) + (unless (and (integerp nth) (>= (length links) nth)) + (user-error "Invalid link selection")) + (setq link (nth (1- nth) links))))) + (cons link end))))) ;; TODO: These functions are deprecated since `org-open-at-point' ;; hard-codes behaviour for "file+emacs" and "file+sys" types. @@ -10980,8 +11064,8 @@ which see. A function in this hook may also use `setq' to set the variable `description' to provide a suggestion for the descriptive text to -be used for this link when it gets inserted into an Org-mode -buffer with \\[org-insert-link].") +be used for this link when it gets inserted into an Org buffer +with \\[org-insert-link].") (defvar org-execute-file-search-functions nil "List of functions to execute a file search triggered by a link. @@ -11046,7 +11130,7 @@ visibility around point, thus ignoring `org-show-context-detail' variable. Search is case-insensitive and ignores white spaces. Return type -of matched result, with is either `dedicated' or `fuzzy'." +of matched result, which is either `dedicated' or `fuzzy'." (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s)) (let* ((case-fold-search t) (origin (point)) @@ -11095,10 +11179,7 @@ of matched result, with is either `dedicated' or `fuzzy'." (match-string 1 s))) ;; Fuzzy links. (t - (let* ((starred (eq (string-to-char normalized) ?*)) - (headline-search (and (derived-mode-p 'org-mode) - (or org-link-search-must-match-exact-headline - starred)))) + (let ((starred (eq (string-to-char normalized) ?*))) (cond ;; Look for targets, only if not in a headline search. ((and (not starred) @@ -11151,7 +11232,7 @@ of matched result, with is either `dedicated' or `fuzzy'." sep))) (if starred (substring title 1) title)) sep "?" - (org-re "\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?") + "\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?" "[ \t]*$"))) (goto-char (point-min)) (re-search-forward re nil t))) @@ -11209,7 +11290,7 @@ of matched result, with is either `dedicated' or `fuzzy'." (cond ((not org-display-internal-link-with-indirect-buffer) buffer) - ((string-match "(Clone)$" (buffer-name buffer)) + ((string-suffix-p "(Clone)" (buffer-name buffer)) (message "Buffer is already a clone, not making another one") ;; we also do not modify visibility in this case buffer) @@ -11233,8 +11314,8 @@ to read." (goto-char (point-min)) (when (re-search-forward "match[a-z]+" nil t) (setq beg (match-end 0)) - (if (re-search-forward "^[ \t]*[0-9]+" nil t) - (setq end (1- (match-beginning 0))))) + (when (re-search-forward "^[ \t]*[0-9]+" nil t) + (setq end (1- (match-beginning 0))))) (and beg end (let ((inhibit-read-only t)) (delete-region beg end))) (goto-char (point-min)) (select-window cwin)))) @@ -11242,13 +11323,13 @@ to read." ;;; The mark ring for links jumps (defvar org-mark-ring nil - "Mark ring for positions before jumps in Org-mode.") + "Mark ring for positions before jumps in Org mode.") (defvar org-mark-ring-last-goto nil "Last position in the mark ring used to go back.") ;; Fill and close the ring (setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded -(loop for i from 1 to org-mark-ring-length do - (push (make-marker) org-mark-ring)) +(dotimes (_ org-mark-ring-length) + (push (make-marker) org-mark-ring)) (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring) org-mark-ring) @@ -11262,15 +11343,15 @@ to read." (or buffer (current-buffer))) (message "%s" (substitute-command-keys - "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) + "Position saved to mark ring, go back with \ +`\\[org-mark-ring-goto]'."))) (defun org-mark-ring-goto (&optional n) "Jump to the previous position in the mark ring. With prefix arg N, jump back that many stored positions. When called several times in succession, walk through the entire ring. -Org-mode commands jumping to a different position in the current file, -or to another Org-mode file, automatically push the old position -onto the ring." +Org mode commands jumping to a different position in the current file, +or to another Org file, automatically push the old position onto the ring." (interactive "p") (let (p m) (if (eq last-command this-command) @@ -11278,25 +11359,19 @@ onto the ring." (setq p org-mark-ring)) (setq org-mark-ring-last-goto p) (setq m (car p)) - (org-pop-to-buffer-same-window (marker-buffer m)) + (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) - (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) + (when (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) -(defun org-remove-angle-brackets (s) - (if (equal (substring s 0 1) "<") (setq s (substring s 1))) - (if (equal (substring s -1) ">") (setq s (substring s 0 -1))) - s) (defun org-add-angle-brackets (s) - (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s))) - (if (equal (substring s -1) ">") nil (setq s (concat s ">"))) - s) -(defun org-remove-double-quotes (s) - (if (equal (substring s 0 1) "\"") (setq s (substring s 1))) - (if (equal (substring s -1) "\"") (setq s (substring s 0 -1))) + (unless (equal (substring s 0 1) "<") (setq s (concat "<" s))) + (unless (equal (substring s -1) ">") (setq s (concat s ">"))) s) ;;; Following specific links +(defvar org-agenda-buffer-tmp-name) +(defvar org-agenda-start-on-weekday) (defun org-follow-timestamp-link () "Open an agenda view for the time-stamp date/range at point." (cond @@ -11351,43 +11426,40 @@ If the file does not exist, an error is thrown." buffer-file-name (substitute-in-file-name (expand-file-name path)))) (file-apps (append org-file-apps (org-default-apps))) - (apps (org-remove-if + (apps (cl-remove-if 'org-file-apps-entry-match-against-dlink-p file-apps)) - (apps-dlink (org-remove-if-not + (apps-dlink (cl-remove-if-not 'org-file-apps-entry-match-against-dlink-p file-apps)) (remp (and (assq 'remote apps) (org-file-remote-p file))) - (dirp (if remp nil (file-directory-p file))) + (dirp (unless remp (file-directory-p file))) (file (if (and dirp org-open-directory-means-index-dot-org) (concat (file-name-as-directory file) "index.org") file)) (a-m-a-p (assq 'auto-mode apps)) (dfile (downcase file)) - ;; reconstruct the original file: link from the PATH, LINE and SEARCH args - (link (cond ((and (eq line nil) - (eq search nil)) - file) - (line - (concat file "::" (number-to-string line))) - (search - (concat file "::" search)))) + ;; Reconstruct the original link from the PATH, LINE and + ;; SEARCH args. + (link (cond (line (concat file "::" (number-to-string line))) + (search (concat file "::" search)) + (t file))) (dlink (downcase link)) (old-buffer (current-buffer)) (old-pos (point)) (old-mode major-mode) - ext cmd link-match-data) - (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) - (setq ext (match-string 1 dfile)) - (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) - (setq ext (match-string 1 dfile)))) + (ext + (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile) + (match-string 1 dfile))) + cmd link-match-data) (cond ((member in-emacs '((16) system)) - (setq cmd (cdr (assoc 'system apps)))) + (setq cmd (cdr (assq 'system apps)))) (in-emacs (setq cmd 'emacs)) (t - (setq cmd (or (and remp (cdr (assoc 'remote apps))) - (and dirp (cdr (assoc 'directory apps))) - ; first, try matching against apps-dlink - ; if we get a match here, store the match data for later + (setq cmd (or (and remp (cdr (assq 'remote apps))) + (and dirp (cdr (assq 'directory apps))) + ;; First, try matching against apps-dlink if we + ;; get a match here, store the match data for + ;; later. (let ((match (assoc-default dlink apps-dlink 'string-match))) (if match @@ -11400,9 +11472,9 @@ If the file does not exist, an error is thrown." (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) 'string-match) (cdr (assoc ext apps)) - (cdr (assoc t apps)))))) + (cdr (assq t apps)))))) (when (eq cmd 'system) - (setq cmd (cdr (assoc 'system apps)))) + (setq cmd (cdr (assq 'system apps)))) (when (eq cmd 'default) (setq cmd (cdr (assoc t apps)))) (when (eq cmd 'mailcap) @@ -11413,21 +11485,20 @@ If the file does not exist, an error is thrown." (if (stringp command) (setq cmd command) (setq cmd 'emacs)))) - (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files - (not (file-exists-p file)) - (not org-open-non-existing-files)) - (user-error "No such file: %s" file)) + (when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files + (not (file-exists-p file)) + (not org-open-non-existing-files)) + (user-error "No such file: %s" file)) (cond ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) ;; Remove quotes around the file name - we'll use shell-quote-argument. (while (string-match "['\"]%s['\"]" cmd) (setq cmd (replace-match "%s" t t cmd))) - (while (string-match "%s" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument - (convert-standard-filename file))) - t t cmd))) + (setq cmd (replace-regexp-in-string + "%s" + (shell-quote-argument (convert-standard-filename file)) + cmd + nil t)) ;; Replace "%1", "%2" etc. in command with group matches from regex (save-match-data @@ -11449,19 +11520,33 @@ If the file does not exist, an error is thrown." (eq cmd 'emacs)) (funcall (cdr (assq 'file org-link-frame-setup)) file) (widen) - (if line (progn (org-goto-line line) - (if (derived-mode-p 'org-mode) - (org-reveal))) - (if search (org-link-search search)))) + (cond (line (org-goto-line line) + (when (derived-mode-p 'org-mode) (org-reveal))) + (search (org-link-search search)))) + ((functionp cmd) + (save-match-data + (set-match-data link-match-data) + (condition-case nil + (funcall cmd file link) + ;; FIXME: Remove this check when most default installations + ;; of Emacs have at least Org 9.0. + ((debug wrong-number-of-arguments wrong-type-argument + invalid-function) + (user-error "Please see Org News for version 9.0 about \ +`org-file-apps'--Lisp error: %S" cmd))))) ((consp cmd) - (let ((file (convert-standard-filename file))) - (save-match-data - (set-match-data link-match-data) - (eval cmd)))) + ;; FIXME: Remove this check when most default installations of + ;; Emacs have at least Org 9.0. + ;; Heads-up instead of silently fall back to + ;; `org-link-frame-setup' for an old usage of `org-file-apps' + ;; with sexp instead of a function for `cmd'. + (user-error "Please see Org News for version 9.0 about \ +`org-file-apps'--Error: Deprecated usage of %S" cmd)) (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) - (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode) - (or (not (equal old-buffer (current-buffer))) - (not (equal old-pos (point)))) + (and (derived-mode-p 'org-mode) + (eq old-mode 'org-mode) + (or (not (eq old-buffer (current-buffer))) + (not (eq old-pos (point)))) (org-mark-ring-push old-pos old-buffer)))) (defun org-file-apps-entry-match-against-dlink-p (entry) @@ -11502,16 +11587,15 @@ be opened in Emacs." (append (delq nil (mapcar (lambda (x) - (if (not (stringp (car x))) - nil + (unless (not (stringp (car x))) (if (string-match "\\W" (car x)) x (cons (concat "\\." (car x) "\\'") (cdr x))))) list)) - (if add-auto-mode - (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) + (when add-auto-mode + (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) -(defvar ange-ftp-name-format) ; to silence the XEmacs compiler. +(defvar ange-ftp-name-format) (defun org-file-remote-p (file) "Test whether FILE specifies a location on a remote system. Return non-nil if the location is indeed remote. @@ -11544,8 +11628,8 @@ on the system \"/user@host:\"." ((not (listp org-reverse-note-order)) nil) (t (catch 'exit (dolist (entry org-reverse-note-order) - (if (string-match (car entry) buffer-file-name) - (throw 'exit (cdr entry)))))))) + (when (string-match (car entry) buffer-file-name) + (throw 'exit (cdr entry)))))))) (defvar org-refile-target-table nil "The list of refile targets, created by `org-refile'.") @@ -11570,7 +11654,7 @@ on the system \"/user@host:\"." (defun org-refile-cache-clear () "Clear the refile cache and disable all the markers." - (mapc (lambda (m) (move-marker m nil)) org-refile-markers) + (dolist (m org-refile-markers) (move-marker m nil)) (setq org-refile-markers nil) (setq org-refile-cache nil) (message "Refile cache has been cleared")) @@ -11605,17 +11689,23 @@ on the system \"/user@host:\"." org-refile-cache)))) (and set (org-refile-cache-check-set set) set))))) -(defun org-refile-get-targets (&optional default-buffer excluded-entries) +(defvar org-outline-path-cache nil + "Alist between buffer positions and outline paths. +It value is an alist (POSITION . PATH) where POSITION is the +buffer position at the beginning of an entry and PATH is a list +of strings describing the outline path for that entry, in reverse +order.") + +(defun org-refile-get-targets (&optional default-buffer) "Produce a table with refile targets." (let ((case-fold-search nil) ;; otherwise org confuses "TODO" as a kw and "Todo" as a word (entries (or org-refile-targets '((nil . (:level . 1))))) - targets tgs txt re files desc descre fast-path-p level pos0) + targets tgs files desc descre) (message "Getting targets...") (with-current-buffer (or default-buffer (current-buffer)) (dolist (entry entries) (setq files (car entry) desc (cdr entry)) - (setq fast-path-p nil) (cond ((null files) (setq files (list (current-buffer)))) ((eq files 'org-agenda-files) @@ -11624,7 +11714,7 @@ on the system \"/user@host:\"." (setq files (funcall files))) ((and (symbolp files) (boundp files)) (setq files (symbol-value files)))) - (if (stringp files) (setq files (list files))) + (when (stringp files) (setq files (list files))) (cond ((eq (car desc) :tag) (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) @@ -11639,7 +11729,6 @@ on the system \"/user@host:\"." (cdr desc))) "\\}[ \t]"))) ((eq (car desc) :maxlevel) - (setq fast-path-p t) (setq descre (concat "^\\*\\{1," (number-to-string (if org-odd-levels-only (1- (* 2 (cdr desc))) @@ -11647,58 +11736,51 @@ on the system \"/user@host:\"." "\\}[ \t]"))) (t (error "Bad refiling target description %s" desc))) (dolist (f files) - (with-current-buffer - (if (bufferp f) f (org-get-agenda-file-buffer f)) + (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)) (or (setq tgs (org-refile-cache-get (buffer-file-name) descre)) (progn - (if (bufferp f) (setq f (buffer-file-name - (buffer-base-buffer f)))) + (when (bufferp f) + (setq f (buffer-file-name (buffer-base-buffer f)))) (setq f (and f (expand-file-name f))) - (if (eq org-refile-use-outline-path 'file) - (push (list (file-name-nondirectory f) f nil nil) tgs)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward descre nil t) - (goto-char (setq pos0 (point-at-bol))) - (catch 'next - (when org-refile-target-verify-function - (save-match-data - (or (funcall org-refile-target-verify-function) - (throw 'next t)))) - (when (and (looking-at org-complex-heading-regexp) - (not (member (match-string 4) excluded-entries)) - (match-string 4)) - (setq level (org-reduced-level - (- (match-end 1) (match-beginning 1))) - txt (org-link-display-format (match-string 4)) - txt (replace-regexp-in-string "\\( *[[0-9]+/?[0-9]*%?]\\)+$" "" txt) - re (format org-complex-heading-regexp-format - (regexp-quote (match-string 4)))) - (when org-refile-use-outline-path - (setq txt (mapconcat - 'org-protect-slash - (append - (if (eq org-refile-use-outline-path - 'file) - (list (file-name-nondirectory - (buffer-file-name - (buffer-base-buffer)))) - (if (eq org-refile-use-outline-path - 'full-file-path) - (list (buffer-file-name - (buffer-base-buffer))))) - (org-get-outline-path fast-path-p - level txt) - (list txt)) - "/"))) - (push (list txt f re (org-refile-marker (point))) - tgs))) - (when (= (point) pos0) - ;; verification function has not moved point - (goto-char (point-at-eol)))))))) + (when (eq org-refile-use-outline-path 'file) + (push (list (file-name-nondirectory f) f nil nil) tgs)) + (org-with-wide-buffer + (goto-char (point-min)) + (setq org-outline-path-cache nil) + (while (re-search-forward descre nil t) + (beginning-of-line) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) + (let ((begin (point)) + (heading (match-string-no-properties 4))) + (unless (or (and + org-refile-target-verify-function + (not + (funcall org-refile-target-verify-function))) + (not heading)) + (let ((re (format org-complex-heading-regexp-format + (regexp-quote heading))) + (target + (if (not org-refile-use-outline-path) heading + (mapconcat + #'org-protect-slash + (append + (pcase org-refile-use-outline-path + (`file (list (file-name-nondirectory + (buffer-file-name + (buffer-base-buffer))))) + (`full-file-path + (list (buffer-file-name + (buffer-base-buffer)))) + (_ nil)) + (org-get-outline-path t t)) + "/")))) + (push (list target f re (org-refile-marker (point))) + tgs))) + (when (= (point) begin) + ;; Verification function has not moved point. + (end-of-line))))))) (when org-refile-use-cache (org-refile-cache-put tgs (buffer-file-name) descre)) (setq targets (append tgs targets)))))) @@ -11706,40 +11788,61 @@ on the system \"/user@host:\"." (nreverse targets))) (defun org-protect-slash (s) - (while (string-match "/" s) - (setq s (replace-match "\\" t t s))) - s) - -(defvar org-olpa (make-vector 20 nil)) - -(defun org-get-outline-path (&optional fastp level heading) - "Return the outline path to the current entry, as a list. - -The parameters FASTP, LEVEL, and HEADING are for use by a scanner -routine which makes outline path derivations for an entire file, -avoiding backtracing. Refile target collection makes use of that." - (if fastp - (progn - (if (> level 19) - (error "Outline path failure, more than 19 levels")) - (loop for i from level upto 19 do - (aset org-olpa i nil)) - (prog1 - (delq nil (append org-olpa nil)) - (aset org-olpa level heading))) - (let (rtn case-fold-search) - (save-excursion - (save-restriction - (widen) - (while (org-up-heading-safe) - (when (looking-at org-complex-heading-regexp) - (push (org-trim - (replace-regexp-in-string - ;; Remove statistical/checkboxes cookies - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" - (org-match-string-no-properties 4))) - rtn))) - rtn))))) + (replace-regexp-in-string "/" "\\/" s nil t)) + +(defun org--get-outline-path-1 (&optional use-cache) + "Return outline path to current headline. + +Outline path is a list of strings, in reverse order. When +optional argument USE-CACHE is non-nil, make use of a cache. See +`org-get-outline-path' for details. + +Assume buffer is widened and point is on a headline." + (or (and use-cache (cdr (assq (point) org-outline-path-cache))) + (let ((p (point)) + (heading (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp) + (if (not (match-end 4)) "" + ;; Remove statistics cookies. + (org-trim + (org-link-display-format + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (match-string-no-properties 4)))))))) + (if (org-up-heading-safe) + (let ((path (cons heading (org--get-outline-path-1 use-cache)))) + (when use-cache + (push (cons p path) org-outline-path-cache)) + path) + ;; This is a new root node. Since we assume we are moving + ;; forward, we can drop previous cache so as to limit number + ;; of associations there. + (let ((path (list heading))) + (when use-cache (setq org-outline-path-cache (list (cons p path)))) + path))))) + +(defun org-get-outline-path (&optional with-self use-cache) + "Return the outline path to the current entry. + +An outline path is a list of ancestors for current headline, as +a list of strings. Statistics cookies are removed and links are +replaced with their description, if any, or their path otherwise. + +When optional argument WITH-SELF is non-nil, the path also +includes the current headline. + +When optional argument USE-CACHE is non-nil, cache outline paths +between calls to this function so as to avoid backtracking. This +argument is useful when planning to find more than one outline +path in the same document. In that case, there are two +conditions to satisfy: + - `org-outline-path-cache' is set to nil before starting the + process; + - outline paths are computed by increasing buffer positions." + (org-with-wide-buffer + (and (or (and with-self (org-back-to-heading t)) + (org-up-heading-safe)) + (reverse (org--get-outline-path-1 use-cache))))) (defun org-format-outline-path (path &optional width prefix separator) "Format the outline path PATH for display. @@ -11758,11 +11861,11 @@ the default is \"/\"." prefix (and prefix path separator) (mapconcat (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s)) - (loop for head in path - for n from 0 - collect (org-add-props - head nil 'face - (nth (% n org-n-level-faces) org-level-faces))) + (cl-loop for head in path + for n from 0 + collect (org-add-props + head nil 'face + (nth (% n org-n-level-faces) org-level-faces))) separator)))) (when (> (length fpath) width) (if (< width 7) @@ -11785,10 +11888,10 @@ If JUST-RETURN-STRING is non-nil, return a string, don't display a message." (bfn (buffer-file-name (buffer-base-buffer))) (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) res) - (if current (setq path (append path - (save-excursion - (org-back-to-heading t) - (if (looking-at org-complex-heading-regexp) + (when current (setq path (append path + (save-excursion + (org-back-to-heading t) + (when (looking-at org-complex-heading-regexp) (list (match-string 4))))))) (setq res (org-format-outline-path @@ -11820,6 +11923,7 @@ the *old* location.") (defun org-refile (&optional arg default-buffer rfloc msg) "Move the entry or entries at point to another heading. + The list of target headings is compiled using the information in `org-refile-targets', which see. @@ -11831,10 +11935,12 @@ If there is an active region, all entries in that region will be refiled. However, the region must fulfill the requirement that the first heading sets the top-level of the moved text. -With prefix arg ARG, the command will only visit the target -location and not actually move anything. +With a `\\[universal-argument]' ARG, the command will only visit the target \ +location +and not actually move anything. -With a double prefix arg \\[universal-argument] \\[universal-argument], go to the location where the last +With a prefix `\\[universal-argument] \\[universal-argument]', go to the \ +location where the last refiling operation has put the subtree. With a numeric prefix argument of `2', refile to the running clock. @@ -11849,11 +11955,11 @@ RFLOC can be a refile location obtained in a different way. MSG is a string to replace \"Refile\" in the default prompt with another verb. E.g. `org-copy' sets this parameter to \"Copy\". -See also `org-refile-use-outline-path' and `org-completion-use-ido'. +See also `org-refile-use-outline-path'. If you are using target caching (see `org-refile-use-cache'), you have to clear the target cache in order to find new targets. -This can be done with a 0 prefix (`C-0 C-c C-w') or a triple +This can be done with a `0' prefix (`C-0 C-c C-w') or a triple prefix argument (`C-u C-u C-u C-c C-w')." (interactive "P") (if (member arg '(0 (64))) @@ -11861,13 +11967,11 @@ prefix argument (`C-u C-u C-u C-c C-w')." (let* ((actionmsg (cond (msg msg) ((equal arg 3) "Refile (and keep)") (t "Refile"))) - (cbuf (current-buffer)) (regionp (org-region-active-p)) (region-start (and regionp (region-beginning))) (region-end (and regionp (region-end))) - (filename (buffer-file-name (buffer-base-buffer cbuf))) (org-refile-keep (if (equal arg 3) t org-refile-keep)) - pos it nbuf file re level reversed) + pos it nbuf file level reversed) (setq last-command nil) (when regionp (goto-char region-start) @@ -11892,43 +11996,43 @@ prefix argument (`C-u C-u C-u C-c C-w')." "" (marker-position org-clock-hd-marker))) (setq arg nil))) - (setq it (or rfloc - (let (heading-text) - (save-excursion - (unless (and arg (listp arg)) - (org-back-to-heading t) - (setq heading-text - (replace-regexp-in-string - org-bracket-link-regexp - "\\3" - (nth 4 (org-heading-components))))) - (org-refile-get-location - (cond ((and arg (listp arg)) "Goto") - (regionp (concat actionmsg " region to")) - (t (concat actionmsg " subtree \"" - heading-text "\" to"))) - default-buffer - (and (not (equal '(4) arg)) - org-refile-allow-creating-parent-nodes) - arg)))))) + (setq it + (or rfloc + (let (heading-text) + (save-excursion + (unless (and arg (listp arg)) + (org-back-to-heading t) + (setq heading-text + (replace-regexp-in-string + org-bracket-link-regexp + "\\3" + (or (nth 4 (org-heading-components)) + "")))) + (org-refile-get-location + (cond ((and arg (listp arg)) "Goto") + (regionp (concat actionmsg " region to")) + (t (concat actionmsg " subtree \"" + heading-text "\" to"))) + default-buffer + (and (not (equal '(4) arg)) + org-refile-allow-creating-parent-nodes))))))) (setq file (nth 1 it) - re (nth 2 it) pos (nth 3 it)) - (if (and (not arg) - pos - (equal (buffer-file-name) file) - (if regionp - (and (>= pos region-start) - (<= pos region-end)) - (and (>= pos (point)) - (< pos (save-excursion - (org-end-of-subtree t t)))))) - (error "Cannot refile to position inside the tree or region")) + (when (and (not arg) + pos + (equal (buffer-file-name) file) + (if regionp + (and (>= pos region-start) + (<= pos region-end)) + (and (>= pos (point)) + (< pos (save-excursion + (org-end-of-subtree t t)))))) + (error "Cannot refile to position inside the tree or region")) (setq nbuf (or (find-buffer-visiting file) (find-file-noselect file))) (if (and arg (not (equal arg 3))) (progn - (org-pop-to-buffer-same-window nbuf) + (pop-to-buffer-same-window nbuf) (goto-char pos) (org-show-context 'org-goto)) (if regionp @@ -11939,50 +12043,48 @@ prefix argument (`C-u C-u C-u C-c C-w')." (with-current-buffer (setq nbuf (or (find-buffer-visiting file) (find-file-noselect file))) (setq reversed (org-notes-order-reversed-p)) - (save-excursion - (save-restriction - (widen) - (if pos - (progn - (goto-char pos) - (looking-at org-outline-regexp) - (setq level (org-get-valid-level (funcall outline-level) 1)) - (goto-char - (if reversed - (or (outline-next-heading) (point-max)) - (or (save-excursion (org-get-next-sibling)) - (org-end-of-subtree t t) - (point-max))))) - (setq level 1) - (if (not reversed) - (goto-char (point-max)) - (goto-char (point-min)) - (or (outline-next-heading) (goto-char (point-max))))) - (if (not (bolp)) (newline)) - (org-paste-subtree level nil nil t) - (when org-log-refile - (org-add-log-setup 'refile nil nil 'findpos org-log-refile) - (unless (eq org-log-refile 'note) - (save-excursion (org-add-log-note)))) - (and org-auto-align-tags - (let ((org-loop-over-headlines-in-active-region nil)) - (org-set-tags nil t))) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-refile))) - (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) - ;; If we are refiling for capture, make sure that the - ;; last-capture pointers point here - (when (org-bound-and-true-p org-refile-for-capture) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-capture-marker))) - (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) - (move-marker org-capture-last-stored-marker (point))) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (run-hooks 'org-after-refile-insert-hook)))) + (org-with-wide-buffer + (if pos + (progn + (goto-char pos) + (looking-at org-outline-regexp) + (setq level (org-get-valid-level (funcall outline-level) 1)) + (goto-char + (if reversed + (or (outline-next-heading) (point-max)) + (or (save-excursion (org-get-next-sibling)) + (org-end-of-subtree t t) + (point-max))))) + (setq level 1) + (if (not reversed) + (goto-char (point-max)) + (goto-char (point-min)) + (or (outline-next-heading) (goto-char (point-max))))) + (unless (bolp) (newline)) + (org-paste-subtree level nil nil t) + (when org-log-refile + (org-add-log-setup 'refile nil nil org-log-refile) + (unless (eq org-log-refile 'note) + (save-excursion (org-add-log-note)))) + (and org-auto-align-tags + (let ((org-loop-over-headlines-in-active-region nil)) + (org-set-tags nil t))) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-refile))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) + ;; If we are refiling for capture, make sure that the + ;; last-capture pointers point here + (when (bound-and-true-p org-capture-is-refiling) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-capture-marker))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) + (move-marker org-capture-last-stored-marker (point))) + (when (fboundp 'deactivate-mark) (deactivate-mark)) + (run-hooks 'org-after-refile-insert-hook))) (unless org-refile-keep (if regionp (delete-region (point) (+ (point) (- region-end region-start))) @@ -12011,35 +12113,22 @@ Also check `org-refile-target-table'." (list (replace-regexp-in-string "/$" "" refloc) (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc)))))) -(defun org-refile-get-location (&optional prompt default-buffer new-nodes - no-exclude) +(defun org-refile-get-location (&optional prompt default-buffer new-nodes) "Prompt the user for a refile location, using PROMPT. PROMPT should not be suffixed with a colon and a space, because this function appends the default value from -`org-refile-history' automatically, if that is not empty. -When NO-EXCLUDE is set, do not exclude headlines in the current subtree, -this is used for the GOTO interface." +`org-refile-history' automatically, if that is not empty." (let ((org-refile-targets org-refile-targets) - (org-refile-use-outline-path org-refile-use-outline-path) - excluded-entries) - (when (and (derived-mode-p 'org-mode) - (not org-refile-use-cache) - (not no-exclude)) - (org-map-tree - (lambda() - (setq excluded-entries - (append excluded-entries (list (org-get-heading t t))))))) - (setq org-refile-target-table - (org-refile-get-targets default-buffer excluded-entries))) + (org-refile-use-outline-path org-refile-use-outline-path)) + (setq org-refile-target-table (org-refile-get-targets default-buffer))) (unless org-refile-target-table (user-error "No refile targets")) (let* ((cbuf (current-buffer)) - (partial-completion-mode nil) (cfn (buffer-file-name (buffer-base-buffer cbuf))) (cfunc (if (and org-refile-use-outline-path org-outline-path-complete-in-steps) - 'org-olpath-completing-read - 'org-icompleting-read)) + #'org-olpath-completing-read + #'completing-read)) (extra (if org-refile-use-outline-path "/" "")) (cbnex (concat (buffer-name) extra)) (filename (and cfn (expand-file-name cfn))) @@ -12074,8 +12163,8 @@ this is used for the GOTO interface." (cons (car pa) (if (assoc (car org-refile-history) tbl) org-refile-history (cdr org-refile-history)))) - (if (equal (car org-refile-history) (nth 1 org-refile-history)) - (pop org-refile-history))) + (when (equal (car org-refile-history) (nth 1 org-refile-history)) + (pop org-refile-history))) pa) (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) (progn @@ -12105,13 +12194,11 @@ this is used for the GOTO interface." (or (find-buffer-visiting file) (find-file-noselect file)))) (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (beginning-of-line 1) - (unless (org-looking-at-p re) - (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))) + (org-with-wide-buffer + (goto-char pos) + (beginning-of-line 1) + (unless (looking-at-p re) + (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling")))))))) (defun org-refile-new-child (parent-target child) "Use refile target PARENT-TARGET to add new CHILD below it." @@ -12122,29 +12209,25 @@ this is used for the GOTO interface." level) (with-current-buffer (or (find-buffer-visiting file) (find-file-noselect file)) - (save-excursion - (save-restriction - (widen) - (if pos - (goto-char pos) - (goto-char (point-max)) - (if (not (bolp)) (newline))) - (when (looking-at org-outline-regexp) - (setq level (funcall outline-level)) - (org-end-of-subtree t t)) - (org-back-over-empty-lines) - (insert "\n" (make-string - (if pos (org-get-valid-level level 1) 1) ?*) - " " child "\n") - (beginning-of-line 0) - (list (concat (car parent-target) "/" child) file "" (point))))))) + (org-with-wide-buffer + (if pos + (goto-char pos) + (goto-char (point-max)) + (unless (bolp) (newline))) + (when (looking-at org-outline-regexp) + (setq level (funcall outline-level)) + (org-end-of-subtree t t)) + (org-back-over-empty-lines) + (insert "\n" (make-string + (if pos (org-get-valid-level level 1) 1) ?*) + " " child "\n") + (beginning-of-line 0) + (list (concat (car parent-target) "/" child) file "" (point)))))) (defun org-olpath-completing-read (prompt collection &rest args) "Read an outline path like a file name." - (let ((thetable collection) - (org-completion-use-ido nil) ; does not work with ido. - (org-completion-use-iswitchb nil)) ; or iswitchb - (apply #'org-icompleting-read + (let ((thetable collection)) + (apply #'completing-read prompt (lambda (string predicate &optional flag) (cond @@ -12175,7 +12258,7 @@ If not found, stay at current position and return nil." (setq pos (and (re-search-forward (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t) (match-beginning 0)))) - (if pos (goto-char pos)) + (when pos (goto-char pos)) pos)) (defun org-create-dblock (plist) @@ -12300,15 +12383,14 @@ This function can be used in a hook." ;;;; Completion -(declare-function org-export-backend-name "org-export" (cl-x)) -(declare-function org-export-backend-options "org-export" (cl-x)) +(declare-function org-export-backend-options "ox" (cl-x) t) (defun org-get-export-keywords () "Return a list of all currently understood export keywords. Export keywords include options, block names, attributes and keywords relative to each registered export back-end." (let (keywords) (dolist (backend - (org-bound-and-true-p org-export-registered-backends) + (bound-and-true-p org-export-registered-backends) (delq nil keywords)) ;; Back-end name (for keywords, like #+LATEX:) (push (upcase (symbol-name (org-export-backend-name backend))) keywords) @@ -12330,11 +12412,11 @@ keywords relative to each registered export back-end." ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE") ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM") ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER") - ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX") + ("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT") ("L" "#+LaTeX: ") - ("h" "#+BEGIN_HTML\n?\n#+END_HTML") + ("h" "#+BEGIN_EXPORT html\n?\n#+END_EXPORT") ("H" "#+HTML: ") - ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII") + ("a" "#+BEGIN_EXPORT ascii\n?\n#+END_EXPORT") ("A" "#+ASCII: ") ("i" "#+INDEX: ?") ("I" "#+INCLUDE: %file ?")) @@ -12353,7 +12435,7 @@ variable `org-mtags-prefer-muse-templates'." (list (string :tag "Key") (string :tag "Template"))) - :version "25.1" + :version "25.2" :package-version '(Org . "8.3")) (defun org-try-structure-completion () @@ -12381,18 +12463,18 @@ expands them." (setq ind (buffer-substring (point-at-bol) (point)))) (t (newline)))) (setq start (point)) - (if (string-match "%file" rpl) - (setq rpl (replace-match - (concat - "\"" - (save-match-data - (abbreviate-file-name (read-file-name "Include file: "))) - "\"") - t t rpl))) + (when (string-match "%file" rpl) + (setq rpl (replace-match + (concat + "\"" + (save-match-data + (abbreviate-file-name (read-file-name "Include file: "))) + "\"") + t t rpl))) (setq rpl (mapconcat 'identity (split-string rpl "\n") (concat "\n" ind))) (insert rpl) - (if (re-search-backward "\\?" start t) (delete-char 1)))) + (when (re-search-backward "\\?" start t) (delete-char 1)))) ;;;; TODO, DEADLINE, Comments @@ -12401,7 +12483,8 @@ expands them." (interactive) (save-excursion (org-back-to-heading) - (looking-at org-complex-heading-regexp) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) (goto-char (or (match-end 3) (match-end 2) (match-end 1))) (skip-chars-forward " \t") (unless (memq (char-before) '(?\s ?\t)) (insert " ")) @@ -12451,8 +12534,7 @@ nil or a string to be used for the todo mark." ) (if (eq major-mode 'org-agenda-mode) (apply 'org-agenda-todo-yesterday arg) (let* ((org-use-effective-time t) - (hour (third (decode-time - (org-current-time)))) + (hour (nth 2 (decode-time (org-current-time)))) (org-extend-today-until (1+ hour))) (org-todo arg)))) @@ -12466,44 +12548,49 @@ nil or a string to be used for the todo mark." ) (org-back-to-heading t) (let ((bound1 (point)) (bound0 (save-excursion (outline-next-heading) (point)))) - (when (re-search-forward - (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" - org-deadline-time-regexp "\\)\\|\\(" - org-ts-regexp "\\)") - bound0 t) - (if (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]" bound1 t) - (replace-match "0" t nil nil 1)))))) - + (when (and (re-search-forward + (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" + org-deadline-time-regexp "\\)\\|\\(" + org-ts-regexp "\\)") + bound0 t) + (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]" + bound1 t)) + (replace-match "0" t nil nil 1))))) + +(defvar org-state) ;; dynamically scoped into this function (defun org-todo (&optional arg) "Change the TODO state of an item. + The state of an item is given by a keyword at the start of the heading, like *** TODO Write paper *** DONE Call mom The different keywords are specified in the variable `org-todo-keywords'. -By default the available states are \"TODO\" and \"DONE\". -So for this example: when the item starts with TODO, it is changed to DONE. +By default the available states are \"TODO\" and \"DONE\". So, for this +example: when the item starts with TODO, it is changed to DONE. When it starts with DONE, the DONE is removed. And when neither TODO nor DONE are present, add TODO at the beginning of the heading. -With \\[universal-argument] prefix arg, use completion to determine the new \ +With `\\[universal-argument]' prefix ARG, use completion to determine the new \ state. -With numeric prefix arg, switch to that state. -With a double \\[universal-argument] prefix, switch to the next set of TODO \ +With numeric prefix ARG, switch to that state. +With a `\\[universal-argument] \\[universal-argument]' prefix, switch to the \ +next set of TODO \ keywords (nextset). -With a triple \\[universal-argument] prefix, circumvent any state blocking. +With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ +prefix, circumvent any state blocking. With a numeric prefix arg of 0, inhibit note taking for the change. With a numeric prefix arg of -1, cancel repeater to allow marking as DONE. When called through ELisp, arg is also interpreted in the following way: -`none' -> empty state -\"\"(empty string) -> switch to empty state -`done' -> switch to DONE -`nextset' -> switch to the next set of keywords -`previousset' -> switch to the previous set of keywords -\"WAITING\" -> switch to the specified keyword, but only if it - really is a member of `org-todo-keywords'." +`none' -> empty state +\"\" -> switch to empty state +`done' -> switch to DONE +`nextset' -> switch to the next set of keywords +`previousset' -> switch to the previous set of keywords +\"WAITING\" -> switch to the specified keyword, but only if it + really is a member of `org-todo-keywords'." (interactive "P") (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) @@ -12512,8 +12599,8 @@ When called through ELisp, arg is also interpreted in the following way: (org-map-entries `(org-todo ,arg) org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (if (equal arg '(16)) (setq arg 'nextset)) + cl (when (outline-invisible-p) (org-end-of-subtree nil t)))) + (when (equal arg '(16)) (setq arg 'nextset)) (when (equal arg -1) (org-cancel-repeater) (setq arg nil)) (let ((org-blocker-hook org-blocker-hook) commentp @@ -12530,7 +12617,7 @@ When called through ELisp, arg is also interpreted in the following way: (when (org-in-commented-heading-p t) (org-toggle-comment) (setq commentp t)) - (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) + (when (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)")) (looking-at "\\(?: *\\|[ \t]*$\\)")) (let* ((match-data (match-data)) @@ -12566,16 +12653,15 @@ When called through ELisp, arg is also interpreted in the following way: (or (not org-use-fast-todo-selection) (not org-todo-key-trigger))) ;; Read a state with completion - (org-icompleting-read - "State: " (mapcar 'list org-todo-keywords-1) + (completing-read + "State: " (mapcar #'list org-todo-keywords-1) nil t)) ((eq arg 'right) (if this (if tail (car tail) nil) (car org-todo-keywords-1))) ((eq arg 'left) - (if (equal member org-todo-keywords-1) - nil + (unless (equal member org-todo-keywords-1) (if this (nth (- (length org-todo-keywords-1) (length tail) 2) @@ -12628,7 +12714,7 @@ When called through ELisp, arg is also interpreted in the following way: (org-with-wide-buffer (run-hook-with-args-until-failure 'org-blocker-hook change-plist)))) - (if (org-called-interactively-p 'interactive) + (if (called-interactively-p 'interactive) (user-error "TODO state change from %s to %s blocked (by \"%s\")" this org-state org-block-entry-blocking) ;; fail silently @@ -12664,8 +12750,8 @@ When called through ELisp, arg is also interpreted in the following way: ;; we need to look at recording a time and note (setq dolog (or (nth 1 (assoc org-state org-todo-log-states)) (nth 2 (assoc this org-todo-log-states)))) - (if (and (eq dolog 'note) (eq org-inhibit-logging 'note)) - (setq dolog 'time)) + (when (and (eq dolog 'note) (eq org-inhibit-logging 'note)) + (setq dolog 'time)) (when (or (and (not org-state) (not org-closed-keep-when-no-todo)) (and org-state (member org-state org-not-done-keywords) @@ -12676,19 +12762,19 @@ When called through ELisp, arg is also interpreted in the following way: (when (and now-done-p org-log-done) ;; It is now done, and it was not done before (org-add-planning-info 'closed (org-current-effective-time)) - (if (and (not dolog) (eq 'note org-log-done)) - (org-add-log-setup 'done org-state this 'findpos 'note))) + (when (and (not dolog) (eq 'note org-log-done)) + (org-add-log-setup 'done org-state this 'note))) (when (and org-state dolog) ;; This is a non-nil state, and we need to log it - (org-add-log-setup 'state org-state this 'findpos dolog))) + (org-add-log-setup 'state org-state this dolog))) ;; Fixup tag positioning (org-todo-trigger-tag-changes org-state) (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) (when org-provide-todo-statistics (org-update-parent-todo-statistics)) (run-hooks 'org-after-todo-state-change-hook) - (if (and arg (not (member org-state org-done-keywords))) - (setq head (org-get-todo-sequence-head org-state))) + (when (and arg (not (member org-state org-done-keywords))) + (setq head (org-get-todo-sequence-head org-state))) (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) ;; Do we need to trigger a repeat? (when now-done-p @@ -12699,14 +12785,13 @@ When called through ELisp, arg is also interpreted in the following way: (org-get-heading)))) (org-auto-repeat-maybe org-state)) ;; Fixup cursor location if close to the keyword - (if (and (outline-on-heading-p) - (not (bolp)) - (save-excursion (beginning-of-line 1) - (looking-at org-todo-line-regexp)) - (< (point) (+ 2 (or (match-end 2) (match-end 1))))) - (progn - (goto-char (or (match-end 2) (match-end 1))) - (and (looking-at " ") (just-one-space)))) + (when (and (outline-on-heading-p) + (not (bolp)) + (save-excursion (beginning-of-line 1) + (looking-at org-todo-line-regexp)) + (< (point) (+ 2 (or (match-end 2) (match-end 1))))) + (goto-char (or (match-end 2) (match-end 1))) + (and (looking-at " ") (just-one-space))) (when org-trigger-hook (save-excursion (run-hook-with-args 'org-trigger-hook change-plist))) @@ -12748,10 +12833,10 @@ changes. Such blocking occurs when: (> child-level this-level)) ;; this todo has children, check whether they are all ;; completed - (if (and (not (org-entry-is-done-p)) - (org-entry-is-todo-p)) - (progn (setq org-block-entry-blocking (org-get-heading)) - (throw 'dont-block nil))) + (when (and (not (org-entry-is-done-p)) + (org-entry-is-todo-p)) + (setq org-block-entry-blocking (org-get-heading)) + (throw 'dont-block nil)) (outline-next-heading) (setq child-level (funcall outline-level)))))) ;; Otherwise, if the task's parent has the :ORDERED: property, and @@ -12760,7 +12845,7 @@ changes. Such blocking occurs when: (org-back-to-heading t) (let* ((pos (point)) (parent-pos (and (org-up-heading-safe) (point)))) - (if (not parent-pos) (throw 'dont-block t)) ; no parent + (unless parent-pos (throw 'dont-block t)) ; no parent (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t)) @@ -12769,11 +12854,11 @@ changes. Such blocking occurs when: ;; Search further up the hierarchy, to see if an ancestor is blocked (while t (goto-char parent-pos) - (if (not (looking-at org-not-done-heading-regexp)) - (throw 'dont-block t)) ; do not block, parent is not a TODO + (unless (looking-at org-not-done-heading-regexp) + (throw 'dont-block t)) ; do not block, parent is not a TODO (setq pos (point)) (setq parent-pos (and (org-up-heading-safe) (point))) - (if (not parent-pos) (throw 'dont-block t)) ; no parent + (unless parent-pos (throw 'dont-block t)) ; no parent (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t) @@ -12841,15 +12926,14 @@ changes because there are unchecked boxes in this entry." (outline-next-heading) (setq end (point)) (goto-char beg) - (if (org-list-search-forward - (concat (org-item-beginning-re) - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" - "\\[[- ]\\]") - end t) - (progn - (if (boundp 'org-blocked-by-checkboxes) - (setq org-blocked-by-checkboxes t)) - (throw 'dont-block nil))))) + (when (org-list-search-forward + (concat (org-item-beginning-re) + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" + "\\[[- ]\\]") + end t) + (when (boundp 'org-blocked-by-checkboxes) + (setq org-blocked-by-checkboxes t)) + (throw 'dont-block nil)))) t))) ; do not block (defun org-entry-blocked-p () @@ -12865,7 +12949,9 @@ changes because there are unchecked boxes in this entry." (defun org-update-statistics-cookies (all) "Update the statistics cookie, either from TODO or from checkboxes. -This should be called with the cursor in a line with a statistics cookie." +This should be called with the cursor in a line with a statistics +cookie. When called with a \\[universal-argument] prefix, update +all statistics cookies in the buffer." (interactive "P") (if all (progn @@ -12881,7 +12967,7 @@ This should be called with the cursor in a line with a statistics cookie." (setq l1 (org-outline-level)) (setq end (save-excursion (outline-next-heading) - (if (org-at-heading-p) (setq l2 (org-outline-level))) + (when (org-at-heading-p) (setq l2 (org-outline-level))) (point))) (if (and (save-excursion (re-search-forward @@ -12918,7 +13004,7 @@ statistics everywhere." (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") level ltoggle l1 new ndel (cnt-all 0) (cnt-done 0) is-percent kwd - checkbox-beg ov ovs ove cookie-present) + checkbox-beg cookie-present) (catch 'exit (save-excursion (beginning-of-line 1) @@ -12965,8 +13051,9 @@ statistics everywhere." (and (member kwd org-done-keywords) (member kwd (cadr org-provide-todo-statistics)))))) (setq cnt-all (1+ cnt-all)) - (if (eq org-provide-todo-statistics t) - (and kwd (setq cnt-all (1+ cnt-all))))) + (and (eq org-provide-todo-statistics t) + kwd + (setq cnt-all (1+ cnt-all)))) (when (or (and (member org-provide-todo-statistics '(t all-headlines)) (member kwd org-done-keywords)) (and (listp org-provide-todo-statistics) @@ -12984,15 +13071,10 @@ statistics everywhere." (max 1 cnt-all))) (format "[%d/%d]" cnt-done cnt-all)) ndel (- (match-end 0) checkbox-beg)) - ;; handle overlays when updating cookie from column view - (when (setq ov (car (overlays-at checkbox-beg))) - (setq ovs (overlay-start ov) ove (overlay-end ov)) - (delete-overlay ov)) (goto-char checkbox-beg) (insert new) (delete-region (point) (+ (point) ndel)) - (when org-auto-align-tags (org-fix-tags-on-the-fly)) - (when ov (move-overlay ov ovs ove))) + (when org-auto-align-tags (org-fix-tags-on-the-fly))) (when cookie-present (run-hook-with-args 'org-after-todo-statistics-hook cnt-done (- cnt-all cnt-done)))))) @@ -13028,9 +13110,9 @@ This hook runs even if there is no statistics cookie present, in which case (when (and (stringp state) (> (length state) 0)) (setq changes (append changes (cdr (assoc state l))))) (when (member state org-not-done-keywords) - (setq changes (append changes (cdr (assoc 'todo l))))) + (setq changes (append changes (cdr (assq 'todo l))))) (when (member state org-done-keywords) - (setq changes (append changes (cdr (assoc 'done l))))) + (setq changes (append changes (cdr (assq 'done l))))) (dolist (c changes) (org-toggle-tag (car c) (if (cdr c) 'on 'off))))) @@ -13086,13 +13168,13 @@ Returns the new TODO keyword, or nil if no state change should occur." (set-buffer (get-buffer-create " *Org todo*")) (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) (erase-buffer) - (org-set-local 'org-done-keywords done-keywords) + (setq-local org-done-keywords done-keywords) (setq tbl fulltable cnt 0) (while (setq e (pop tbl)) (cond ((equal e '(:startgroup)) (push '() groups) (setq ingroup t) - (when (not (= cnt 0)) + (unless (= cnt 0) (setq cnt 0) (insert "\n")) (insert "{ ")) @@ -13100,7 +13182,7 @@ Returns the new TODO keyword, or nil if no state change should occur." (setq ingroup nil cnt 0) (insert "}\n")) ((equal e '(:newline)) - (when (not (= cnt 0)) + (unless (= cnt 0) (setq cnt 0) (insert "\n") (setq e (car tbl)) @@ -13109,19 +13191,19 @@ Returns the new TODO keyword, or nil if no state change should occur." (setq tbl (cdr tbl))))) (t (setq tg (car e) c (cdr e)) - (if ingroup (push tg (car groups))) + (when ingroup (push tg (car groups))) (setq tg (org-add-props tg nil 'face (org-get-todo-face tg))) - (if (and (= cnt 0) (not ingroup)) (insert " ")) + (when (and (= cnt 0) (not ingroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 (length tg)) ?\ )) (when (= (setq cnt (1+ cnt)) ncol) (insert "\n") - (if ingroup (insert " ")) + (when ingroup (insert " ")) (setq cnt 0))))) (insert "\n") (goto-char (point-min)) - (if (not expert) (org-fit-window-to-buffer)) + (unless expert (org-fit-window-to-buffer)) (message "[a-z..]:Set [SPC]:clear") (setq c (let ((inhibit-quit t)) (read-char-exclusive))) (cond @@ -13190,11 +13272,12 @@ on INACTIVE-OK." (defvar org-log-note-how nil) (defvar org-log-note-extra) (defun org-auto-repeat-maybe (done-word) - "Check if the current headline contains a repeated deadline/schedule. + "Check if the current headline contains a repeated time-stamp. + If yes, set TODO state back to what it was and change the base date of repeating deadline/scheduled time stamps to new date. + This function is run automatically after each state change to a DONE state." - ;; last-state is dynamically scoped into this function (let* ((repeat (org-get-repeat)) (aa (assoc org-last-state org-todo-kwd-alist)) (interpret (nth 1 aa)) @@ -13202,73 +13285,102 @@ This function is run automatically after each state change to a DONE state." (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year))) (msg "Entry repeats: ") (org-log-done nil) - (org-todo-log-states nil) - re type n what ts time to-state) + (org-todo-log-states nil)) (when (and repeat (not (zerop (string-to-number (substring repeat 1))))) - (if (eq org-log-repeat t) (setq org-log-repeat 'state)) - (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE") - org-todo-repeat-to-state)) - (unless (and to-state (member to-state org-todo-keywords-1)) - (setq to-state (if (eq interpret 'type) org-last-state head))) - (org-todo to-state) + (when (eq org-log-repeat t) (setq org-log-repeat 'state)) + (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective) + org-todo-repeat-to-state))) + (unless (and to-state (member to-state org-todo-keywords-1)) + (setq to-state (if (eq interpret 'type) org-last-state head))) + (org-todo to-state)) (when (or org-log-repeat (org-entry-get nil "CLOCK")) (org-entry-put nil "LAST_REPEAT" (format-time-string (org-time-stamp-format t t)))) (when org-log-repeat (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) (memq 'org-add-log-note post-command-hook)) - ;; OK, we are already setup for some record - (if (eq org-log-repeat 'note) - ;; make sure we take a note, not only a time stamp - (setq org-log-note-how 'note)) - ;; Set up for taking a record - (org-add-log-setup 'state (or done-word (car org-done-keywords)) + ;; We are already setup for some record. + (when (eq org-log-repeat 'note) + ;; Make sure we take a note, not only a time stamp. + (setq org-log-note-how 'note)) + ;; Set up for taking a record. + (org-add-log-setup 'state + (or done-word (car org-done-keywords)) org-last-state - 'findpos org-log-repeat))) + org-log-repeat))) (org-back-to-heading t) (org-add-planning-info nil nil 'closed) - (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" - org-deadline-time-regexp "\\)\\|\\(" - org-ts-regexp "\\)")) - (while (re-search-forward - re (save-excursion (outline-next-heading) (point)) t) - (setq type (if (match-end 1) org-scheduled-string - (if (match-end 3) org-deadline-string "Plain:")) - ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0)))) - (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts) - (setq n (string-to-number (match-string 2 ts)) - what (match-string 3 ts)) - (if (equal what "w") (setq n (* n 7) what "d")) - (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))) - (user-error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n)) - ;; Preparation, see if we need to modify the start date for the change - (when (match-end 1) - (setq time (save-match-data (org-time-string-to-time ts))) - (cond - ((equal (match-string 1 ts) ".") - ;; Shift starting date to today - (org-timestamp-change - (- (org-today) (time-to-days time)) - 'day)) - ((equal (match-string 1 ts) "+") - (let ((nshiftmax 10) (nshift 0)) - (while (or (= nshift 0) - (<= (time-to-days time) - (time-to-days (current-time)))) - (when (= (incf nshift) nshiftmax) - (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift)) - (user-error "Abort"))) - (org-timestamp-change n (cdr (assoc what whata))) - (org-at-timestamp-p t) - (setq ts (match-string 1)) - (setq time (save-match-data (org-time-string-to-time ts))))) - (org-timestamp-change (- n) (cdr (assoc what whata))) - ;; rematch, so that we have everything in place for the real shift - (org-at-timestamp-p t) - (setq ts (match-string 1)) - (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)))) - (save-excursion (org-timestamp-change n (cdr (assoc what whata)) nil t)) - (setq msg (concat msg type " " org-last-changed-timestamp " ")))) + (let ((end (save-excursion (outline-next-heading) (point)))) + (while (re-search-forward org-ts-regexp end t) + (when (save-match-data + (or (org-at-planning-p) + (org-at-property-p) + (eq (org-element-type (save-excursion + (backward-char) + (org-element-context))) + 'timestamp))) + (let ((type (cond ((match-end 1) org-scheduled-string) + ((match-end 3) org-deadline-string) + (t "Plain:"))) + (ts (or (match-string 2) (match-string 4) (match-string 0)))) + (cond + ((not + (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)) + ;; Time-stamps without a repeater are usually skipped. + ;; However, a SCHEDULED time-stamp without one is + ;; removed, as it is considered as no longer relevant. + (when (equal type org-scheduled-string) + (org-remove-timestamp-with-keyword type))) + (t + (let ((n (string-to-number (match-string 2 ts))) + (what (match-string 3 ts))) + (when (equal what "w") (setq n (* n 7) what "d")) + (when (and (equal what "h") + (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" + ts))) + (user-error + "Cannot repeat in Repeat in %d hour(s) because no hour \ +has been set" + n)) + ;; Preparation, see if we need to modify the start + ;; date for the change. + (when (match-end 1) + (let ((time (save-match-data (org-time-string-to-time ts)))) + (cond + ((equal (match-string 1 ts) ".") + ;; Shift starting date to today + (org-timestamp-change + (- (org-today) (time-to-days time)) + 'day)) + ((equal (match-string 1 ts) "+") + (let ((nshiftmax 10) + (nshift 0)) + (while (or (= nshift 0) + (not (time-less-p (current-time) time))) + (when (= (cl-incf nshift) nshiftmax) + (or (y-or-n-p + (format "%d repeater intervals were not \ +enough to shift date past today. Continue? " + nshift)) + (user-error "Abort"))) + (org-timestamp-change n (cdr (assoc what whata))) + (org-at-timestamp-p t) + (setq ts (match-string 1)) + (setq time + (save-match-data + (org-time-string-to-time ts))))) + (org-timestamp-change (- n) (cdr (assoc what whata))) + ;; Rematch, so that we have everything in + ;; place for the real shift. + (org-at-timestamp-p t) + (setq ts (match-string 1)) + (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" + ts))))) + (save-excursion + (org-timestamp-change n (cdr (assoc what whata)) nil t)) + (setq msg + (concat + msg type " " org-last-changed-timestamp " "))))))))) (setq org-log-post-message msg) (message "%s" msg)))) @@ -13276,7 +13388,7 @@ This function is run automatically after each state change to a DONE state." "Make a compact tree which shows all headlines marked with TODO. The tree will show the lines where the regexp matches, and all higher headlines above the match. -With a \\[universal-argument] prefix, prompt for a regexp to match. +With a `\\[universal-argument]' prefix, prompt for a regexp to match. With a numeric prefix N, construct a sparse tree for the Nth element of `org-todo-keywords-1'." (interactive "P") @@ -13284,8 +13396,9 @@ of `org-todo-keywords-1'." (kwd-re (cond ((null arg) org-not-done-regexp) ((equal arg '(4)) - (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): " - (mapcar 'list org-todo-keywords-1)))) + (let ((kwd + (completing-read "Keyword (or KWD1|KWD2|...): " + (mapcar #'list org-todo-keywords-1)))) (concat "\\(" (mapconcat 'identity (org-split-string kwd "|") "\\|") "\\)\\>"))) @@ -13310,9 +13423,9 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (org-map-entries `(org-deadline ',arg ,time) org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + cl (when (outline-invisible-p) (org-end-of-subtree nil t)))) (let* ((old-date (org-entry-get nil "DEADLINE")) - (old-date-time (if old-date (org-time-string-to-time old-date))) + (old-date-time (when old-date (org-time-string-to-time old-date))) (repeater (and old-date (string-match "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" @@ -13321,8 +13434,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (cond ((equal arg '(4)) (when (and old-date org-log-redeadline) - (org-add-log-setup 'deldeadline nil old-date 'findpos - org-log-redeadline)) + (org-add-log-setup 'deldeadline nil old-date org-log-redeadline)) (org-remove-timestamp-with-keyword org-deadline-string) (message "Item no longer has a deadline.")) ((equal arg '(16)) @@ -13350,8 +13462,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." org-log-redeadline (not (equal old-date org-last-inserted-timestamp))) (org-add-log-setup - 'redeadline org-last-inserted-timestamp old-date 'findpos - org-log-redeadline)) + 'redeadline org-last-inserted-timestamp old-date org-log-redeadline)) (when repeater (save-excursion (org-back-to-heading t) @@ -13381,9 +13492,9 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (org-map-entries `(org-schedule ',arg ,time) org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + cl (when (outline-invisible-p) (org-end-of-subtree nil t)))) (let* ((old-date (org-entry-get nil "SCHEDULED")) - (old-date-time (if old-date (org-time-string-to-time old-date))) + (old-date-time (when old-date (org-time-string-to-time old-date))) (repeater (and old-date (string-match "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" @@ -13393,8 +13504,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." ((equal arg '(4)) (progn (when (and old-date org-log-reschedule) - (org-add-log-setup 'delschedule nil old-date 'findpos - org-log-reschedule)) + (org-add-log-setup 'delschedule nil old-date org-log-reschedule)) (org-remove-timestamp-with-keyword org-scheduled-string) (message "Item is no longer scheduled."))) ((equal arg '(16)) @@ -13422,8 +13532,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." org-log-reschedule (not (equal old-date org-last-inserted-timestamp))) (org-add-log-setup - 'reschedule org-last-inserted-timestamp old-date 'findpos - org-log-reschedule)) + 'reschedule org-last-inserted-timestamp old-date org-log-reschedule)) (when repeater (save-excursion (org-back-to-heading t) @@ -13468,10 +13577,10 @@ nil." (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point))) (equal (char-before) ?\ )) (backward-delete-char 1) - (if (string-match "^[ \t]*$" (buffer-substring - (point-at-bol) (point-at-eol))) - (delete-region (point-at-bol) - (min (point-max) (1+ (point-at-eol)))))))))) + (when (string-match "^[ \t]*$" (buffer-substring + (point-at-bol) (point-at-eol))) + (delete-region (point-at-bol) + (min (point-max) (1+ (point-at-eol)))))))))) (defvar org-time-was-given) ; dynamically scoped parameter (defvar org-end-time-was-given) ; dynamically scoped parameter @@ -13482,7 +13591,7 @@ nil." ;; planning info location is fixed in the section. (org-with-wide-buffer (beginning-of-line) - (and (org-looking-at-p org-planning-line-re) + (and (looking-at-p org-planning-line-re) (eq (point) (ignore-errors (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p)) @@ -13530,14 +13639,14 @@ WHAT entry will also be removed." (org-back-to-heading t) (forward-line) (unless (bolp) (insert "\n")) - (cond ((org-looking-at-p org-planning-line-re) + (cond ((looking-at-p org-planning-line-re) ;; Move to current indentation. (skip-chars-forward " \t") ;; Check if we have to remove something. (dolist (type (if what (cons what remove) remove)) (save-excursion (when (re-search-forward - (case type + (cl-case type (closed org-closed-time-regexp) (deadline org-deadline-time-regexp) (scheduled org-scheduled-time-regexp) @@ -13554,7 +13663,7 @@ WHAT entry will also be removed." (line-end-position)))))) ;; If there is nothing more to add and no more keyword ;; is left, remove the line completely. - (if (and (org-looking-at-p "[ \t]*$") (not what)) + (if (and (looking-at-p "[ \t]*$") (not what)) (delete-region (line-beginning-position) (line-beginning-position 2)) ;; If we removed last keyword, do not leave trailing @@ -13568,10 +13677,10 @@ WHAT entry will also be removed." (t (insert-before-markers "\n") (backward-char 1) (when org-adapt-indentation - (org-indent-to-column (1+ (org-outline-level)))))) + (indent-to-column (1+ (org-outline-level)))))) (when what ;; Insert planning keyword. - (insert (case what + (insert (cl-case what (closed org-closed-string) (deadline org-deadline-string) (scheduled org-scheduled-string) @@ -13587,7 +13696,8 @@ WHAT entry will also be removed." (unless (eolp) (insert " ")) ts)))))) -(defvar org-log-note-marker (make-marker)) +(defvar org-log-note-marker (make-marker) + "Marker pointing at the entry where the note is to be inserted.") (defvar org-log-note-purpose nil) (defvar org-log-note-state nil) (defvar org-log-note-previous-state nil) @@ -13596,8 +13706,7 @@ WHAT entry will also be removed." (defvar org-log-note-return-to (make-marker)) (defvar org-log-note-effective-time nil "Remembered current time so that dynamically scoped -`org-extend-today-until' affects tha timestamps in state change -log") +`org-extend-today-until' affects timestamps in state change log") (defvar org-log-post-message nil "Message to be displayed after a log note has been stored. @@ -13607,7 +13716,7 @@ The auto-repeater uses this.") "Add a note to the current entry. This is done in the same way as adding a state change note." (interactive) - (org-add-log-setup 'note nil nil 'findpos nil)) + (org-add-log-setup 'note)) (defun org-log-beginning (&optional create) "Return expected start of log notes in current entry. @@ -13615,13 +13724,13 @@ When optional argument CREATE is non-nil, the function creates a drawer to store notes, if necessary. Returned position ignores narrowing." (org-with-wide-buffer - (org-end-of-meta-data) - (let ((end (if (org-at-heading-p) (point) - (save-excursion (outline-next-heading) (point)))) - (drawer (org-log-into-drawer))) + (let ((drawer (org-log-into-drawer))) (cond (drawer + (org-end-of-meta-data) (let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$")) + (end (if (org-at-heading-p) (point) + (save-excursion (outline-next-heading) (point)))) (case-fold-search t)) (catch 'exit ;; Try to find existing drawer. @@ -13639,38 +13748,29 @@ narrowing." (insert ":" drawer ":\n:END:\n") (org-indent-region beg (point))) (end-of-line -1))))) - (org-log-state-notes-insert-after-drawers - (while (and (looking-at org-drawer-regexp) - (progn (goto-char (match-end 0)) - (re-search-forward org-property-end-re end t))) + (t + (org-end-of-meta-data org-log-state-notes-insert-after-drawers) + (skip-chars-forward " \t\n") + (beginning-of-line) + (unless org-log-states-order-reversed + (org-skip-over-state-notes) + (skip-chars-backward " \t\n") (forward-line))))) (if (bolp) (point) (line-beginning-position 2)))) -(defun org-add-log-setup (&optional purpose state prev-state findpos how extra) +(defun org-add-log-setup (&optional purpose state prev-state how extra) "Set up the post command hook to take a note. If this is about to TODO state change, the new state is expected in STATE. -When FINDPOS is non-nil, find the correct position for the note in -the current entry. If not, assume that it can be inserted at point. HOW is an indicator what kind of note should be created. EXTRA is additional text that will be inserted into the notes buffer." - (org-with-wide-buffer - (when findpos - (goto-char (org-log-beginning t)) - (unless org-log-states-order-reversed - (org-skip-over-state-notes) - (skip-chars-backward " \t\n\r") - (forward-line))) - (move-marker org-log-note-marker (point)) - ;; Preserve position even if a property drawer is inserted in the - ;; process. - (set-marker-insertion-type org-log-note-marker t) - (setq org-log-note-purpose purpose - org-log-note-state state - org-log-note-previous-state prev-state - org-log-note-how how - org-log-note-extra extra - org-log-note-effective-time (org-current-effective-time)) - (add-hook 'post-command-hook 'org-add-log-note 'append))) + (move-marker org-log-note-marker (point)) + (setq org-log-note-purpose purpose + org-log-note-state state + org-log-note-previous-state prev-state + org-log-note-how how + org-log-note-extra extra + org-log-note-effective-time (org-current-effective-time)) + (add-hook 'post-command-hook 'org-add-log-note 'append)) (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." @@ -13691,17 +13791,17 @@ EXTRA is additional text that will be inserted into the notes buffer." ("%T" . ,org-ts-regexp) ("%u" . ".*?") ("%U" . ".*?"))))))) - (while (org-looking-at-p regexp) + (while (looking-at-p regexp) (goto-char (or (org-list-get-next-item (point) struct prevs) (org-list-get-item-end (point) struct))))))) -(defun org-add-log-note (&optional purpose) - "Pop up a window for taking a note, and add this note later at point." +(defun org-add-log-note (&optional _purpose) + "Pop up a window for taking a note, and add this note later." (remove-hook 'post-command-hook 'org-add-log-note) (setq org-log-note-window-configuration (current-window-configuration)) (delete-other-windows) (move-marker org-log-note-return-to (point)) - (org-pop-to-buffer-same-window (marker-buffer org-log-note-marker)) + (pop-to-buffer-same-window (marker-buffer org-log-note-marker)) (goto-char org-log-note-marker) (org-switch-to-buffer-other-window "*Org Note*") (erase-buffer) @@ -13730,100 +13830,99 @@ EXTRA is additional text that will be inserted into the notes buffer." ((eq org-log-note-purpose 'note) "this entry") (t (error "This should not happen"))))) - (if org-log-note-extra (insert org-log-note-extra)) - (org-set-local 'org-finish-function 'org-store-log-note) + (when org-log-note-extra (insert org-log-note-extra)) + (setq-local org-finish-function 'org-store-log-note) (run-hooks 'org-log-buffer-setup-hook))) (defvar org-note-abort nil) ; dynamically scoped (defun org-store-log-note () "Finish taking a log note, and insert it to where it belongs." - (let ((txt (buffer-string))) - (kill-buffer (current-buffer)) - (let ((note (cdr (assq org-log-note-purpose org-log-note-headings))) lines) - (while (string-match "\\`# .*\n[ \t\n]*" txt) - (setq txt (replace-match "" t t txt))) - (if (string-match "\\s-+\\'" txt) - (setq txt (replace-match "" t t txt))) - (setq lines (org-split-string txt "\n")) - (when (and note (string-match "\\S-" note)) - (setq note - (org-replace-escapes - note - (list (cons "%u" (user-login-name)) - (cons "%U" user-full-name) - (cons "%t" (format-time-string - (org-time-stamp-format 'long 'inactive) - org-log-note-effective-time)) - (cons "%T" (format-time-string - (org-time-stamp-format 'long nil) - org-log-note-effective-time)) - (cons "%d" (format-time-string - (org-time-stamp-format nil 'inactive) - org-log-note-effective-time)) - (cons "%D" (format-time-string - (org-time-stamp-format nil nil) - org-log-note-effective-time)) - (cons "%s" (cond - ((not org-log-note-state) "") - ((org-string-match-p org-ts-regexp - org-log-note-state) - (format "\"[%s]\"" - (substring org-log-note-state 1 -1))) - (t (format "\"%s\"" org-log-note-state)))) - (cons "%S" - (cond - ((not org-log-note-previous-state) "") - ((org-string-match-p org-ts-regexp - org-log-note-previous-state) - (format "\"[%s]\"" - (substring - org-log-note-previous-state 1 -1))) - (t (format "\"%s\"" - org-log-note-previous-state))))))) - (when lines (setq note (concat note " \\\\"))) - (push note lines)) - (when (or current-prefix-arg org-note-abort) - (when (org-log-into-drawer) - (org-remove-empty-drawer-at org-log-note-marker)) - (setq lines nil)) - (when lines - (with-current-buffer (marker-buffer org-log-note-marker) - (org-with-wide-buffer - (goto-char org-log-note-marker) - (move-marker org-log-note-marker nil) - ;; Make sure point is at the beginning of an empty line. - (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) - ;; In an existing list, add a new item at the top level. - ;; Otherwise, indent line like a regular one. - (let ((itemp (org-in-item-p))) - (if itemp - (org-indent-line-to - (let ((struct (save-excursion - (goto-char itemp) (org-list-struct)))) - (org-list-get-ind (org-list-get-top-point struct) struct))) - (org-indent-line))) - (insert (org-list-bullet-string "-") (pop lines)) - (let ((ind (org-list-item-body-column (line-beginning-position)))) - (dolist (line lines) - (insert "\n") - (org-indent-line-to ind) - (insert line))) - (message "Note stored") - (org-back-to-heading t) - (org-cycle-hide-drawers 'children)) - ;; Fix `buffer-undo-list' when `org-store-log-note' is called - ;; from within `org-add-log-note' because `buffer-undo-list' - ;; is then modified outside of `org-with-remote-undo'. - (when (eq this-command 'org-agenda-todo) - (setcdr buffer-undo-list (cddr buffer-undo-list))))))) - ;; Don't add undo information when called from `org-agenda-todo' + (let ((txt (prog1 (buffer-string) + (kill-buffer))) + (note (cdr (assq org-log-note-purpose org-log-note-headings))) + lines) + (while (string-match "\\`# .*\n[ \t\n]*" txt) + (setq txt (replace-match "" t t txt))) + (when (string-match "\\s-+\\'" txt) + (setq txt (replace-match "" t t txt))) + (setq lines (org-split-string txt "\n")) + (when (org-string-nw-p note) + (setq note + (org-replace-escapes + note + (list (cons "%u" (user-login-name)) + (cons "%U" user-full-name) + (cons "%t" (format-time-string + (org-time-stamp-format 'long 'inactive) + org-log-note-effective-time)) + (cons "%T" (format-time-string + (org-time-stamp-format 'long nil) + org-log-note-effective-time)) + (cons "%d" (format-time-string + (org-time-stamp-format nil 'inactive) + org-log-note-effective-time)) + (cons "%D" (format-time-string + (org-time-stamp-format nil nil) + org-log-note-effective-time)) + (cons "%s" (cond + ((not org-log-note-state) "") + ((string-match-p org-ts-regexp + org-log-note-state) + (format "\"[%s]\"" + (substring org-log-note-state 1 -1))) + (t (format "\"%s\"" org-log-note-state)))) + (cons "%S" + (cond + ((not org-log-note-previous-state) "") + ((string-match-p org-ts-regexp + org-log-note-previous-state) + (format "\"[%s]\"" + (substring + org-log-note-previous-state 1 -1))) + (t (format "\"%s\"" + org-log-note-previous-state))))))) + (when lines (setq note (concat note " \\\\"))) + (push note lines)) + (when (and lines (not (or current-prefix-arg org-note-abort))) + (with-current-buffer (marker-buffer org-log-note-marker) + (org-with-wide-buffer + ;; Find location for the new note. + (goto-char org-log-note-marker) + (set-marker org-log-note-marker nil) + (goto-char (org-log-beginning t)) + ;; Make sure point is at the beginning of an empty line. + (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) + ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) + ;; In an existing list, add a new item at the top level. + ;; Otherwise, indent line like a regular one. + (let ((itemp (org-in-item-p))) + (if itemp + (indent-line-to + (let ((struct (save-excursion + (goto-char itemp) (org-list-struct)))) + (org-list-get-ind (org-list-get-top-point struct) struct))) + (org-indent-line))) + (insert (org-list-bullet-string "-") (pop lines)) + (let ((ind (org-list-item-body-column (line-beginning-position)))) + (dolist (line lines) + (insert "\n") + (indent-line-to ind) + (insert line))) + (message "Note stored") + (org-back-to-heading t) + (org-cycle-hide-drawers 'children)) + ;; Fix `buffer-undo-list' when `org-store-log-note' is called + ;; from within `org-add-log-note' because `buffer-undo-list' + ;; is then modified outside of `org-with-remote-undo'. + (when (eq this-command 'org-agenda-todo) + (setcdr buffer-undo-list (cddr buffer-undo-list)))))) + ;; Don't add undo information when called from `org-agenda-todo'. (let ((buffer-undo-list (eq this-command 'org-agenda-todo))) (set-window-configuration org-log-note-window-configuration) (with-current-buffer (marker-buffer org-log-note-return-to) (goto-char org-log-note-return-to)) (move-marker org-log-note-return-to nil) - (and org-log-post-message (message "%s" org-log-post-message)))) + (when org-log-post-message (message "%s" org-log-post-message)))) (defun org-remove-empty-drawer-at (pos) "Remove an empty drawer at position POS. @@ -13859,10 +13958,10 @@ D Show deadlines and scheduled items between a date range." (interactive "P") (setq type (or type org-sparse-tree-default-date-type)) (setq org-ts-type type) - (message "Sparse tree: [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty - [d]eadlines [b]efore-date [a]fter-date [D]ates range - [c]ycle through date types: %s" - (case type + (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty + \[d]eadlines [b]efore-date [a]fter-date [D]ates range + \[c]ycle through date types: %s" + (cl-case type (all "all timestamps") (scheduled "only scheduled") (deadline "only deadline") @@ -13871,7 +13970,7 @@ D Show deadlines and scheduled items between a date range." (closed "with a closed time-stamp") (otherwise "scheduled/deadline"))) (let ((answer (read-char-exclusive))) - (case answer + (cl-case answer (?c (org-sparse-tree arg @@ -13885,20 +13984,19 @@ D Show deadlines and scheduled items between a date range." (?T (org-show-todo-tree '(4))) (?m (call-interactively 'org-match-sparse-tree)) ((?p ?P) - (let* ((kwd (org-icompleting-read - "Property: " (mapcar 'list (org-buffer-property-keys)))) - (value (org-icompleting-read - "Value: " (mapcar 'list (org-property-values kwd))))) + (let* ((kwd (completing-read + "Property: " (mapcar #'list (org-buffer-property-keys)))) + (value (completing-read + "Value: " (mapcar #'list (org-property-values kwd))))) (unless (string-match "\\`{.*}\\'" value) (setq value (concat "\"" value "\""))) (org-match-sparse-tree arg (concat kwd "=" value)))) ((?r ?R ?/) (call-interactively 'org-occur)) (otherwise (user-error "No such sparse tree command \"%c\"" answer))))) -(defvar org-occur-highlights nil +(defvar-local org-occur-highlights nil "List of overlays used for occur matches.") -(make-variable-buffer-local 'org-occur-highlights) -(defvar org-occur-parameters nil +(defvar-local org-occur-parameters nil "Parameters of the active org-occur calls. This is a list, each call to org-occur pushes as cons cell, containing the regular expression and the callback, onto the list. @@ -13908,18 +14006,21 @@ will only contain one set of parameters. When the highlights are removed (for example with `C-c C-c', or with the next edit (depending on `org-remove-highlights-with-change'), this variable is emptied as well.") -(make-variable-buffer-local 'org-occur-parameters) (defun org-occur (regexp &optional keep-previous callback) "Make a compact tree which shows all matches of REGEXP. -The tree will show the lines where the regexp matches, and all higher -headlines above the match. It will also show the heading after the match, -to make sure editing the matching entry is easy. -If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous -call to `org-occur' will be kept, to allow stacking of calls to this -command. -If CALLBACK is non-nil, it is a function which is called to confirm -that the match should indeed be shown." + +The tree will show the lines where the regexp matches, and any other context +defined in `org-show-context-detail', which see. + +When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing +done by a previous call to `org-occur' will be kept, to allow stacking of +calls to this command. + +Optional argument CALLBACK can be a function of no argument. In this case, +it is called with point at the end of the match, match data being set +accordingly. Current match is shown only if the return value is non-nil. +The function must neither move point nor alter narrowing." (interactive "sRegexp: \nP") (when (equal regexp "") (user-error "Regexp cannot be empty")) @@ -13929,33 +14030,35 @@ that the match should indeed be shown." (let ((cnt 0)) (save-excursion (goto-char (point-min)) - (if (or (not keep-previous) ; do not want to keep - (not org-occur-highlights)) ; no previous matches - ;; hide everything - (org-overview)) - (while (re-search-forward regexp nil t) - (backward-char) ;; FIXME: Match timestamps at the end of a headline - (when (or (not callback) - (save-match-data (funcall callback))) - (setq cnt (1+ cnt)) - (when org-highlight-sparse-tree-matches - (org-highlight-new-match (match-beginning 0) (match-end 0))) - (org-show-context 'occur-tree)))) + (when (or (not keep-previous) ; do not want to keep + (not org-occur-highlights)) ; no previous matches + ;; hide everything + (org-overview)) + (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart) + (isearch-no-upper-case-p regexp t) + org-occur-case-fold-search))) + (while (re-search-forward regexp nil t) + (when (or (not callback) + (save-match-data (funcall callback))) + (setq cnt (1+ cnt)) + (when org-highlight-sparse-tree-matches + (org-highlight-new-match (match-beginning 0) (match-end 0))) + (org-show-context 'occur-tree))))) (when org-remove-highlights-with-change - (org-add-hook 'before-change-functions 'org-remove-occur-highlights - nil 'local)) + (add-hook 'before-change-functions 'org-remove-occur-highlights + nil 'local)) (unless org-sparse-tree-open-archived-trees (org-hide-archived-subtrees (point-min) (point-max))) (run-hooks 'org-occur-hook) - (if (org-called-interactively-p 'interactive) - (message "%d match(es) for regexp %s" cnt regexp)) + (when (called-interactively-p 'interactive) + (message "%d match(es) for regexp %s" cnt regexp)) cnt)) -(defun org-occur-next-match (&optional n reset) +(defun org-occur-next-match (&optional n _reset) "Function for `next-error-function' to find sparse tree matches. N is the number of matches to move, when negative move backwards. -RESET is entirely ignored - this function always goes back to the -starting point when no match is found." +This function always goes back to the starting point when no +match is found." (let* ((limit (if (< n 0) (point-min) (point-max))) (search-func (if (< n 0) 'previous-single-char-property-change @@ -13992,28 +14095,33 @@ be shown." DETAIL is either nil, `minimal', `local', `ancestors', `lineage', `tree', `canonical' or t. See `org-show-context-detail' for more information." - (unless (org-before-first-heading-p) - ;; Show current heading and possibly its entry, following headline - ;; or all children. - (if (and (org-at-heading-p) (not (eq detail 'local))) - (org-flag-heading nil) - (org-show-entry) + ;; Show current heading and possibly its entry, following headline + ;; or all children. + (if (and (org-at-heading-p) (not (eq detail 'local))) + (org-flag-heading nil) + (org-show-entry) + ;; If point is hidden within a drawer or a block, make sure to + ;; expose it. + (dolist (o (overlays-at (point))) + (when (memq (overlay-get o 'invisible) '(org-hide-block outline)) + (delete-overlay o))) + (unless (org-before-first-heading-p) (org-with-limited-levels - (case detail - ((tree canonical t) (outline-show-children)) + (cl-case detail + ((tree canonical t) (org-show-children)) ((nil minimal ancestors)) (t (save-excursion (outline-next-heading) - (org-flag-heading nil)))))) - ;; Show all siblings. - (when (eq detail 'lineage) (org-show-siblings)) - ;; Show ancestors, possibly with their children. - (when (memq detail '(ancestors lineage tree canonical t)) - (save-excursion - (while (org-up-heading-safe) - (org-flag-heading nil) - (when (memq detail '(canonical t)) (org-show-entry)) - (when (memq detail '(tree canonical t)) (outline-show-children))))))) + (org-flag-heading nil))))))) + ;; Show all siblings. + (when (eq detail 'lineage) (org-show-siblings)) + ;; Show ancestors, possibly with their children. + (when (memq detail '(ancestors lineage tree canonical t)) + (save-excursion + (while (org-up-heading-safe) + (org-flag-heading nil) + (when (memq detail '(canonical t)) (org-show-entry)) + (when (memq detail '(tree canonical t)) (org-show-children)))))) (defvar org-reveal-start-hook nil "Hook run before revealing a location.") @@ -14028,9 +14136,8 @@ With optional argument SIBLINGS, on each level of the hierarchy all siblings are shown. This repairs the tree structure to what it would look like when opened with hierarchical calls to `org-cycle'. -With double optional argument \\[universal-argument] \\[universal-argument], \ -go to the parent and show the -entire tree." +With a \\[universal-argument] \\[universal-argument] prefix, \ +go to the parent and show the entire tree." (interactive "P") (run-hooks 'org-reveal-start-hook) (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical)) @@ -14048,13 +14155,13 @@ entire tree." (overlay-put ov 'org-type 'org-occur) (push ov org-occur-highlights))) -(defun org-remove-occur-highlights (&optional beg end noremove) +(defun org-remove-occur-highlights (&optional _beg _end noremove) "Remove the occur highlights from the buffer. BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) (unless org-inhibit-highlight-removal - (mapc 'delete-overlay org-occur-highlights) + (mapc #'delete-overlay org-occur-highlights) (setq org-occur-highlights nil) (setq org-occur-parameters nil) (unless noremove @@ -14078,7 +14185,7 @@ from the `before-change-functions' in the current buffer." (interactive) (org-priority 'down)) -(defun org-priority (&optional action show) +(defun org-priority (&optional action _show) "Change the priority of an item. ACTION can be `set', `up', `down', or a character." (interactive "P") @@ -14090,23 +14197,23 @@ ACTION can be `set', `up', `down', or a character." (let (current new news have remove) (save-excursion (org-back-to-heading t) - (if (looking-at org-priority-regexp) - (setq current (string-to-char (match-string 2)) - have t)) + (when (looking-at org-priority-regexp) + (setq current (string-to-char (match-string 2)) + have t)) (cond ((eq action 'remove) (setq remove t new ?\ )) ((or (eq action 'set) - (if (featurep 'xemacs) (characterp action) (integerp action))) + (integerp action)) (if (not (eq action 'set)) (setq new action) (message "Priority %c-%c, SPC to remove: " org-highest-priority org-lowest-priority) (save-match-data (setq new (read-char-exclusive)))) - (if (and (= (upcase org-highest-priority) org-highest-priority) - (= (upcase org-lowest-priority) org-lowest-priority)) - (setq new (upcase new))) + (when (and (= (upcase org-highest-priority) org-highest-priority) + (= (upcase org-lowest-priority) org-lowest-priority)) + (setq new (upcase new))) (cond ((equal new ?\ ) (setq remove t)) ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) (user-error "Priority must be between `%c' and `%c'" @@ -14132,16 +14239,16 @@ ACTION can be `set', `up', `down', or a character." org-default-priority (1+ org-default-priority)))))) (t (user-error "Invalid action"))) - (if (or (< (upcase new) org-highest-priority) - (> (upcase new) org-lowest-priority)) - (if (and (memq action '(up down)) - (not have) (not (eq last-command this-command))) - ;; `new' is from default priority - (error - "The default can not be set, see `org-default-priority' why") - ;; normal cycling: `new' is beyond highest/lowest priority - ;; and is wrapped around to the empty priority - (setq remove t))) + (when (or (< (upcase new) org-highest-priority) + (> (upcase new) org-lowest-priority)) + (if (and (memq action '(up down)) + (not have) (not (eq last-command this-command))) + ;; `new' is from default priority + (error + "The default can not be set, see `org-default-priority' why") + ;; normal cycling: `new' is beyond highest/lowest priority + ;; and is wrapped around to the empty priority + (setq remove t))) (setq news (format "%c" new)) (if have (if remove @@ -14195,6 +14302,7 @@ Can be set by the action argument to `org-scan-tags' and `org-map-entries'.") (defvar org-scanner-tags nil "The current tag list while the tags scanner is running.") + (defvar org-trust-scanner-tags nil "Should `org-get-tags-at' use the tags for the scanner. This is for internal dynamical scoping only. @@ -14206,6 +14314,8 @@ obtain a list of properties. Building the tags list for each entry in such a file becomes an N^2 operation - but with this variable set, it scales as N.") +(defvar org--matcher-tags-todo-only nil) + (defun org-scan-tags (action matcher todo-only &optional start-level) "Scan headline tags with inheritance and produce output ACTION. @@ -14214,11 +14324,14 @@ or `agenda' to produce an entry list for an agenda view. It can also be a Lisp form or a function that should be called at each matched headline, in this case the return value is a list of all return values from these calls. -MATCHER is a Lisp form to be evaluated, testing if a given set of tags -qualifies a headline for inclusion. When TODO-ONLY is non-nil, -only lines with a not-done TODO keyword are included in the output. -This should be the same variable that was scoped into -and set by `org-make-tags-matcher' when it constructed MATCHER. +MATCHER is a function accepting three arguments, returning +a non-nil value whenever a given set of tags qualifies a headline +for inclusion. See `org-make-tags-matcher' for more information. +As a special case, it can also be set to t (respectively nil) in +order to match all (respectively none) headline. + +When TODO-ONLY is non-nil, only lines with a not-done TODO +keyword are included in the output. START-LEVEL can be a string with asterisks, reducing the scope to headlines matching this string." @@ -14229,8 +14342,8 @@ headlines matching this string." (concat "\\*\\{" (number-to-string start-level) "\\} ") org-outline-regexp) " *\\(\\<\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - (org-re "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))) + (mapconcat #'regexp-quote org-todo-keywords-1 "\\|") + "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) (props (list 'face 'default 'done-face 'org-agenda-done 'undone-face 'default @@ -14249,7 +14362,7 @@ headlines matching this string." (llast 0) rtn rtn1 level category i txt todo marker entry priority ts-date ts-date-type ts-date-pair) - (when (not (or (member action '(agenda sparse-tree)) (functionp action))) + (unless (or (member action '(agenda sparse-tree)) (functionp action)) (setq action (list 'lambda nil action))) (save-excursion (goto-char (point-min)) @@ -14260,8 +14373,10 @@ headlines matching this string." (re-search-forward re nil t)) (setq org-map-continue-from nil) (catch :skip - (setq todo (if (match-end 1) (org-match-string-no-properties 2)) - tags (if (match-end 4) (org-match-string-no-properties 4))) + (setq todo + ;; TODO: is the 1-2 difference a bug? + (when (match-end 1) (match-string-no-properties 2)) + tags (when (match-end 4) (match-string-no-properties 4))) (goto-char (setq lspos (match-beginning 0))) (setq level (org-reduced-level (org-outline-level)) category (org-get-category)) @@ -14295,18 +14410,20 @@ headlines matching this string." (when (and tags org-use-tag-inheritance (or (not (eq t org-use-tag-inheritance)) org-tags-exclude-from-inheritance)) - ;; selective inheritance, remove uninherited ones + ;; Selective inheritance, remove uninherited ones. (setcdr (car tags-alist) (org-remove-uninherited-tags (cdar tags-alist)))) (when (and ;; eval matcher only when the todo condition is OK (and (or (not todo-only) (member todo org-not-done-keywords)) - (let ((case-fold-search t) (org-trust-scanner-tags t)) - (eval matcher))) + (if (functionp matcher) + (let ((case-fold-search t) (org-trust-scanner-tags t)) + (funcall matcher todo tags-list level)) + matcher)) - ;; Call the skipper, but return t if it does not skip, - ;; so that the `and' form continues evaluating + ;; Call the skipper, but return t if it does not + ;; skip, so that the `and' form continues evaluating. (progn (unless (eq action 'sparse-tree) (org-agenda-skip)) t) @@ -14394,7 +14511,9 @@ If optional argument TODO-ONLY is non-nil, only select lines that are also TODO lines." (interactive "P") (org-agenda-prepare-buffers (list (current-buffer))) - (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) + (let ((org--matcher-tags-todo-only todo-only)) + (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) + org--matcher-tags-todo-only))) (defalias 'org-tags-sparse-tree 'org-match-sparse-tree) @@ -14403,7 +14522,7 @@ also TODO lines." (if (or (eq t org-use-property-inheritance) (and (stringp org-use-property-inheritance) (let ((case-fold-search t)) - (org-string-match-p org-use-property-inheritance property))) + (string-match-p org-use-property-inheritance property))) (and (listp org-use-property-inheritance) (member-ignore-case property org-use-property-inheritance))) ;; Caching is not possible, check it directly. @@ -14421,175 +14540,162 @@ instead of the agenda files." (save-excursion (org-uniquify (delq nil - (apply 'append + (apply #'append (mapcar (lambda (file) (set-buffer (find-file-noselect file)) - (append (org-get-buffer-tags) - (mapcar (lambda (x) (if (stringp (car-safe x)) - (list (car-safe x)) nil)) - org-tag-alist))) - (if (and files (car files)) - files + (mapcar (lambda (x) + (and (stringp (car-safe x)) + (list (car-safe x)))) + (or org-current-tag-alist (org-get-buffer-tags)))) + (if (car-safe files) files (org-agenda-files)))))))) (defun org-make-tags-matcher (match) "Create the TAGS/TODO matcher form for the selection string MATCH. -The variable `todo-only' is scoped dynamically into this function. -It will be set to t if the matcher restricts matching to TODO entries, -otherwise will not be touched. - -Returns a cons of the selection string MATCH and the constructed -lisp form implementing the matcher. The matcher is to be evaluated -at an Org entry, with point on the headline, and returns t if the -entry matches the selection string MATCH. The returned lisp form -references two variables with information about the entry, which -must be bound around the form's evaluation: todo, the TODO keyword -at the entry (or nil of none); and tags-list, the list of all tags -at the entry including inherited ones. Additionally, the category -of the entry (if any) must be specified as the text property -`org-category' on the headline. - -See also `org-scan-tags'. -" - (declare (special todo-only)) - (unless (boundp 'todo-only) - (error "`org-make-tags-matcher' expects todo-only to be scoped in")) +Returns a cons of the selection string MATCH and a function +implementing the matcher. + +The matcher is to be called at an Org entry, with point on the +headline, and returns non-nil if the entry matches the selection +string MATCH. It must be called with three arguments: the TODO +keyword at the entry (or nil if none), the list of all tags at +the entry including inherited ones and the reduced level of the +headline. Additionally, the category of the entry, if any, must +be specified as the text property `org-category' on the headline. + +This function sets the variable `org--matcher-tags-todo-only' to +a non-nil value if the matcher restricts matching to TODO +entries, otherwise it is not touched. + +See also `org-scan-tags'." (unless match ;; Get a new match request, with completion against the global - ;; tags table and the local tags in current buffer + ;; tags table and the local tags in current buffer. (let ((org-last-tags-completion-table (org-uniquify (delq nil (append (org-get-buffer-tags) (org-global-tags-completion-table)))))) - (setq match (org-completing-read-no-i - "Match: " 'org-tags-completion-function nil nil nil - 'org-tags-history)))) + (setq match + (completing-read + "Match: " + 'org-tags-completion-function nil nil nil 'org-tags-history)))) - ;; Parse the string and create a lisp form (let ((match0 match) - (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")) - minus tag mm - tagsmatch todomatch tagsmatcher todomatcher kwd matcher - orterms term orlist re-p str-p level-p level-op time-p - prop-p pn pv po gv rest (start 0) (ss 0)) - ;; Expand group tags + (re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)") + (start 0) + tagsmatch todomatch tagsmatcher todomatcher) + + ;; Expand group tags. (setq match (org-tags-expand match)) ;; Check if there is a TODO part of this match, which would be the - ;; part after a "/". TO make sure that this slash is not part of - ;; a property value to be matched against, we also check that there - ;; is no " after that slash. - ;; First, find the last slash - (while (string-match "/+" match ss) - (setq start (match-beginning 0) ss (match-end 0))) + ;; part after a "/". To make sure that this slash is not part of + ;; a property value to be matched against, we also check that + ;; there is no / after that slash. First, find the last slash. + (let ((s 0)) + (while (string-match "/+" match s) + (setq start (match-beginning 0)) + (setq s (match-end 0)))) (if (and (string-match "/+" match start) - (not (save-match-data (string-match "\"" match start)))) - ;; match contains also a todo-matching request + (not (string-match-p "\"" match start))) + ;; Match contains also a TODO-matching request. (progn - (setq tagsmatch (substring match 0 (match-beginning 0)) - todomatch (substring match (match-end 0))) - (if (string-match "^!" todomatch) - (setq todo-only t todomatch (substring todomatch 1))) - (if (string-match "^\\s-*$" todomatch) - (setq todomatch nil))) - ;; only matching tags - (setq tagsmatch match todomatch nil)) - - ;; Make the tags matcher - (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch))) - (setq tagsmatcher t) - (setq orterms (org-split-string tagsmatch "|") orlist nil) - (while (setq term (pop orterms)) - (while (and (equal (substring term -1) "\\") orterms) - (setq term (concat term "|" (pop orterms)))) ; repair bad split - (while (string-match re term) - (setq rest (substring term (match-end 0)) - minus (and (match-end 1) - (equal (match-string 1 term) "-")) - tag (save-match-data (replace-regexp-in-string - "\\\\-" "-" - (match-string 2 term))) - re-p (equal (string-to-char tag) ?{) - level-p (match-end 4) - prop-p (match-end 5) - mm (cond - (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list)) - (level-p - (setq level-op (org-op-to-function (match-string 3 term))) - `(,level-op level ,(string-to-number - (match-string 4 term)))) - (prop-p - (setq pn (match-string 5 term) - po (match-string 6 term) - pv (match-string 7 term) - re-p (equal (string-to-char pv) ?{) - str-p (equal (string-to-char pv) ?\") - time-p (save-match-data - (string-match "^\"[[<].*[]>]\"$" pv)) - pv (if (or re-p str-p) (substring pv 1 -1) pv)) - (if time-p (setq pv (org-matcher-time pv))) - (setq po (org-op-to-function po (if time-p 'time str-p))) - (cond - ((equal pn "CATEGORY") - (setq gv '(get-text-property (point) 'org-category))) - ((equal pn "TODO") - (setq gv 'todo)) - (t - (setq gv `(org-cached-entry-get nil ,pn)))) - (if re-p - (if (eq po 'org<>) - `(not (string-match ,pv (or ,gv ""))) - `(string-match ,pv (or ,gv ""))) - (if str-p - `(,po (or ,gv "") ,pv) - `(,po (string-to-number (or ,gv "")) - ,(string-to-number pv) )))) - (t `(member ,tag tags-list))) - mm (if minus (list 'not mm) mm) - term rest) - (push mm tagsmatcher)) - (push (if (> (length tagsmatcher) 1) - (cons 'and tagsmatcher) - (car tagsmatcher)) - orlist) - (setq tagsmatcher nil)) - (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist))) - (setq tagsmatcher - (list 'progn '(setq org-cached-props nil) tagsmatcher))) - ;; Make the todo matcher - (if (or (not todomatch) (not (string-match "\\S-" todomatch))) - (setq todomatcher t) - (setq orterms (org-split-string todomatch "|") orlist nil) - (dolist (term orterms) - (while (string-match re term) - (setq minus (and (match-end 1) - (equal (match-string 1 term) "-")) - kwd (match-string 2 term) - re-p (equal (string-to-char kwd) ?{) - term (substring term (match-end 0)) - mm (if re-p - `(string-match ,(substring kwd 1 -1) todo) - (list 'equal 'todo kwd)) - mm (if minus (list 'not mm) mm)) - (push mm todomatcher)) - (push (if (> (length todomatcher) 1) - (cons 'and todomatcher) - (car todomatcher)) - orlist) - (setq todomatcher nil)) - (setq todomatcher (if (> (length orlist) 1) - (cons 'or orlist) (car orlist)))) - - ;; Return the string and lisp forms of the matcher - (setq matcher (if todomatcher - (list 'and tagsmatcher todomatcher) - tagsmatcher)) - (when todo-only - (setq matcher (list 'and '(member todo org-not-done-keywords) - matcher))) - (cons match0 matcher))) + (setq tagsmatch (substring match 0 (match-beginning 0))) + (setq todomatch (substring match (match-end 0))) + (when (string-prefix-p "!" todomatch) + (setq org--matcher-tags-todo-only t) + (setq todomatch (substring todomatch 1))) + (when (string-match "\\`\\s-*\\'" todomatch) + (setq todomatch nil))) + ;; Only matching tags. + (setq tagsmatch match) + (setq todomatch nil)) + + ;; Make the tags matcher. + (when (org-string-nw-p tagsmatch) + (let ((orlist nil) + (orterms (org-split-string tagsmatch "|")) + term) + (while (setq term (pop orterms)) + (while (and (equal (substring term -1) "\\") orterms) + (setq term (concat term "|" (pop orterms)))) ;repair bad split. + (while (string-match re term) + (let* ((rest (substring term (match-end 0))) + (minus (and (match-end 1) + (equal (match-string 1 term) "-"))) + (tag (save-match-data + (replace-regexp-in-string + "\\\\-" "-" (match-string 2 term)))) + (regexp (eq (string-to-char tag) ?{)) + (levelp (match-end 4)) + (propp (match-end 5)) + (mm + (cond + (regexp `(org-match-any-p ,(substring tag 1 -1) tags-list)) + (levelp + `(,(org-op-to-function (match-string 3 term)) + level + ,(string-to-number (match-string 4 term)))) + (propp + (let* ((gv (pcase (upcase (match-string 5 term)) + ("CATEGORY" + '(get-text-property (point) 'org-category)) + ("TODO" 'todo) + (p `(org-cached-entry-get nil ,p)))) + (pv (match-string 7 term)) + (regexp (eq (string-to-char pv) ?{)) + (strp (eq (string-to-char pv) ?\")) + (timep (string-match-p "^\"[[<].*[]>]\"$" pv)) + (po (org-op-to-function (match-string 6 term) + (if timep 'time strp)))) + (setq pv (if (or regexp strp) (substring pv 1 -1) pv)) + (when timep (setq pv (org-matcher-time pv))) + (cond ((and regexp (eq po 'org<>)) + `(not (string-match ,pv (or ,gv "")))) + (regexp `(string-match ,pv (or ,gv ""))) + (strp `(,po (or ,gv "") ,pv)) + (t + `(,po + (string-to-number (or ,gv "")) + ,(string-to-number pv)))))) + (t `(member ,tag tags-list))))) + (push (if minus `(not ,mm) mm) tagsmatcher) + (setq term rest))) + (push `(and ,@tagsmatcher) orlist) + (setq tagsmatcher nil)) + (setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist))))) + + ;; Make the TODO matcher. + (when (org-string-nw-p todomatch) + (let ((orlist nil)) + (dolist (term (org-split-string todomatch "|")) + (while (string-match re term) + (let* ((minus (and (match-end 1) + (equal (match-string 1 term) "-"))) + (kwd (match-string 2 term)) + (regexp (eq (string-to-char kwd) ?{)) + (mm (if regexp `(string-match ,(substring kwd 1 -1) todo) + `(equal todo ,kwd)))) + (push (if minus `(not ,mm) mm) todomatcher)) + (setq term (substring term (match-end 0)))) + (push (if (> (length todomatcher) 1) + (cons 'and todomatcher) + (car todomatcher)) + orlist) + (setq todomatcher nil)) + (setq todomatcher (cons 'or orlist)))) + + ;; Return the string and function of the matcher. If no + ;; tags-specific or todo-specific matcher exists, match + ;; everything. + (let ((matcher (if (and tagsmatcher todomatcher) + `(and ,tagsmatcher ,todomatcher) + (or tagsmatcher todomatcher t)))) + (when org--matcher-tags-todo-only + (setq matcher `(and (member todo org-not-done-keywords) ,matcher))) + (cons match0 `(lambda (todo tags-list level) ,matcher))))) (defun org-tags-expand (match &optional single-as-list downcased tags-already-expanded) "Expand group tags in MATCH. @@ -14639,7 +14745,7 @@ When DOWNCASE is non-nil, expand downcased TAGS." (modify-syntax-entry ?_ "w" stable) ;; Temporarily replace regexp-expressions in the match-expression. (while (string-match "{.+?}" return-match) - (incf count) + (cl-incf count) (push (match-string 0 return-match) regexps-in-match) (setq return-match (replace-match (format "<%d>" count) t nil return-match))) (while (and taggroups-keys @@ -14725,7 +14831,7 @@ When DOWNCASE is non-nil, expand downcased TAGS." (setq return-match (replace-regexp-in-string (format "<%d>" count) (pop regexps-in-match) return-match t t)) - (decf count)) + (cl-decf count)) (if single-as-list (if tags-in-group tags-in-group (list return-match)) return-match)) @@ -14798,7 +14904,7 @@ epoch to the beginning of today (00:00)." (defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param (defvar org-tags-overlay (make-overlay 1 1)) -(org-detach-overlay org-tags-overlay) +(delete-overlay org-tags-overlay) (defun org-get-local-tags-at (&optional pos) "Get a list of tags defined in the current headline." @@ -14832,10 +14938,9 @@ ignore inherited ones." (org-back-to-heading t) (while (not (equal lastpos (point))) (setq lastpos (point)) - (when (looking-at - (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) + (when (looking-at ".+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$") (setq ltags (org-split-string - (org-match-string-no-properties 1) ":")) + (match-string-no-properties 1) ":")) (when parent (setq ltags (mapcar 'org-add-prop-inherited ltags))) (setq tags (append @@ -14844,7 +14949,7 @@ ignore inherited ones." ltags) tags))) (or org-use-tag-inheritance (throw 'done t)) - (if local (throw 'done t)) + (when local (throw 'done t)) (or (org-up-heading-safe) (error nil)) (setq parent t))) (error nil))))) @@ -14866,7 +14971,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (let (res current) (save-excursion (org-back-to-heading t) - (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$") + (if (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$" (point-at-eol) t) (progn (setq current (match-string 1)) @@ -14892,29 +14997,24 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (run-hooks 'org-after-tags-change-hook)) res)) -(defun org-align-tags-here (to-col) - ;; Assumes that this is a headline - "Align tags on the current headline to TO-COL." - (let ((pos (point)) (col (current-column)) ncol tags-l p) - (beginning-of-line 1) - (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) - (< pos (match-beginning 2))) - (progn - (setq tags-l (- (match-end 2) (match-beginning 2))) - (goto-char (match-beginning 1)) - (insert " ") - (delete-region (point) (1+ (match-beginning 2))) - (setq ncol (max (current-column) - (1+ col) - (if (> to-col 0) - to-col - (- (abs to-col) tags-l)))) - (setq p (point)) - (insert (make-string (- ncol (current-column)) ?\ )) - (setq ncol (current-column)) - (when indent-tabs-mode (tabify p (point-at-eol))) - (org-move-to-column (min ncol col))) - (goto-char pos)))) +(defun org--align-tags-here (to-col) + "Align tags on the current headline to TO-COL. +Assume point is on a headline." + (let ((pos (point))) + (beginning-of-line) + (if (or (not (looking-at ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) + (>= pos (match-beginning 2))) + ;; No tags or point within tags: do not align. + (goto-char pos) + (goto-char (match-beginning 1)) + (let ((shift (max (- (if (>= to-col 0) to-col + (- (abs to-col) (string-width (match-string 2)))) + (current-column)) + 1))) + (replace-match (make-string shift ?\s) nil nil nil 1) + ;; Preserve initial position, if possible. In any case, stop + ;; before tags. + (when (< pos (point)) (goto-char pos)))))) (defun org-set-tags-command (&optional arg just-align) "Call the set-tags command for the current entry." @@ -14944,7 +15044,8 @@ If DATA is nil or the empty string, any tags will be removed." (when data (save-excursion (org-back-to-heading t) - (when (looking-at org-complex-heading-regexp) + (when (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) (if (match-end 5) (progn (goto-char (match-beginning 5)) @@ -14955,11 +15056,11 @@ If DATA is nil or the empty string, any tags will be removed." (insert " " data) (org-set-tags nil 'align))) (beginning-of-line 1) - (if (looking-at ".*?\\([ \t]+\\)$") - (delete-region (match-beginning 1) (match-end 1)))))) + (when (looking-at ".*?\\([ \t]+\\)$") + (delete-region (match-beginning 1) (match-end 1)))))) (defun org-align-all-tags () - "Align the tags i all headings." + "Align the tags in all headings." (interactive) (save-excursion (or (ignore-errors (org-back-to-heading t)) @@ -14990,27 +15091,36 @@ When JUST-ALIGN is non-nil, only align tags." (if arg (save-excursion (goto-char (point-min)) - (let ((buffer-invisibility-spec (org-inhibit-invisibility))) - (while (re-search-forward org-outline-regexp-bol nil t) - (org-set-tags nil t) - (end-of-line))) + (while (re-search-forward org-outline-regexp-bol nil t) + (org-set-tags nil t) + (end-of-line)) (message "All tags realigned to column %d" org-tags-column)) (let* ((current (org-get-tags-string)) - (col (current-column)) (tags (if just-align current ;; Get a new set of tags from the user. (save-excursion - (let* ((table + (let* ((seen) + (table (setq org-last-tags-completion-table - (append - org-tag-persistent-alist - (or org-tag-alist (org-get-buffer-tags)) - (and - org-complete-tags-always-offer-all-agenda-tags - (org-global-tags-completion-table - (org-agenda-files)))))) + ;; Uniquify tags in alists, yet preserve + ;; structure (i.e., keywords). + (delq nil + (mapcar + (lambda (pair) + (let ((head (car pair))) + (cond ((symbolp head) pair) + ((member head seen) nil) + (t (push head seen) + pair)))) + (append + (or org-current-tag-alist + (org-get-buffer-tags)) + (and + org-complete-tags-always-offer-all-agenda-tags + (org-global-tags-completion-table + (org-agenda-files)))))))) (current-tags (org-split-string current ":")) (inherited-tags (nreverse (nthcdr (length current-tags) @@ -15037,51 +15147,48 @@ When JUST-ALIGN is non-nil, only align tags." (setq tags (mapconcat #'identity - (sort (org-split-string tags (org-re "[^[:alnum:]_@#%]+")) + (sort (org-split-string tags "[^[:alnum:]_@#%]+") org-tags-sort-function) ":"))) (if (not (org-string-nw-p tags)) (setq tags "") - (unless (string-match ":\\'" tags) (setq tags (concat tags ":"))) - (unless (string-match "\\`:" tags) (setq tags (concat ":" tags)))) + (unless (string-suffix-p ":" tags) (setq tags (concat tags ":"))) + (unless (string-prefix-p ":" tags) (setq tags (concat ":" tags)))) - ;; Insert new tags at the correct column - (beginning-of-line) - (let ((level (if (looking-at org-outline-regexp) - (- (match-end 0) (point) 1) - 1))) - (cond - ((and (equal current "") (equal tags ""))) - ((re-search-forward - (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") - (line-end-position) - t) - (if (equal tags "") (replace-match "" t t) - (goto-char (match-beginning 0)) - (let* ((c0 (current-column)) - ;; Compute offset for the case of org-indent-mode - ;; active. - (di (if (org-bound-and-true-p org-indent-mode) + ;; Insert new tags at the correct column. + (unless (equal current tags) + (save-excursion + (beginning-of-line) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) + ;; Remove current tags, if any. + (when (match-end 5) (replace-match "" nil nil nil 5)) + ;; Insert new tags, if any. Otherwise, remove trailing + ;; white spaces. + (end-of-line) + (if (not (equal tags "")) + (insert " " tags) + (skip-chars-backward " \t") + (delete-region (point) (line-end-position))))) + ;; Align tags, if any. Fix tags column if `org-indent-mode' + ;; is on. + (unless (equal tags "") + (let* ((level (save-excursion + (beginning-of-line) + (skip-chars-forward "\\*"))) + (offset (if (bound-and-true-p org-indent-mode) (* (1- org-indent-indentation-per-level) (1- level)) 0)) - (p0 (if (eq (char-before) ?*) (1+ (point)) (point))) - (tc (+ org-tags-column - (if (> org-tags-column 0) (- di) di))) - (c1 (max (1+ c0) - (if (> tc 0) tc - (- (- tc) (string-width tags))))) - (rpl (concat (make-string (max 0 (- c1 c0)) ?\s) tags))) - (replace-match rpl t t) - (when (and (not (featurep 'xemacs)) indent-tabs-mode) - (tabify p0 (point)))))) - (t (error "Tags alignment failed")))) - (org-move-to-column col)) + (tags-column + (+ org-tags-column + (if (> org-tags-column 0) (- offset) offset)))) + (org--align-tags-here tags-column)))) (unless just-align (run-hooks 'org-after-tags-change-hook)))))) (defun org-change-tag-in-region (beg end tag off) "Add or remove TAG for each entry in the region. -This works in the agenda, and also in an org-mode buffer." +This works in the agenda, and also in an Org buffer." (interactive (list (region-beginning) (region-end) (let ((org-last-tags-completion-table @@ -15090,37 +15197,37 @@ This works in the agenda, and also in an org-mode buffer." (delq nil (append (org-get-buffer-tags) (org-global-tags-completion-table)))) (org-global-tags-completion-table)))) - (org-icompleting-read + (completing-read "Tag: " 'org-tags-completion-function nil nil nil 'org-tags-history)) (progn (message "[s]et or [r]emove? ") (equal (read-char-exclusive) ?r)))) - (if (fboundp 'deactivate-mark) (deactivate-mark)) + (when (fboundp 'deactivate-mark) (deactivate-mark)) (let ((agendap (equal major-mode 'org-agenda-mode)) l1 l2 m buf pos newhead (cnt 0)) (goto-char end) (setq l2 (1- (org-current-line))) (goto-char beg) (setq l1 (org-current-line)) - (loop for l from l1 to l2 do - (org-goto-line l) - (setq m (get-text-property (point) 'org-hd-marker)) - (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p)) - (and agendap m)) - (setq buf (if agendap (marker-buffer m) (current-buffer)) - pos (if agendap m (point))) - (with-current-buffer buf - (save-excursion - (save-restriction - (goto-char pos) - (setq cnt (1+ cnt)) - (org-toggle-tag tag (if off 'off 'on)) - (setq newhead (org-get-heading))))) - (and agendap (org-agenda-change-all-lines newhead m)))) + (cl-loop for l from l1 to l2 do + (org-goto-line l) + (setq m (get-text-property (point) 'org-hd-marker)) + (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p)) + (and agendap m)) + (setq buf (if agendap (marker-buffer m) (current-buffer)) + pos (if agendap m (point))) + (with-current-buffer buf + (save-excursion + (save-restriction + (goto-char pos) + (setq cnt (1+ cnt)) + (org-toggle-tag tag (if off 'off 'on)) + (setq newhead (org-get-heading))))) + (and agendap (org-agenda-change-all-lines newhead m)))) (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) -(defun org-tags-completion-function (string predicate &optional flag) +(defun org-tags-completion-function (string _predicate &optional flag) (let (s1 s2 rtn (ctable org-last-tags-completion-table) (confirm (lambda (x) (stringp (car x))))) (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string) @@ -15131,12 +15238,12 @@ This works in the agenda, and also in an org-mode buffer." ((eq flag nil) ;; try completion (setq rtn (try-completion s2 ctable confirm)) - (if (stringp rtn) - (setq rtn - (concat s1 s2 (substring rtn (length s2)) - (if (and org-add-colon-after-tag-completion - (assoc rtn ctable)) - ":" "")))) + (when (stringp rtn) + (setq rtn + (concat s1 s2 (substring rtn (length s2)) + (if (and org-add-colon-after-tag-completion + (assoc rtn ctable)) + ":" "")))) rtn) ((eq flag t) ;; all-completions @@ -15155,8 +15262,8 @@ Also insert END." (defun org-fast-tag-show-exit (flag) (save-excursion (org-goto-line 3) - (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) - (replace-match "")) + (when (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) + (replace-match "")) (when flag (end-of-line 1) (org-move-to-column (- (window-width) 19) t) @@ -15165,11 +15272,8 @@ Also insert END." (defun org-set-current-tags-overlay (current prefix) "Add an overlay to CURRENT tag with PREFIX." (let ((s (concat ":" (mapconcat 'identity current ":") ":"))) - (if (featurep 'xemacs) - (org-overlay-display org-tags-overlay (concat prefix s) - 'secondary-selection) - (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) - (org-overlay-display org-tags-overlay (concat prefix s))))) + (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) + (org-overlay-display org-tags-overlay (concat prefix s)))) (defvar org-last-tag-selection-key nil) (defun org-fast-tag-selection (current inherited table &optional todo-table) @@ -15199,8 +15303,7 @@ Returns the new tags string, or nil to not change the current settings." groups ingroup intaggroup) (save-excursion (beginning-of-line 1) - (if (looking-at - (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) + (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") (setq ov-start (match-beginning 1) ov-end (match-end 1) ov-prefix "") @@ -15221,7 +15324,7 @@ Returns the new tags string, or nil to not change the current settings." (set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*")) (org-switch-to-buffer-other-window " *Org tags*")) (erase-buffer) - (org-set-local 'org-done-keywords done-keywords) + (setq-local org-done-keywords done-keywords) (org-fast-tag-insert "Inherited" inherited i-face "\n") (org-fast-tag-insert "Current" current c-face "\n\n") (org-fast-tag-show-exit exit-after-next) @@ -15282,7 +15385,7 @@ Returns the new tags string, or nil to not change the current settings." (insert "[" c "] " tg (make-string (- fwidth 4 (length tg)) ?\ )) (push (cons tg c) ntable) - (when (= (incf cnt) ncol) + (when (= (cl-incf cnt) ncol) (insert "\n") (when (or ingroup intaggroup) (insert " ")) (setq cnt 0))))) @@ -15315,14 +15418,14 @@ Returns the new tags string, or nil to not change the current settings." (org-fit-window-to-buffer))) ((or (= c ?\C-g) (and (= c ?q) (not (rassoc c ntable)))) - (org-detach-overlay org-tags-overlay) + (delete-overlay org-tags-overlay) (setq quit-flag t)) ((= c ?\ ) (setq current nil) (when exit-after-next (setq exit-after-next 'now))) ((= c ?\t) (condition-case nil - (setq tg (org-icompleting-read + (setq tg (completing-read "Tag: " (or buffer-tags (with-current-buffer buf @@ -15330,7 +15433,7 @@ Returns the new tags string, or nil to not change the current settings." (org-get-buffer-tags)))))) (quit (setq tg ""))) (when (string-match "\\S-" tg) - (add-to-list 'buffer-tags (list tg)) + (cl-pushnew (list tg) buffer-tags :test #'equal) (if (member tg current) (setq current (delete tg current)) (push tg current))) @@ -15342,9 +15445,9 @@ Returns the new tags string, or nil to not change the current settings." ((setq e (rassoc c ntable) tg (car e)) (if (member tg current) (setq current (delete tg current)) - (loop for g in groups do - (when (member tg g) - (dolist (x g) (setq current (delete x current))))) + (cl-loop for g in groups do + (when (member tg g) + (dolist (x g) (setq current (delete x current))))) (push tg current)) (when exit-after-next (setq exit-after-next 'now)))) @@ -15359,8 +15462,7 @@ Returns the new tags string, or nil to not change the current settings." (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) - (while (re-search-forward - (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) + (while (re-search-forward "\\[.\\] \\([[:alnum:]_@#%]+\\)" nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) @@ -15370,7 +15472,7 @@ Returns the new tags string, or nil to not change the current settings." ((member tg inherited) i-face) (t (get-text-property (match-beginning 1) 'face)))))) (goto-char (point-min))))) - (org-detach-overlay org-tags-overlay) + (delete-overlay org-tags-overlay) (if rtn (mapconcat 'identity current ":") nil)))) @@ -15381,8 +15483,8 @@ Returns the new tags string, or nil to not change the current settings." (user-error "Not on a heading")) (save-excursion (beginning-of-line 1) - (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) - (org-match-string-no-properties 1) + (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + (match-string-no-properties 1) ""))) (defun org-get-tags () @@ -15394,16 +15496,17 @@ Returns the new tags string, or nil to not change the current settings." (org-with-wide-buffer (goto-char (point-min)) (let ((tag-re (concat org-outline-regexp-bol - "\\(?:.*?[ \t]\\)?" - (org-re ":\\([[:alnum:]_@#%:]+\\):[ \t]*$"))) + "\\(?:.*?[ \t]\\)?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) tags) (while (re-search-forward tag-re nil t) - (dolist (tag (org-split-string (org-match-string-no-properties 1) ":")) + (dolist (tag (org-split-string (match-string-no-properties 1) ":")) (push tag tags))) (mapcar #'list (append org-file-tags (org-uniquify tags)))))) ;;;; The mapping API +(defvar org-agenda-skip-comment-trees) +(defvar org-agenda-skip-function) (defun org-map-entries (func &optional match scope &rest skip) "Call FUNC at each headline selected by MATCH in SCOPE. @@ -15473,12 +15576,12 @@ a *different* entry, you cannot use these techniques." (car (org-delete-all '(comment archive) skip))) (org-tags-match-list-sublevels t) (start-level (eq scope 'region-start-level)) - matcher file res + matcher res org-todo-keywords-for-agenda org-done-keywords-for-agenda org-todo-keyword-alist-for-agenda org-tag-alist-for-agenda - todo-only) + org--matcher-tags-todo-only) (cond ((eq match t) (setq matcher t)) @@ -15511,7 +15614,9 @@ a *different* entry, you cannot use these techniques." (progn (org-agenda-prepare-buffers (and buffer-file-name (list buffer-file-name))) - (setq res (org-scan-tags func matcher todo-only start-level))) + (setq res + (org-scan-tags + func matcher org--matcher-tags-todo-only start-level))) ;; Get the right scope (cond ((and scope (listp scope) (symbolp (car scope))) @@ -15528,11 +15633,13 @@ a *different* entry, you cannot use these techniques." (org-agenda-prepare-buffers scope) (dolist (file scope) (with-current-buffer (org-find-base-buffer-visiting file) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (setq res (append res (org-scan-tags func matcher todo-only)))))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (setq res + (append + res + (org-scan-tags + func matcher org--matcher-tags-todo-only))))))))) res))) ;;; Properties API @@ -15559,7 +15666,7 @@ Being in this list makes sure that they are offered for completion.") "Non nil when string PROPERTY is a valid property name." (not (or (equal property "") - (org-string-match-p "\\s-" property)))) + (string-match-p "\\s-" property)))) (defun org--update-property-plist (key val props) "Associate KEY to VAL in alist PROPS. @@ -15586,7 +15693,7 @@ return nil." (org-back-to-heading t)) (t (org-with-limited-levels (org-back-to-heading t)))))) (forward-line) - (when (org-looking-at-p org-planning-line-re) (forward-line)) + (when (looking-at-p org-planning-line-re) (forward-line)) (cond ((looking-at org-property-drawer-re) (forward-line) (cons (point) (progn (goto-char (match-end 0)) @@ -15615,7 +15722,7 @@ See `org-property-re' for match data, if applicable." (unless (org-at-property-p) (user-error "Not at a property")) (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") (let ((c (read-char-exclusive))) - (case c + (cl-case c (?s (call-interactively #'org-set-property)) (?d (call-interactively #'org-delete-property)) (?D (call-interactively #'org-delete-property-globally)) @@ -15636,7 +15743,7 @@ With numerical prefix arg, use the nth allowed value, 0 stands for the When INCREMENT is non-nil, set the property to the next allowed value." (interactive "P") - (if (equal value 0) (setq value 10)) + (when (equal value 0) (setq value 10)) (let* ((completion-ignore-case t) (prop org-effort-property) (cur (org-entry-get nil prop)) @@ -15650,7 +15757,7 @@ When INCREMENT is non-nil, set the property to the next allowed value." (or (car (nth (1- value) allowed)) (car (org-last allowed)))) ((and allowed increment) - (or (caadr (member (list cur) allowed)) + (or (cl-caadr (member (list cur) allowed)) (user-error "Allowed effort values are not set"))) (allowed (message "Select 1-9,0, [RET%s]: %s" @@ -15660,24 +15767,23 @@ When INCREMENT is non-nil, set the property to the next allowed value." (if (equal rpl ?\r) cur (setq rpl (- rpl ?0)) - (if (equal rpl 0) (setq rpl 10)) + (when (equal rpl 0) (setq rpl 10)) (if (and (> rpl 0) (<= rpl (length allowed))) (car (nth (1- rpl) allowed)) (org-completing-read "Effort: " allowed nil)))) (t - (let (org-completion-use-ido org-completion-use-iswitchb) - (org-completing-read - (concat "Effort " (if (and cur (string-match "\\S-" cur)) - (concat "[" cur "]") "") - ": ") - existing nil nil "" nil cur)))))) + (org-completing-read + (concat "Effort" (and cur (string-match "\\S-" cur) + (concat " [" cur "]")) + ": ") + existing nil nil "" nil cur))))) (unless (equal (org-entry-get nil prop) val) (org-entry-put nil prop val)) (org-refresh-property '((effort . identity) (effort-minutes . org-duration-string-to-minutes)) val) - (when (string= heading org-clock-current-task) + (when (equal heading (bound-and-true-p org-clock-current-task)) (setq org-clock-effort (get-text-property (point-at-bol) 'effort)) (org-clock-update-mode-line)) (message "%s is now %s" prop val))) @@ -15714,8 +15820,7 @@ strings." (let ((clocksum (get-text-property (point) :org-clock-minutes))) (when clocksum (push (cons "CLOCKSUM" - (org-columns-number-to-string - (/ (float clocksum) 60.) 'add_times)) + (org-minutes-to-clocksum-string clocksum)) props))) (when specific (throw 'exit props))) (when (or (not specific) (string= specific "CLOCKSUM_T")) @@ -15723,29 +15828,28 @@ strings." :org-clock-minutes-today))) (when clocksumt (push (cons "CLOCKSUM_T" - (org-columns-number-to-string - (/ (float clocksumt) 60.) 'add_times)) + (org-minutes-to-clocksum-string clocksumt)) props))) (when specific (throw 'exit props))) (when (or (not specific) (string= specific "ITEM")) - (when (looking-at org-complex-heading-regexp) - (push (cons "ITEM" - (concat - (org-match-string-no-properties 1) - (let ((title (org-match-string-no-properties 4))) - (when (org-string-nw-p title) - (concat " " (org-remove-tabs title)))))) - props)) + (let ((case-fold-search nil)) + (when (looking-at org-complex-heading-regexp) + (push (cons "ITEM" + (let ((title (match-string-no-properties 4))) + (if (org-string-nw-p title) + (org-remove-tabs title) + ""))) + props))) (when specific (throw 'exit props))) (when (or (not specific) (string= specific "TODO")) (let ((case-fold-search nil)) (when (and (looking-at org-todo-line-regexp) (match-end 2)) - (push (cons "TODO" (org-match-string-no-properties 2)) props))) + (push (cons "TODO" (match-string-no-properties 2)) props))) (when specific (throw 'exit props))) (when (or (not specific) (string= specific "PRIORITY")) (push (cons "PRIORITY" (if (looking-at org-priority-regexp) - (org-match-string-no-properties 2) + (match-string-no-properties 2) (char-to-string org-default-priority))) props) (when specific (throw 'exit props))) @@ -15770,7 +15874,7 @@ strings." (when (or (not specific) (member specific '("CLOSED" "DEADLINE" "SCHEDULED"))) (forward-line) - (when (org-looking-at-p org-planning-line-re) + (when (looking-at-p org-planning-line-re) (end-of-line) (let ((bol (line-beginning-position)) ;; Backward compatibility: time keywords used to @@ -15787,14 +15891,17 @@ strings." (skip-chars-forward " \t") (and (looking-at org-ts-regexp-both) (push (cons (car pair) - (org-match-string-no-properties 0)) + (match-string-no-properties 0)) props))))))) (when specific (throw 'exit props))) (when (or (not specific) (member specific '("TIMESTAMP" "TIMESTAMP_IA"))) (let ((find-ts (lambda (end ts) - (let ((regexp (cond + ;; Fix next time-stamp before END. TS is the + ;; list of time-stamps found so far. + (let ((ts ts) + (regexp (cond ((string= specific "TIMESTAMP") org-ts-regexp) ((string= specific "TIMESTAMP_IA") @@ -15842,7 +15949,7 @@ strings." (forward-line) ;; Then find timestamps in the section, skipping ;; planning line. - (when (org-looking-at-p org-planning-line-re) + (when (looking-at-p org-planning-line-re) (forward-line)) (let ((end (save-excursion (outline-next-heading)))) (setq props (nconc (funcall find-ts end ts) props)))))))) @@ -15864,10 +15971,10 @@ strings." ;; after its extension. We also forbid standard ;; properties to be named as special properties. (while (re-search-forward org-property-re end t) - (let* ((key (upcase (org-match-string-no-properties 2))) - (extendp (org-string-match-p "\\+\\'" key)) + (let* ((key (upcase (match-string-no-properties 2))) + (extendp (string-match-p "\\+\\'" key)) (key-base (if extendp (substring key 0 -1) key)) - (value (org-match-string-no-properties 3))) + (value (match-string-no-properties 3))) (cond ((member-ignore-case key-base org-special-properties)) (extendp @@ -15886,7 +15993,7 @@ strings." (defun org-property--local-values (property literal-nil) "Return value for PROPERTY in current entry. -Value is a list whose care is the base value for PROPERTY and cdr +Value is a list whose car is the base value for PROPERTY and cdr a list of accumulated values. Return nil if neither is found in the entry. Also return nil when PROPERTY is set to \"nil\", unless LITERAL-NIL is non-nil." @@ -15900,12 +16007,12 @@ unless LITERAL-NIL is non-nil." (save-excursion (let ((v (and (re-search-forward (org-re-property property nil t) end t) - (org-match-string-no-properties 3)))) + (match-string-no-properties 3)))) (list (if literal-nil v (org-not-nil v))))))) ;; Find additional values. (let* ((property+ (org-re-property (concat property "+") nil t))) (while (re-search-forward property+ end t) - (push (org-match-string-no-properties 3) value))) + (push (match-string-no-properties 3) value))) ;; Return final values. (and (not (equal value '(nil))) (nreverse value)))))) @@ -16113,7 +16220,7 @@ decreases scheduled or deadline date by one day." (org-set-tags nil 'align)) ((equal property "SCHEDULED") (forward-line) - (if (and (org-looking-at-p org-planning-line-re) + (if (and (looking-at-p org-planning-line-re) (re-search-forward org-scheduled-time-regexp (line-end-position) t)) (cond ((string= value "earlier") (org-timestamp-change -1 'day)) @@ -16125,7 +16232,7 @@ decreases scheduled or deadline date by one day." (org-schedule nil value)))) ((equal property "DEADLINE") (forward-line) - (if (and (org-looking-at-p org-planning-line-re) + (if (and (looking-at-p org-planning-line-re) (re-search-forward org-deadline-time-regexp (line-end-position) t)) (cond ((string= value "earlier") (org-timestamp-change -1 'day)) @@ -16153,7 +16260,8 @@ decreases scheduled or deadline date by one day." (org-indent-line))))) (run-hook-with-args 'org-property-changed-functions property value))) -(defun org-buffer-property-keys (&optional specials defaults columns) +(defun org-buffer-property-keys + (&optional specials defaults columns ignore-malformed) "Get all property keys in the current buffer. When SPECIALS is non-nil, also list the special properties that @@ -16164,7 +16272,10 @@ special meaning internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING and others. When COLUMNS in non-nil, also include property names given in -COLUMN formats in the current buffer." +COLUMN formats in the current buffer. + +When IGNORE-MALFORMED is non-nil, malformed drawer repair will not be +automatically performed, such drawers will be silently ignored." (let ((case-fold-search t) (props (append (and specials org-special-properties) @@ -16176,7 +16287,8 @@ COLUMN formats in the current buffer." (let ((range (org-get-property-block))) (catch 'skip (unless range - (when (and (not (org-before-first-heading-p)) + (when (and (not ignore-malformed) + (not (org-before-first-heading-p)) (y-or-n-p (format "Malformed drawer at %d, repair?" (line-beginning-position)))) (org-get-property-block nil t)) @@ -16201,11 +16313,11 @@ COLUMN formats in the current buffer." (if (< begin (point)) (throw 'skip nil) (goto-char begin)) (while (< (point) end) (let ((p (progn (looking-at org-property-re) - (org-match-string-no-properties 2)))) + (match-string-no-properties 2)))) ;; Only add true property name, not extension symbol. - (add-to-list 'props - (if (not (org-string-match-p "\\+\\'" p)) p - (substring p 0 -1)))) + (push (if (not (string-match-p "\\+\\'" p)) p + (substring p 0 -1)) + props)) (forward-line)))) (outline-next-heading))) (when columns @@ -16217,10 +16329,10 @@ COLUMN formats in the current buffer." (start 0)) (while (string-match "%[0-9]*\\(\\S-+\\)" value start) (setq start (match-end 0)) - (let ((p (org-match-string-no-properties 1 value))) + (let ((p (match-string-no-properties 1 value))) (unless (member-ignore-case p org-special-properties) - (add-to-list 'props p)))))))))) - (sort props (lambda (a b) (string< (upcase a) (upcase b)))))) + (push p props)))))))))) + (sort (delete-dups props) (lambda (a b) (string< (upcase a) (upcase b)))))) (defun org-property-values (key) "List all non-nil values of property KEY in current buffer." @@ -16230,8 +16342,8 @@ COLUMN formats in the current buffer." (re (org-re-property key)) values) (while (re-search-forward re nil t) - (add-to-list 'values (org-entry-get (point) key))) - values))) + (push (org-entry-get (point) key) values)) + (delete-dups values)))) (defun org-insert-property-drawer () "Insert a property drawer into the current entry." @@ -16240,8 +16352,8 @@ COLUMN formats in the current buffer." (org-back-to-heading t) (org-with-limited-levels (org-back-to-heading t))) (forward-line) - (when (org-looking-at-p org-planning-line-re) (forward-line)) - (unless (org-looking-at-p org-property-drawer-re) + (when (looking-at-p org-planning-line-re) (forward-line)) + (unless (looking-at-p org-property-drawer-re) ;; Make sure we start editing a line from current entry, not from ;; next one. It prevents extending text properties or overlays ;; belonging to the latter. @@ -16271,7 +16383,7 @@ Point is left between drawer's boundaries." ;; With C-u, fall back on `org-insert-property-drawer' (arg (org-insert-property-drawer)) ;; Check validity of suggested drawer's name. - ((not (org-string-match-p org-drawer-regexp (format ":%s:" drawer))) + ((not (string-match-p org-drawer-regexp (format ":%s:" drawer))) (user-error "Invalid drawer name")) ;; With an active region, insert a drawer at point. ((not (org-region-active-p)) @@ -16338,10 +16450,9 @@ This is computed according to `org-property-set-functions-alist'." (funcall set-function prompt allowed nil (not (get-text-property 0 'org-unrestricted (caar allowed)))) - (let (org-completion-use-ido org-completion-use-iswitchb) - (funcall set-function prompt - (mapcar 'list (org-property-values property)) - nil nil "" nil cur))))) + (funcall set-function prompt + (mapcar 'list (org-property-values property)) + nil nil "" nil cur)))) (org-trim val))) (defvar org-last-set-property nil) @@ -16350,7 +16461,7 @@ This is computed according to `org-property-set-functions-alist'." "Read a property name." (let ((completion-ignore-case t) (default-prop (or (and (org-at-property-p) - (org-match-string-no-properties 2)) + (match-string-no-properties 2)) org-last-set-property))) (org-completing-read (concat "Property" @@ -16431,7 +16542,7 @@ part of the buffer." (props (if cat props0 (delete `("CATEGORY" . ,(org-get-category)) props0))) (prop (if (< 1 (length props)) - (org-icompleting-read "Property: " props nil t) + (completing-read "Property: " props nil t) (caar props)))) (list prop))) (if (not property) @@ -16444,7 +16555,7 @@ part of the buffer." This function ignores narrowing, if any." (interactive (let* ((completion-ignore-case t) - (prop (org-icompleting-read + (prop (completing-read "Globally remove property: " (mapcar #'list (org-buffer-property-keys))))) (list prop))) @@ -16453,7 +16564,7 @@ This function ignores narrowing, if any." (let ((count 0) (re (org-re-property (concat (regexp-quote property) "\\+?") t t))) (while (re-search-forward re nil t) - (when (org-entry-delete (point) property) (incf count))) + (when (org-entry-delete (point) property) (cl-incf count))) (message "Property \"%s\" removed from %d entries" property count)))) (defvar org-columns-current-fmt-compiled) ; defined in org-colview.el @@ -16465,9 +16576,9 @@ then applies it to the property in the column format's scope." (interactive) (unless (org-at-property-p) (user-error "Not at a property")) - (let ((prop (org-match-string-no-properties 2))) + (let ((prop (match-string-no-properties 2))) (org-columns-get-format-and-top-level) - (unless (nth 3 (assoc prop org-columns-current-fmt-compiled)) + (unless (nth 3 (assoc-string prop org-columns-current-fmt-compiled t)) (user-error "No operator defined for property %s" prop)) (org-columns-compute prop))) @@ -16513,7 +16624,7 @@ completion." (org-add-props (car vals) '(org-unrestricted t))) (if table (mapcar 'list vals) vals))) -(defun org-property-previous-allowed-value (&optional previous) +(defun org-property-previous-allowed-value (&optional _previous) "Switch to the next allowed value for this property." (interactive) (org-property-next-allowed-value t)) @@ -16533,12 +16644,12 @@ completion." nval) (unless allowed (user-error "Allowed values for this property have not been defined")) - (if previous (setq allowed (reverse allowed))) - (if (member value allowed) - (setq nval (car (cdr (member value allowed))))) + (when previous (setq allowed (reverse allowed))) + (when (member value allowed) + (setq nval (car (cdr (member value allowed))))) (setq nval (or nval (car allowed))) - (if (equal nval value) - (user-error "Only one allowed value for this property")) + (when (equal nval value) + (user-error "Only one allowed value for this property")) (org-at-property-p) (replace-match (concat " :" key ": " nval) t t) (org-indent-line) @@ -16573,31 +16684,28 @@ only headings." (level 1) (lmin 1) (lmax 1) - limit re end found pos heading cnt flevel) + end found flevel) (unless buffer (error "File not found :%s" file)) (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (setq limit (point-max)) - (goto-char (point-min)) - (dolist (heading path) - (setq re (format org-complex-heading-regexp-format - (regexp-quote heading))) - (setq cnt 0 pos (point)) - (while (re-search-forward re end t) - (setq level (- (match-end 1) (match-beginning 1))) - (if (and (>= level lmin) (<= level lmax)) - (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) - (when (= cnt 0) (error "Heading not found on level %d: %s" - lmax heading)) - (when (> cnt 1) (error "Heading not unique on level %d: %s" - lmax heading)) - (goto-char found) - (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) - (setq end (save-excursion (org-end-of-subtree t t)))) - (when (org-at-heading-p) - (point-marker))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (dolist (heading path) + (let ((re (format org-complex-heading-regexp-format + (regexp-quote heading))) + (cnt 0)) + (while (re-search-forward re end t) + (setq level (- (match-end 1) (match-beginning 1))) + (when (and (>= level lmin) (<= level lmax)) + (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) + (when (= cnt 0) + (error "Heading not found on level %d: %s" lmax heading)) + (when (> cnt 1) + (error "Heading not unique on level %d: %s" lmax heading)) + (goto-char found) + (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) + (setq end (save-excursion (org-end-of-subtree t t))))) + (when (org-at-heading-p) + (point-marker)))))) (defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) "Find node HEADING in BUFFER. @@ -16607,17 +16715,15 @@ If POS-ONLY is set, return just the position instead of a marker. The heading text must match exact, but it may have a TODO keyword, a priority cookie and tags in the standard locations." (with-current-buffer (or buffer (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let (case-fold-search) - (if (re-search-forward - (format org-complex-heading-regexp-format - (regexp-quote heading)) nil t) - (if pos-only - (match-beginning 0) - (move-marker (make-marker) (match-beginning 0))))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (let (case-fold-search) + (when (re-search-forward + (format org-complex-heading-regexp-format + (regexp-quote heading)) nil t) + (if pos-only + (match-beginning 0) + (move-marker (make-marker) (match-beginning 0)))))))) (defun org-find-exact-heading-in-directory (heading &optional dir) "Find Org node headline HEADING in all .org files in directory DIR. @@ -16738,7 +16844,7 @@ non-nil." (if (not t2) t1 (setq dh (- h2 h1) dm (- m2 m1)) - (if (< dm 0) (setq dm (+ dm 60) dh (1- dh))) + (when (< dm 0) (setq dm (+ dm 60) dh (1- dh))) (concat t1 "+" (number-to-string dh) (and (/= 0 dm) (format ":%02d" dm))))))) @@ -16753,7 +16859,7 @@ So these are more for recording a certain time/date." (defvar org-date-ovl (make-overlay 1 1)) (overlay-put org-date-ovl 'face 'org-date-selected) -(org-detach-overlay org-date-ovl) +(delete-overlay org-date-ovl) (defvar org-ans1) ; dynamically scoped parameter (defvar org-ans2) ; dynamically scoped parameter @@ -16775,9 +16881,9 @@ So these are more for recording a certain time/date." (org-defkey map (kbd ".") (lambda () (interactive) ;; Are we at the beginning of the prompt? - (if (org-looking-back "^[^:]+: " - (let ((inhibit-field-text-motion t)) - (line-beginning-position))) + (if (looking-back "^[^:]+: " + (let ((inhibit-field-text-motion t)) + (line-beginning-position))) (org-eval-in-calendar '(calendar-goto-today)) (insert ".")))) (org-defkey map (kbd "C-.") @@ -16844,7 +16950,8 @@ So these are more for recording a certain time/date." (defvar org-defdecode) (defvar org-with-time) -(defun org-read-date (&optional org-with-time to-time from-string prompt +(defvar calendar-setup) ; Dynamically scoped. +(defun org-read-date (&optional with-time to-time from-string prompt default-time default-input inactive) "Read a date, possibly a time, and make things smooth for the user. The prompt will suggest to enter an ISO date, but you can also enter anything @@ -16888,8 +16995,8 @@ If you don't like the calendar, turn it off with With optional argument TO-TIME, the date will immediately be converted to an internal time. -With an optional argument ORG-WITH-TIME, the prompt will suggest to -also insert a time. Note that when ORG-WITH-TIME is not set, you can +With an optional argument WITH-TIME, the prompt will suggest to +also insert a time. Note that when WITH-TIME is not set, you can still enter a time, and this function will inform the calling routine about this change. The calling routine may then choose to change the format used to insert the time stamp into the buffer to include the time. @@ -16898,83 +17005,90 @@ the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is the time/date that is used for everything that is not specified by the user." (require 'parse-time) - (let* ((org-time-stamp-rounding-minutes - (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes)) + (let* ((org-with-time with-time) + (org-time-stamp-rounding-minutes + (if (equal org-with-time '(16)) + '(0 0) + org-time-stamp-rounding-minutes)) (org-dcst org-display-custom-times) (ct (org-current-time)) (org-def (or org-overriding-default-time default-time ct)) (org-defdecode (decode-time org-def)) - (dummy (progn - (when (< (nth 2 org-defdecode) org-extend-today-until) - (setcar (nthcdr 2 org-defdecode) -1) - (setcar (nthcdr 1 org-defdecode) 59) - (setq org-def (apply 'encode-time org-defdecode) - org-defdecode (decode-time org-def))))) (cur-frame (selected-frame)) - (mouse-autoselect-window nil) ; Don't let the mouse jump - (calendar-frame-setup nil) - (calendar-setup (when (eq calendar-setup 'calendar-only) 'calendar-only)) + (mouse-autoselect-window nil) ; Don't let the mouse jump + (calendar-setup + (and (eq calendar-setup 'calendar-only) 'calendar-only)) (calendar-move-hook nil) (calendar-view-diary-initially-flag nil) (calendar-view-holidays-initially-flag nil) - (timestr (format-time-string - (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def)) - (prompt (concat (if prompt (concat prompt " ") "") - (format "Date+time [%s]: " timestr))) ans (org-ans0 "") org-ans1 org-ans2 final cal-frame) - - (cond - (from-string (setq ans from-string)) - (org-read-date-popup-calendar - (save-excursion - (save-window-excursion - (calendar) - (when (eq calendar-setup 'calendar-only) - (setq cal-frame - (window-frame (get-buffer-window "*Calendar*" 'visible))) - (select-frame cal-frame)) - (org-eval-in-calendar '(setq cursor-type nil) t) - (unwind-protect - (progn - (calendar-forward-day (- (time-to-days org-def) - (calendar-absolute-from-gregorian - (calendar-current-date)))) - (org-eval-in-calendar nil t) - (let* ((old-map (current-local-map)) - (map (copy-keymap calendar-mode-map)) - (minibuffer-local-map - (copy-keymap org-read-date-minibuffer-local-map))) - (org-defkey map (kbd "RET") 'org-calendar-select) - (org-defkey map [mouse-1] 'org-calendar-select-mouse) - (org-defkey map [mouse-2] 'org-calendar-select-mouse) - (unwind-protect - (progn - (use-local-map map) - (setq org-read-date-inactive inactive) - (add-hook 'post-command-hook 'org-read-date-display) - (setq org-ans0 (read-string prompt default-input - 'org-read-date-history nil)) - ;; org-ans0: from prompt - ;; org-ans1: from mouse click - ;; org-ans2: from calendar motion - (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) - (remove-hook 'post-command-hook 'org-read-date-display) - (use-local-map old-map) - (when org-read-date-overlay - (delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))) - (bury-buffer "*Calendar*") - (when cal-frame - (delete-frame cal-frame) - (select-frame-set-input-focus cur-frame)))))) - - (t ; Naked prompt only - (unwind-protect - (setq ans (read-string prompt default-input - 'org-read-date-history timestr)) - (when org-read-date-overlay - (delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))) + ;; Rationalize `org-def' and `org-defdecode', if required. + (when (< (nth 2 org-defdecode) org-extend-today-until) + (setf (nth 2 org-defdecode) -1) + (setf (nth 1 org-defdecode) 59) + (setq org-def (apply #'encode-time org-defdecode)) + (setq org-defdecode (decode-time org-def))) + (let* ((timestr (format-time-string + (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") + org-def)) + (prompt (concat (if prompt (concat prompt " ") "") + (format "Date+time [%s]: " timestr)))) + (cond + (from-string (setq ans from-string)) + (org-read-date-popup-calendar + (save-excursion + (save-window-excursion + (calendar) + (when (eq calendar-setup 'calendar-only) + (setq cal-frame + (window-frame (get-buffer-window "*Calendar*" 'visible))) + (select-frame cal-frame)) + (org-eval-in-calendar '(setq cursor-type nil) t) + (unwind-protect + (progn + (calendar-forward-day (- (time-to-days org-def) + (calendar-absolute-from-gregorian + (calendar-current-date)))) + (org-eval-in-calendar nil t) + (let* ((old-map (current-local-map)) + (map (copy-keymap calendar-mode-map)) + (minibuffer-local-map + (copy-keymap org-read-date-minibuffer-local-map))) + (org-defkey map (kbd "RET") 'org-calendar-select) + (org-defkey map [mouse-1] 'org-calendar-select-mouse) + (org-defkey map [mouse-2] 'org-calendar-select-mouse) + (unwind-protect + (progn + (use-local-map map) + (setq org-read-date-inactive inactive) + (add-hook 'post-command-hook 'org-read-date-display) + (setq org-ans0 + (read-string prompt + default-input + 'org-read-date-history + nil)) + ;; org-ans0: from prompt + ;; org-ans1: from mouse click + ;; org-ans2: from calendar motion + (setq ans + (concat org-ans0 " " (or org-ans1 org-ans2)))) + (remove-hook 'post-command-hook 'org-read-date-display) + (use-local-map old-map) + (when org-read-date-overlay + (delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil))))) + (bury-buffer "*Calendar*") + (when cal-frame + (delete-frame cal-frame) + (select-frame-set-input-focus cur-frame)))))) + + (t ; Naked prompt only + (unwind-protect + (setq ans (read-string prompt default-input + 'org-read-date-history timestr)) + (when org-read-date-overlay + (delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil)))))) (setq final (org-read-date-analyze ans org-def org-defdecode)) @@ -17035,16 +17149,18 @@ user." (make-overlay (1- (point-at-eol)) (point-at-eol))) (org-overlay-display org-read-date-overlay txt 'secondary-selection))))) -(defun org-read-date-analyze (ans org-def org-defdecode) +(defun org-read-date-analyze (ans def defdecode) "Analyze the combined answer of the date prompt." ;; FIXME: cleanup and comment ;; Pass `current-time' result to `decode-time' (instead of calling ;; without arguments) so that only `current-time' has to be ;; overriden in tests. - (let ((nowdecode (decode-time (current-time))) + (let ((org-def def) + (org-defdecode defdecode) + (nowdecode (decode-time (current-time))) delta deltan deltaw deltadef year month day hour minute second wday pm h2 m2 tl wday1 - iso-year iso-weekday iso-week iso-year iso-date futurep kill-year) + iso-year iso-weekday iso-week iso-date futurep kill-year) (setq org-read-date-analyze-futurep nil org-read-date-analyze-forced-year nil) (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) @@ -17060,11 +17176,11 @@ user." ;; info and postpone interpreting it until the rest of the parsing ;; is done. (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) - (setq iso-year (if (match-end 1) - (org-small-year-to-year - (string-to-number (match-string 1 ans)))) - iso-weekday (if (match-end 3) - (string-to-number (match-string 3 ans))) + (setq iso-year (when (match-end 1) + (org-small-year-to-year + (string-to-number (match-string 1 ans)))) + iso-weekday (when (match-end 3) + (string-to-number (match-string 3 ans))) iso-week (string-to-number (match-string 2 ans))) (setq ans (replace-match "" t t ans))) @@ -17077,7 +17193,7 @@ user." (string-to-number (format-time-string "%Y")))) month (string-to-number (match-string 3 ans)) day (string-to-number (match-string 4 ans))) - (if (< year 100) (setq year (+ 2000 year))) + (setq year (org-small-year-to-year year)) (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) t nil ans))) @@ -17101,26 +17217,26 @@ user." (string-to-number (format-time-string "%Y")))) month (string-to-number (match-string 1 ans)) day (string-to-number (match-string 2 ans))) - (if (< year 100) (setq year (+ 2000 year))) + (setq year (org-small-year-to-year year)) (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) t nil ans))) ;; Help matching am/pm times, because `parse-time-string' does not do that. ;; If there is a time with am/pm, and *no* time without it, we convert ;; so that matching will be successful. - (loop for i from 1 to 2 do ; twice, for end time as well - (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) - (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) - (setq hour (string-to-number (match-string 1 ans)) - minute (if (match-end 3) - (string-to-number (match-string 3 ans)) - 0) - pm (equal ?p - (string-to-char (downcase (match-string 4 ans))))) - (if (and (= hour 12) (not pm)) - (setq hour 0) - (if (and pm (< hour 12)) (setq hour (+ 12 hour)))) - (setq ans (replace-match (format "%02d:%02d" hour minute) - t t ans)))) + (cl-loop for i from 1 to 2 do ; twice, for end time as well + (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) + (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) + (setq hour (string-to-number (match-string 1 ans)) + minute (if (match-end 3) + (string-to-number (match-string 3 ans)) + 0) + pm (equal ?p + (string-to-char (downcase (match-string 4 ans))))) + (if (and (= hour 12) (not pm)) + (setq hour 0) + (when (and pm (< hour 12)) (setq hour (+ 12 hour)))) + (setq ans (replace-match (format "%02d:%02d" hour minute) + t t ans)))) ;; Check if a time range is given as a duration (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans) @@ -17129,7 +17245,7 @@ user." minute (string-to-number (match-string 2 ans)) m2 (+ minute (if (match-end 5) (string-to-number (match-string 5 ans))0))) - (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) + (when (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) t t ans))) @@ -17233,17 +17349,17 @@ user." (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) (unless (equal wday wday1) (setq day (+ day (% (- wday wday1 -7) 7)))))) - (if (and (boundp 'org-time-was-given) - (nth 2 tl)) - (setq org-time-was-given t)) - (if (< year 100) (setq year (+ 2000 year))) + (when (and (boundp 'org-time-was-given) + (nth 2 tl)) + (setq org-time-was-given t)) + (when (< year 100) (setq year (+ 2000 year))) ;; Check of the date is representable (if org-read-date-force-compatible-dates (progn - (if (< year 1970) - (setq year 1970 org-read-date-analyze-forced-year t)) - (if (> year 2037) - (setq year 2037 org-read-date-analyze-forced-year t))) + (when (< year 1970) + (setq year 1970 org-read-date-analyze-forced-year t)) + (when (> year 2037) + (setq year 2037 org-read-date-analyze-forced-year t))) (condition-case nil (ignore (encode-time second minute hour day month year)) (error @@ -17283,12 +17399,11 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to (if wday1 (progn (setq delta (mod (+ 7 (- wday1 wday)) 7)) - (if (= delta 0) (setq delta 7)) - (if (= dir ?-) - (progn - (setq delta (- delta 7)) - (if (= delta 0) (setq delta -7)))) - (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) + (when (= delta 0) (setq delta 7)) + (when (= dir ?-) + (setq delta (- delta 7)) + (when (= delta 0) (setq delta -7))) + (when (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) (list delta "d" rel)) (list (* n (if (= dir ?-) -1 1)) what rel))))) @@ -17297,23 +17412,14 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to The internal representation needed by the calendar is (month day year). This is a wrapper to handle the brain-dead convention in calendar that user function argument order change dependent on argument order." - (if (boundp 'calendar-date-style) - (cond - ((eq calendar-date-style 'american) - (list arg1 arg2 arg3)) - ((eq calendar-date-style 'european) - (list arg2 arg1 arg3)) - ((eq calendar-date-style 'iso) - (list arg2 arg3 arg1))) - (org-no-warnings ;; european-calendar-style is obsolete as of version 23.1 - (if (org-bound-and-true-p european-calendar-style) - (list arg2 arg1 arg3) - (list arg1 arg2 arg3))))) + (pcase calendar-date-style + (`american (list arg1 arg2 arg3)) + (`european (list arg2 arg1 arg3)) + (`iso (list arg2 arg3 arg1)))) (defun org-eval-in-calendar (form &optional keepdate) "Eval FORM in the calendar window and return to current window. -When KEEPDATE is non-nil, update `org-ans2' from the cursor date, -otherwise stick to the current value of `org-ans2'." +Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date." (let ((sf (selected-frame)) (sw (selected-window))) (select-window (get-buffer-window "*Calendar*" t)) @@ -17324,7 +17430,7 @@ otherwise stick to the current value of `org-ans2'." (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) (select-window sw) - (org-select-frame-set-input-focus sf))) + (select-frame-set-input-focus sf))) (defun org-calendar-select () "Return to `org-read-date' with the date currently selected. @@ -17334,7 +17440,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer." (let* ((date (calendar-cursor-to-date)) (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) (setq org-ans1 (format-time-string "%Y-%m-%d" time))) - (if (active-minibuffer-window) (exit-minibuffer)))) + (when (active-minibuffer-window) (exit-minibuffer)))) (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) "Insert a date stamp for the date given by the internal TIME. @@ -17347,7 +17453,7 @@ stamp. The command returns the inserted time stamp." (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) stamp) - (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) + (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) (insert-before-markers (or pre "")) (when (listp extra) (setq extra (car extra)) @@ -17370,14 +17476,12 @@ The command returns the inserted time stamp." (unless org-display-custom-times (let ((p (point-min)) (bmp (buffer-modified-p))) (while (setq p (next-single-property-change p 'display)) - (if (and (get-text-property p 'display) - (eq (get-text-property p 'face) 'org-date)) - (remove-text-properties - p (setq p (next-single-property-change p 'display)) - '(display t)))) + (when (and (get-text-property p 'display) + (eq (get-text-property p 'face) 'org-date)) + (remove-text-properties + p (setq p (next-single-property-change p 'display)) + '(display t)))) (set-buffer-modified-p bmp))) - (if (featurep 'xemacs) - (remove-text-properties (point-min) (point-max) '(end-glyph t))) (org-restart-font-lock) (setq org-table-may-need-update t) (if org-display-custom-times @@ -17390,8 +17494,8 @@ The command returns the inserted time stamp." t1 w1 with-hm tf time str w2 (off 0)) (save-match-data (setq t1 (org-parse-time-string ts t)) - (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) - (setq off (- (match-end 0) (match-beginning 0))))) + (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) + (setq off (- (match-end 0) (match-beginning 0))))) (setq end (- end off)) (setq w1 (- end beg) with-hm (and (nth 1 t1) (nth 2 t1)) @@ -17402,14 +17506,10 @@ The command returns the inserted time stamp." (substring tf 1 -1) (apply 'encode-time time)) nil 'mouse-face 'highlight) w2 (length str)) - (if (not (= w2 w1)) - (add-text-properties (1+ beg) (+ 2 beg) - (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) - (if (featurep 'xemacs) - (progn - (put-text-property beg end 'invisible t) - (put-text-property beg end 'end-glyph (make-glyph str))) - (put-text-property beg end 'display str)))) + (unless (= w2 w1) + (add-text-properties (1+ beg) (+ 2 beg) + (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) + (put-text-property beg end 'display str))) (defun org-fix-decoded-time (time) "Set 0 instead of nil for the first 6 elements of time. @@ -17417,19 +17517,17 @@ Don't touch the rest." (let ((n 0)) (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) -(define-obsolete-function-alias 'org-days-to-time 'org-time-stamp-to-now "24.4") - (defun org-time-stamp-to-now (timestamp-string &optional seconds) "Difference between TIMESTAMP-STRING and now in days. If SECONDS is non-nil, return the difference in seconds." - (let ((fdiff (if seconds 'org-float-time 'time-to-days))) + (let ((fdiff (if seconds #'float-time #'time-to-days))) (- (funcall fdiff (org-time-string-to-time timestamp-string)) (funcall fdiff (current-time))))) -(defun org-deadline-close (timestamp-string &optional ndays) +(defun org-deadline-close-p (timestamp-string &optional ndays) "Is the time in TIMESTAMP-STRING close to the current date?" (setq ndays (or ndays (org-get-wdays timestamp-string))) - (and (< (org-time-stamp-to-now timestamp-string) ndays) + (and (<= (org-time-stamp-to-now timestamp-string) ndays) (not (org-entry-is-done-p)))) (defun org-get-wdays (ts &optional delay zero-delay) @@ -17465,14 +17563,15 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer." (let* ((date (calendar-cursor-to-date)) (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) (setq org-ans1 (format-time-string "%Y-%m-%d" time))) - (if (active-minibuffer-window) (exit-minibuffer)))) + (when (active-minibuffer-window) (exit-minibuffer)))) (defun org-check-deadlines (ndays) "Check if there are any deadlines due or past due. A deadline is considered due if it happens within `org-deadline-warning-days' days from today's date. If the deadline appears in an entry marked DONE, -it is not shown. The prefix arg NDAYS can be used to test that many -days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown." +it is not shown. A numeric prefix argument NDAYS can be used to test that +many days. If the prefix is a raw `\\[universal-argument]', all deadlines \ +are shown." (interactive "P") (let* ((org-warn-days (cond @@ -17482,7 +17581,7 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s (case-fold-search nil) (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) (callback - (lambda () (org-deadline-close (match-string 1) org-warn-days)))) + (lambda () (org-deadline-close-p (match-string 1) org-warn-days)))) (message "%d deadlines past-due or due within %d days" (org-occur regexp nil callback) org-warn-days))) @@ -17500,7 +17599,7 @@ Allowed values for TYPE are: When TYPE is nil, fall back on returning a regexp that matches both scheduled and deadline timestamps." - (case type + (cl-case type (all org-ts-regexp-both) (active org-ts-regexp) (inactive org-ts-regexp-inactive) @@ -17512,39 +17611,49 @@ both scheduled and deadline timestamps." (regexp-opt (list org-deadline-string org-scheduled-string)) " *<\\([^>]+\\)>")))) -(defun org-check-before-date (date) - "Check if there are deadlines or scheduled entries before DATE." +(defun org-check-before-date (d) + "Check if there are deadlines or scheduled entries before date D." (interactive (list (org-read-date))) - (let ((case-fold-search nil) - (regexp (org-re-timestamp org-ts-type)) - (callback - `(lambda () + (let* ((case-fold-search nil) + (regexp (org-re-timestamp org-ts-type)) + (ts-type org-ts-type) + (callback + (lambda () (let ((match (match-string 1))) - (and ,(if (memq org-ts-type '(active inactive all)) - '(eq (org-element-type (org-element-context)) 'timestamp) - '(org-at-planning-p)) + (and (if (memq ts-type '(active inactive all)) + (eq (org-element-type (save-excursion + (backward-char) + (org-element-context))) + 'timestamp) + (org-at-planning-p)) (time-less-p (org-time-string-to-time match) - (org-time-string-to-time date))))))) + (org-time-string-to-time d))))))) (message "%d entries before %s" - (org-occur regexp nil callback) date))) + (org-occur regexp nil callback) + d))) -(defun org-check-after-date (date) - "Check if there are deadlines or scheduled entries after DATE." +(defun org-check-after-date (d) + "Check if there are deadlines or scheduled entries after date D." (interactive (list (org-read-date))) - (let ((case-fold-search nil) - (regexp (org-re-timestamp org-ts-type)) - (callback - `(lambda () + (let* ((case-fold-search nil) + (regexp (org-re-timestamp org-ts-type)) + (ts-type org-ts-type) + (callback + (lambda () (let ((match (match-string 1))) - (and ,(if (memq org-ts-type '(active inactive all)) - '(eq (org-element-type (org-element-context)) 'timestamp) - '(org-at-planning-p)) + (and (if (memq ts-type '(active inactive all)) + (eq (org-element-type (save-excursion + (backward-char) + (org-element-context))) + 'timestamp) + (org-at-planning-p)) (not (time-less-p (org-time-string-to-time match) - (org-time-string-to-time date)))))))) + (org-time-string-to-time d)))))))) (message "%d entries after %s" - (org-occur regexp nil callback) date))) + (org-occur regexp nil callback) + d))) (defun org-check-dates-range (start-date end-date) "Check for deadlines/scheduled entries between START-DATE and END-DATE." @@ -17553,18 +17662,22 @@ both scheduled and deadline timestamps." (let ((case-fold-search nil) (regexp (org-re-timestamp org-ts-type)) (callback - `(lambda () - (let ((match (match-string 1))) - (and - ,(if (memq org-ts-type '(active inactive all)) - '(eq (org-element-type (org-element-context)) 'timestamp) - '(org-at-planning-p)) - (not (time-less-p - (org-time-string-to-time match) - (org-time-string-to-time start-date))) - (time-less-p - (org-time-string-to-time match) - (org-time-string-to-time end-date))))))) + (let ((type org-ts-type)) + (lambda () + (let ((match (match-string 1))) + (and + (if (memq type '(active inactive all)) + (eq (org-element-type (save-excursion + (backward-char) + (org-element-context))) + 'timestamp) + (org-at-planning-p)) + (not (time-less-p + (org-time-string-to-time match) + (org-time-string-to-time start-date))) + (time-less-p + (org-time-string-to-time match) + (org-time-string-to-time end-date)))))))) (message "%d entries between %s and %s" (org-occur regexp nil callback) start-date end-date))) @@ -17583,16 +17696,16 @@ days in order to avoid rounding problems." (unless (org-at-date-range-p t) (goto-char (point-at-bol)) (re-search-forward org-tr-regexp-both (point-at-eol) t)) - (if (not (org-at-date-range-p t)) - (user-error "Not at a time-stamp range, and none found in current line"))) + (unless (org-at-date-range-p t) + (user-error "Not at a time-stamp range, and none found in current line"))) (let* ((ts1 (match-string 1)) (ts2 (match-string 2)) (havetime (or (> (length ts1) 15) (> (length ts2) 15))) (match-end (match-end 0)) (time1 (org-time-string-to-time ts1)) (time2 (org-time-string-to-time ts2)) - (t1 (org-float-time time1)) - (t2 (org-float-time time2)) + (t1 (float-time time1)) + (t2 (float-time time2)) (diff (abs (- t2 t1))) (negative (< (- t2 t1) 0)) ;; (ys (floor (* 365 24 60 60))) @@ -17622,27 +17735,31 @@ days in order to avoid rounding problems." (setq align t) (and (looking-at " *|") (goto-char (match-end 0)))) (goto-char match-end)) - (if (looking-at - "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") - (replace-match "")) - (if negative (insert " -")) + (when (looking-at + "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") + (replace-match "")) + (when negative (insert " -")) (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) (insert " " (format fh h m)))) - (if align (org-table-align)) + (when align (org-table-align)) (message "Time difference inserted"))))) (defun org-make-tdiff-string (y d h m) (let ((fmt "") (l nil)) - (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") - l (push y l))) - (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") - l (push d l))) - (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") - l (push h l))) - (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") - l (push m l))) + (when (> y 0) + (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ")) + (push y l)) + (when (> d 0) + (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ")) + (push d l)) + (when (> h 0) + (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ")) + (push h l)) + (when (> m 0) + (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ")) + (push m l)) (apply 'format fmt (nreverse l)))) (defun org-time-string-to-time (s &optional buffer pos) @@ -17657,31 +17774,42 @@ days in order to avoid rounding problems." (defun org-time-string-to-seconds (s) "Convert a timestamp string to a number of seconds." - (org-float-time (org-time-string-to-time s))) + (float-time (org-time-string-to-time s))) + +(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp") (defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos) - "Convert a time stamp to an absolute day number. -If there is a specifier for a cyclic time stamp, get the closest -date to DAYNR. -PREFER and SHOW-ALL are passed through to `org-closest-date'. -The variable `date' is bound by the calendar when this is called." + "Convert time stamp S to an absolute day number. + +If DAYNR in non-nil, and there is a specifier for a cyclic time +stamp, get the closest date to DAYNR. If PREFER is +`past' (respectively `future') return a date past (respectively +after) or equal to DAYNR. + +POS is the location of time stamp S, as a buffer position in +BUFFER. + +Diary sexp timestamps are matched against DAYNR, when non-nil. +If matching fails or DAYNR is nil, `org-diary-sexp-no-match' is +signalled." (cond - ((and daynr (string-match "\\`%%\\((.*)\\)" s)) - (if (org-diary-sexp-entry (match-string 1 s) "" date) + ((string-match "\\`%%\\((.*)\\)" s) + ;; Sexp timestamp: try to match DAYNR, if available, since we're + ;; only able to match individual dates. If it fails, raise an + ;; error. + (if (and daynr + (org-diary-sexp-entry + (match-string 1 s) "" (calendar-gregorian-from-absolute daynr))) daynr - (+ daynr 1000))) - ((and daynr (string-match "\\+\\([0-9]+\\)[hdwmy]" s) - (> (string-to-number (match-string 1 s)) 0)) - (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr - (time-to-days (current-time))) (match-string 0 s) - prefer show-all)) + (signal 'org-diary-sexp-no-match (list s)))) + ((and daynr show-all) (org-closest-date s daynr prefer)) (t (time-to-days (condition-case errdata - (apply 'encode-time (org-parse-time-string s)) + (apply #'encode-time (org-parse-time-string s)) (error (error "Bad timestamp `%s'%s\nError was: %s" - s (if (not (and buffer pos)) - "" - (format-message " at %d in buffer `%s'" pos buffer)) + s + (if (not (and buffer pos)) "" + (format-message " at %d in buffer `%s'" pos buffer)) (cdr errdata)))))))) (defun org-days-to-iso-week (days) @@ -17704,31 +17832,33 @@ into a past one. Any year larger than 99 is returned unchanged." (defun org-time-from-absolute (d) "Return the time corresponding to date D. D may be an absolute day number, or a calendar-type list (month day year)." - (if (numberp d) (setq d (calendar-gregorian-from-absolute d))) + (when (numberp d) (setq d (calendar-gregorian-from-absolute d))) (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d))) +(defvar org-agenda-current-date) (defun org-calendar-holiday () - "List of holidays, for Diary display in Org-mode." + "List of holidays, for Diary display in Org mode." (require 'holidays) - (let ((hl (funcall - (if (fboundp 'calendar-check-holidays) - 'calendar-check-holidays 'check-calendar-holidays) date))) - (if hl (mapconcat 'identity hl "; ")))) + (let ((hl (calendar-check-holidays org-agenda-current-date))) + (and hl (mapconcat #'identity hl "; ")))) -(defun org-diary-sexp-entry (sexp entry date) - "Process a SEXP diary ENTRY for DATE." +(defun org-diary-sexp-entry (sexp entry d) + "Process a SEXP diary ENTRY for date D." (require 'diary-lib) - (let ((result (if calendar-debug-sexp - (let ((stack-trace-on-error t)) - (eval (car (read-from-string sexp)))) - (condition-case nil - (eval (car (read-from-string sexp))) - (error - (beep) - (message "Bad sexp at line %d in %s: %s" - (org-current-line) - (buffer-file-name) sexp) - (sleep-for 2)))))) + ;; `org-anniversary' and alike expect ENTRY and DATE to be bound + ;; dynamically. + (let* ((sexp `(let ((entry ,entry) + (date ',d)) + ,(car (read-from-string sexp)))) + (result (if calendar-debug-sexp (eval sexp) + (condition-case nil + (eval sexp) + (error + (beep) + (message "Bad sexp at line %d in %s: %s" + (org-current-line) + (buffer-file-name) sexp) + (sleep-for 2)))))) (cond ((stringp result) (split-string result "; ")) ((and (consp result) (not (consp (cdr result))) @@ -17740,9 +17870,7 @@ D may be an absolute day number, or a calendar-type list (month day year)." (defun org-diary-to-ical-string (frombuf) "Get iCalendar entries from diary entries in buffer FROMBUF. This uses the icalendar.el library." - (let* ((tmpdir (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory)) + (let* ((tmpdir temporary-file-directory) (tmpfile (make-temp-name (expand-file-name "orgics" tmpdir))) buf rtn b e) @@ -17751,126 +17879,136 @@ This uses the icalendar.el library." (setq buf (find-buffer-visiting tmpfile)) (set-buffer buf) (goto-char (point-min)) - (if (re-search-forward "^BEGIN:VEVENT" nil t) - (setq b (match-beginning 0))) + (when (re-search-forward "^BEGIN:VEVENT" nil t) + (setq b (match-beginning 0))) (goto-char (point-max)) - (if (re-search-backward "^END:VEVENT" nil t) - (setq e (match-end 0))) + (when (re-search-backward "^END:VEVENT" nil t) + (setq e (match-end 0))) (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") ""))) (kill-buffer buf) (delete-file tmpfile) rtn)) -(defun org-closest-date (start current change prefer show-all) - "Find the date closest to CURRENT that is consistent with START and CHANGE. -When PREFER is `past', return a date that is either CURRENT or past. -When PREFER is `future', return a date that is either CURRENT or future. -When SHOW-ALL is nil, only return the current occurrence of a time stamp." - ;; Make the proper lists from the dates - (catch 'exit - (let ((a1 '(("h" . hour) - ("d" . day) - ("w" . week) - ("m" . month) - ("y" . year))) - (shour (nth 2 (org-parse-time-string start))) - dn dw sday cday n1 n2 n0 - d m y y1 y2 date1 date2 nmonths nm ny m2) - - (setq start (org-date-to-gregorian start) - current (org-date-to-gregorian - (if show-all - current - (time-to-days (current-time)))) - sday (calendar-absolute-from-gregorian start) - cday (calendar-absolute-from-gregorian current)) - - (if (<= cday sday) (throw 'exit sday)) - - (when (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change) - (setq dn (string-to-number (match-string 1 change)) - dw (cdr (assoc (match-string 2 change) a1)))) - (unless (and dn (> dn 0)) - (user-error "Invalid change specifier: %s" change)) - (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) - (cond - ((eq dw 'hour) - (let ((missing-hours - (mod (+ (- (* 24 (- cday sday)) shour) org-extend-today-until) - dn))) - (setq n1 (if (zerop missing-hours) cday - (- cday (1+ (floor (/ missing-hours 24))))) - n2 (+ cday (floor (/ (- dn missing-hours) 24)))))) - ((eq dw 'day) - (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn)))) - n2 (+ n1 dn))) - ((eq dw 'year) - (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current)) - (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1)) - (setq date1 (list m d y1) - n1 (calendar-absolute-from-gregorian date1) - date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn))) - n2 (calendar-absolute-from-gregorian date2))) - ((eq dw 'month) - ;; approx number of month between the two dates - (setq nmonths (floor (/ (- cday sday) 30.436875))) - ;; How often does dn fit in there? - (setq d (nth 1 start) m (car start) y (nth 2 start) - nm (* dn (max 0 (1- (floor (/ nmonths dn))))) - m (+ m nm) - ny (floor (/ m 12)) - y (+ y ny) - m (- m (* ny 12))) - (while (> m 12) (setq m (- m 12) y (1+ y))) - (setq n1 (calendar-absolute-from-gregorian (list m d y))) - (setq m2 (+ m dn) y2 y) - (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) - (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))) - (while (<= n2 cday) - (setq n1 n2 m m2 y y2) - (setq m2 (+ m dn) y2 y) - (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) - (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))))) - ;; Make sure n1 is the earlier date - (setq n0 n1 n1 (min n1 n2) n2 (max n0 n2)) - (if show-all - (cond - ((eq prefer 'past) (if (= cday n2) n2 n1)) - ((eq prefer 'future) (if (= cday n1) n1 n2)) - (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))) - (cond - ((eq prefer 'past) (if (= cday n2) n2 n1)) - ((eq prefer 'future) (if (= cday n1) n1 n2)) - (t (if (= cday n1) n1 n2))))))) - -(defun org-date-to-gregorian (date) - "Turn any specification of DATE into a Gregorian date for the calendar." - (cond ((integerp date) (calendar-gregorian-from-absolute date)) - ((and (listp date) (= (length date) 3)) date) - ((stringp date) - (setq date (org-parse-time-string date)) - (list (nth 4 date) (nth 3 date) (nth 5 date))) - ((listp date) - (list (nth 4 date) (nth 3 date) (nth 5 date))))) +(defun org-closest-date (start current prefer) + "Return closest date to CURRENT starting from START. + +CURRENT and START are both time stamps. + +When PREFER is `past', return a date that is either CURRENT or +past. When PREFER is `future', return a date that is either +CURRENT or future. + +Only time stamps with a repeater are modified. Any other time +stamp stay unchanged. In any case, return value is an absolute +day number." + (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start)) + ;; No repeater. Do not shift time stamp. + (time-to-days (apply #'encode-time (org-parse-time-string start))) + (let ((value (string-to-number (match-string 1 start))) + (type (match-string 2 start))) + (if (= 0 value) + ;; Repeater with a 0-value is considered as void. + (time-to-days (apply #'encode-time (org-parse-time-string start))) + (let* ((base (org-date-to-gregorian start)) + (target (org-date-to-gregorian current)) + (sday (calendar-absolute-from-gregorian base)) + (cday (calendar-absolute-from-gregorian target)) + n1 n2) + ;; If START is already past CURRENT, just return START. + (if (<= cday sday) sday + ;; Compute closest date before (N1) and closest date past + ;; (N2) CURRENT. + (pcase type + ("h" + (let ((missing-hours + (mod (+ (- (* 24 (- cday sday)) + (nth 2 (org-parse-time-string start))) + org-extend-today-until) + value))) + (setf n1 (if (= missing-hours 0) cday + (- cday (1+ (/ missing-hours 24))))) + (setf n2 (+ cday (/ (- value missing-hours) 24))))) + ((or "d" "w") + (let ((value (if (equal type "w") (* 7 value) value))) + (setf n1 (+ sday (* value (/ (- cday sday) value)))) + (setf n2 (+ n1 value)))) + ("m" + (let* ((add-months + (lambda (d n) + ;; Add N months to gregorian date D, i.e., + ;; a list (MONTH DAY YEAR). Return a valid + ;; gregorian date. + (let ((m (+ (nth 0 d) n))) + (list (mod m 12) + (nth 1 d) + (+ (/ m 12) (nth 2 d)))))) + (months ; Complete months to TARGET. + (* (/ (+ (* 12 (- (nth 2 target) (nth 2 base))) + (- (nth 0 target) (nth 0 base)) + ;; If START's day is greater than + ;; TARGET's, remove incomplete month. + (if (> (nth 1 target) (nth 1 base)) 0 -1)) + value) + value)) + (before (funcall add-months base months))) + (setf n1 (calendar-absolute-from-gregorian before)) + (setf n2 + (calendar-absolute-from-gregorian + (funcall add-months before value))))) + (_ + (let* ((d (nth 1 base)) + (m (nth 0 base)) + (y (nth 2 base)) + (years ; Complete years to TARGET. + (* (/ (- (nth 2 target) + y + ;; If START's month and day are + ;; greater than TARGET's, remove + ;; incomplete year. + (if (or (> (nth 0 target) m) + (and (= (nth 0 target) m) + (> (nth 1 target) d))) + 0 + 1)) + value) + value)) + (before (list m d (+ y years)))) + (setf n1 (calendar-absolute-from-gregorian before)) + (setf n2 (calendar-absolute-from-gregorian + (list m d (+ (nth 2 before) value))))))) + ;; Handle PREFER parameter, if any. + (cond + ((eq prefer 'past) (if (= cday n2) n2 n1)) + ((eq prefer 'future) (if (= cday n1) n1 n2)) + (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))))))))) + +(defun org-date-to-gregorian (d) + "Turn any specification of date D into a Gregorian date for the calendar." + (cond ((integerp d) (calendar-gregorian-from-absolute d)) + ((and (listp d) (= (length d) 3)) d) + ((stringp d) + (let ((d (org-parse-time-string d))) + (list (nth 4 d) (nth 3 d) (nth 5 d)))) + ((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d))))) (defun org-parse-time-string (s &optional nodefault) - "Parse the standard Org-mode time string. + "Parse the standard Org time string. This should be a lot faster than the normal `parse-time-string'. If time is not given, defaults to 0:00. However, with optional NODEFAULT, hour and minute fields will be nil if not given." (cond ((string-match org-ts-regexp0 s) (list 0 - (if (or (match-beginning 8) (not nodefault)) - (string-to-number (or (match-string 8 s) "0"))) - (if (or (match-beginning 7) (not nodefault)) - (string-to-number (or (match-string 7 s) "0"))) + (when (or (match-beginning 8) (not nodefault)) + (string-to-number (or (match-string 8 s) "0"))) + (when (or (match-beginning 7) (not nodefault)) + (string-to-number (or (match-string 7 s) "0"))) (string-to-number (match-string 4 s)) (string-to-number (match-string 3 s)) (string-to-number (match-string 2 s)) nil nil nil)) ((string-match "^<[^>]+>$" s) (decode-time (seconds-to-time (org-matcher-time s)))) - (t (error "Not a standard Org-mode time string: %s" s)))) + (t (error "Not a standard Org time string: %s" s)))) (defun org-timestamp-up (&optional arg) "Increase the date item at the cursor by one. @@ -17921,7 +18059,7 @@ INACTIVE-OK." (ans (or (looking-at tsr) (save-excursion (skip-chars-backward "^[<\n\r\t") - (if (> (point) (point-min)) (backward-char 1)) + (when (> (point) (point-min)) (backward-char 1)) (and (looking-at tsr) (> (- (match-end 0) pos) -1)))))) (and ans @@ -17979,19 +18117,19 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." org-ts-what extra rem ts time time0 fixnext clrgx) - (if (not (org-at-timestamp-p t)) - (user-error "Not at a timestamp")) + (unless (org-at-timestamp-p t) + (user-error "Not at a timestamp")) (if (and (not what) (eq org-ts-what 'bracket)) (org-toggle-timestamp-type) ;; Point isn't on brackets. Remember the part of the time-stamp ;; the point was in. Indeed, size of time-stamps may change, ;; but point must be kept in the same category nonetheless. (setq origin-cat org-ts-what) - (if (and (not what) (not (eq org-ts-what 'day)) - org-display-custom-times - (get-text-property (point) 'display) - (not (get-text-property (1- (point)) 'display))) - (setq org-ts-what 'day)) + (when (and (not what) (not (eq org-ts-what 'day)) + org-display-custom-times + (get-text-property (point) 'display) + (not (get-text-property (1- (point)) 'display))) + (setq org-ts-what 'day)) (setq org-ts-what (or what org-ts-what) inactive (= (char-after (match-beginning 0)) ?\[) ts (match-string 0)) @@ -18000,27 +18138,28 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" ts) (setq extra (match-string 1 ts)) - (if suppress-tmp-delay - (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra)))) - (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) - (setq with-hm t)) + (when suppress-tmp-delay + (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra)))) + (when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) + (setq with-hm t)) (setq time0 (org-parse-time-string ts)) (when (and updown (eq org-ts-what 'minute) (not current-prefix-arg)) ;; This looks like s-up and s-down. Change by one rounding step. (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) - (when (not (= 0 (setq rem (% (nth 1 time0) dm)))) + (unless (= 0 (setq rem (% (nth 1 time0) dm))) (setcar (cdr time0) (+ (nth 1 time0) (if (> n 0) (- rem) (- dm rem)))))) (setq time - (encode-time (or (car time0) 0) - (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) - (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) - (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) - (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) - (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) - (nthcdr 6 time0))) + (apply #'encode-time + (or (car time0) 0) + (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) + (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) + (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) + (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) + (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) + (nthcdr 6 time0))) (when (and (member org-ts-what '(hour minute)) extra (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) @@ -18030,15 +18169,15 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." n dm))) (when (integerp org-ts-what) (setq extra (org-modify-ts-extra extra org-ts-what n dm))) - (if (eq what 'calendar) - (let ((cal-date (org-get-date-from-calendar))) - (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month - (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day - (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year - (setcar time0 (or (car time0) 0)) - (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) - (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) - (setq time (apply 'encode-time time0)))) + (when (eq what 'calendar) + (let ((cal-date (org-get-date-from-calendar))) + (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month + (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day + (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year + (setcar time0 (or (car time0) 0)) + (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) + (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) + (setq time (apply 'encode-time time0)))) ;; Insert the new time-stamp, and ensure point stays in the same ;; category as before (i.e. not after the last position in that ;; category). @@ -18049,17 +18188,21 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (goto-char pos)) (save-match-data (looking-at org-ts-regexp3) - (goto-char (cond - ;; `day' category ends before `hour' if any, or at - ;; the end of the day name. - ((eq origin-cat 'day) - (min (or (match-beginning 7) (1- (match-end 5))) origin)) - ((eq origin-cat 'hour) (min (match-end 7) origin)) - ((eq origin-cat 'minute) (min (1- (match-end 8)) origin)) - ((integerp origin-cat) (min (1- (match-end 0)) origin)) - ;; `year' and `month' have both fixed size: point - ;; couldn't have moved into another part. - (t origin)))) + (goto-char + (pcase origin-cat + ;; `day' category ends before `hour' if any, or at the end + ;; of the day name. + (`day (min (or (match-beginning 7) (1- (match-end 5))) origin)) + (`hour (min (match-end 7) origin)) + (`minute (min (1- (match-end 8)) origin)) + ((pred integerp) (min (1- (match-end 0)) origin)) + ;; Point was right after the time-stamp. However, the + ;; time-stamp length might have changed, so refer to + ;; (match-end 0) instead. + (`after (match-end 0)) + ;; `year' and `month' have both fixed size: point couldn't + ;; have moved into another part. + (_ origin)))) ;; Update clock if on a CLOCK line. (org-clock-update-time-maybe) ;; Maybe adjust the closest clock in `org-clock-history' @@ -18068,12 +18211,12 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (< 1 (length (delq nil (mapcar 'marker-position org-clock-history)))))) (message "No clock to adjust") - (cond ((save-excursion ; fix previous clock? + (cond ((save-excursion ; fix previous clock? (re-search-backward org-ts-regexp0 nil t) - (org-looking-back (concat org-clock-string " \\[") - (line-beginning-position))) + (looking-back (concat org-clock-string " \\[") + (line-beginning-position))) (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$"))) - ((save-excursion ; fix next clock? + ((save-excursion ; fix next clock? (re-search-backward org-ts-regexp0 nil t) (looking-at (concat org-ts-regexp0 "\\] =>"))) (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0)))) @@ -18083,7 +18226,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history)) (clfixnth (+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100)))) - (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history)))) + (clfixpos (unless (> 0 clfixnth) (nth clfixnth org-clock-history)))) (if (not clfixpos) (message "No clock to adjust") (save-excursion @@ -18097,10 +18240,10 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (file-name-nondirectory (buffer-file-name)) (org-get-heading t t))))))))) ;; Try to recenter the calendar window, if any. - (if (and org-calendar-follow-timestamp-change - (get-buffer-window "*Calendar*" t) - (memq org-ts-what '(day month year))) - (org-recenter-calendar (time-to-days time)))))) + (when (and org-calendar-follow-timestamp-change + (get-buffer-window "*Calendar*" t) + (memq org-ts-what '(day month year))) + (org-recenter-calendar (time-to-days time)))))) (defun org-modify-ts-extra (s pos n dm) "Change the different parts of the lead-time and repeat fields in timestamp." @@ -18114,12 +18257,12 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." h (string-to-number (match-string 2 s))) (if (org-pos-in-match-range pos 2) (setq h (+ h n)) - (setq n (* dm (org-no-warnings (signum n)))) - (when (not (= 0 (setq rem (% m dm)))) + (setq n (* dm (with-no-warnings (signum n)))) + (unless (= 0 (setq rem (% m dm))) (setq m (+ m (if (> n 0) (- rem) (- dm rem))))) (setq m (+ m n))) - (if (< m 0) (setq m (+ m 60) h (1- h))) - (if (> m 59) (setq m (- m 60) h (1+ h))) + (when (< m 0) (setq m (+ m 60) h (1- h))) + (when (> m 59) (setq m (- m 60) h (1+ h))) (setq h (mod h 24)) (setq ng 1 new (format "-%02d:%02d" h m))) ((org-pos-in-match-range pos 6) @@ -18139,14 +18282,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (substring s (match-end ng)))))) s)) -(defun org-recenter-calendar (date) - "If the calendar is visible, recenter it to DATE." +(defun org-recenter-calendar (d) + "If the calendar is visible, recenter it to date D." (let ((cwin (get-buffer-window "*Calendar*" t))) (when cwin (let ((calendar-move-hook nil)) (with-selected-window cwin - (calendar-goto-date (if (listp date) date - (calendar-gregorian-from-absolute date)))))))) + (calendar-goto-date + (if (listp d) d (calendar-gregorian-from-absolute d)))))))) (defun org-goto-calendar (&optional arg) "Go to the Emacs calendar at the current date. @@ -18157,17 +18300,17 @@ A prefix ARG can be used to force the current date." (calendar-move-hook nil) (calendar-view-holidays-initially-flag nil) (calendar-view-diary-initially-flag nil)) - (if (or (org-at-timestamp-p) - (save-excursion - (beginning-of-line 1) - (looking-at (concat ".*" tsr)))) - (let ((d1 (time-to-days (current-time))) - (d2 (time-to-days - (org-time-string-to-time (match-string 1))))) - (setq diff (- d2 d1)))) + (when (or (org-at-timestamp-p) + (save-excursion + (beginning-of-line 1) + (looking-at (concat ".*" tsr)))) + (let ((d1 (time-to-days (current-time))) + (d2 (time-to-days + (org-time-string-to-time (match-string 1))))) + (setq diff (- d2 d1)))) (calendar) (calendar-goto-today) - (if (and diff (not arg)) (calendar-forward-day diff)))) + (when (and diff (not arg)) (calendar-forward-day diff)))) (defun org-get-date-from-calendar () "Return a list (month day year) of date at point in calendar." @@ -18203,7 +18346,7 @@ minutes. For example, if the value of this variable is ((\"hours\" . 60)), then an effort string \"2hours\" is equivalent to 120 minutes." :group 'org-agenda - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(alist :key-type (string :tag "Modifier") :value-type (number :tag "Minutes"))) @@ -18297,10 +18440,6 @@ The format is determined by `org-time-clocksum-format', ;; return formatted time duration clocksum)))) -(defalias 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string) -(make-obsolete 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string - "Org mode version 8.0") - (defun org-hours-to-clocksum-string (n) (org-minutes-to-clocksum-string (* n 60))) @@ -18356,10 +18495,6 @@ tables are not re-aligned, etc." :version "24.3" :group 'org-agenda) -(define-obsolete-variable-alias - 'org-agenda-ignore-drawer-properties - 'org-agenda-ignore-properties "25.1") - (defcustom org-agenda-ignore-properties nil "Avoid updating text properties when building the agenda. Properties are used to prepare buffers for effort estimates, @@ -18373,7 +18508,7 @@ The value is a list, with zero or more of the symbols `effort', `appt', (const appt) (const stats) (const category)) - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :group 'org-agenda) @@ -18390,25 +18525,25 @@ Entries containing a colon are interpreted as H:MM by (regexp-opt (mapcar 'car org-effort-durations)) "\\)"))) (while (string-match re s) - (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations)) - (string-to-number (match-string 1 s)))) + (cl-incf result (* (cdr (assoc (match-string 2 s) org-effort-durations)) + (string-to-number (match-string 1 s)))) (setq s (replace-match "" nil t s))) (setq result (floor result)) - (incf result (org-hh:mm-string-to-minutes s)) + (cl-incf result (org-hh:mm-string-to-minutes s)) (if output-to-string (number-to-string result) result))) ;;;; Files (defun org-save-all-org-buffers () - "Save all Org-mode buffers without user confirmation." + "Save all Org buffers without user confirmation." (interactive) - (message "Saving all Org-mode buffers...") + (message "Saving all Org buffers...") (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) (when (featurep 'org-id) (org-id-locations-save)) - (message "Saving all Org-mode buffers... done")) + (message "Saving all Org buffers... done")) (defun org-revert-all-org-buffers () - "Revert all Org-mode buffers. + "Revert all Org buffers. Prompt for confirmation when there are unsaved changes. Be sure you know what you are doing before letting this function overwrite your changes. @@ -18425,13 +18560,11 @@ changes from another. I believe the procedure must be like this: (user-error "Abort")) (save-excursion (save-window-excursion - (mapc - (lambda (b) - (when (and (with-current-buffer b (derived-mode-p 'org-mode)) - (with-current-buffer b buffer-file-name)) - (org-pop-to-buffer-same-window b) - (revert-buffer t 'no-confirm))) - (buffer-list)) + (dolist (b (buffer-list)) + (when (and (with-current-buffer b (derived-mode-p 'org-mode)) + (with-current-buffer b buffer-file-name)) + (pop-to-buffer-same-window b) + (revert-buffer t 'no-confirm))) (when (and (featurep 'org-id) org-id-track-globally) (org-id-locations-load))))) @@ -18440,29 +18573,19 @@ changes from another. I believe the procedure must be like this: ;;;###autoload (defun org-switchb (&optional arg) "Switch between Org buffers. -With one prefix argument, restrict available buffers to files. -With two prefix arguments, restrict available buffers to agenda files. -Defaults to `iswitchb' for buffer name completion. -Set `org-completion-use-ido' to make it use ido instead." +With `\\[universal-argument]' prefix, restrict available buffers to files. + +With `\\[universal-argument] \\[universal-argument]' \ +prefix, restrict available buffers to agenda files." (interactive "P") - (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files)) - ((equal arg '(16)) (org-buffer-list 'agenda)) - (t (org-buffer-list)))) - (org-completion-use-iswitchb org-completion-use-iswitchb) - (org-completion-use-ido org-completion-use-ido)) - (unless (or org-completion-use-ido org-completion-use-iswitchb) - (setq org-completion-use-iswitchb t)) - (org-pop-to-buffer-same-window - (org-icompleting-read "Org buffer: " - (mapcar 'list (mapcar 'buffer-name blist)) - nil t)))) - -;;; Define some older names previously used for this functionality -;;;###autoload -(defalias 'org-ido-switchb 'org-switchb) -;;;###autoload -(defalias 'org-iswitchb 'org-switchb) + (let ((blist (org-buffer-list + (cond ((equal arg '(4)) 'files) + ((equal arg '(16)) 'agenda))))) + (pop-to-buffer-same-window + (completing-read "Org buffer: " + (mapcar #'list (mapcar #'buffer-name blist)) + nil t)))) (defun org-buffer-list (&optional predicate exclude-tmp) "Return a list of Org buffers. @@ -18552,15 +18675,15 @@ the buffer and restores the previous window configuration." (if (stringp org-agenda-files) (let ((cw (current-window-configuration))) (find-file org-agenda-files) - (org-set-local 'org-window-configuration cw) - (org-add-hook 'after-save-hook - (lambda () - (set-window-configuration - (prog1 org-window-configuration - (kill-buffer (current-buffer)))) - (org-install-agenda-files-menu) - (message "New agenda file list installed")) - nil 'local) + (setq-local org-window-configuration cw) + (add-hook 'after-save-hook + (lambda () + (set-window-configuration + (prog1 org-window-configuration + (kill-buffer (current-buffer)))) + (org-install-agenda-files-menu) + (message "New agenda file list installed")) + nil 'local) (message "%s" (substitute-command-keys "Edit list and finish with \\[save-buffer]"))) (customize-variable 'org-agenda-files))) @@ -18619,7 +18742,7 @@ If the current buffer does not, find the first agenda file." (while (and (setq file (pop files)) (not (equal (file-truename file) tcf))))) (find-file (car (or files fs))) - (if (buffer-base-buffer) (org-pop-to-buffer-same-window (buffer-base-buffer))))) + (when (buffer-base-buffer) (pop-to-buffer-same-window (buffer-base-buffer))))) (defun org-agenda-file-to-front (&optional to-end) "Move/add the current file to the top of the agenda file list. @@ -18637,7 +18760,7 @@ end of the list." x had) (setq x (assoc ctf file-alist) had x) - (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) + (unless x (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) (if to-end (setq file-alist (append (delq x file-alist) (list x))) (setq file-alist (cons x (delq x file-alist)))) @@ -18658,9 +18781,9 @@ Optional argument FILE means use this file instead of the current." (afile (abbreviate-file-name file)) (files (delq nil (mapcar (lambda (x) - (if (equal true-file - (file-truename x)) - nil x)) + (unless (equal true-file + (file-truename x)) + x)) (org-agenda-files t))))) (if (not (= (length files) (length (org-agenda-files t)))) (progn @@ -18674,7 +18797,7 @@ Optional argument FILE means use this file instead of the current." (defun org-check-agenda-file (file) "Make sure FILE exists. If not, ask user what to do." - (when (not (file-exists-p file)) + (unless (file-exists-p file) (message "Non-existent agenda file %s. [R]emove from list or [A]bort?" (abbreviate-file-name file)) (let ((r (downcase (read-char-exclusive)))) @@ -18693,7 +18816,7 @@ which might be released later." buf ; just return it ;; Make a new buffer and remember it (setq buf (find-file-noselect file)) - (if buf (push buf org-agenda-new-buffers)) + (when buf (push buf org-agenda-new-buffers)) buf))) (defun org-release-buffers (blist) @@ -18718,7 +18841,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (inhibit-read-only t) (org-inhibit-startup org-agenda-inhibit-startup) (rea (concat ":" org-archive-tag ":")) - file re pos) + re pos) (setq org-tag-alist-for-agenda nil org-tag-groups-alist-for-agenda nil) (save-excursion @@ -18749,8 +18872,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (setq org-tag-alist-for-agenda (org-uniquify (append org-tag-alist-for-agenda - org-tag-alist - org-tag-persistent-alist))) + org-current-tag-alist))) ;; Merge current file's tag groups into global ;; `org-tag-groups-alist-for-agenda'. (when org-group-tags @@ -18765,8 +18887,8 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (when org-agenda-skip-archived-trees (goto-char (point-min)) (while (re-search-forward rea nil t) - (if (org-at-heading-p t) - (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) + (when (org-at-heading-p t) + (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) (goto-char (point-min)) (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string)) (while (re-search-forward re nil t) @@ -18797,7 +18919,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (define-minor-mode org-cdlatex-mode "Toggle the minor `org-cdlatex-mode'. This mode supports entering LaTeX environment and math in LaTeX fragments -in Org-mode. +in Org mode. \\{org-cdlatex-mode-map}" nil " OCDL" nil (when org-cdlatex-mode @@ -18807,11 +18929,11 @@ in Org-mode. (unless org-cdlatex-texmathp-advice-is-done (setq org-cdlatex-texmathp-advice-is-done t) (defadvice texmathp (around org-math-always-on activate) - "Always return t in org-mode buffers. + "Always return t in Org buffers. This is because we want to insert math symbols without dollars even outside -the LaTeX math segments. If Orgmode thinks that point is actually inside -an embedded LaTeX fragment, let texmathp do its job. -\\[org-cdlatex-mode-map]" +the LaTeX math segments. If Org mode thinks that point is actually inside +an embedded LaTeX fragment, let `texmathp' do its job. +`\\[org-cdlatex-mode-map]'" (interactive) (let (p) (cond @@ -18823,8 +18945,8 @@ an embedded LaTeX fragment, let texmathp do its job. (let ((p (org-inside-LaTeX-fragment-p))) (if (and p (member (car p) (plist-get org-format-latex-options :matchers))) (setq ad-return-value t - texmathp-why '("Org-mode embedded math" . 0)) - (if p ad-do-it))))))))) + texmathp-why '("Org mode embedded math" . 0)) + (when p ad-do-it))))))))) (defun turn-on-org-cdlatex () "Unconditionally turn on `org-cdlatex-mode'." @@ -18849,7 +18971,7 @@ It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is (cdlatex-tab) t) ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) -(defun org-cdlatex-underscore-caret (&optional arg) +(defun org-cdlatex-underscore-caret (&optional _arg) "Execute `cdlatex-sub-superscript' in LaTeX fragments. Revert to the normal definition outside of these fragments." (interactive "P") @@ -18858,7 +18980,7 @@ Revert to the normal definition outside of these fragments." (let (org-cdlatex-mode) (call-interactively (key-binding (vector last-input-event)))))) -(defun org-cdlatex-math-modify (&optional arg) +(defun org-cdlatex-math-modify (&optional _arg) "Execute `cdlatex-math-modify' in LaTeX fragments. Revert to the normal definition outside of these fragments." (interactive "P") @@ -18887,10 +19009,10 @@ environment remains unintended." ;; environment has been inserted. (lines (when inserted (save-excursion - (- (loop while (< beg (point)) + (- (cl-loop while (< beg (point)) with x = 0 do (forward-line -1) - (incf x) + (cl-incf x) finally return x) (if (progn (goto-char beg) (and (progn (skip-chars-forward " \t") (eolp)) @@ -18916,11 +19038,11 @@ environment remains unintended." (save-excursion (goto-char beg) (while (< (point) end) - (unless (eolp) (org-indent-line-to ind)) + (unless (eolp) (indent-line-to ind)) (forward-line)))) (goto-char beg) (forward-line lines) - (org-indent-line-to ind))) + (indent-line-to ind))) (set-marker beg nil) (set-marker end nil))) @@ -18969,7 +19091,7 @@ looks only before point, not after." (while (re-search-backward "\\$\\$" lim t) (setq dd-on (not dd-on))) (goto-char pos) - (if dd-on (cons "$$" m)))))) + (when dd-on (cons "$$" m)))))) (defun org-inside-latex-macro-p () "Is point inside a LaTeX macro or its arguments?" @@ -18977,27 +19099,26 @@ looks only before point, not after." (org-in-regexp "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) -(defun org--format-latex-make-overlay (beg end image) - "Build an overlay between BEG and END using IMAGE file." - (let ((ov (make-overlay beg end))) +(defun org--format-latex-make-overlay (beg end image &optional imagetype) + "Build an overlay between BEG and END using IMAGE file. +Argument IMAGETYPE is the extension of the displayed image, +as a string. It defaults to \"png\"." + (let ((ov (make-overlay beg end)) + (imagetype (or (intern imagetype) 'png))) (overlay-put ov 'org-overlay-type 'org-latex-overlay) (overlay-put ov 'evaporate t) (overlay-put ov 'modification-hooks (list (lambda (o _flag _beg _end &optional _l) (delete-overlay o)))) - (if (featurep 'xemacs) - (progn - (overlay-put ov 'invisible t) - (overlay-put ov 'end-glyph (make-glyph (vector 'png :file image)))) - (overlay-put ov - 'display - (list 'image :type 'png :file image :ascent 'center))))) + (overlay-put ov + 'display + (list 'image :type imagetype :file image :ascent 'center)))) (defun org--list-latex-overlays (&optional beg end) "List all Org LaTeX overlays in current buffer. Limit to overlays between BEG and END when those are provided." - (org-remove-if-not + (cl-remove-if-not (lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay)) (overlays-in (or beg (point-min)) (or end (point-max))))) @@ -19010,8 +19131,6 @@ overlays were removed, nil otherwise." (mapc #'delete-overlay overlays) overlays)) -(define-obsolete-function-alias - 'org-preview-latex-fragment 'org-toggle-latex-fragment "24.4") (defun org-toggle-latex-fragment (&optional arg) "Preview the LaTeX fragment at point, or all locally or globally. @@ -19022,75 +19141,71 @@ current section. With prefix ARG, preview or clear image for all fragments in the current subtree or in the whole buffer when used before the first -headline. With a double prefix ARG \\[universal-argument] \ -\\[universal-argument] preview or clear images +headline. With a prefix ARG `\\[universal-argument] \ +\\[universal-argument]' preview or clear images for all fragments in the buffer." (interactive "P") - (unless (buffer-file-name (buffer-base-buffer)) - (user-error "Can't preview LaTeX fragment in a non-file buffer")) (when (display-graphic-p) (catch 'exit (save-excursion - (let ((window-start (window-start)) msg) - (save-restriction - (cond - ((or (equal arg '(16)) - (and (equal arg '(4)) - (org-with-limited-levels (org-before-first-heading-p)))) - (if (org-remove-latex-fragment-image-overlays) - (progn (message "LaTeX fragments images removed from buffer") - (throw 'exit nil)) - (setq msg "Creating images for buffer..."))) - ((equal arg '(4)) - (org-with-limited-levels (org-back-to-heading t)) - (let ((beg (point)) - (end (progn (org-end-of-subtree t) (point)))) - (if (org-remove-latex-fragment-image-overlays beg end) - (progn - (message "LaTeX fragment images removed from subtree") - (throw 'exit nil)) - (setq msg "Creating images for subtree...") - (narrow-to-region beg end)))) - ((let ((datum (org-element-context))) - (when (memq (org-element-type datum) - '(latex-environment latex-fragment)) - (let* ((beg (org-element-property :begin datum)) - (end (org-element-property :end datum))) - (if (org-remove-latex-fragment-image-overlays beg end) - (progn (message "LaTeX fragment image removed") - (throw 'exit nil)) - (narrow-to-region beg end) - (setq msg "Creating image...")))))) - (t - (org-with-limited-levels - (let ((beg (if (org-at-heading-p) (line-beginning-position) - (outline-previous-heading) - (point))) - (end (progn (outline-next-heading) (point)))) - (if (org-remove-latex-fragment-image-overlays beg end) - (progn - (message "LaTeX fragment images removed from section") + (let (beg end msg) + (cond + ((or (equal arg '(16)) + (and (equal arg '(4)) + (org-with-limited-levels (org-before-first-heading-p)))) + (if (org-remove-latex-fragment-image-overlays) + (progn (message "LaTeX fragments images removed from buffer") (throw 'exit nil)) - (setq msg "Creating images for section...") - (narrow-to-region beg end)))))) - (let ((file (buffer-file-name (buffer-base-buffer)))) - (org-format-latex - (concat org-latex-preview-ltxpng-directory - (file-name-sans-extension (file-name-nondirectory file))) - ;; Emacs cannot overlay images from remote hosts. - ;; Create it in `temporary-file-directory' instead. - (if (file-remote-p file) temporary-file-directory - default-directory) - 'overlays msg 'forbuffer - org-latex-create-formula-image-program))) - ;; Work around a bug that doesn't restore window's start - ;; when widening back the buffer. - (set-window-start nil window-start) + (setq msg "Creating images for buffer..."))) + ((equal arg '(4)) + (org-with-limited-levels (org-back-to-heading t)) + (setq beg (point)) + (setq end (progn (org-end-of-subtree t) (point))) + (if (org-remove-latex-fragment-image-overlays beg end) + (progn + (message "LaTeX fragment images removed from subtree") + (throw 'exit nil)) + (setq msg "Creating images for subtree..."))) + ((let ((datum (org-element-context))) + (when (memq (org-element-type datum) + '(latex-environment latex-fragment)) + (setq beg (org-element-property :begin datum)) + (setq end (org-element-property :end datum)) + (if (org-remove-latex-fragment-image-overlays beg end) + (progn (message "LaTeX fragment image removed") + (throw 'exit nil)) + (setq msg "Creating image..."))))) + (t + (org-with-limited-levels + (setq beg (if (org-at-heading-p) (line-beginning-position) + (outline-previous-heading) + (point))) + (setq end (progn (outline-next-heading) (point))) + (if (org-remove-latex-fragment-image-overlays beg end) + (progn + (message "LaTeX fragment images removed from section") + (throw 'exit nil)) + (setq msg "Creating images for section..."))))) + (let ((file (buffer-file-name (buffer-base-buffer)))) + (org-format-latex + (concat org-preview-latex-image-directory "org-ltximg") + beg end + ;; Emacs cannot overlay images from remote hosts. Create + ;; it in `temporary-file-directory' instead. + (if (or (not file) (file-remote-p file)) + temporary-file-directory + default-directory) + 'overlays msg 'forbuffer org-preview-latex-default-process)) (message (concat msg "done"))))))) (defun org-format-latex - (prefix &optional dir overlays msg forbuffer processing-type) - "Replace LaTeX fragments with links to an image, and produce images. + (prefix &optional beg end dir overlays msg forbuffer processing-type) + "Replace LaTeX fragments with links to an image. + +The function takes care of creating the replacement image. + +Only consider fragments between BEG and END when those are +provided. When optional argument OVERLAYS is non-nil, display the image on top of the fragment instead of replacing it. @@ -19104,11 +19219,11 @@ Some of the options can be changed using the variable (let* ((math-regexp "\\$\\|\\\\[([]\\|^[ \t]*\\\\begin{[A-Za-z0-9*]+}") (cnt 0) checkdir-flag) - (goto-char (point-min)) + (goto-char (or beg (point-min))) ;; Optimize overlay creation: (info "(elisp) Managing Overlays"). (when (and overlays (memq processing-type '(dvipng imagemagick))) - (overlay-recenter (point-max))) - (while (re-search-forward math-regexp nil t) + (overlay-recenter (or end (point-max)))) + (while (re-search-forward math-regexp end t) (unless (and overlays (eq (get-char-property (point) 'org-overlay-type) 'org-latex-overlay)) @@ -19122,85 +19237,88 @@ Some of the options can be changed using the variable (goto-char (org-element-property :end context)) (skip-chars-backward " \r\t\n") (point)))) - (case processing-type - (mathjax - ;; Prepare for MathJax processing. - (if (not (string-match "\\`\\$\\$?" value)) - (goto-char end) - (delete-region beg end) - (if (string= (match-string 0 value) "$$") - (insert "\\[" (substring value 2 -2) "\\]") - (insert "\\(" (substring value 1 -1) "\\)")))) - ((dvipng imagemagick) - ;; Process to an image. - (incf cnt) - (goto-char beg) - (let* ((face (face-at-point)) - ;; Get the colors from the face at point. - (fg - (let ((color (plist-get org-format-latex-options - :foreground))) - (if (and forbuffer (eq color 'auto)) - (face-attribute face :foreground nil 'default) - color))) - (bg - (let ((color (plist-get org-format-latex-options - :background))) - (if (and forbuffer (eq color 'auto)) - (face-attribute face :background nil 'default) - color))) - (hash (sha1 (prin1-to-string - (list org-format-latex-header - org-latex-default-packages-alist - org-latex-packages-alist - org-format-latex-options - forbuffer value fg bg)))) - (absprefix (expand-file-name prefix dir)) - (linkfile (format "%s_%s.png" prefix hash)) - (movefile (format "%s_%s.png" absprefix hash)) - (sep (and block-type "\n\n")) - (link (concat sep "[[file:" linkfile "]]" sep)) - (options - (org-combine-plists - org-format-latex-options - `(:foreground ,fg :background ,bg)))) - (when msg (message msg cnt)) - (unless checkdir-flag ; Ensure the directory exists. - (setq checkdir-flag t) - (let ((todir (file-name-directory absprefix))) - (unless (file-directory-p todir) - (make-directory todir t)))) - (unless (file-exists-p movefile) - (org-create-formula-image - value movefile options forbuffer processing-type)) - (if overlays - (progn - (dolist (o (overlays-in beg end)) - (when (eq (overlay-get o 'org-overlay-type) - 'org-latex-overlay) - (delete-overlay o))) - (org--format-latex-make-overlay beg end movefile) - (goto-char end)) - (delete-region beg end) - (insert - (org-add-props link - (list 'org-latex-src - (replace-regexp-in-string "\"" "" value) - 'org-latex-src-embed-type - (if block-type 'paragraph 'character))))))) - (mathml - ;; Process to MathML. - (unless (org-format-latex-mathml-available-p) - (user-error "LaTeX to MathML converter not configured")) - (incf cnt) - (when msg (message msg cnt)) - (goto-char beg) - (delete-region beg end) - (insert (org-format-latex-as-mathml - value block-type prefix dir))) - (otherwise - (error "Unknown conversion type %s for LaTeX fragments" - processing-type))))))))))) + (cond + ((eq processing-type 'mathjax) + ;; Prepare for MathJax processing. + (if (not (string-match "\\`\\$\\$?" value)) + (goto-char end) + (delete-region beg end) + (if (string= (match-string 0 value) "$$") + (insert "\\[" (substring value 2 -2) "\\]") + (insert "\\(" (substring value 1 -1) "\\)")))) + ((assq processing-type org-preview-latex-process-alist) + ;; Process to an image. + (cl-incf cnt) + (goto-char beg) + (let* ((processing-info + (cdr (assq processing-type org-preview-latex-process-alist))) + (face (face-at-point)) + ;; Get the colors from the face at point. + (fg + (let ((color (plist-get org-format-latex-options + :foreground))) + (if (and forbuffer (eq color 'auto)) + (face-attribute face :foreground nil 'default) + color))) + (bg + (let ((color (plist-get org-format-latex-options + :background))) + (if (and forbuffer (eq color 'auto)) + (face-attribute face :background nil 'default) + color))) + (hash (sha1 (prin1-to-string + (list org-format-latex-header + org-latex-default-packages-alist + org-latex-packages-alist + org-format-latex-options + forbuffer value fg bg)))) + (imagetype (or (plist-get processing-info :image-output-type) "png")) + (absprefix (expand-file-name prefix dir)) + (linkfile (format "%s_%s.%s" prefix hash imagetype)) + (movefile (format "%s_%s.%s" absprefix hash imagetype)) + (sep (and block-type "\n\n")) + (link (concat sep "[[file:" linkfile "]]" sep)) + (options + (org-combine-plists + org-format-latex-options + `(:foreground ,fg :background ,bg)))) + (when msg (message msg cnt)) + (unless checkdir-flag ; Ensure the directory exists. + (setq checkdir-flag t) + (let ((todir (file-name-directory absprefix))) + (unless (file-directory-p todir) + (make-directory todir t)))) + (unless (file-exists-p movefile) + (org-create-formula-image + value movefile options forbuffer processing-type)) + (if overlays + (progn + (dolist (o (overlays-in beg end)) + (when (eq (overlay-get o 'org-overlay-type) + 'org-latex-overlay) + (delete-overlay o))) + (org--format-latex-make-overlay beg end movefile imagetype) + (goto-char end)) + (delete-region beg end) + (insert + (org-add-props link + (list 'org-latex-src + (replace-regexp-in-string "\"" "" value) + 'org-latex-src-embed-type + (if block-type 'paragraph 'character))))))) + ((eq processing-type 'mathml) + ;; Process to MathML. + (unless (org-format-latex-mathml-available-p) + (user-error "LaTeX to MathML converter not configured")) + (cl-incf cnt) + (when msg (message msg cnt)) + (goto-char beg) + (delete-region beg end) + (insert (org-format-latex-as-mathml + value block-type prefix dir))) + (t + (error "Unknown conversion process %s for LaTeX fragments" + processing-type))))))))))) (defun org-create-math-formula (latex-frag &optional mathml-file) "Convert LATEX-FRAG to MathML and store it in MATHML-FILE. @@ -19216,22 +19334,24 @@ inspection." (region-beginning) (region-end))))) (read-string "LaTeX Fragment: " frag nil frag)))) (unless latex-frag (user-error "Invalid LaTeX fragment")) - (let* ((tmp-in-file (file-relative-name - (make-temp-name (expand-file-name "ltxmathml-in")))) - (ignore (write-region latex-frag nil tmp-in-file)) + (let* ((tmp-in-file + (let ((file (file-relative-name + (make-temp-name (expand-file-name "ltxmathml-in"))))) + (write-region latex-frag nil file) + file)) (tmp-out-file (file-relative-name (make-temp-name (expand-file-name "ltxmathml-out")))) (cmd (format-spec org-latex-to-mathml-convert-command `((?j . ,(and org-latex-to-mathml-jar-file - (shell-quote-argument - (expand-file-name - org-latex-to-mathml-jar-file)))) + (shell-quote-argument + (expand-file-name + org-latex-to-mathml-jar-file)))) (?I . ,(shell-quote-argument tmp-in-file)) (?i . ,latex-frag) (?o . ,(shell-quote-argument tmp-out-file))))) mathml shell-command-output) - (when (org-called-interactively-p 'any) + (when (called-interactively-p 'any) (unless (org-format-latex-mathml-available-p) (user-error "LaTeX to MathML converter not configured"))) (message "Running %s" cmd) @@ -19255,7 +19375,7 @@ inspection." (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml)) (when mathml-file (write-region mathml nil mathml-file)) - (when (org-called-interactively-p 'any) + (when (called-interactively-p 'any) (message mathml))) ((message "LaTeX to MathML conversion failed") (message shell-command-output))) @@ -19294,31 +19414,6 @@ inspection." ;; Failed conversion. Return the LaTeX fragment verbatim latex-frag))) -(defun org-create-formula-image (string tofile options buffer &optional type) - "Create an image from LaTeX source using dvipng or convert. -This function calls either `org-create-formula-image-with-dvipng' -or `org-create-formula-image-with-imagemagick' depending on the -value of `org-latex-create-formula-image-program' or on the value -of the optional TYPE variable. - -Note: ultimately these two function should be combined as they -share a good deal of logic." - (org-check-external-command - "latex" "needed to convert LaTeX fragments to images") - (funcall - (case (or type org-latex-create-formula-image-program) - (dvipng - (org-check-external-command - "dvipng" "needed to convert LaTeX fragments to images") - #'org-create-formula-image-with-dvipng) - (imagemagick - (org-check-external-command - "convert" "you need to install imagemagick") - #'org-create-formula-image-with-imagemagick) - (t (error - "Invalid value of `org-latex-create-formula-image-program'"))) - string tofile options buffer)) - (declare-function org-export-get-backend "ox" (name)) (declare-function org-export--get-global-options "ox" (&optional backend)) (declare-function org-export--get-inbuffer-options "ox" (&optional backend)) @@ -19349,133 +19444,105 @@ horizontal and vertical directions." (/ (display-mm-height) 25.4))) (error "Attempt to calculate the dpi of a non-graphic display"))) -;; This function borrows from Ganesh Swami's latex2png.el -(defun org-create-formula-image-with-dvipng (string tofile options buffer) - "This calls dvipng." - (require 'ox-latex) - (let* ((tmpdir (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory)) +(defun org-create-formula-image + (string tofile options buffer &optional processing-type) + "Create an image from LaTeX source using external processes. + +The LaTeX STRING is saved to a temporary LaTeX file, then +converted to an image file by process PROCESSING-TYPE defined in +`org-preview-latex-process-alist'. A nil value defaults to +`org-preview-latex-default-process'. + +The generated image file is eventually moved to TOFILE. + +The OPTIONS argument controls the size, foreground color and +background color of the generated image. + +When BUFFER non-nil, this function is used for LaTeX previewing. +Otherwise, it is used to deal with LaTeX snippets showed in +a HTML file." + (let* ((processing-type (or processing-type + org-preview-latex-default-process)) + (processing-info + (cdr (assq processing-type org-preview-latex-process-alist))) + (programs (plist-get processing-info :programs)) + (error-message (or (plist-get processing-info :message) "")) + (use-xcolor (plist-get processing-info :use-xcolor)) + (image-input-type (plist-get processing-info :image-input-type)) + (image-output-type (plist-get processing-info :image-output-type)) + (post-clean (or (plist-get processing-info :post-clean) + '(".dvi" ".xdv" ".pdf" ".tex" ".aux" ".log" + ".svg" ".png" ".jpg" ".jpeg" ".out"))) + (latex-header (or (plist-get processing-info :latex-header) + (org-create-formula--latex-header))) + (latex-compiler (plist-get processing-info :latex-compiler)) + (image-converter (plist-get processing-info :image-converter)) + (tmpdir temporary-file-directory) (texfilebase (make-temp-name (expand-file-name "orgtex" tmpdir))) (texfile (concat texfilebase ".tex")) - (dvifile (concat texfilebase ".dvi")) - (pngfile (concat texfilebase ".png")) - (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) - ;; This assumes that the display has the same pixel width in - ;; the horizontal and vertical directions - (dpi (number-to-string (* scale (if buffer (org--get-display-dpi) 120)))) + (font-height (face-attribute 'default :height nil)) + (image-size-adjust (or (plist-get processing-info :image-size-adjust) + '(1.0 . 1.0))) + (scale (* (if buffer (car image-size-adjust) (cdr image-size-adjust)) + (or (plist-get options (if buffer :scale :html-scale)) 1.0))) + (dpi (* scale (floor (if buffer font-height 140.0)))) (fg (or (plist-get options (if buffer :foreground :html-foreground)) "Black")) (bg (or (plist-get options (if buffer :background :html-background)) - "Transparent"))) - (if (eq fg 'default) (setq fg (org-dvipng-color :foreground)) - (unless (string= fg "Transparent") (setq fg (org-dvipng-color-format fg)))) - (if (eq bg 'default) (setq bg (org-dvipng-color :background)) - (unless (string= bg "Transparent") (setq bg (org-dvipng-color-format bg)))) - (let ((latex-header (org-create-formula--latex-header))) + "Transparent")) + (log-buf (get-buffer-create "*Org Preview LaTeX Output*")) + (resize-mini-windows nil)) ;Fix Emacs flicker when creating image. + (dolist (program programs) + (org-check-external-command program error-message)) + (if use-xcolor + (progn (if (eq fg 'default) + (setq fg (org-latex-color :foreground)) + (setq fg (org-latex-color-format fg))) + (if (eq bg 'default) + (setq bg (org-latex-color :background)) + (setq bg (org-latex-color-format + (if (string= bg "Transparent") "white" bg)))) + (with-temp-file texfile + (insert latex-header) + (insert "\n\\begin{document}\n" + "\\definecolor{fg}{rgb}{" fg "}\n" + "\\definecolor{bg}{rgb}{" bg "}\n" + "\n\\pagecolor{bg}\n" + "\n{\\color{fg}\n" + string + "\n}\n" + "\n\\end{document}\n"))) + (if (eq fg 'default) + (setq fg (org-dvipng-color :foreground)) + (unless (string= fg "Transparent") + (setq fg (org-dvipng-color-format fg)))) + (if (eq bg 'default) + (setq bg (org-dvipng-color :background)) + (unless (string= bg "Transparent") + (setq bg (org-dvipng-color-format bg)))) (with-temp-file texfile (insert latex-header) (insert "\n\\begin{document}\n" string "\n\\end{document}\n"))) - (let ((dir default-directory)) - (ignore-errors - (cd tmpdir) - (call-process "latex" nil nil nil texfile)) - (cd dir)) - (if (not (file-exists-p dvifile)) - (progn (message "Failed to create dvi file from %s" texfile) nil) - (ignore-errors - (if (featurep 'xemacs) - (call-process "dvipng" nil nil nil - "-fg" fg "-bg" bg - "-T" "tight" - "-o" pngfile - dvifile) - (call-process "dvipng" nil nil nil - "-fg" fg "-bg" bg - "-D" dpi - ;;"-x" scale "-y" scale - "-T" "tight" - "-o" pngfile - dvifile))) - (if (not (file-exists-p pngfile)) - (if org-format-latex-signal-error - (error "Failed to create png file from %s" texfile) - (message "Failed to create png file from %s" texfile) - nil) - ;; Use the requested file name and clean up - (copy-file pngfile tofile 'replace) - (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do - (if (file-exists-p (concat texfilebase e)) - (delete-file (concat texfilebase e)))) - pngfile)))) - -(declare-function org-latex-compile "ox-latex" (texfile &optional snippet)) -(defun org-create-formula-image-with-imagemagick (string tofile options buffer) - "This calls convert, which is included into imagemagick." - (require 'ox-latex) - (let* ((tmpdir (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory)) - (texfilebase (make-temp-name - (expand-file-name "orgtex" tmpdir))) - (texfile (concat texfilebase ".tex")) - (pdffile (concat texfilebase ".pdf")) - (pngfile (concat texfilebase ".png")) - (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) - (dpi (number-to-string (* scale (if buffer (org--get-display-dpi) 120)))) - (fg (or (plist-get options (if buffer :foreground :html-foreground)) - "black")) - (bg (or (plist-get options (if buffer :background :html-background)) - "white"))) - (if (eq fg 'default) (setq fg (org-latex-color :foreground)) - (setq fg (org-latex-color-format fg))) - (if (eq bg 'default) (setq bg (org-latex-color :background)) - (setq bg (org-latex-color-format - (if (string= bg "Transparent") "white" bg)))) - (let ((latex-header (org-create-formula--latex-header))) - (with-temp-file texfile - (insert latex-header) - (insert "\n\\begin{document}\n" - "\\definecolor{fg}{rgb}{" fg "}\n" - "\\definecolor{bg}{rgb}{" bg "}\n" - "\n\\pagecolor{bg}\n" - "\n{\\color{fg}\n" - string - "\n}\n" - "\n\\end{document}\n"))) - (org-latex-compile texfile t) - (if (not (file-exists-p pdffile)) - (progn (message "Failed to create pdf file from %s" texfile) nil) - (ignore-errors - (if (featurep 'xemacs) - (call-process "convert" nil nil nil - "-density" "96" - "-trim" - "-antialias" - pdffile - "-quality" "100" - ;; "-sharpen" "0x1.0" - pngfile) - (call-process "convert" nil nil nil - "-density" dpi - "-trim" - "-antialias" - pdffile - "-quality" "100" - ;; "-sharpen" "0x1.0" - pngfile))) - (if (not (file-exists-p pngfile)) - (if org-format-latex-signal-error - (error "Failed to create png file from %s" texfile) - (message "Failed to create png file from %s" texfile) - nil) - ;; Use the requested file name and clean up - (copy-file pngfile tofile 'replace) - (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do - (if (file-exists-p (concat texfilebase e)) - (delete-file (concat texfilebase e)))) - pngfile)))) + + (let* ((err-msg (format "Please adjust '%s' part of \ +`org-preview-latex-process-alist'." + processing-type)) + (image-input-file + (org-compile-file + texfile latex-compiler image-input-type err-msg log-buf)) + (image-output-file + (org-compile-file + image-input-file image-converter image-output-type err-msg log-buf + `((?F . ,(shell-quote-argument fg)) + (?B . ,(shell-quote-argument bg)) + (?D . ,(shell-quote-argument (format "%s" dpi))) + (?S . ,(shell-quote-argument (format "%s" (/ dpi 140.0)))))))) + (copy-file image-output-file tofile 'replace) + (dolist (e post-clean) + (when (file-exists-p (concat texfilebase e)) + (delete-file (concat texfilebase e)))) + image-output-file))) (defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) "Fill a LaTeX header template TPL. @@ -19499,22 +19566,22 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." (setq rpl (if (or (match-end 1) (not def-pkg)) "" (org-latex-packages-to-string def-pkg snippets-p t)) tpl (replace-match rpl t t tpl)) - (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) + (when def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl) (setq rpl (if (or (match-end 1) (not pkg)) "" (org-latex-packages-to-string pkg snippets-p t)) tpl (replace-match rpl t t tpl)) - (if pkg (setq end - (concat end "\n" - (org-latex-packages-to-string pkg snippets-p))))) + (when pkg (setq end + (concat end "\n" + (org-latex-packages-to-string pkg snippets-p))))) (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl) (setq rpl (if (or (match-end 1) (not extra)) "" (concat extra "\n")) tpl (replace-match rpl t t tpl)) - (if (and extra (string-match "\\S-" extra)) - (setq end (concat end "\n" extra)))) + (when (and extra (string-match "\\S-" extra)) + (setq end (concat end "\n" extra)))) (if (string-match "\\S-" end) (concat tpl "\n" end) @@ -19538,35 +19605,21 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." (defun org-dvipng-color (attr) "Return a RGB color specification for dvipng." - (apply 'format "rgb %s %s %s" - (mapcar 'org-normalize-color - (if (featurep 'xemacs) - (color-rgb-components - (face-property 'default - (cond ((eq attr :foreground) 'foreground) - ((eq attr :background) 'background)))) - (color-values (face-attribute 'default attr nil)))))) + (org-dvipng-color-format (face-attribute 'default attr nil))) (defun org-dvipng-color-format (color-name) "Convert COLOR-NAME to a RGB color value for dvipng." - (apply 'format "rgb %s %s %s" + (apply #'format "rgb %s %s %s" (mapcar 'org-normalize-color (color-values color-name)))) (defun org-latex-color (attr) "Return a RGB color for the LaTeX color package." - (apply 'format "%s,%s,%s" - (mapcar 'org-normalize-color - (if (featurep 'xemacs) - (color-rgb-components - (face-property 'default - (cond ((eq attr :foreground) 'foreground) - ((eq attr :background) 'background)))) - (color-values (face-attribute 'default attr nil)))))) + (org-latex-color-format (face-attribute 'default attr nil))) (defun org-latex-color-format (color-name) "Convert COLOR-NAME to a RGB color value." - (apply 'format "%s,%s,%s" + (apply #'format "%s,%s,%s" (mapcar 'org-normalize-color (color-values color-name)))) @@ -19578,8 +19631,7 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." ;; Image display -(defvar org-inline-image-overlays nil) -(make-variable-buffer-local 'org-inline-image-overlays) +(defvar-local org-inline-image-overlays nil) (defun org-toggle-inline-images (&optional include-linked) "Toggle the display of inline images. @@ -19588,10 +19640,10 @@ INCLUDE-LINKED is passed to `org-display-inline-images'." (if org-inline-image-overlays (progn (org-remove-inline-images) - (when (org-called-interactively-p 'interactive) + (when (called-interactively-p 'interactive) (message "Inline image display turned off"))) (org-display-inline-images include-linked) - (when (org-called-interactively-p 'interactive) + (when (called-interactively-p 'interactive) (message (if org-inline-image-overlays (format "%d images displayed inline" (length org-inline-image-overlays)) @@ -19634,7 +19686,7 @@ boundaries." (org-with-wide-buffer (goto-char (or beg (point-min))) (let ((case-fold-search t) - (file-extension-re (org-image-file-name-regexp))) + (file-extension-re (image-file-name-regexp))) (while (re-search-forward "[][]\\[\\(?:file\\|[./~]\\)" end t) (let ((link (save-match-data (org-element-context)))) ;; Check if we're at an inline image. @@ -19644,8 +19696,8 @@ boundaries." (let ((parent (org-element-property :parent link))) (or (not (eq (org-element-type parent) 'link)) (not (cdr (org-element-contents parent))))) - (org-string-match-p file-extension-re - (org-element-property :path link))) + (string-match-p file-extension-re + (org-element-property :path link))) (let ((file (expand-file-name (org-link-unescape (org-element-property :path link))))) @@ -19716,10 +19768,7 @@ boundaries." (list 'org-display-inline-remove-overlay)) (push ov org-inline-image-overlays))))))))))))))) -(define-obsolete-function-alias - 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") - -(defun org-display-inline-remove-overlay (ov after beg end &optional len) +(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len) "Remove inline-display overlay if a corresponding region is modified." (let ((inhibit-modification-hooks t)) (when (and ov after) @@ -19729,7 +19778,7 @@ boundaries." (defun org-remove-inline-images () "Remove inline display of images." (interactive) - (mapc 'delete-overlay org-inline-image-overlays) + (mapc #'delete-overlay org-inline-image-overlays) (setq org-inline-image-overlays nil)) ;;;; Key bindings @@ -19751,6 +19800,7 @@ boundaries." 'org-next-visible-heading) (define-key org-mode-map [remap outline-previous-visible-heading] 'org-previous-visible-heading) +(define-key org-mode-map [remap show-children] 'org-show-children) ;; Outline functions from `outline-mode-prefix-map' that can not ;; be remapped in Org: @@ -19763,13 +19813,10 @@ boundaries." ;; | Outline function | key binding | Org replacement | ;; |------------------------------------+-------------+--------------------------| -;; | `outline-next-visible-heading' | `C-c C-n' | better: skip inlinetasks | -;; | `outline-previous-visible-heading' | `C-c C-p' | better: skip inlinetasks | ;; | `outline-up-heading' | `C-c C-u' | still same function | ;; | `outline-move-subtree-up' | overridden | better: org-shiftup | ;; | `outline-move-subtree-down' | overridden | better: org-shiftdown | ;; | `show-entry' | overridden | no replacement | -;; | `show-children' | `C-c C-i' | visibility cycling | ;; | `show-branches' | `C-c C-k' | still same function | ;; | `show-subtree' | overridden | visibility cycling | ;; | `show-all' | overridden | no replacement | @@ -19789,8 +19836,7 @@ boundaries." (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) (org-defkey org-mode-map "\M-\t" #'pcomplete) ;; The following line is necessary under Suse GNU/Linux -(unless (featurep 'xemacs) - (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) +(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab) (org-defkey org-mode-map [(shift tab)] 'org-shifttab) (define-key org-mode-map [backtab] 'org-shifttab) @@ -19823,17 +19869,14 @@ boundaries." ;; Babel keys (define-key org-mode-map org-babel-key-prefix org-babel-map) -(mapc (lambda (pair) - (define-key org-babel-map (car pair) (cdr pair))) - org-babel-key-bindings) +(dolist (pair org-babel-key-bindings) + (define-key org-babel-map (car pair) (cdr pair))) ;;; Extra keys for tty access. ;; We only set them when really needed because otherwise the ;; menus don't show the simple keys -(when (or org-use-extra-keys - (featurep 'xemacs) ;; because XEmacs supports multi-device stuff - (not window-system)) +(when (or org-use-extra-keys (not window-system)) (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down) (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return) @@ -19992,7 +20035,7 @@ boundaries." (org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) (org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort) (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) -(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) +(org-defkey org-mode-map "\C-c\C-xi" 'org-columns-insert-dblock) (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) (org-defkey org-mode-map "\C-c\C-x." 'org-timer) @@ -20011,10 +20054,6 @@ boundaries." (define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation) -(when (featurep 'xemacs) - (org-defkey org-mode-map 'button3 'popup-mode-menu)) - - (defconst org-speed-commands-default '( ("Outline Navigation") @@ -20095,10 +20134,10 @@ boundaries." (user-error "Speed commands are not activated, customize `org-use-speed-commands'") (with-output-to-temp-buffer "*Help*" (princ "User-defined Speed commands\n===========================\n") - (mapc 'org-print-speed-command org-speed-commands-user) + (mapc #'org-print-speed-command org-speed-commands-user) (princ "\n") (princ "Built-in Speed commands\n=======================\n") - (mapc 'org-print-speed-command org-speed-commands-default)) + (mapc #'org-print-speed-command org-speed-commands-default)) (with-current-buffer "*Help*" (setq truncate-lines t)))) @@ -20117,9 +20156,6 @@ If not, return to the original position and throw an error." (defvar org-table-auto-blank-field) ; defined in org-table.el (defvar org-speed-command nil) -(define-obsolete-function-alias - 'org-speed-command-default-hook 'org-speed-command-activate "24.3") - (defun org-speed-command-activate (keys) "Hook for activating single-letter speed commands. `org-speed-commands-default' specifies a minimal command set. @@ -20130,9 +20166,6 @@ Use `org-speed-commands-user' for further customization." (cdr (assoc keys (append org-speed-commands-user org-speed-commands-default))))) -(define-obsolete-function-alias - 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3") - (defun org-babel-speed-command-activate (keys) "Hook for activating single-letter code block commands." (when (and (bolp) (looking-at org-babel-src-block-regexp)) @@ -20181,7 +20214,7 @@ overwritten, and the table is not marked as requiring realignment." (t (let (org-use-speed-commands) (call-interactively 'org-self-insert-command))))) ((and - (org-table-p) + (org-at-table-p) (progn ;; Check if we blank the field, and if that triggers align. (and (featurep 'org-table) org-table-auto-blank-field @@ -20204,71 +20237,75 @@ overwritten, and the table is not marked as requiring realignment." (setq org-table-may-need-update t) (self-insert-command N) (org-fix-tags-on-the-fly) - (if org-self-insert-cluster-for-undo - (if (not (eq last-command 'org-self-insert-command)) + (when org-self-insert-cluster-for-undo + (if (not (eq last-command 'org-self-insert-command)) + (setq org-self-insert-command-undo-counter 1) + (if (>= org-self-insert-command-undo-counter 20) (setq org-self-insert-command-undo-counter 1) - (if (>= org-self-insert-command-undo-counter 20) - (setq org-self-insert-command-undo-counter 1) - (and (> org-self-insert-command-undo-counter 0) - buffer-undo-list (listp buffer-undo-list) - (not (cadr buffer-undo-list)) ; remove nil entry - (setcdr buffer-undo-list (cddr buffer-undo-list))) - (setq org-self-insert-command-undo-counter - (1+ org-self-insert-command-undo-counter)))))))) + (and (> org-self-insert-command-undo-counter 0) + buffer-undo-list (listp buffer-undo-list) + (not (cadr buffer-undo-list)) ; remove nil entry + (setcdr buffer-undo-list (cddr buffer-undo-list))) + (setq org-self-insert-command-undo-counter + (1+ org-self-insert-command-undo-counter)))))))) (defun org-check-before-invisible-edit (kind) "Check is editing if kind KIND would be dangerous with invisible text around. The detailed reaction depends on the user option `org-catch-invisible-edits'." ;; First, try to get out of here as quickly as possible, to reduce overhead - (if (and org-catch-invisible-edits - (or (not (boundp 'visible-mode)) (not visible-mode)) - (or (get-char-property (point) 'invisible) - (get-char-property (max (point-min) (1- (point))) 'invisible))) - ;; OK, we need to take a closer look - (let* ((invisible-at-point (get-char-property (point) 'invisible)) - (invisible-before-point (if (bobp) nil (get-char-property - (1- (point)) 'invisible))) - (border-and-ok-direction - (or - ;; Check if we are acting predictably before invisible text - (and invisible-at-point (not invisible-before-point) - (memq kind '(insert delete-backward))) - ;; Check if we are acting predictably after invisible text - ;; This works not well, and I have turned it off. It seems - ;; better to always show and stop after invisible text. - ;; (and (not invisible-at-point) invisible-before-point - ;; (memq kind '(insert delete))) - ))) - (when (or (memq invisible-at-point '(outline org-hide-block t)) - (memq invisible-before-point '(outline org-hide-block t))) - (if (eq org-catch-invisible-edits 'error) - (user-error "Editing in invisible areas is prohibited, make them visible first")) - (if (and org-custom-properties-overlays - (y-or-n-p "Display invisible properties in this buffer? ")) - (org-toggle-custom-properties-visibility) - ;; Make the area visible - (save-excursion - (if invisible-before-point - (goto-char (previous-single-char-property-change - (point) 'invisible))) - (outline-show-subtree)) - (cond - ((eq org-catch-invisible-edits 'show) - ;; That's it, we do the edit after showing - (message - "Unfolding invisible region around point before editing") - (sit-for 1)) - ((and (eq org-catch-invisible-edits 'smart) - border-and-ok-direction) - (message "Unfolding invisible region around point before editing")) - (t - ;; Don't do the edit, make the user repeat it in full visibility - (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) + (when (and org-catch-invisible-edits + (or (not (boundp 'visible-mode)) (not visible-mode)) + (or (get-char-property (point) 'invisible) + (get-char-property (max (point-min) (1- (point))) 'invisible))) + ;; OK, we need to take a closer look + (let* ((invisible-at-point (get-char-property (point) 'invisible)) + (invisible-before-point (unless (bobp) (get-char-property + (1- (point)) 'invisible))) + (border-and-ok-direction + (or + ;; Check if we are acting predictably before invisible text + (and invisible-at-point (not invisible-before-point) + (memq kind '(insert delete-backward))) + ;; Check if we are acting predictably after invisible text + ;; This works not well, and I have turned it off. It seems + ;; better to always show and stop after invisible text. + ;; (and (not invisible-at-point) invisible-before-point + ;; (memq kind '(insert delete))) + ))) + (when (or (memq invisible-at-point '(outline org-hide-block t)) + (memq invisible-before-point '(outline org-hide-block t))) + (when (eq org-catch-invisible-edits 'error) + (user-error "Editing in invisible areas is prohibited, make them visible first")) + (if (and org-custom-properties-overlays + (y-or-n-p "Display invisible properties in this buffer? ")) + (org-toggle-custom-properties-visibility) + ;; Make the area visible + (save-excursion + (when invisible-before-point + (goto-char (previous-single-char-property-change + (point) 'invisible))) + (outline-show-subtree)) + (cond + ((eq org-catch-invisible-edits 'show) + ;; That's it, we do the edit after showing + (message + "Unfolding invisible region around point before editing") + (sit-for 1)) + ((and (eq org-catch-invisible-edits 'smart) + border-and-ok-direction) + (message "Unfolding invisible region around point before editing")) + (t + ;; Don't do the edit, make the user repeat it in full visibility + (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) (defun org-fix-tags-on-the-fly () - (when (and (equal (char-after (point-at-bol)) ?*) + "Align tags in headline at point. +Unlike to `org-set-tags', it ignores region and sorting." + (when (and (eq (char-after (line-beginning-position)) ?*) ;short-circuit (org-at-heading-p)) - (org-align-tags-here org-tags-column))) + (let ((org-ignore-region t) + (org-tags-sort-function nil)) + (org-set-tags nil t)))) (defun org-delete-backward-char (N) "Like `delete-backward-char', insert whitespace at field end in tables. @@ -20279,7 +20316,7 @@ because, in this case the deletion might narrow the column." (interactive "p") (save-match-data (org-check-before-invisible-edit 'delete-backward) - (if (and (org-table-p) + (if (and (org-at-table-p) (eq N 1) (string-match "|" (buffer-substring (point-at-bol) (point))) (looking-at ".*?|")) @@ -20287,14 +20324,13 @@ because, in this case the deletion might narrow the column." (noalign (looking-at "[^|\n\r]* |")) (c org-table-may-need-update)) (backward-delete-char N) - (if (not overwrite-mode) - (progn - (skip-chars-forward "^|") - (insert " ") - (goto-char (1- pos)))) + (unless overwrite-mode + (skip-chars-forward "^|") + (insert " ") + (goto-char (1- pos))) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) + (when noalign (setq org-table-may-need-update c))) (backward-delete-char N) (org-fix-tags-on-the-fly)))) @@ -20307,7 +20343,7 @@ because, in this case the deletion might narrow the column." (interactive "p") (save-match-data (org-check-before-invisible-edit 'delete) - (if (and (org-table-p) + (if (and (org-at-table-p) (not (bolp)) (not (= (char-after) ?|)) (eq N 1)) @@ -20320,12 +20356,12 @@ because, in this case the deletion might narrow the column." (goto-char pos) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) + (when noalign (setq org-table-may-need-update c))) (delete-char N)) (delete-char N) (org-fix-tags-on-the-fly)))) -;; Make `delete-selection-mode' work with org-mode and orgtbl-mode +;; Make `delete-selection-mode' work with Org mode and Orgtbl mode (put 'org-self-insert-command 'delete-selection (lambda () (not (run-hook-with-args-until-success @@ -20344,7 +20380,7 @@ because, in this case the deletion might narrow the column." (put 'org-delete-char 'flyspell-delayed t) (put 'org-delete-backward-char 'flyspell-delayed t) -;; Make pabbrev-mode expand after org-mode commands +;; Make pabbrev-mode expand after Org mode commands (put 'org-self-insert-command 'pabbrev-expand-after-command t) (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) @@ -20354,9 +20390,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (let (new old) (while commands (setq old (pop commands) new (pop commands)) - (if (fboundp 'command-remapping) - (org-defkey map (vector 'remap old) new) - (substitute-key-definition old new map global-map))))) + (org-defkey map (vector 'remap old) new)))) (defun org-transpose-words () "Transpose words for Org. @@ -20498,7 +20532,7 @@ See `org-ctrl-c-ctrl-c-hook' for more information.") (defun org-shiftselect-error () "Throw an error because Shift-Cursor command was applied in wrong context." (if (and (boundp 'shift-select-mode) shift-select-mode) - (user-error "To use shift-selection with Org-mode, customize `org-support-shift-select'") + (user-error "To use shift-selection with Org mode, customize `org-support-shift-select'") (user-error "This command works only in special context like headlines or timestamps"))) (defun org-call-for-shift-select (cmd) @@ -20553,7 +20587,7 @@ individual commands for more information." (call-interactively 'org-indent-item-tree)) (t (org-modifier-cursor-error)))) -(defun org-shiftmetaup (&optional arg) +(defun org-shiftmetaup (&optional _arg) "Drag the line at point up. In a table, kill the current row. On a clock timestamp, update the value of the timestamp like `S-<up>' @@ -20567,7 +20601,7 @@ Everywhere else, drag the line at point up." (call-interactively 'org-timestamp-up))) (t (call-interactively 'org-drag-line-backward)))) -(defun org-shiftmetadown (&optional arg) +(defun org-shiftmetadown (&optional _arg) "Drag the line at point down. In a table, insert an empty row at the current line. On a clock timestamp, update the value of the timestamp like `S-<down>' @@ -20585,7 +20619,7 @@ Everywhere else, drag the line at point down." (user-error "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>")) -(defun org-metaleft (&optional arg) +(defun org-metaleft (&optional _arg) "Promote heading, list item at point or move table column left. Calls `org-do-promote', `org-outdent-item' or `org-table-move-column', @@ -20619,13 +20653,13 @@ and returns at first non-nil value." (call-interactively 'org-outdent-item)) (t (call-interactively 'backward-word)))) -(defun org-metaright (&optional arg) +(defun org-metaright (&optional _arg) "Demote heading, list item at point or move table column right. In front of a drawer or a block keyword, indent it correctly. Calls `org-do-demote', `org-indent-item', `org-table-move-column', -`org-indnet-drawer' or `org-indent-block' depending on context. +`org-indent-drawer' or `org-indent-block' depending on context. With no specific context, calls the Emacs default `forward-word'. See the individual commands for more information. @@ -20680,11 +20714,11 @@ this function returns t, nil otherwise." (goto-char (point-at-eol)) (setq end (max end (point))) (while (re-search-forward re end t) - (if (get-char-property (match-beginning 0) 'invisible) - (throw 'exit t)))) + (when (get-char-property (match-beginning 0) 'invisible) + (throw 'exit t)))) nil)))) -(defun org-metaup (&optional arg) +(defun org-metaup (&optional _arg) "Move subtree up or move table row up. Calls `org-move-subtree-up' or `org-table-move-row' or `org-move-item-up', depending on context. See the individual commands @@ -20706,7 +20740,7 @@ for more information." ((org-at-item-p) (call-interactively 'org-move-item-up)) (t (org-drag-element-backward)))) -(defun org-metadown (&optional arg) +(defun org-metadown (&optional _arg) "Move subtree down or move table row down. Calls `org-move-subtree-down' or `org-table-move-row' or `org-move-item-down', depending on context. See the individual @@ -20952,19 +20986,19 @@ this numeric value." (defun org-copy-special () "Copy region in table or copy current subtree. -Calls `org-table-copy' or `org-copy-subtree', depending on context. -See the individual commands for more information." +Calls `org-table-copy-region' or `org-copy-subtree', depending on +context. See the individual commands for more information." (interactive) (call-interactively - (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) + (if (org-at-table-p) #'org-table-copy-region #'org-copy-subtree))) (defun org-cut-special () "Cut region in table or cut current subtree. -Calls `org-table-copy' or `org-cut-subtree', depending on context. -See the individual commands for more information." +Calls `org-table-cut-region' or `org-cut-subtree', depending on +context. See the individual commands for more information." (interactive) (call-interactively - (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree))) + (if (org-at-table-p) #'org-table-cut-region #'org-cut-subtree))) (defun org-paste-special (arg) "Paste rectangular region into table, or past subtree relative to level. @@ -20975,11 +21009,6 @@ See the individual commands for more information." (org-table-paste-rectangle) (org-paste-subtree arg))) -(defsubst org-in-fixed-width-region-p () - "Is point in a fixed-width region?" - (save-match-data - (eq 'fixed-width (org-element-type (org-element-at-point))))) - (defun org-edit-special (&optional arg) "Call a special editor for the element at point. When at a table, call the formula editor with `org-table-edit-formulas'. @@ -20992,23 +21021,22 @@ On a link, call `ffap' to visit the link at point. Otherwise, return a user error." (interactive "P") (let ((element (org-element-at-point))) - (assert (not buffer-read-only) nil - "Buffer is read-only: %s" (buffer-name)) - (case (org-element-type element) - (src-block + (barf-if-buffer-read-only) + (pcase (org-element-type element) + (`src-block (if (not arg) (org-edit-src-code) - (let* ((info (org-babel-get-src-block-info)) - (lang (nth 0 info)) - (params (nth 2 info)) - (session (cdr (assq :session params)))) - (if (not session) (org-edit-src-code) - ;; At a src-block with a session and function called with - ;; an ARG: switch to the buffer related to the inferior - ;; process. - (switch-to-buffer + (let* ((info (org-babel-get-src-block-info)) + (lang (nth 0 info)) + (params (nth 2 info)) + (session (cdr (assq :session params)))) + (if (not session) (org-edit-src-code) + ;; At a src-block with a session and function called with + ;; an ARG: switch to the buffer related to the inferior + ;; process. + (switch-to-buffer (funcall (intern (concat "org-babel-prep-session:" lang)) session params)))))) - (keyword + (`keyword (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE")) (org-open-link-from-string (format "[[%s]]" @@ -21022,23 +21050,24 @@ Otherwise, return a user error." (match-string 0 value)) (t (user-error "No valid file specified"))))))) (user-error "No special environment to edit here"))) - (table + (`table (if (eq (org-element-property :type element) 'table.el) (org-edit-table.el) (call-interactively 'org-table-edit-formulas))) ;; Only Org tables contain `table-row' type elements. - (table-row (call-interactively 'org-table-edit-formulas)) - (example-block (org-edit-src-code)) - (export-block (org-edit-export-block)) - (fixed-width (org-edit-fixed-width-region)) - (otherwise + (`table-row (call-interactively 'org-table-edit-formulas)) + (`example-block (org-edit-src-code)) + (`export-block (org-edit-export-block)) + (`fixed-width (org-edit-fixed-width-region)) + (_ ;; No notable element at point. Though, we may be at a link or ;; a footnote reference, which are objects. Thus, scan deeper. (let ((context (org-element-context element))) - (case (org-element-type context) - (link (call-interactively #'ffap)) - (footnote-reference (org-edit-footnote-reference)) - (t (user-error "No special environment to edit here")))))))) + (pcase (org-element-type context) + (`footnote-reference (org-edit-footnote-reference)) + (`inline-src-block (org-edit-inline-src-code)) + (`link (call-interactively #'ffap)) + (_ (user-error "No special environment to edit here")))))))) (defvar org-table-coordinate-overlays) ; defined in org-table.el (defun org-ctrl-c-ctrl-c (&optional arg) @@ -21087,180 +21116,196 @@ This command does many different things, depending on context: inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." (interactive "P") (cond - ((or (and (boundp 'org-clock-overlays) org-clock-overlays) - org-occur-highlights) - (and (boundp 'org-clock-overlays) (org-clock-remove-overlays)) + ((or (bound-and-true-p org-clock-overlays) org-occur-highlights) + (when (boundp 'org-clock-overlays) (org-clock-remove-overlays)) (org-remove-occur-highlights) (message "Temporary highlights/overlays removed from current buffer")) - ((and (local-variable-p 'org-finish-function (current-buffer)) + ((and (local-variable-p 'org-finish-function) (fboundp org-finish-function)) (funcall org-finish-function)) + ((org-babel-hash-at-point)) ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) + ((save-excursion (beginning-of-line) (looking-at-p "[ \t]*$")) + (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) + (user-error + (substitute-command-keys + "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))) (t - (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$")) - (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) - (user-error "C-c C-c can do nothing useful at this location")) - (let* ((context (org-element-context)) - (type (org-element-type context))) - (case type - ;; When at a link, act according to the parent instead. - (link (setq context (org-element-property :parent context)) - (setq type (org-element-type context))) - ;; Unsupported object types: refer to the first supported - ;; element or object containing it. - ((bold code entity export-snippet inline-babel-call inline-src-block - italic latex-fragment line-break macro strike-through subscript - superscript underline verbatim) - (setq context - (org-element-lineage - context '(radio-target paragraph verse-block table-cell))))) - ;; For convenience: at the first line of a paragraph on the - ;; same line as an item, apply function on that item instead. - (when (eq type 'paragraph) - (let ((parent (org-element-property :parent context))) - (when (and (eq (org-element-type parent) 'item) - (= (line-beginning-position) - (org-element-property :begin parent))) - (setq context parent type 'item)))) - ;; Act according to type of element or object at point. - (case type - (clock (org-clock-update-time-maybe)) - (dynamic-block - (save-excursion - (goto-char (org-element-property :post-affiliated context)) - (org-update-dblock))) - (footnote-definition + (let* ((context + (org-element-lineage + (org-element-context) + ;; Limit to supported contexts. + '(babel-call clock dynamic-block footnote-definition + footnote-reference inline-babel-call inline-src-block + item keyword node-property paragraph plain-list + property-drawer radio-target src-block + statistics-cookie table table-cell table-row + timestamp) + t)) + (type (org-element-type context))) + ;; For convenience: at the first line of a paragraph on the same + ;; line as an item, apply function on that item instead. + (when (eq type 'paragraph) + (let ((parent (org-element-property :parent context))) + (when (and (eq (org-element-type parent) 'item) + (= (line-beginning-position) + (org-element-property :begin parent))) + (setq context parent) + (setq type 'item)))) + ;; Act according to type of element or object at point. + (pcase type + ((or `babel-call `inline-babel-call) + (let ((info (org-babel-lob-get-info context))) + (when info (org-babel-execute-src-block nil info)))) + (`clock (org-clock-update-time-maybe)) + (`dynamic-block + (save-excursion (goto-char (org-element-property :post-affiliated context)) - (call-interactively 'org-footnote-action)) - (footnote-reference (call-interactively 'org-footnote-action)) - ((headline inlinetask) - (save-excursion (goto-char (org-element-property :begin context)) - (call-interactively 'org-set-tags))) - (item - ;; At an item: a double C-u set checkbox to "[-]" - ;; unconditionally, whereas a single one will toggle its - ;; presence. Without a universal argument, if the item - ;; has a checkbox, toggle it. Otherwise repair the list. - (let* ((box (org-element-property :checkbox context)) - (struct (org-element-property :structure context)) - (old-struct (copy-tree struct)) - (parents (org-list-parents-alist struct)) - (prevs (org-list-prevs-alist struct)) - (orderedp (org-not-nil (org-entry-get nil "ORDERED")))) - (org-list-set-checkbox - (org-element-property :begin context) struct - (cond ((equal arg '(16)) "[-]") - ((and (not box) (equal arg '(4))) "[ ]") - ((or (not box) (equal arg '(4))) nil) - ((eq box 'on) "[ ]") - (t "[X]"))) - ;; Mimic `org-list-write-struct' but with grabbing - ;; a return value from `org-list-struct-fix-box'. - (org-list-struct-fix-ind struct parents 2) - (org-list-struct-fix-item-end struct) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-fix-ind struct parents) - (let ((block-item - (org-list-struct-fix-box struct parents prevs orderedp))) - (if (and box (equal struct old-struct)) - (if (equal arg '(16)) - (message "Checkboxes already reset") - (user-error "Cannot toggle this checkbox: %s" - (if (eq box 'on) - "all subitems checked" - "unchecked subitems"))) - (org-list-struct-apply-struct struct old-struct) - (org-update-checkbox-count-maybe)) - (when block-item - (message "Checkboxes were removed due to empty box at line %d" - (org-current-line block-item)))))) - (keyword - (let ((org-inhibit-startup-visibility-stuff t) - (org-startup-align-all-tables nil)) - (when (boundp 'org-table-coordinate-overlays) - (mapc 'delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil)) - (org-save-outline-visibility 'use-markers (org-mode-restart))) - (message "Local setup has been refreshed")) - (plain-list - ;; At a plain list, with a double C-u argument, set - ;; checkboxes of each item to "[-]", whereas a single one - ;; will toggle their presence according to the state of the - ;; first item in the list. Without an argument, repair the - ;; list. - (let* ((begin (org-element-property :contents-begin context)) - (beginm (move-marker (make-marker) begin)) - (struct (org-element-property :structure context)) - (old-struct (copy-tree struct)) - (first-box (save-excursion - (goto-char begin) - (looking-at org-list-full-item-re) - (match-string-no-properties 3))) - (new-box (cond ((equal arg '(16)) "[-]") - ((equal arg '(4)) (unless first-box "[ ]")) - ((equal first-box "[X]") "[ ]") - (t "[X]")))) - (cond - (arg - (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box)) - (org-list-get-all-items - begin struct (org-list-prevs-alist struct)))) - ((and first-box (eq (point) begin)) - ;; For convenience, when point is at bol on the first - ;; item of the list and no argument is provided, simply - ;; toggle checkbox of that item, if any. - (org-list-set-checkbox begin struct new-box))) - (org-list-write-struct - struct (org-list-parents-alist struct) old-struct) - (org-update-checkbox-count-maybe) - (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) - ((property-drawer node-property) - (call-interactively 'org-property-action)) - ((radio-target target) - (call-interactively 'org-update-radio-target-regexp)) - (statistics-cookie - (call-interactively 'org-update-statistics-cookies)) - ((table table-cell table-row) - ;; At a table, recalculate every field and align it. Also - ;; send the table if necessary. If the table has - ;; a `table.el' type, just give up. At a table row or - ;; cell, maybe recalculate line but always align table. - (if (eq (org-element-property :type context) 'table.el) - (message "%s" (substitute-command-keys "\\<org-mode-map>\ -Use \\[org-edit-special] to edit table.el tables")) - (let ((org-enable-table-editor t)) - (if (or (eq type 'table) - ;; Check if point is at a TBLFM line. - (and (eq type 'table-row) - (= (point) (org-element-property :end context)))) - (save-excursion - (if (org-at-TBLFM-p) - (progn (require 'org-table) - (org-table-calc-current-TBLFM)) - (goto-char (org-element-property :contents-begin context)) - (org-call-with-arg 'org-table-recalculate (or arg t)) - (orgtbl-send-table 'maybe))) - (org-table-maybe-eval-formula) - (cond (arg (call-interactively 'org-table-recalculate)) - ((org-table-maybe-recalculate-line)) - (t (org-table-align))))))) - (timestamp (org-timestamp-change 0 'day)) - (otherwise - (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) - (user-error - "C-c C-c can do nothing useful at this location"))))))))) + (org-update-dblock))) + (`footnote-definition + (goto-char (org-element-property :post-affiliated context)) + (call-interactively 'org-footnote-action)) + (`footnote-reference (call-interactively #'org-footnote-action)) + ((or `headline `inlinetask) + (save-excursion (goto-char (org-element-property :begin context)) + (call-interactively #'org-set-tags))) + ((or `inline-src-block `src-block) + (unless org-babel-no-eval-on-ctrl-c-ctrl-c + (org-babel-eval-wipe-error-buffer) + (org-babel-execute-src-block + current-prefix-arg (org-babel-get-src-block-info nil context)))) + (`item + ;; At an item: `C-u C-u' sets checkbox to "[-]" + ;; unconditionally, whereas `C-u' will toggle its presence. + ;; Without a universal argument, if the item has a checkbox, + ;; toggle it. Otherwise repair the list. + (let* ((box (org-element-property :checkbox context)) + (struct (org-element-property :structure context)) + (old-struct (copy-tree struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (orderedp (org-not-nil (org-entry-get nil "ORDERED")))) + (org-list-set-checkbox + (org-element-property :begin context) struct + (cond ((equal arg '(16)) "[-]") + ((and (not box) (equal arg '(4))) "[ ]") + ((or (not box) (equal arg '(4))) nil) + ((eq box 'on) "[ ]") + (t "[X]"))) + ;; Mimic `org-list-write-struct' but with grabbing a return + ;; value from `org-list-struct-fix-box'. + (org-list-struct-fix-ind struct parents 2) + (org-list-struct-fix-item-end struct) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (let ((block-item + (org-list-struct-fix-box struct parents prevs orderedp))) + (if (and box (equal struct old-struct)) + (if (equal arg '(16)) + (message "Checkboxes already reset") + (user-error "Cannot toggle this checkbox: %s" + (if (eq box 'on) + "all subitems checked" + "unchecked subitems"))) + (org-list-struct-apply-struct struct old-struct) + (org-update-checkbox-count-maybe)) + (when block-item + (message "Checkboxes were removed due to empty box at line %d" + (org-current-line block-item)))))) + (`keyword + (let ((org-inhibit-startup-visibility-stuff t) + (org-startup-align-all-tables nil)) + (when (boundp 'org-table-coordinate-overlays) + (mapc #'delete-overlay org-table-coordinate-overlays) + (setq org-table-coordinate-overlays nil)) + (org-save-outline-visibility 'use-markers (org-mode-restart))) + (message "Local setup has been refreshed")) + (`plain-list + ;; At a plain list, with a double C-u argument, set + ;; checkboxes of each item to "[-]", whereas a single one + ;; will toggle their presence according to the state of the + ;; first item in the list. Without an argument, repair the + ;; list. + (let* ((begin (org-element-property :contents-begin context)) + (beginm (move-marker (make-marker) begin)) + (struct (org-element-property :structure context)) + (old-struct (copy-tree struct)) + (first-box (save-excursion + (goto-char begin) + (looking-at org-list-full-item-re) + (match-string-no-properties 3))) + (new-box (cond ((equal arg '(16)) "[-]") + ((equal arg '(4)) (unless first-box "[ ]")) + ((equal first-box "[X]") "[ ]") + (t "[X]")))) + (cond + (arg + (dolist (pos + (org-list-get-all-items + begin struct (org-list-prevs-alist struct))) + (org-list-set-checkbox pos struct new-box))) + ((and first-box (eq (point) begin)) + ;; For convenience, when point is at bol on the first + ;; item of the list and no argument is provided, simply + ;; toggle checkbox of that item, if any. + (org-list-set-checkbox begin struct new-box))) + (org-list-write-struct + struct (org-list-parents-alist struct) old-struct) + (org-update-checkbox-count-maybe) + (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) + ((or `property-drawer `node-property) + (call-interactively #'org-property-action)) + (`radio-target + (call-interactively #'org-update-radio-target-regexp)) + (`statistics-cookie + (call-interactively #'org-update-statistics-cookies)) + ((or `table `table-cell `table-row) + ;; At a table, recalculate every field and align it. Also + ;; send the table if necessary. If the table has + ;; a `table.el' type, just give up. At a table row or cell, + ;; maybe recalculate line but always align table. + (if (eq (org-element-property :type context) 'table.el) + (message "%s" (substitute-command-keys "\\<org-mode-map>\ +Use `\\[org-edit-special]' to edit table.el tables")) + (let ((org-enable-table-editor t)) + (if (or (eq type 'table) + ;; Check if point is at a TBLFM line. + (and (eq type 'table-row) + (= (point) (org-element-property :end context)))) + (save-excursion + (if (org-at-TBLFM-p) + (progn (require 'org-table) + (org-table-calc-current-TBLFM)) + (goto-char (org-element-property :contents-begin context)) + (org-call-with-arg 'org-table-recalculate (or arg t)) + (orgtbl-send-table 'maybe))) + (org-table-maybe-eval-formula) + (cond (arg (call-interactively #'org-table-recalculate)) + ((org-table-maybe-recalculate-line)) + (t (org-table-align))))))) + (`timestamp (org-timestamp-change 0 'day)) + ((and `nil (guard (org-at-heading-p))) + ;; When point is on an unsupported object type, we can miss + ;; the fact that it also is at a heading. Handle it here. + (call-interactively #'org-set-tags)) + ((guard + (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook))) + (_ + (user-error + (substitute-command-keys + "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))))))) (defun org-mode-restart () (interactive) - (let ((indent-status (org-bound-and-true-p org-indent-mode))) + (let ((indent-status (bound-and-true-p org-indent-mode))) (funcall major-mode) (hack-local-variables) - (when (and indent-status (not (org-bound-and-true-p org-indent-mode))) + (when (and indent-status (not (bound-and-true-p org-indent-mode))) (org-indent-mode -1))) (message "%s restarted" major-mode)) (defun org-kill-note-or-show-branches () - "If this is a Note buffer, abort storing the note. Else call `show-branches'." + "Abort storing current note, or call `outline-show-branches'." (interactive) (if (not org-finish-function) (progn @@ -21269,23 +21314,23 @@ Use \\[org-edit-special] to edit table.el tables")) (let ((org-note-abort t)) (funcall org-finish-function)))) -(defun org-delete-indentation (&optional ARG) +(defun org-delete-indentation (&optional arg) "Join current line to previous and fix whitespace at join. If previous line is a headline add to headline title. Otherwise the function calls `delete-indentation'. -With argument, join this line to following line." +With a non-nil optional argument, join it to the following one." (interactive "*P") (if (save-excursion - (if ARG (beginning-of-line) - (forward-line -1)) - (looking-at org-complex-heading-regexp)) + (beginning-of-line (if arg 1 0)) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp))) ;; At headline. (let ((tags-column (when (match-beginning 5) (save-excursion (goto-char (match-beginning 5)) (current-column)))) - (string (concat " " (progn (when ARG (forward-line 1)) + (string (concat " " (progn (when arg (forward-line 1)) (org-trim (delete-and-extract-region (line-beginning-position) (line-end-position))))))) @@ -21296,23 +21341,21 @@ With argument, join this line to following line." (skip-chars-backward " \t") (save-excursion (insert string)) ;; Adjust alignment of tags. - (when tags-column - (org-align-tags-here (if org-auto-align-tags - org-tags-column - tags-column)))) - (delete-indentation ARG))) + (cond + ((not tags-column)) ;no tags + (org-auto-align-tags (org-set-tags nil t)) + (t (org--align-tags-here tags-column)))) ;preserve tags column + (delete-indentation arg))) (defun org-open-line (n) "Insert a new row in tables, call `open-line' elsewhere. -If `org-special-ctrl-o' is nil, just call `open-line' everywhere." +If `org-special-ctrl-o' is nil, just call `open-line' everywhere. +As a special case, when a document starts with a table, allow to +call `open-line' on the very first character." (interactive "*p") - (cond - ((not org-special-ctrl-o) - (open-line n)) - ((org-at-table-p) - (org-table-insert-row)) - (t - (open-line n)))) + (if (and org-special-ctrl-o (/= (point) 1) (org-at-table-p)) + (org-table-insert-row) + (open-line n))) (defun org-return (&optional indent) "Goto next table row or insert a newline. @@ -21338,18 +21381,19 @@ object (e.g., within a comment). In these case, you need to use (org-element-lineage context '(table-row table-cell) t)) (org-table-justify-field-maybe) (call-interactively #'org-table-next-row)) - ;; On a link or a timestamp, call `org-open-line' if + ;; On a link or a timestamp, call `org-open-at-point' if ;; `org-return-follows-link' allows it. Tolerate fuzzy - ;; locations, e.g., in a comment, as `org-open-line'. + ;; locations, e.g., in a comment, as `org-open-at-point'. ((and org-return-follows-link - (or (org-at-timestamp-p t) - (org-at-date-range-p t) - (org-in-regexp org-any-link-re))) + (or (org-in-regexp org-ts-regexp-both nil t) + (org-in-regexp org-tsr-regexp-both nil t) + (org-in-regexp org-any-link-re nil t))) (call-interactively #'org-open-at-point)) ;; Insert newline in heading, but preserve tags. ((and (not (bolp)) (save-excursion (beginning-of-line) - (looking-at org-complex-heading-regexp))) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)))) ;; At headline. Split line. However, if point is on keyword, ;; priority cookie or tags, do not break any of them: add ;; a newline after the headline instead. @@ -21357,14 +21401,13 @@ object (e.g., within a comment). In these case, you need to use (save-excursion (goto-char (match-beginning 5)) (current-column)))) (string - (when (and (match-end 4) - (>= (point) - (or (match-end 3) (match-end 2) (1+ (match-end 1)))) - (<= (point) (match-end 4))) + (when (and (match-end 4) (org-point-in-group (point) 4)) (delete-and-extract-region (point) (match-end 4))))) - (when (and tags-column string) ; Adjust tag alignment. - (org-align-tags-here - (if org-auto-align-tags org-tags-column tags-column))) + ;; Adjust tag alignment. + (cond + ((not (and tags-column string))) + (org-auto-align-tags (org-set-tags nil t)) + (t (org--align-tags-here tags-column))) ;preserve tags column (end-of-line) (org-show-entry) (if indent (newline-and-indent) (newline)) @@ -21414,153 +21457,11 @@ Calls `org-table-insert-hline', `org-toggle-item', or (t (call-interactively 'org-toggle-item)))) -(defun org-toggle-item (arg) - "Convert headings or normal lines to items, items to normal lines. -If there is no active region, only the current line is considered. - -If the first non blank line in the region is a headline, convert -all headlines to items, shifting text accordingly. - -If it is an item, convert all items to normal lines. - -If it is normal text, change region into a list of items. -With a prefix argument ARG, change the region in a single item." - (interactive "P") - (let ((shift-text - (function - ;; Shift text in current section to IND, from point to END. - ;; The function leaves point to END line. - (lambda (ind end) - (let ((min-i 1000) (end (copy-marker end))) - ;; First determine the minimum indentation (MIN-I) of - ;; the text. - (save-excursion - (catch 'exit - (while (< (point) end) - (let ((i (org-get-indentation))) - (cond - ;; Skip blank lines and inline tasks. - ((looking-at "^[ \t]*$")) - ((looking-at org-outline-regexp-bol)) - ;; We can't find less than 0 indentation. - ((zerop i) (throw 'exit (setq min-i 0))) - ((< i min-i) (setq min-i i)))) - (forward-line)))) - ;; Then indent each line so that a line indented to - ;; MIN-I becomes indented to IND. Ignore blank lines - ;; and inline tasks in the process. - (let ((delta (- ind min-i))) - (while (< (point) end) - (unless (or (looking-at "^[ \t]*$") - (looking-at org-outline-regexp-bol)) - (org-indent-line-to (+ (org-get-indentation) delta))) - (forward-line))))))) - (skip-blanks - (function - ;; Return beginning of first non-blank line, starting from - ;; line at POS. - (lambda (pos) - (save-excursion - (goto-char pos) - (skip-chars-forward " \r\t\n") - (point-at-bol))))) - beg end) - ;; Determine boundaries of changes. - (if (org-region-active-p) - (setq beg (funcall skip-blanks (region-beginning)) - end (copy-marker (region-end))) - (setq beg (funcall skip-blanks (point-at-bol)) - end (copy-marker (point-at-eol)))) - ;; Depending on the starting line, choose an action on the text - ;; between BEG and END. - (org-with-limited-levels - (save-excursion - (goto-char beg) - (cond - ;; Case 1. Start at an item: de-itemize. Note that it only - ;; happens when a region is active: `org-ctrl-c-minus' - ;; would call `org-cycle-list-bullet' otherwise. - ((org-at-item-p) - (while (< (point) end) - (when (org-at-item-p) - (skip-chars-forward " \t") - (delete-region (point) (match-end 0))) - (forward-line))) - ;; Case 2. Start at an heading: convert to items. - ((org-at-heading-p) - (let* ((bul (org-list-bullet-string "-")) - (bul-len (length bul)) - (done (org-entry-is-done-p)) - (todo (org-entry-is-todo-p)) - ;; Indentation of the first heading. It should be - ;; relative to the indentation of its parent, if any. - (start-ind (save-excursion - (cond - ((not org-adapt-indentation) 0) - ((not (outline-previous-heading)) 0) - (t (length (match-string 0)))))) - ;; Level of first heading. Further headings will be - ;; compared to it to determine hierarchy in the list. - (ref-level (org-reduced-level (org-outline-level)))) - (when (or done todo) (org-todo "")) - (while (< (point) end) - (let* ((level (org-reduced-level (org-outline-level))) - (delta (max 0 (- level ref-level)))) - ;; If current headline is less indented than the first - ;; one, set it as reference, in order to preserve - ;; subtrees. - (when (< level ref-level) (setq ref-level level)) - (replace-match bul t t) - (org-indent-line-to (+ start-ind (* delta bul-len))) - (when (or done todo) - (let* ((struct (org-list-struct)) - (old (copy-tree struct))) - (org-list-set-checkbox (line-beginning-position) - struct - (if done "[X]" "[ ]")) - (org-list-write-struct struct - (org-list-parents-alist struct) - old))) - ;; Ensure all text down to END (or SECTION-END) belongs - ;; to the newly created item. - (let ((section-end (save-excursion - (or (outline-next-heading) (point))))) - (forward-line) - (funcall shift-text - (+ start-ind (* (1+ delta) bul-len)) - (min end section-end))))))) - ;; Case 3. Normal line with ARG: make the first line of region - ;; an item, and shift indentation of others lines to - ;; set them as item's body. - (arg (let* ((bul (org-list-bullet-string "-")) - (bul-len (length bul)) - (ref-ind (org-get-indentation))) - (skip-chars-forward " \t") - (insert bul) - (forward-line) - (while (< (point) end) - ;; Ensure that lines less indented than first one - ;; still get included in item body. - (funcall shift-text - (+ ref-ind bul-len) - (min end (save-excursion (or (outline-next-heading) - (point))))) - (forward-line)))) - ;; Case 4. Normal line without ARG: turn each non-item line - ;; into an item. - (t - (while (< (point) end) - (unless (or (org-at-heading-p) (org-at-item-p)) - (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match - (concat "\\1" (org-list-bullet-string "-") "\\2")))) - (forward-line)))))))) - (defun org-toggle-heading (&optional nstars) "Convert headings to normal text, or items or text to headings. If there is no active region, only convert the current line. -With a \\[universal-argument] prefix, convert the whole list at +With a `\\[universal-argument]' prefix, convert the whole list at point into heading. In a region: @@ -21596,7 +21497,7 @@ number of stars to add." ;; do not consider the last line to be in the region. (when (and current-prefix-arg (org-at-item-p)) - (if (listp current-prefix-arg) (setq current-prefix-arg 1)) + (when (listp current-prefix-arg) (setq current-prefix-arg 1)) (org-mark-element)) (if (org-region-active-p) @@ -21625,10 +21526,11 @@ number of stars to add." (when (org-at-item-p) ;; Pay attention to cases when region ends before list. (let* ((struct (org-list-struct)) - (list-end (min (org-list-get-bottom-point struct) (1+ end)))) + (list-end + (min (org-list-get-bottom-point struct) (1+ end)))) (save-restriction (narrow-to-region (point) list-end) - (insert (org-list-to-subtree (org-list-parse-list t))))) + (insert (org-list-to-subtree (org-list-to-lisp t)) "\n"))) (setq toggled t)) (forward-line))) ;; Case 3. Started at normal text: make every line an heading, @@ -21642,7 +21544,7 @@ number of stars to add." (org-odd-levels-only "**") ; inside heading, odd (t "*"))) ; inside heading, oddeven (rpl (concat stars add-stars " ")) - (lend (if (listp nstars) (save-excursion (end-of-line) (point))))) + (lend (when (listp nstars) (save-excursion (end-of-line) (point))))) (while (< (point) (if (equal nstars '(4)) lend end)) (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p))) (looking-at "\\([ \t]*\\)\\(\\S-\\)")) @@ -21667,7 +21569,7 @@ on context. See the individual commands for more information." (and (not (org-before-first-heading-p)) (not (org-at-table-p)))) -;; Define the Org-mode menus +;; Define the Org mode menus (easy-menu-define org-tbl-menu org-mode-map "Tbl menu" '("Tbl" ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)] @@ -21714,11 +21616,11 @@ on context. See the individual commands for more information." ["Which Column?" org-table-current-column (org-at-table-p)]) ["Debug Formulas" org-table-toggle-formula-debugger - :style toggle :selected (org-bound-and-true-p org-table-formula-debug)] + :style toggle :selected (bound-and-true-p org-table-formula-debug)] ["Show Col/Row Numbers" org-table-toggle-coordinate-overlays :style toggle - :selected (org-bound-and-true-p org-table-overlay-coordinates)] + :selected (bound-and-true-p org-table-overlay-coordinates)] "--" ["Create" org-table-create (and (not (org-at-table-p)) org-enable-table-editor)] @@ -21842,7 +21744,7 @@ on context. See the individual commands for more information." "--" ["Set property" org-set-property (not (org-before-first-heading-p))] ["Column view of properties" org-columns t] - ["Insert Column View DBlock" org-insert-columns-dblock t]) + ["Insert Column View DBlock" org-columns-insert-dblock t]) ("Dates and Scheduling" ["Timestamp" org-time-stamp (not (org-before-first-heading-p))] ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))] @@ -21903,9 +21805,7 @@ on context. See the individual commands for more information." ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] ["Modify math symbol" org-cdlatex-math-modify (org-inside-LaTeX-fragment-p)] - ["Insert citation" org-reftex-citation t] - "--" - ["Template for BEAMER" (org-beamer-insert-options-template) t]) + ["Insert citation" org-reftex-citation t]) "--" ("MobileOrg" ["Push Files and Views" org-mobile-push t] @@ -21931,20 +21831,20 @@ on context. See the individual commands for more information." )) (defun org-info (&optional node) - "Read documentation for Org-mode in the info system. + "Read documentation for Org in the info system. With optional NODE, go directly to that node." (interactive) (info (format "(org)%s" (or node "")))) ;;;###autoload (defun org-submit-bug-report () - "Submit a bug report on Org-mode via mail. + "Submit a bug report on Org via mail. Don't hesitate to report any problems or inaccurate documentation. If you don't have setup sending mail from (X)Emacs, please copy the output buffer into your mail program, as it gives us important -information about your Org-mode version and configuration." +information about your Org version and configuration." (interactive) (require 'reporter) (defvar reporter-prompt-for-summary-p) @@ -21956,12 +21856,12 @@ information about your Org-mode version and configuration." (org-version nil 'full) (let (list) (save-window-excursion - (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) + (pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) (delete-other-windows) (erase-buffer) - (insert "You are about to submit a bug report to the Org-mode mailing list. + (insert "You are about to submit a bug report to the Org mailing list. -We would like to add your full Org-mode and Outline configuration to the +We would like to add your full Org and Outline configuration to the bug report. This greatly simplifies the work of the maintainer and other experts on the mailing list. @@ -21971,7 +21871,7 @@ appear in the form of file names, tags, todo states, or search strings. If you answer yes to the prompt, you might want to check and remove such private information before sending the email.") (add-text-properties (point-min) (point-max) '(face org-warning)) - (when (yes-or-no-p "Include your Org-mode configuration ") + (when (yes-or-no-p "Include your Org configuration ") (mapatoms (lambda (v) (and (boundp v) @@ -21990,11 +21890,11 @@ what in fact did happen. You don't know how to make a good report? See http://orgmode.org/manual/Feedback.html#Feedback -Your bug report will be posted to the Org-mode mailing list. +Your bug report will be posted to the Org mailing list. ------------------------------------------------------------------------") (save-excursion - (if (re-search-backward "^\\(Subject: \\)Org-mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t) - (replace-match "\\1Bug: \\3 [\\2]"))))) + (when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t) + (replace-match "\\1Bug: \\3 [\\2]"))))) (defun org-install-agenda-files-menu () @@ -22002,7 +21902,7 @@ Your bug report will be posted to the Org-mode mailing list. (save-excursion (while bl (set-buffer (pop bl)) - (if (derived-mode-p 'org-mode) (setq bl nil))) + (when (derived-mode-p 'org-mode) (setq bl nil))) (when (derived-mode-p 'org-mode) (easy-menu-change '("Org") "File List for Agenda" @@ -22020,7 +21920,7 @@ Your bug report will be posted to the Org-mode mailing list. (defun org-require-autoloaded-modules () (interactive) - (mapc 'require + (mapc #'require '(org-agenda org-archive org-attach org-clock org-colview org-id org-table org-timer))) @@ -22033,13 +21933,8 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (let* ((org-dir (org-find-library-dir "org")) (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir)) (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?") - (remove-re (mapconcat 'identity - (mapcar (lambda (f) (concat "^" f "$")) - (list (if (featurep 'xemacs) - "org-colview" - "org-colview-xemacs") - "org" "org-loaddefs" "org-version")) - "\\|")) + (remove-re (format "\\`%s\\'" + (regexp-opt '("org" "org-loaddefs" "org-version")))) (feats (delete-dups (mapcar 'file-name-sans-extension (mapcar 'file-name-nondirectory @@ -22071,9 +21966,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions." 't) f)) lfeat))) - (if load-uncore - (message "The following feature%s found in load-path, please check if that's correct:\n%s" - (if (> (length load-uncore) 1) "s were" " was") load-uncore)) + (when load-uncore + (message "The following feature%s found in load-path, please check if that's correct:\n%s" + (if (> (length load-uncore) 1) "s were" " was") load-uncore)) (if load-misses (message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s" (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full)) @@ -22088,7 +21983,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (customize-browse 'org)) (defun org-create-customize-menu () - "Create a full customization menu for Org-mode, insert it into the menu." + "Create a full customization menu for Org mode, insert it into the menu." (interactive) (org-load-modules-maybe) (org-require-autoloaded-modules) @@ -22111,7 +22006,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions." ;;; Generally useful functions -(defsubst org-get-at-eol (property n) +(defun org-get-at-eol (property n) "Get text property PROPERTY at the end of line less N characters." (get-text-property (- (point-at-eol) n) property)) @@ -22121,19 +22016,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (get-text-property (or (next-single-property-change 0 prop s) 0) prop s))) -(defun org-display-warning (message) ;; Copied from Emacs-Muse +(defun org-display-warning (message) "Display the given MESSAGE as a warning." - (if (fboundp 'display-warning) - (display-warning 'org message - (if (featurep 'xemacs) 'warning :warning)) - (let ((buf (get-buffer-create "*Org warnings*"))) - (with-current-buffer buf - (goto-char (point-max)) - (insert "Warning (Org): " message) - (unless (bolp) - (newline))) - (display-buffer buf) - (sit-for 0)))) + (display-warning 'org message :warning)) (defun org-eval (form) "Eval FORM and return result." @@ -22159,14 +22044,35 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (<= (point) (match-end 4)) (member (match-string 3) '("=" "~"))))) +(defun org-overlay-display (ovl text &optional face evap) + "Make overlay OVL display TEXT with face FACE." + (overlay-put ovl 'display text) + (if face (overlay-put ovl 'face face)) + (if evap (overlay-put ovl 'evaporate t))) + +(defun org-overlay-before-string (ovl text &optional face evap) + "Make overlay OVL display TEXT with face FACE." + (if face (org-add-props text nil 'face face)) + (overlay-put ovl 'before-string text) + (if evap (overlay-put ovl 'evaporate t))) + +(defun org-find-overlays (prop &optional pos delete) + "Find all overlays specifying PROP at POS or point. +If DELETE is non-nil, delete all those overlays." + (let (found) + (dolist (ov (overlays-at (or pos (point))) found) + (cond ((not (overlay-get ov prop))) + (delete (delete-overlay ov)) + (t (push ov found)))))) + (defun org-goto-marker-or-bmk (marker &optional bookmark) "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." (if (and marker (marker-buffer marker) (buffer-live-p (marker-buffer marker))) (progn - (org-pop-to-buffer-same-window (marker-buffer marker)) - (if (or (> marker (point-max)) (< marker (point-min))) - (widen)) + (pop-to-buffer-same-window (marker-buffer marker)) + (when (or (> marker (point-max)) (< marker (point-min))) + (widen)) (goto-char marker) (org-show-context 'org-goto)) (if bookmark @@ -22209,7 +22115,7 @@ upon the next fontification round." l)) (defun org-shorten-string (s maxlength) - "Shorten string S so tht it is no longer than MAXLENGTH characters. + "Shorten string S so that it is no longer than MAXLENGTH characters. If the string is shorter or has length MAXLENGTH, just return the original string. If it is longer, the functions finds a space in the string, breaks this string off at that locations and adds three dots @@ -22229,8 +22135,8 @@ if necessary." "Get the indentation of the current line, interpreting tabs. When LINE is given, assume it represents a line and compute its indentation." (if line - (if (string-match "^ *" (org-remove-tabs line)) - (match-end 0)) + (when (string-match "^ *" (org-remove-tabs line)) + (match-end 0)) (save-excursion (beginning-of-line 1) (skip-chars-forward " \t") @@ -22267,35 +22173,45 @@ leave it alone. If it is larger than ind, set it to the target." (let* ((l (org-remove-tabs line)) (i (org-get-indentation l)) (i1 (car ind)) (i2 (cdr ind))) - (if (>= i i2) (setq l (substring line i2))) + (when (>= i i2) (setq l (substring line i2))) (if (> i1 0) (concat (make-string i1 ?\ ) l) l))) (defun org-remove-indentation (code &optional n) - "Remove the maximum common indentation from the lines in CODE. -N may optionally be the number of spaces to remove." + "Remove maximum common indentation in string CODE and return it. +N may optionally be the number of columns to remove. Return CODE +as-is if removal failed." (with-temp-buffer (insert code) - (org-do-remove-indentation n) - (buffer-string))) + (if (org-do-remove-indentation n) (buffer-string) code))) (defun org-do-remove-indentation (&optional n) - "Remove the maximum common indentation from the buffer." - (untabify (point-min) (point-max)) - (let ((min 10000) re) - (if n - (setq min n) - (goto-char (point-min)) - (while (re-search-forward "^ *[^ \n]" nil t) - (setq min (min min (1- (- (match-end 0) (match-beginning 0))))))) - (unless (or (= min 0) (= min 10000)) - (setq re (format "^ \\{%d\\}" min)) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (replace-match "") - (end-of-line 1)) - min))) + "Remove the maximum common indentation from the buffer. +When optional argument N is a positive integer, remove exactly +that much characters from indentation, if possible. Return nil +if it fails." + (catch :exit + (goto-char (point-min)) + ;; Find maximum common indentation, if not specified. + (let ((n (or n + (let ((min-ind (point-max))) + (save-excursion + (while (re-search-forward "^[ \t]*\\S-" nil t) + (let ((ind (1- (current-column)))) + (if (zerop ind) (throw :exit nil) + (setq min-ind (min min-ind ind)))))) + min-ind)))) + (if (zerop n) (throw :exit nil) + ;; Remove exactly N indentation, but give up if not possible. + (while (not (eobp)) + (let ((ind (progn (skip-chars-forward " \t") (current-column)))) + (cond ((eolp) (delete-region (line-beginning-position) (point))) + ((< ind n) (throw :exit nil)) + (t (indent-line-to (- ind n)))) + (forward-line))) + ;; Signal success. + t)))) (defun org-fill-template (template alist) "Find each %key of ALIST in TEMPLATE and replace it." @@ -22387,7 +22303,7 @@ and end of string." "Whether point is in a code source block. When INSIDE is non-nil, don't consider we are within a src block when point is at #+BEGIN_SRC or #+END_SRC." - (let ((case-fold-search t) ov) + (let ((case-fold-search t)) (or (and (eq (get-char-property (point) 'src-block) t)) (and (not inside) (save-match-data @@ -22410,7 +22326,7 @@ contexts are: :item on the first line of a plain list item :item-bullet on the bullet/number of a plain list item :checkbox on the checkbox in a plain list item -:table in an org-mode table +:table in an Org table :table-special on a special filed in a table :table-table in a table.el table :clocktable in a clocktable @@ -22441,8 +22357,8 @@ and :keyword." (push (org-point-in-group p 4 :tags) clist)) (goto-char p) (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1)) - (if (looking-at "\\[#[A-Z0-9]\\]") - (push (org-point-in-group p 0 :priority) clist))) + (when (looking-at "\\[#[A-Z0-9]\\]") + (push (org-point-in-group p 0 :priority) clist))) ((org-at-item-p) (push (org-point-in-group p 2 :item-bullet) clist) @@ -22454,10 +22370,10 @@ and :keyword." ((org-at-table-p) (push (list :table (org-table-begin) (org-table-end)) clist) - (if (memq 'org-formula faces) - (push (list :table-special - (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist))) + (when (memq 'org-formula faces) + (push (list :table-special + (previous-single-property-change p 'face) + (next-single-property-change p 'face)) clist))) ((org-at-table-p 'any) (push (list :table-table) clist))) (goto-char p) @@ -22495,13 +22411,12 @@ and :keyword." ((org-at-target-p) (push (org-point-in-group p 0 :target) clist) (goto-char (1- (match-beginning 0))) - (if (looking-at org-radio-target-regexp) - (push (org-point-in-group p 0 :radio-target) clist)) + (when (looking-at org-radio-target-regexp) + (push (org-point-in-group p 0 :radio-target) clist)) (goto-char p)) - ((setq o (org-some + ((setq o (cl-some (lambda (o) - (and (eq (overlay-get o 'org-overlay-type) - 'org-latex-overlay) + (and (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay) o)) (overlays-at (point)))) (push (list :latex-fragment @@ -22515,25 +22430,27 @@ and :keyword." (setq clist (nreverse (delq nil clist))) clist)) -(defun org-in-regexp (re &optional nlines visually) - "Check if point is inside a match of RE. +(defun org-in-regexp (regexp &optional nlines visually) + "Check if point is inside a match of REGEXP. Normally only the current line is checked, but you can include -NLINES extra lines after point into the search. If VISUALLY is +NLINES extra lines around point into the search. If VISUALLY is set, require that the cursor is not after the match but really -on, so that the block visually is on the match." - (catch 'exit +on, so that the block visually is on the match. + +Return nil or a cons cell (BEG . END) where BEG and END are, +respectively, the positions at the beginning and the end of the +match." + (catch :exit (let ((pos (point)) - (eol (point-at-eol (+ 1 (or nlines 0)))) - (inc (if visually 1 0))) + (eol (line-end-position (if nlines (1+ nlines) 1)))) (save-excursion (beginning-of-line (- 1 (or nlines 0))) - (while (re-search-forward re eol t) - (if (and (<= (match-beginning 0) pos) - (>= (+ inc (match-end 0)) pos)) - (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) -(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp - "Org mode 8.3") + (while (and (re-search-forward regexp eol t) + (<= (match-beginning 0) pos)) + (let ((end (match-end 0))) + (when (or (> end pos) (and (= end pos) (not visually))) + (throw :exit (cons (match-beginning 0) (match-end 0)))))))))) (defun org-between-regexps-p (start-re end-re &optional lim-up lim-down) "Non-nil when point is between matches of START-RE and END-RE. @@ -22580,14 +22497,13 @@ block from point." (let ((case-fold-search t) (lim-up (save-excursion (outline-previous-heading))) (lim-down (save-excursion (outline-next-heading)))) - (mapc (lambda (name) - (let ((n (regexp-quote name))) - (when (org-between-regexps-p - (concat "^[ \t]*#\\+begin_" n) - (concat "^[ \t]*#\\+end_" n) - lim-up lim-down) - (throw 'exit n)))) - names)) + (dolist (name names) + (let ((n (regexp-quote name))) + (when (org-between-regexps-p + (concat "^[ \t]*#\\+begin_" n) + (concat "^[ \t]*#\\+end_" n) + lim-up lim-down) + (throw 'exit n))))) nil))) (defun org-occur-in-agenda-files (regexp &optional _nlines) @@ -22614,27 +22530,8 @@ block from point." files) regexp))) -(if (boundp 'occur-mode-find-occurrence-hook) - ;; Emacs 23 - (add-hook 'occur-mode-find-occurrence-hook - (lambda () - (when (derived-mode-p 'org-mode) - (org-reveal)))) - ;; Emacs 22 - (defadvice occur-mode-goto-occurrence - (after org-occur-reveal activate) - (and (derived-mode-p 'org-mode) (org-reveal))) - (defadvice occur-mode-goto-occurrence-other-window - (after org-occur-reveal activate) - (and (derived-mode-p 'org-mode) (org-reveal))) - (defadvice occur-mode-display-occurrence - (after org-occur-reveal activate) - (when (derived-mode-p 'org-mode) - (let ((pos (occur-mode-find-occurrence))) - (with-current-buffer (marker-buffer pos) - (save-excursion - (goto-char pos) - (org-reveal))))))) +(add-hook 'occur-mode-find-occurrence-hook + (lambda () (when (derived-mode-p 'org-mode) (org-reveal)))) (defun org-occur-link-in-agenda-files () "Create a link and search for it in the agendas. @@ -22664,81 +22561,27 @@ merge (a 1) and (a 3) into (a 1 3). The function returns the new ALIST." (let (rtn) - (mapc - (lambda (e) - (let (n) - (if (not (assoc (car e) rtn)) - (push e rtn) - (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) - (setq rtn (assq-delete-all (car e) rtn)) - (push n rtn)))) - alist) - rtn)) + (dolist (e alist rtn) + (let (n) + (if (not (assoc (car e) rtn)) + (push e rtn) + (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) + (setq rtn (assq-delete-all (car e) rtn)) + (push n rtn)))))) (defun org-delete-all (elts list) - "Remove all elements in ELTS from LIST." + "Remove all elements in ELTS from LIST. +Comparison is done with `equal'. It is a destructive operation +that may remove elements by altering the list structure." (while elts (setq list (delete (pop elts) list))) list) -(defun org-count (cl-item cl-seq) - "Count the number of occurrences of ITEM in SEQ. -Taken from `count' in cl-seq.el with all keyword arguments removed." - (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x) - (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) - (while (< cl-start cl-end) - (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start))) - (if (equal cl-item cl-x) (setq cl-count (1+ cl-count))) - (setq cl-start (1+ cl-start))) - cl-count)) - -(defun org-remove-if (predicate seq) - "Remove everything from SEQ that fulfills PREDICATE." - (let (res e) - (while seq - (setq e (pop seq)) - (if (not (funcall predicate e)) (push e res))) - (nreverse res))) - -(defun org-remove-if-not (predicate seq) - "Remove everything from SEQ that does not fulfill PREDICATE." - (let (res e) - (while seq - (setq e (pop seq)) - (if (funcall predicate e) (push e res))) - (nreverse res))) - -(defun org-reduce (cl-func cl-seq &rest cl-keys) - "Reduce two-argument FUNCTION across SEQ. -Taken from `reduce' in cl-seq.el with all keyword arguments but -\":initial-value\" removed." - (let ((cl-accum (cond ((memq :initial-value cl-keys) - (cadr (memq :initial-value cl-keys))) - (cl-seq (pop cl-seq)) - (t (funcall cl-func))))) - (while cl-seq - (setq cl-accum (funcall cl-func cl-accum (pop cl-seq)))) - cl-accum)) - -(defun org-every (pred seq) - "Return true if PREDICATE is true of every element of SEQ. -Adapted from `every' in cl.el." - (catch 'org-every - (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq) - t)) - -(defun org-some (pred seq) - "Return true if PREDICATE is true of any element of SEQ. -Adapted from `some' in cl.el." - (catch 'org-some - (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq) - nil)) - (defun org-back-over-empty-lines () "Move backwards over whitespace, to the beginning of the first empty line. Returns the number of empty lines passed." (let ((pos (point))) - (if (cdr (assoc 'heading org-blank-before-new-entry)) + (if (cdr (assq 'heading org-blank-before-new-entry)) (skip-chars-backward " \t\n\r") (unless (eobp) (forward-line -1))) @@ -22791,7 +22634,7 @@ so values can contain further %-escapes if they are define later in TABLE." (let ((tbl (copy-alist table)) (case-fold-search nil) (pchg 0) - e re rpl) + re rpl) (dolist (e tbl) (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) (when (and (cdr e) (string-match re (cdr e))) @@ -22809,16 +22652,6 @@ so values can contain further %-escapes if they are define later in TABLE." (setq string (replace-match sref t t string))))) string)) -(defun org-sublist (list start end) - "Return a section of LIST, from START to END. -Counting starts at 1." - (let (rtn (c start)) - (setq list (nthcdr (1- start) list)) - (while (and list (<= c end)) - (push (pop list) rtn) - (setq c (1+ c))) - (nreverse rtn))) - (defun org-find-base-buffer-visiting (file) "Like `find-buffer-visiting' but always return the base buffer and not an indirect buffer." @@ -22828,26 +22661,12 @@ not an indirect buffer." (or (buffer-base-buffer buf) buf) nil))) -(defun org-image-file-name-regexp (&optional extensions) - "Return regexp matching the file names of images. -If EXTENSIONS is given, only match these." - (if (and (not extensions) (fboundp 'image-file-name-regexp)) - (image-file-name-regexp) - (let ((image-file-name-extensions - (or extensions - '("png" "jpeg" "jpg" "gif" "tiff" "tif" - "xbm" "xpm" "pbm" "pgm" "ppm")))) - (concat "\\." - (regexp-opt (nconc (mapcar 'upcase - image-file-name-extensions) - image-file-name-extensions) - t) - "\\'")))) - -(defun org-file-image-p (file &optional extensions) +;;; TODO: Only called once, from ox-odt which should probably use +;;; org-export-inline-image-p or something. +(defun org-file-image-p (file) "Return non-nil if FILE is an image." (save-match-data - (string-match (org-image-file-name-regexp extensions) file))) + (string-match (image-file-name-regexp) file))) (defun org-get-cursor-date (&optional with-time) "Return the date at cursor in as a time. @@ -22871,10 +22690,10 @@ the agenda) or the current time of the day." (nth 1 date) (nth 0 date) (nth 2 date)))) ((eq major-mode 'org-agenda-mode) (setq day (get-text-property (point) 'day)) - (if day - (setq date (calendar-gregorian-from-absolute day) - defd (encode-time 0 (or mod 0) (or hod 0) - (nth 1 date) (nth 0 date) (nth 2 date)))))) + (when day + (setq date (calendar-gregorian-from-absolute day) + defd (encode-time 0 (or mod 0) (or hod 0) + (nth 1 date) (nth 0 date) (nth 2 date)))))) (or defd (current-time)))) (defun org-mark-subtree (&optional up) @@ -22887,11 +22706,77 @@ hierarchy of headlines by UP levels before marking the subtree." (cond ((org-at-heading-p) (beginning-of-line)) ((org-before-first-heading-p) (user-error "Not in a subtree")) (t (outline-previous-visible-heading 1)))) - (when up (while (and (> up 0) (org-up-heading-safe)) (decf up))) - (if (org-called-interactively-p 'any) + (when up (while (and (> up 0) (org-up-heading-safe)) (cl-decf up))) + (if (called-interactively-p 'any) (call-interactively 'org-mark-element) (org-mark-element))) +(defun org-file-newer-than-p (file time) + "Non-nil if FILE is newer than TIME. +FILE is a filename, as a string, TIME is a list of integers, as +returned by, e.g., `current-time'." + (and (file-exists-p file) + ;; Only compare times up to whole seconds as some file-systems + ;; (e.g. HFS+) do not retain any finer granularity. As + ;; a consequence, make sure we return non-nil when the two + ;; times are equal. + (not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2) + (cl-subseq time 0 2))))) + +(defun org-compile-file (source process ext &optional err-msg log-buf spec) + "Compile a SOURCE file using PROCESS. + +PROCESS is either a function or a list of shell commands, as +strings. EXT is a file extension, without the leading dot, as +a string. It is used to check if the process actually succeeded. + +PROCESS must create a file with the same base name and directory +as SOURCE, but ending with EXT. The function then returns its +filename. Otherwise, it raises an error. The error message can +then be refined by providing string ERR-MSG, which is appended to +the standard message. + +If PROCESS is a function, it is called with a single argument: +the SOURCE file. + +If it is a list of commands, each of them is called using +`shell-command'. By default, in each command, %b, %f, %F and %o +are replaced with, respectively, SOURCE base name, name, full +name and directory. It is possible, however, to use more +place-holders by specifying them in optional argument SPEC, as an +alist following the pattern (CHARACTER . REPLACEMENT-STRING). + +When PROCESS is a list of commands, optional argument LOG-BUF can +be set to a buffer or a buffer name. `shell-command' then uses +it for output. + +`default-directory' is set to SOURCE directory during the whole +process." + (let* ((source-name (file-name-nondirectory source)) + (base-name (file-name-sans-extension source-name)) + (full-name (file-truename source)) + (out-dir (file-name-directory source)) + (time (current-time)) + (err-msg (if (stringp err-msg) (concat ". " err-msg) ""))) + (save-window-excursion + (let ((default-directory (file-name-directory full-name))) + (pcase process + ((pred functionp) (funcall process (shell-quote-argument source))) + ((pred consp) + (let ((log-buf (and log-buf (get-buffer-create log-buf))) + (spec (append spec + `((?b . ,(shell-quote-argument base-name)) + (?f . ,(shell-quote-argument source-name)) + (?F . ,(shell-quote-argument full-name)) + (?o . ,(shell-quote-argument out-dir)))))) + (dolist (command process) + (shell-command (format-spec command spec) log-buf)))) + (_ (error "No valid command to process %S%s" source err-msg))))) + ;; Check for process failure. + (let ((output (concat out-dir base-name "." ext))) + (unless (org-file-newer-than-p output time) + (error (format "File %S wasn't produced%s" output err-msg))) + output))) ;;; Indentation @@ -22906,7 +22791,7 @@ ELEMENT." (org-with-wide-buffer (cond (contentsp - (case type + (cl-case type ((diary-sexp footnote-definition) 0) ((headline inlinetask nil) (if (not org-adapt-indentation) 0 @@ -22984,16 +22869,15 @@ ELEMENT." ;; ;; As a special case, if point is at the end of a footnote ;; definition or an item, indent like the very last element - ;; within. + ;; within. If that last element is an item, indent like its + ;; contents. ((and (not (eq type 'paragraph)) (let ((cend (org-element-property :contents-end element))) (and cend (<= cend pos)))) (if (memq type '(footnote-definition item plain-list)) (let ((last (org-element-at-point))) (org--get-expected-indentation - last - (memq (org-element-type last) - '(footnote-definition item plain-list)))) + last (eq (org-element-type last) 'item))) (goto-char start) (org-get-indentation))) ;; In any other case, indent like the current line. @@ -23052,15 +22936,15 @@ Indentation is done according to the following rules: - Otherwise, indent like the first non-blank line above. The function doesn't indent an item as it could break the whole -list structure. Instead, use \\<org-mode-map>\\[org-shiftmetaleft] or \ -\\[org-shiftmetaright]. +list structure. Instead, use \\<org-mode-map>`\\[org-shiftmetaleft]' or \ +`\\[org-shiftmetaright]'. Also align node properties according to `org-property-format'." (interactive) (cond (orgstruct-is-++ (let ((indent-line-function - (cadadr (assq 'indent-line-function org-fb-vars)))) + (cl-cadadr (assq 'indent-line-function org-fb-vars)))) (indent-according-to-mode))) ((org-at-heading-p) 'noindent) (t @@ -23084,8 +22968,8 @@ Also align node properties according to `org-property-format'." (let ((column (org--get-expected-indentation element nil))) ;; Preserve current column. (if (<= (current-column) (current-indentation)) - (org-indent-line-to column) - (save-excursion (org-indent-line-to column)))) + (indent-line-to column) + (save-excursion (indent-line-to column)))) ;; Align node property. Also preserve current column. (when (eq type 'node-property) (let ((column (current-column))) @@ -23106,16 +22990,16 @@ assumed to be significant there." (let ((indent-to (lambda (ind pos) ;; Set IND as indentation for all lines between point and - ;; POS or END, whichever comes first. Blank lines are - ;; ignored. Leave point after POS once done. - (let ((limit (copy-marker (min end pos)))) + ;; POS. Blank lines are ignored. Leave point after POS + ;; once done. + (let ((limit (copy-marker pos))) (while (< (point) limit) - (unless (org-looking-at-p "[ \t]*$") (org-indent-line-to ind)) + (unless (looking-at-p "[ \t]*$") (indent-line-to ind)) (forward-line)) (set-marker limit nil)))) (end (copy-marker end))) (while (< (point) end) - (if (or (org-looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line) + (if (or (looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line) (let* ((element (org-element-at-point)) (type (org-element-type element)) (element-end (copy-marker (org-element-property :end element))) @@ -23130,7 +23014,7 @@ assumed to be significant there." (when (eq type 'node-property) (org--align-node-property) (beginning-of-line)) - (funcall indent-to ind element-end)) + (funcall indent-to ind (min element-end end))) (t ;; Elements in this category consist of three parts: ;; before the contents, the contents, and after the @@ -23178,9 +23062,9 @@ assumed to be significant there." offset)) (goto-char cbeg))) ((eq type 'item) (goto-char cbeg)) - (t (funcall indent-to ind cbeg))) + (t (funcall indent-to ind (min cbeg end)))) (when (< (point) end) - (case type + (cl-case type ((example-block export-block verse-block)) (src-block ;; In a source block, indent source code @@ -23192,7 +23076,8 @@ assumed to be significant there." (indent-region (point-min) (point-max)))))) (t (org-indent-region (point) (min cend end)))) (goto-char (min cend end)) - (when (< (point) end) (funcall indent-to ind element-end))) + (when (< (point) end) + (funcall indent-to ind (min element-end end)))) (set-marker post nil) (set-marker cbeg nil) (set-marker cend nil)))) @@ -23204,7 +23089,7 @@ assumed to be significant there." (interactive) (unless (save-excursion (beginning-of-line) - (org-looking-at-p org-drawer-regexp)) + (looking-at-p org-drawer-regexp)) (user-error "Not at a drawer")) (let ((element (org-element-at-point))) (unless (memq (org-element-type element) '(drawer property-drawer)) @@ -23220,7 +23105,7 @@ assumed to be significant there." (unless (save-excursion (beginning-of-line) (let ((case-fold-search t)) - (org-looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_"))) + (looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_"))) (user-error "Not at a block")) (let ((element (org-element-at-point))) (unless (memq (org-element-type element) @@ -23255,20 +23140,20 @@ assumed to be significant there." (require 'org-element) ;; Prevent auto-fill from inserting unwanted new items. (when (boundp 'fill-nobreak-predicate) - (org-set-local - 'fill-nobreak-predicate + (setq-local + fill-nobreak-predicate (org-uniquify (append fill-nobreak-predicate '(org-fill-line-break-nobreak-p org-fill-paragraph-with-timestamp-nobreak-p))))) (let ((paragraph-ending (substring org-element-paragraph-separate 1))) - (org-set-local 'paragraph-start paragraph-ending) - (org-set-local 'paragraph-separate paragraph-ending)) - (org-set-local 'fill-paragraph-function 'org-fill-paragraph) - (org-set-local 'auto-fill-inhibit-regexp nil) - (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) - (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) - (org-set-local 'comment-line-break-function 'org-comment-line-break-function)) + (setq-local paragraph-start paragraph-ending) + (setq-local paragraph-separate paragraph-ending)) + (setq-local fill-paragraph-function 'org-fill-paragraph) + (setq-local auto-fill-inhibit-regexp nil) + (setq-local adaptive-fill-function 'org-adaptive-fill-function) + (setq-local normal-auto-fill-function 'org-auto-fill-function) + (setq-local comment-line-break-function 'org-comment-line-break-function)) (defun org-fill-line-break-nobreak-p () "Non-nil when a new line at point would create an Org line break." @@ -23294,7 +23179,7 @@ matches in paragraphs or comments, use it." (save-excursion (beginning-of-line) (cond ((not (message-in-body-p)) (throw 'exit nil)) - ((org-looking-at-p org-table-line-regexp) (throw 'exit nil)) + ((looking-at-p org-table-line-regexp) (throw 'exit nil)) ((looking-at message-cite-prefix-regexp) (throw 'exit (match-string-no-properties 0))) ((looking-at org-outline-regexp) @@ -23308,7 +23193,7 @@ matches in paragraphs or comments, use it." (type (org-element-type element)) (post-affiliated (org-element-property :post-affiliated element))) (unless (< p post-affiliated) - (case type + (cl-case type (comment (save-excursion (beginning-of-line) @@ -23376,11 +23261,11 @@ a footnote definition, try to fill the first paragraph within." (looking-at message-cite-prefix-regexp)))) ;; First ensure filling is correct in message-mode. (let ((fill-paragraph-function - (cadadr (assoc 'fill-paragraph-function org-fb-vars))) - (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars))) - (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars))) + (cl-cadadr (assq 'fill-paragraph-function org-fb-vars))) + (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars))) + (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars))) (paragraph-separate - (cadadr (assoc 'paragraph-separate org-fb-vars)))) + (cl-cadadr (assq 'paragraph-separate org-fb-vars)))) (fill-paragraph nil)) (with-syntax-table org-mode-transpose-word-syntax-table ;; Move to end of line in order to get the first paragraph @@ -23392,7 +23277,7 @@ a footnote definition, try to fill the first paragraph within." (line-number-at-pos (point))))))) ;; First check if point is in a blank line at the beginning of ;; the buffer. In that case, ignore filling. - (case (org-element-type element) + (cl-case (org-element-type element) ;; Use major mode filling function is src blocks. (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) ;; Align Org tables, leave table.el tables as-is. @@ -23552,7 +23437,7 @@ region only contains such lines." (<= (org-element-property :post-affiliated element) (point))) (skip-chars-forward " \t") (insert ": ")) - ((and (org-looking-at-p "[ \t]*$") + ((and (looking-at-p "[ \t]*$") (or (eq type 'inlinetask) (save-excursion (skip-chars-forward " \r\t\n") @@ -23601,7 +23486,7 @@ region only contains such lines." (setq min-ind 0) (catch 'zerop (while (< (point) end) - (unless (org-looking-at-p "[ \t]*$") + (unless (looking-at-p "[ \t]*$") (let ((ind (org-get-indentation))) (setq min-ind (min min-ind ind)) (when (zerop ind) (throw 'zerop t)))) @@ -23615,10 +23500,10 @@ region only contains such lines." ((org-at-heading-p) (insert ": ") (forward-line) - (while (and (< (point) end) (org-looking-at-p "[ \t]*$")) + (while (and (< (point) end) (looking-at-p "[ \t]*$")) (insert ":") (forward-line))) - ((org-looking-at-p "[ \t]*:\\( \\|$\\)") + ((looking-at-p "[ \t]*:\\( \\|$\\)") (let* ((element (org-element-at-point)) (element-end (org-element-property :end element))) (if (eq (org-element-type element) 'fixed-width) @@ -23657,12 +23542,12 @@ region only contains such lines." (defun org-setup-comments-handling () (interactive) - (org-set-local 'comment-use-syntax nil) - (org-set-local 'comment-start "# ") - (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)") - (org-set-local 'comment-insert-comment-function 'org-insert-comment) - (org-set-local 'comment-region-function 'org-comment-or-uncomment-region) - (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region)) + (setq-local comment-use-syntax nil) + (setq-local comment-start "# ") + (setq-local comment-start-skip "^\\s-*#\\(?: \\|$\\)") + (setq-local comment-insert-comment-function 'org-insert-comment) + (setq-local comment-region-function 'org-comment-or-uncomment-region) + (setq-local uncomment-region-function 'org-comment-or-uncomment-region)) (defun org-insert-comment () "Insert an empty comment above current line. @@ -23704,7 +23589,13 @@ strictly within a source block, use appropriate comment syntax." (skip-chars-backward " \r\t\n") (line-beginning-position)) end))) - (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim)) + ;; Translate region boundaries for the Org buffer to the source + ;; buffer. + (let ((offset (- end beg))) + (save-excursion + (goto-char beg) + (org-babel-do-in-edit-buffer + (comment-or-uncomment-region (point) (+ offset (point)))))) (save-restriction ;; Restrict region (narrow-to-region (save-excursion (goto-char beg) @@ -23754,7 +23645,7 @@ strictly within a source block, use appropriate comment syntax." (insert comment-start)) (forward-line))))))))) -(defun org-comment-dwim (arg) +(defun org-comment-dwim (_arg) "Call `comment-dwim' within a source edit buffer if needed." (interactive "*P") (if (org-in-src-block-p) @@ -23794,7 +23685,8 @@ time-range, if possible. When optional argument UTC is non-nil, time will be expressed as Universal Time." (format-time-string - format (org-timestamp--to-internal-time timestamp end) utc)) + format (org-timestamp--to-internal-time timestamp end) + (and utc t))) (defun org-timestamp-split-range (timestamp &optional end) "Extract a TIMESTAMP object from a date or time range. @@ -23856,7 +23748,6 @@ it has a `diary' type." ;;; Other stuff. (defvar reftex-docstruct-symbol) -(defvar reftex-cite-format) (defvar org--rds) (defun org-reftex-citation () @@ -23874,131 +23765,137 @@ Export of such citations to both LaTeX and HTML is handled by the contributed package ox-bibtex by Taru Karttunen." (interactive) (let ((reftex-docstruct-symbol 'org--rds) - (reftex-cite-format "\\cite{%l}") org--rds bib) - (save-excursion - (save-restriction - (widen) - (let ((case-fold-search t) - (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)")) - (if (not (save-excursion - (or (re-search-forward re nil t) - (re-search-backward re nil t)))) - (user-error "No bibliography defined in file") - (setq bib (concat (match-string 1) ".bib") - org--rds (list (list 'bib bib))))))) + (org-with-wide-buffer + (let ((case-fold-search t) + (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)")) + (if (not (save-excursion + (or (re-search-forward re nil t) + (re-search-backward re nil t)))) + (user-error "No bibliography defined in file") + (setq bib (concat (match-string 1) ".bib") + org--rds (list (list 'bib bib)))))) (call-interactively 'reftex-citation))) ;;;; Functions extending outline functionality -(defun org-beginning-of-line (&optional arg) - "Go to the beginning of the current line. If that is invisible, continue -to a visible line beginning. This makes the function of C-a more intuitive. -If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the -first attempt, and only move to after the tags when the cursor is already -beyond the end of the headline." - (interactive "P") - (let ((pos (point)) - (special (if (consp org-special-ctrl-a/e) - (car org-special-ctrl-a/e) - org-special-ctrl-a/e)) - deactivate-mark refpos) - (if (org-bound-and-true-p visual-line-mode) - (beginning-of-visual-line 1) - (beginning-of-line 1)) - (if (and arg (fboundp 'move-beginning-of-line)) - (call-interactively 'move-beginning-of-line) - (if (bobp) - nil - (backward-char 1) - (if (org-truely-invisible-p) - (while (and (not (bobp)) (org-truely-invisible-p)) - (backward-char 1) - (beginning-of-line 1)) - (forward-char 1)))) - (when special - (cond - ((and (looking-at org-complex-heading-regexp) - (eq (char-after (match-end 1)) ?\s)) - (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) - (point-at-eol))) - (goto-char - (if (eq special t) - (cond ((> pos refpos) refpos) - ((= pos (point)) refpos) - (t (point))) - (cond ((> pos (point)) (point)) - ((not (eq last-command this-command)) (point)) - (t refpos))))) - ((org-at-item-p) - ;; Being at an item and not looking at an the item means point - ;; was previously moved to beginning of a visual line, which - ;; doesn't contain the item. Therefore, do nothing special, - ;; just stay here. - (when (looking-at org-list-full-item-re) - ;; Set special position at first white space character after - ;; bullet, and check-box, if any. - (let ((after-bullet - (let ((box (match-end 3))) - (if (not box) (match-end 1) - (let ((after (char-after box))) - (if (and after (= after ? )) (1+ box) box)))))) - ;; Special case: Move point to special position when - ;; currently after it or at beginning of line. - (if (eq special t) - (when (or (> pos after-bullet) (= (point) pos)) - (goto-char after-bullet)) - ;; Reversed case: Move point to special position when - ;; point was already at beginning of line and command is - ;; repeated. - (when (and (= (point) pos) (eq last-command this-command)) - (goto-char after-bullet)))))))) - (org-no-warnings - (and (featurep 'xemacs) (setq zmacs-region-stays t)))) - (setq disable-point-adjustment - (or (not (invisible-p (point))) - (not (invisible-p (max (point-min) (1- (point)))))))) - -(defun org-end-of-line (&optional arg) - "Go to the end of the line. +(defun org-beginning-of-line (&optional n) + "Go to the beginning of the current visible line. + If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the first attempt, and only move to after the tags when -the cursor is already beyond the end of the headline." - (interactive "P") - (let ((special (if (consp org-special-ctrl-a/e) (cdr org-special-ctrl-a/e) - org-special-ctrl-a/e)) - (move-fun (cond ((org-bound-and-true-p visual-line-mode) - 'end-of-visual-line) - ((fboundp 'move-end-of-line) 'move-end-of-line) - (t 'end-of-line))) +the cursor is already beyond the end of the headline. + +With argument N not nil or 1, move forward N - 1 lines first." + (interactive "^p") + (let ((origin (point)) + (special (pcase org-special-ctrl-a/e + (`(,C-a . ,_) C-a) (_ org-special-ctrl-a/e))) deactivate-mark) - (if (or (not special) arg) (call-interactively move-fun) - (let* ((element (save-excursion (beginning-of-line) - (org-element-at-point))) - (type (org-element-type element))) - (cond - ((memq type '(headline inlinetask)) - (let ((pos (point))) - (beginning-of-line 1) - (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$")) - (if (eq special t) - (if (or (< pos (match-beginning 1)) (= pos (match-end 0))) - (goto-char (match-beginning 1)) - (goto-char (match-end 0))) - (if (or (< pos (match-end 0)) - (not (eq this-command last-command))) - (goto-char (match-end 0)) - (goto-char (match-beginning 1)))) - (call-interactively move-fun)))) - ((outline-invisible-p (line-end-position)) - ;; If element is hidden, `move-end-of-line' would put point - ;; after it. Use `end-of-line' to stay on current line. - (call-interactively 'end-of-line)) - (t (call-interactively move-fun))))) - (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t)))) - (setq disable-point-adjustment - (or (not (invisible-p (point))) - (not (invisible-p (max (point-min) (1- (point)))))))) + ;; First move to a visible line. + (if (bound-and-true-p visual-line-mode) + (beginning-of-visual-line n) + (move-beginning-of-line n) + ;; `move-beginning-of-line' may leave point after invisible + ;; characters if line starts with such of these (e.g., with + ;; a link at column 0). Really move to the beginning of the + ;; current visible line. + (beginning-of-line)) + (cond + ;; No special behavior. Point is already at the beginning of + ;; a line, logical or visual. + ((not special)) + ;; `beginning-of-visual-line' left point before logical beginning + ;; of line: point is at the beginning of a visual line. Bail + ;; out. + ((and (bound-and-true-p visual-line-mode) (not (bolp)))) + ((let ((case-fold-search nil)) (looking-at org-complex-heading-regexp)) + ;; At a headline, special position is before the title, but + ;; after any TODO keyword or priority cookie. + (let ((refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) + (line-end-position))) + (bol (point))) + (if (eq special 'reversed) + (when (and (= origin bol) (eq last-command this-command)) + (goto-char refpos)) + (when (or (> origin refpos) (= origin bol)) + (goto-char refpos))))) + ((and (looking-at org-list-full-item-re) + (memq (org-element-type (save-match-data (org-element-at-point))) + '(item plain-list))) + ;; Set special position at first white space character after + ;; bullet, and check-box, if any. + (let ((after-bullet + (let ((box (match-end 3))) + (cond ((not box) (match-end 1)) + ((eq (char-after box) ?\s) (1+ box)) + (t box))))) + (if (eq special 'reversed) + (when (and (= (point) origin) (eq last-command this-command)) + (goto-char after-bullet)) + (when (or (> origin after-bullet) (= (point) origin)) + (goto-char after-bullet))))) + ;; No special context. Point is already at beginning of line. + (t nil)))) + +(defun org-end-of-line (&optional n) + "Go to the end of the line, but before ellipsis, if any. + +If this is a headline, and `org-special-ctrl-a/e' is set, ignore +tags on the first attempt, and only move to after the tags when +the cursor is already beyond the end of the headline. + +With argument N not nil or 1, move forward N - 1 lines first." + (interactive "^p") + (let ((origin (point)) + (special (pcase org-special-ctrl-a/e + (`(,_ . ,C-e) C-e) (_ org-special-ctrl-a/e))) + deactivate-mark) + ;; First move to a visible line. + (if (bound-and-true-p visual-line-mode) + (beginning-of-visual-line n) + (move-beginning-of-line n)) + (cond + ;; At a headline, with tags. + ((and special + (save-excursion + (beginning-of-line) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp))) + (match-end 5)) + (let ((tags (save-excursion + (goto-char (match-beginning 5)) + (skip-chars-backward " \t") + (point))) + (visual-end (and (bound-and-true-p visual-line-mode) + (save-excursion + (end-of-visual-line) + (point))))) + ;; If `end-of-visual-line' brings us before end of line or + ;; even tags, i.e., the headline spans over multiple visual + ;; lines, move there. + (cond ((and visual-end + (< visual-end tags) + (<= origin visual-end)) + (goto-char visual-end)) + ((eq special 'reversed) + (if (and (= origin (line-end-position)) + (eq this-command last-command)) + (goto-char tags) + (end-of-line))) + (t + (if (or (< origin tags) (= origin (line-end-position))) + (goto-char tags) + (end-of-line)))))) + ((bound-and-true-p visual-line-mode) + (let ((bol (line-beginning-position))) + (end-of-visual-line) + ;; If `end-of-visual-line' gets us past the ellipsis at the + ;; end of a line, backtrack and use `end-of-line' instead. + (when (/= bol (line-beginning-position)) + (goto-char bol) + (end-of-line)))) + (t (end-of-line))))) (define-key org-mode-map "\C-a" 'org-beginning-of-line) (define-key org-mode-map "\C-e" 'org-end-of-line) @@ -24056,14 +23953,14 @@ depending on context." ((or (not org-special-ctrl-k) (bolp) (not (org-at-heading-p))) - (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible) - org-ctrl-k-protect-subtree) - (if (or (eq org-ctrl-k-protect-subtree 'error) - (not (y-or-n-p "Kill hidden subtree along with headline? "))) - (user-error "C-k aborted as it would kill a hidden subtree"))) + (when (and (get-char-property (min (point-max) (point-at-eol)) 'invisible) + org-ctrl-k-protect-subtree + (or (eq org-ctrl-k-protect-subtree 'error) + (not (y-or-n-p "Kill hidden subtree along with headline? ")))) + (user-error "C-k aborted as it would kill a hidden subtree")) (call-interactively - (if (org-bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line))) - ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) + (if (bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line))) + ((looking-at ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$") (kill-region (point) (match-beginning 1)) (org-set-tags nil t)) (t (kill-region (point) (point-at-eol))))) @@ -24076,20 +23973,21 @@ This command will look at the current kill and check if is a single subtree, or a series of subtrees[1]. If it passes the test, and if the cursor is at the beginning of a line or after the stars of a currently empty headline, then the yank is handled specially. How exactly depends -on the value of the following variables, both set by default. +on the value of the following variables. `org-yank-folded-subtrees' - When set, the subtree(s) will be folded after insertion, but only - if doing so would now swallow text after the yanked text. + By default, this variable is non-nil, which results in + subtree(s) being folded after insertion, except if doing so + would swallow text after the yanked text. `org-yank-adjusted-subtrees' - When set, the subtree will be promoted or demoted in order to - fit into the local outline tree structure, which means that the - level will be adjusted so that it becomes the smaller one of the - two *visible* surrounding headings. + When non-nil (the default value is nil), the subtree will be + promoted or demoted in order to fit into the local outline tree + structure, which means that the level will be adjusted so that it + becomes the smaller one of the two *visible* surrounding headings. Any prefix to this command will cause `yank' to be called directly with -no special treatment. In particular, a simple \\[universal-argument] prefix \ +no special treatment. In particular, a simple `\\[universal-argument]' prefix \ will just plainly yank the text as it is. @@ -24167,11 +24065,9 @@ interactive command with similar behavior." (setq level (org-outline-level))) (goto-char end) (skip-chars-forward " \t\r\n\v\f") - (if (or (eobp) - (and (bolp) (looking-at org-outline-regexp) - (<= (org-outline-level) level))) - nil ; Nothing would be swallowed - t))))) ; something would swallow + (not (or (eobp) + (and (bolp) (looking-at-p org-outline-regexp) + (<= (org-outline-level) level)))))))) (define-key org-mode-map "\C-y" 'org-yank) @@ -24180,14 +24076,13 @@ interactive command with similar behavior." This version does not only check the character property, but also `visible-mode'." ;; Early versions of noutline don't have `outline-invisible-p'. - (if (org-bound-and-true-p visible-mode) - nil + (unless (bound-and-true-p visible-mode) (outline-invisible-p))) (defun org-invisible-p2 () "Check if point is at a character currently not visible." (save-excursion - (if (and (eolp) (not (bobp))) (backward-char 1)) + (when (and (eolp) (not (bobp))) (backward-char 1)) ;; Early versions of noutline don't have `outline-invisible-p'. (outline-invisible-p))) @@ -24206,8 +24101,6 @@ This version does not only check the character property, but also (defun org-at-heading-p (&optional ignored) (outline-on-heading-p t)) -;; Compatibility alias with Org versions < 7.8.03 -(defalias 'org-on-heading-p 'org-at-heading-p) (defun org-in-commented-heading-p (&optional no-inheritance) "Non-nil if point is under a commented heading. @@ -24218,8 +24111,8 @@ unless optional argument NO-INHERITANCE is non-nil." ((let ((headline (nth 4 (org-heading-components)))) (and headline (let ((case-fold-search nil)) - (org-string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)") - headline))))) + (string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)") + headline))))) (no-inheritance nil) (t (save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p)))))) @@ -24268,9 +24161,7 @@ empty." "Move to the heading line of which the present line is a subheading. This function considers both visible and invisible heading lines. With argument, move up ARG levels." - (if (fboundp 'outline-up-heading-all) - (outline-up-heading-all arg) ; emacs 21 version of outline.el - (outline-up-heading arg t))) ; emacs 22 version of outline.el + (outline-up-heading arg t)) (defun org-up-heading-safe () "Move to the heading line of which the present line is a subheading. @@ -24369,8 +24260,7 @@ This is like outline-next-sibling, but invisible headings are ok." (outline-next-heading) (while (and (not (eobp)) (> (funcall outline-level) level)) (outline-next-heading)) - (if (or (eobp) (< (funcall outline-level) level)) - nil + (unless (or (eobp) (< (funcall outline-level) level)) (point)))) (defun org-get-last-sibling () @@ -24383,8 +24273,7 @@ If there is no such heading, return nil." (while (and (> (funcall outline-level) level) (not (bobp))) (outline-previous-heading)) - (if (< (funcall outline-level) level) - nil + (unless (< (funcall outline-level) level) (point))))) (defun org-end-of-subtree (&optional invisible-ok to-heading) @@ -24400,7 +24289,7 @@ If there is no such heading, return nil." (let ((first t) (level (funcall outline-level))) (if (and (derived-mode-p 'org-mode) (< level 1000)) - ;; A true heading (not a plain list item), in Org-mode + ;; A true heading (not a plain list item), in Org ;; This means we can easily find the end by looking ;; only for the right number of stars. Using a regexp to do ;; this is so much faster than using a Lisp loop. @@ -24413,13 +24302,12 @@ If there is no such heading, return nil." (setq first nil) (outline-next-heading))) (unless to-heading - (if (memq (preceding-char) '(?\n ?\^M)) - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - ;; leave blank line before heading - (forward-char -1)))))) + (when (memq (preceding-char) '(?\n ?\^M)) + ;; Go to end of line before heading + (forward-char -1) + (when (memq (preceding-char) '(?\n ?\^M)) + ;; leave blank line before heading + (forward-char -1))))) (point)) (defun org-end-of-meta-data (&optional full) @@ -24429,7 +24317,7 @@ clocking lines and regular drawers at the beginning of the entry." (org-back-to-heading t) (forward-line) - (when (org-looking-at-p org-planning-line-re) (forward-line)) + (when (looking-at-p org-planning-line-re) (forward-line)) (when (looking-at org-property-drawer-re) (goto-char (match-end 0)) (forward-line)) @@ -24438,11 +24326,11 @@ entry." (let ((end (save-excursion (outline-next-heading) (point))) (re (concat "[ \t]*$" "\\|" org-clock-line-re))) (while (not (eobp)) - (cond ((org-looking-at-p org-drawer-regexp) + (cond ((looking-at-p org-drawer-regexp) (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t) (forward-line) (throw 'exit t))) - ((org-looking-at-p re) (forward-line)) + ((looking-at-p re) (forward-line)) (t (throw 'exit t)))))))) (defun org-forward-heading-same-level (arg &optional invisible-ok) @@ -24536,7 +24424,7 @@ Throw an error if no block is found." (<= (match-beginning 0) (org-element-property :post-affiliated element))) (setq last-element element) - (decf count)))) + (cl-decf count)))) (if (= count 0) (prog1 (goto-char (org-element-property :post-affiliated last-element)) (save-match-data (org-show-context))) @@ -24608,7 +24496,7 @@ item, etc. It also provides some special moves for convenience: ((not contents-begin) (goto-char end)) ;; If contents are invisible, skip the element altogether. ((outline-invisible-p (line-end-position)) - (case type + (cl-case type (headline (org-with-limited-levels (outline-next-visible-heading 1))) ;; At a plain list, make sure we move to the next item @@ -24619,7 +24507,7 @@ item, etc. It also provides some special moves for convenience: ((>= (point) contents-end) (goto-char end)) ((>= (point) contents-begin) ;; This can only happen on paragraphs and plain lists. - (case type + (cl-case type (paragraph (goto-char end)) ;; At a plain list, try to move to second element in ;; first item, if possible. @@ -24840,7 +24728,7 @@ Move to the previous element at the same level, when possible." (defun org-drag-line-forward (arg) "Drag the line at point ARG lines forward." (interactive "p") - (dotimes (n (abs arg)) + (dotimes (_ (abs arg)) (let ((c (current-column))) (if (< 0 arg) (progn @@ -24864,7 +24752,7 @@ mode) if the mark is active, it marks the next element after the ones already marked." (interactive) (let (deactivate-mark) - (if (and (org-called-interactively-p 'any) + (if (and (called-interactively-p 'any) (or (and (eq last-command this-command) (mark t)) (and transient-mark-mode mark-active))) (set-mark @@ -24910,13 +24798,10 @@ modified." (interactive) (unless (eq major-mode 'org-mode) (user-error "Cannot un-indent a buffer not in Org mode")) - (let* ((parse-tree (org-element-parse-buffer 'greater-element)) - unindent-tree ; For byte-compiler. - (unindent-tree - (function - (lambda (contents) - (mapc - (lambda (element) + (letrec ((parse-tree (org-element-parse-buffer 'greater-element)) + (unindent-tree + (lambda (contents) + (dolist (element (reverse contents)) (if (memq (org-element-type element) '(headline section)) (funcall unindent-tree (org-element-contents element)) (save-excursion @@ -24924,10 +24809,49 @@ modified." (narrow-to-region (org-element-property :begin element) (org-element-property :end element)) - (org-do-remove-indentation))))) - (reverse contents)))))) + (org-do-remove-indentation)))))))) (funcall unindent-tree (org-element-contents parse-tree)))) +(defun org-show-children (&optional level) + "Show all direct subheadings of this heading. +Prefix arg LEVEL is how many levels below the current level +should be shown. Default is enough to cause the following +heading to appear." + (interactive "p") + ;; If `orgstruct-mode' is active, use the slower version. + (if orgstruct-mode (call-interactively #'outline-show-children) + (save-excursion + (org-back-to-heading t) + (let* ((current-level (funcall outline-level)) + (max-level (org-get-valid-level + current-level + (if level (prefix-numeric-value level) 1))) + (end (save-excursion (org-end-of-subtree t t))) + (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)") + (past-first-child nil) + ;; Make sure to skip inlinetasks. + (re (format regexp-fmt + current-level + (cond + ((not (featurep 'org-inlinetask)) "") + (org-odd-levels-only (- (* 2 org-inlinetask-min-level) + 3)) + (t (1- org-inlinetask-min-level)))))) + ;; Display parent heading. + (outline-flag-region (line-end-position 0) (line-end-position) nil) + (forward-line) + ;; Display children. First child may be deeper than expected + ;; MAX-LEVEL. Since we want to display it anyway, adjust + ;; MAX-LEVEL accordingly. + (while (re-search-forward re end t) + (unless past-first-child + (setq re (format regexp-fmt + current-level + (max (funcall outline-level) max-level))) + (setq past-first-child t)) + (outline-flag-region + (line-end-position 0) (line-end-position) nil)))))) + (defun org-show-subtree () "Show everything after this heading at deeper levels." (interactive) @@ -24963,36 +24887,12 @@ when non-nil, is a regexp matching keywords names." (and extra (concat (and kwds "\\|") extra)) "\\):[ \t]*\\(.*\\)")) -;; Make isearch reveal the necessary context -(defun org-isearch-end () - "Reveal context after isearch exits." - (when isearch-success ; only if search was successful - (if (featurep 'xemacs) - ;; Under XEmacs, the hook is run in the correct place, - ;; we directly show the context. - (org-show-context 'isearch) - ;; In Emacs the hook runs *before* restoring the overlays. - ;; So we have to use a one-time post-command-hook to do this. - ;; (Emacs 22 has a special variable, see function `org-mode') - (unless (and (boundp 'isearch-mode-end-hook-quit) - isearch-mode-end-hook-quit) - ;; Only when the isearch was not quitted. - (org-add-hook 'post-command-hook 'org-isearch-post-command - 'append 'local))))) - -(defun org-isearch-post-command () - "Remove self from hook, and show context." - (remove-hook 'post-command-hook 'org-isearch-post-command 'local) - (org-show-context 'isearch)) - - ;;;; Integration with and fixes for other packages ;;; Imenu support -(defvar org-imenu-markers nil +(defvar-local org-imenu-markers nil "All markers currently used by Imenu.") -(make-variable-buffer-local 'org-imenu-markers) (defun org-imenu-new-marker (&optional pos) "Return a new marker for use by Imenu, and remember the marker." @@ -25003,50 +24903,48 @@ when non-nil, is a regexp matching keywords names." (defun org-imenu-get-tree () "Produce the index for Imenu." - (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) + (dolist (x org-imenu-markers) (move-marker x nil)) (setq org-imenu-markers nil) - (let* ((n org-imenu-depth) + (let* ((case-fold-search nil) + (n org-imenu-depth) (re (concat "^" (org-get-limited-outline-regexp))) (subs (make-vector (1+ n) nil)) (last-level 0) m level head0 head) - (save-excursion - (save-restriction - (widen) - (goto-char (point-max)) - (while (re-search-backward re nil t) - (setq level (org-reduced-level (funcall outline-level))) - (when (and (<= level n) - (looking-at org-complex-heading-regexp) - (setq head0 (org-match-string-no-properties 4))) - (setq head (org-link-display-format head0) - m (org-imenu-new-marker)) - (org-add-props head nil 'org-imenu-marker m 'org-imenu t) - (if (>= level last-level) - (push (cons head m) (aref subs level)) - (push (cons head (aref subs (1+ level))) (aref subs level)) - (loop for i from (1+ level) to n do (aset subs i nil))) - (setq last-level level))))) + (org-with-wide-buffer + (goto-char (point-max)) + (while (re-search-backward re nil t) + (setq level (org-reduced-level (funcall outline-level))) + (when (and (<= level n) + (looking-at org-complex-heading-regexp) + (setq head0 (match-string-no-properties 4))) + (setq head (org-link-display-format head0) + m (org-imenu-new-marker)) + (org-add-props head nil 'org-imenu-marker m 'org-imenu t) + (if (>= level last-level) + (push (cons head m) (aref subs level)) + (push (cons head (aref subs (1+ level))) (aref subs level)) + (cl-loop for i from (1+ level) to n do (aset subs i nil))) + (setq last-level level)))) (aref subs 1))) (eval-after-load "imenu" '(progn (add-hook 'imenu-after-jump-hook (lambda () - (if (derived-mode-p 'org-mode) - (org-show-context 'org-goto)))))) + (when (derived-mode-p 'org-mode) + (org-show-context 'org-goto)))))) -(defun org-link-display-format (link) - "Replace a link with its the description. +(defun org-link-display-format (s) + "Replace links in string S with their description. If there is no description, use the link target." (save-match-data - (if (string-match org-bracket-link-analytic-regexp link) - (replace-match (if (match-end 5) - (match-string 5 link) - (concat (match-string 1 link) - (match-string 3 link))) - nil t link) - link))) + (replace-regexp-in-string + org-bracket-link-analytic-regexp + (lambda (m) + (if (match-end 5) (match-string 5 m) + (concat (match-string 1 m) (match-string 3 m)))) + s nil t))) (defun org-toggle-link-display () "Toggle the literal or descriptive display of links." @@ -25067,11 +24965,11 @@ If there is no description, use the link target." 'face 'org-agenda-restriction-lock) (overlay-put org-speedbar-restriction-lock-overlay 'help-echo "Agendas are currently limited to this item.") -(org-detach-overlay org-speedbar-restriction-lock-overlay) +(delete-overlay org-speedbar-restriction-lock-overlay) (defun org-speedbar-set-agenda-restriction () "Restrict future agenda commands to the location at point in speedbar. -To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." +To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'." (interactive) (require 'org-agenda) (let (p m tp np dir txt) @@ -25095,9 +24993,9 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (let ((default-directory dir)) (expand-file-name txt))) (unless (derived-mode-p 'org-mode) - (user-error "Cannot restrict to non-Org-mode file")) + (user-error "Cannot restrict to non-Org mode file")) (org-agenda-set-restriction-lock 'file))) - (t (user-error "Don't know how to restrict Org-mode's agenda"))) + (t (user-error "Don't know how to restrict Org mode agenda"))) (move-overlay org-speedbar-restriction-lock-overlay (point-at-bol) (point-at-eol)) (setq current-prefix-arg nil) @@ -25121,9 +25019,9 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." "Non-nil when Flyspell can check object at point. ELEMENT is the element at point." (let ((object (save-excursion - (when (org-looking-at-p "\\>") (backward-char)) + (when (looking-at-p "\\>") (backward-char)) (org-element-context element)))) - (case (org-element-type object) + (cl-case (org-element-type object) ;; Prevent checks in links due to keybinding conflict with ;; Flyspell. ((code entity export-snippet inline-babel-call @@ -25146,8 +25044,9 @@ ELEMENT is the element at point." ;; faster than relying on `org-element-at-point'. (and (save-excursion (beginning-of-line) (and (let ((case-fold-search t)) - (not (looking-at "\\*+ END[ \t]*$"))) - (looking-at org-complex-heading-regexp))) + (not (looking-at-p "\\*+ END[ \t]*$"))) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)))) (match-beginning 4) (>= (point) (match-beginning 4)) (or (not (match-beginning 5)) @@ -25173,7 +25072,7 @@ ELEMENT is the element at point." t))))) nil) (t - (case (org-element-type element) + (cl-case (org-element-type element) ((comment quote-section) t) (comment-block ;; Allow checks between block markers, not on them. @@ -25201,7 +25100,7 @@ ELEMENT is the element at point." (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region." - (and (org-bound-and-true-p flyspell-mode) + (and (bound-and-true-p flyspell-mode) (fboundp 'flyspell-delete-region-overlays) (flyspell-delete-region-overlays beg end))) @@ -25229,8 +25128,8 @@ ELEMENT is the element at point." (eval-after-load "ecb" '(defadvice ecb-method-clicked (after esf/org-show-context activate) "Make hierarchy visible when jumping into location from ECB tree buffer." - (if (derived-mode-p 'org-mode) - (org-show-context)))) + (when (derived-mode-p 'org-mode) + (org-show-context)))) (defun org-bookmark-jump-unhide () "Unhide the current position, to show the bookmark location." diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index aa12d9e..43808aa 100644 --- a/lisp/ox-ascii.el +++ b/lisp/ox-ascii.el @@ -1,4 +1,4 @@ -;;; ox-ascii.el --- ASCII Back-End for Org Export Engine +;;; ox-ascii.el --- ASCII Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2016 Free Software Foundation, Inc. @@ -27,9 +27,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'ox) (require 'ox-publish) +(require 'cl-lib) (declare-function aa2u "ext:ascii-art-to-unicode" ()) @@ -93,7 +93,6 @@ (underline . org-ascii-underline) (verbatim . org-ascii-verbatim) (verse-block . org-ascii-verse-block)) - :export-block "ASCII" :menu-entry '(?t "Export to Plain Text" ((?A "As ASCII buffer" @@ -189,7 +188,7 @@ This margin is applied on both sides of the text." This margin applies to top level list only, not to its sub-lists." :group 'org-export-ascii - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type 'integer) @@ -370,7 +369,7 @@ Otherwise, place it right after it." :type 'string) (defcustom org-ascii-format-drawer-function - (lambda (name contents width) contents) + (lambda (_name contents _width) contents) "Function called to format a drawer in ASCII. The function must accept three parameters: @@ -512,7 +511,7 @@ that is according to the widest non blank line in CONTENTS." ;; possible. (save-excursion (while (not (eobp)) - (unless (org-looking-at-p "[ \t]*$") + (unless (looking-at-p "[ \t]*$") (end-of-line) (let ((column (current-column))) (cond @@ -525,8 +524,8 @@ that is according to the widest non blank line in CONTENTS." (if (eq how 'right) 1 2)))) (if (zerop offset) (throw 'exit contents) (while (not (eobp)) - (unless (org-looking-at-p "[ \t]*$") - (org-indent-to-column offset)) + (unless (looking-at-p "[ \t]*$") + (indent-to-column offset)) (forward-line))))) (buffer-string)))))))) @@ -550,23 +549,24 @@ INFO is a plist used as a communication channel." (defun org-ascii--current-text-width (element info) "Return maximum text width for ELEMENT's contents. INFO is a plist used as a communication channel." - (case (org-element-type element) + (pcase (org-element-type element) ;; Elements with an absolute width: `headline' and `inlinetask'. - (inlinetask (plist-get info :ascii-inlinetask-width)) - (headline + (`inlinetask (plist-get info :ascii-inlinetask-width)) + (`headline (- (plist-get info :ascii-text-width) (let ((low-level-rank (org-export-low-level-p element info))) (if low-level-rank (* low-level-rank 2) (plist-get info :ascii-global-margin))))) ;; Elements with a relative width: store maximum text width in ;; TOTAL-WIDTH. - (otherwise + (_ (let* ((genealogy (org-element-lineage element nil t)) ;; Total width is determined by the presence, or not, of an ;; inline task among ELEMENT parents. (total-width - (if (loop for parent in genealogy - thereis (eq (org-element-type parent) 'inlinetask)) + (if (cl-some (lambda (parent) + (eq (org-element-type parent) 'inlinetask)) + genealogy) (plist-get info :ascii-inlinetask-width) ;; No inlinetask: Remove global margin from text width. (- (plist-get info :ascii-text-width) @@ -585,19 +585,20 @@ INFO is a plist used as a communication channel." (- total-width ;; Each `quote-block' and `verse-block' above narrows text ;; width by twice the standard margin size. - (+ (* (loop for parent in genealogy - when (memq (org-element-type parent) - '(quote-block verse-block)) - count parent) - 2 (plist-get info :ascii-quote-margin)) + (+ (* (cl-count-if (lambda (parent) + (memq (org-element-type parent) + '(quote-block verse-block))) + genealogy) + 2 + (plist-get info :ascii-quote-margin)) ;; Apply list margin once per "top-level" plain-list ;; containing current line - (* (let ((count 0)) - (dolist (e genealogy count) - (and (eq (org-element-type e) 'plain-list) - (not (eq (org-element-type (org-export-get-parent e)) - 'item)) - (incf count)))) + (* (cl-count-if + (lambda (e) + (and (eq (org-element-type e) 'plain-list) + (not (eq (org-element-type (org-export-get-parent e)) + 'item)))) + genealogy) (plist-get info :ascii-list-margin)) ;; Text width within a plain-list is restricted by ;; indentation of current item. If that's the case, @@ -605,9 +606,9 @@ INFO is a plist used as a communication channel." ;; parent item, if any. (let ((item (if (eq (org-element-type element) 'item) element - (loop for parent in genealogy - when (eq (org-element-type parent) 'item) - return parent)))) + (cl-find-if (lambda (parent) + (eq (org-element-type parent) 'item)) + genealogy)))) (if (not item) 0 ;; Compute indentation offset of the current item, ;; that is the sum of the difference between its @@ -634,9 +635,9 @@ Return value is a symbol among `left', `center', `right' and (let (justification) (while (and (not justification) (setq element (org-element-property :parent element))) - (case (org-element-type element) - (center-block (setq justification 'center)) - (special-block + (pcase (org-element-type element) + (`center-block (setq justification 'center)) + (`special-block (let ((name (org-element-property :type element))) (cond ((string= name "JUSTIFYRIGHT") (setq justification 'right)) ((string= name "JUSTIFYLEFT") (setq justification 'left))))))) @@ -712,7 +713,7 @@ possible. It doesn't apply to `inlinetask' elements." (char-width under-char)) under-char)))))))) -(defun org-ascii--has-caption-p (element info) +(defun org-ascii--has-caption-p (element _info) "Non-nil when ELEMENT has a caption affiliated keyword. INFO is a plist used as a communication channel. This function is meant to be used as a predicate for `org-export-get-ordinal'." @@ -734,9 +735,9 @@ caption keyword." (org-export-get-ordinal element info nil 'org-ascii--has-caption-p)) (title-fmt (org-ascii--translate - (case (org-element-type element) - (table "Table %d:") - (src-block "Listing %d:")) + (pcase (org-element-type element) + (`table "Table %d:") + (`src-block "Listing %d:")) info))) (org-ascii--fill-string (concat (format title-fmt reference) @@ -807,7 +808,7 @@ generation. INFO is a plist used as a communication channel." ;; filling (like contents of a description list item). (let* ((initial-text (format (org-ascii--translate "Listing %d:" info) - (incf count))) + (cl-incf count))) (initial-width (string-width initial-text))) (concat initial-text " " @@ -847,7 +848,7 @@ generation. INFO is a plist used as a communication channel." ;; filling (like contents of a description list item). (let* ((initial-text (format (org-ascii--translate "Table %d:" info) - (incf count))) + (cl-incf count))) (initial-width (string-width initial-text))) (concat initial-text " " @@ -868,34 +869,32 @@ ELEMENT is either a headline element or a section element. INFO is a plist used as a communication channel." (let* (seen (unique-link-p - (function - ;; Return LINK if it wasn't referenced so far, or nil. - ;; Update SEEN links along the way. - (lambda (link) - (let ((footprint - ;; Normalize description in footprints. - (cons (org-element-property :raw-link link) - (let ((contents (org-element-contents link))) - (and contents - (replace-regexp-in-string - "[ \r\t\n]+" " " - (org-trim - (org-element-interpret-data contents)))))))) - ;; Ignore LINK if it hasn't been translated already. - ;; It can happen if it is located in an affiliated - ;; keyword that was ignored. - (when (and (org-string-nw-p - (gethash link (plist-get info :exported-data))) - (not (member footprint seen))) - (push footprint seen) link))))) - ;; If at a section, find parent headline, if any, in order to - ;; count links that might be in the title. - (headline - (if (eq (org-element-type element) 'headline) element - (or (org-export-get-parent-headline element) element)))) - ;; Get all links in HEADLINE. - (org-element-map headline 'link - (lambda (l) (funcall unique-link-p l)) info nil nil t))) + ;; Return LINK if it wasn't referenced so far, or nil. + ;; Update SEEN links along the way. + (lambda (link) + (let ((footprint + ;; Normalize description in footprints. + (cons (org-element-property :raw-link link) + (let ((contents (org-element-contents link))) + (and contents + (replace-regexp-in-string + "[ \r\t\n]+" " " + (org-trim + (org-element-interpret-data contents)))))))) + ;; Ignore LINK if it hasn't been translated already. It + ;; can happen if it is located in an affiliated keyword + ;; that was ignored. + (when (and (org-string-nw-p + (gethash link (plist-get info :exported-data))) + (not (member footprint seen))) + (push footprint seen) link))))) + (org-element-map (if (eq (org-element-type element) 'section) + element + ;; In a headline, only retrieve links in title + ;; and relative section, not in children. + (list (org-element-property :title element) + (car (org-element-contents element)))) + 'link unique-link-p info nil 'headline t))) (defun org-ascii--describe-links (links width info) "Return a string describing a list of links. @@ -938,11 +937,7 @@ channel." ((not (org-element-contents link)) nil) ;; Do not add a link already handled by custom export ;; functions. - ((let ((protocol (nth 2 (assoc type org-link-protocols))) - (path (org-element-property :path link))) - (and (functionp protocol) - (funcall protocol (org-link-unescape path) anchor 'ascii))) - nil) + ((org-export-custom-protocol-maybe link anchor 'ascii) nil) (t (concat (org-ascii--fill-string @@ -955,10 +950,10 @@ channel." "Return checkbox string for ITEM or nil. INFO is a plist used as a communication channel." (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) - (case (org-element-property :checkbox item) - (on (if utf8p "☑ " "[X] ")) - (off (if utf8p "☐ " "[ ] ")) - (trans (if utf8p "☒ " "[-] "))))) + (pcase (org-element-property :checkbox item) + (`on (if utf8p "☑ " "[X] ")) + (`off (if utf8p "☐ " "[ ] ")) + (`trans (if utf8p "☒ " "[-] "))))) @@ -1081,7 +1076,8 @@ holding export options." ;; full-fledged definitions. (org-trim (let ((def (nth 2 ref))) - (if (eq (org-element-type def) 'org-data) + (if (org-element-map def org-element-all-elements + #'identity info 'first-match) ;; Full-fledged definition: footnote ID is ;; inserted inside the first parsed ;; paragraph (FIRST), if any, to be sure @@ -1141,7 +1137,7 @@ INFO is a plist used as a communication channel." ;;;; Bold -(defun org-ascii-bold (bold contents info) +(defun org-ascii-bold (_bold contents _info) "Transcode BOLD from Org to ASCII. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." @@ -1150,7 +1146,7 @@ contextual information." ;;;; Center Block -(defun org-ascii-center-block (center-block contents info) +(defun org-ascii-center-block (_center-block contents _info) "Transcode a CENTER-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -1161,7 +1157,7 @@ holding contextual information." ;;;; Clock -(defun org-ascii-clock (clock contents info) +(defun org-ascii-clock (clock _contents info) "Transcode a CLOCK object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1179,7 +1175,7 @@ information." ;;;; Code -(defun org-ascii-code (code contents info) +(defun org-ascii-code (code _contents info) "Return a CODE object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1201,7 +1197,7 @@ holding contextual information." ;;;; Dynamic Block -(defun org-ascii-dynamic-block (dynamic-block contents info) +(defun org-ascii-dynamic-block (_dynamic-block contents _info) "Transcode a DYNAMIC-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -1210,7 +1206,7 @@ holding contextual information." ;;;; Entity -(defun org-ascii-entity (entity contents info) +(defun org-ascii-entity (entity _contents info) "Transcode an ENTITY object from Org to ASCII. CONTENTS are the definition itself. INFO is a plist holding contextual information." @@ -1221,7 +1217,7 @@ contextual information." ;;;; Example Block -(defun org-ascii-example-block (example-block contents info) +(defun org-ascii-example-block (example-block _contents info) "Transcode a EXAMPLE-BLOCK element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (org-ascii--justify-element @@ -1232,7 +1228,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Export Snippet -(defun org-ascii-export-snippet (export-snippet contents info) +(defun org-ascii-export-snippet (export-snippet _contents _info) "Transcode a EXPORT-SNIPPET object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (when (eq (org-export-snippet-backend export-snippet) 'ascii) @@ -1241,7 +1237,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Export Block -(defun org-ascii-export-block (export-block contents info) +(defun org-ascii-export-block (export-block _contents info) "Transcode a EXPORT-BLOCK element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (when (string= (org-element-property :type export-block) "ASCII") @@ -1251,7 +1247,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Fixed Width -(defun org-ascii-fixed-width (fixed-width contents info) +(defun org-ascii-fixed-width (fixed-width _contents info) "Transcode a FIXED-WIDTH element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (org-ascii--justify-element @@ -1269,7 +1265,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Footnote Reference -(defun org-ascii-footnote-reference (footnote-reference contents info) +(defun org-ascii-footnote-reference (footnote-reference _contents info) "Transcode a FOOTNOTE-REFERENCE element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (format "[%s]" (org-export-get-footnote-number footnote-reference info))) @@ -1284,51 +1280,55 @@ holding contextual information." ;; Don't export footnote section, which will be handled at the end ;; of the template. (unless (org-element-property :footnote-section-p headline) - (let* ((low-level-rank (org-export-low-level-p headline info)) + (let* ((low-level (org-export-low-level-p headline info)) (width (org-ascii--current-text-width headline info)) + ;; Export title early so that any link in it can be + ;; exported and seen in `org-ascii--unique-links'. + (title (org-ascii--build-title headline info width (not low-level))) ;; Blank lines between headline and its contents. ;; `org-ascii-headline-spacing', when set, overwrites ;; original buffer's spacing. (pre-blanks - (make-string - (or (car (plist-get info :ascii-headline-spacing)) - (org-element-property :pre-blank headline)) - ?\n)) - ;; Even if HEADLINE has no section, there might be some - ;; links in its title that we shouldn't forget to describe. - (links - (unless (or (eq (caar (org-element-contents headline)) 'section)) - (let ((title (org-element-property :title headline))) - (when (consp title) - (org-ascii--describe-links - (org-ascii--unique-links title info) width info)))))) + (make-string (or (car (plist-get info :ascii-headline-spacing)) + (org-element-property :pre-blank headline) + 0) + ?\n)) + (links (and (plist-get info :ascii-links-to-notes) + (org-ascii--describe-links + (org-ascii--unique-links headline info) width info))) + ;; Re-build contents, inserting section links at the right + ;; place. The cost is low since build results are cached. + (body + (if (not (org-string-nw-p links)) contents + (let* ((contents (org-element-contents headline)) + (section (let ((first (car contents))) + (and (eq (org-element-type first) 'section) + first)))) + (concat (and section + (concat (org-element-normalize-string + (org-export-data section info)) + "\n\n")) + links + (mapconcat (lambda (e) (org-export-data e info)) + (if section (cdr contents) contents) + "")))))) ;; Deep subtree: export it as a list item. - (if low-level-rank - (concat - ;; Bullet. - (let ((bullets (cdr (assq (plist-get info :ascii-charset) - (plist-get info :ascii-bullets))))) - (char-to-string - (nth (mod (1- low-level-rank) (length bullets)) bullets))) - " " - ;; Title. - (org-ascii--build-title headline info width) "\n" - ;; Contents, indented by length of bullet. - pre-blanks - (org-ascii--indent-string - (concat contents - (when (org-string-nw-p links) (concat "\n\n" links))) - 2)) + (if low-level + (let* ((bullets (cdr (assq (plist-get info :ascii-charset) + (plist-get info :ascii-bullets)))) + (bullet + (format "%c " + (nth (mod (1- low-level) (length bullets)) bullets)))) + (concat bullet title "\n" pre-blanks + ;; Contents, indented by length of bullet. + (org-ascii--indent-string body (length bullet)))) ;; Else: Standard headline. - (concat - (org-ascii--build-title headline info width 'underline) - "\n" pre-blanks - (concat (when (org-string-nw-p links) links) contents)))))) + (concat title "\n" pre-blanks body))))) ;;;; Horizontal Rule -(defun org-ascii-horizontal-rule (horizontal-rule contents info) +(defun org-ascii-horizontal-rule (horizontal-rule _contents info) "Transcode an HORIZONTAL-RULE object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1345,7 +1345,7 @@ information." ;;;; Inline Src Block -(defun org-ascii-inline-src-block (inline-src-block contents info) +(defun org-ascii-inline-src-block (inline-src-block _contents info) "Transcode an INLINE-SRC-BLOCK element from Org to ASCII. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." @@ -1356,7 +1356,7 @@ contextual information." ;;;; Inlinetask (defun org-ascii-format-inlinetask-default - (todo type priority name tags contents width inlinetask info) + (_todo _type _priority _name _tags contents width inlinetask info) "Format an inline task element for ASCII export. See `org-ascii-format-inlinetask-function' for a description of the parameters." @@ -1411,7 +1411,7 @@ holding contextual information." ;;;; Italic -(defun org-ascii-italic (italic contents info) +(defun org-ascii-italic (_italic contents _info) "Transcode italic from Org to ASCII. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." @@ -1431,12 +1431,12 @@ contextual information." ;; First parent of ITEM is always the plain-list. Get ;; `:type' property from it. (org-list-bullet-string - (case list-type - (descriptive + (pcase list-type + (`descriptive (concat checkbox (org-export-data (org-element-property :tag item) info) ": ")) - (ordered + (`ordered ;; Return correct number for ITEM, paying attention to ;; counters. (let* ((struct (org-element-property :structure item)) @@ -1448,7 +1448,7 @@ contextual information." (org-list-prevs-alist struct) (org-list-parents-alist struct))))))) (replace-regexp-in-string "[0-9]+" num bul))) - (t (let ((bul (org-element-property :bullet item))) + (_ (let ((bul (org-element-property :bullet item))) ;; Change bullets into more visible form if UTF-8 is active. (if (not utf8p) bul (replace-regexp-in-string @@ -1470,7 +1470,7 @@ contextual information." ;;;; Keyword -(defun org-ascii-keyword (keyword contents info) +(defun org-ascii-keyword (keyword _contents info) "Transcode a KEYWORD element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1482,21 +1482,21 @@ information." (org-ascii--justify-element (let ((case-fold-search t)) (cond - ((org-string-match-p "\\<headlines\\>" value) + ((string-match-p "\\<headlines\\>" value) (let ((depth (and (string-match "\\<[0-9]+\\>" value) (string-to-number (match-string 0 value)))) - (localp (org-string-match-p "\\<local\\>" value))) + (localp (string-match-p "\\<local\\>" value))) (org-ascii--build-toc info depth keyword localp))) - ((org-string-match-p "\\<tables\\>" value) + ((string-match-p "\\<tables\\>" value) (org-ascii--list-tables keyword info)) - ((org-string-match-p "\\<listings\\>" value) + ((string-match-p "\\<listings\\>" value) (org-ascii--list-listings keyword info)))) keyword info))))) ;;;; Latex Environment -(defun org-ascii-latex-environment (latex-environment contents info) +(defun org-ascii-latex-environment (latex-environment _contents info) "Transcode a LATEX-ENVIRONMENT element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1508,7 +1508,7 @@ information." ;;;; Latex Fragment -(defun org-ascii-latex-fragment (latex-fragment contents info) +(defun org-ascii-latex-fragment (latex-fragment _contents info) "Transcode a LATEX-FRAGMENT object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1518,7 +1518,7 @@ information." ;;;; Line Break -(defun org-ascii-line-break (line-break contents info) +(defun org-ascii-line-break (_line-break _contents _info) "Transcode a LINE-BREAK object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." hard-newline) @@ -1569,7 +1569,7 @@ INFO is a plist holding contextual information." ;;;; Node Properties -(defun org-ascii-node-property (node-property contents info) +(defun org-ascii-node-property (node-property _contents _info) "Transcode a NODE-PROPERTY element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1632,7 +1632,7 @@ INFO is a plist used as a communication channel." ;;;; Planning -(defun org-ascii-planning (planning contents info) +(defun org-ascii-planning (planning _contents info) "Transcode a PLANNING element from Org to ASCII. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -1668,7 +1668,7 @@ holding contextual information." ;;;; Quote Block -(defun org-ascii-quote-block (quote-block contents info) +(defun org-ascii-quote-block (_quote-block contents info) "Transcode a QUOTE-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -1677,7 +1677,7 @@ holding contextual information." ;;;; Radio Target -(defun org-ascii-radio-target (radio-target contents info) +(defun org-ascii-radio-target (_radio-target contents _info) "Transcode a RADIO-TARGET object from Org to ASCII. CONTENTS is the contents of the target. INFO is a plist holding contextual information." @@ -1690,25 +1690,26 @@ contextual information." "Transcode a SECTION element from Org to ASCII. CONTENTS is the contents of the section. INFO is a plist holding contextual information." - (org-ascii--indent-string - (concat - contents - (when (plist-get info :ascii-links-to-notes) - ;; Add list of links at the end of SECTION. - (let ((links (org-ascii--describe-links - (org-ascii--unique-links section info) - (org-ascii--current-text-width section info) info))) - ;; Separate list of links and section contents. - (when (org-string-nw-p links) (concat "\n\n" links))))) - ;; Do not apply inner margin if parent headline is low level. - (let ((headline (org-export-get-parent-headline section))) - (if (or (not headline) (org-export-low-level-p headline info)) 0 - (plist-get info :ascii-inner-margin))))) + (let ((links + (and (plist-get info :ascii-links-to-notes) + ;; Take care of links in first section of the document. + (not (org-element-lineage section '(headline))) + (org-ascii--describe-links + (org-ascii--unique-links section info) + (org-ascii--current-text-width section info) + info)))) + (org-ascii--indent-string + (if (not (org-string-nw-p links)) contents + (concat (org-element-normalize-string contents) "\n\n" links)) + ;; Do not apply inner margin if parent headline is low level. + (let ((headline (org-export-get-parent-headline section))) + (if (or (not headline) (org-export-low-level-p headline info)) 0 + (plist-get info :ascii-inner-margin)))))) ;;;; Special Block -(defun org-ascii-special-block (special-block contents info) +(defun org-ascii-special-block (_special-block contents _info) "Transcode a SPECIAL-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -1720,7 +1721,7 @@ holding contextual information." ;;;; Src Block -(defun org-ascii-src-block (src-block contents info) +(defun org-ascii-src-block (src-block _contents info) "Transcode a SRC-BLOCK element from Org to ASCII. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." @@ -1738,7 +1739,7 @@ contextual information." ;;;; Statistics Cookie -(defun org-ascii-statistics-cookie (statistics-cookie contents info) +(defun org-ascii-statistics-cookie (statistics-cookie _contents _info) "Transcode a STATISTICS-COOKIE object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (org-element-property :value statistics-cookie)) @@ -1746,7 +1747,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Subscript -(defun org-ascii-subscript (subscript contents info) +(defun org-ascii-subscript (subscript contents _info) "Transcode a SUBSCRIPT object from Org to ASCII. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -1757,7 +1758,7 @@ contextual information." ;;;; Superscript -(defun org-ascii-superscript (superscript contents info) +(defun org-ascii-superscript (superscript contents _info) "Transcode a SUPERSCRIPT object from Org to ASCII. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -1768,7 +1769,7 @@ contextual information." ;;;; Strike-through -(defun org-ascii-strike-through (strike-through contents info) +(defun org-ascii-strike-through (_strike-through contents _info) "Transcode STRIKE-THROUGH from Org to ASCII. CONTENTS is text with strike-through markup. INFO is a plist holding contextual information." @@ -1938,7 +1939,7 @@ a communication channel." ;;;; Timestamp -(defun org-ascii-timestamp (timestamp contents info) +(defun org-ascii-timestamp (timestamp _contents info) "Transcode a TIMESTAMP object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (org-ascii-plain-text (org-timestamp-translate timestamp) info)) @@ -1946,7 +1947,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Underline -(defun org-ascii-underline (underline contents info) +(defun org-ascii-underline (_underline contents _info) "Transcode UNDERLINE from Org to ASCII. CONTENTS is the text with underline markup. INFO is a plist holding contextual information." @@ -1955,7 +1956,7 @@ holding contextual information." ;;;; Verbatim -(defun org-ascii-verbatim (verbatim contents info) +(defun org-ascii-verbatim (verbatim _contents info) "Return a VERBATIM object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (format (plist-get info :ascii-verbatim-format) @@ -1968,21 +1969,20 @@ CONTENTS is nil. INFO is a plist holding contextual information." "Transcode a VERSE-BLOCK element from Org to ASCII. CONTENTS is verse block contents. INFO is a plist holding contextual information." - (let ((verse-width (org-ascii--current-text-width verse-block info))) - (org-ascii--indent-string - (org-ascii--justify-element contents verse-block info) - (plist-get info :ascii-quote-margin)))) + (org-ascii--indent-string + (org-ascii--justify-element contents verse-block info) + (plist-get info :ascii-quote-margin))) ;;; Filters -(defun org-ascii-filter-headline-blank-lines (headline back-end info) +(defun org-ascii-filter-headline-blank-lines (headline _backend info) "Filter controlling number of blank lines after a headline. -HEADLINE is a string representing a transcoded headline. -BACK-END is symbol specifying back-end used for export. INFO is -plist containing the communication channel. +HEADLINE is a string representing a transcoded headline. BACKEND +is symbol specifying back-end used for export. INFO is plist +containing the communication channel. This function only applies to `ascii' back-end. See `org-ascii-headline-spacing' for information." @@ -1991,10 +1991,10 @@ This function only applies to `ascii' back-end. See (let ((blanks (make-string (1+ (cdr headline-spacing)) ?\n))) (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))))) -(defun org-ascii-filter-paragraph-spacing (tree back-end info) +(defun org-ascii-filter-paragraph-spacing (tree _backend info) "Filter controlling number of blank lines between paragraphs. -TREE is the parse tree. BACK-END is the symbol specifying +TREE is the parse tree. BACKEND is the symbol specifying back-end used for export. INFO is a plist used as a communication channel. @@ -2008,9 +2008,9 @@ See `org-ascii-paragraph-spacing' for information." (org-element-put-property p :post-blank paragraph-spacing)))))) tree) -(defun org-ascii-filter-comment-spacing (tree backend info) +(defun org-ascii-filter-comment-spacing (tree _backend info) "Filter removing blank lines between comments. -TREE is the parse tree. BACK-END is the symbol specifying +TREE is the parse tree. BACKEND is the symbol specifying back-end used for export. INFO is a plist used as a communication channel." (org-element-map tree '(comment comment-block) diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el index 7afe390..c254c0b 100644 --- a/lisp/ox-beamer.el +++ b/lisp/ox-beamer.el @@ -1,4 +1,4 @@ -;;; ox-beamer.el --- Beamer Back-End for Org Export Engine +;;; ox-beamer.el --- Beamer Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2016 Free Software Foundation, Inc. @@ -29,7 +29,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'ox-latex) ;; Install a default set-up for Beamer export. @@ -140,7 +140,7 @@ You might want to put e.g. \"allowframebreaks=0.9\" here." The format string should have at most one \"%s\"-expression, which is replaced with the subtitle." :group 'org-export-beamer - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(string :tag "Format string")) @@ -202,19 +202,14 @@ TYPE is a symbol among the following: `defaction' Return ARGUMENT within both square and angular brackets. `option' Return ARGUMENT within square brackets." (if (not (string-match "\\S-" argument)) "" - (case type - (action (if (string-match "\\`<.*>\\'" argument) argument - (format "<%s>" argument))) - (defaction (cond - ((string-match "\\`\\[<.*>\\]\\'" argument) argument) - ((string-match "\\`<.*>\\'" argument) - (format "[%s]" argument)) - ((string-match "\\`\\[\\(.*\\)\\]\\'" argument) - (format "[<%s>]" (match-string 1 argument))) - (t (format "[<%s>]" argument)))) - (option (if (string-match "\\`\\[.*\\]\\'" argument) argument - (format "[%s]" argument))) - (otherwise argument)))) + (cl-case type + (action (format "<%s>" (org-unbracket-string "<" ">" argument))) + (defaction + (format "[<%s>]" + (org-unbracket-string "<" ">" (org-unbracket-string "[" "]" argument)))) + (option (format "[%s]" (org-unbracket-string "[" "]" argument))) + (otherwise (error "Invalid `type' argument to `org-beamer--normalize-argument': %s" + type))))) (defun org-beamer--element-has-overlay-p (element) "Non-nil when ELEMENT has an overlay specified. @@ -224,14 +219,14 @@ Return overlay specification, as a string, or nil." (let ((first-object (car (org-element-contents element)))) (when (eq (org-element-type first-object) 'export-snippet) (let ((value (org-element-property :value first-object))) - (and (string-match "\\`<.*>\\'" value) value))))) + (and (string-prefix-p "<" value) (string-suffix-p ">" value) + value))))) ;;; Define Back-End (org-export-define-derived-backend 'beamer 'latex - :export-block "BEAMER" :menu-entry '(?l 1 ((?B "As LaTeX buffer (Beamer)" org-beamer-export-as-latex) @@ -274,7 +269,7 @@ Return overlay specification, as a string, or nil." ;;;; Bold -(defun org-beamer-bold (bold contents info) +(defun org-beamer-bold (bold contents _info) "Transcode BLOCK object into Beamer code. CONTENTS is the text being bold. INFO is a plist used as a communication channel." @@ -285,7 +280,7 @@ a communication channel." ;;;; Export Block -(defun org-beamer-export-block (export-block contents info) +(defun org-beamer-export-block (export-block _contents _info) "Transcode an EXPORT-BLOCK element into Beamer code. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -295,7 +290,7 @@ channel." ;;;; Export Snippet -(defun org-beamer-export-snippet (export-snippet contents info) +(defun org-beamer-export-snippet (export-snippet _contents info) "Transcode an EXPORT-SNIPPET object into Beamer code. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -331,17 +326,21 @@ channel." INFO is a plist used as a communication channel. The value is either the label specified in \"BEAMER_opt\" -property, or a unique internal label. This function assumes -HEADLINE will be treated as a frame." - (let ((opt (org-element-property :BEAMER_OPT headline))) - (if (and (stringp opt) - (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt)) - (let ((label (match-string 1 opt))) - ;; Strip protective braces, if any. - (if (org-string-match-p "\\`{.*}\\'" label) - (substring label 1 -1) - label)) - (format "sec:%s" (org-export-get-reference headline info))))) +property, the custom ID, if there is one and +`:latex-prefer-user-labels' property has a non nil value, or +a unique internal label. This function assumes HEADLINE will be +treated as a frame." + (cond + ((let ((opt (org-element-property :BEAMER_OPT headline))) + (and (stringp opt) + (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt) + (let ((label (match-string 1 opt))) + (if (string-match-p "\\`{.*}\\'" label) + (substring label 1 -1) + label))))) + ((and (plist-get info :latex-prefer-user-labels) + (org-element-property :CUSTOM_ID headline))) + (t (format "sec:%s" (org-export-get-reference headline info))))) (defun org-beamer--frame-level (headline info) "Return frame level in subtree containing HEADLINE. @@ -448,7 +447,7 @@ used as a communication channel." (let ((label (org-beamer--get-label headline info))) ;; Labels containing colons need to be ;; wrapped within braces. - (format (if (org-string-match-p ":" label) + (format (if (string-match-p ":" label) "label={%s}" "label=%s") label))))))) @@ -560,7 +559,8 @@ used as a communication channel." (let ((action (org-element-property :BEAMER_ACT headline))) (cond ((not action) (list (cons "a" "") (cons "A" "") (cons "R" ""))) - ((string-match "\\`\\[.*\\]\\'" action) + ((and (string-prefix-p "[" action) + (string-suffix-p "]" action)) (list (cons "A" (org-beamer--normalize-argument action 'defaction)) (cons "a" "") @@ -676,7 +676,7 @@ contextual information." (list (cons 'item - (lambda (item c i) + (lambda (item _c _i) (let ((action (let ((first (car (org-element-contents item)))) (and (eq (org-element-type first) 'paragraph) @@ -720,8 +720,7 @@ channel." "Transcode a LINK object into Beamer code. CONTENTS is the description part of the link. INFO is a plist used as a communication channel." - (let ((type (org-element-property :type link)) - (path (org-element-property :path link))) + (let ((type (org-element-property :type link))) (cond ;; Link type is handled by a special function. ((org-export-custom-protocol-maybe link contents 'beamer)) @@ -737,7 +736,7 @@ used as a communication channel." (let ((destination (if (string= type "fuzzy") (org-export-resolve-fuzzy-link link info) (org-export-resolve-id-link link info)))) - (case (org-element-type destination) + (cl-case (org-element-type destination) (headline (let ((label (format "sec-%s" @@ -813,7 +812,7 @@ contextual information." ;;;; Target -(defun org-beamer-target (target contents info) +(defun org-beamer-target (target _contents info) "Transcode a TARGET object into Beamer code. CONTENTS is nil. INFO is a plist holding contextual information." @@ -832,34 +831,14 @@ holding export options." (let ((title (org-export-data (plist-get info :title) info)) (subtitle (org-export-data (plist-get info :subtitle) info))) (concat - ;; 1. Time-stamp. + ;; Time-stamp. (and (plist-get info :time-stamp-file) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) - ;; 2. Document class and packages. - (let* ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options)) - (header (nth 1 (assoc class org-latex-classes))) - (document-class-string - (and (stringp header) - (if (not class-options) header - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" - class-options header t nil 1))))) - (if (not document-class-string) - (user-error "Unknown LaTeX class `%s'" class) - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-element-normalize-string - (org-splice-latex-header - document-class-string - org-latex-default-packages-alist - org-latex-packages-alist nil - (concat (org-element-normalize-string - (plist-get info :latex-header)) - (org-element-normalize-string - (plist-get info :latex-header-extra)))))) - info))) - ;; 3. Insert themes. + ;; LaTeX compiler + (org-latex--insert-compiler info) + ;; Document class and packages. + (org-latex--make-preamble info) + ;; Insert themes. (let ((format-theme (function (lambda (prop command) @@ -879,11 +858,11 @@ holding export options." (:beamer-inner-theme "\\useinnertheme") (:beamer-outer-theme "\\useoutertheme")) "")) - ;; 4. Possibly limit depth for headline numbering. + ;; Possibly limit depth for headline numbering. (let ((sec-num (plist-get info :section-numbers))) (when (integerp sec-num) (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) - ;; 5. Author. + ;; Author. (let ((author (and (plist-get info :with-author) (let ((auth (plist-get info :author))) (and auth (org-export-data auth info))))) @@ -892,14 +871,14 @@ holding export options." (cond ((and author email (not (string= "" email))) (format "\\author{%s\\thanks{%s}}\n" author email)) ((or author email) (format "\\author{%s}\n" (or author email))))) - ;; 6. Date. + ;; Date. (let ((date (and (plist-get info :with-date) (org-export-get-date info)))) (format "\\date{%s}\n" (org-export-data date info))) - ;; 7. Title + ;; Title (format "\\title{%s}\n" title) (when (org-string-nw-p subtitle) (concat (format (plist-get info :beamer-subtitle-format) subtitle) "\n")) - ;; 8. Beamer-header + ;; Beamer-header (let ((beamer-header (plist-get info :beamer-header))) (when beamer-header (format "%s\n" (plist-get info :beamer-header)))) @@ -907,9 +886,9 @@ holding export options." (let ((template (plist-get info :latex-hyperref-template))) (and (stringp template) (format-spec template (org-latex--format-spec info)))) - ;; 10. Document start. + ;; Document start. "\\begin{document}\n\n" - ;; 11. Title command. + ;; Title command. (org-element-normalize-string (cond ((not (plist-get info :with-title)) nil) ((string= "" title) nil) @@ -918,7 +897,7 @@ holding export options." org-latex-title-command) (format org-latex-title-command title)) (t org-latex-title-command))) - ;; 12. Table of contents. + ;; Table of contents. (let ((depth (plist-get info :with-toc))) (when depth (concat @@ -930,13 +909,13 @@ holding export options." (format "\\setcounter{tocdepth}{%d}\n" depth)) "\\tableofcontents\n" "\\end{frame}\n\n"))) - ;; 13. Document's body. + ;; Document's body. contents - ;; 14. Creator. + ;; Creator. (if (plist-get info :with-creator) (concat (plist-get info :creator) "\n") "") - ;; 15. Document end. + ;; Document end. "\\end{document}"))) @@ -972,7 +951,7 @@ value." (save-excursion (org-back-to-heading t) ;; Filter out Beamer-related tags and install environment tag. - (let ((tags (org-remove-if (lambda (x) (string-match "^B_" x)) + (let ((tags (cl-remove-if (lambda (x) (string-match "^B_" x)) (org-get-tags))) (env-tag (and (org-string-nw-p value) (concat "B_" value)))) (org-set-tags-to (if env-tag (cons env-tag tags) tags)) @@ -1124,7 +1103,7 @@ aid, but the tag does not have any semantic meaning." (let* ((envs (append org-beamer-environments-special org-beamer-environments-extra org-beamer-environments-default)) - (org-tag-alist + (org-current-tag-alist (append '((:startgroup)) (mapcar (lambda (e) (cons (concat "B_" (car e)) (string-to-char (nth 1 e)))) diff --git a/lisp/ox-html.el b/lisp/ox-html.el index de2e5d9..404b62f 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -1,4 +1,4 @@ -;;; ox-html.el --- HTML Back-End for Org Export Engine +;;; ox-html.el --- HTML Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -30,20 +30,24 @@ ;;; Dependencies +(require 'cl-lib) +(require 'format-spec) (require 'ox) (require 'ox-publish) -(require 'format-spec) -(eval-when-compile (require 'cl) (require 'table nil 'noerror)) +(require 'table) ;;; Function Declarations (declare-function org-id-find-id-file "org-id" (id)) (declare-function htmlize-region "ext:htmlize" (beg end)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) (declare-function mm-url-decode-entities "mm-url" ()) +(defvar htmlize-css-name-prefix) +(defvar htmlize-output-type) +(defvar htmlize-output-type) +(defvar htmlize-css-name-prefix) + ;;; Define Back-End (org-export-define-backend 'html @@ -96,7 +100,6 @@ (underline . org-html-underline) (verbatim . org-html-verbatim) (verse-block . org-html-verse-block)) - :export-block "HTML" :filters-alist '((:filter-options . org-html-infojs-install-script) (:filter-final-output . org-html-final-function)) :menu-entry @@ -117,7 +120,6 @@ (:html-link-home "HTML_LINK_HOME" nil org-html-link-home) (:html-link-up "HTML_LINK_UP" nil org-html-link-up) (:html-mathjax "HTML_MATHJAX" nil "" space) - (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url) (:html-postamble nil "html-postamble" org-html-postamble) (:html-preamble nil "html-preamble" org-html-preamble) (:html-head "HTML_HEAD" nil org-html-head newline) @@ -165,7 +167,8 @@ (:html-viewport nil nil org-html-viewport) (:html-inline-images nil nil org-html-inline-images) (:html-table-attributes nil nil org-html-table-default-attributes) - (:html-table-row-tags nil nil org-html-table-row-tags) + (:html-table-row-open-tag nil nil org-html-table-row-open-tag) + (:html-table-row-close-tag nil nil org-html-table-row-close-tag) (:html-xml-declaration nil nil org-html-xml-declaration) (:infojs-opt "INFOJS_OPT" nil nil) ;; Redefine regular options. @@ -314,13 +317,97 @@ for the JavaScript code in this tag. border: 1px solid black; } pre.src:hover:before { display: inline;} - pre.src-sh:before { content: 'sh'; } - pre.src-bash:before { content: 'sh'; } + /* Languages per Org manual */ + pre.src-asymptote:before { content: 'Asymptote'; } + pre.src-awk:before { content: 'Awk'; } + pre.src-C:before { content: 'C'; } + /* pre.src-C++ doesn't work in CSS */ + pre.src-clojure:before { content: 'Clojure'; } + pre.src-css:before { content: 'CSS'; } + pre.src-D:before { content: 'D'; } + pre.src-ditaa:before { content: 'ditaa'; } + pre.src-dot:before { content: 'Graphviz'; } + pre.src-calc:before { content: 'Emacs Calc'; } pre.src-emacs-lisp:before { content: 'Emacs Lisp'; } - pre.src-R:before { content: 'R'; } - pre.src-perl:before { content: 'Perl'; } - pre.src-java:before { content: 'Java'; } - pre.src-sql:before { content: 'SQL'; } + pre.src-fortran:before { content: 'Fortran'; } + pre.src-gnuplot:before { content: 'gnuplot'; } + pre.src-haskell:before { content: 'Haskell'; } + pre.src-java:before { content: 'Java'; } + pre.src-js:before { content: 'Javascript'; } + pre.src-latex:before { content: 'LaTeX'; } + pre.src-ledger:before { content: 'Ledger'; } + pre.src-lisp:before { content: 'Lisp'; } + pre.src-lilypond:before { content: 'Lilypond'; } + pre.src-lua:before { content: 'Lua'; } + pre.src-matlab:before { content: 'MATLAB'; } + pre.src-mscgen:before { content: 'Mscgen'; } + pre.src-ocaml:before { content: 'Objective Caml'; } + pre.src-octave:before { content: 'Octave'; } + pre.src-org:before { content: 'Org mode'; } + pre.src-oz:before { content: 'OZ'; } + pre.src-plantuml:before { content: 'Plantuml'; } + pre.src-processing:before { content: 'Processing.js'; } + pre.src-python:before { content: 'Python'; } + pre.src-R:before { content: 'R'; } + pre.src-ruby:before { content: 'Ruby'; } + pre.src-sass:before { content: 'Sass'; } + pre.src-scheme:before { content: 'Scheme'; } + pre.src-screen:before { content: 'Gnu Screen'; } + pre.src-sed:before { content: 'Sed'; } + pre.src-sh:before { content: 'shell'; } + pre.src-sql:before { content: 'SQL'; } + pre.src-sqlite:before { content: 'SQLite'; } + /* additional languages in org.el's org-babel-load-languages alist */ + pre.src-forth:before { content: 'Forth'; } + pre.src-io:before { content: 'IO'; } + pre.src-J:before { content: 'J'; } + pre.src-makefile:before { content: 'Makefile'; } + pre.src-maxima:before { content: 'Maxima'; } + pre.src-perl:before { content: 'Perl'; } + pre.src-picolisp:before { content: 'Pico Lisp'; } + pre.src-scala:before { content: 'Scala'; } + pre.src-shell:before { content: 'Shell Script'; } + pre.src-ebnf2ps:before { content: 'ebfn2ps'; } + /* additional language identifiers per \"defun org-babel-execute\" + in ob-*.el */ + pre.src-cpp:before { content: 'C++'; } + pre.src-abc:before { content: 'ABC'; } + pre.src-coq:before { content: 'Coq'; } + pre.src-groovy:before { content: 'Groovy'; } + /* additional language identifiers from org-babel-shell-names in + ob-shell.el: ob-shell is the only babel language using a lambda to put + the execution function name together. */ + pre.src-bash:before { content: 'bash'; } + pre.src-csh:before { content: 'csh'; } + pre.src-ash:before { content: 'ash'; } + pre.src-dash:before { content: 'dash'; } + pre.src-ksh:before { content: 'ksh'; } + pre.src-mksh:before { content: 'mksh'; } + pre.src-posh:before { content: 'posh'; } + /* Additional Emacs modes also supported by the LaTeX listings package */ + pre.src-ada:before { content: 'Ada'; } + pre.src-asm:before { content: 'Assembler'; } + pre.src-caml:before { content: 'Caml'; } + pre.src-delphi:before { content: 'Delphi'; } + pre.src-html:before { content: 'HTML'; } + pre.src-idl:before { content: 'IDL'; } + pre.src-mercury:before { content: 'Mercury'; } + pre.src-metapost:before { content: 'MetaPost'; } + pre.src-modula-2:before { content: 'Modula-2'; } + pre.src-pascal:before { content: 'Pascal'; } + pre.src-ps:before { content: 'PostScript'; } + pre.src-prolog:before { content: 'Prolog'; } + pre.src-simula:before { content: 'Simula'; } + pre.src-tcl:before { content: 'tcl'; } + pre.src-tex:before { content: 'TeX'; } + pre.src-plain-tex:before { content: 'Plain TeX'; } + pre.src-verilog:before { content: 'Verilog'; } + pre.src-vhdl:before { content: 'VHDL'; } + pre.src-xml:before { content: 'XML'; } + pre.src-nxml:before { content: 'XML'; } + /* add a generic configuration mode; LaTeX export needs an additional + (add-to-list 'org-latex-listings-langs '(conf \" \")) in .emacs */ + pre.src-conf:before { content: 'Configuration File'; } table { border-collapse:collapse; } caption.t-above { caption-side: top; } @@ -353,6 +440,7 @@ for the JavaScript code in this tag. { font-size: 10px; font-weight: bold; white-space: nowrap; } .org-info-js_search-highlight { background-color: #ffff00; color: #000000; font-weight: bold; } + .org-svg { width: 90%; } /*]]>*/--> </style>" "The default style specification for exported HTML files. @@ -492,7 +580,7 @@ Option settings will replace the %MANAGER-OPTIONS cookie." :package-version '(Org . "8.0") :type 'string) -(defun org-html-infojs-install-script (exp-plist backend) +(defun org-html-infojs-install-script (exp-plist _backend) "Install script in export options when appropriate. EXP-PLIST is a plist containing export options. BACKEND is the export back-end currently used." @@ -529,21 +617,21 @@ export back-end currently used." options)) (match-string 1 options) default))) - (case opt - (path (setq template - (replace-regexp-in-string - "%SCRIPT_PATH" val template t t))) - (sdepth (when (integerp (read val)) - (setq sdepth (min (read val) sdepth)))) - (tdepth (when (integerp (read val)) - (setq tdepth (min (read val) tdepth)))) - (otherwise (setq val - (cond - ((or (eq val t) (equal val "t")) "1") - ((or (eq val nil) (equal val "nil")) "0") - ((stringp val) val) - (t (format "%s" val)))) - (push (cons var val) style))))) + (pcase opt + (`path (setq template + (replace-regexp-in-string + "%SCRIPT_PATH" val template t t))) + (`sdepth (when (integerp (read val)) + (setq sdepth (min (read val) sdepth)))) + (`tdepth (when (integerp (read val)) + (setq tdepth (min (read val) tdepth)))) + (_ (setq val + (cond + ((or (eq val t) (equal val "t")) "1") + ((or (eq val nil) (equal val "nil")) "0") + ((stringp val) val) + (t (format "%s" val)))) + (push (cons var val) style))))) ;; Now we set the depth of the *generated* TOC to SDEPTH, ;; because the toc will actually determine the splitting. How ;; much of the toc will actually be displayed is governed by the @@ -609,7 +697,7 @@ Warning: non-nil may break indentation of source code blocks." ;;;; Drawers -(defcustom org-html-format-drawer-function (lambda (name contents) contents) +(defcustom org-html-format-drawer-function (lambda (_name contents) contents) "Function called to format a drawer in HTML code. The function must accept two parameters: @@ -680,7 +768,7 @@ INFO the export options (plist). The function result will be used in the section format string." :group 'org-export-html - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type 'function) @@ -712,7 +800,7 @@ The function must accept seven parameters: The function should return the string to be exported." :group 'org-export-html - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type 'function) @@ -727,24 +815,20 @@ fragments. This option can also be set with the +OPTIONS line, e.g. \"tex:mathjax\". Allowed values are: -nil Ignore math snippets. -`verbatim' Keep everything in verbatim -`dvipng' Process the LaTeX fragments to images. This will also - include processing of non-math environments. -`imagemagick' Convert the LaTeX fragments to pdf files and use - imagemagick to convert pdf files to png files. -`mathjax' Do MathJax preprocessing and arrange for MathJax.js to - be loaded. -t Synonym for `mathjax'." + nil Ignore math snippets. + `verbatim' Keep everything in verbatim + `mathjax', t Do MathJax preprocessing and arrange for MathJax.js to + be loaded. + SYMBOL Any symbol defined in `org-preview-latex-process-alist', + e.g., `dvipng'." :group 'org-export-html :version "24.4" :package-version '(Org . "8.0") :type '(choice (const :tag "Do not process math in any way" nil) - (const :tag "Use dvipng to make images" dvipng) - (const :tag "Use imagemagick to make images" imagemagick) + (const :tag "Leave math verbatim" verbatim) (const :tag "Use MathJax to display math" mathjax) - (const :tag "Leave math verbatim" verbatim))) + (symbol :tag "Convert to image to display math" :value dvipng))) ;;;; Links :: Generic @@ -752,11 +836,11 @@ t Synonym for `mathjax'." "Non-nil means make file links to `file.org' point to `file.html'. When `org-mode' is exporting an `org-mode' file to HTML, links to non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org') should become links to the corresponding html +However, links to other Org files (recognized by the extension +\".org\") should become links to the corresponding HTML file, assuming that the linked `org-mode' file will also be converted to HTML. -When nil, the links still point to the plain `.org' file." +When nil, the links still point to the plain \".org\" file." :group 'org-export-html :type 'boolean) @@ -811,7 +895,7 @@ a style file to define the look of these classes. To get a start for your css file, start Emacs session and make sure that all the faces you are interested in are defined, for example by loading files in all modes you want. Then, use the command -\\[org-html-htmlize-generate-css] to extract class definitions." +`\\[org-html-htmlize-generate-css]' to extract class definitions." :group 'org-export-html :type '(choice (const css) (const inline-css) (const nil))) @@ -854,43 +938,50 @@ See also the variable `org-html-table-align-individual-fields'." :group 'org-export-html :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) -(defcustom org-html-table-row-tags '("<tr>" . "</tr>") - "The opening and ending tags for table rows. +(defcustom org-html-table-row-open-tag "<tr>" + "The opening tag for table rows. This is customizable so that alignment options can be specified. -Instead of strings, these can be Lisp forms that will be +Instead of strings, these can be a Lisp function that will be evaluated for each row in order to construct the table row tags. -During evaluation, these variables will be dynamically bound so that -you can reuse them: +The function will be called with these arguments: - `row-number': row number (0 is the first row) - `rowgroup-number': group number of current row - `start-rowgroup-p': non-nil means the row starts a group - `end-rowgroup-p': non-nil means the row ends a group - `top-row-p': non-nil means this is the top row - `bottom-row-p': non-nil means this is the bottom row + `number': row number (0 is the first row) + `group-number': group number of current row + `start-group?': non-nil means the row starts a group + `end-group?': non-nil means the row ends a group + `top?': non-nil means this is the top row + `bottom?': non-nil means this is the bottom row For example: -\(setq org-html-table-row-tags - (cons \\='(cond (top-row-p \"<tr class=\\\"tr-top\\\">\") - (bottom-row-p \"<tr class=\\\"tr-bottom\\\">\") - (t (if (= (mod row-number 2) 1) - \"<tr class=\\\"tr-odd\\\">\" - \"<tr class=\\\"tr-even\\\">\"))) - \"</tr>\")) + (setq org-html-table-row-open-tag + (lambda (number group-number start-group? end-group-p top? bottom?) + (cond (top? \"<tr class=\\\"tr-top\\\">\") + (bottom? \"<tr class=\\\"tr-bottom\\\">\") + (t (if (= (mod number 2) 1) + \"<tr class=\\\"tr-odd\\\">\" + \"<tr class=\\\"tr-even\\\">\"))))) will use the \"tr-top\" and \"tr-bottom\" classes for the top row and the bottom row, and otherwise alternate between \"tr-odd\" and \"tr-even\" for odd and even rows." :group 'org-export-html - :type '(cons - (choice :tag "Opening tag" - (string :tag "Specify") - (sexp)) - (choice :tag "Closing tag" - (string :tag "Specify") - (sexp)))) + :type '(choice :tag "Opening tag" + (string :tag "Specify") + (function))) + +(defcustom org-html-table-row-close-tag "</tr>" + "The closing tag for table rows. +This is customizable so that alignment options can be specified. +Instead of strings, this can be a Lisp function that will be +evaluated for each row in order to construct the table row tags. + +See documentation of `org-html-table-row-open-tag'." + :group 'org-export-html + :type '(choice :tag "Closing tag" + (string :tag "Specify") + (function))) (defcustom org-html-table-align-individual-fields t "Non-nil means attach style attributes for alignment to each table field. @@ -1326,8 +1417,6 @@ ignored." ;;;; Template :: Scripts -(define-obsolete-variable-alias - 'org-html-style-include-scripts 'org-html-head-include-scripts "24.4") (defcustom org-html-head-include-scripts t "Non-nil means include the JavaScript snippets in exported HTML files. The actual script is defined in `org-html-scripts' and should @@ -1339,8 +1428,6 @@ not be modified." ;;;; Template :: Styles -(define-obsolete-variable-alias - 'org-html-style-include-default 'org-html-head-include-default-style "24.4") (defcustom org-html-head-include-default-style t "Non-nil means include the default style in exported HTML files. The actual style is defined in `org-html-style-default' and @@ -1353,7 +1440,6 @@ style information." ;;;###autoload (put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) -(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") (defcustom org-html-head "" "Org-wide head definitions for exported HTML files. @@ -1425,7 +1511,7 @@ The viewport meta tag is inserted if this variable is non-nil. See the following site for a reference: https://developer.mozilla.org/en-US/docs/Mozilla/Mobile/Viewport_meta_tag" :group 'org-export-html - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(choice (const :tag "Disable" nil) (list :tag "Enable" @@ -1543,21 +1629,27 @@ a communication channel." info))) (defun org-html--svg-image (source attributes info) - "Return \"object\" appropriate for embedding svg file SOURCE -with assoicated ATTRIBUTES. INFO is a plist used as a -communication channel. + "Return \"object\" embedding svg file SOURCE with given ATTRIBUTES. +INFO is a plist used as a communication channel. -The special attribute \"fallback\" can be used to specify a fallback -image file to use if the object embedding is not supported." +The special attribute \"fallback\" can be used to specify a +fallback image file to use if the object embedding is not +supported. CSS class \"org-svg\" is assigned as the class of the +object unless a different class is specified with an attribute." (let ((fallback (plist-get attributes :fallback)) (attrs (org-html--make-attribute-string - (plist-put attributes :fallback nil)))) - (format "<object type=\"image/svg+xml\" data=\"%s\" %s>\n%s</object>" - source attrs - (if fallback - (org-html-close-tag - "img" (format "src=\"%s\" %s" fallback attrs) info) - "Sorry, your browser does not support SVG.")))) + (org-combine-plists + ;; Remove fallback attribute, which is not meant to + ;; appear directly in the attributes string, and + ;; provide a default class if none is set. + '(:class "org-svg") attributes '(:fallback nil))))) + (format "<object type=\"image/svg+xml\" data=\"%s\" %s>\n%s</object>" + source + attrs + (if fallback + (org-html-close-tag + "img" (format "src=\"%s\" %s" fallback attrs) info) + "Sorry, your browser does not support SVG.")))) (defun org-html--textarea-block (element) "Transcode ELEMENT into a textarea block. @@ -1569,7 +1661,7 @@ ELEMENT is either a src block or an example block." (or (plist-get attr :height) (org-count-lines code)) code))) -(defun org-html--has-caption-p (element &optional info) +(defun org-html--has-caption-p (element &optional _info) "Non-nil when ELEMENT has a caption affiliated keyword. INFO is a plist used as a communication channel. This function is meant to be used as a predicate for `org-export-get-ordinal' or @@ -1616,7 +1708,7 @@ produce code that uses these same face definitions." (when (and (symbolp f) (or (not i) (not (listp i)))) (insert (org-add-props (copy-sequence "1") nil 'face f)))) (htmlize-region (point-min) (point-max)))) - (org-pop-to-buffer-same-window "*html*") + (pop-to-buffer-same-window "*html*") (goto-char (point-min)) (if (re-search-forward "<style" nil t) (delete-region (point-min) (match-beginning 0))) @@ -1628,26 +1720,23 @@ produce code that uses these same face definitions." (defun org-html--make-string (n string) "Build a string by concatenating N times STRING." - (let (out) (dotimes (i n out) (setq out (concat string out))))) + (let (out) (dotimes (_ n out) (setq out (concat string out))))) (defun org-html-fix-class-name (kwd) ; audit callers of this function "Turn todo keyword KWD into a valid class name. Replaces invalid characters with \"_\"." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" kwd) - (setq kwd (replace-match "_" t t kwd)))) - kwd) + (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" kwd nil t)) (defun org-html-footnote-section (info) "Format the footnote section. INFO is a plist used as a communication channel." (let* ((fn-alist (org-export-collect-footnote-definitions info)) (fn-alist - (loop for (n type raw) in fn-alist collect - (cons n (if (eq (org-element-type raw) 'org-data) - (org-trim (org-export-data raw info)) - (format "<div class=\"footpara\">%s</div>" - (org-trim (org-export-data raw info)))))))) + (cl-loop for (n _type raw) in fn-alist collect + (cons n (if (eq (org-element-type raw) 'org-data) + (org-trim (org-export-data raw info)) + (format "<div class=\"footpara\">%s</div>" + (org-trim (org-export-data raw info)))))))) (when fn-alist (format (plist-get info :html-footnotes-section) @@ -1705,45 +1794,45 @@ INFO is a plist used as a communication channel." " -->\n"))) (format (if (org-html-html5-p info) - (org-html-close-tag "meta" " charset=\"%s\"" info) + (org-html-close-tag "meta" "charset=\"%s\"" info) (org-html-close-tag - "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"" + "meta" "http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"" info)) charset) "\n" (let ((viewport-options - (org-remove-if-not (lambda (cell) (org-string-nw-p (cadr cell))) + (cl-remove-if-not (lambda (cell) (org-string-nw-p (cadr cell))) (plist-get info :html-viewport)))) (and viewport-options (concat (org-html-close-tag "meta" - (format " name=\"viewport\" content=\"%s\"" + (format "name=\"viewport\" content=\"%s\"" (mapconcat (lambda (elm) (format "%s=%s" (car elm) (cadr elm))) viewport-options ", ")) info) "\n"))) (format "<title>%s</title>\n" title) - (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info) + (org-html-close-tag "meta" "name=\"generator\" content=\"Org mode\"" info) "\n" (and (org-string-nw-p author) (concat (org-html-close-tag "meta" - (format " name=\"author\" content=\"%s\"" + (format "name=\"author\" content=\"%s\"" (funcall protect-string author)) info) "\n")) (and (org-string-nw-p description) (concat (org-html-close-tag "meta" - (format " name=\"description\" content=\"%s\"\n" + (format "name=\"description\" content=\"%s\"\n" (funcall protect-string description)) info) "\n")) (and (org-string-nw-p keywords) (concat (org-html-close-tag "meta" - (format " name=\"keywords\" content=\"%s\"" + (format "name=\"keywords\" content=\"%s\"" (funcall protect-string keywords)) info) "\n"))))) @@ -1760,7 +1849,7 @@ INFO is a plist used as a communication channel." (when (and (plist-get info :html-htmlized-css-url) (eq org-html-htmlize-output-type 'css)) (org-html-close-tag "link" - (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\"" + (format "rel=\"stylesheet\" href=\"%s\" type=\"text/css\"" (plist-get info :html-htmlized-css-url)) info)) (when (plist-get info :html-head-include-scripts) org-html-scripts)))) @@ -1773,20 +1862,17 @@ INFO is a plist used as a communication channel." '(latex-fragment latex-environment) 'identity info t)) (let ((template (plist-get info :html-mathjax-template)) (options (plist-get info :html-mathjax-options)) - (in-buffer (or (plist-get info :html-mathjax) "")) - name val x) - (mapc - (lambda (e) - (setq name (car e) val (nth 1 e)) - (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) - (setq val (car (read-from-string - (substring in-buffer (match-end 0)))))) - (if (not (stringp val)) (setq val (format "%s" val))) - (while (string-match (concat "%" (upcase (symbol-name name))) template) - (setq template (replace-match val t t template)))) - options) - ;; Return the modified template. - (org-element-normalize-string template)))) + (in-buffer (or (plist-get info :html-mathjax) ""))) + (dolist (e options (org-element-normalize-string template)) + (let ((name (car e)) + (val (nth 1 e))) + (when (string-match (concat "\\<" (symbol-name name) ":") in-buffer) + (setq val + (car (read-from-string (substring in-buffer (match-end 0)))))) + (unless (stringp val) (setq val (format "%s" val))) + (while (string-match (concat "%" (upcase (symbol-name name))) + template) + (setq template (replace-match val t t template)))))))) (defun org-html-format-spec (info) "Return format specification for elements that can be @@ -1825,7 +1911,6 @@ communication channel." (author (cdr (assq ?a spec))) (email (cdr (assq ?e spec))) (creator (cdr (assq ?c spec))) - (timestamp (cdr (assq ?T spec))) (validation-link (cdr (assq ?v spec)))) (concat (when (and (plist-get info :with-date) @@ -1854,15 +1939,17 @@ communication channel." (format "<p class=\"validation\">%s</p>\n" validation-link)))) (t (format-spec - (or (cadr (assoc + (or (cadr (assoc-string (plist-get info :language) (eval (intern - (format "org-html-%s-format" type))))) + (format "org-html-%s-format" type))) + t)) (cadr - (assoc + (assoc-string "en" (eval - (intern (format "org-html-%s-format" type)))))) + (intern (format "org-html-%s-format" type))) + t))) spec)))))) (let ((div (assq type (plist-get info :html-divs)))) (when (org-string-nw-p section-contents) @@ -1909,10 +1996,12 @@ holding export options." (org-html-doctype info) "\n" (concat "<html" - (when (org-html-xhtml-p info) - (format - " xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\"" - (plist-get info :language) (plist-get info :language))) + (cond ((org-html-xhtml-p info) + (format + " xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\"" + (plist-get info :language) (plist-get info :language))) + ((org-html-html5-p info) + (format " lang=\"%s\"" (plist-get info :language)))) ">\n") "<head>\n" (org-html--build-meta-info info) @@ -1984,7 +2073,7 @@ INFO is a plist used as a communication channel." ;;;; Priority -(defun org-html--priority (priority info) +(defun org-html--priority (priority _info) "Format a priority into HTML. PRIORITY is the character code of the priority or nil. INFO is a plist containing export options." @@ -2115,9 +2204,7 @@ a plist used as a communication channel." ;; Does the src block contain labels? (retain-labels (org-element-property :retain-labels element)) ;; Does it have line numbers? - (num-start (case (org-element-property :number-lines element) - (continued (org-export-get-loc element info)) - (new 0)))) + (num-start (org-export-get-loc element info))) (org-html-do-format-code code lang refs retain-labels num-start))) @@ -2164,8 +2251,7 @@ and value is its relative level, as an integer." (level (cdr entry))) (concat (let* ((cnt (- level prev-level)) - (times (if (> cnt 0) (1- cnt) (- cnt))) - rtn) + (times (if (> cnt 0) (1- cnt) (- cnt)))) (setq prev-level level) (concat (org-html--make-string @@ -2241,10 +2327,12 @@ of listings as a string, or nil if it is empty." (concat "<li>" (if (not label) - (concat (format initial-fmt (incf count)) " " title) + (concat (format initial-fmt (cl-incf count)) + " " + title) (format "<a href=\"#%s\">%s %s</a>" label - (format initial-fmt (incf count)) + (format initial-fmt (cl-incf count)) title)) "</li>"))) lol-entries "\n")) @@ -2278,10 +2366,12 @@ of tables as a string, or nil if it is empty." (concat "<li>" (if (not label) - (concat (format initial-fmt (incf count)) " " title) + (concat (format initial-fmt (cl-incf count)) + " " + title) (format "<a href=\"#%s\">%s %s</a>" label - (format initial-fmt (incf count)) + (format initial-fmt (cl-incf count)) title)) "</li>"))) lol-entries "\n")) @@ -2292,7 +2382,7 @@ of tables as a string, or nil if it is empty." ;;;; Bold -(defun org-html-bold (bold contents info) +(defun org-html-bold (_bold contents info) "Transcode BOLD from Org to HTML. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." @@ -2301,7 +2391,7 @@ contextual information." ;;;; Center Block -(defun org-html-center-block (center-block contents info) +(defun org-html-center-block (_center-block contents _info) "Transcode a CENTER-BLOCK element from Org to HTML. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -2309,7 +2399,7 @@ holding contextual information." ;;;; Clock -(defun org-html-clock (clock contents info) +(defun org-html-clock (clock _contents _info) "Transcode a CLOCK element from Org to HTML. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -2325,7 +2415,7 @@ channel." ;;;; Code -(defun org-html-code (code contents info) +(defun org-html-code (code _contents info) "Transcode CODE from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." @@ -2344,7 +2434,7 @@ holding contextual information." ;;;; Dynamic Block -(defun org-html-dynamic-block (dynamic-block contents info) +(defun org-html-dynamic-block (_dynamic-block contents _info) "Transcode a DYNAMIC-BLOCK element from Org to HTML. CONTENTS holds the contents of the block. INFO is a plist holding contextual information. See `org-export-data'." @@ -2352,7 +2442,7 @@ holding contextual information. See `org-export-data'." ;;;; Entity -(defun org-html-entity (entity contents info) +(defun org-html-entity (entity _contents _info) "Transcode an ENTITY object from Org to HTML. CONTENTS are the definition itself. INFO is a plist holding contextual information." @@ -2360,18 +2450,25 @@ contextual information." ;;;; Example Block -(defun org-html-example-block (example-block contents info) +(defun org-html-example-block (example-block _contents info) "Transcode a EXAMPLE-BLOCK element from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." - (if (org-export-read-attribute :attr_html example-block :textarea) - (org-html--textarea-block example-block) - (format "<pre class=\"example\">\n%s</pre>" - (org-html-format-code example-block info)))) + (let ((attributes (org-export-read-attribute :attr_html example-block))) + (if (plist-get attributes :textarea) + (org-html--textarea-block example-block) + (format "<pre class=\"example\"%s>\n%s</pre>" + (let* ((name (org-element-property :name example-block)) + (a (org-html--make-attribute-string + (if (or (not name) (plist-member attributes :id)) + attributes + (plist-put attributes :id name))))) + (if (org-string-nw-p a) (concat " " a) "")) + (org-html-format-code example-block info))))) ;;;; Export Snippet -(defun org-html-export-snippet (export-snippet contents info) +(defun org-html-export-snippet (export-snippet _contents _info) "Transcode a EXPORT-SNIPPET object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." @@ -2380,7 +2477,7 @@ information." ;;;; Export Block -(defun org-html-export-block (export-block contents info) +(defun org-html-export-block (export-block _contents _info) "Transcode a EXPORT-BLOCK element from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (when (string= (org-element-property :type export-block) "HTML") @@ -2388,7 +2485,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Fixed Width -(defun org-html-fixed-width (fixed-width contents info) +(defun org-html-fixed-width (fixed-width _contents _info) "Transcode a FIXED-WIDTH element from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (format "<pre class=\"example\">\n%s</pre>" @@ -2398,7 +2495,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Footnote Reference -(defun org-html-footnote-reference (footnote-reference contents info) +(defun org-html-footnote-reference (footnote-reference _contents info) "Transcode a FOOTNOTE-REFERENCE element from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (concat @@ -2427,8 +2524,6 @@ holding contextual information." (unless (org-element-property :footnote-section-p headline) (let* ((numberedp (org-export-numbered-headline-p headline info)) (numbers (org-export-get-headline-number headline info)) - (section-number (and numbers - (mapconcat #'number-to-string numbers "-"))) (level (+ (org-export-get-relative-level headline info) (1- (plist-get info :html-toplevel-hlevel)))) (todo (and (plist-get info :with-todo-keywords) @@ -2500,7 +2595,7 @@ holding contextual information." (org-html--container headline info))))))) (defun org-html-format-headline-default-function - (todo todo-type priority text tags info) + (todo _todo-type priority text tags info) "Default format function for a headline. See `org-html-format-headline-function' for details." (let ((todo (org-html--todo todo info)) @@ -2519,19 +2614,19 @@ See `org-html-format-headline-function' for details." ;;;; Horizontal Rule -(defun org-html-horizontal-rule (horizontal-rule contents info) +(defun org-html-horizontal-rule (_horizontal-rule _contents info) "Transcode an HORIZONTAL-RULE object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (org-html-close-tag "hr" nil info)) ;;;; Inline Src Block -(defun org-html-inline-src-block (inline-src-block contents info) +(defun org-html-inline-src-block (inline-src-block _contents info) "Transcode an INLINE-SRC-BLOCK element from Org to HTML. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let ((lang (org-element-property :language inline-src-block)) - (code (org-html-format-code inline-src-block info)) + (code (org-element-property :value inline-src-block)) (label (let ((lbl (and (org-element-property :name inline-src-block) (org-export-get-reference inline-src-block info)))) @@ -2568,7 +2663,7 @@ See `org-html-format-inlinetask-function' for details." ;;;; Italic -(defun org-html-italic (italic contents info) +(defun org-html-italic (_italic contents info) "Transcode ITALIC from Org to HTML. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." @@ -2587,8 +2682,8 @@ INFO is a plist holding contextual information. See org-html-checkbox-types))))) (defun org-html-format-list-item (contents type checkbox info - &optional term-counter-id - headline) + &optional term-counter-id + headline) "Format a list item into HTML." (let ((class (if checkbox (format " class=\"%s\"" @@ -2597,20 +2692,20 @@ INFO is a plist holding contextual information. See (and checkbox " "))) (br (org-html-close-tag "br" nil info))) (concat - (case type - (ordered + (pcase type + (`ordered (let* ((counter term-counter-id) (extra (if counter (format " value=\"%s\"" counter) ""))) (concat (format "<li%s%s>" class extra) (when headline (concat headline br))))) - (unordered + (`unordered (let* ((id term-counter-id) (extra (if id (format " id=\"%s\"" id) ""))) (concat (format "<li%s%s>" class extra) (when headline (concat headline br))))) - (descriptive + (`descriptive (let* ((term term-counter-id)) (setq term (or term "(no term)")) ;; Check-boxes in descriptive lists are associated to tag. @@ -2619,10 +2714,10 @@ INFO is a plist holding contextual information. See "<dd>")))) (unless (eq type 'descriptive) checkbox) (and contents (org-trim contents)) - (case type - (ordered "</li>") - (unordered "</li>") - (descriptive "</dd>"))))) + (pcase type + (`ordered "</li>") + (`unordered "</li>") + (`descriptive "</dd>"))))) (defun org-html-item (item contents info) "Transcode an ITEM element from Org to HTML. @@ -2639,7 +2734,7 @@ contextual information." ;;;; Keyword -(defun org-html-keyword (keyword contents info) +(defun org-html-keyword (keyword _contents info) "Transcode a KEYWORD element from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (let ((key (org-element-property :key keyword)) @@ -2652,7 +2747,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ((string-match "\\<headlines\\>" value) (let ((depth (and (string-match "\\<[0-9]+\\>" value) (string-to-number (match-string 0 value)))) - (localp (org-string-match-p "\\<local\\>" value))) + (localp (string-match-p "\\<local\\>" value))) (org-html-toc depth info (and localp keyword)))) ((string= "listings" value) (org-html-list-of-listings info)) ((string= "tables" value) (org-html-list-of-tables info)))))))) @@ -2661,10 +2756,11 @@ CONTENTS is nil. INFO is a plist holding contextual information." (defun org-html-format-latex (latex-frag processing-type info) "Format a LaTeX fragment LATEX-FRAG into HTML. -PROCESSING-TYPE designates the tool used for conversion. It is -a symbol among `mathjax', `dvipng', `imagemagick', `verbatim' nil -and t. See `org-html-with-latex' for more information. INFO is -a plist containing export properties." +PROCESSING-TYPE designates the tool used for conversion. It can +be `mathjax', `verbatim', nil, t or symbols in +`org-preview-latex-process-alist', e.g., `dvipng', `dvisvgm' or +`imagemagick'. See `org-html-with-latex' for more information. +INFO is a plist containing export properties." (let ((cache-relpath "") (cache-dir "")) (unless (eq processing-type 'mathjax) (let ((bfn (or (buffer-file-name) @@ -2679,7 +2775,7 @@ a plist containing export properties." "\n") "\n"))))) (setq cache-relpath - (concat "ltxpng/" + (concat (file-name-as-directory org-preview-latex-image-directory) (file-name-sans-extension (file-name-nondirectory bfn))) cache-dir (file-name-directory bfn)) @@ -2689,51 +2785,51 @@ a plist containing export properties." (setq latex-frag (concat latex-header latex-frag)))) (with-temp-buffer (insert latex-frag) - (org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..." - nil processing-type) + (org-format-latex cache-relpath nil nil cache-dir nil + "Creating LaTeX Image..." nil processing-type) (buffer-string)))) -(defun org-html-latex-environment (latex-environment contents info) +(defun org-html-latex-environment (latex-environment _contents info) "Transcode a LATEX-ENVIRONMENT element from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (let ((processing-type (plist-get info :with-latex)) (latex-frag (org-remove-indentation (org-element-property :value latex-environment))) (attributes (org-export-read-attribute :attr_html latex-environment))) - (case processing-type - ((t mathjax) - (org-html-format-latex latex-frag 'mathjax info)) - ((dvipng imagemagick) - (let ((formula-link - (org-html-format-latex latex-frag processing-type info))) - (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) - ;; Do not provide a caption or a name to be consistent with - ;; `mathjax' handling. - (org-html--wrap-image - (org-html--format-image - (match-string 1 formula-link) attributes info) info)))) - (t latex-frag)))) + (cond + ((memq processing-type '(t mathjax)) + (org-html-format-latex latex-frag 'mathjax info)) + ((assq processing-type org-preview-latex-process-alist) + (let ((formula-link + (org-html-format-latex latex-frag processing-type info))) + (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) + ;; Do not provide a caption or a name to be consistent with + ;; `mathjax' handling. + (org-html--wrap-image + (org-html--format-image + (match-string 1 formula-link) attributes info) info)))) + (t latex-frag)))) ;;;; Latex Fragment -(defun org-html-latex-fragment (latex-fragment contents info) +(defun org-html-latex-fragment (latex-fragment _contents info) "Transcode a LATEX-FRAGMENT object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (let ((latex-frag (org-element-property :value latex-fragment)) (processing-type (plist-get info :with-latex))) - (case processing-type - ((t mathjax) - (org-html-format-latex latex-frag 'mathjax info)) - ((dvipng imagemagick) - (let ((formula-link - (org-html-format-latex latex-frag processing-type info))) - (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) - (org-html--format-image (match-string 1 formula-link) nil info)))) - (t latex-frag)))) + (cond + ((memq processing-type '(t mathjax)) + (org-html-format-latex latex-frag 'mathjax info)) + ((assq processing-type org-preview-latex-process-alist) + (let ((formula-link + (org-html-format-latex latex-frag processing-type info))) + (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) + (org-html--format-image (match-string 1 formula-link) nil info)))) + (t latex-frag)))) ;;;; Line Break -(defun org-html-line-break (line-break contents info) +(defun org-html-line-break (_line-break _contents info) "Transcode a LINE-BREAK object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (concat (org-html-close-tag "br" nil info) "\n")) @@ -2754,13 +2850,13 @@ if its description is a single link targeting an image file." (org-element-map (org-element-contents link) (cons 'plain-text org-element-all-objects) (lambda (obj) - (case (org-element-type obj) - (plain-text (org-string-nw-p obj)) - (link (if (= link-count 1) t - (incf link-count) - (not (org-export-inline-image-p - obj (plist-get info :html-inline-image-rules))))) - (otherwise t))) + (pcase (org-element-type obj) + (`plain-text (org-string-nw-p obj)) + (`link (if (= link-count 1) t + (cl-incf link-count) + (not (org-export-inline-image-p + obj (plist-get info :html-inline-image-rules))))) + (_ t))) info t))))) (defvar org-html-standalone-image-predicate) @@ -2782,9 +2878,9 @@ further. For example, to check for only captioned standalone images, set it to: (lambda (paragraph) (org-element-property :caption paragraph))" - (let ((paragraph (case (org-element-type element) - (paragraph element) - (link (org-export-get-parent element))))) + (let ((paragraph (pcase (org-element-type element) + (`paragraph element) + (`link (org-export-get-parent element))))) (and (eq (org-element-type paragraph) 'paragraph) (or (not (fboundp 'org-html-standalone-image-predicate)) (funcall org-html-standalone-image-predicate paragraph)) @@ -2792,13 +2888,13 @@ images, set it to: (let ((link-count 0)) (org-element-map (org-element-contents paragraph) (cons 'plain-text org-element-all-objects) - #'(lambda (obj) - (when (case (org-element-type obj) - (plain-text (org-string-nw-p obj)) - (link (or (> (incf link-count) 1) - (not (org-html-inline-image-p obj info)))) - (otherwise t)) - (throw 'exit nil))) + (lambda (obj) + (when (pcase (org-element-type obj) + (`plain-text (org-string-nw-p obj)) + (`link (or (> (cl-incf link-count) 1) + (not (org-html-inline-image-p obj info)))) + (_ t)) + (throw 'exit nil))) info nil 'link) (= link-count 1)))))) @@ -2827,9 +2923,8 @@ INFO is a plist holding contextual information. See (desc (org-string-nw-p desc)) (path (cond - ((member type '("http" "https" "ftp" "mailto")) - (org-link-escape-browser - (org-link-unescape (concat type ":" raw-path)))) + ((member type '("http" "https" "ftp" "mailto" "news")) + (url-encode-url (org-link-unescape (concat type ":" raw-path)))) ((string= type "file") ;; Treat links to ".org" files as ".html", if needed. (setq raw-path @@ -2842,15 +2937,19 @@ INFO is a plist holding contextual information. See ((and home use-abs-url) (setq raw-path (concat (file-name-as-directory home) raw-path)))) ;; Add search option, if any. A search option can be - ;; relative to a custom-id, a headline title a name, - ;; a target or a radio-target. + ;; relative to a custom-id, a headline title, a name or + ;; a target. (let ((option (org-element-property :search-option link))) - (if (not option) raw-path - (concat raw-path - "#" - (org-publish-resolve-external-link - option - (org-element-property :path link)))))) + (cond ((not option) raw-path) + ;; Since HTML back-end use custom-id value as-is, + ;; resolving is them is trivial. + ((eq (string-to-char option) ?#) (concat raw-path option)) + (t + (concat raw-path + "#" + (org-publish-resolve-external-link + option + (org-element-property :path link))))))) (t raw-path))) ;; Extract attributes from parent's paragraph. HACK: Only do ;; this for the first link in parent (inner image link for @@ -2891,9 +2990,9 @@ INFO is a plist holding contextual information. See (let ((destination (if (string= type "fuzzy") (org-export-resolve-fuzzy-link link info) (org-export-resolve-id-link link info)))) - (case (org-element-type destination) + (pcase (org-element-type destination) ;; ID link points to an external file. - (plain-text + (`plain-text (let ((fragment (concat "ID-" path)) ;; Treat links to ".org" files as ".html", if needed. (path (funcall link-org-files-as-html-maybe @@ -2901,13 +3000,13 @@ INFO is a plist holding contextual information. See (format "<a href=\"%s#%s\"%s>%s</a>" path fragment attributes (or desc destination)))) ;; Fuzzy link points nowhere. - ((nil) + (`nil (format "<i>%s</i>" (or desc (org-export-data (org-element-property :raw-link link) info)))) ;; Link points to a headline. - (headline + (`headline (let ((href (or (org-element-property :CUSTOM_ID destination) (org-export-get-reference destination info))) ;; What description to use? @@ -2927,7 +3026,7 @@ INFO is a plist holding contextual information. See (org-element-property :title destination) info))))) (format "<a href=\"#%s\"%s>%s</a>" href attributes desc))) ;; Fuzzy link points to a target or an element. - (t + (_ (let* ((ref (org-export-get-reference destination info)) (org-html-standalone-image-predicate #'org-html--has-caption-p) @@ -2964,13 +3063,16 @@ INFO is a plist holding contextual information. See desc)) ;; External link without a description part. (path (let ((path (org-html-encode-plain-text path))) - (format "<a href=\"%s\"%s>%s</a>" path attributes path))) + (format "<a href=\"%s\"%s>%s</a>" + path + attributes + (org-link-unescape path)))) ;; No path, only description. Try to do something useful. (t (format "<i>%s</i>" desc))))) ;;;; Node Property -(defun org-html-node-property (node-property contents info) +(defun org-html-node-property (node-property _contents _info) "Transcode a NODE-PROPERTY element from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." @@ -3007,16 +3109,16 @@ the plist used as a communication channel." (let ((raw (org-export-data (org-export-get-caption paragraph) info)) (org-html-standalone-image-predicate - 'org-html--has-caption-p)) + #'org-html--has-caption-p)) (if (not (org-string-nw-p raw)) raw - (concat - "<span class=\"figure-number\">" - (format (org-html--translate "Figure %d:" info) - (org-export-get-ordinal - (org-element-map paragraph 'link - 'identity info t) - info nil 'org-html-standalone-image-p)) - "</span> " raw)))) + (concat "<span class=\"figure-number\">" + (format (org-html--translate "Figure %d:" info) + (org-export-get-ordinal + (org-element-map paragraph 'link + #'identity info t) + info nil #'org-html-standalone-image-p)) + " </span>" + raw)))) (label (and (org-element-property :name paragraph) (org-export-get-reference paragraph info)))) (org-html--wrap-image contents info caption label))) @@ -3034,26 +3136,25 @@ the plist used as a communication channel." "Insert the beginning of the HTML list depending on TYPE. When ARG1 is a string, use it as the start parameter for ordered lists." - (case type - (ordered + (pcase type + (`ordered (format "<ol class=\"org-ol\"%s>" (if arg1 (format " start=\"%d\"" arg1) ""))) - (unordered "<ul class=\"org-ul\">") - (descriptive "<dl class=\"org-dl\">"))) + (`unordered "<ul class=\"org-ul\">") + (`descriptive "<dl class=\"org-dl\">"))) (defun org-html-end-plain-list (type) "Insert the end of the HTML list depending on TYPE." - (case type - (ordered "</ol>") - (unordered "</ul>") - (descriptive "</dl>"))) + (pcase type + (`ordered "</ol>") + (`unordered "</ul>") + (`descriptive "</dl>"))) -(defun org-html-plain-list (plain-list contents info) +(defun org-html-plain-list (plain-list contents _info) "Transcode a PLAIN-LIST element from Org to HTML. CONTENTS is the contents of the list. INFO is a plist holding contextual information." - (let* (arg1 ;; (assoc :counter (org-element-map plain-list 'item - (type (org-element-property :type plain-list))) + (let ((type (org-element-property :type plain-list))) (format "%s\n%s%s" (org-html-begin-plain-list type) contents (org-html-end-plain-list type)))) @@ -3062,13 +3163,10 @@ contextual information." (defun org-html-convert-special-strings (string) "Convert special characters in STRING to HTML." - (let ((all org-html-special-string-regexps) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (setq string (replace-match rpl t nil string)))) - string)) + (dolist (a org-html-special-string-regexps string) + (let ((re (car a)) + (rpl (cdr a))) + (setq string (replace-regexp-in-string re rpl string t))))) (defun org-html-encode-plain-text (text) "Convert plain text characters from TEXT to HTML equivalent. @@ -3102,34 +3200,31 @@ contextual information." ;; Planning -(defun org-html-planning (planning contents info) +(defun org-html-planning (planning _contents info) "Transcode a PLANNING element from Org to HTML. CONTENTS is nil. INFO is a plist used as a communication channel." - (let ((span-fmt "<span class=\"timestamp-kwd\">%s</span> <span class=\"timestamp\">%s</span>")) - (format - "<p><span class=\"timestamp-wrapper\">%s</span></p>" - (mapconcat - 'identity - (delq nil - (list - (let ((closed (org-element-property :closed planning))) - (when closed - (format span-fmt org-closed-string - (org-timestamp-translate closed)))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline - (format span-fmt org-deadline-string - (org-timestamp-translate deadline)))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (format span-fmt org-scheduled-string - (org-timestamp-translate scheduled)))))) - " ")))) + (format + "<p><span class=\"timestamp-wrapper\">%s</span></p>" + (org-trim + (mapconcat + (lambda (pair) + (let ((timestamp (cdr pair))) + (when timestamp + (let ((string (car pair))) + (format "<span class=\"timestamp-kwd\">%s</span> \ +<span class=\"timestamp\">%s</span> " + string + (org-html-plain-text (org-timestamp-translate timestamp) + info)))))) + `((,org-closed-string . ,(org-element-property :closed planning)) + (,org-deadline-string . ,(org-element-property :deadline planning)) + (,org-scheduled-string . ,(org-element-property :scheduled planning))) + "")))) ;;;; Property Drawer -(defun org-html-property-drawer (property-drawer contents info) +(defun org-html-property-drawer (_property-drawer contents _info) "Transcode a PROPERTY-DRAWER element from Org to HTML. CONTENTS holds the contents of the drawer. INFO is a plist holding contextual information." @@ -3138,11 +3233,19 @@ holding contextual information." ;;;; Quote Block -(defun org-html-quote-block (quote-block contents info) +(defun org-html-quote-block (quote-block contents _info) "Transcode a QUOTE-BLOCK element from Org to HTML. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." - (format "<blockquote>\n%s</blockquote>" contents)) + (format "<blockquote%s>\n%s</blockquote>" + (let* ((name (org-element-property :name quote-block)) + (attributes (org-export-read-attribute :attr_html quote-block)) + (a (org-html--make-attribute-string + (if (or (not name) (plist-member attributes :id)) + attributes + (plist-put attributes :id name))))) + (if (org-string-nw-p a) (concat " " a) "")) + contents)) ;;;; Section @@ -3185,48 +3288,60 @@ contextual information." CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let* ((block-type (org-element-property :type special-block)) - (contents (or contents "")) - (html5-fancy (and (org-html--html5-fancy-p info) - (member block-type org-html-html5-elements))) - (attributes (org-export-read-attribute :attr_html special-block))) + (html5-fancy (and (org-html--html5-fancy-p info) + (member block-type org-html-html5-elements))) + (attributes (org-export-read-attribute :attr_html special-block))) (unless html5-fancy (let ((class (plist-get attributes :class))) - (setq attributes (plist-put attributes :class - (if class (concat class " " block-type) - block-type))))) - (setq attributes (org-html--make-attribute-string attributes)) - (when (not (equal attributes "")) - (setq attributes (concat " " attributes))) - (if html5-fancy - (format "<%s%s>\n%s</%s>" block-type attributes - contents block-type) - (format "<div%s>\n%s\n</div>" attributes contents)))) + (setq attributes (plist-put attributes :class + (if class (concat class " " block-type) + block-type))))) + (let* ((contents (or contents "")) + (name (org-element-property :name special-block)) + (a (org-html--make-attribute-string + (if (or (not name) (plist-member attributes :id)) + attributes + (plist-put attributes :id name)))) + (str (if (org-string-nw-p a) (concat " " a) ""))) + (if html5-fancy + (format "<%s%s>\n%s</%s>" block-type str contents block-type) + (format "<div%s>\n%s\n</div>" str contents))))) ;;;; Src Block -(defun org-html-src-block (src-block contents info) +(defun org-html-src-block (src-block _contents info) "Transcode a SRC-BLOCK element from Org to HTML. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (if (org-export-read-attribute :attr_html src-block :textarea) (org-html--textarea-block src-block) (let ((lang (org-element-property :language src-block)) - (caption (org-export-get-caption src-block)) (code (org-html-format-code src-block info)) (label (let ((lbl (and (org-element-property :name src-block) (org-export-get-reference src-block info)))) (if lbl (format " id=\"%s\"" lbl) "")))) (if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code) - (format - "<div class=\"org-src-container\">\n%s%s\n</div>" - (if (not caption) "" - (format "<label class=\"org-src-name\">%s</label>" - (org-export-data caption info))) - (format "\n<pre class=\"src src-%s\"%s>%s</pre>" lang label code)))))) + (format "<div class=\"org-src-container\">\n%s%s\n</div>" + ;; Build caption. + (let ((caption (org-export-get-caption src-block))) + (if (not caption) "" + (let ((listing-number + (format + "<span class=\"listing-number\">%s </span>" + (format + (org-html--translate "Listing %d:" info) + (org-export-get-ordinal + src-block info nil #'org-html--has-caption-p))))) + (format "<label class=\"org-src-name\">%s%s</label>" + listing-number + (org-trim (org-export-data caption info)))))) + ;; Contents. + (format "<pre class=\"src src-%s\"%s>%s</pre>" + lang label code)))))) ;;;; Statistics Cookie -(defun org-html-statistics-cookie (statistics-cookie contents info) +(defun org-html-statistics-cookie (statistics-cookie _contents _info) "Transcode a STATISTICS-COOKIE object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (let ((cookie-value (org-element-property :value statistics-cookie))) @@ -3234,7 +3349,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Strike-Through -(defun org-html-strike-through (strike-through contents info) +(defun org-html-strike-through (_strike-through contents info) "Transcode STRIKE-THROUGH from Org to HTML. CONTENTS is the text with strike-through markup. INFO is a plist holding contextual information." @@ -3245,7 +3360,7 @@ holding contextual information." ;;;; Subscript -(defun org-html-subscript (subscript contents info) +(defun org-html-subscript (_subscript contents _info) "Transcode a SUBSCRIPT object from Org to HTML. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -3253,7 +3368,7 @@ contextual information." ;;;; Superscript -(defun org-html-superscript (superscript contents info) +(defun org-html-superscript (_superscript contents _info) "Transcode a SUPERSCRIPT object from Org to HTML. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -3302,40 +3417,45 @@ communication channel." ;; Rules are ignored since table separators are deduced from ;; borders of the current row. (when (eq (org-element-property :type table-row) 'standard) - (let* ((rowgroup-number (org-export-table-row-group table-row info)) - (row-number (org-export-table-row-number table-row info)) - (start-rowgroup-p + (let* ((group (org-export-table-row-group table-row info)) + (number (org-export-table-row-number table-row info)) + (start-group-p (org-export-table-row-starts-rowgroup-p table-row info)) - (end-rowgroup-p + (end-group-p (org-export-table-row-ends-rowgroup-p table-row info)) - ;; `top-row-p' and `end-rowgroup-p' are not used directly - ;; but should be set so that `org-html-table-row-tags' can - ;; use them (see the docstring of this variable.) - (top-row-p (and (equal start-rowgroup-p '(top)) - (equal end-rowgroup-p '(below top)))) - (bottom-row-p (and (equal start-rowgroup-p '(above)) - (equal end-rowgroup-p '(bottom above)))) - (rowgroup-tags + (topp (and (equal start-group-p '(top)) + (equal end-group-p '(below top)))) + (bottomp (and (equal start-group-p '(above)) + (equal end-group-p '(bottom above)))) + (row-open-tag + (pcase (plist-get info :html-table-row-open-tag) + ((and accessor (pred functionp)) + (funcall accessor + number group start-group-p end-group-p topp bottomp)) + (accessor accessor))) + (row-close-tag + (pcase (plist-get info :html-table-row-close-tag) + ((and accessor (pred functionp)) + (funcall accessor + number group start-group-p end-group-p topp bottomp)) + (accessor accessor))) + (group-tags (cond - ;; Case 1: Row belongs to second or subsequent rowgroups. - ((not (= 1 rowgroup-number)) - '("<tbody>" . "\n</tbody>")) - ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups. + ;; Row belongs to second or subsequent groups. + ((not (= 1 group)) '("<tbody>" . "\n</tbody>")) + ;; Row is from first group. Table has >=1 groups. ((org-export-table-has-header-p (org-export-get-parent-table table-row) info) '("<thead>" . "\n</thead>")) - ;; Case 2: Row is from first and only row group. + ;; Row is from first and only group. (t '("<tbody>" . "\n</tbody>"))))) - (concat - ;; Begin a rowgroup? - (when start-rowgroup-p (car rowgroup-tags)) - ;; Actual table row - (concat "\n" (eval (car (plist-get info :html-table-row-tags))) - contents - "\n" - (eval (cdr (plist-get info :html-table-row-tags)))) - ;; End a rowgroup? - (when end-rowgroup-p (cdr rowgroup-tags)))))) + (concat (and start-group-p (car group-tags)) + (concat "\n" + row-open-tag + contents + "\n" + row-close-tag) + (and end-group-p (cdr group-tags)))))) ;;;; Table @@ -3351,7 +3471,7 @@ INFO is a plist used as a communication channel." (if (not special-column-p) (org-element-contents table-row) (cdr (org-element-contents table-row))))) -(defun org-html-table--table.el-table (table info) +(defun org-html-table--table.el-table (table _info) "Format table.el tables into HTML. INFO is a plist used as a communication channel." (when (eq (org-element-property :type table) 'table.el) @@ -3372,63 +3492,61 @@ INFO is a plist used as a communication channel." "Transcode a TABLE element from Org to HTML. CONTENTS is the contents of the table. INFO is a plist holding contextual information." - (case (org-element-property :type table) - ;; Case 1: table.el table. Convert it using appropriate tools. - (table.el (org-html-table--table.el-table table info)) - ;; Case 2: Standard table. - (t - (let* ((caption (org-export-get-caption table)) - (number (org-export-get-ordinal - table info nil #'org-html--has-caption-p)) - (attributes - (org-html--make-attribute-string - (org-combine-plists - (and (org-element-property :name table) - (list :id (org-export-get-reference table info))) - (and (not (org-html-html5-p info)) - (plist-get info :html-table-attributes)) - (org-export-read-attribute :attr_html table)))) - (alignspec - (if (and (boundp 'org-html-format-table-no-css) - org-html-format-table-no-css) - "align=\"%s\"" "class=\"org-%s\"")) - (table-column-specs - (function - (lambda (table info) - (mapconcat - (lambda (table-cell) - (let ((alignment (org-export-table-cell-alignment - table-cell info))) - (concat - ;; Begin a colgroup? - (when (org-export-table-cell-starts-colgroup-p - table-cell info) - "\n<colgroup>") - ;; Add a column. Also specify its alignment. - (format "\n%s" - (org-html-close-tag - "col" (concat " " (format alignspec alignment)) info)) - ;; End a colgroup? - (when (org-export-table-cell-ends-colgroup-p - table-cell info) - "\n</colgroup>")))) - (org-html-table-first-row-data-cells table info) "\n"))))) - (format "<table%s>\n%s\n%s\n%s</table>" - (if (equal attributes "") "" (concat " " attributes)) - (if (not caption) "" - (format (if (plist-get info :html-table-caption-above) - "<caption class=\"t-above\">%s</caption>" - "<caption class=\"t-bottom\">%s</caption>") - (concat - "<span class=\"table-number\">" - (format (org-html--translate "Table %d:" info) number) - "</span> " (org-export-data caption info)))) - (funcall table-column-specs table info) - contents))))) + (if (eq (org-element-property :type table) 'table.el) + ;; "table.el" table. Convert it using appropriate tools. + (org-html-table--table.el-table table info) + ;; Standard table. + (let* ((caption (org-export-get-caption table)) + (number (org-export-get-ordinal + table info nil #'org-html--has-caption-p)) + (attributes + (org-html--make-attribute-string + (org-combine-plists + (and (org-element-property :name table) + (list :id (org-export-get-reference table info))) + (and (not (org-html-html5-p info)) + (plist-get info :html-table-attributes)) + (org-export-read-attribute :attr_html table)))) + (alignspec + (if (bound-and-true-p org-html-format-table-no-css) + "align=\"%s\"" + "class=\"org-%s\"")) + (table-column-specs + (lambda (table info) + (mapconcat + (lambda (table-cell) + (let ((alignment (org-export-table-cell-alignment + table-cell info))) + (concat + ;; Begin a colgroup? + (when (org-export-table-cell-starts-colgroup-p + table-cell info) + "\n<colgroup>") + ;; Add a column. Also specify its alignment. + (format "\n%s" + (org-html-close-tag + "col" (concat " " (format alignspec alignment)) info)) + ;; End a colgroup? + (when (org-export-table-cell-ends-colgroup-p + table-cell info) + "\n</colgroup>")))) + (org-html-table-first-row-data-cells table info) "\n")))) + (format "<table%s>\n%s\n%s\n%s</table>" + (if (equal attributes "") "" (concat " " attributes)) + (if (not caption) "" + (format (if (plist-get info :html-table-caption-above) + "<caption class=\"t-above\">%s</caption>" + "<caption class=\"t-bottom\">%s</caption>") + (concat + "<span class=\"table-number\">" + (format (org-html--translate "Table %d:" info) number) + "</span> " (org-export-data caption info)))) + (funcall table-column-specs table info) + contents)))) ;;;; Target -(defun org-html-target (target contents info) +(defun org-html-target (target _contents info) "Transcode a TARGET object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." @@ -3437,7 +3555,7 @@ information." ;;;; Timestamp -(defun org-html-timestamp (timestamp contents info) +(defun org-html-timestamp (timestamp _contents info) "Transcode a TIMESTAMP object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." @@ -3447,7 +3565,7 @@ information." ;;;; Underline -(defun org-html-underline (underline contents info) +(defun org-html-underline (_underline contents info) "Transcode UNDERLINE from Org to HTML. CONTENTS is the text with underline markup. INFO is a plist holding contextual information." @@ -3457,7 +3575,7 @@ holding contextual information." ;;;; Verbatim -(defun org-html-verbatim (verbatim contents info) +(defun org-html-verbatim (verbatim _contents info) "Transcode VERBATIM from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." @@ -3466,7 +3584,7 @@ information." ;;;; Verse Block -(defun org-html-verse-block (verse-block contents info) +(defun org-html-verse-block (_verse-block contents info) "Transcode a VERSE-BLOCK element from Org to HTML. CONTENTS is verse block contents. INFO is a plist holding contextual information." @@ -3481,15 +3599,14 @@ contextual information." ;; non-breaking space. (while (string-match "^[ \t]+" contents) (let* ((num-ws (length (match-string 0 contents))) - (ws (let (out) (dotimes (i num-ws out) - (setq out (concat out " ")))))) + (ws (org-html--make-string num-ws " "))) (setq contents (replace-match ws nil t contents)))) (format "<p class=\"verse\">\n%s</p>" contents)) ;;; Filter Functions -(defun org-html-final-function (contents backend info) +(defun org-html-final-function (contents _backend info) "Filter to indent the HTML and convert HTML entities." (with-temp-buffer (insert contents) @@ -3539,10 +3656,10 @@ is non-nil." ;;;###autoload (defun org-html-convert-region-to-html () - "Assume the current region has org-mode syntax, and convert it to HTML. + "Assume the current region has Org syntax, and convert it to HTML. This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an HTML buffer and use this -command to convert it." +itemized list in Org syntax in an HTML buffer and use this command +to convert it." (interactive) (org-export-replace-region-by 'html)) diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el index f965ddc..c22866a 100644 --- a/lisp/ox-icalendar.el +++ b/lisp/ox-icalendar.el @@ -1,4 +1,4 @@ -;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine +;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -31,7 +31,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'ox-ascii) (declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) @@ -46,7 +46,7 @@ (defcustom org-icalendar-combined-agenda-file "~/org.ics" "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-icalendar-combine-agenda-files]. +This file is created with the command `\\[org-icalendar-combine-agenda-files]'. The file name should be absolute. It will be overwritten without warning." :group 'org-export-icalendar :type 'file) @@ -396,7 +396,8 @@ Universal Time, ignoring `org-icalendar-date-time-format'." ;; Convert timestamp into internal time in order to use ;; `format-time-string' and fix any mistake (i.e. MI >= 60). (encode-time 0 mi h d m y) - (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))))))) + (and (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))) + t))))) (defun org-icalendar-dtstamp () "Return DTSTAMP property, as a string." @@ -407,27 +408,25 @@ Universal Time, ignoring `org-icalendar-date-time-format'." ENTRY is a headline or an inlinetask element. INFO is a plist used as a communication channel." (mapconcat - 'identity + #'identity (org-uniquify (let (categories) - (mapc (lambda (type) - (case type - (category - (push (org-export-get-category entry info) categories)) - (todo-state - (let ((todo (org-element-property :todo-keyword entry))) - (and todo (push todo categories)))) - (local-tags - (setq categories - (append (nreverse (org-export-get-tags entry info)) - categories))) - (all-tags - (setq categories - (append (nreverse (org-export-get-tags entry info nil t)) - categories))))) - org-icalendar-categories) - ;; Return list of categories, following specified order. - (nreverse categories))) ",")) + (dolist (type org-icalendar-categories (nreverse categories)) + (cl-case type + (category + (push (org-export-get-category entry info) categories)) + (todo-state + (let ((todo (org-element-property :todo-keyword entry))) + (and todo (push todo categories)))) + (local-tags + (setq categories + (append (nreverse (org-export-get-tags entry info)) + categories))) + (all-tags + (setq categories + (append (nreverse (org-export-get-tags entry info nil t)) + categories))))))) + ",")) (defun org-icalendar-transcode-diary-sexp (sexp uid summary) "Transcode a diary sexp into iCalendar format. @@ -479,7 +478,7 @@ or subject for the event." ;;; Filters -(defun org-icalendar-clear-blank-lines (headline back-end info) +(defun org-icalendar-clear-blank-lines (headline _back-end _info) "Remove blank lines in HEADLINE export. HEADLINE is a string representing a transcoded headline. BACK-END and INFO are ignored." @@ -576,11 +575,11 @@ inlinetask within the section." 'timestamp (lambda (ts) (when (let ((type (org-element-property :type ts))) - (case (plist-get info :with-timestamps) + (cl-case (plist-get info :with-timestamps) (active (memq type '(active active-range))) (inactive (memq type '(inactive inactive-range))) ((t) t))) - (let ((uid (format "TS%d-%s" (incf counter) uid))) + (let ((uid (format "TS%d-%s" (cl-incf counter) uid))) (org-icalendar--vevent entry ts uid summary loc desc cat)))) info nil (and (eq type 'headline) 'inlinetask)) @@ -589,7 +588,7 @@ inlinetask within the section." ;; so, call `org-icalendar--vtodo' to transcode it into ;; a "VTODO" component. (when (and todo-type - (case (plist-get info :icalendar-include-todo) + (cl-case (plist-get info :icalendar-include-todo) (all t) (unblocked (and (eq type 'headline) @@ -611,7 +610,7 @@ inlinetask within the section." (lambda (sexp) (org-icalendar-transcode-diary-sexp (org-element-property :value sexp) - (format "DS%d-%s" (incf counter) uid) + (format "DS%d-%s" (cl-incf counter) uid) summary)) info nil (and (eq type 'headline) 'inlinetask)) ""))))) @@ -627,7 +626,7 @@ inlinetask within the section." contents)))) (defun org-icalendar--vevent - (entry timestamp uid summary location description categories) + (entry timestamp uid summary location description categories) "Create a VEVENT component. ENTRY is either a headline or an inlinetask element. TIMESTAMP @@ -651,7 +650,7 @@ Return VEVENT component as a string." ;; RRULE. (when (org-element-property :repeater-type timestamp) (format "RRULE:FREQ=%s;INTERVAL=%d\n" - (case (org-element-property :repeater-unit timestamp) + (cl-case (org-element-property :repeater-unit timestamp) (hour "HOURLY") (day "DAILY") (week "WEEKLY") (month "MONTHLY") (year "YEARLY")) (org-element-property :repeater-value timestamp))) @@ -836,27 +835,23 @@ external process." ;; Asynchronous export is not interactive, so we will not call ;; `org-check-agenda-file'. Instead we remove any non-existent ;; agenda file from the list. - (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t)))) + (let ((files (cl-remove-if-not #'file-exists-p (org-agenda-files t)))) (org-export-async-start (lambda (results) - (mapc (lambda (f) (org-export-add-to-stack f 'icalendar)) - results)) + (dolist (f results) (org-export-add-to-stack f 'icalendar))) `(let (output-files) - (mapc (lambda (file) - (with-current-buffer (org-get-agenda-file-buffer file) - (push (expand-file-name (org-icalendar-export-to-ics)) - output-files))) - ',files) - output-files))) + (dolist (file ',files outputfiles) + (with-current-buffer (org-get-agenda-file-buffer file) + (push (expand-file-name (org-icalendar-export-to-ics)) + output-files)))))) (let ((files (org-agenda-files t))) (org-agenda-prepare-buffers files) (unwind-protect - (mapc (lambda (file) - (catch 'nextfile - (org-check-agenda-file file) - (with-current-buffer (org-get-agenda-file-buffer file) - (org-icalendar-export-to-ics)))) - files) + (dolist (file files) + (catch 'nextfile + (org-check-agenda-file file) + (with-current-buffer (org-get-agenda-file-buffer file) + (org-icalendar-export-to-ics)))) (org-release-buffers org-agenda-new-buffers))))) ;;;###autoload @@ -871,14 +866,14 @@ The file is stored under the name chosen in `org-icalendar-combined-agenda-file'." (interactive) (if async - (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t)))) + (let ((files (cl-remove-if-not #'file-exists-p (org-agenda-files t)))) (org-export-async-start - (lambda (dummy) + (lambda (_) (org-export-add-to-stack (expand-file-name org-icalendar-combined-agenda-file) 'icalendar)) - `(apply 'org-icalendar--combine-files ',files))) - (apply 'org-icalendar--combine-files (org-agenda-files t)))) + `(apply #'org-icalendar--combine-files ',files))) + (apply #'org-icalendar--combine-files (org-agenda-files t)))) (defun org-icalendar-export-current-agenda (file) "Export current agenda view to an iCalendar FILE. diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 121a675..57ec1d2 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -1,4 +1,4 @@ -;;; ox-latex.el --- LaTeX Back-End for Org Export Engine +;;; ox-latex.el --- LaTeX Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -26,7 +26,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'ox) (require 'ox-publish) @@ -90,7 +90,6 @@ ;; Pseudo objects and elements. (latex-math-block . org-latex-math-block) (latex-matrices . org-latex-matrices)) - :export-block '("LATEX" "TEX") :menu-entry '(?l "Export to LaTeX" ((?L "As LaTeX buffer" org-latex-export-as-latex) @@ -119,6 +118,7 @@ (:latex-default-table-environment nil nil org-latex-default-table-environment) (:latex-default-table-mode nil nil org-latex-default-table-mode) (:latex-diary-timestamp-format nil nil org-latex-diary-timestamp-format) + (:latex-footnote-defined-format nil nil org-latex-footnote-defined-format) (:latex-footnote-separator nil nil org-latex-footnote-separator) (:latex-format-drawer-function nil nil org-latex-format-drawer-function) (:latex-format-headline-function nil nil org-latex-format-headline-function) @@ -127,6 +127,7 @@ (:latex-image-default-height nil nil org-latex-image-default-height) (:latex-image-default-option nil nil org-latex-image-default-option) (:latex-image-default-width nil nil org-latex-image-default-width) + (:latex-images-centered nil nil org-latex-images-centered) (:latex-inactive-timestamp-format nil nil org-latex-inactive-timestamp-format) (:latex-inline-image-rules nil nil org-latex-inline-image-rules) (:latex-link-with-unknown-path-format nil nil org-latex-link-with-unknown-path-format) @@ -144,6 +145,7 @@ (:latex-text-markup-alist nil nil org-latex-text-markup-alist) (:latex-title-command nil nil org-latex-title-command) (:latex-toc-command nil nil org-latex-toc-command) + (:latex-compiler "LATEX_COMPILER" nil org-latex-compiler) ;; Redefine regular options. (:date "DATE" nil "\\today" parse))) @@ -327,7 +329,7 @@ Otherwise, place it near the end. When value is a list of symbols, put caption above selected elements only. Allowed symbols are: `image', `table', `src-block' and `special-block'." :group 'org-export-latex - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(choice (const :tag "For all elements" t) @@ -363,9 +365,9 @@ For example, when this variable is non-nil, a headline like this: :CUSTOM_ID: sec:foo :END: This is section [[#sec:foo]]. - #+BEGIN_LATEX + #+BEGIN_EXPORT latex And this is still section \\ref{sec:foo}. - #+END_LATEX + #+END_EXPORT will be exported to LaTeX as: @@ -390,7 +392,7 @@ labeling scheme to generate labels and resolve links into proper references." :group 'org-export-latex :type 'boolean - :version "25.1" + :version "25.2" :package-version '(Org . "8.3")) ;;;; Preamble @@ -572,14 +574,14 @@ precedence over this variable." The format string should have at most one \"%s\"-expression, which is replaced with the subtitle." :group 'org-export-latex - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(string :tag "Format string")) (defcustom org-latex-subtitle-separate nil "Non-nil means the subtitle is not typeset as part of title." :group 'org-export-latex - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type 'boolean) @@ -616,12 +618,10 @@ inserted. Setting :latex-hyperref-template in publishing projects will take precedence over this variable." :group 'org-export-latex - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(choice (const :tag "No template" nil) (string :tag "Format string"))) -(define-obsolete-variable-alias - 'org-latex-with-hyperref 'org-latex-hyperref-template "25.1") ;;;; Headline @@ -651,6 +651,16 @@ The function result will be used in the section format string." :group 'org-export-latex :type 'string) +(defcustom org-latex-footnote-defined-format "\\textsuperscript{\\ref{%s}}" + "Format string used to format reference to footnote already defined. +%s will be replaced by the label of the referred footnote." + :group 'org-export-latex + :type '(choice + (const :tag "Use plain superscript (default)" "\\textsuperscript{\\ref{%s}}") + (const :tag "Use Memoir/KOMA-Script footref" "\\footref{%s}") + (string :tag "Other format string")) + :version "25.2" + :package-version '(Org . "9.0")) ;;;; Timestamps @@ -672,6 +682,14 @@ The function result will be used in the section format string." ;;;; Links +(defcustom org-latex-images-centered t + "When non-nil, images are centered." + :group 'org-export-latex + :version "25.2" + :package-version '(Org . "9.0") + :type 'boolean + :safe #'booleanp) + (defcustom org-latex-image-default-option "" "Default option for images." :group 'org-export-latex @@ -697,10 +715,13 @@ environment." :package-version '(Org . "8.0") :type 'string) -(defcustom org-latex-default-figure-position "htb" - "Default position for latex figures." +(defcustom org-latex-default-figure-position "htbp" + "Default position for LaTeX figures." :group 'org-export-latex - :type 'string) + :type 'string + :version "25.2" + :package-version '(Org . "9.0") + :safe #'stringp) (defcustom org-latex-inline-image-rules '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'")) @@ -821,7 +842,7 @@ to typeset and try to protect special characters. If no association can be found for a given markup, text will be returned as-is." :group 'org-export-latex - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type 'alist :options '(bold code italic strike-through underline verbatim)) @@ -829,8 +850,7 @@ returned as-is." ;;;; Drawers -(defcustom org-latex-format-drawer-function - (lambda (name contents) contents) +(defcustom org-latex-format-drawer-function (lambda (_ contents) contents) "Function called to format a drawer in LaTeX code. The function must accept two parameters: @@ -864,7 +884,7 @@ The function must accept seven parameters: The function should return the string to be exported." :group 'org-export-latex :type 'function - :version "25.1" + :version "25.2" :package-version '(Org . "8.3")) @@ -923,7 +943,8 @@ into previewing problems, please consult (gnuplot "Gnuplot") (ocaml "Caml") (caml "Caml") (sql "SQL") (sqlite "sql") - (makefile "make")) + (makefile "make") + (R "r")) "Alist mapping languages to their listing language counterpart. The key is a symbol, the major mode symbol without the \"-mode\". The value is the string that should be inserted as the language @@ -1020,34 +1041,116 @@ block-specific options, you may use the following syntax: (string :tag "Minted option name ") (string :tag "Minted option value")))) -(defvar org-latex-custom-lang-environments nil +(defcustom org-latex-custom-lang-environments nil "Alist mapping languages to language-specific LaTeX environments. It is used during export of src blocks by the listings and minted -latex packages. For example, +latex packages. The environment may be a simple string, composed of +only letters and numbers. In this case, the string is directly the +name of the latex environment to use. The environment may also be +a format string. In this case the format string will be directly +exported. This format string may contain these elements: + + %s for the formatted source + %c for the caption + %f for the float attribute + %l for an appropriate label + %o for the LaTeX attributes + +For example, (setq org-latex-custom-lang-environments - '((python \"pythoncode\"))) + '((python \"pythoncode\") + (ocaml \"\\\\begin{listing} +\\\\begin{minted}[%o]{ocaml} +%s\\\\end{minted} +\\\\caption{%c} +\\\\label{%l}\"))) -would have the effect that if org encounters begin_src python -during latex export it will output +would have the effect that if Org encounters a Python source block +during LaTeX export it will produce \\begin{pythoncode} <src block body> - \\end{pythoncode}") + \\end{pythoncode} + +and if Org encounters an Ocaml source block during LaTeX export it +will produce + + \\begin{listing} + \\begin{minted}[<attr_latex options>]{ocaml} + <src block body> + \\end{minted} + \\caption{<caption>} + \\label{<label>} + \\end{listing}" + :group 'org-export-latex + :type '(repeat + (list + (symbol :tag "Language name ") + (string :tag "Environment name or format string"))) + :version "25.2" + :package-version '(Org . "9.0")) ;;;; Compilation +(defcustom org-latex-compiler-file-string "%% Intended LaTeX compiler: %s\n" + "LaTeX compiler format-string. +See also `org-latex-compiler'." + :group 'org-export-latex + :type '(choice + (const :tag "Comment" "%% Intended LaTeX compiler: %s\n") + (const :tag "latex-mode file variable" "%% -*- latex-run-command: %s -*-\n") + (const :tag "AUCTeX file variable" "%% -*- LaTeX-command: %s -*-\n") + (string :tag "custom format" "%% %s")) + :version "25.2" + :package-version '(Org . "9.0")) + +(defcustom org-latex-compiler "pdflatex" + "LaTeX compiler to use. + +Must be an element in `org-latex-compilers' or the empty quote. +Can also be set in buffers via #+LATEX_COMPILER. See also +`org-latex-compiler-file-string'." + :group 'org-export-latex + :type '(choice + (const :tag "pdfLaTeX" "pdflatex") + (const :tag "XeLaTeX" "xelatex") + (const :tag "LuaLaTeX" "lualatex") + (const :tag "Unset" "")) + :version "25.2" + :package-version '(Org . "9.0")) + +(defconst org-latex-compilers '("pdflatex" "xelatex" "lualatex") + "Known LaTeX compilers. +See also `org-latex-compiler'.") + +(defcustom org-latex-bib-compiler "bibtex" + "Command to process a LaTeX file's bibliography. + +The shorthand %bib in `org-latex-pdf-process' is replaced with +this value. + +A better approach is to use a compiler suit such as `latexmk'." + :group 'org-export-latex + :type '(choice (const :tag "BibTeX" "bibtex") + (const :tag "Biber" "biber") + (string :tag "Other process")) + :version "25.2" + :package-version '(Org . "9.0")) + (defcustom org-latex-pdf-process - '("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f") + '("%latex -interaction nonstopmode -output-directory %o %f" + "%latex -interaction nonstopmode -output-directory %o %f" + "%latex -interaction nonstopmode -output-directory %o %f") "Commands to process a LaTeX file to a PDF file. This is a list of strings, each of them will be given to the shell as a command. %f in the command will be replaced by the full file name, %b by the file base name (i.e. without directory -and extension parts) and %o by the base directory of the file. +and extension parts), %o by the base directory of the file, +%latex is the LaTeX compiler (see `org-latex-compiler'), and %bib +is the BibTeX-like compiler (see `org-latex-bib-compiler'). The reason why this is a list is that it usually takes several runs of `pdflatex', maybe mixed with a call to `bibtex'. Org @@ -1055,18 +1158,8 @@ does not have a clever mechanism to detect which of these commands have to be run to get to a stable result, and it also does not do any error checking. -By default, Org uses 3 runs of `pdflatex' to do the processing. -If you have texi2dvi on your system and if that does not cause -the infamous egrep/locale bug: - - http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html - -then `texi2dvi' is the superior choice as it automates the LaTeX -build process by calling the \"correct\" combinations of -auxiliary programs. Org does offer `texi2dvi' as one of the -customize options. Alternatively, `rubber' and `latexmk' also -provide similar functionality. The latter supports `biber' out -of the box. +Consider a smart LaTeX compiler such as `texi2dvi' or `latexmk', +which calls the \"correct\" combinations of auxiliary programs. Alternatively, this may be a Lisp function that does the processing, so you could use this to apply the machinery of @@ -1076,36 +1169,22 @@ file name as its single argument." :type '(choice (repeat :tag "Shell command sequence" (string :tag "Shell command")) - (const :tag "2 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "pdflatex,bibtex,pdflatex,pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "2 runs of xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "xelatex,bibtex,xelatex,xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "2 runs of latex" + ("%latex -interaction nonstopmode -output-directory %o %f" + "%latex -interaction nonstopmode -output-directory %o %f")) + (const :tag "3 runs of latex" + ("%latex -interaction nonstopmode -output-directory %o %f" + "%latex -interaction nonstopmode -output-directory %o %f" + "%latex -interaction nonstopmode -output-directory %o %f")) + (const :tag "latex,bibtex,latex,latex" + ("%latex -interaction nonstopmode -output-directory %o %f" + "%bib %b" + "%latex -interaction nonstopmode -output-directory %o %f" + "%latex -interaction nonstopmode -output-directory %o %f")) (const :tag "texi2dvi" - ("texi2dvi -p -b -V %f")) - (const :tag "rubber" - ("rubber -d --into %o %f")) + ("LATEX=\"%latex\" texi2dvi -p -b -V %f")) (const :tag "latexmk" - ("latexmk -g -pdf %f")) + ("latexmk -g -pdflatex=\"%latex\" %f")) (function))) (defcustom org-latex-logfiles-extensions @@ -1115,7 +1194,7 @@ file name as its single argument." The logfiles will be removed if `org-latex-remove-logfiles' is non-nil." :group 'org-export-latex - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(repeat (string :tag "Extension"))) @@ -1139,7 +1218,7 @@ The regular expressions are used to find possible warnings in the log of a latex-run. These warnings will be reported after calling `org-latex-compile'." :group 'org-export-latex - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(repeat (cons @@ -1171,7 +1250,7 @@ Eventually, if FULL is non-nil, wrap label within \"\\label{}\"." (let* ((type (org-element-type datum)) (user-label (org-element-property - (case type + (cl-case type ((headline inlinetask) :CUSTOM_ID) (target :value) (otherwise :name)) @@ -1180,11 +1259,11 @@ Eventually, if FULL is non-nil, wrap label within \"\\label{}\"." (and (or user-label force) (if (and user-label (plist-get info :latex-prefer-user-labels)) user-label - (concat (case type + (concat (cl-case type (headline "sec:") (table "tab:") (latex-environment - (and (org-string-match-p + (and (string-match-p org-latex-math-environments-re (org-element-property :value datum)) "eq:")) @@ -1222,13 +1301,13 @@ For non-floats, see `org-latex--wrap-label'." ((org-string-nw-p caption-from-attr-latex) (concat caption-from-attr-latex "\n")) ((and (not main) (equal label "")) "") - ((not main) (concat label "\n")) + ((not main) label) ;; Option caption format with short name. (t (format (if nonfloat "\\captionof{%s}%s{%s%s}\n" "\\caption%s%s{%s%s}\n") (if nonfloat - (case type + (cl-case type (paragraph "figure") (src-block (if (plist-get info :latex-listings) "listing" @@ -1280,8 +1359,8 @@ Return the new header." header (let ((options (save-match-data (org-split-string (match-string 1 header) ",[ \t]*"))) - (language (cdr (assoc language-code - org-latex-babel-language-alist)))) + (language (cdr (assoc-string language-code + org-latex-babel-language-alist t)))) ;; If LANGUAGE is already loaded, return header without AUTO. ;; Otherwise, replace AUTO with language or append language if ;; AUTO is not present. @@ -1346,13 +1425,37 @@ Return the new header." "")) t t header 0))))) +(defun org-latex--remove-packages (pkg-alist info) + "Remove packages based on the current LaTeX compiler. + +If the fourth argument of an element is set in pkg-alist, and it +is not a member of the LaTeX compiler of the document, the packages +is removed. See also `org-latex-compiler'. + +Return modified pkg-alist." + (let ((compiler (or (plist-get info :latex-compiler) ""))) + (if (member-ignore-case compiler org-latex-compilers) + (delq nil + (mapcar + (lambda (pkg) + (unless (and + (listp pkg) + (let ((third (nth 3 pkg))) + (and third + (not (member-ignore-case + compiler + (if (listp third) third (list third))))))) + pkg)) + pkg-alist)) + pkg-alist))) + (defun org-latex--find-verb-separator (s) "Return a character not used in string S. This is used to choose a separator for constructs like \\verb." (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (loop for c across ll - when (not (string-match (regexp-quote (char-to-string c)) s)) - return (char-to-string c)))) + (cl-loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) (defun org-latex--make-option-string (options) "Return a comma separated string of keywords and values. @@ -1360,9 +1463,10 @@ OPTIONS is an alist where the key is the options keyword as a string, and the value a list containing the keyword value, or nil." (mapconcat (lambda (pair) - (concat (first pair) - (when (> (length (second pair)) 0) - (concat "=" (second pair))))) + (pcase-let ((`(,keyword ,value) pair)) + (concat keyword + (and (> (length value) 0) + (concat "=" value))))) options ",")) @@ -1394,7 +1498,7 @@ should not be used for floats. See INFO is a plist used as a communication channel. See `org-latex-text-markup-alist' for details." (let ((fmt (cdr (assq markup (plist-get info :latex-text-markup-alist))))) - (case fmt + (cl-case fmt ;; No format string: Return raw text. ((nil) text) ;; Handle the `verb' special case: Find an appropriate separator @@ -1416,38 +1520,35 @@ INFO is a plist used as a communication channel. See INFO is a plist used as a communication channel. -Footnotes definitions are returned within \"\\footnotetxt{}\" +Footnotes definitions are returned within \"\\footnotetext{}\" commands. This function is used within constructs that don't support -\"\\footnote{}\" command (i.e. an item's tag). In that case, +\"\\footnote{}\" command (e.g., an item tag). In that case, \"\\footnotemark\" is used within the construct and the function just outside of it." (mapconcat (lambda (ref) - (format - "\\footnotetext[%s]{%s}" - (org-export-get-footnote-number ref info) - (org-trim - (org-export-data - (org-export-get-footnote-definition ref info) info)))) + (let ((def (org-export-get-footnote-definition ref info))) + (format "\\footnotetext[%d]{%s%s}" + (org-export-get-footnote-number ref info) + (org-trim (org-latex--label def info t t)) + (org-trim (org-export-data def info))))) ;; Find every footnote reference in ELEMENT. - (let* (all-refs - search-refs ; For byte-compiler. - (search-refs - (function - (lambda (data) - ;; Return a list of all footnote references never seen - ;; before in DATA. - (org-element-map data 'footnote-reference - (lambda (ref) - (when (org-export-footnote-first-reference-p ref info) - (push ref all-refs) - (when (eq (org-element-property :type ref) 'standard) - (funcall search-refs - (org-export-get-footnote-definition ref info))))) - info) - (reverse all-refs))))) + (letrec ((all-refs nil) + (search-refs + (lambda (data) + ;; Return a list of all footnote references never seen + ;; before in DATA. + (org-element-map data 'footnote-reference + (lambda (ref) + (when (org-export-footnote-first-reference-p ref info) + (push ref all-refs) + (when (eq (org-element-property :type ref) 'standard) + (funcall search-refs + (org-export-get-footnote-definition ref info))))) + info) + (reverse all-refs)))) (funcall search-refs element)) "")) @@ -1460,7 +1561,8 @@ INFO is a plist used as a communication channel." "Create a format-spec for document meta-data. INFO is a plist used as a communication channel." (let ((language (let ((lang (plist-get info :language))) - (or (cdr (assoc lang org-latex-babel-language-alist)) + (or (cdr (assoc-string lang org-latex-babel-language-alist t)) + (nth 1 (assoc-string lang org-latex-polyglossia-language-alist t)) lang)))) `((?a . ,(org-export-data (plist-get info :author) info)) (?t . ,(org-export-data (plist-get info :title) info)) @@ -1475,8 +1577,8 @@ INFO is a plist used as a communication channel." (?L . ,(capitalize language)) (?D . ,(org-export-get-date info))))) -(defun org-latex--make-header (info) - "Return a formatted LaTeX header. +(defun org-latex--make-preamble (info) + "Return a formatted LaTeX preamble. INFO is a plist used as a communication channel." (let* ((class (plist-get info :latex-class)) (class-options (plist-get info :latex-class-options)) @@ -1495,14 +1597,25 @@ INFO is a plist used as a communication channel." (org-element-normalize-string (org-splice-latex-header document-class-string - org-latex-default-packages-alist - org-latex-packages-alist nil - (concat (org-element-normalize-string - (plist-get info :latex-header)) - (plist-get info :latex-header-extra))))) + (org-latex--remove-packages + org-latex-default-packages-alist info) + (org-latex--remove-packages + org-latex-packages-alist info) + nil + (mapconcat 'org-element-normalize-string + (list (plist-get info :latex-header) + (plist-get info :latex-header-extra)) "")))) info) info)))) +(defun org-latex--insert-compiler (info) + "Insert LaTeX_compiler info into the document. +INFO is a plist used as a communication channel." + (let ((compiler (plist-get info :latex-compiler))) + (and (org-string-nw-p org-latex-compiler-file-string) + (member (or compiler "") org-latex-compilers) + (format org-latex-compiler-file-string compiler)))) + ;;; Template @@ -1516,8 +1629,10 @@ holding export options." ;; Time-stamp. (and (plist-get info :time-stamp-file) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) + ;; LaTeX compiler. + (org-latex--insert-compiler info) ;; Document class and packages. - (org-latex--make-header info) + (org-latex--make-preamble info) ;; Possibly limit depth for headline numbering. (let ((sec-num (plist-get info :section-numbers))) (when (integerp sec-num) @@ -1583,7 +1698,7 @@ holding export options." ;;;; Bold -(defun org-latex-bold (bold contents info) +(defun org-latex-bold (_bold contents info) "Transcode BOLD from Org to LaTeX. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." @@ -1602,7 +1717,7 @@ holding contextual information." ;;;; Clock -(defun org-latex-clock (clock contents info) +(defun org-latex-clock (clock _contents info) "Transcode a CLOCK element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1618,7 +1733,7 @@ information." ;;;; Code -(defun org-latex-code (code contents info) +(defun org-latex-code (code _contents info) "Transcode a CODE object from Org to LaTeX. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -1648,7 +1763,7 @@ holding contextual information. See `org-export-data'." ;;;; Entity -(defun org-latex-entity (entity contents info) +(defun org-latex-entity (entity _contents _info) "Transcode an ENTITY object from Org to LaTeX. CONTENTS are the definition itself. INFO is a plist holding contextual information." @@ -1657,7 +1772,7 @@ contextual information." ;;;; Example Block -(defun org-latex-example-block (example-block contents info) +(defun org-latex-example-block (example-block _contents info) "Transcode an EXAMPLE-BLOCK element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1676,7 +1791,7 @@ information." ;;;; Export Block -(defun org-latex-export-block (export-block contents info) +(defun org-latex-export-block (export-block _contents _info) "Transcode a EXPORT-BLOCK element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (when (member (org-element-property :type export-block) '("LATEX" "TEX")) @@ -1685,7 +1800,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Export Snippet -(defun org-latex-export-snippet (export-snippet contents info) +(defun org-latex-export-snippet (export-snippet _contents _info) "Transcode a EXPORT-SNIPPET object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (when (eq (org-export-snippet-backend export-snippet) 'latex) @@ -1694,7 +1809,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Fixed Width -(defun org-latex-fixed-width (fixed-width contents info) +(defun org-latex-fixed-width (fixed-width _contents info) "Transcode a FIXED-WIDTH element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (org-latex--wrap-label @@ -1707,33 +1822,47 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Footnote Reference -(defun org-latex-footnote-reference (footnote-reference contents info) +(defun org-latex-footnote-reference (footnote-reference _contents info) "Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." - (concat - ;; Insert separator between two footnotes in a row. - (let ((prev (org-export-get-previous-element footnote-reference info))) - (when (eq (org-element-type prev) 'footnote-reference) - (plist-get info :latex-footnote-separator))) - (cond - ;; Use \footnotemark if the footnote has already been defined. - ((not (org-export-footnote-first-reference-p footnote-reference info)) - (format "\\footnotemark[%s]{}" - (org-export-get-footnote-number footnote-reference info))) - ;; Use \footnotemark if reference is within another footnote - ;; reference, footnote definition or table cell. - ((org-element-lineage footnote-reference - '(footnote-reference footnote-definition table-cell)) - "\\footnotemark") - ;; Otherwise, define it with \footnote command. - (t - (let ((def (org-export-get-footnote-definition footnote-reference info))) - (concat - (format "\\footnote{%s}" (org-trim (org-export-data def info))) - ;; Retrieve all footnote references within the footnote and - ;; add their definition after it, since LaTeX doesn't support - ;; them inside. - (org-latex--delayed-footnotes-definitions def info))))))) + (let ((label (org-element-property :label footnote-reference))) + (concat + ;; Insert separator between two footnotes in a row. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (when (eq (org-element-type prev) 'footnote-reference) + (plist-get info :latex-footnote-separator))) + (cond + ;; Use `:latex-footnote-defined-format' if the footnote has + ;; already been defined. + ((not (org-export-footnote-first-reference-p footnote-reference info)) + (format (plist-get info :latex-footnote-defined-format) + (org-latex--label + (org-export-get-footnote-definition footnote-reference info) + info t))) + ;; Use \footnotemark if reference is within another footnote + ;; reference, footnote definition or table cell. + ((org-element-lineage footnote-reference + '(footnote-reference footnote-definition table-cell)) + "\\footnotemark") + ;; Otherwise, define it with \footnote command. + (t + (let ((def (org-export-get-footnote-definition footnote-reference info))) + (concat + (format "\\footnote{%s%s}" (org-trim (org-export-data def info)) + ;; Only insert a \label if there exist another + ;; reference to def. + (cond ((not label) "") + ((org-element-map (plist-get info :parse-tree) 'footnote-reference + (lambda (f) + (and (not (eq f footnote-reference)) + (equal (org-element-property :label f) label) + (org-trim (org-latex--label def info t t)))) + info t)) + (t ""))) + ;; Retrieve all footnote references within the footnote and + ;; add their definition after it, since LaTeX doesn't support + ;; them inside. + (org-latex--delayed-footnotes-definitions def info)))))))) ;;;; Headline @@ -1807,7 +1936,8 @@ holding contextual information." (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize))) ;; Itemize headline "\\item" - (and full-text (org-string-match-p "\\`[ \t]*\\[" full-text) + (and full-text + (string-match-p "\\`[ \t]*\\[" full-text) "\\relax") " " full-text "\n" headline-label @@ -1844,8 +1974,8 @@ holding contextual information." (lambda (k) (and (equal (org-element-property :key k) "TOC") (let ((v (org-element-property :value k))) - (and (org-string-match-p "\\<headlines\\>" v) - (org-string-match-p "\\<local\\>" v) + (and (string-match-p "\\<headlines\\>" v) + (string-match-p "\\<local\\>" v) (format "\\stopcontents[level-%d]" level))))) info t))))) (if (and opt-title @@ -1865,7 +1995,7 @@ holding contextual information." (concat headline-label pre-blanks contents)))))))) (defun org-latex-format-headline-default-function - (todo todo-type priority text tags info) + (todo _todo-type priority text tags info) "Default format function for a headline. See `org-latex-format-headline-function' for details." (concat @@ -1880,7 +2010,7 @@ See `org-latex-format-headline-function' for details." ;;;; Horizontal Rule -(defun org-latex-horizontal-rule (horizontal-rule contents info) +(defun org-latex-horizontal-rule (horizontal-rule _contents info) "Transcode an HORIZONTAL-RULE object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let ((attr (org-export-read-attribute :attr_latex horizontal-rule)) @@ -1902,13 +2032,13 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Inline Src Block -(defun org-latex-inline-src-block (inline-src-block contents info) +(defun org-latex-inline-src-block (inline-src-block _contents info) "Transcode an INLINE-SRC-BLOCK element from Org to LaTeX. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((code (org-element-property :value inline-src-block)) (separator (org-latex--find-verb-separator code))) - (case (plist-get info :latex-listings) + (cl-case (plist-get info :latex-listings) ;; Do not use a special package: transcode it verbatim. ((nil) (format "\\texttt{%s}" (org-latex--protect-text code))) ;; Use minted package. @@ -1919,10 +2049,10 @@ contextual information." (downcase org-lang))) (options (org-latex--make-option-string (plist-get info :latex-minted-options)))) - (concat (format "\\mint%s{%s}" - (if (string= options "") "" (format "[%s]" options)) - mint-lang) - separator code separator))) + (format "\\mintinline%s{%s}{%s}" + (if (string= options "") "" (format "[%s]" options)) + mint-lang + code))) ;; Use listings package. (otherwise ;; Maybe translate language's name. @@ -1957,7 +2087,7 @@ holding contextual information." todo todo-type priority title tags contents info))) (defun org-latex-format-inlinetask-default-function - (todo todo-type priority title tags contents info) + (todo _todo-type priority title tags contents info) "Default format function for a inlinetasks. See `org-latex-format-inlinetask-function' for details." (let ((full-title @@ -1982,7 +2112,7 @@ See `org-latex-format-inlinetask-function' for details." ;;;; Italic -(defun org-latex-italic (italic contents info) +(defun org-latex-italic (_italic contents info) "Transcode ITALIC from Org to LaTeX. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." @@ -2007,14 +2137,14 @@ contextual information." (when (and (eq (org-element-type parent) 'plain-list) (eq (org-element-property :type parent) 'ordered)) - (incf level))) + (cl-incf level))) level))) (and count (< level 5) (format "\\setcounter{enum%s}{%s}\n" (nth (1- level) '("i" "ii" "iii" "iv")) (1- count))))) - (checkbox (case (org-element-property :checkbox item) + (checkbox (cl-case (org-element-property :checkbox item) (on "$\\boxtimes$ ") (off "$\\square$ ") (trans "$\\boxminus$ "))) @@ -2033,7 +2163,7 @@ contextual information." ;; unless the brackets comes from an initial export ;; snippet (i.e. it is inserted willingly by the user). ((and contents - (org-string-match-p "\\`[ \t]*\\[" contents) + (string-match-p "\\`[ \t]*\\[" contents) (not (let ((e (car (org-element-contents item)))) (and (eq (org-element-type e) 'paragraph) (let ((o (car (org-element-contents e)))) @@ -2054,7 +2184,7 @@ contextual information." ;;;; Keyword -(defun org-latex-keyword (keyword contents info) +(defun org-latex-keyword (keyword _contents info) "Transcode a KEYWORD element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let ((key (org-element-property :key keyword)) @@ -2065,8 +2195,8 @@ CONTENTS is nil. INFO is a plist holding contextual information." ((string= key "TOC") (let ((case-fold-search t)) (cond - ((org-string-match-p "\\<headlines\\>" value) - (let* ((localp (org-string-match-p "\\<local\\>" value)) + ((string-match-p "\\<headlines\\>" value) + (let* ((localp (string-match-p "\\<local\\>" value)) (parent (org-element-lineage keyword '(headline))) (level (if (not (and localp parent)) 0 (org-export-get-relative-level parent info))) @@ -2082,9 +2212,9 @@ CONTENTS is nil. INFO is a plist holding contextual information." \\printcontents[level-%d]{}{0}{%s}" level level (or depth "")) (concat depth (and depth "\n") "\\tableofcontents")))) - ((org-string-match-p "\\<tables\\>" value) "\\listoftables") - ((org-string-match-p "\\<listings\\>" value) - (case (plist-get info :latex-listings) + ((string-match-p "\\<tables\\>" value) "\\listoftables") + ((string-match-p "\\<listings\\>" value) + (cl-case (plist-get info :latex-listings) ((nil) "\\listoffigures") (minted "\\listoflistings") (otherwise "\\lstlistoflistings"))))))))) @@ -2092,7 +2222,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Latex Environment -(defun org-latex-latex-environment (latex-environment contents info) +(defun org-latex-latex-environment (latex-environment _contents info) "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (when (plist-get info :with-latex) @@ -2112,22 +2242,20 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Latex Fragment -(defun org-latex-latex-fragment (latex-fragment contents info) +(defun org-latex-latex-fragment (latex-fragment _contents _info) "Transcode a LATEX-FRAGMENT object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-element-property :value latex-fragment))) ;; Trim math markers since the fragment is enclosed within ;; a latex-math-block object anyway. - (cond ((string-match "\\`\\(\\$\\{1,2\\}\\)\\([^\000]*\\)\\1\\'" value) - (match-string 2 value)) - ((string-match "\\`\\\\(\\([^\000]*\\)\\\\)\\'" value) - (match-string 1 value)) + (cond ((string-match-p "\\`\\$[^$]" value) (substring value 1 -1)) + ((string-prefix-p "\\(" value) (substring value 2 -2)) (t value)))) ;;;; Line Break -(defun org-latex-line-break (line-break contents info) +(defun org-latex-line-break (_line-break _contents _info) "Transcode a LINE-BREAK object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." "\\\\\n") @@ -2152,13 +2280,12 @@ used as a communication channel." (cond ((string= float "wrap") 'wrap) ((string= float "sideways") 'sideways) ((string= float "multicolumn") 'multicolumn) + ((and (plist-member attr :float) (not float)) 'nonfloat) ((or float (org-element-property :caption parent) (org-string-nw-p (plist-get attr :caption))) - (if (and (plist-member attr :float) (not float)) - 'nonfloat - 'figure)) - ((and (not float) (plist-member attr :float)) nil)))) + 'figure) + (t 'nonfloat)))) (placement (let ((place (plist-get attr :placement))) (cond @@ -2167,6 +2294,9 @@ used as a communication channel." ((eq float 'figure) (format "[%s]" (plist-get info :latex-default-figure-position))) (t "")))) + (center + (if (plist-member attr :center) (plist-get attr :center) + (plist-get info :latex-images-centered))) (comment-include (if (plist-get attr :comment-include) "%" "")) ;; It is possible to specify width and height in the ;; ATTR_LATEX line, and also via default variables. @@ -2211,14 +2341,14 @@ used as a communication channel." (let ((search-option (org-element-property :search-option link))) (when (and search-option (equal filetype "pdf") - (org-string-match-p "\\`[0-9]+\\'" search-option) - (not (org-string-match-p "page=" options))) + (string-match-p "\\`[0-9]+\\'" search-option) + (not (string-match-p "page=" options))) (setq options (concat options ",page=" search-option)))) (setq image-code (format "\\includegraphics%s{%s}" (cond ((not (org-string-nw-p options)) "") - ((= (aref options 0) ?,) - (format "[%s]"(substring options 1))) + ((string-prefix-p "," options) + (format "[%s]" (substring options 1))) (t (format "[%s]" options))) path)) (when (equal filetype "svg") @@ -2231,46 +2361,53 @@ used as a communication channel." image-code nil t)))) ;; Return proper string, depending on FLOAT. - (case float - (wrap (format "\\begin{wrapfigure}%s -%s\\centering + (pcase float + (`wrap (format "\\begin{wrapfigure}%s +%s%s %s%s %s\\end{wrapfigure}" - placement - (if caption-above-p caption "") - comment-include image-code - (if caption-above-p "" caption))) - (sideways (format "\\begin{sidewaysfigure} -%s\\centering + placement + (if caption-above-p caption "") + (if center "\\centering" "") + comment-include image-code + (if caption-above-p "" caption))) + (`sideways (format "\\begin{sidewaysfigure} +%s%s %s%s %s\\end{sidewaysfigure}" - (if caption-above-p caption "") - comment-include image-code - (if caption-above-p "" caption))) - (multicolumn (format "\\begin{figure*}%s -%s\\centering + (if caption-above-p caption "") + (if center "\\centering" "") + comment-include image-code + (if caption-above-p "" caption))) + (`multicolumn (format "\\begin{figure*}%s +%s%s %s%s %s\\end{figure*}" - placement - (if caption-above-p caption "") - comment-include image-code - (if caption-above-p "" caption))) - (figure (format "\\begin{figure}%s -%s\\centering + placement + (if caption-above-p caption "") + (if center "\\centering" "") + comment-include image-code + (if caption-above-p "" caption))) + (`figure (format "\\begin{figure}%s +%s%s %s%s %s\\end{figure}" - placement - (if caption-above-p caption "") - comment-include image-code - (if caption-above-p "" caption))) - (nonfloat + placement + (if caption-above-p caption "") + (if center "\\centering" "") + comment-include image-code + (if caption-above-p "" caption))) + ((guard center) (format "\\begin{center} %s%s %s\\end{center}" (if caption-above-p caption "") image-code (if caption-above-p "" caption))) - (otherwise image-code)))) + (_ + (concat (if caption-above-p caption "") + image-code + (if caption-above-p caption "")))))) (defun org-latex-link (link desc info) "Transcode a LINK object from Org to LaTeX. @@ -2309,7 +2446,7 @@ INFO is a plist holding contextual information. See (let ((destination (if (string= type "fuzzy") (org-export-resolve-fuzzy-link link info) (org-export-resolve-id-link link info)))) - (case (org-element-type destination) + (cl-case (org-element-type destination) ;; Id link points to an external file. (plain-text (if desc (format "\\href{%s}{%s}" destination desc) @@ -2353,7 +2490,7 @@ INFO is a plist holding contextual information. See ;;;; Node Property -(defun org-latex-node-property (node-property contents info) +(defun org-latex-node-property (node-property _contents _info) "Transcode a NODE-PROPERTY element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." @@ -2365,7 +2502,7 @@ information." ;;;; Paragraph -(defun org-latex-paragraph (paragraph contents info) +(defun org-latex-paragraph (_paragraph contents _info) "Transcode a PARAGRAPH element from Org to LaTeX. CONTENTS is the contents of the paragraph, as a string. INFO is the plist used as a communication channel." @@ -2413,7 +2550,7 @@ contextual information." (replace-regexp-in-string (concat "[%$#&{}_~^]\\|\\\\" (and specialp "\\([^-]\\|$\\)")) (lambda (m) - (case (string-to-char m) + (cl-case (string-to-char m) (?\\ "$\\\\backslash$\\1") (?~ "\\\\textasciitilde{}") (?^ "\\\\^{}") @@ -2436,7 +2573,7 @@ contextual information." ;;;; Planning -(defun org-latex-planning (planning contents info) +(defun org-latex-planning (planning _contents info) "Transcode a PLANNING element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." @@ -2470,7 +2607,7 @@ information." ;;;; Property Drawer -(defun org-latex-property-drawer (property-drawer contents info) +(defun org-latex-property-drawer (_property-drawer contents _info) "Transcode a PROPERTY-DRAWER element from Org to LaTeX. CONTENTS holds the contents of the drawer. INFO is a plist holding contextual information." @@ -2524,24 +2661,28 @@ it." (org-element-extract-element previous) (org-element-adopt-elements matrices previous) (setq previous next)) + ;; Inherit `:post-blank' from the value of the last + ;; swallowed table. Set the latter's `:post-blank' + ;; value to 0 so as to not duplicate empty lines. (org-element-put-property matrices :post-blank (org-element-property :post-blank previous)) + (org-element-put-property previous :post-blank 0) (org-element-extract-element previous) (org-element-adopt-elements matrices previous)))))) info) data) -(defun org-latex-matrices (matrices contents info) +(defun org-latex-matrices (matrices contents _info) "Transcode a MATRICES element from Org to LaTeX. CONTENTS is a string. INFO is a plist used as a communication channel." - (format (case (org-element-property :markup matrices) + (format (cl-case (org-element-property :markup matrices) (inline "\\(%s\\)") (equation "\\begin{equation}\n%s\\end{equation}") (t "\\[\n%s\\]")) contents)) -(defun org-latex-matrices-tree-filter (tree backend info) +(defun org-latex-matrices-tree-filter (tree _backend info) (org-latex--wrap-latex-matrices tree info)) ;;;; Pseudo Object: LaTeX Math Block @@ -2554,16 +2695,15 @@ channel." DATA is a parse tree or a secondary string. INFO is a plist containing export options. Modify DATA by side-effect and return it." (let ((valid-object-p - (function - ;; Non-nil when OBJ can be added to the latex math block. - (lambda (obj) - (case (org-element-type obj) - (entity (org-element-property :latex-math-p obj)) - (latex-fragment - (let ((value (org-element-property :value obj))) - (or (org-string-match-p "\\`\\\\([^\000]*\\\\)\\'" value) - (org-string-match-p "\\`\\$[^\000]*\\$\\'" value)))) - ((subscript superscript) t)))))) + ;; Non-nil when OBJ can be added to the latex math block. + (lambda (obj) + (pcase (org-element-type obj) + (`entity (org-element-property :latex-math-p obj)) + (`latex-fragment + (let ((value (org-element-property :value obj))) + (or (string-prefix-p "\\(" value) + (string-match-p "\\`\\$[^$]" value)))) + ((or `subscript `superscript) t))))) (org-element-map data '(entity latex-fragment subscript superscript) (lambda (object) ;; Skip objects already wrapped. @@ -2598,15 +2738,15 @@ containing export options. Modify DATA by side-effect and return it." ;; Return updated DATA. data)) -(defun org-latex-math-block-tree-filter (tree backend info) +(defun org-latex-math-block-tree-filter (tree _backend info) (org-latex--wrap-latex-math-block tree info)) -(defun org-latex-math-block-options-filter (info backend) +(defun org-latex-math-block-options-filter (info _backend) (dolist (prop '(:author :date :title) info) (plist-put info prop (org-latex--wrap-latex-math-block (plist-get info prop) info)))) -(defun org-latex-math-block (math-block contents info) +(defun org-latex-math-block (_math-block contents _info) "Transcode a MATH-BLOCK object from Org to LaTeX. CONTENTS is a string. INFO is a plist used as a communication channel." @@ -2634,7 +2774,7 @@ contextual information." ;;;; Section -(defun org-latex-section (section contents info) +(defun org-latex-section (_section contents _info) "Transcode a SECTION element from Org to LaTeX. CONTENTS holds the contents of the section. INFO is a plist holding contextual information." @@ -2660,7 +2800,7 @@ holding contextual information." ;;;; Src Block -(defun org-latex-src-block (src-block contents info) +(defun org-latex-src-block (src-block _contents info) "Transcode a SRC-BLOCK element from Org to LaTeX. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." @@ -2672,9 +2812,7 @@ contextual information." (custom-env (and lang (cadr (assq (intern lang) org-latex-custom-lang-environments)))) - (num-start (case (org-element-property :number-lines src-block) - (continued (org-export-get-loc src-block info)) - (new 0))) + (num-start (org-export-get-loc src-block info)) (retain-labels (org-element-property :retain-labels src-block)) (attributes (org-export-read-attribute :attr_latex src-block)) (float (plist-get attributes :float)) @@ -2700,13 +2838,21 @@ contextual information." (org-export-format-code-default src-block info)))))) ;; Case 2. Custom environment. (custom-env - (let ((caption-str (org-latex--caption/label-string src-block info))) - (format "\\begin{%s}\n%s\\end{%s}\n" - custom-env - (concat (and caption-above-p caption-str) - (org-export-format-code-default src-block info) - (and (not caption-above-p) caption-str)) - custom-env))) + (let ((caption-str (org-latex--caption/label-string src-block info)) + (formatted-src (org-export-format-code-default src-block info))) + (if (string-match-p "\\`[a-zA-Z0-9]+\\'" custom-env) + (format "\\begin{%s}\n%s\\end{%s}\n" + custom-env + (concat (and caption-above-p caption-str) + formatted-src + (and (not caption-above-p) caption-str)) + custom-env) + (format-spec custom-env + `((?s . ,formatted-src) + (?c . ,caption) + (?f . ,float) + (?l . ,(org-latex--label src-block info)) + (?o . ,(or (plist-get attributes :options) ""))))))) ;; Case 3. Use minted package. ((eq listings 'minted) (let* ((caption-str (org-latex--caption/label-string src-block info)) @@ -2749,7 +2895,7 @@ contextual information." "\n"))))) (org-export-format-code (car code-info) - (lambda (loc num ref) + (lambda (loc _num ref) (concat loc (when ref @@ -2792,7 +2938,9 @@ contextual information." ((and float (not (assoc "float" lst-opt))) `(("float" ,(plist-get info :latex-default-figure-position))))) `(("language" ,lst-lang)) - (if label `(("label" ,label)) '(("label" " "))) + (if label + `(("label" ,(org-latex--label src-block info))) + '(("label" " "))) (if caption-str `(("caption" ,caption-str)) '(("caption" " "))) `(("captionpos" ,(if caption-above-p "t" "b"))) (cond ((assoc "numbers" lst-opt) nil) @@ -2811,21 +2959,21 @@ contextual information." (org-split-string (car code-info) "\n"))))) (org-export-format-code (car code-info) - (lambda (loc num ref) + (lambda (loc _num ref) (concat loc (when ref ;; Ensure references are flushed to the right, ;; separated with 6 spaces from the widest line of ;; code - (concat (make-string (+ (- max-width (length loc)) 6) ? ) + (concat (make-string (+ (- max-width (length loc)) 6) ?\s) (format "(%s)" ref))))) nil (and retain-labels (cdr code-info)))))))))))) ;;;; Statistics Cookie -(defun org-latex-statistics-cookie (statistics-cookie contents info) +(defun org-latex-statistics-cookie (statistics-cookie _contents _info) "Transcode a STATISTICS-COOKIE object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (replace-regexp-in-string @@ -2834,7 +2982,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Strike-Through -(defun org-latex-strike-through (strike-through contents info) +(defun org-latex-strike-through (_strike-through contents info) "Transcode STRIKE-THROUGH from Org to LaTeX. CONTENTS is the text with strike-through markup. INFO is a plist holding contextual information." @@ -2847,12 +2995,11 @@ holding contextual information." "Transcode a subscript or superscript object. OBJECT is an Org object. INFO is a plist used as a communication channel." - (let ((type (org-element-type object)) - (output "")) + (let ((output "")) (org-element-map (org-element-contents object) (cons 'plain-text org-element-all-objects) (lambda (obj) - (case (org-element-type obj) + (cl-case (org-element-type obj) ((entity latex-fragment) (let ((data (org-trim (org-export-data obj info)))) (string-match @@ -2880,7 +3027,7 @@ channel." output (and (> (length output) 1) "}")))) -(defun org-latex-subscript (subscript contents info) +(defun org-latex-subscript (subscript _contents info) "Transcode a SUBSCRIPT object from Org to LaTeX. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -2889,7 +3036,7 @@ contextual information." ;;;; Superscript -(defun org-latex-superscript (superscript contents info) +(defun org-latex-superscript (superscript _contents info) "Transcode a SUPERSCRIPT object from Org to LaTeX. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -2951,7 +3098,7 @@ a communication channel." ;; Check left border for the first cell only. (when (and (memq 'left borders) (not align)) (push "|" align)) - (push (case (org-export-table-cell-alignment cell info) + (push (cl-case (org-export-table-cell-alignment cell info) (left "l") (right "r") (center "c")) @@ -3103,7 +3250,7 @@ property." (let ((n 0) (pos 0)) (while (and (< (length output) pos) (setq pos (string-match "^\\\\hline\n?" output pos))) - (incf n) + (cl-incf n) (unless (= n 2) (setq output (replace-match "" nil nil output)))))) (let ((centerp (if (plist-member attr :center) (plist-get attr :center) (plist-get info :latex-tables-centered)))) @@ -3239,7 +3386,7 @@ a communication channel." ;;;; Target -(defun org-latex-target (target contents info) +(defun org-latex-target (target _contents info) "Transcode a TARGET object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." @@ -3248,14 +3395,14 @@ information." ;;;; Timestamp -(defun org-latex-timestamp (timestamp contents info) +(defun org-latex-timestamp (timestamp _contents info) "Transcode a TIMESTAMP object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-latex-plain-text (org-timestamp-translate timestamp) info))) (format (plist-get info - (case (org-element-property :type timestamp) + (cl-case (org-element-property :type timestamp) ((active active-range) :latex-active-timestamp-format) ((inactive inactive-range) :latex-inactive-timestamp-format) (otherwise :latex-diary-timestamp-format))) @@ -3264,7 +3411,7 @@ information." ;;;; Underline -(defun org-latex-underline (underline contents info) +(defun org-latex-underline (_underline contents info) "Transcode UNDERLINE from Org to LaTeX. CONTENTS is the text with underline markup. INFO is a plist holding contextual information." @@ -3273,7 +3420,7 @@ holding contextual information." ;;;; Verbatim -(defun org-latex-verbatim (verbatim contents info) +(defun org-latex-verbatim (verbatim _contents info) "Transcode a VERBATIM object from Org to LaTeX. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -3344,9 +3491,9 @@ is non-nil." ;;;###autoload (defun org-latex-convert-region-to-latex () - "Assume the current region has org-mode syntax, and convert it to LaTeX. + "Assume the current region has Org syntax, and convert it to LaTeX. This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an LaTeX buffer and use this +itemized list in Org syntax in an LaTeX buffer and use this command to convert it." (interactive) (org-export-replace-region-by 'latex)) @@ -3422,74 +3569,59 @@ Return PDF file's name." "Compile a TeX file. TEXFILE is the name of the file being compiled. Processing is -done through the command specified in `org-latex-pdf-process'. +done through the command specified in `org-latex-pdf-process', +which see. Output is redirected to \"*Org PDF LaTeX Output*\" +buffer. When optional argument SNIPPET is non-nil, TEXFILE is a temporary file used to preview a LaTeX snippet. In this case, do not -create a log buffer and do not bother removing log files. - -Return PDF file name or an error if it couldn't be produced." - (let* ((base-name (file-name-sans-extension (file-name-nondirectory texfile))) - (full-name (file-truename texfile)) - (out-dir (file-name-directory texfile)) - ;; Properly set working directory for compilation. - (default-directory (if (file-name-absolute-p texfile) - (file-name-directory full-name) - default-directory)) - (time (current-time)) - warnings) - (unless snippet (message "Processing LaTeX file %s..." texfile)) - (save-window-excursion - (cond - ;; A function is provided: Apply it. - ((functionp org-latex-pdf-process) - (funcall org-latex-pdf-process (shell-quote-argument texfile))) - ;; A list is provided: Replace %b, %f and %o with appropriate - ;; values in each command before applying it. Output is - ;; redirected to "*Org PDF LaTeX Output*" buffer. - ((consp org-latex-pdf-process) - (let ((outbuf (and (not snippet) - (get-buffer-create "*Org PDF LaTeX Output*")))) - (dolist (command org-latex-pdf-process) - (shell-command - (replace-regexp-in-string - "%b" (shell-quote-argument base-name) - (replace-regexp-in-string - "%f" (shell-quote-argument full-name) - (replace-regexp-in-string - "%o" (shell-quote-argument out-dir) command t t) t t) t t) - outbuf)) - ;; Collect standard errors from output buffer. - (setq warnings (and (not snippet) - (org-latex--collect-warnings outbuf))))) - (t (error "No valid command to process to PDF"))) - (let ((pdffile (concat out-dir base-name ".pdf"))) - ;; Check for process failure. Provide collected errors if - ;; possible. - (if (or (not (file-exists-p pdffile)) - ;; Only compare times up to whole seconds as some filesystems - ;; (e.g. HFS+) do not retain any finer granularity. - (time-less-p (org-sublist (nth 5 (file-attributes pdffile)) 1 2) - (org-sublist time 1 2))) - (error (format "PDF file %s wasn't produced" pdffile)) - ;; Else remove log files, when specified, and signal end of - ;; process to user, along with any error encountered. - (unless snippet - (when org-latex-remove-logfiles - (dolist (file (directory-files - out-dir t - (concat (regexp-quote base-name) - "\\(?:\\.[0-9]+\\)?" - "\\." - (regexp-opt org-latex-logfiles-extensions)))) - (delete-file file))) - (message (concat "PDF file produced" - (cond - ((eq warnings 'error) " with errors.") - (warnings (concat " with warnings: " warnings)) - (t ".")))))) - ;; Return output file name. - pdffile)))) +create a log buffer and do not remove log files. + +Return PDF file name or raise an error if it couldn't be +produced." + (unless snippet (message "Processing LaTeX file %s..." texfile)) + (let* ((compiler + (or (with-temp-buffer + (save-excursion (insert-file-contents texfile)) + (and (search-forward-regexp (regexp-opt org-latex-compilers) + (line-end-position 2) + t) + (progn (beginning-of-line) (looking-at-p "%")) + (match-string 0))) + "pdflatex")) + (process (if (functionp org-latex-pdf-process) org-latex-pdf-process + ;; Replace "%latex" and "%bibtex" with, + ;; respectively, "%L" and "%B" so as to adhere to + ;; `format-spec' specifications. + (mapcar (lambda (command) + (replace-regexp-in-string + "%\\(?:bib\\|la\\)tex\\>" + (lambda (m) (upcase (substring m 0 2))) + command)) + org-latex-pdf-process))) + (spec `((?B . ,(shell-quote-argument org-latex-bib-compiler)) + (?L . ,(shell-quote-argument compiler)))) + (log-buf-name "*Org PDF LaTeX Output*") + (log-buf (and (not snippet) (get-buffer-create log-buf-name))) + (outfile (org-compile-file texfile process "pdf" + (format "See %S for details" log-buf-name) + log-buf spec))) + (unless snippet + (when org-latex-remove-logfiles + (mapc #'delete-file + (directory-files + (file-name-directory texfile) t + (concat (regexp-quote (file-name-base outfile)) + "\\(?:\\.[0-9]+\\)?\\." + (regexp-opt org-latex-logfiles-extensions))))) + (let ((warnings (org-latex--collect-warnings log-buf))) + (message (concat "PDF file produced" + (cond + ((eq warnings 'error) " with errors.") + (warnings (concat " with warnings: " warnings)) + (t ".")))))) + ;; Return output file name. + outfile)) (defun org-latex--collect-warnings (buffer) "Collect some warnings from \"pdflatex\" command output. diff --git a/lisp/ox-man.el b/lisp/ox-man.el index df744e8..4e2bfc7 100644 --- a/lisp/ox-man.el +++ b/lisp/ox-man.el @@ -1,4 +1,4 @@ -;; ox-man.el --- Man Back-End for Org Export Engine +;; ox-man.el --- Man Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -29,18 +29,17 @@ ;; ;; M-: (org-export-to-buffer 'man "*Test Man*") RET ;; -;; in an org-mode buffer then switch to the buffer to see the Man -;; export. See ox.el for more details on how this exporter works. +;; in an Org buffer then switch to the buffer to see the Man export. +;; See ox.el for more details on how this exporter works. ;; ;; It introduces one new buffer keywords: ;; "MAN_CLASS_OPTIONS". ;;; Code: +(require 'cl-lib) (require 'ox) -(eval-when-compile (require 'cl)) - (defvar org-export-man-default-packages-alist) (defvar org-export-man-packages-alist) (defvar orgtbl-exp-regexp) @@ -53,7 +52,6 @@ '((babel-call . org-man-babel-call) (bold . org-man-bold) (center-block . org-man-center-block) - (clock . org-man-clock) (code . org-man-code) (drawer . org-man-drawer) (dynamic-block . org-man-dynamic-block) @@ -98,7 +96,6 @@ (underline . org-man-underline) (verbatim . org-man-verbatim) (verse-block . org-man-verse-block)) - :export-block "MAN" :menu-entry '(?M "Export to MAN" ((?m "As MAN file" org-man-export-to-man) @@ -203,21 +200,6 @@ in this list - but it does not hurt if it is present." (string :tag "Listings language")))) - -(defvar org-man-custom-lang-environments nil - "Alist mapping languages to language-specific Man environments. - -It is used during export of src blocks by the listings and -man packages. For example, - - (setq org-man-custom-lang-environments - '((python \"pythoncode\"))) - -would have the effect that if org encounters begin_src python -during man export." -) - - ;;; Compilation (defcustom org-man-pdf-process @@ -343,7 +325,7 @@ holding export options." ;;; Bold -(defun org-man-bold (bold contents info) +(defun org-man-bold (_bold contents _info) "Transcode BOLD from Org to Man. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." @@ -352,7 +334,7 @@ contextual information." ;;; Center Block -(defun org-man-center-block (center-block contents info) +(defun org-man-center-block (center-block contents _info) "Transcode a CENTER-BLOCK element from Org to Man. CONTENTS holds the contents of the center block. INFO is a plist holding contextual information." @@ -363,37 +345,18 @@ holding contextual information." contents))) -;;; Clock - -(defun org-man-clock (clock contents info) - "Transcode a CLOCK element from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual -information." - "" ) - - ;;; Code -(defun org-man-code (code contents info) +(defun org-man-code (code _contents _info) "Transcode a CODE object from Org to Man. CONTENTS is nil. INFO is a plist used as a communication channel." (format "\\fC%s\\fP" code)) -;;; Comment -;; -;; Comments are ignored. - - -;;; Comment Block -;; -;; Comment Blocks are ignored. - - ;;; Drawer -(defun org-man-drawer (drawer contents info) +(defun org-man-drawer (_drawer contents _info) "Transcode a DRAWER element from Org to Man. DRAWER holds the drawer information CONTENTS holds the contents of the block. @@ -403,7 +366,7 @@ channel." ;;; Dynamic Block -(defun org-man-dynamic-block (dynamic-block contents info) +(defun org-man-dynamic-block (dynamic-block contents _info) "Transcode a DYNAMIC-BLOCK element from Org to Man. CONTENTS holds the contents of the block. INFO is a plist holding contextual information. See `org-export-data'." @@ -412,7 +375,7 @@ holding contextual information. See `org-export-data'." ;;; Entity -(defun org-man-entity (entity contents info) +(defun org-man-entity (entity _contents _info) "Transcode an ENTITY object from Org to Man. CONTENTS are the definition itself. INFO is a plist holding contextual information." @@ -421,7 +384,7 @@ contextual information." ;;; Example Block -(defun org-man-example-block (example-block contents info) +(defun org-man-example-block (example-block _contents info) "Transcode an EXAMPLE-BLOCK element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." @@ -433,7 +396,7 @@ information." ;;; Export Block -(defun org-man-export-block (export-block contents info) +(defun org-man-export-block (export-block _contents _info) "Transcode a EXPORT-BLOCK element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." (when (string= (org-element-property :type export-block) "MAN") @@ -442,7 +405,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;; Export Snippet -(defun org-man-export-snippet (export-snippet contents info) +(defun org-man-export-snippet (export-snippet _contents _info) "Transcode a EXPORT-SNIPPET object from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." (when (eq (org-export-snippet-backend export-snippet) 'man) @@ -451,7 +414,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;; Fixed Width -(defun org-man-fixed-width (fixed-width contents info) +(defun org-man-fixed-width (fixed-width _contents _info) "Transcode a FIXED-WIDTH element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." (org-man--wrap-label @@ -477,16 +440,15 @@ CONTENTS is nil. INFO is a plist holding contextual information." CONTENTS holds the contents of the headline. INFO is a plist holding contextual information." (let* ((level (org-export-get-relative-level headline info)) - (numberedp (org-export-numbered-headline-p headline info)) - ;; Section formatting will set two placeholders: one for the - ;; title and the other for the contents. - (section-fmt - (case level - (1 ".SH \"%s\"\n%s") - (2 ".SS \"%s\"\n%s") - (3 ".SS \"%s\"\n%s") - (t nil))) - (text (org-export-data (org-element-property :title headline) info))) + ;; Section formatting will set two placeholders: one for the + ;; title and the other for the contents. + (section-fmt + (pcase level + (1 ".SH \"%s\"\n%s") + (2 ".SS \"%s\"\n%s") + (3 ".SS \"%s\"\n%s") + (_ nil))) + (text (org-export-data (org-element-property :title headline) info))) (cond ;; Case 1: This is a footnote section: ignore it. @@ -498,20 +460,20 @@ holding contextual information." ((or (not section-fmt) (org-export-low-level-p headline info)) ;; Build the real contents of the sub-tree. (let ((low-level-body - (concat - ;; If the headline is the first sibling, start a list. - (when (org-export-first-sibling-p headline info) - (format "%s\n" ".RS")) - ;; Itemize headline - ".TP\n.ft I\n" text "\n.ft\n" - contents ".RE"))) - ;; If headline is not the last sibling simply return - ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any - ;; blank line. - (if (not (org-export-last-sibling-p headline info)) low-level-body - (replace-regexp-in-string - "[ \t\n]*\\'" "" - low-level-body)))) + (concat + ;; If the headline is the first sibling, start a list. + (when (org-export-first-sibling-p headline info) + (format "%s\n" ".RS")) + ;; Itemize headline + ".TP\n.ft I\n" text "\n.ft\n" + contents ".RE"))) + ;; If headline is not the last sibling simply return + ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any + ;; blank line. + (if (not (org-export-last-sibling-p headline info)) low-level-body + (replace-regexp-in-string + "[ \t\n]*\\'" "" + low-level-body)))) ;; Case 3. Standard headline. Export it as a section. (t (format section-fmt text contents ))))) @@ -525,16 +487,14 @@ holding contextual information." ;;; Inline Src Block -(defun org-man-inline-src-block (inline-src-block contents info) +(defun org-man-inline-src-block (inline-src-block _contents info) "Transcode an INLINE-SRC-BLOCK element from Org to Man. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((code (org-element-property :value inline-src-block))) (cond ((plist-get info :man-source-highlight) - (let* ((tmpdir (if (featurep 'xemacs) - temp-directory - temporary-file-directory )) + (let* ((tmpdir temporary-file-directory) (in-file (make-temp-name (expand-file-name "srchilite" tmpdir))) (out-file (make-temp-name @@ -570,7 +530,7 @@ contextual information." ;;; Inlinetask ;;; Italic -(defun org-man-italic (italic contents info) +(defun org-man-italic (_italic contents _info) "Transcode ITALIC from Org to Man. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." @@ -581,17 +541,15 @@ contextual information." (defun org-man-item (item contents info) - "Transcode an ITEM element from Org to Man. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((bullet (org-element-property :bullet item)) (type (org-element-property :type (org-element-property :parent item))) - (checkbox (case (org-element-property :checkbox item) - (on "\\o'\\(sq\\(mu'") ;; - (off "\\(sq ") ;; - (trans "\\o'\\(sq\\(mi'" ))) ;; + (checkbox (pcase (org-element-property :checkbox item) + (`on "\\o'\\(sq\\(mu'") + (`off "\\(sq ") + (`trans "\\o'\\(sq\\(mi'"))) (tag (let ((tag (org-element-property :tag item))) ;; Check-boxes must belong to the tag. @@ -599,24 +557,22 @@ contextual information." (concat checkbox (org-export-data tag info))))))) - (if (and (null tag ) - (null checkbox)) - (let* ((bullet (org-trim bullet)) - (marker (cond ((string= "-" bullet) "\\(em") - ((string= "*" bullet) "\\(bu") - ((eq type 'ordered) - (format "%s " (org-trim bullet))) - (t "\\(dg")))) - (concat ".IP " marker " 4\n" - (org-trim (or contents " " )))) - ; else + (if (and (null tag) (null checkbox)) + (let* ((bullet (org-trim bullet)) + (marker (cond ((string= "-" bullet) "\\(em") + ((string= "*" bullet) "\\(bu") + ((eq type 'ordered) + (format "%s " (org-trim bullet))) + (t "\\(dg")))) + (concat ".IP " marker " 4\n" + (org-trim (or contents " " )))) (concat ".TP\n" (or tag (concat " " checkbox)) "\n" (org-trim (or contents " " )))))) ;;; Keyword -(defun org-man-keyword (keyword contents info) +(defun org-man-keyword (keyword _contents _info) "Transcode a KEYWORD element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." (let ((key (org-element-property :key keyword)) @@ -629,7 +585,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;; Line Break -(defun org-man-line-break (line-break contents info) +(defun org-man-line-break (_line-break _contents _info) "Transcode a LINE-BREAK object from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." ".br\n") @@ -638,7 +594,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;; Link -(defun org-man-link (link desc info) +(defun org-man-link (link desc _info) "Transcode a LINK object from Org to Man. DESC is the description part of the link, or the empty string. @@ -652,8 +608,7 @@ INFO is a plist holding contextual information. See ((member type '("http" "https" "ftp" "mailto")) (concat type ":" raw-path)) ((string= type "file") (org-export-file-uri raw-path)) - (t raw-path))) - protocol) + (t raw-path)))) (cond ;; Link type is handled by a special function. ((org-export-custom-protocol-maybe link desc 'man)) @@ -666,7 +621,7 @@ INFO is a plist holding contextual information. See ;;;; Node Property -(defun org-man-node-property (node-property contents info) +(defun org-man-node-property (node-property _contents _info) "Transcode a NODE-PROPERTY element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." @@ -677,7 +632,7 @@ information." ;;; Paragraph -(defun org-man-paragraph (paragraph contents info) +(defun org-man-paragraph (paragraph contents _info) "Transcode a PARAGRAPH element from Org to Man. CONTENTS is the contents of the paragraph, as a string. INFO is the plist used as a communication channel." @@ -698,7 +653,7 @@ the plist used as a communication channel." ;;; Plain List -(defun org-man-plain-list (plain-list contents info) +(defun org-man-plain-list (_plain-list contents _info) "Transcode a PLAIN-LIST element from Org to Man. CONTENTS is the contents of the list. INFO is a plist holding contextual information." @@ -733,7 +688,7 @@ contextual information." ;;; Property Drawer -(defun org-man-property-drawer (property-drawer contents info) +(defun org-man-property-drawer (_property-drawer contents _info) "Transcode a PROPERTY-DRAWER element from Org to Man. CONTENTS holds the contents of the drawer. INFO is a plist holding contextual information." @@ -742,7 +697,7 @@ holding contextual information." ;;; Quote Block -(defun org-man-quote-block (quote-block contents info) +(defun org-man-quote-block (quote-block contents _info) "Transcode a QUOTE-BLOCK element from Org to Man. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -753,16 +708,16 @@ holding contextual information." ;;; Radio Target -(defun org-man-radio-target (radio-target text info) +(defun org-man-radio-target (_radio-target text _info) "Transcode a RADIO-TARGET object from Org to Man. TEXT is the text of the target. INFO is a plist holding contextual information." - text ) + text) ;;; Section -(defun org-man-section (section contents info) +(defun org-man-section (_section contents _info) "Transcode a SECTION element from Org to Man. CONTENTS holds the contents of the section. INFO is a plist holding contextual information." @@ -771,61 +726,49 @@ holding contextual information." ;;; Special Block -(defun org-man-special-block (special-block contents info) +(defun org-man-special-block (special-block contents _info) "Transcode a SPECIAL-BLOCK element from Org to Man. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." - (let ((type (org-element-property :type special-block))) - (org-man--wrap-label - special-block - (format "%s\n" contents)))) + (org-man--wrap-label special-block (format "%s\n" contents))) ;;; Src Block -(defun org-man-src-block (src-block contents info) +(defun org-man-src-block (src-block _contents info) "Transcode a SRC-BLOCK element from Org to Man. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((lang (org-element-property :language src-block)) - (code (org-element-property :value src-block)) - (custom-env (and lang - (cadr (assq (intern lang) - org-man-custom-lang-environments)))) - (num-start (case (org-element-property :number-lines src-block) - (continued (org-export-get-loc src-block info)) - (new 0))) - (retain-labels (org-element-property :retain-labels src-block))) - (if (not (plist-get info :man-source-highlight)) - (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n" - (org-export-format-code-default src-block info)) - (let* ((tmpdir (if (featurep 'xemacs) temp-directory - temporary-file-directory)) - (in-file (make-temp-name (expand-file-name "srchilite" tmpdir))) - (out-file (make-temp-name (expand-file-name "reshilite" tmpdir))) - (org-lang (org-element-property :language src-block)) - (lst-lang - (cadr (assq (intern org-lang) - (plist-get info :man-source-highlight-langs)))) - (cmd (concat "source-highlight" - " -s " lst-lang - " -f groff_man " - " -i " in-file - " -o " out-file))) - (if lst-lang - (let ((code-block "")) - (with-temp-file in-file (insert code)) - (shell-command cmd) - (setq code-block (org-file-contents out-file)) - (delete-file in-file) - (delete-file out-file) - code-block) - (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code)))))) + (if (not (plist-get info :man-source-highlight)) + (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n" + (org-export-format-code-default src-block info)) + (let* ((tmpdir temporary-file-directory) + (in-file (make-temp-name (expand-file-name "srchilite" tmpdir))) + (out-file (make-temp-name (expand-file-name "reshilite" tmpdir))) + (code (org-element-property :value src-block)) + (org-lang (org-element-property :language src-block)) + (lst-lang + (cadr (assq (intern org-lang) + (plist-get info :man-source-highlight-langs)))) + (cmd (concat "source-highlight" + " -s " lst-lang + " -f groff_man " + " -i " in-file + " -o " out-file))) + (if lst-lang + (let ((code-block "")) + (with-temp-file in-file (insert code)) + (shell-command cmd) + (setq code-block (org-file-contents out-file)) + (delete-file in-file) + (delete-file out-file) + code-block) + (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code))))) ;;; Statistics Cookie -(defun org-man-statistics-cookie (statistics-cookie contents info) +(defun org-man-statistics-cookie (statistics-cookie _contents _info) "Transcode a STATISTICS-COOKIE object from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." (org-element-property :value statistics-cookie)) @@ -833,7 +776,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;; Strike-Through -(defun org-man-strike-through (strike-through contents info) +(defun org-man-strike-through (_strike-through contents _info) "Transcode STRIKE-THROUGH from Org to Man. CONTENTS is the text with strike-through markup. INFO is a plist holding contextual information." @@ -841,7 +784,7 @@ holding contextual information." ;;; Subscript -(defun org-man-subscript (subscript contents info) +(defun org-man-subscript (_subscript contents _info) "Transcode a SUBSCRIPT object from Org to Man. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -849,7 +792,7 @@ contextual information." ;;; Superscript "^_%s$ -(defun org-man-superscript (superscript contents info) +(defun org-man-superscript (_superscript contents _info) "Transcode a SUPERSCRIPT object from Org to Man. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -912,14 +855,14 @@ a communication channel." (when (and (memq 'left borders) (not alignment)) (push "|" alignment)) (push - (case (org-export-table-cell-alignment cell info) - (left (concat "l" width divider)) - (right (concat "r" width divider)) - (center (concat "c" width divider))) + (concat (pcase (org-export-table-cell-alignment cell info) + (`left "l") (`right "r") (`center "c")) + width + divider) alignment) (when (memq 'right borders) (push "|" alignment)))) info) - (apply 'concat (reverse alignment)))) + (apply #'concat (reverse alignment)))) (defun org-man-table--org-table (table contents info) "Return appropriate Man code for an Org table. @@ -930,7 +873,6 @@ channel. This function assumes TABLE has `org' as its `:type' attribute." (let* ((attr (org-export-read-attribute :attr_man table)) - (label (org-element-property :name table)) (caption (and (not (plist-get attr :disable-caption)) (org-man--caption/label-string table info))) (divider (if (plist-get attr :divider) "|" " ")) @@ -976,14 +918,14 @@ This function assumes TABLE has `org' as its `:type' attribute." (format "%s.\n" (let ((final-line "")) (when title-line - (dotimes (i (length first-line)) + (dotimes (_ (length first-line)) (setq final-line (concat final-line "cb" divider)))) (setq final-line (concat final-line "\n")) (if alignment (setq final-line (concat final-line alignment)) - (dotimes (i (length first-line)) + (dotimes (_ (length first-line)) (setq final-line (concat final-line "c" divider)))) final-line )) @@ -1040,35 +982,26 @@ a communication channel." ;;; Table Row (defun org-man-table-row (table-row contents info) - "Transcode a TABLE-ROW element from Org to Man + "Transcode a TABLE-ROW element from Org to Man. CONTENTS is the contents of the row. INFO is a plist used as a communication channel." - ;; Rules are ignored since table separators are deduced from - ;; borders of the current row. + ;; Rules are ignored since table separators are deduced from borders + ;; of the current row. (when (eq (org-element-property :type table-row) 'standard) - (let* ((attr (mapconcat 'identity - (org-element-property - :attr_man (org-export-get-parent table-row)) - " ")) - ;; TABLE-ROW's borders are extracted from its first cell. - (borders - (org-export-table-cell-borders - (car (org-element-contents table-row)) info))) + (let ((borders + ;; TABLE-ROW's borders are extracted from its first cell. + (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) (concat - ;; Mark horizontal lines - (cond ((and (memq 'top borders) (memq 'above borders)) "_\n")) + (cond ((and (memq 'top borders) (memq 'above borders)) "_\n")) contents - - (cond - ;; When BOOKTABS are activated enforce bottom rule even when - ;; no hline was specifically marked. - ((and (memq 'bottom borders) (memq 'below borders)) "\n_") - ((memq 'below borders) "\n_")))))) + (cond ((and (memq 'bottom borders) (memq 'below borders)) "\n_") + ((memq 'below borders) "\n_")))))) ;;; Target -(defun org-man-target (target contents info) +(defun org-man-target (target _contents info) "Transcode a TARGET object from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1077,16 +1010,15 @@ information." ;;; Timestamp -(defun org-man-timestamp (timestamp contents info) +(defun org-man-timestamp (_timestamp _contents _info) "Transcode a TIMESTAMP object from Org to Man. - CONTENTS is nil. INFO is a plist holding contextual - information." - "" ) +ONTENTS is nil. INFO is a plist holding contextual information." + "") ;;; Underline -(defun org-man-underline (underline contents info) +(defun org-man-underline (_underline contents _info) "Transcode UNDERLINE from Org to Man. CONTENTS is the text with underline markup. INFO is a plist holding contextual information." @@ -1095,7 +1027,7 @@ holding contextual information." ;;; Verbatim -(defun org-man-verbatim (verbatim contents info) +(defun org-man-verbatim (_verbatim contents _info) "Transcode a VERBATIM object from Org to Man. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -1104,7 +1036,7 @@ channel." ;;; Verse Block -(defun org-man-verse-block (verse-block contents info) +(defun org-man-verse-block (_verse-block contents _info) "Transcode a VERSE-BLOCK element from Org to Man. CONTENTS is verse block contents. INFO is a plist holding contextual information." @@ -1188,68 +1120,15 @@ FILE is the name of the file being compiled. Processing is done through the command specified in `org-man-pdf-process'. Return PDF file name or an error if it couldn't be produced." - (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) - (full-name (file-truename file)) - (out-dir (file-name-directory file)) - ;; Properly set working directory for compilation. - (default-directory (if (file-name-absolute-p file) - (file-name-directory full-name) - default-directory)) - errors) - (message "Processing Groff file %s..." file) - (save-window-excursion - (cond - ;; A function is provided: Apply it. - ((functionp org-man-pdf-process) - (funcall org-man-pdf-process (shell-quote-argument file))) - ;; A list is provided: Replace %b, %f and %o with appropriate - ;; values in each command before applying it. Output is - ;; redirected to "*Org PDF Groff Output*" buffer. - ((consp org-man-pdf-process) - (let ((outbuf (get-buffer-create "*Org PDF Groff Output*"))) - (mapc - (lambda (command) - (shell-command - (replace-regexp-in-string - "%b" (shell-quote-argument base-name) - (replace-regexp-in-string - "%f" (shell-quote-argument full-name) - (replace-regexp-in-string - "%o" (shell-quote-argument out-dir) command t t) t t) t t) - outbuf)) - org-man-pdf-process) - ;; Collect standard errors from output buffer. - (setq errors (org-man-collect-errors outbuf)))) - (t (error "No valid command to process to PDF"))) - (let ((pdffile (concat out-dir base-name ".pdf"))) - ;; Check for process failure. Provide collected errors if - ;; possible. - (if (not (file-exists-p pdffile)) - (error "PDF file %s wasn't produced%s" pdffile - (if errors (concat ": " errors) "")) - ;; Else remove log files, when specified, and signal end of - ;; process to user, along with any error encountered. - (when org-man-remove-logfiles - (dolist (ext org-man-logfiles-extensions) - (let ((file (concat out-dir base-name "." ext))) - (when (file-exists-p file) (delete-file file))))) - (message (concat "Process completed" - (if (not errors) "." - (concat " with errors: " errors))))) - ;; Return output file name. - pdffile)))) - -(defun org-man-collect-errors (buffer) - "Collect some kind of errors from \"groff\" output -BUFFER is the buffer containing output. -Return collected error types as a string, or nil if there was -none." - (with-current-buffer buffer - (save-excursion - (goto-char (point-max)) - ;; Find final run - nil ))) - + (message "Processing Groff file %s..." file) + (let ((output (org-compile-file file org-man-pdf-process "pdf"))) + (when org-man-remove-logfiles + (let ((base (file-name-sans-extension output))) + (dolist (ext org-man-logfiles-extensions) + (let ((file (concat base "." ext))) + (when (file-exists-p file) (delete-file file)))))) + (message "Process completed.") + output)) (provide 'ox-man) diff --git a/lisp/ox-md.el b/lisp/ox-md.el index 0aaade6..b8c4704 100644 --- a/lisp/ox-md.el +++ b/lisp/ox-md.el @@ -1,4 +1,4 @@ -;;; ox-md.el --- Markdown Back-End for Org Export Engine +;;; ox-md.el --- Markdown Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2016 Free Software Foundation, Inc. @@ -28,7 +28,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'ox-html) (require 'ox-publish) @@ -51,11 +51,29 @@ This variable can be set to either `atx' or `setext'." (const :tag "Use \"Setext\" style" setext))) +;;;; Footnotes + +(defcustom org-md-footnotes-section "%s%s" + "Format string for the footnotes section. +The first %s placeholder will be replaced with the localized Footnotes section +heading, the second with the contents of the Footnotes section." + :group 'org-export-md + :type 'string + :version "25.2" + :package-version '(Org . "9.0")) + +(defcustom org-md-footnote-format "<sup>%s</sup>" + "Format string for the footnote reference. +The %s will be replaced by the footnote reference itself." + :group 'org-export-md + :type 'string + :version "25.2" + :package-version '(Org . "9.0")) + ;;; Define Back-End (org-export-define-derived-backend 'md 'html - :export-block '("MD" "MARKDOWN") :filters-alist '((:filter-parse-tree . org-md-separate-elements)) :menu-entry '(?m "Export to Markdown" @@ -90,12 +108,15 @@ This variable can be set to either `atx' or `setext'." (src-block . org-md-example-block) (template . org-md-template) (verbatim . org-md-verbatim)) - :options-alist '((:md-headline-style nil nil org-md-headline-style))) + :options-alist + '((:md-footnote-format nil nil org-md-footnote-format) + (:md-footnotes-section nil nil org-md-footnotes-section) + (:md-headline-style nil nil org-md-headline-style))) ;;; Filters -(defun org-md-separate-elements (tree backend info) +(defun org-md-separate-elements (tree _backend info) "Fix blank lines between elements. TREE is the parse tree being exported. BACKEND is the export @@ -132,7 +153,7 @@ Assume BACKEND is `md'." ;;;; Bold -(defun org-md-bold (bold contents info) +(defun org-md-bold (_bold contents _info) "Transcode BOLD object into Markdown format. CONTENTS is the text within bold markup. INFO is a plist used as a communication channel." @@ -141,14 +162,14 @@ a communication channel." ;;;; Code and Verbatim -(defun org-md-verbatim (verbatim contents info) +(defun org-md-verbatim (verbatim _contents _info) "Transcode VERBATIM object into Markdown format. CONTENTS is nil. INFO is a plist used as a communication channel." (let ((value (org-element-property :value verbatim))) (format (cond ((not (string-match "`" value)) "`%s`") - ((or (string-match "\\``" value) - (string-match "`\\'" value)) + ((or (string-prefix-p "`" value) + (string-suffix-p "`" value)) "`` %s ``") (t "``%s``")) value))) @@ -156,7 +177,7 @@ channel." ;;;; Example Block, Src Block and export Block -(defun org-md-example-block (example-block contents info) +(defun org-md-example-block (example-block _contents info) "Transcode EXAMPLE-BLOCK element into Markdown format. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -216,24 +237,33 @@ a communication channel." (car (last (org-export-get-headline-number headline info)))) ".")))) - (concat bullet (make-string (- 4 (length bullet)) ?\s) heading tags - "\n\n" - (and contents - (replace-regexp-in-string "^" " " contents))))) - ;; Use "Setext" style. - ((eq style 'setext) - (concat heading tags anchor "\n" - (make-string (length heading) (if (= level 1) ?= ?-)) - "\n\n" - contents)) - ;; Use "atx" style. - (t (concat (make-string level ?#) " " heading tags anchor "\n\n" - contents)))))) - + (concat bullet (make-string (- 4 (length bullet)) ?\s) heading tags "\n\n" + (and contents (replace-regexp-in-string "^" " " contents))))) + (t (concat (org-md--headline-title style level title anchor tags) contents)))))) + + +;; Headline Title + +(defun org-md--headline-title (style level title &optional anchor tags) + "Generate a headline title in the preferred Markdown headline style. +STYLE is the preferred style (`atx' or `setext'). LEVEL is the +header level. TITLE is the headline title. ANCHOR is the HTML +anchor tag for the section as a string. TAGS are the tags set on +the section." + (let ((anchor-lines (and anchor (concat anchor "\n\n")))) + ;; Use "Setext" style + (if (and (eq style 'setext) (< level 3)) + (let* ((underline-char (if (= level 1) ?= ?-)) + (underline (concat (make-string (length title) underline-char) + "\n"))) + (concat "\n" anchor-lines title tags "\n" underline "\n")) + ;; Use "Atx" style + (let ((level-mark (make-string level ?#))) + (concat "\n" anchor-lines level-mark " " title tags "\n\n"))))) ;;;; Horizontal Rule -(defun org-md-horizontal-rule (horizontal-rule contents info) +(defun org-md-horizontal-rule (_horizontal-rule _contents _info) "Transcode HORIZONTAL-RULE element into Markdown format. CONTENTS is the horizontal rule contents. INFO is a plist used as a communication channel." @@ -242,7 +272,7 @@ as a communication channel." ;;;; Italic -(defun org-md-italic (italic contents info) +(defun org-md-italic (_italic contents _info) "Transcode ITALIC object into Markdown format. CONTENTS is the text within italic markup. INFO is a plist used as a communication channel." @@ -267,10 +297,10 @@ a communication channel." ".")))) (concat bullet (make-string (- 4 (length bullet)) ? ) - (case (org-element-property :checkbox item) - (on "[X] ") - (trans "[-] ") - (off "[ ] ")) + (pcase (org-element-property :checkbox item) + (`on "[X] ") + (`trans "[-] ") + (`off "[ ] ")) (let ((tag (org-element-property :tag item))) (and tag (format "**%s:** "(org-export-data tag info)))) (and contents @@ -291,7 +321,7 @@ channel." ;;;; Line Break -(defun org-md-line-break (line-break contents info) +(defun org-md-line-break (_line-break _contents _info) "Transcode LINE-BREAK object into Markdown format. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -318,12 +348,12 @@ a communication channel." (let ((destination (if (string= type "fuzzy") (org-export-resolve-fuzzy-link link info) (org-export-resolve-id-link link info)))) - (case (org-element-type destination) - (plain-text ; External file. + (pcase (org-element-type destination) + (`plain-text ; External file. (let ((path (funcall link-org-files-as-md destination))) (if (not contents) (format "<%s>" path) (format "[%s](%s)" contents path)))) - (headline + (`headline (format "[%s](#%s)" ;; Description. @@ -337,7 +367,7 @@ a communication channel." ;; Reference. (or (org-element-property :CUSTOM_ID destination) (org-export-get-reference destination info)))) - (t + (_ (let ((description (or (org-string-nw-p contents) (let ((number (org-export-get-ordinal destination info))) @@ -378,7 +408,7 @@ a communication channel." ;;;; Node Property -(defun org-md-node-property (node-property contents info) +(defun org-md-node-property (node-property _contents _info) "Transcode a NODE-PROPERTY element into Markdown syntax. CONTENTS is nil. INFO is a plist holding contextual information." @@ -390,20 +420,20 @@ information." ;;;; Paragraph -(defun org-md-paragraph (paragraph contents info) +(defun org-md-paragraph (paragraph contents _info) "Transcode PARAGRAPH element into Markdown format. CONTENTS is the paragraph contents. INFO is a plist used as a communication channel." (let ((first-object (car (org-element-contents paragraph)))) ;; If paragraph starts with a #, protect it. - (if (and (stringp first-object) (string-match "\\`#" first-object)) - (replace-regexp-in-string "\\`#" "\\#" contents nil t) + (if (and (stringp first-object) (string-prefix-p "#" first-object)) + (concat "\\" contents) contents))) ;;;; Plain List -(defun org-md-plain-list (plain-list contents info) +(defun org-md-plain-list (_plain-list contents _info) "Transcode PLAIN-LIST element into Markdown format. CONTENTS is the plain-list contents. INFO is a plist used as a communication channel." @@ -438,7 +468,7 @@ contextual information." ;;;; Property Drawer -(defun org-md-property-drawer (property-drawer contents info) +(defun org-md-property-drawer (_property-drawer contents _info) "Transcode a PROPERTY-DRAWER element into Markdown format. CONTENTS holds the contents of the drawer. INFO is a plist holding contextual information." @@ -448,7 +478,7 @@ holding contextual information." ;;;; Quote Block -(defun org-md-quote-block (quote-block contents info) +(defun org-md-quote-block (_quote-block contents _info) "Transcode QUOTE-BLOCK element into Markdown format. CONTENTS is the quote-block contents. INFO is a plist used as a communication channel." @@ -459,7 +489,7 @@ a communication channel." ;;;; Section -(defun org-md-section (section contents info) +(defun org-md-section (_section contents _info) "Transcode SECTION element into Markdown format. CONTENTS is the section contents. INFO is a plist used as a communication channel." @@ -468,15 +498,50 @@ a communication channel." ;;;; Template +(defun org-md--footnote-formatted (footnote info) + "Formats a single footnote entry FOOTNOTE. +FOOTNOTE is a cons cell of the form (number . definition). +INFO is a plist with contextual information." + (let* ((fn-num (car footnote)) + (fn-text (cdr footnote)) + (fn-format (plist-get info :md-footnote-format)) + (fn-anchor (format "fn.%d" fn-num)) + (fn-href (format " href=\"#fnr.%d\"" fn-num)) + (fn-link-to-ref (org-html--anchor fn-anchor fn-num fn-href info))) + (concat (format fn-format fn-link-to-ref) " " fn-text "\n"))) + +(defun org-md--footnote-section (info) + "Format the footnote section. +INFO is a plist used as a communication channel." + (let* ((fn-alist (org-export-collect-footnote-definitions info)) + (fn-alist (cl-loop for (n _type raw) in fn-alist collect + (cons n (org-trim (org-export-data raw info))))) + (headline-style (plist-get info :md-headline-style)) + (section-title (org-html--translate "Footnotes" info))) + (when fn-alist + (format (plist-get info :md-footnotes-section) + (org-md--headline-title headline-style 1 section-title) + (mapconcat (lambda (fn) (org-md--footnote-formatted fn info)) + fn-alist + "\n"))))) + (defun org-md-inner-template (contents info) "Return body of document after converting it to Markdown syntax. CONTENTS is the transcoded contents string. INFO is a plist holding export options." ;; Make sure CONTENTS is separated from table of contents and ;; footnotes with at least a blank line. - (org-trim (org-html-inner-template (concat "\n" contents "\n") info))) - -(defun org-md-template (contents info) + (concat + ;; Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth (org-html-toc depth info))) + ;; Document contents. + contents + "\n" + ;; Footnotes section. + (org-md--footnote-section info))) + +(defun org-md-template (contents _info) "Return complete document string after Markdown conversion. CONTENTS is the transcoded contents string. INFO is a plist used as a communication channel." @@ -515,9 +580,9 @@ non-nil." ;;;###autoload (defun org-md-convert-region-to-md () - "Assume the current region has org-mode syntax, and convert it to Markdown. + "Assume the current region has Org syntax, and convert it to Markdown. This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in a Markdown buffer and use +itemized list in Org syntax in a Markdown buffer and use this command to convert it." (interactive) (org-export-replace-region-by 'md)) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index 9fce5e7..05d86bf 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -1,4 +1,4 @@ -;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode +;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -25,12 +25,11 @@ ;;; Code: -(eval-when-compile - (require 'cl) - (require 'table nil 'noerror)) +(require 'cl-lib) (require 'format-spec) (require 'ox) (require 'org-compat) +(require 'table nil 'noerror) ;;; Define Back-End @@ -83,7 +82,6 @@ (underline . org-odt-underline) (verbatim . org-odt-verbatim) (verse-block . org-odt-verse-block)) - :export-block "ODT" :filters-alist '((:filter-parse-tree . (org-odt--translate-latex-fragments org-odt--translate-description-lists @@ -121,7 +119,7 @@ ;;; Hooks -;;; Function Declarations +;;; Function and Dynamically Scoped Variables Declarations (declare-function hfy-face-to-style "htmlfontify" (fn)) (declare-function hfy-face-or-def-to-name "htmlfontify" (fn)) @@ -129,6 +127,13 @@ (declare-function org-create-math-formula "org" (latex-frag &optional mathml-file)) (declare-function browse-url-file-url "browse-url" (file)) +(defvar nxml-auto-insert-xml-declaration-flag) ; nxml-mode.el +(defvar archive-zip-extract) ; arc-mode.el +(defvar hfy-end-span-handler) ; htmlfontify.el +(defvar hfy-begin-span-handler) ; htmlfontify.el +(defvar hfy-face-to-css) ; htmlfontify.el +(defvar hfy-html-quote-map) ; htmlfontify.el +(defvar hfy-html-quote-regex) ; htmlfontify.el ;;; Internal Variables @@ -172,7 +177,7 @@ and `org-odt-data-dir'.") (eval-when-compile (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install (expand-file-name "./styles/" org-odt-data-dir))) - (expand-file-name "../../etc/styles/" org-odt-lib-dir) ; git + (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa (expand-file-name "./org/" data-directory) ; system ) @@ -182,23 +187,14 @@ heuristically based on the values of `org-odt-lib-dir' and `org-odt-data-dir'.") (defconst org-odt-styles-dir - (let* ((styles-dir - (catch 'styles-dir - (message "Debug (ox-odt): Searching for OpenDocument styles files...") - (mapc (lambda (styles-dir) - (when styles-dir - (message "Debug (ox-odt): Trying %s..." styles-dir) - (when (and (file-readable-p - (expand-file-name - "OrgOdtContentTemplate.xml" styles-dir)) - (file-readable-p - (expand-file-name - "OrgOdtStyles.xml" styles-dir))) - (message "Debug (ox-odt): Using styles under %s" - styles-dir) - (throw 'styles-dir styles-dir)))) - org-odt-styles-dir-list) - nil))) + (let ((styles-dir + (cl-find-if + (lambda (dir) + (and dir + (file-readable-p + (expand-file-name "OrgOdtContentTemplate.xml" dir)) + (file-readable-p (expand-file-name "OrgOdtStyles.xml" dir)))) + org-odt-styles-dir-list))) (unless styles-dir (error "Error (ox-odt): Cannot find factory styles files, aborting")) styles-dir) @@ -210,9 +206,9 @@ This directory contains the following XML files - `org-odt-styles-file' and `org-odt-content-template-file'. The default value of this variable varies depending on the -version of org in use and is initialized from -`org-odt-styles-dir-list'. Note that the user could be using org -from one of: org's own private git repository, GNU ELPA tar or +version of Org in use and is initialized from +`org-odt-styles-dir-list'. Note that the user could be using Org +from one of: Org own private git repository, GNU ELPA tar or standard Emacs.") (defconst org-odt-bookmark-prefix "OrgXref.") @@ -277,7 +273,6 @@ except that the foreground and background colors are set according to the default face identified by the `htmlfontify'.") (defvar hfy-optimizations) -(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "25.1") (defvar org-odt-embedded-formulas-count 0) (defvar org-odt-embedded-images-count 0) (defvar org-odt-image-size-probe-method @@ -383,28 +378,14 @@ visually." (require 'rng-loc) (defcustom org-odt-schema-dir - (let* ((schema-dir - (catch 'schema-dir - (message "Debug (ox-odt): Searching for OpenDocument schema files...") - (mapc - (lambda (schema-dir) - (when schema-dir - (message "Debug (ox-odt): Trying %s..." schema-dir) - (when (and (file-expand-wildcards - (expand-file-name "od-manifest-schema*.rnc" - schema-dir)) - (file-expand-wildcards - (expand-file-name "od-schema*.rnc" - schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - (message "Debug (ox-odt): Using schema files under %s" - schema-dir) - (throw 'schema-dir schema-dir)))) - org-odt-schema-dir-list) - (message "Debug (ox-odt): No OpenDocument schema files installed") - nil))) - schema-dir) + (cl-find-if + (lambda (dir) + (and dir + (file-expand-wildcards + (expand-file-name "od-manifest-schema*.rnc" dir)) + (file-expand-wildcards (expand-file-name "od-schema*.rnc" dir)) + (file-readable-p (expand-file-name "schemas.xml" dir)))) + org-odt-schema-dir-list) "Directory that contains OpenDocument schema files. This directory contains: @@ -661,8 +642,7 @@ values. See Info node `(emacs) File Variables'." ;;;; Drawers -(defcustom org-odt-format-drawer-function - (lambda (name contents) contents) +(defcustom org-odt-format-drawer-function (lambda (_name contents) contents) "Function called to format a drawer in ODT code. The function must accept two parameters: @@ -693,7 +673,7 @@ TAGS the tags string, separated with colons (string or nil). The function result will be used as headline text." :group 'org-export-odt - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type 'function) @@ -714,7 +694,7 @@ The function must accept six parameters: The function should return the string to be exported." :group 'org-export-odt - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type 'function) @@ -773,7 +753,7 @@ A rule consists in an association whose key is the type of link to consider, and value is a regexp that will be matched against link's path." :group 'org-export-odt - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(alist :key-type (string :tag "Type") :value-type (regexp :tag "Path"))) @@ -992,11 +972,11 @@ See `org-odt--build-date-styles' for implementation details." (repeater-unit (org-element-property :repeater-unit timestamp))) (concat - (case repeater-type + (cl-case repeater-type (catchup "++") (restart ".+") (cumulate "+")) (when repeater-value (number-to-string repeater-value)) - (case repeater-unit + (cl-case repeater-unit (hour "h") (day "d") (week "w") (month "m") (year "y")))))) (concat @@ -1035,29 +1015,28 @@ See `org-odt--build-date-styles' for implementation details." (defun org-odt--zip-extract (archive members target) (when (atom members) (setq members (list members))) - (mapc (lambda (member) - (require 'arc-mode) - (let* ((--quote-file-name - ;; This is shamelessly stolen from `archive-zip-extract'. - (lambda (name) - (if (or (not (memq system-type '(windows-nt ms-dos))) - (and (boundp 'w32-quote-process-args) - (null w32-quote-process-args))) - (shell-quote-argument name) - name))) - (target (funcall --quote-file-name target)) - (archive (expand-file-name archive)) - (archive-zip-extract - (list "unzip" "-qq" "-o" "-d" target)) - exit-code command-output) - (setq command-output - (with-temp-buffer - (setq exit-code (archive-zip-extract archive member)) - (buffer-string))) - (unless (zerop exit-code) - (message command-output) - (error "Extraction failed")))) - members)) + (require 'arc-mode) + (dolist (member members) + (let* ((--quote-file-name + ;; This is shamelessly stolen from `archive-zip-extract'. + (lambda (name) + (if (or (not (memq system-type '(windows-nt ms-dos))) + (and (boundp 'w32-quote-process-args) + (null w32-quote-process-args))) + (shell-quote-argument name) + name))) + (target (funcall --quote-file-name target)) + (archive (expand-file-name archive)) + (archive-zip-extract + (list "unzip" "-qq" "-o" "-d" target)) + exit-code command-output) + (setq command-output + (with-temp-buffer + (setq exit-code (archive-zip-extract archive member)) + (buffer-string))) + (unless (zerop exit-code) + (message command-output) + (error "Extraction failed"))))) ;;;; Target @@ -1125,38 +1104,37 @@ specifying the depth of the table." </text:index-body> </text:table-of-content>")) -(defun* org-odt-format-toc-headline - (todo todo-type priority text tags - &key level section-number headline-label &allow-other-keys) - (setq text - (concat - ;; Section number. - (and section-number (concat section-number ". ")) - ;; Todo. - (when todo - (let ((style (if (member todo org-done-keywords) - "OrgDone" "OrgTodo"))) - (format "<text:span text:style-name=\"%s\">%s</text:span> " - style todo))) - (when priority - (let* ((style (format "OrgPriority-%s" priority)) - (priority (format "[#%c]" priority))) - (format "<text:span text:style-name=\"%s\">%s</text:span> " - style priority))) - ;; Title. - text - ;; Tags. - (when tags - (concat - (format " <text:span text:style-name=\"%s\">[%s]</text:span>" - "OrgTags" - (mapconcat - (lambda (tag) - (format - "<text:span text:style-name=\"%s\">%s</text:span>" - "OrgTag" tag)) tags " : ")))))) +(cl-defun org-odt-format-toc-headline + (todo _todo-type priority text tags + &key _level section-number headline-label &allow-other-keys) (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>" - headline-label text)) + headline-label + (concat + ;; Section number. + (and section-number (concat section-number ". ")) + ;; Todo. + (when todo + (let ((style (if (member todo org-done-keywords) + "OrgDone" "OrgTodo"))) + (format "<text:span text:style-name=\"%s\">%s</text:span> " + style todo))) + (when priority + (let* ((style (format "OrgPriority-%s" priority)) + (priority (format "[#%c]" priority))) + (format "<text:span text:style-name=\"%s\">%s</text:span> " + style priority))) + ;; Title. + text + ;; Tags. + (when tags + (concat + (format " <text:span text:style-name=\"%s\">[%s]</text:span>" + "OrgTags" + (mapconcat + (lambda (tag) + (format + "<text:span text:style-name=\"%s\">%s</text:span>" + "OrgTag" tag)) tags " : "))))))) (defun org-odt-toc (depth info &optional scope) "Build a table of contents. @@ -1164,7 +1142,7 @@ DEPTH is an integer specifying the depth of the table. INFO is a plist containing current export properties. Optional argument SCOPE, when non-nil, defines the scope of the table. Return the table of contents as a string, or nil." - (assert (wholenump depth)) + (cl-assert (wholenump depth)) ;; When a headline is marked as a radio target, as in the example below: ;; ;; ** <<<Some Heading>>> @@ -1211,7 +1189,7 @@ Use `org-odt-object-counters' to generate an automatic OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME . STYLE-NAME)." - (assert (stringp object-type)) + (cl-assert (stringp object-type)) (let* ((object (intern object-type)) (seqvar object) (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0))) @@ -1233,7 +1211,7 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME (let ((checkbox (org-element-property :checkbox item))) (if (not checkbox) "" (format "<text:span text:style-name=\"%s\">%s</text:span>" - "OrgCode" (case checkbox + "OrgCode" (cl-case checkbox (on "[✓] ") ; CHECK MARK (off "[ ] ") (trans "[-] ")))))) @@ -1277,31 +1255,30 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME (case-fold-search nil) (re (mapconcat 'identity (mapcar 'car fmt-alist) "\\|")) match rpl (start 0) (filler-beg 0) filler-end filler output) - (mapc - (lambda (pair) - (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t))) - '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns - ("%C" . "Y") ; replace century with year - ("%D" . "%m/%d/%y") - ("%G" . "Y") ; year corresponding to iso week - ("%I" . "%H") ; hour on a 12-hour clock - ("%R" . "%H:%M") - ("%T" . "%H:%M:%S") - ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon. - ("%Z" . "") ; time zone name - ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format - ("%g" . "%y") - ("%X" . "%x" ) ; locale's pref. time format - ("%j" . "") ; day of the year - ("%l" . "%k") ; like %I blank-padded - ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000 - ("%n" . "<text:line-break/>") - ("%r" . "%I:%M:%S %p") - ("%t" . "<text:tab/>") - ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6) - ("%x" . "%Y-%M-%d %a") ; locale's pref. time format - ("%z" . "") ; time zone in numeric form - )) + (dolist (pair + '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns + ("%C" . "Y") ; replace century with year + ("%D" . "%m/%d/%y") + ("%G" . "Y") ; year corresponding to iso week + ("%I" . "%H") ; hour on a 12-hour clock + ("%R" . "%H:%M") + ("%T" . "%H:%M:%S") + ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon. + ("%Z" . "") ; time zone name + ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format + ("%g" . "%y") + ("%X" . "%x" ) ; locale's pref. time format + ("%j" . "") ; day of the year + ("%l" . "%k") ; like %I blank-padded + ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000 + ("%n" . "<text:line-break/>") + ("%r" . "%I:%M:%S %p") + ("%t" . "<text:tab/>") + ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6) + ("%x" . "%Y-%M-%d %a") ; locale's pref. time format + ("%z" . "") ; time zone in numeric form + )) + (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t))) (while (string-match re fmt start) (setq match (match-string 0 fmt)) (setq rpl (assoc-default match fmt-alist)) @@ -1334,7 +1311,6 @@ original parsed data. INFO is a plist holding export options." (subtitle (org-export-data (plist-get info :subtitle) info)) (author (let ((author (plist-get info :author))) (if (not author) "" (org-export-data author info)))) - (email (plist-get info :email)) (keywords (or (plist-get info :keywords) "")) (description (or (plist-get info :description) ""))) (write-region @@ -1397,13 +1373,11 @@ original parsed data. INFO is a plist holding export options." (let ((archive (nth 0 styles-file)) (members (nth 1 styles-file))) (org-odt--zip-extract archive members org-odt-zip-dir) - (mapc - (lambda (member) - (when (org-file-image-p member) - (let* ((image-type (file-name-extension member)) - (media-type (format "image/%s" image-type))) - (org-odt-create-manifest-file-entry media-type member)))) - members))) + (dolist (member members) + (when (org-file-image-p member) + (let* ((image-type (file-name-extension member)) + (media-type (format "image/%s" image-type))) + (org-odt-create-manifest-file-entry media-type member)))))) ((and (stringp styles-file) (file-exists-p styles-file)) (let ((styles-file-type (file-name-extension styles-file))) (cond @@ -1446,7 +1420,7 @@ original parsed data. INFO is a plist holding export options." ;; currently the zip command zips up the entire temp directory so ;; that any auto-generated files created under the hood ends up in ;; the resulting odt file. - (set (make-local-variable 'backup-inhibited) t) + (setq-local backup-inhibited t) ;; Outline numbering is retained only upto LEVEL. ;; To disable outline numbering pass a LEVEL of 0. @@ -1483,16 +1457,16 @@ original parsed data. INFO is a plist holding export options." (re-search-forward " </office:automatic-styles>" nil t) (goto-char (match-beginning 0)) ;; - Dump automatic table styles. - (loop for (style-name props) in - (plist-get org-odt-automatic-styles 'Table) do - (when (setq props (or (plist-get props :rel-width) "96")) - (insert (format org-odt-table-style-format style-name props)))) + (cl-loop for (style-name props) in + (plist-get org-odt-automatic-styles 'Table) do + (when (setq props (or (plist-get props :rel-width) "96")) + (insert (format org-odt-table-style-format style-name props)))) ;; - Dump date-styles. (when (plist-get info :odt-use-date-fields) (insert (org-odt--build-date-styles (car custom-time-fmts) - "OrgDate1") + "OrgDate1") (org-odt--build-date-styles (cdr custom-time-fmts) - "OrgDate2"))) + "OrgDate2"))) ;; Update display level. ;; - Remove existing sequence decls. Also position the cursor. (goto-char (point-min)) @@ -1600,7 +1574,7 @@ original parsed data. INFO is a plist holding export options." ;;;; Bold -(defun org-odt-bold (bold contents info) +(defun org-odt-bold (_bold contents _info) "Transcode BOLD from Org to ODT. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." @@ -1610,7 +1584,7 @@ contextual information." ;;;; Center Block -(defun org-odt-center-block (center-block contents info) +(defun org-odt-center-block (_center-block contents _info) "Transcode a CENTER-BLOCK element from Org to ODT. CONTENTS holds the contents of the center block. INFO is a plist holding contextual information." @@ -1637,7 +1611,7 @@ channel." ;;;; Code -(defun org-odt-code (code contents info) +(defun org-odt-code (code _contents _info) "Transcode a CODE object from Org to ODT. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -1646,16 +1620,6 @@ channel." (org-element-property :value code)))) -;;;; Comment - -;; Comments are ignored. - - -;;;; Comment Block - -;; Comment Blocks are ignored. - - ;;;; Drawer (defun org-odt-drawer (drawer contents info) @@ -1670,7 +1634,7 @@ holding contextual information." ;;;; Dynamic Block -(defun org-odt-dynamic-block (dynamic-block contents info) +(defun org-odt-dynamic-block (_dynamic-block contents _info) "Transcode a DYNAMIC-BLOCK element from Org to ODT. CONTENTS holds the contents of the block. INFO is a plist holding contextual information. See `org-export-data'." @@ -1679,7 +1643,7 @@ holding contextual information. See `org-export-data'." ;;;; Entity -(defun org-odt-entity (entity contents info) +(defun org-odt-entity (entity _contents _info) "Transcode an ENTITY object from Org to ODT. CONTENTS are the definition itself. INFO is a plist holding contextual information." @@ -1688,7 +1652,7 @@ contextual information." ;;;; Example Block -(defun org-odt-example-block (example-block contents info) +(defun org-odt-example-block (example-block _contents info) "Transcode a EXAMPLE-BLOCK element from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." (org-odt-format-code example-block info)) @@ -1696,7 +1660,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Export Snippet -(defun org-odt-export-snippet (export-snippet contents info) +(defun org-odt-export-snippet (export-snippet _contents _info) "Transcode a EXPORT-SNIPPET object from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." (when (eq (org-export-snippet-backend export-snippet) 'odt) @@ -1705,7 +1669,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Export Block -(defun org-odt-export-block (export-block contents info) +(defun org-odt-export-block (export-block _contents _info) "Transcode a EXPORT-BLOCK element from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." (when (string= (org-element-property :type export-block) "ODT") @@ -1714,7 +1678,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Fixed Width -(defun org-odt-fixed-width (fixed-width contents info) +(defun org-odt-fixed-width (fixed-width _contents info) "Transcode a FIXED-WIDTH element from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." (org-odt-do-format-code (org-element-property :value fixed-width) info)) @@ -1727,34 +1691,31 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Footnote Reference -(defun org-odt-footnote-reference (footnote-reference contents info) +(defun org-odt-footnote-reference (footnote-reference _contents info) "Transcode a FOOTNOTE-REFERENCE element from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." (let ((--format-footnote-definition - (function - (lambda (n def) - (setq n (format "%d" n)) - (let ((id (concat "fn" n)) - (note-class "footnote") - (par-style "Footnote")) - (format - "<text:note text:id=\"%s\" text:note-class=\"%s\">%s</text:note>" - id note-class - (concat - (format "<text:note-citation>%s</text:note-citation>" n) - (format "<text:note-body>%s</text:note-body>" def))))))) + (lambda (n def) + (setq n (format "%d" n)) + (let ((id (concat "fn" n)) + (note-class "footnote")) + (format + "<text:note text:id=\"%s\" text:note-class=\"%s\">%s</text:note>" + id note-class + (concat + (format "<text:note-citation>%s</text:note-citation>" n) + (format "<text:note-body>%s</text:note-body>" def)))))) (--format-footnote-reference - (function - (lambda (n) - (setq n (format "%d" n)) - (let ((note-class "footnote") - (ref-format "text") - (ref-name (concat "fn" n))) - (format - "<text:span text:style-name=\"%s\">%s</text:span>" - "OrgSuperscript" - (format "<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:note-ref>" - note-class ref-format ref-name n))))))) + (lambda (n) + (setq n (format "%d" n)) + (let ((note-class "footnote") + (ref-format "text") + (ref-name (concat "fn" n))) + (format + "<text:span text:style-name=\"%s\">%s</text:span>" + "OrgSuperscript" + (format "<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:note-ref>" + note-class ref-format ref-name n)))))) (concat ;; Insert separator between two footnotes in a row. (let ((prev (org-export-get-previous-element footnote-reference info))) @@ -1786,8 +1747,8 @@ CONTENTS is nil. INFO is a plist holding contextual information." info)))) ;; Inline definitions are secondary strings. We ;; need to wrap them within a paragraph. - (if (memq (org-element-type (car (org-element-contents raw))) - org-element-all-elements) + (if (eq (org-element-class (car (org-element-contents raw))) + 'element) def (format "\n<text:p text:style-name=\"Footnote\">%s</text:p>" @@ -1822,15 +1783,16 @@ INFO is a plist holding contextual information." (headline-label (org-export-get-reference headline info)) (format-function (if (functionp format-function) format-function - (function* + (cl-function (lambda (todo todo-type priority text tags - &key level section-number headline-label - &allow-other-keys) + &key _level _section-number _headline-label + &allow-other-keys) (funcall (plist-get info :odt-format-headline-function) todo todo-type priority text tags)))))) (apply format-function todo todo-type priority text tags - :headline-label headline-label :level level + :headline-label headline-label + :level level :section-number section-number extra-keys))) (defun org-odt-headline (headline contents info) @@ -1839,9 +1801,7 @@ CONTENTS holds the contents of the headline. INFO is a plist holding contextual information." ;; Case 1: This is a footnote section: ignore it. (unless (org-element-property :footnote-section-p headline) - (let* ((text (org-export-data (org-element-property :title headline) info)) - ;; Create the headline text. - (full-text (org-odt-format-headline--wrap headline nil info)) + (let* ((full-text (org-odt-format-headline--wrap headline nil info)) ;; Get level relative to current parsed data. (level (org-export-get-relative-level headline info)) (numbered (org-export-numbered-headline-p headline info)) @@ -1928,7 +1888,7 @@ See `org-odt-format-headline-function' for details." ;;;; Horizontal Rule -(defun org-odt-horizontal-rule (horizontal-rule contents info) +(defun org-odt-horizontal-rule (_horizontal-rule _contents _info) "Transcode an HORIZONTAL-RULE object from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." (format "\n<text:p text:style-name=\"%s\">%s</text:p>" @@ -1946,18 +1906,15 @@ CONTENTS is nil. INFO is a plist holding contextual information." "Return a character not used in string S. This is used to choose a separator for constructs like \\verb." (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (loop for c across ll - when (not (string-match (regexp-quote (char-to-string c)) s)) - return (char-to-string c)))) + (cl-loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) -(defun org-odt-inline-src-block (inline-src-block contents info) +(defun org-odt-inline-src-block (_inline-src-block _contents _info) "Transcode an INLINE-SRC-BLOCK element from Org to ODT. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((org-lang (org-element-property :language inline-src-block)) - (code (org-element-property :value inline-src-block)) - (separator (org-odt--find-verb-separator code))) - (error "FIXME"))) + (error "FIXME")) ;;;; Inlinetask @@ -1996,7 +1953,7 @@ See `org-odt-format-inlinetask-function' for details." ;;;; Italic -(defun org-odt-italic (italic contents info) +(defun org-odt-italic (_italic contents _info) "Transcode ITALIC from Org to ODT. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." @@ -2011,30 +1968,18 @@ contextual information." CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((plain-list (org-export-get-parent item)) - (type (org-element-property :type plain-list)) - (counter (org-element-property :counter item)) - (tag (let ((tag (org-element-property :tag item))) - (and tag - (concat (org-odt--checkbox item) - (org-export-data tag info)))))) - (case type - ((ordered unordered descriptive-1 descriptive-2) - (format "\n<text:list-item>\n%s\n%s" - contents - (let* ((--element-has-a-table-p - (function - (lambda (element info) - (loop for el in (org-element-contents element) - thereis (eq (org-element-type el) 'table)))))) - (cond - ((funcall --element-has-a-table-p item info) - "</text:list-header>") - (t "</text:list-item>"))))) - (t (error "Unknown list type: %S" type))))) + (type (org-element-property :type plain-list))) + (unless (memq type '(ordered unordered descriptive-1 descriptive-2)) + (error "Unknown list type: %S" type)) + (format "\n<text:list-item>\n%s\n%s" + contents + (if (org-element-map item 'table #'identity info 'first-match) + "</text:list-header>" + "</text:list-item>")))) ;;;; Keyword -(defun org-odt-keyword (keyword contents info) +(defun org-odt-keyword (keyword _contents info) "Transcode a KEYWORD element from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." @@ -2048,13 +1993,13 @@ information." ((string= key "TOC") (let ((case-fold-search t)) (cond - ((org-string-match-p "\\<headlines\\>" value) + ((string-match-p "\\<headlines\\>" value) (let ((depth (or (and (string-match "\\<[0-9]+\\>" value) (string-to-number (match-string 0 value))) (plist-get info :headline-levels))) - (localp (org-string-match-p "\\<local\\>" value))) + (localp (string-match-p "\\<local\\>" value))) (org-odt-toc depth info (and localp keyword)))) - ((org-string-match-p "tables\\|figures\\|listings" value) + ((string-match-p "tables\\|figures\\|listings" value) ;; FIXME (ignore)))))))) @@ -2070,7 +2015,7 @@ information." ;; (unless (> (length ad-return-value) 0) ;; (setq ad-return-value (org-odt--encode-plain-text (ad-get-arg 0))))) -(defun org-odt-latex-environment (latex-environment contents info) +(defun org-odt-latex-environment (latex-environment _contents info) "Transcode a LATEX-ENVIRONMENT element from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." (let* ((latex-frag (org-remove-indentation @@ -2081,23 +2026,22 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Latex Fragment ;; (when latex-frag ; FIXME -;; (setq href (org-propertize href :title "LaTeX Fragment" +;; (setq href (propertize href :title "LaTeX Fragment" ;; :description latex-frag))) ;; handle verbatim ;; provide descriptions -(defun org-odt-latex-fragment (latex-fragment contents info) +(defun org-odt-latex-fragment (latex-fragment _contents _info) "Transcode a LATEX-FRAGMENT object from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." - (let* ((latex-frag (org-element-property :value latex-fragment)) - (processing-type (plist-get info :with-latex))) + (let ((latex-frag (org-element-property :value latex-fragment))) (format "<text:span text:style-name=\"%s\">%s</text:span>" "OrgCode" (org-odt--encode-plain-text latex-frag t)))) ;;;; Line Break -(defun org-odt-line-break (line-break contents info) +(defun org-odt-line-break (_line-break _contents _info) "Transcode a LINE-BREAK object from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." "<text:line-break/>") @@ -2108,27 +2052,25 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Links :: Label references (defun org-odt--enumerate (element info &optional predicate n) - (when predicate (assert (funcall predicate element info))) + (when predicate (cl-assert (funcall predicate element info))) (let* ((--numbered-parent-headline-at-<=-n - (function - (lambda (element n info) - (loop for x in (org-element-lineage element) - thereis (and (eq (org-element-type x) 'headline) - (<= (org-export-get-relative-level x info) n) - (org-export-numbered-headline-p x info) - x))))) + (lambda (element n info) + (cl-loop for x in (org-element-lineage element) + thereis (and (eq (org-element-type x) 'headline) + (<= (org-export-get-relative-level x info) n) + (org-export-numbered-headline-p x info) + x)))) (--enumerate - (function - (lambda (element scope info &optional predicate) - (let ((counter 0)) - (org-element-map (or scope (plist-get info :parse-tree)) - (org-element-type element) - (lambda (el) - (and (or (not predicate) (funcall predicate el info)) - (incf counter) - (eq element el) - counter)) - info 'first-match))))) + (lambda (element scope info &optional predicate) + (let ((counter 0)) + (org-element-map (or scope (plist-get info :parse-tree)) + (org-element-type element) + (lambda (el) + (and (or (not predicate) (funcall predicate el info)) + (cl-incf counter) + (eq element el) + counter)) + info 'first-match)))) (scope (funcall --numbered-parent-headline-at-<=-n element (or n (plist-get info :odt-display-outline-level)) @@ -2157,9 +2099,9 @@ the generated string. Return value is a string if OP is set to `reference' or a cons cell like CAPTION . SHORT-CAPTION) where CAPTION and SHORT-CAPTION are strings." - (assert (memq (org-element-type element) '(link table src-block paragraph))) + (cl-assert (memq (org-element-type element) '(link table src-block paragraph))) (let* ((element-or-parent - (case (org-element-type element) + (cl-case (org-element-type element) (link (org-export-get-parent-element element)) (t element))) ;; Get label and caption. @@ -2172,7 +2114,7 @@ SHORT-CAPTION are strings." (short-caption nil)) (when (or label caption) (let* ((default-category - (case (org-element-type element) + (cl-case (org-element-type element) (table "__Table__") (src-block "__Listing__") ((link paragraph) @@ -2188,14 +2130,15 @@ SHORT-CAPTION are strings." (t (error "Don't know how to format label for element type: %s" (org-element-type element))))) seqno) - (assert default-category) - (destructuring-bind (counter label-style category predicate) - (assoc-default default-category org-odt-category-map-alist) + (cl-assert default-category) + (pcase-let + ((`(,counter ,label-style ,category ,predicate) + (assoc-default default-category org-odt-category-map-alist))) ;; Compute sequence number of the element. (setq seqno (org-odt--enumerate element info predicate)) ;; Localize category string. (setq category (org-export-translate category :utf-8 info)) - (case op + (cl-case op ;; Case 1: Handle Label definition. (definition (cons @@ -2238,7 +2181,7 @@ SHORT-CAPTION are strings." (target-dir "Images/") (target-file (format "%s%04d.%s" target-dir - (incf org-odt-embedded-images-count) image-type))) + (cl-incf org-odt-embedded-images-count) image-type))) (message "Embedding %s as %s..." (substring-no-properties path) target-file) @@ -2317,7 +2260,7 @@ SHORT-CAPTION are strings." "Return ODT code for an inline image. LINK is the link pointing to the inline image. INFO is a plist used as a communication channel." - (assert (eq (org-element-type element) 'link)) + (cl-assert (eq (org-element-type element) 'link)) (let* ((src (let* ((type (org-element-property :type element)) (raw-path (org-element-property :path element))) (cond ((member type '("http" "https")) @@ -2332,7 +2275,7 @@ used as a communication channel." "\n<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" (org-odt--copy-image-file src-expanded))) ;; Extract attributes from #+ATTR_ODT line. - (attr-from (case (org-element-type element) + (attr-from (cl-case (org-element-type element) (link (org-export-get-parent-element element)) (t element))) ;; Convert attributes to a plist. @@ -2366,7 +2309,7 @@ used as a communication channel." (standalone-link-p (org-odt--standalone-link-p element info)) (embed-as (if standalone-link-p "paragraph" "as-char")) (captions (org-odt-format-label element info 'definition)) - (caption (car captions)) (short-caption (cdr captions)) + (caption (car captions)) (entity (concat (and caption "Captioned") embed-as "Image")) ;; Check if this link was created by LaTeX-to-PNG converter. (replaces (org-element-property @@ -2387,8 +2330,7 @@ used as a communication channel." ;;;; Links :: Math formula (defun org-odt-link--inline-formula (element info) - (let* ((src (let* ((type (org-element-property :type element)) - (raw-path (org-element-property :path element))) + (let* ((src (let ((raw-path (org-element-property :path element))) (cond ((file-name-absolute-p raw-path) (expand-file-name raw-path)) @@ -2404,7 +2346,6 @@ used as a communication channel." (standalone-link-p (org-odt--standalone-link-p element info)) (embed-as (if standalone-link-p 'paragraph 'character)) (captions (org-odt-format-label element info 'definition)) - (caption (car captions)) (short-caption (cdr captions)) ;; Check if this link was created by LaTeX-to-MathML ;; converter. (replaces (org-element-property @@ -2422,7 +2363,7 @@ used as a communication channel." (cond ((eq embed-as 'character) (org-odt--render-image/formula "InlineFormula" href width height - nil nil title desc)) + nil nil title desc)) (t (let* ((equation (org-odt--render-image/formula "CaptionedDisplayFormula" href width height @@ -2437,7 +2378,7 @@ used as a communication channel." (defun org-odt--copy-formula-file (src-file) "Returns the internal name of the file" (let* ((target-dir (format "Formula-%04d/" - (incf org-odt-embedded-formulas-count))) + (cl-incf org-odt-embedded-formulas-count))) (target-file (concat target-dir "content.xml"))) ;; Create a directory for holding formula file. Also enter it in ;; to manifest. @@ -2447,13 +2388,13 @@ used as a communication channel." ;; Copy over the formula file from user directory to zip ;; directory. (message "Embedding %s as %s..." src-file target-file) - (let ((case-fold-search nil)) + (let ((ext (file-name-extension src-file))) (cond ;; Case 1: Mathml. - ((string-match "\\.\\(mathml\\|mml\\)\\'" src-file) + ((member ext '("mathml" "mml")) (copy-file src-file (concat org-odt-zip-dir target-file) 'overwrite)) ;; Case 2: OpenDocument formula. - ((string-match "\\.odf\\'" src-file) + ((string= ext "odf") (org-odt--zip-extract src-file "content.xml" (concat org-odt-zip-dir target-dir))) (t (error "%s is not a formula file" src-file)))) @@ -2464,8 +2405,8 @@ used as a communication channel." ;;;; Targets (defun org-odt--render-image/formula (cfg-key href width height &optional - captions user-frame-params - &rest title-and-desc) + captions user-frame-params + &rest title-and-desc) (let* ((frame-cfg-alist ;; Each element of this alist is of the form (CFG-HANDLE ;; INNER-FRAME-PARAMS OUTER-FRAME-PARAMS). @@ -2527,11 +2468,11 @@ used as a communication channel." (lambda (default user) "Merge default and user frame params." (if (not user) default - (assert (= (length default) 3)) - (assert (= (length user) 3)) - (loop for u in user - for d in default - collect (or u d))))))) + (cl-assert (= (length default) 3)) + (cl-assert (= (length user) 3)) + (cl-loop for u in user + for d in default + collect (or u d))))))) (cond ;; Case 1: Image/Formula has no caption. ;; There is only one frame, one that surrounds the image @@ -2565,7 +2506,7 @@ used as a communication channel." caption)) width height outer))))) -(defun org-odt--enumerable-p (element info) +(defun org-odt--enumerable-p (element _info) ;; Element should have a caption or label. (or (org-element-property :caption element) (org-element-property :name element))) @@ -2582,7 +2523,7 @@ used as a communication channel." (org-element-property :name p)))) ;; Link should point to an image file. (lambda (l) - (assert (eq (org-element-type l) 'link)) + (cl-assert (eq (org-element-type l) 'link)) (org-export-inline-image-p l (plist-get info :odt-inline-image-rules))))) (defun org-odt--enumerable-latex-image-p (element info) @@ -2597,7 +2538,7 @@ used as a communication channel." (org-element-property :name p)))) ;; Link should point to an image file. (lambda (l) - (assert (eq (org-element-type l) 'link)) + (cl-assert (eq (org-element-type l) 'link)) (org-export-inline-image-p l (plist-get info :odt-inline-image-rules))))) (defun org-odt--enumerable-formula-p (element info) @@ -2609,12 +2550,12 @@ used as a communication channel." (org-element-property :name p))) ;; Link should point to a MathML or ODF file. (lambda (l) - (assert (eq (org-element-type l) 'link)) + (cl-assert (eq (org-element-type l) 'link)) (org-export-inline-image-p l (plist-get info :odt-inline-formula-rules))))) -(defun org-odt--standalone-link-p (element info &optional - paragraph-predicate - link-predicate) +(defun org-odt--standalone-link-p (element _info &optional + paragraph-predicate + link-predicate) "Test if ELEMENT is a standalone link for the purpose ODT export. INFO is a plist holding contextual information. @@ -2628,7 +2569,7 @@ PARAGRAPH-PREDICATE in addition to having no other content save for leading and trailing whitespaces. Return nil, otherwise." - (let ((p (case (org-element-type element) + (let ((p (cl-case (org-element-type element) (paragraph element) (link (and (or (not link-predicate) (funcall link-predicate element)) @@ -2638,16 +2579,16 @@ Return nil, otherwise." (when (or (not paragraph-predicate) (funcall paragraph-predicate p)) (let ((contents (org-element-contents p))) - (loop for x in contents - with inline-image-count = 0 - always (case (org-element-type x) - (plain-text - (not (org-string-nw-p x))) - (link - (and (or (not link-predicate) - (funcall link-predicate x)) - (= (incf inline-image-count) 1))) - (t nil)))))))) + (cl-loop for x in contents + with inline-image-count = 0 + always (cl-case (org-element-type x) + (plain-text + (not (org-string-nw-p x))) + (link + (and (or (not link-predicate) + (funcall link-predicate x)) + (= (cl-incf inline-image-count) 1))) + (t nil)))))))) (defun org-odt-link--infer-description (destination info) ;; DESTINATION is a headline or an element (like paragraph, @@ -2672,31 +2613,31 @@ Return nil, otherwise." (or (let* ( ;; Locate top-level list. (top-level-list - (loop for x on data - when (eq (org-element-type (car x)) 'plain-list) - return x)) + (cl-loop for x on data + when (eq (org-element-type (car x)) 'plain-list) + return x)) ;; Get list item nos. (item-numbers - (loop for (plain-list item . rest) on top-level-list by #'cddr - until (not (eq (org-element-type plain-list) 'plain-list)) - collect (when (eq (org-element-property :type - plain-list) - 'ordered) - (1+ (length (org-export-get-previous-element - item info t)))))) + (cl-loop for (plain-list item . rest) on top-level-list by #'cddr + until (not (eq (org-element-type plain-list) 'plain-list)) + collect (when (eq (org-element-property :type + plain-list) + 'ordered) + (1+ (length (org-export-get-previous-element + item info t)))))) ;; Locate top-most listified headline. (listified-headlines - (loop for x on data - when (and (eq (org-element-type (car x)) 'headline) - (org-export-low-level-p (car x) info)) - return x)) + (cl-loop for x on data + when (and (eq (org-element-type (car x)) 'headline) + (org-export-low-level-p (car x) info)) + return x)) ;; Get listified headline numbers. (listified-headline-nos - (loop for el in listified-headlines - when (eq (org-element-type el) 'headline) - collect (when (org-export-numbered-headline-p el info) - (1+ (length (org-export-get-previous-element - el info t))))))) + (cl-loop for el in listified-headlines + when (eq (org-element-type el) 'headline) + collect (when (org-export-numbered-headline-p el info) + (1+ (length (org-export-get-previous-element + el info t))))))) ;; Combine item numbers from both the listified headlines and ;; regular list items. @@ -2715,11 +2656,11 @@ Return nil, otherwise." (and ;; Test if destination is a numbered headline. (org-export-numbered-headline-p destination info) - (loop for el in (cons destination genealogy) - when (and (eq (org-element-type el) 'headline) - (not (org-export-low-level-p el info)) - (org-export-numbered-headline-p el info)) - return el)))) + (cl-loop for el in (cons destination genealogy) + when (and (eq (org-element-type el) 'headline) + (not (org-export-low-level-p el info)) + (org-export-numbered-headline-p el info)) + return el)))) ;; We found one. (when headline (format "<text:bookmark-ref text:reference-format=\"chapter\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>" @@ -2728,10 +2669,10 @@ Return nil, otherwise." headline info) ".")))) ;; Case 4: Locate a regular headline in the hierarchy. Display ;; its title. - (let ((headline (loop for el in (cons destination genealogy) - when (and (eq (org-element-type el) 'headline) - (not (org-export-low-level-p el info))) - return el))) + (let ((headline (cl-loop for el in (cons destination genealogy) + when (and (eq (org-element-type el) 'headline) + (not (org-export-low-level-p el info))) + return el))) ;; We found one. (when headline (format "<text:bookmark-ref text:reference-format=\"text\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>" @@ -2763,12 +2704,11 @@ INFO is a plist holding contextual information. See ;; Link type is handled by a special function. ((org-export-custom-protocol-maybe link desc 'odt)) ;; Image file. - ((and (not desc) (org-export-inline-image-p - link (plist-get info :odt-inline-image-rules))) - (org-odt-link--inline-image link info)) + ((and (not desc) imagep) (org-odt-link--inline-image link info)) ;; Formula file. - ((and (not desc) (org-export-inline-image-p - link (plist-get info :odt-inline-formula-rules))) + ((and (not desc) + (org-export-inline-image-p + link (plist-get info :odt-inline-formula-rules))) (org-odt-link--inline-formula link info)) ;; Radio target: Transcode target's contents and use them as ;; link's description. @@ -2785,7 +2725,7 @@ INFO is a plist holding contextual information. See (let ((destination (if (string= type "fuzzy") (org-export-resolve-fuzzy-link link info) (org-export-resolve-id-link link info)))) - (case (org-element-type destination) + (cl-case (org-element-type destination) ;; Fuzzy link points to a headline. If there's ;; a description, create a hyperlink. Otherwise, try to ;; provide a meaningful description. @@ -2862,7 +2802,7 @@ INFO is a plist holding contextual information. See ;;;; Node Property -(defun org-odt-node-property (node-property contents info) +(defun org-odt-node-property (node-property _contents _info) "Transcode a NODE-PROPERTY element from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." @@ -2881,7 +2821,7 @@ Style is a symbol among `quoted', `centered' and nil." (while (and (setq up (org-element-property :parent up)) (not (memq (org-element-type up) '(center-block quote-block section))))) - (case (org-element-type up) + (cl-case (org-element-type up) (center-block 'centered) (quote-block 'quoted)))) @@ -2893,7 +2833,7 @@ a plist used as a communication channel. DEFAULT, CENTER and QUOTE are, respectively, style to use when paragraph belongs to no special environment, a center block, or a quote block." (format "\n<text:p text:style-name=\"%s\">%s</text:p>" - (case (org-odt--paragraph-style paragraph) + (cl-case (org-odt--paragraph-style paragraph) (quoted quote) (centered center) (otherwise default)) @@ -2919,13 +2859,13 @@ the plist used as a communication channel." ;;;; Plain List -(defun org-odt-plain-list (plain-list contents info) +(defun org-odt-plain-list (plain-list contents _info) "Transcode a PLAIN-LIST element from Org to ODT. CONTENTS is the contents of the list. INFO is a plist holding contextual information." (format "\n<text:list text:style-name=\"%s\" %s>\n%s</text:list>" ;; Choose style based on list type. - (case (org-element-property :type plain-list) + (cl-case (org-element-property :type plain-list) (ordered "OrgNumberedList") (unordered "OrgBulletedList") (descriptive-1 "OrgDescriptionList") @@ -2954,10 +2894,8 @@ contextual information." line)) (defun org-odt--encode-plain-text (text &optional no-whitespace-filling) - (mapc - (lambda (pair) - (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) - '(("&" . "&") ("<" . "<") (">" . ">"))) + (dolist (pair '(("&" . "&") ("<" . "<") (">" . ">"))) + (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) (if no-whitespace-filling text (org-odt--encode-tabs-and-spaces text))) @@ -2974,11 +2912,9 @@ contextual information." (setq output (org-export-activate-smart-quotes output :utf-8 info text))) ;; Convert special strings. (when (plist-get info :with-special-strings) - (mapc - (lambda (pair) - (setq output - (replace-regexp-in-string (car pair) (cdr pair) output t nil))) - org-odt-special-string-regexps)) + (dolist (pair org-odt-special-string-regexps) + (setq output + (replace-regexp-in-string (car pair) (cdr pair) output t nil)))) ;; Handle break preservation if required. (when (plist-get info :preserve-breaks) (setq output (replace-regexp-in-string @@ -3018,7 +2954,7 @@ channel." ;;;; Property Drawer -(defun org-odt-property-drawer (property-drawer contents info) +(defun org-odt-property-drawer (_property-drawer contents _info) "Transcode a PROPERTY-DRAWER element from Org to ODT. CONTENTS holds the contents of the drawer. INFO is a plist holding contextual information." @@ -3029,7 +2965,7 @@ holding contextual information." ;;;; Quote Block -(defun org-odt-quote-block (quote-block contents info) +(defun org-odt-quote-block (_quote-block contents _info) "Transcode a QUOTE-BLOCK element from Org to ODT. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -3046,7 +2982,7 @@ holding contextual information." text))) -(defun org-odt-section (section contents info) ; FIXME +(defun org-odt-section (_section contents _info) ; FIXME "Transcode a SECTION element from Org to ODT. CONTENTS holds the contents of the section. INFO is a plist holding contextual information." @@ -3137,25 +3073,24 @@ and prefix with \"OrgSrc\". For example, (cons style-name style))) (defun org-odt-htmlfontify-string (line) - (let* ((hfy-html-quote-regex "\\([<\"&> ]\\)") + (let* ((hfy-html-quote-regex "\\([<\"&> \t]\\)") (hfy-html-quote-map '(("\"" """) ("<" "<") ("&" "&") (">" ">") (" " "<text:s/>") - (" " "<text:tab/>"))) + ("\t" "<text:tab/>"))) (hfy-face-to-css 'org-odt-hfy-face-to-css) (hfy-optimizations-1 (copy-sequence hfy-optimizations)) - (hfy-optimizations (add-to-list 'hfy-optimizations-1 - 'body-text-only)) + (hfy-optimizations (cl-pushnew 'body-text-only hfy-optimizations-1)) (hfy-begin-span-handler - (lambda (style text-block text-id text-begins-block-p) + (lambda (style _text-block _text-id _text-begins-block-p) (insert (format "<text:span text:style-name=\"%s\">" style)))) - (hfy-end-span-handler (lambda nil (insert "</text:span>")))) - (org-no-warnings (htmlfontify-string line)))) + (hfy-end-span-handler (lambda () (insert "</text:span>")))) + (with-no-warnings (htmlfontify-string line)))) (defun org-odt-do-format-code - (code info &optional lang refs retain-labels num-start) + (code info &optional lang refs retain-labels num-start) (let* ((lang (or (assoc-default lang org-src-lang-modes) lang)) (lang-mode (and lang (intern (format "%s-mode" lang)))) (code-lines (org-split-string code "\n")) @@ -3175,19 +3110,20 @@ and prefix with \"OrgSrc\". For example, (par-style (if use-htmlfontify-p "OrgSrcBlock" "OrgFixedWidthBlock")) (i 0)) - (assert (= code-length (length (org-split-string code "\n")))) + (cl-assert (= code-length (length (org-split-string code "\n")))) (setq code (org-export-format-code code (lambda (loc line-num ref) (setq par-style - (concat par-style (and (= (incf i) code-length) "LastLine"))) + (concat par-style (and (= (cl-incf i) code-length) + "LastLine"))) (setq loc (concat loc (and ref retain-labels (format " (%s)" ref)))) (setq loc (funcall fontifier loc)) (when ref (setq loc (org-odt--target loc (concat "coderef-" ref)))) - (assert par-style) + (cl-assert par-style) (setq loc (format "\n<text:p text:style-name=\"%s\">%s</text:p>" par-style loc)) (if (not line-num) loc @@ -3213,19 +3149,15 @@ and prefix with \"OrgSrc\". For example, ;; Does the src block contain labels? (retain-labels (org-element-property :retain-labels element)) ;; Does it have line numbers? - (num-start (case (org-element-property :number-lines element) - (continued (org-export-get-loc element info)) - (new 0)))) + (num-start (org-export-get-loc element info))) (org-odt-do-format-code code info lang refs retain-labels num-start))) -(defun org-odt-src-block (src-block contents info) +(defun org-odt-src-block (src-block _contents info) "Transcode a SRC-BLOCK element from Org to ODT. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((lang (org-element-property :language src-block)) - (attributes (org-export-read-attribute :attr_odt src-block)) - (captions (org-odt-format-label src-block info 'definition)) - (caption (car captions)) (short-caption (cdr captions))) + (let* ((attributes (org-export-read-attribute :attr_odt src-block)) + (caption (car (org-odt-format-label src-block info 'definition)))) (concat (and caption (format "\n<text:p text:style-name=\"%s\">%s</text:p>" @@ -3239,7 +3171,7 @@ contextual information." ;;;; Statistics Cookie -(defun org-odt-statistics-cookie (statistics-cookie contents info) +(defun org-odt-statistics-cookie (statistics-cookie _contents _info) "Transcode a STATISTICS-COOKIE object from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." (let ((cookie-value (org-element-property :value statistics-cookie))) @@ -3249,7 +3181,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Strike-Through -(defun org-odt-strike-through (strike-through contents info) +(defun org-odt-strike-through (_strike-through contents _info) "Transcode STRIKE-THROUGH from Org to ODT. CONTENTS is the text with strike-through markup. INFO is a plist holding contextual information." @@ -3259,7 +3191,7 @@ holding contextual information." ;;;; Subscript -(defun org-odt-subscript (subscript contents info) +(defun org-odt-subscript (_subscript contents _info) "Transcode a SUBSCRIPT object from Org to ODT. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -3269,7 +3201,7 @@ contextual information." ;;;; Superscript -(defun org-odt-superscript (superscript contents info) +(defun org-odt-superscript (_superscript contents _info) "Transcode a SUPERSCRIPT object from Org to ODT. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -3324,23 +3256,23 @@ styles congruent with the ODF-1.2 specification." (cell-style-selectors (nth 2 style-spec)) (cell-type (cond - ((and (cdr (assoc 'use-first-column-styles cell-style-selectors)) + ((and (cdr (assq 'use-first-column-styles cell-style-selectors)) (= c 0)) "FirstColumn") - ((and (cdr (assoc 'use-last-column-styles cell-style-selectors)) + ((and (cdr (assq 'use-last-column-styles cell-style-selectors)) (= (1+ c) (cdr table-dimensions))) "LastColumn") - ((and (cdr (assoc 'use-first-row-styles cell-style-selectors)) + ((and (cdr (assq 'use-first-row-styles cell-style-selectors)) (= r 0)) "FirstRow") - ((and (cdr (assoc 'use-last-row-styles cell-style-selectors)) + ((and (cdr (assq 'use-last-row-styles cell-style-selectors)) (= (1+ r) (car table-dimensions))) "LastRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) + ((and (cdr (assq 'use-banding-rows-styles cell-style-selectors)) (= (% r 2) 1)) "EvenRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) + ((and (cdr (assq 'use-banding-rows-styles cell-style-selectors)) (= (% r 2) 0)) "OddRow") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) + ((and (cdr (assq 'use-banding-columns-styles cell-style-selectors)) (= (% c 2) 1)) "EvenColumn") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) + ((and (cdr (assq 'use-banding-columns-styles cell-style-selectors)) (= (% c 2) 0)) "OddColumn") (t "")))) (concat template-name cell-type))))) @@ -3398,17 +3330,16 @@ channel." (1+ horiz-span)))))) (unless contents (setq contents "")) (concat - (assert paragraph-style) + (cl-assert paragraph-style) (format "\n<table:table-cell%s>\n%s\n</table:table-cell>" cell-attributes (let ((table-cell-contents (org-element-contents table-cell))) - (if (memq (org-element-type (car table-cell-contents)) - org-element-all-elements) + (if (eq (org-element-class (car table-cell-contents)) 'element) contents (format "\n<text:p text:style-name=\"%s\">%s</text:p>" paragraph-style contents)))) (let (s) - (dotimes (i horiz-span s) + (dotimes (_ horiz-span s) (setq s (concat s "\n<table:covered-table-cell/>")))) "\n"))) @@ -3459,7 +3390,7 @@ communication channel." "Transcode a TABLE element from Org to ODT. CONTENTS is the contents of the table. INFO is a plist holding contextual information." - (case (org-element-property :type table) + (cl-case (org-element-property :type table) ;; Case 1: table.el doesn't support export to OD format. Strip ;; such tables from export. (table.el @@ -3476,20 +3407,19 @@ contextual information." (attributes (org-export-read-attribute :attr_odt table)) (custom-table-style (nth 1 (org-odt-table-style-spec table info))) (table-column-specs - (function - (lambda (table info) - (let* ((table-style (or custom-table-style "OrgTable")) - (column-style (format "%sColumn" table-style))) - (mapconcat - (lambda (table-cell) - (let ((width (1+ (or (org-export-table-cell-width - table-cell info) 0))) - (s (format - "\n<table:table-column table:style-name=\"%s\"/>" - column-style)) - out) - (dotimes (i width out) (setq out (concat s out))))) - (org-odt-table-first-row-data-cells table info) "\n")))))) + (lambda (table info) + (let* ((table-style (or custom-table-style "OrgTable")) + (column-style (format "%sColumn" table-style))) + (mapconcat + (lambda (table-cell) + (let ((width (1+ (or (org-export-table-cell-width + table-cell info) 0))) + (s (format + "\n<table:table-column table:style-name=\"%s\"/>" + column-style)) + out) + (dotimes (_ width out) (setq out (concat s out))))) + (org-odt-table-first-row-data-cells table info) "\n"))))) (concat ;; caption. (when caption @@ -3518,84 +3448,84 @@ contextual information. Use `org-odt--table' to typeset the table. Handle details pertaining to indentation here." (let* ((--element-preceded-by-table-p - (function - (lambda (element info) - (loop for el in (org-export-get-previous-element element info t) - thereis (eq (org-element-type el) 'table))))) + (lambda (element info) + (cl-loop for el in (org-export-get-previous-element element info t) + thereis (eq (org-element-type el) 'table)))) (--walk-list-genealogy-and-collect-tags - (function - (lambda (table info) - (let* ((genealogy (org-element-lineage table)) - (list-genealogy - (when (eq (org-element-type (car genealogy)) 'item) - (loop for el in genealogy - when (memq (org-element-type el) - '(item plain-list)) - collect el))) - (llh-genealogy - (apply 'nconc - (loop for el in genealogy - when (and (eq (org-element-type el) 'headline) - (org-export-low-level-p el info)) - collect - (list el - (assq 'headline - (org-element-contents - (org-export-get-parent el))))))) - parent-list) - (nconc - ;; Handle list genealogy. - (loop for el in list-genealogy collect - (case (org-element-type el) - (plain-list - (setq parent-list el) - (cons "</text:list>" - (format "\n<text:list text:style-name=\"%s\" %s>" - (case (org-element-property :type el) - (ordered "OrgNumberedList") - (unordered "OrgBulletedList") - (descriptive-1 "OrgDescriptionList") - (descriptive-2 "OrgDescriptionList")) - "text:continue-numbering=\"true\""))) - (item - (cond - ((not parent-list) - (if (funcall --element-preceded-by-table-p table info) - '("</text:list-header>" . "<text:list-header>") - '("</text:list-item>" . "<text:list-header>"))) - ((funcall --element-preceded-by-table-p - parent-list info) - '("</text:list-header>" . "<text:list-header>")) - (t '("</text:list-item>" . "<text:list-item>")))))) - ;; Handle low-level headlines. - (loop for el in llh-genealogy - with step = 'item collect - (case step - (plain-list - (setq step 'item) ; Flip-flop - (setq parent-list el) - (cons "</text:list>" - (format "\n<text:list text:style-name=\"%s\" %s>" - (if (org-export-numbered-headline-p - el info) - "OrgNumberedList" - "OrgBulletedList") - "text:continue-numbering=\"true\""))) - (item - (setq step 'plain-list) ; Flip-flop - (cond - ((not parent-list) - (if (funcall --element-preceded-by-table-p table info) - '("</text:list-header>" . "<text:list-header>") - '("</text:list-item>" . "<text:list-header>"))) - ((let ((section? (org-export-get-previous-element - parent-list info))) - (and section? - (eq (org-element-type section?) 'section) - (assq 'table (org-element-contents section?)))) - '("</text:list-header>" . "<text:list-header>")) - (t - '("</text:list-item>" . "<text:list-item>"))))))))))) + (lambda (table info) + (let* ((genealogy (org-element-lineage table)) + (list-genealogy + (when (eq (org-element-type (car genealogy)) 'item) + (cl-loop for el in genealogy + when (memq (org-element-type el) + '(item plain-list)) + collect el))) + (llh-genealogy + (apply #'nconc + (cl-loop + for el in genealogy + when (and (eq (org-element-type el) 'headline) + (org-export-low-level-p el info)) + collect + (list el + (assq 'headline + (org-element-contents + (org-export-get-parent el))))))) + parent-list) + (nconc + ;; Handle list genealogy. + (cl-loop + for el in list-genealogy collect + (cl-case (org-element-type el) + (plain-list + (setq parent-list el) + (cons "</text:list>" + (format "\n<text:list text:style-name=\"%s\" %s>" + (cl-case (org-element-property :type el) + (ordered "OrgNumberedList") + (unordered "OrgBulletedList") + (descriptive-1 "OrgDescriptionList") + (descriptive-2 "OrgDescriptionList")) + "text:continue-numbering=\"true\""))) + (item + (cond + ((not parent-list) + (if (funcall --element-preceded-by-table-p table info) + '("</text:list-header>" . "<text:list-header>") + '("</text:list-item>" . "<text:list-header>"))) + ((funcall --element-preceded-by-table-p + parent-list info) + '("</text:list-header>" . "<text:list-header>")) + (t '("</text:list-item>" . "<text:list-item>")))))) + ;; Handle low-level headlines. + (cl-loop for el in llh-genealogy + with step = 'item collect + (cl-case step + (plain-list + (setq step 'item) ; Flip-flop + (setq parent-list el) + (cons "</text:list>" + (format "\n<text:list text:style-name=\"%s\" %s>" + (if (org-export-numbered-headline-p + el info) + "OrgNumberedList" + "OrgBulletedList") + "text:continue-numbering=\"true\""))) + (item + (setq step 'plain-list) ; Flip-flop + (cond + ((not parent-list) + (if (funcall --element-preceded-by-table-p table info) + '("</text:list-header>" . "<text:list-header>") + '("</text:list-item>" . "<text:list-header>"))) + ((let ((section? (org-export-get-previous-element + parent-list info))) + (and section? + (eq (org-element-type section?) 'section) + (assq 'table (org-element-contents section?)))) + '("</text:list-header>" . "<text:list-header>")) + (t + '("</text:list-item>" . "<text:list-item>")))))))))) (close-open-tags (funcall --walk-list-genealogy-and-collect-tags table info))) ;; OpenDocument schema does not permit table to occur within a @@ -3641,7 +3571,7 @@ pertaining to indentation here." ;; ;; - Description lists are simulated as plain lists. ;; - Low-level headlines can be listified. - ;; - In Org-mode, a table can occur not only as a regular list + ;; - In Org mode, a table can occur not only as a regular list ;; item, but also within description lists and low-level ;; headlines. @@ -3663,7 +3593,7 @@ pertaining to indentation here." ;;;; Target -(defun org-odt-target (target contents info) +(defun org-odt-target (target _contents info) "Transcode a TARGET object from Org to ODT. CONTENTS is nil. INFO is a plist holding contextual information." @@ -3672,16 +3602,15 @@ information." ;;;; Timestamp -(defun org-odt-timestamp (timestamp contents info) +(defun org-odt-timestamp (timestamp _contents info) "Transcode a TIMESTAMP object from Org to ODT. CONTENTS is nil. INFO is a plist used as a communication channel." - (let* ((raw-value (org-element-property :raw-value timestamp)) - (type (org-element-property :type timestamp))) + (let ((type (org-element-property :type timestamp))) (if (not (plist-get info :odt-use-date-fields)) (let ((value (org-odt-plain-text (org-timestamp-translate timestamp) info))) - (case (org-element-property :type timestamp) + (cl-case (org-element-property :type timestamp) ((active active-range) (format "<text:span text:style-name=\"%s\">%s</text:span>" "OrgActiveTimestamp" value)) @@ -3689,7 +3618,7 @@ channel." (format "<text:span text:style-name=\"%s\">%s</text:span>" "OrgInactiveTimestamp" value)) (otherwise value))) - (case type + (cl-case type (active (format "<text:span text:style-name=\"%s\">%s</text:span>" "OrgActiveTimestamp" @@ -3719,7 +3648,7 @@ channel." ;;;; Underline -(defun org-odt-underline (underline contents info) +(defun org-odt-underline (_underline contents _info) "Transcode UNDERLINE from Org to ODT. CONTENTS is the text with underline markup. INFO is a plist holding contextual information." @@ -3729,7 +3658,7 @@ holding contextual information." ;;;; Verbatim -(defun org-odt-verbatim (verbatim contents info) +(defun org-odt-verbatim (verbatim _contents _info) "Transcode a VERBATIM object from Org to ODT. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -3740,7 +3669,7 @@ channel." ;;;; Verse Block -(defun org-odt-verse-block (verse-block contents info) +(defun org-odt-verse-block (_verse-block contents _info) "Transcode a VERSE-BLOCK element from Org to ODT. CONTENTS is verse block contents. INFO is a plist holding contextual information." @@ -3760,13 +3689,13 @@ contextual information." ;;;; LaTeX fragments -(defun org-odt--translate-latex-fragments (tree backend info) +(defun org-odt--translate-latex-fragments (tree _backend info) (let ((processing-type (plist-get info :with-latex)) (count 0)) ;; Normalize processing-type to one of dvipng, mathml or verbatim. ;; If the desired converter is not available, force verbatim ;; processing. - (case processing-type + (cl-case processing-type ((t mathml) (if (and (fboundp 'org-format-latex-mathml-available-p) (org-format-latex-mathml-available-p)) @@ -3792,18 +3721,18 @@ contextual information." (when (memq processing-type '(mathml dvipng imagemagick)) (org-element-map tree '(latex-fragment latex-environment) (lambda (latex-*) - (incf count) + (cl-incf count) (let* ((latex-frag (org-element-property :value latex-*)) (input-file (plist-get info :input-file)) (cache-dir (file-name-directory input-file)) (cache-subdir (concat - (case processing-type + (cl-case processing-type ((dvipng imagemagick) "ltxpng/") (mathml "ltxmathml/")) (file-name-sans-extension (file-name-nondirectory input-file)))) (display-msg - (case processing-type + (cl-case processing-type ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count)) (mathml (format "Creating MathML snippet %d..." count)))) @@ -3817,7 +3746,7 @@ contextual information." nil processing-type) (buffer-substring-no-properties (point-min) (point-max))))) - (if (org-string-match-p "file:\\([^]]*\\)" link) link + (if (string-match-p "file:\\([^]]*\\)" link) link (message "LaTeX Conversion failed.") nil)))) (when org-link @@ -3828,7 +3757,7 @@ contextual information." (org-element-parse-secondary-string org-link '(link)) 'link #'identity info t)) (replacement - (case (org-element-type latex-*) + (cl-case (org-element-type latex-*) ;; Case 1: LaTeX environment. Mimic ;; a "standalone image or formula" by ;; enclosing the `link' in a `paragraph'. @@ -3864,7 +3793,7 @@ contextual information." ;; This translator is necessary to handle indented tables in a uniform ;; manner. See comment in `org-odt--table'. -(defun org-odt--translate-description-lists (tree backend info) +(defun org-odt--translate-description-lists (tree _backend info) ;; OpenDocument has no notion of a description list. So simulate it ;; using plain lists. Description lists in the exported document ;; are typeset in the same manner as they are in a typical HTML @@ -3897,7 +3826,7 @@ contextual information." ;; (org-element-map tree 'plain-list (lambda (el) - (when (equal (org-element-property :type el) 'descriptive) + (when (eq (org-element-property :type el) 'descriptive) (org-element-set-element el (apply 'org-element-adopt-elements @@ -3960,7 +3889,7 @@ contextual information." ;; Translate lists to tables -(defun org-odt--translate-list-tables (tree backend info) +(defun org-odt--translate-list-tables (tree _backend info) (org-element-map tree 'plain-list (lambda (l1-list) (when (org-export-read-attribute :attr_odt l1-list :list-table) @@ -4021,42 +3950,38 @@ contextual information." (insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?> <manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\n") - (mapc - (lambda (file-entry) - (let* ((version (nth 2 file-entry)) - (extra (if (not version) "" - (format " manifest:version=\"%s\"" version)))) - (insert - (format org-odt-manifest-file-entry-tag - (nth 0 file-entry) (nth 1 file-entry) extra)))) - org-odt-manifest-file-entries) + (dolist (file-entry org-odt-manifest-file-entries) + (let* ((version (nth 2 file-entry)) + (extra (if (not version) "" + (format " manifest:version=\"%s\"" version)))) + (insert + (format org-odt-manifest-file-entry-tag + (nth 0 file-entry) (nth 1 file-entry) extra)))) (insert "\n</manifest:manifest>")))) (defmacro org-odt--export-wrap (out-file &rest body) `(let* ((--out-file ,out-file) (out-file-type (file-name-extension --out-file)) (org-odt-xml-files '("META-INF/manifest.xml" "content.xml" - "meta.xml" "styles.xml")) + "meta.xml" "styles.xml")) ;; Initialize temporary workarea. All files that end up in ;; the exported document get parked/created here. (org-odt-zip-dir (file-name-as-directory - (make-temp-file (format "%s-" out-file-type) t))) + (make-temp-file (format "%s-" out-file-type) t))) (org-odt-manifest-file-entries nil) (--cleanup-xml-buffers - (function - (lambda nil - ;; Kill all XML buffers. - (mapc (lambda (file) - (let ((buf (find-buffer-visiting - (concat org-odt-zip-dir file)))) - (when buf - (with-current-buffer buf - (set-buffer-modified-p nil) - (kill-buffer buf))))) - org-odt-xml-files) - ;; Delete temporary directory and also other embedded - ;; files that get copied there. - (delete-directory org-odt-zip-dir t))))) + (lambda () + ;; Kill all XML buffers. + (dolist (file org-odt-xml-files) + (let ((buf (find-buffer-visiting + (concat org-odt-zip-dir file)))) + (when buf + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))))) + ;; Delete temporary directory and also other embedded + ;; files that get copied there. + (delete-directory org-odt-zip-dir t)))) (condition-case err (progn (unless (executable-find "zip") @@ -4079,16 +4004,15 @@ contextual information." ;; Write out the manifest entries before zipping (org-odt-write-manifest-file) ;; Save all XML files. - (mapc (lambda (file) - (let ((buf (find-buffer-visiting - (concat org-odt-zip-dir file)))) - (when buf - (with-current-buffer buf - ;; Prettify output if needed. - (when org-odt-prettify-xml - (indent-region (point-min) (point-max))) - (save-buffer 0))))) - org-odt-xml-files) + (dolist (file org-odt-xml-files) + (let ((buf (find-buffer-visiting + (concat org-odt-zip-dir file)))) + (when buf + (with-current-buffer buf + ;; Prettify output if needed. + (when org-odt-prettify-xml + (indent-region (point-min) (point-max))) + (save-buffer 0))))) ;; Run zip. (let* ((target --out-file) (target-name (file-name-nondirectory target)) @@ -4106,19 +4030,17 @@ contextual information." ;; directory. (with-current-buffer (find-file-noselect (concat org-odt-zip-dir "content.xml") t) - (mapc - (lambda (cmd) - (message "Running %s" (mapconcat 'identity cmd " ")) - (setq err-string - (with-output-to-string - (setq exitcode - (apply 'call-process (car cmd) - nil standard-output nil (cdr cmd))))) - (or (zerop exitcode) - (error (concat "Unable to create OpenDocument file." - " Zip failed with error (%s)") - err-string))) - cmds))) + (dolist (cmd cmds) + (message "Running %s" (mapconcat 'identity cmd " ")) + (setq err-string + (with-output-to-string + (setq exitcode + (apply 'call-process (car cmd) + nil standard-output nil (cdr cmd))))) + (or (zerop exitcode) + (error (concat "Unable to create OpenDocument file." + " Zip failed with error (%s)") + err-string))))) ;; Move the zip file from temporary work directory to ;; user-mandated location. (rename-file (concat org-odt-zip-dir target-name) target) @@ -4162,9 +4084,9 @@ MathML source to kill ring depending on the value of (setq frag (and (setq frag (and (region-active-p) (buffer-substring (region-beginning) (region-end)))) - (loop for e in org-latex-regexps - thereis (when (string-match (nth 1 e) frag) - (match-string (nth 2 e) frag))))) + (cl-loop for e in org-latex-regexps + thereis (when (string-match (nth 1 e) frag) + (match-string (nth 2 e) frag))))) (read-string "LaTeX Fragment: " frag nil frag)) ,(let ((odf-filename (expand-file-name (concat @@ -4292,12 +4214,12 @@ Return output file's name." (when out-fmt-spec (throw 'done (cons (car e) out-fmt-spec)))))))) -(defun org-odt-do-convert (in-file out-fmt &optional prefix-arg) +(defun org-odt-do-convert (in-file out-fmt &optional open) "Workhorse routine for `org-odt-convert'." (require 'browse-url) - (let* ((in-file (expand-file-name (or in-file buffer-file-name))) - (dummy (or (file-readable-p in-file) - (error "Cannot read %s" in-file))) + (let* ((in-file (let ((f (expand-file-name (or in-file buffer-file-name)))) + (if (file-readable-p f) f + (error "Cannot read %s" in-file)))) (in-fmt (file-name-extension in-file)) (out-fmt (or out-fmt (error "Output format unspecified"))) (how (or (org-odt-reachable-p in-fmt out-fmt) @@ -4327,7 +4249,7 @@ Return output file's name." (cond ((file-exists-p out-file) (message "Exported to %s" out-file) - (when prefix-arg + (when open (message "Opening %s..." out-file) (org-open-file out-file 'system)) out-file) @@ -4360,12 +4282,10 @@ form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See (defun org-odt-reachable-formats (in-fmt) "Return list of formats to which IN-FMT can be converted. The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)." - (let (l) - (mapc (lambda (e) (add-to-list 'l e)) - (apply 'append (mapcar - (lambda (e) (mapcar 'car (cdr e))) - (org-odt-do-reachable-formats in-fmt)))) - l)) + (copy-sequence + (apply #'append (mapcar + (lambda (e) (mapcar #'car (cdr e))) + (org-odt-do-reachable-formats in-fmt))))) (defun org-odt-convert-read-params () "Return IN-FILE and OUT-FMT params for `org-odt-do-convert'. @@ -4385,25 +4305,23 @@ This is a helper routine for interactive use." (list in-file out-fmt))) ;;;###autoload -(defun org-odt-convert (&optional in-file out-fmt prefix-arg) +(defun org-odt-convert (&optional in-file out-fmt open) "Convert IN-FILE to format OUT-FMT using a command line converter. IN-FILE is the file to be converted. If unspecified, it defaults to variable `buffer-file-name'. OUT-FMT is the desired output -format. Use `org-odt-convert-process' as the converter. -If PREFIX-ARG is non-nil then the newly converted file is opened -using `org-open-file'." +format. Use `org-odt-convert-process' as the converter. If OPEN +is non-nil then the newly converted file is opened using +`org-open-file'." (interactive (append (org-odt-convert-read-params) current-prefix-arg)) - (org-odt-do-convert in-file out-fmt prefix-arg)) + (org-odt-do-convert in-file out-fmt open)) ;;; Library Initializations -(mapc - (lambda (desc) - ;; Let Emacs open all OpenDocument files in archive mode - (add-to-list 'auto-mode-alist - (cons (concat "\\." (car desc) "\\'") 'archive-mode))) - org-odt-file-extensions) +(dolist (desc org-odt-file-extensions) + ;; Let Emacs open all OpenDocument files in archive mode. + (add-to-list 'auto-mode-alist + (cons (concat "\\." (car desc) "\\'") 'archive-mode))) (provide 'ox-odt) diff --git a/lisp/ox-org.el b/lisp/ox-org.el index d9af3f7..b8cd15d 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -1,4 +1,4 @@ -;;; ox-org.el --- Org Back-End for Org Export Engine +;;; ox-org.el --- Org Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. @@ -25,7 +25,8 @@ ;;; Code: (require 'ox) -(declare-function htmlize-buffer "htmlize" (&optional buffer)) +(declare-function htmlize-buffer "ext:htmlize" (&optional buffer)) +(defvar htmlize-output-type) (defgroup org-export-org nil "Options for exporting Org mode files to Org." @@ -34,8 +35,6 @@ :version "24.4" :package-version '(Org . "8.0")) -(define-obsolete-variable-alias - 'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4") (defcustom org-org-htmlized-css-url nil "URL pointing to the CSS defining colors for htmlized Emacs buffers. Normally when creating an htmlized version of an Org buffer, @@ -62,6 +61,7 @@ setting of `org-html-htmlize-output-type' is `css'." (dynamic-block . org-org-identity) (entity . org-org-identity) (example-block . org-org-identity) + (export-block . org-org-export-block) (fixed-width . org-org-identity) (footnote-definition . ignore) (footnote-reference . org-org-identity) @@ -109,7 +109,13 @@ setting of `org-html-htmlize-output-type' is `css'." (if a (org-org-export-to-org t s v b) (org-open-file (org-org-export-to-org nil s v b)))))))) -(defun org-org-identity (blob contents info) +(defun org-org-export-block (export-block _contents _info) + "Transcode a EXPORT-BLOCK element from Org to LaTeX. +CONTENTS and INFO are ignored." + (and (equal (org-element-property :type export-block) "ORG") + (org-element-property :value export-block))) + +(defun org-org-identity (blob contents _info) "Transcode BLOB element or object back into Org syntax. CONTENTS is its contents, as a string or nil. INFO is ignored." (let ((case-fold-search t)) @@ -131,7 +137,7 @@ CONTENTS is its contents, as a string or nil. INFO is ignored." (org-export-get-relative-level headline info)) (org-element-headline-interpreter headline contents))) -(defun org-org-keyword (keyword contents info) +(defun org-org-keyword (keyword _contents _info) "Transcode KEYWORD element back into Org syntax. CONTENTS is nil. INFO is ignored." (let ((key (org-element-property :key keyword))) @@ -139,7 +145,7 @@ CONTENTS is nil. INFO is ignored." '("AUTHOR" "CREATOR" "DATE" "EMAIL" "OPTIONS" "TITLE")) (org-element-keyword-interpreter keyword nil)))) -(defun org-org-link (link contents info) +(defun org-org-link (link contents _info) "Transcode LINK object back into Org syntax. CONTENTS is the description of the link, as a string, or nil. INFO is a plist containing current export state." @@ -202,7 +208,7 @@ a communication channel." (mapconcat (lambda (d) (org-element-normalize-string - (concat (format "[%s] "(car d)) + (concat (format "[fn:%s] "(car d)) (org-export-data (cdr d) info)))) footnotes-alist "\n")))) (make-string (or (org-element-property :post-blank section) 0) ?\n))) diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el index 8e20a81..102f460 100644 --- a/lisp/ox-publish.el +++ b/lisp/ox-publish.el @@ -1,4 +1,4 @@ -;;; ox-publish.el --- Publish Related Org Mode Files as a Website +;;; ox-publish.el --- Publish Related Org Mode Files as a Website -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2016 Free Software Foundation, Inc. ;; Author: David O'Toole <dto@gnu.org> @@ -38,7 +38,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'format-spec) (require 'ox) @@ -61,15 +61,16 @@ the name of the original file and the name of the file produced.") (defgroup org-publish nil - "Options for publishing a set of Org-mode and related files." + "Options for publishing a set of files." :tag "Org Publishing" :group 'org) (defcustom org-publish-project-alist nil "Association list to control publishing behavior. -Each element of the alist is a publishing project. The CAR of +\\<org-mode-map> +Each element of the alist is a publishing project. The car of each element is a string, uniquely identifying the project. The -CDR of each element is in one of the following forms: +cdr of each element is in one of the following forms: 1. A well-formed property list with an even number of elements, alternating keys and values, specifying parameters for the @@ -86,7 +87,7 @@ When the CDR of an element of org-publish-project-alist is in this second form, the elements of the list after `:components' are taken to be components of the project, which group together files requiring different publishing options. When you publish -such a project with \\[org-publish], the components all publish. +such a project with `\\[org-publish]', the components all publish. When a property is given a value in `org-publish-project-alist', its setting overrides the value of the corresponding user @@ -110,6 +111,9 @@ Most properties are optional, but some should always be set: Directory (possibly remote) where output files will be published. +If `:recursive' is non-nil files in sub-directories of +`:base-directory' are considered. + The `:exclude' property may be used to prevent certain files from being published. Its value may be a string or regexp matching file names you don't want to be published. @@ -141,12 +145,16 @@ date. `:preparation-function' Function to be called before publishing this project. This - may also be a list of functions. + may also be a list of functions. Preparation functions are + called with the project properties list as their sole + argument. `:completion-function' Function to be called after publishing this project. This - may also be a list of functions. + may also be a list of functions. Completion functions are + called with the project properties list as their sole + argument. Some properties control details of the Org publishing process, and are equivalent to the corresponding user variables listed in @@ -341,7 +349,7 @@ You could use brackets to delimit on what part the link will be. (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) (defun org-publish-needed-p - (filename &optional pub-dir pub-func true-pub-dir base-dir) + (filename &optional pub-dir pub-func _true-pub-dir base-dir) "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC. TRUE-PUB-DIR is where the file will truly end up. Currently we are not using this - maybe it can eventually be used to check if @@ -358,7 +366,7 @@ still decide about that independently." rtn)) (defun org-publish-update-timestamp - (filename &optional pub-dir pub-func base-dir) + (filename &optional pub-dir pub-func _base-dir) "Update publishing timestamp for file FILENAME. If there is no timestamp, create one." (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) @@ -367,10 +375,9 @@ If there is no timestamp, create one." (defun org-publish-remove-all-timestamps () "Remove all files in the timestamp directory." - (let ((dir org-publish-timestamp-directory) - files) + (let ((dir org-publish-timestamp-directory)) (when (and (file-exists-p dir) (file-directory-p dir)) - (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) + (mapc #'delete-file (directory-files dir 'full "[^.]\\'")) (org-publish-reset-cache)))) @@ -403,12 +410,12 @@ This splices all the components into the list." (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders) ;; First we sort files: (when org-publish-sitemap-sort-files - (case org-publish-sitemap-sort-files - (alphabetically + (pcase org-publish-sitemap-sort-files + (`alphabetically (let* ((adir (file-directory-p a)) - (aorg (and (string-match "\\.org$" a) (not adir))) + (aorg (and (string-suffix-p ".org" a) (not adir))) (bdir (file-directory-p b)) - (borg (and (string-match "\\.org$" b) (not bdir))) + (borg (and (string-suffix-p ".org" b) (not bdir))) (A (if aorg (concat (file-name-directory a) (org-publish-find-title a)) a)) (B (if borg (concat (file-name-directory b) @@ -416,57 +423,56 @@ This splices all the components into the list." (setq retval (if org-publish-sitemap-ignore-case (not (string-lessp (upcase B) (upcase A))) (not (string-lessp B A)))))) - ((anti-chronologically chronologically) + ((or `anti-chronologically `chronologically) (let* ((adate (org-publish-find-date a)) (bdate (org-publish-find-date b)) (A (+ (lsh (car adate) 16) (cadr adate))) (B (+ (lsh (car bdate) 16) (cadr bdate)))) (setq retval - (if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B) + (if (eq org-publish-sitemap-sort-files 'chronologically) + (<= A B) (>= A B))))))) ;; Directory-wise wins: (when org-publish-sitemap-sort-folders ;; a is directory, b not: (cond ((and (file-directory-p a) (not (file-directory-p b))) - (setq retval (equal org-publish-sitemap-sort-folders 'first))) + (setq retval (eq org-publish-sitemap-sort-folders 'first))) ;; a is not a directory, but b is: ((and (not (file-directory-p a)) (file-directory-p b)) - (setq retval (equal org-publish-sitemap-sort-folders 'last)))))) + (setq retval (eq org-publish-sitemap-sort-folders 'last)))))) retval)) (defun org-publish-get-base-files-1 - (base-dir &optional recurse match skip-file skip-dir) + (base-dir &optional recurse match skip-file skip-dir) "Set `org-publish-temp-files' with files from BASE-DIR directory. If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is non-nil, restrict this list to the files matching the regexp MATCH. If SKIP-FILE is non-nil, skip file matching the regexp SKIP-FILE. If SKIP-DIR is non-nil, don't check directories matching the regexp SKIP-DIR when recursing through BASE-DIR." - (mapc (lambda (f) - (let ((fd-p (file-directory-p f)) - (fnd (file-name-nondirectory f))) - (if (and fd-p recurse - (not (string-match "^\\.+$" fnd)) - (if skip-dir (not (string-match skip-dir fnd)) t)) - (org-publish-get-base-files-1 - f recurse match skip-file skip-dir) - (unless (or fd-p ;; this is a directory - (and skip-file (string-match skip-file fnd)) - (not (file-exists-p (file-truename f))) - (not (string-match match fnd))) - - (pushnew f org-publish-temp-files))))) - (let ((all-files (if (not recurse) (directory-files base-dir t match) - ;; If RECURSE is non-nil, we want all files - ;; matching MATCH and sub-directories. - (org-remove-if-not - (lambda (file) - (or (file-directory-p file) - (and match (string-match match file)))) - (directory-files base-dir t))))) - (if (not org-publish-sitemap-requested) all-files - (sort all-files 'org-publish-compare-directory-files))))) + (let ((all-files (if (not recurse) (directory-files base-dir t match) + ;; If RECURSE is non-nil, we want all files + ;; matching MATCH and sub-directories. + (cl-remove-if-not + (lambda (file) + (or (file-directory-p file) + (and match (string-match match file)))) + (directory-files base-dir t))))) + (dolist (f (if (not org-publish-sitemap-requested) all-files + (sort all-files #'org-publish-compare-directory-files))) + (let ((fd-p (file-directory-p f)) + (fnd (file-name-nondirectory f))) + (if (and fd-p recurse + (not (string-match "^\\.+$" fnd)) + (if skip-dir (not (string-match skip-dir fnd)) t)) + (org-publish-get-base-files-1 + f recurse match skip-file skip-dir) + (unless (or fd-p ; This is a directory. + (and skip-file (string-match skip-file fnd)) + (not (file-exists-p (file-truename f))) + (not (string-match match fnd))) + (cl-pushnew f org-publish-temp-files))))))) (defun org-publish-get-base-files (project &optional exclude-regexp) "Return a list of all files in PROJECT. @@ -508,19 +514,16 @@ matching filenames." (setq org-publish-sitemap-sort-folders nil)) (setq org-publish-temp-files nil) - (if org-publish-sitemap-requested - (pushnew (expand-file-name (concat base-dir sitemap-filename)) + (when org-publish-sitemap-requested + (cl-pushnew (expand-file-name (concat base-dir sitemap-filename)) org-publish-temp-files)) (org-publish-get-base-files-1 base-dir recurse match ;; FIXME distinguish exclude regexp ;; for skip-file and skip-dir? exclude-regexp exclude-regexp) - (mapc (lambda (f) - (pushnew - (expand-file-name (concat base-dir f)) - org-publish-temp-files)) - include-list) - org-publish-temp-files)) + (dolist (f include-list org-publish-temp-files) + (cl-pushnew (expand-file-name (concat base-dir f)) + org-publish-temp-files)))) (defun org-publish-get-project-from-filename (filename &optional up) "Return the project that FILENAME belongs to." @@ -541,9 +544,7 @@ matching filenames." (when (or (and i (member filename - (mapcar (lambda (file) - (expand-file-name file b)) - i))) + (dolist (file i) (expand-file-name file b)))) (and (not (and e (string-match e filename))) (string-match xm filename))) (setq project-name (car prj)) @@ -575,29 +576,30 @@ Return output file name." (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t)) ;; Check if a buffer visiting FILENAME is already open. (let* ((org-inhibit-startup t) - (visitingp (find-buffer-visiting filename)) - (work-buffer (or visitingp (find-file-noselect filename)))) - (prog1 (with-current-buffer work-buffer - (let ((output-file - (org-export-output-file-name extension nil pub-dir)) - (body-p (plist-get plist :body-only))) - (org-export-to-file backend output-file - nil nil nil body-p - ;; Add `org-publish--collect-references' and - ;; `org-publish-collect-index' to final output - ;; filters. The latter isn't dependent on - ;; `:makeindex', since we want to keep it up-to-date - ;; in cache anyway. - (org-combine-plists - plist - `(:filter-final-output - ,(cons 'org-publish--collect-references - (cons 'org-publish-collect-index - (plist-get plist :filter-final-output)))))))) + (visiting (find-buffer-visiting filename)) + (work-buffer (or visiting (find-file-noselect filename)))) + (unwind-protect + (with-current-buffer work-buffer + (let ((output (org-export-output-file-name extension nil pub-dir))) + (org-export-to-file backend output + nil nil nil (plist-get plist :body-only) + ;; Add `org-publish--store-crossrefs' and + ;; `org-publish-collect-index' to final output filters. + ;; The latter isn't dependent on `:makeindex', since we + ;; want to keep it up-to-date in cache anyway. + (org-combine-plists + plist + `(:crossrefs + ,(org-publish-cache-get-file-property + (expand-file-name filename) :crossrefs nil t) + :filter-final-output + (org-publish--store-crossrefs + org-publish-collect-index + ,@(plist-get plist :filter-final-output))))))) ;; Remove opened buffer in the process. - (unless visitingp (kill-buffer work-buffer))))) + (unless visiting (kill-buffer work-buffer))))) -(defun org-publish-attachment (plist filename pub-dir) +(defun org-publish-attachment (_plist filename pub-dir) "Publish a file with no transformation of any kind. FILENAME is the filename of the Org file to be published. PLIST @@ -621,10 +623,10 @@ Return output file name." (defun org-publish-file (filename &optional project no-cache) "Publish file FILENAME from PROJECT. -If NO-CACHE is not nil, do not initialize org-publish-cache and -write it to disk. This is needed, since this function is used to -publish single files, when entire projects are published. -See `org-publish-projects'." +If NO-CACHE is not nil, do not initialize `org-publish-cache'. +This is needed, since this function is used to publish single +files, when entire projects are published (see +`org-publish-projects')." (let* ((project (or project (or (org-publish-get-project-from-filename filename) @@ -666,53 +668,54 @@ See `org-publish-projects'." (run-hook-with-args 'org-publish-after-publishing-hook filename output)))) - (unless no-cache (org-publish-write-cache-file)))) + ;; Make sure to write cache to file after successfully publishing + ;; a file, so as to minimize impact of a publishing failure. + (org-publish-write-cache-file))) (defun org-publish-projects (projects) "Publish all files belonging to the PROJECTS alist. If `:auto-sitemap' is set, publish the sitemap too. If -`:makeindex' is set, also produce a file theindex.org." - (mapc - (lambda (project) - ;; Each project uses its own cache file: - (org-publish-initialize-cache (car project)) - (let* ((project-plist (cdr project)) - (exclude-regexp (plist-get project-plist :exclude)) - (sitemap-p (plist-get project-plist :auto-sitemap)) - (sitemap-filename (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (sitemap-function (or (plist-get project-plist :sitemap-function) - 'org-publish-org-sitemap)) - (org-publish-sitemap-date-format - (or (plist-get project-plist :sitemap-date-format) - org-publish-sitemap-date-format)) - (org-publish-sitemap-file-entry-format - (or (plist-get project-plist :sitemap-file-entry-format) - org-publish-sitemap-file-entry-format)) - (preparation-function - (plist-get project-plist :preparation-function)) - (completion-function (plist-get project-plist :completion-function)) - (files (org-publish-get-base-files project exclude-regexp)) - (theindex +`:makeindex' is set, also produce a file \"theindex.org\"." + (dolist (project (org-publish-expand-projects projects)) + (let ((project-plist (cdr project))) + (let ((fun (plist-get project-plist :preparation-function))) + (cond ((consp fun) (dolist (f fun) (funcall f project-plist))) + ((functionp fun) (funcall fun project-plist)))) + ;; Each project uses its own cache file. + (org-publish-initialize-cache (car project)) + (when (plist-get project-plist :auto-sitemap) + (let ((sitemap-filename + (or (plist-get project-plist :sitemap-filename) + "sitemap.org")) + (sitemap-function + (or (plist-get project-plist :sitemap-function) + #'org-publish-org-sitemap)) + (org-publish-sitemap-date-format + (or (plist-get project-plist :sitemap-date-format) + org-publish-sitemap-date-format)) + (org-publish-sitemap-file-entry-format + (or (plist-get project-plist :sitemap-file-entry-format) + org-publish-sitemap-file-entry-format))) + (funcall sitemap-function project sitemap-filename))) + ;; Publish all files from PROJECT excepted "theindex.org". Its + ;; publishing will be deferred until "theindex.inc" is + ;; populated. + (let ((theindex (expand-file-name "theindex.org" - (plist-get project-plist :base-directory)))) - (when preparation-function (run-hooks 'preparation-function)) - (if sitemap-p (funcall sitemap-function project sitemap-filename)) - ;; Publish all files from PROJECT excepted "theindex.org". Its - ;; publishing will be deferred until "theindex.inc" is - ;; populated. - (dolist (file files) - (unless (equal file theindex) - (org-publish-file file project t))) - ;; Populate "theindex.inc", if needed, and publish - ;; "theindex.org". - (when (plist-get project-plist :makeindex) - (org-publish-index-generate-theindex - project (plist-get project-plist :base-directory)) - (org-publish-file theindex project t)) - (when completion-function (run-hooks 'completion-function)) - (org-publish-write-cache-file))) - (org-publish-expand-projects projects))) + (plist-get project-plist :base-directory))) + (exclude-regexp (plist-get project-plist :exclude))) + (dolist (file (org-publish-get-base-files project exclude-regexp)) + (unless (equal file theindex) (org-publish-file file project t))) + ;; Populate "theindex.inc", if needed, and publish + ;; "theindex.org". + (when (plist-get project-plist :makeindex) + (org-publish-index-generate-theindex + project (plist-get project-plist :base-directory)) + (org-publish-file theindex project t))) + (let ((fun (plist-get project-plist :completion-function))) + (cond ((consp fun) (dolist (f fun) (funcall f project-plist))) + ((functionp fun) (funcall fun project-plist)))) + (org-publish-write-cache-file)))) (defun org-publish-org-sitemap (project &optional sitemap-filename) "Create a sitemap of pages in set defined by PROJECT. @@ -734,7 +737,6 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension)) (visiting (find-buffer-visiting sitemap-filename)) - (ifn (file-name-nondirectory sitemap-filename)) file sitemap-buffer) (with-current-buffer (let ((org-inhibit-startup t)) @@ -743,8 +745,7 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (erase-buffer) (insert (concat "#+TITLE: " sitemap-title "\n\n")) (while (setq file (pop files)) - (let ((fn (file-name-nondirectory file)) - (link (file-relative-name file dir)) + (let ((link (file-relative-name file dir)) (oldlocal localdir)) (when sitemap-sans-extension (setq link (file-name-sans-extension link))) @@ -874,8 +875,8 @@ When optional argument FORCE is non-nil, force publishing all files in PROJECT. With a non-nil optional argument ASYNC, publishing will be done asynchronously, in another process." (interactive - (list (assoc (org-icompleting-read "Publish project: " - org-publish-project-alist nil t) + (list (assoc (completing-read "Publish project: " + org-publish-project-alist nil t) org-publish-project-alist) current-prefix-arg)) (let ((project (if (not (stringp project)) project @@ -885,7 +886,7 @@ publishing will be done asynchronously, in another process." (cond ((not project)) (async - (org-export-async-start (lambda (results) nil) + (org-export-async-start (lambda (_) nil) `(let ((org-publish-use-timestamps-flag ,(and (not force) org-publish-use-timestamps-flag))) ;; Expand components right now as external process may not @@ -906,7 +907,7 @@ optional argument ASYNC, publishing will be done asynchronously, in another process." (interactive "P") (if async - (org-export-async-start (lambda (results) nil) + (org-export-async-start (lambda (_) nil) `(progn (when ',force (org-publish-remove-all-timestamps)) (let ((org-publish-use-timestamps-flag @@ -928,7 +929,7 @@ asynchronously, in another process." (interactive "P") (let ((file (buffer-file-name (buffer-base-buffer)))) (if async - (org-export-async-start (lambda (results) nil) + (org-export-async-start (lambda (_) nil) `(let ((org-publish-use-timestamps-flag (if ',force nil ,org-publish-use-timestamps-flag))) (org-publish-file ,file))) @@ -954,7 +955,7 @@ the project." ;;; Index generation -(defun org-publish-collect-index (output backend info) +(defun org-publish-collect-index (output _backend info) "Update index for a file in cache. OUTPUT is the output from transcoding current file. BACKEND is @@ -1027,10 +1028,11 @@ publishing directory." ;; Compute the first difference between last entry and ;; current one: it tells the level at which new items ;; should be added. - (let* ((rank (if (equal entry last-entry) (1- (length entry)) - (loop for n from 0 to (length entry) - unless (equal (nth n entry) (nth n last-entry)) - return n))) + (let* ((rank + (if (equal entry last-entry) (1- (length entry)) + (cl-loop for n from 0 to (length entry) + unless (equal (nth n entry) (nth n last-entry)) + return n))) (len (length (nthcdr rank entry)))) ;; For each term after the first difference, create ;; a new sub-list with the term as body. Moreover, @@ -1045,11 +1047,11 @@ publishing directory." (format "[[%s][%s]]" ;; Destination. - (case (car target) - ('nil (format "file:%s" file)) - (id (format "id:%s" (cdr target))) - (custom-id (format "file:%s::#%s" file (cdr target))) - (otherwise (format "file:%s::*%s" file (cdr target)))) + (pcase (car target) + (`nil (format "file:%s" file)) + (`id (format "id:%s" (cdr target))) + (`custom-id (format "file:%s::#%s" file (cdr target))) + (_ (format "file:%s::*%s" file (cdr target)))) ;; Description. (car (last entry))))) "\n")))) @@ -1068,103 +1070,63 @@ publishing directory." ;; This part implements tools to resolve [[file.org::*Some headline]] ;; links, where "file.org" belongs to the current project. -(defun org-publish--collect-references (output backend info) - "Store headlines references for current published file. +(defun org-publish--store-crossrefs (output _backend info) + "Store cross-references for current published file. OUPUT is the produced output, as a string. BACKEND is the export back-end used, as a symbol. INFO is the final export state, as a plist. -References are stored as an alist ((TYPE SEARCH) . VALUE) where - - TYPE is a symbol among `headline', `custom-id', `target' and - `other'. - - SEARCH is the string a link is expected to match. It is - - - headline's title, as a string, with all whitespace - characters and statistics cookies removed, if TYPE is - `headline'. - - - CUSTOM_ID value if TYPE is `custom-id'. - - - target's or radio-target's name if TYPE is `target'. - - - NAME affiliated keyword is TYPE is `other'. - - VALUE is an internal reference used in the document, as - a string. - -This function is meant to be used as a final out filter. See +This function is meant to be used as a final output filter. See `org-publish-org-to'." (org-publish-cache-set-file-property - (plist-get info :input-file) :references - (let (refs) - (when (hash-table-p (plist-get info :internal-references)) - (maphash - (lambda (k v) - (case (org-element-type k) - ((headline inlinetask) - (push (cons - (cons 'headline - (org-split-string - (replace-regexp-in-string - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" - (org-element-property :raw-value k)))) - v) - refs) - (let ((custom-id (org-element-property :CUSTOM_ID k))) - (when custom-id - (push (cons (cons 'custom-id custom-id) v) refs)))) - ((radio-target target) - (push - (cons (cons 'target - (org-split-string (org-element-property :value k))) - v) - refs)) - ((org-element-property :name k) - (push - (cons - (cons 'other (org-split-string (org-element-property :name k))) - v) - refs))) - refs) - (plist-get info :internal-references))) - refs)) + (plist-get info :input-file) :crossrefs + ;; Update `:crossrefs' so as to remove unused references and search + ;; cells. Actually used references are extracted from + ;; `:internal-references', with references as strings removed. See + ;; `org-export-get-reference' for details. + (cl-remove-if (lambda (pair) (stringp (car pair))) + (plist-get info :internal-references))) ;; Return output unchanged. output) (defun org-publish-resolve-external-link (search file) - "Return reference for elements or objects matching SEARCH in FILE. + "Return reference for element matching string SEARCH in FILE. Return value is an internal reference, as a string. -This function allows the resolution of external links like: +This function allows resolving external links with a search +option, e.g., - [[file.org::*fuzzy][description]] + [[file.org::*heading][description]] [[file.org::#custom-id][description]] - [[file.org::fuzzy][description]]" + [[file.org::fuzzy][description]] + +It only makes sense to use this if export back-end builds +references with `org-export-get-reference'." (if (not org-publish-cache) (progn - (message "Reference \"%s\" in file \"%s\" cannot be resolved without \ -publishing" + (message "Reference %S in file %S cannot be resolved without publishing" search file) "MissingReference") - (let ((references (org-publish-cache-get-file-property - (expand-file-name file) :references nil t))) - (cond - ((cdr (case (aref search 0) - (?* (assoc (cons 'headline (org-split-string (substring search 1))) - references)) - (?# (assoc (cons 'custom-id (substring search 1)) references)) - (t - (let ((s (org-split-string search))) - (or (assoc (cons 'target s) references) - (assoc (cons 'other s) references) - (assoc (cons 'headline s) references))))))) - (t (message "Unknown cross-reference \"%s\" in file \"%s\"" search file) - "MissingReference"))))) + (let* ((filename (expand-file-name file)) + (crossrefs + (org-publish-cache-get-file-property filename :crossrefs nil t)) + (cells (org-export-string-to-search-cell search))) + (or + ;; Look for reference associated to search cells triggered by + ;; LINK. It can match when targeted file has been published + ;; already. + (let ((known (cdr (cl-some (lambda (c) (assoc c crossrefs)) cells)))) + (and known (org-export-format-reference known))) + ;; Search cell is unknown so far. Generate a new internal + ;; reference that will be used when the targeted file will be + ;; published. + (let ((new (org-export-new-reference crossrefs))) + (dolist (cell cells) (push (cons cell new) crossrefs)) + (org-publish-cache-set-file-property filename :crossrefs crossrefs) + (org-export-format-reference new)))))) @@ -1181,13 +1143,12 @@ If FREE-CACHE, empty the cache." (error "Cannot find cache-file name in `org-publish-write-cache-file'")) (with-temp-file cache-file (let (print-level print-length) - (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") + (insert "(setq org-publish-cache \ +\(make-hash-table :test 'equal :weakness nil :size 100))\n") (maphash (lambda (k v) (insert - (format (concat "(puthash %S " - (if (or (listp v) (symbolp v)) - "'" "") - "%S org-publish-cache)\n") k v))) + (format "(puthash %S %s%S org-publish-cache)\n" + k (if (or (listp v) (symbolp v)) "'" "") v))) org-publish-cache))) (when free-cache (org-publish-reset-cache)))) @@ -1195,7 +1156,8 @@ If FREE-CACHE, empty the cache." "Initialize the projects cache if not initialized yet and return it." (unless project-name - (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) + (error "Cannot initialize `org-publish-cache' without projects name in \ +`org-publish-initialize-cache'")) (unless (file-exists-p org-publish-timestamp-directory) (make-directory org-publish-timestamp-directory t)) @@ -1229,7 +1191,7 @@ If FREE-CACHE, empty the cache." (setq org-publish-cache nil)) (defun org-publish-cache-file-needs-publishing - (filename &optional pub-dir pub-func base-dir) + (filename &optional pub-dir pub-func _base-dir) "Check the timestamp of the last publishing of FILENAME. Return non-nil if the file needs publishing. Also check if any included files have been more recently published, so that @@ -1242,38 +1204,38 @@ the file including them will be republished as well." (pstamp (org-publish-cache-get key)) (org-inhibit-startup t) (visiting (find-buffer-visiting filename)) - included-files-ctime buf) + (buf (find-file-noselect (expand-file-name filename))) + included-files-ctime) (when (equal (file-name-extension filename) "org") - (setq buf (find-file (expand-file-name filename))) - (with-current-buffer buf - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t) - (let* ((element (org-element-at-point)) - (included-file - (and (eq (org-element-type element) 'keyword) - (let ((value (org-element-property :value element))) - (and value - (string-match - "\\`\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" - value) - (let ((m (match-string 1 value))) - (org-remove-double-quotes - ;; Ignore search suffix. - (if (string-match "\\(::\\(.*?\\)\\)\"?\\'" m) - (substring m 0 (match-beginning 0)) - m)))))))) - (when included-file - (add-to-list 'included-files-ctime - (org-publish-cache-ctime-of-src - (expand-file-name included-file)) - t))))) - (unless visiting (kill-buffer buf))) - (if (null pstamp) t - (let ((ctime (org-publish-cache-ctime-of-src filename))) - (or (< pstamp ctime) - (when included-files-ctime - (not (null (delq nil (mapcar (lambda (ct) (< ctime ct)) - included-files-ctime)))))))))) + (unwind-protect + (with-current-buffer buf + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t) + (let* ((element (org-element-at-point)) + (included-file + (and (eq (org-element-type element) 'keyword) + (let ((value (org-element-property :value element))) + (and value + (string-match + "\\`\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" + value) + (let ((m (match-string 1 value))) + (org-unbracket-string + "\"" "\"" + ;; Ignore search suffix. + (if (string-match "\\(::\\(.*?\\)\\)\"?\\'" + m) + (substring m 0 (match-beginning 0)) + m)))))))) + (when included-file + (push (org-publish-cache-ctime-of-src + (expand-file-name included-file)) + included-files-ctime))))) + (unless visiting (kill-buffer buf)))) + (or (null pstamp) + (let ((ctime (org-publish-cache-ctime-of-src filename))) + (or (< pstamp ctime) + (cl-some (lambda (ct) (< ctime ct)) included-files-ctime)))))) (defun org-publish-cache-set-file-property (filename property value &optional project-name) @@ -1290,9 +1252,9 @@ will be created. Return VALUE." (defun org-publish-cache-get-file-property (filename property &optional default no-create project-name) "Return the value for a PROPERTY of file FILENAME in publishing cache. -Use cache file of PROJECT-NAME. Return the value of that PROPERTY -or DEFAULT, if the value does not yet exist. If the entry will -be created, unless NO-CREATE is not nil." +Use cache file of PROJECT-NAME. Return the value of that +PROPERTY or DEFAULT, if the value does not yet exist. If the +entry will be created, unless NO-CREATE is not nil." ;; Evtl. load the requested cache file: (if project-name (org-publish-initialize-cache project-name)) (let ((pl (org-publish-cache-get filename)) retval) diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el index 610874b..cf9cc2f 100644 --- a/lisp/ox-texinfo.el +++ b/lisp/ox-texinfo.el @@ -1,4 +1,4 @@ -;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine +;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2016 Free Software Foundation, Inc. ;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com> @@ -25,7 +25,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'ox) (defvar orgtbl-exp-regexp) @@ -68,6 +68,7 @@ (special-block . org-texinfo-special-block) (src-block . org-texinfo-src-block) (statistics-cookie . org-texinfo-statistics-cookie) + (strike-through . org-texinfo-strike-through) (subscript . org-texinfo-subscript) (superscript . org-texinfo-superscript) (table . org-texinfo-table) @@ -76,9 +77,9 @@ (target . org-texinfo-target) (template . org-texinfo-template) (timestamp . org-texinfo-timestamp) + (underline . org-texinfo-underline) (verbatim . org-texinfo-verbatim) (verse-block . org-texinfo-verse-block)) - :export-block "TEXINFO" :filters-alist '((:filter-headline . org-texinfo--filter-section-blank-lines) (:filter-parse-tree . org-texinfo--normalize-headlines) @@ -223,7 +224,7 @@ TAGS the tags as a list of strings (list of strings or nil). The function result will be used in the section format string." :group 'org-export-texinfo :type 'function - :version "25.1" + :version "25.2" :package-version '(Org . "8.3")) ;;;; Node listing (menu) @@ -287,29 +288,28 @@ When nil, no transformation is made." (defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}") (code . code) (italic . "@emph{%s}") - (verbatim . verb) - (comment . "@c %s")) + (verbatim . verb)) "Alist of Texinfo expressions to convert text markup. -The key must be a symbol among `bold', `italic' and `comment'. -The value is a formatting string to wrap fontified text with. +The key must be a symbol among `bold', `code', `italic', +`strike-through', `underscore' and `verbatim'. The value is +a formatting string to wrap fontified text with. Value can also be set to the following symbols: `verb' and -`code'. For the former, Org will use \"@verb\" to -create a format string and select a delimiter character that -isn't in the string. For the latter, Org will use \"@code\" -to typeset and try to protect special characters. +`code'. For the former, Org will use \"@verb\" to create +a format string and select a delimiter character that isn't in +the string. For the latter, Org will use \"@code\" to typeset +and try to protect special characters. If no association can be found for a given markup, text will be returned as-is." :group 'org-export-texinfo :type 'alist - :options '(bold code italic verbatim comment)) + :options '(bold code italic strike-through underscore verbatim)) ;;;; Drawers -(defcustom org-texinfo-format-drawer-function - (lambda (name contents) contents) +(defcustom org-texinfo-format-drawer-function (lambda (_name contents) contents) "Function called to format a drawer in Texinfo code. The function must accept two parameters: @@ -393,12 +393,11 @@ If two strings share the same prefix (e.g. \"ISO-8859-1\" and ;;; Internal Functions -(defun org-texinfo--filter-section-blank-lines (headline back-end info) +(defun org-texinfo--filter-section-blank-lines (headline _backend _info) "Filter controlling number of blank lines after a section." - (let ((blanks (make-string 2 ?\n))) - (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))) + (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" "\n\n" headline)) -(defun org-texinfo--normalize-headlines (tree back-end info) +(defun org-texinfo--normalize-headlines (tree _backend info) "Normalize headlines in TREE. BACK-END is the symbol specifying back-end used for export. INFO @@ -427,37 +426,24 @@ Return new tree." "Return a character not used in string S. This is used to choose a separator for constructs like \\verb." (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (loop for c across ll - when (not (string-match (regexp-quote (char-to-string c)) s)) - return (char-to-string c)))) + (cl-loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) -(defun org-texinfo--text-markup (text markup info) +(defun org-texinfo--text-markup (text markup _info) "Format TEXT depending on MARKUP text markup. INFO is a plist used as a communication channel. See `org-texinfo-text-markup-alist' for details." - (let ((fmt (cdr (assq markup org-texinfo-text-markup-alist)))) - (cond - ;; No format string: Return raw text. - ((not fmt) text) - ((eq 'verb fmt) - (let ((separator (org-texinfo--find-verb-separator text))) - (concat "@verb{" separator text separator "}"))) - ((eq 'code fmt) - (let ((start 0) - (rtn "") - char) - (while (string-match "[@{}]" text) - (setq char (match-string 0 text)) - (if (> (match-beginning 0) 0) - (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) - (setq text (substring text (1+ (match-beginning 0)))) - (setq char (concat "@" char) - rtn (concat rtn char))) - (setq text (concat rtn text) - fmt "@code{%s}") - (format fmt text))) - ;; Else use format string. - (t (format fmt text))))) + (pcase (cdr (assq markup org-texinfo-text-markup-alist)) + ;; No format string: Return raw text. + (`nil text) + (`verb + (let ((separator (org-texinfo--find-verb-separator text))) + (concat "@verb{" separator text separator "}"))) + (`code + (format "@code{%s}" (replace-regexp-in-string "[@{}]" "@\\&" text))) + ;; Else use format string. + (fmt (format fmt text)))) (defun org-texinfo--get-node (blob info) "Return node or anchor associated to BLOB. @@ -562,7 +548,7 @@ holding export options." (name (symbol-name (or org-texinfo-coding-system buffer-file-coding-system)))) (dolist (system org-texinfo-supported-coding-systems "UTF-8") - (when (org-string-match-p (regexp-quote system) name) + (when (string-match-p (regexp-quote system) name) (throw 'coding-system system)))))) (language (plist-get info :language)) (case-fold-search nil)) @@ -599,7 +585,7 @@ holding export options." (let ((dirdesc (let ((desc (plist-get info :texinfo-dirdesc))) (cond ((not desc) nil) - ((org-string-match-p "\\.$" desc) desc) + ((string-suffix-p "." desc) desc) (t (concat desc ".")))))) (if dirdesc (format "%-23s %s" dirtitle dirdesc) dirtitle)) "\n" @@ -658,7 +644,7 @@ holding export options." ;;;; Bold -(defun org-texinfo-bold (bold contents info) +(defun org-texinfo-bold (_bold contents info) "Transcode BOLD from Org to Texinfo. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." @@ -666,7 +652,7 @@ contextual information." ;;;; Center Block -(defun org-texinfo-center-block (center-block contents info) +(defun org-texinfo-center-block (_center-block contents _info) "Transcode a CENTER-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the block. INFO is a plist used as a communication channel." @@ -674,7 +660,7 @@ as a communication channel." ;;;; Clock -(defun org-texinfo-clock (clock contents info) +(defun org-texinfo-clock (clock _contents info) "Transcode a CLOCK element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." @@ -689,7 +675,7 @@ information." ;;;; Code -(defun org-texinfo-code (code contents info) +(defun org-texinfo-code (code _contents info) "Transcode a CODE object from Org to Texinfo. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -708,7 +694,7 @@ holding contextual information." ;;;; Dynamic Block -(defun org-texinfo-dynamic-block (dynamic-block contents info) +(defun org-texinfo-dynamic-block (_dynamic-block contents _info) "Transcode a DYNAMIC-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -716,7 +702,7 @@ holding contextual information." ;;;; Entity -(defun org-texinfo-entity (entity contents info) +(defun org-texinfo-entity (entity _contents _info) "Transcode an ENTITY object from Org to Texinfo. CONTENTS are the definition itself. INFO is a plist holding contextual information." @@ -725,7 +711,7 @@ contextual information." ;;;; Example Block -(defun org-texinfo-example-block (example-block contents info) +(defun org-texinfo-example-block (example-block _contents info) "Transcode an EXAMPLE-BLOCK element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." @@ -734,7 +720,7 @@ information." ;;; Export Block -(defun org-texinfo-export-block (export-block contents info) +(defun org-texinfo-export-block (export-block _contents _info) "Transcode a EXPORT-BLOCK element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (when (string= (org-element-property :type export-block) "TEXINFO") @@ -742,7 +728,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;; Export Snippet -(defun org-texinfo-export-snippet (export-snippet contents info) +(defun org-texinfo-export-snippet (export-snippet _contents _info) "Transcode a EXPORT-SNIPPET object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (when (eq (org-export-snippet-backend export-snippet) 'texinfo) @@ -750,7 +736,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Fixed Width -(defun org-texinfo-fixed-width (fixed-width contents info) +(defun org-texinfo-fixed-width (fixed-width _contents _info) "Transcode a FIXED-WIDTH element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (format "@example\n%s\n@end example" @@ -760,7 +746,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Footnote Reference -(defun org-texinfo-footnote-reference (footnote contents info) +(defun org-texinfo-footnote-reference (footnote _contents info) "Create a footnote reference for FOOTNOTE. FOOTNOTE is the footnote to define. CONTENTS is nil. INFO is a @@ -848,7 +834,7 @@ holding contextual information." (t (concat node (format section-fmt full-text contents)))))) (defun org-texinfo-format-headline-default-function - (todo todo-type priority text tags) + (todo _todo-type priority text tags) "Default format function for a headline. See `org-texinfo-format-headline-function' for details." (concat (when todo (format "@strong{%s} " todo)) @@ -858,7 +844,7 @@ See `org-texinfo-format-headline-function' for details." ;;;; Inline Src Block -(defun org-texinfo-inline-src-block (inline-src-block contents info) +(defun org-texinfo-inline-src-block (inline-src-block _contents _info) "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." @@ -885,7 +871,7 @@ holding contextual information." todo todo-type priority title tags contents))) (defun org-texinfo-format-inlinetask-default-function - (todo todo-type priority title tags contents) + (todo _todo-type priority title tags contents) "Default format function for a inlinetasks. See `org-texinfo-format-inlinetask-function' for details." (let ((full-title @@ -897,7 +883,7 @@ See `org-texinfo-format-inlinetask-function' for details." ;;;; Italic -(defun org-texinfo-italic (italic contents info) +(defun org-texinfo-italic (_italic contents info) "Transcode ITALIC from Org to Texinfo. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." @@ -916,7 +902,7 @@ contextual information." ;;;; Keyword -(defun org-texinfo-keyword (keyword contents info) +(defun org-texinfo-keyword (keyword _contents info) "Transcode a KEYWORD element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (let ((key (org-element-property :key keyword)) @@ -930,16 +916,16 @@ CONTENTS is nil. INFO is a plist holding contextual information." ((string= key "TINDEX") (format "@tindex %s" value)) ((string= key "VINDEX") (format "@vindex %s" value)) ((string= key "TOC") - (cond ((org-string-match-p "\\<tables\\>" value) + (cond ((string-match-p "\\<tables\\>" value) (concat "@listoffloats " (org-export-translate "Table" :utf-8 info))) - ((org-string-match-p "\\<listings\\>" value) + ((string-match-p "\\<listings\\>" value) (concat "@listoffloats " (org-export-translate "Listing" :utf-8 info)))))))) ;;;; Line Break -(defun org-texinfo-line-break (line-break contents info) +(defun org-texinfo-line-break (_line-break _contents _info) "Transcode a LINE-BREAK object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." "@*\n") @@ -976,15 +962,15 @@ INFO is a plist holding contextual information. See (if (equal type "fuzzy") (org-export-resolve-fuzzy-link link info) (org-export-resolve-id-link link info)))) - (case (org-element-type destination) - ((nil) + (pcase (org-element-type destination) + (`nil (format org-texinfo-link-with-unknown-path-format (org-texinfo--sanitize-content path))) ;; Id link points to an external file. - (plain-text + (`plain-text (if desc (format "@uref{file://%s,%s}" destination desc) (format "@uref{file://%s}" destination))) - (headline + (`headline (format "@ref{%s,%s}" (org-texinfo--get-node destination info) (cond @@ -995,7 +981,7 @@ INFO is a plist holding contextual information. See (org-export-get-headline-number destination info) ".")) (t (org-export-data (org-element-property :title destination) info))))) - (otherwise + (_ (format "@ref{%s,,%s}" (org-texinfo--get-node destination info) (cond @@ -1113,7 +1099,7 @@ is an integer, build the menu recursively, down to this depth." (org-export-data (org-export-get-alt-title h info) info) (org-texinfo--format-entries entries info)) (org-texinfo--build-menu h info (1- level)))))) - (org-texinfo--menu-entries scope info) ""))))) + (org-texinfo--menu-entries scope info) "\n"))))) (defun org-texinfo--format-entries (entries info) "Format all direct menu entries in SCOPE, as a string. @@ -1156,7 +1142,7 @@ holding contextual information." ;;;; Node Property -(defun org-texinfo-node-property (node-property contents info) +(defun org-texinfo-node-property (node-property _contents _info) "Transcode a NODE-PROPERTY element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1167,7 +1153,7 @@ information." ;;;; Paragraph -(defun org-texinfo-paragraph (paragraph contents info) +(defun org-texinfo-paragraph (_paragraph contents _info) "Transcode a PARAGRAPH element from Org to Texinfo. CONTENTS is the contents of the paragraph, as a string. INFO is the plist used as a communication channel." @@ -1227,7 +1213,7 @@ contextual information." ;;;; Planning -(defun org-texinfo-planning (planning contents info) +(defun org-texinfo-planning (planning _contents info) "Transcode a PLANNING element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1260,7 +1246,7 @@ information." ;;;; Property Drawer -(defun org-texinfo-property-drawer (property-drawer contents info) +(defun org-texinfo-property-drawer (_property-drawer contents _info) "Transcode a PROPERTY-DRAWER element from Org to Texinfo. CONTENTS holds the contents of the drawer. INFO is a plist holding contextual information." @@ -1269,7 +1255,7 @@ holding contextual information." ;;;; Quote Block -(defun org-texinfo-quote-block (quote-block contents info) +(defun org-texinfo-quote-block (quote-block contents _info) "Transcode a QUOTE-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -1295,27 +1281,34 @@ contextual information." "Transcode a SECTION element from Org to Texinfo. CONTENTS holds the contents of the section. INFO is a plist holding contextual information." - (concat contents - (let ((parent (org-export-get-parent-headline section))) - (and parent (org-texinfo-make-menu parent info))))) + (org-trim + (concat contents + "\n" + (let ((parent (org-export-get-parent-headline section))) + (and parent (org-texinfo-make-menu parent info)))))) ;;;; Special Block -(defun org-texinfo-special-block (special-block contents info) +(defun org-texinfo-special-block (special-block contents _info) "Transcode a SPECIAL-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the block. INFO is a plist used as a communication channel." - (let ((type (org-element-property :type special-block))) - (format "@%s\n%s@end %s" type contents type))) + (let ((opt (org-export-read-attribute :attr_texinfo special-block :options)) + (type (org-element-property :type special-block))) + (format "@%s%s\n%s@end %s" + type + (if opt (concat " " opt) opt) + (or contents "") + type))) ;;;; Src Block -(defun org-texinfo-src-block (src-block contents info) +(defun org-texinfo-src-block (src-block _contents info) "Transcode a SRC-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((lisp (org-string-match-p "lisp" - (org-element-property :language src-block))) + (let* ((lisp (string-match-p "lisp" + (org-element-property :language src-block))) (code (org-texinfo--sanitize-content (org-export-format-code-default src-block info))) (value (format @@ -1333,14 +1326,23 @@ contextual information." ;;;; Statistics Cookie -(defun org-texinfo-statistics-cookie (statistics-cookie contents info) +(defun org-texinfo-statistics-cookie (statistics-cookie _contents _info) "Transcode a STATISTICS-COOKIE object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (org-element-property :value statistics-cookie)) + +;;;; Strike-through + +(defun org-texinfo-strike-through (_strike-through contents info) + "Transcode STRIKE-THROUGH from Org to Texinfo. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (org-texinfo--text-markup contents 'strike-through info)) + ;;;; Subscript -(defun org-texinfo-subscript (subscript contents info) +(defun org-texinfo-subscript (_subscript contents _info) "Transcode a SUBSCRIPT object from Org to Texinfo. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -1348,7 +1350,7 @@ contextual information." ;;;; Superscript -(defun org-texinfo-superscript (superscript contents info) +(defun org-texinfo-superscript (_superscript contents _info) "Transcode a SUPERSCRIPT object from Org to Texinfo. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -1398,7 +1400,7 @@ a communication channel." (let ((w (- (org-element-property :contents-end cell) (org-element-property :contents-begin cell)))) (aset widths idx (max w (aref widths idx)))) - (incf idx)) + (cl-incf idx)) info))) info) (format "{%s}" (mapconcat (lambda (w) (make-string w ?a)) widths "} {")))) @@ -1441,7 +1443,7 @@ a communication channel." ;;;; Target -(defun org-texinfo-target (target contents info) +(defun org-texinfo-target (target _contents info) "Transcode a TARGET object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1449,22 +1451,30 @@ information." ;;;; Timestamp -(defun org-texinfo-timestamp (timestamp contents info) +(defun org-texinfo-timestamp (timestamp _contents info) "Transcode a TIMESTAMP object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-texinfo-plain-text (org-timestamp-translate timestamp) info))) - (case (org-element-property :type timestamp) - ((active active-range) + (pcase (org-element-property :type timestamp) + ((or `active `active-range) (format (plist-get info :texinfo-active-timestamp-format) value)) - ((inactive inactive-range) + ((or `inactive `inactive-range) (format (plist-get info :texinfo-inactive-timestamp-format) value)) - (t (format (plist-get info :texinfo-diary-timestamp-format) value))))) + (_ (format (plist-get info :texinfo-diary-timestamp-format) value))))) + +;;;; Underline + +(defun org-texinfo-underline (_underline contents info) + "Transcode UNDERLINE from Org to Texinfo. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (org-texinfo--text-markup contents 'underline info)) ;;;; Verbatim -(defun org-texinfo-verbatim (verbatim contents info) +(defun org-texinfo-verbatim (verbatim _contents info) "Transcode a VERBATIM object from Org to Texinfo. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -1473,7 +1483,7 @@ channel." ;;;; Verse Block -(defun org-texinfo-verse-block (verse-block contents info) +(defun org-texinfo-verse-block (_verse-block contents _info) "Transcode a VERSE-BLOCK element from Org to Texinfo. CONTENTS is verse block contents. INFO is a plist holding contextual information." @@ -1567,100 +1577,36 @@ Return output file name." ;;;###autoload (defun org-texinfo-convert-region-to-texinfo () - "Assume the current region has org-mode syntax, and convert it to Texinfo. + "Assume the current region has Org syntax, and convert it to Texinfo. This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an Texinfo buffer and use -this command to convert it." +itemized list in Org syntax in an Texinfo buffer and use this +command to convert it." (interactive) (org-export-replace-region-by 'texinfo)) (defun org-texinfo-compile (file) "Compile a texinfo file. -FILE is the name of the file being compiled. Processing is -done through the command specified in `org-texinfo-info-process'. +FILE is the name of the file being compiled. Processing is done +through the command specified in `org-texinfo-info-process', +which see. Output is redirected to \"*Org INFO Texinfo Output*\" +buffer. Return INFO file name or an error if it couldn't be produced." - (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) - (full-name (file-truename file)) - (out-dir (file-name-directory file)) - ;; Properly set working directory for compilation. - (default-directory (if (file-name-absolute-p file) - (file-name-directory full-name) - default-directory)) - errors) - (message "Processing Texinfo file %s..." file) - (save-window-excursion - ;; Replace %b, %f and %o with appropriate values in each command - ;; before applying it. Output is redirected to "*Org INFO - ;; Texinfo Output*" buffer. - (let ((outbuf (get-buffer-create "*Org INFO Texinfo Output*"))) - (with-current-buffer outbuf (compilation-mode)) - (dolist (command org-texinfo-info-process) - (shell-command - (replace-regexp-in-string - "%b" (shell-quote-argument base-name) - (replace-regexp-in-string - "%f" (shell-quote-argument full-name) - (replace-regexp-in-string - "%o" (shell-quote-argument out-dir) command t t) t t) t t) - outbuf)) - ;; Collect standard errors from output buffer. - (setq errors (org-texinfo-collect-errors outbuf))) - (let ((infofile (concat out-dir base-name ".info"))) - ;; Check for process failure. Provide collected errors if - ;; possible. - (if (not (file-exists-p infofile)) - (error "INFO file %s wasn't produced%s" infofile - (if errors (concat ": " errors) "")) - ;; Else remove log files, when specified, and signal end of - ;; process to user, along with any error encountered. - (when org-texinfo-remove-logfiles - (dolist (ext org-texinfo-logfiles-extensions) - (let ((file (concat out-dir base-name "." ext))) - (when (file-exists-p file) (delete-file file))))) - (message (concat "Process completed" - (if (not errors) "." - (concat " with errors: " errors))))) - ;; Return output file name. - infofile)))) - -(defun org-texinfo-collect-errors (buffer) - "Collect some kind of errors from \"makeinfo\" command output. - -BUFFER is the buffer containing output. - -Return collected error types as a string, or nil if there was -none." - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - ;; Find final "makeinfo" run. - (when t - (let ((case-fold-search t) - (errors "")) - (when (save-excursion - (re-search-forward "perhaps incorrect sectioning?" nil t)) - (setq errors (concat errors " [incorrect sectioning]"))) - (when (save-excursion - (re-search-forward "missing close brace" nil t)) - (setq errors (concat errors " [syntax error]"))) - (when (save-excursion - (re-search-forward "Unknown command" nil t)) - (setq errors (concat errors " [undefined @command]"))) - (when (save-excursion - (re-search-forward "No matching @end" nil t)) - (setq errors (concat errors " [block incomplete]"))) - (when (save-excursion - (re-search-forward "requires a sectioning" nil t)) - (setq errors (concat errors " [invalid section command]"))) - (when (save-excursion - (re-search-forward "\\[unexpected\ ]" nil t)) - (setq errors (concat errors " [unexpected error]"))) - (when (save-excursion - (re-search-forward "misplaced " nil t)) - (setq errors (concat errors " [syntax error]"))) - (and (org-string-nw-p errors) (org-trim errors))))))) + (message "Processing Texinfo file %s..." file) + (let* ((log-name "*Org INFO Texinfo Output*") + (log (get-buffer-create log-name)) + (output + (org-compile-file file org-texinfo-info-process "info" + (format "See %S for details" log-name) + log))) + (when org-texinfo-remove-logfiles + (let ((base (file-name-sans-extension output))) + (dolist (ext org-texinfo-logfiles-extensions) + (let ((file (concat base "." ext))) + (when (file-exists-p file) (delete-file file)))))) + (message "Process completed.") + output)) (provide 'ox-texinfo) @@ -1,4 +1,4 @@ -;;; ox.el --- Generic Export Engine for Org Mode +;;; ox.el --- Export Framework for Org Mode -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2016 Free Software Foundation, Inc. @@ -71,17 +71,18 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) +(require 'ob-exp) (require 'org-element) (require 'org-macro) -(require 'ob-exp) +(require 'tabulated-list) (declare-function org-publish "ox-publish" (project &optional force async)) (declare-function org-publish-all "ox-publish" (&optional force async)) -(declare-function - org-publish-current-file "ox-publish" (&optional force async)) -(declare-function org-publish-current-project "ox-publish" - (&optional force async)) +(declare-function org-publish-current-file "ox-publish" (&optional force async)) +(declare-function org-publish-current-project "ox-publish" (&optional force async)) +(declare-function org-src-coderef-format "org-src" (&optional element)) +(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (defvar org-publish-project-alist) (defvar org-table-number-fraction) @@ -112,6 +113,7 @@ (:time-stamp-file nil "timestamp" org-export-time-stamp-file) (:with-archived-trees nil "arch" org-export-with-archived-trees) (:with-author nil "author" org-export-with-author) + (:with-broken-links nil "broken-links" org-export-with-broken-links) (:with-clocks nil "c" org-export-with-clocks) (:with-creator nil "creator" org-export-with-creator) (:with-date nil "date" org-export-with-date) @@ -345,21 +347,24 @@ e.g. \"arch:nil\"." :type '(choice (const :tag "Not at all" nil) (const :tag "Headline only" headline) - (const :tag "Entirely" t))) + (const :tag "Entirely" t)) + :safe (lambda (x) (memq x '(t nil headline)))) (defcustom org-export-with-author t "Non-nil means insert author name into the exported file. This option can also be set with the OPTIONS keyword, e.g. \"author:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-clocks nil "Non-nil means export CLOCK keywords. This option can also be set with the OPTIONS keyword, e.g. \"c:t\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-creator nil "Non-nil means the postamble should contain a creator sentence. @@ -370,16 +375,18 @@ see. This option can also be set with the OPTIONS keyword, e.g., \"creator:t\"." :group 'org-export-general - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-date t "Non-nil means insert date in the exported document. This option can also be set with the OPTIONS keyword, e.g. \"date:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-date-timestamp-format nil "Time-stamp format string to use for DATE keyword. @@ -392,7 +399,8 @@ string." :group 'org-export-general :type '(choice (string :tag "Time-stamp format string") - (const :tag "No format string" nil))) + (const :tag "No format string" nil)) + :safe (lambda (x) (or (null x) (stringp x)))) (defcustom org-export-creator-string (format "Emacs %s (Org mode %s)" @@ -401,7 +409,8 @@ string." "Information about the creator of the document. This option can also be set on with the CREATOR keyword." :group 'org-export-general - :type '(string :tag "Creator string")) + :type '(string :tag "Creator string") + :safe #'stringp) (defcustom org-export-with-drawers '(not "LOGBOOK") "Non-nil means export contents of standard drawers. @@ -427,14 +436,20 @@ e.g. \"d:nil\"." (const :format "" not) (repeat :tag "Specify names of drawers to ignore during export" :inline t - (string :tag "Drawer name"))))) + (string :tag "Drawer name")))) + :safe (lambda (x) (or (booleanp x) + (and (listp x) + (or (cl-every #'stringp x) + (and (eq (nth 0 x) 'not) + (cl-every #'stringp (cdr x)))))))) (defcustom org-export-with-email nil "Non-nil means insert author email into the exported file. This option can also be set with the OPTIONS keyword, e.g. \"email:t\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-emphasize t "Non-nil means interpret *word*, /word/, _word_ and +word+. @@ -446,7 +461,8 @@ respectively. This option can also be set with the OPTIONS keyword, e.g. \"*:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-exclude-tags '("noexport") "Tags that exclude a tree from export. @@ -457,7 +473,8 @@ carry one of the `org-export-select-tags' will be removed. This option can also be set with the EXCLUDE_TAGS keyword." :group 'org-export-general - :type '(repeat (string :tag "Tag"))) + :type '(repeat (string :tag "Tag")) + :safe (lambda (x) (and (listp x) (cl-every #'stringp x)))) (defcustom org-export-with-fixed-width t "Non-nil means export lines starting with \":\". @@ -466,14 +483,16 @@ e.g. \"::nil\"." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-footnotes t "Non-nil means Org footnotes should be exported. This option can also be set with the OPTIONS keyword, e.g. \"f:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-latex t "Non-nil means process LaTeX environments and fragments. @@ -490,7 +509,8 @@ t Allow export of math snippets." :type '(choice (const :tag "Do not process math in any way" nil) (const :tag "Interpret math snippets" t) - (const :tag "Leave math verbatim" verbatim))) + (const :tag "Leave math verbatim" verbatim)) + :safe (lambda (x) (memq x '(t nil verbatim)))) (defcustom org-export-headline-levels 3 "The last level which is still exported as a headline. @@ -501,7 +521,8 @@ when exported, but back-end behavior may differ. This option can also be set with the OPTIONS keyword, e.g. \"H:2\"." :group 'org-export-general - :type 'integer) + :type 'integer + :safe #'integerp) (defcustom org-export-default-language "en" "The default language for export and clocktable translations, as a string. @@ -510,14 +531,16 @@ This may have an association in `org-export-smart-quotes-alist' and `org-export-dictionary'. This option can also be set with the LANGUAGE keyword." :group 'org-export-general - :type '(string :tag "Language")) + :type '(string :tag "Language") + :safe #'stringp) (defcustom org-export-preserve-breaks nil "Non-nil means preserve all line breaks when exporting. This option can also be set with the OPTIONS keyword, e.g. \"\\n:t\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-entities t "Non-nil means interpret entities when exporting. @@ -531,7 +554,8 @@ and the user option `org-entities-user'. This option can also be set with the OPTIONS keyword, e.g. \"e:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-inlinetasks t "Non-nil means inlinetasks should be exported. @@ -540,7 +564,8 @@ e.g. \"inline:nil\"." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-planning nil "Non-nil means include planning info in export. @@ -553,14 +578,16 @@ e.g. \"p:t\"." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-priority nil "Non-nil means include priority cookies in export. This option can also be set with the OPTIONS keyword, e.g. \"pri:t\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-properties nil "Non-nil means export contents of properties drawers. @@ -577,7 +604,9 @@ e.g. \"prop:t\"." (const :tag "All properties" t) (const :tag "None" nil) (repeat :tag "Selected properties" - (string :tag "Property name")))) + (string :tag "Property name"))) + :safe (lambda (x) (or (booleanp x) + (and (listp x) (cl-every #'stringp x))))) (defcustom org-export-with-section-numbers t "Non-nil means add section numbers to headlines when exporting. @@ -588,7 +617,8 @@ headlines whose relative level is higher or equal to n. This option can also be set with the OPTIONS keyword, e.g. \"num:t\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-select-tags '("export") "Tags that select a tree for export. @@ -600,7 +630,8 @@ tagging it with one of the `org-export-exclude-tags'. This option can also be set with the SELECT_TAGS keyword." :group 'org-export-general - :type '(repeat (string :tag "Tag"))) + :type '(repeat (string :tag "Tag")) + :safe (lambda (x) (and (listp x) (cl-every #'stringp x)))) (defcustom org-export-with-smart-quotes nil "Non-nil means activate smart quotes during export. @@ -615,7 +646,8 @@ E.g., you can load Babel for french like this: :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-special-strings t "Non-nil means interpret \"\\-\", \"--\" and \"---\" for export. @@ -632,7 +664,8 @@ When this option is turned on, these strings will be exported as: This option can also be set with the OPTIONS keyword, e.g. \"-:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-statistics-cookies t "Non-nil means include statistics cookies in export. @@ -641,7 +674,8 @@ e.g. \"stat:nil\"" :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-sub-superscripts t "Non-nil means interpret \"_\" and \"^\" for export. @@ -678,7 +712,8 @@ frequently in plain text." :type '(choice (const :tag "Interpret them" t) (const :tag "Curly brackets only" {}) - (const :tag "Do not interpret them" nil))) + (const :tag "Do not interpret them" nil)) + :safe (lambda (x) (memq x '(t nil {})))) (defcustom org-export-with-toc t "Non-nil means create a table of contents in exported files. @@ -696,7 +731,9 @@ e.g. \"toc:nil\" or \"toc:3\"." :type '(choice (const :tag "No Table of Contents" nil) (const :tag "Full Table of Contents" t) - (integer :tag "TOC to level"))) + (integer :tag "TOC to level")) + :safe (lambda (x) (or (booleanp x) + (integerp x)))) (defcustom org-export-with-tables t "Non-nil means export tables. @@ -705,7 +742,8 @@ e.g. \"|:nil\"." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-tags t "If nil, do not export tags, just remove them from headlines. @@ -720,7 +758,8 @@ e.g. \"tags:nil\"." :type '(choice (const :tag "Off" nil) (const :tag "Not in TOC" not-in-toc) - (const :tag "On" t))) + (const :tag "On" t)) + :safe (lambda (x) (memq x '(t nil not-in-toc)))) (defcustom org-export-with-tasks t "Non-nil means include TODO items for export. @@ -741,23 +780,28 @@ e.g. \"tasks:nil\"." (const :tag "Not-done tasks" todo) (const :tag "Only done tasks" done) (repeat :tag "Specific TODO keywords" - (string :tag "Keyword")))) + (string :tag "Keyword"))) + :safe (lambda (x) (or (memq x '(nil t todo done)) + (and (listp x) + (cl-every #'stringp x))))) (defcustom org-export-with-title t "Non-nil means print title into the exported file. This option can also be set with the OPTIONS keyword, e.g. \"title:nil\"." :group 'org-export-general - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-time-stamp-file t "Non-nil means insert a time stamp into the exported file. The time stamp shows when the file was created. This option can also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-timestamps t "Non nil means allow timestamps in export. @@ -779,7 +823,8 @@ This option can also be set with the OPTIONS keyword, e.g. (const :tag "All timestamps" t) (const :tag "Only active timestamps" active) (const :tag "Only inactive timestamps" inactive) - (const :tag "No timestamp" nil))) + (const :tag "No timestamp" nil)) + :safe (lambda (x) (memq x '(t nil active inactive)))) (defcustom org-export-with-todo-keywords t "Non-nil means include TODO keywords in export. @@ -797,6 +842,27 @@ is nil. You can also allow them through local buffer variables." :package-version '(Org . "8.0") :type 'boolean) +(defcustom org-export-with-broken-links nil + "Non-nil means do not raise an error on broken links. + +When this variable is non-nil, broken links are ignored, without +stopping the export process. If it is set to `mark', broken +links are marked as such in the output, with a string like + + [BROKEN LINK: path] + +where PATH is the un-resolvable reference. + +This option can also be set with the OPTIONS keyword, e.g., +\"broken-links:mark\"." + :group 'org-export-general + :version "25.2" + :package-version '(Org . "9.0") + :type '(choice + (const :tag "Ignore broken links" t) + (const :tag "Mark broken links in output" mark) + (const :tag "Raise an error" nil))) + (defcustom org-export-snippet-translation-alist nil "Alist between export snippets back-ends and exporter back-ends. @@ -810,7 +876,12 @@ HTML code while every other back-end will ignore it." :package-version '(Org . "8.0") :type '(repeat (cons (string :tag "Shortcut") - (string :tag "Back-end")))) + (string :tag "Back-end"))) + :safe (lambda (x) + (and (listp x) + (cl-every #'consp x) + (cl-every #'stringp (mapcar #'car x)) + (cl-every #'stringp (mapcar #'cdr x))))) (defcustom org-export-coding-system nil "Coding system for the exported file." @@ -823,7 +894,7 @@ HTML code while every other back-end will ignore it." "Non-nil means pushing export output to the kill ring. This variable is ignored during asynchronous export." :group 'org-export-general - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(choice (const :tag "Always" t) @@ -851,7 +922,7 @@ these cases." (defcustom org-export-in-background nil "Non-nil means export and publishing commands will run in background. Results from an asynchronous export are never displayed -automatically. But you can retrieve them with \\[org-export-stack]." +automatically. But you can retrieve them with `\\[org-export-stack]'." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") @@ -921,8 +992,8 @@ mode." ;; Eventually `org-export-barf-if-invalid-backend' returns an error ;; when a given back-end hasn't been registered yet. -(defstruct (org-export-backend (:constructor org-export-create-backend) - (:copier nil)) +(cl-defstruct (org-export-backend (:constructor org-export-create-backend) + (:copier nil)) name parent transcoders options filters blocks menu) (defun org-export-get-backend (name) @@ -943,10 +1014,6 @@ BACKEND is a structure with `org-export-backend' type." (let ((parent (org-export-backend-parent backend))) (when (and parent (not (org-export-get-backend parent))) (error "Cannot use unknown \"%s\" back-end as a parent" parent))) - ;; Register dedicated export blocks in the parser. - (dolist (name (org-export-backend-blocks backend)) - (add-to-list 'org-element-block-name-alist - (cons name 'org-element-export-block-parser))) ;; If a back-end with the same name as BACKEND is already ;; registered, replace it with BACKEND. Otherwise, simply add ;; BACKEND to the list of registered back-ends. @@ -1073,14 +1140,6 @@ back-end. BODY can start with pre-defined keyword arguments. The following keywords are understood: - :export-block - - String, or list of strings, representing block names that - will not be parsed. This is used to specify blocks that will - contain raw code specific to the back-end. These blocks - still have to be handled by the relative `export-block' type - translator. - :filters-alist Alist between filters and function, or list of functions, @@ -1150,23 +1209,19 @@ keywords are understood: `org-export-options-alist' for more information about structure of the values." (declare (indent 1)) - (let (blocks filters menu-entry options contents) + (let (filters menu-entry options) (while (keywordp (car body)) (let ((keyword (pop body))) - (case keyword - (:export-block (let ((names (pop body))) - (setq blocks (if (consp names) (mapcar 'upcase names) - (list (upcase names)))))) + (pcase keyword (:filters-alist (setq filters (pop body))) (:menu-entry (setq menu-entry (pop body))) (:options-alist (setq options (pop body))) - (t (error "Unknown keyword: %s" keyword))))) + (_ (error "Unknown keyword: %s" keyword))))) (org-export-register-backend (org-export-create-backend :name backend :transcoders transcoders :options options :filters filters - :blocks blocks :menu menu-entry)))) (defun org-export-define-derived-backend (child parent &rest body) @@ -1178,14 +1233,6 @@ the parent back-end. BODY can start with pre-defined keyword arguments. The following keywords are understood: - :export-block - - String, or list of strings, representing block names that - will not be parsed. This is used to specify blocks that will - contain raw code specific to the back-end. These blocks - still have to be handled by the relative `export-block' type - translator. - :filters-alist Alist of filters that will overwrite or complete filters @@ -1222,25 +1269,21 @@ The back-end could then be called with, for example: (org-export-to-buffer \\='my-latex \"*Test my-latex*\")" (declare (indent 2)) - (let (blocks filters menu-entry options transcoders contents) + (let (filters menu-entry options transcoders) (while (keywordp (car body)) (let ((keyword (pop body))) - (case keyword - (:export-block (let ((names (pop body))) - (setq blocks (if (consp names) (mapcar 'upcase names) - (list (upcase names)))))) + (pcase keyword (:filters-alist (setq filters (pop body))) (:menu-entry (setq menu-entry (pop body))) (:options-alist (setq options (pop body))) (:translate-alist (setq transcoders (pop body))) - (t (error "Unknown keyword: %s" keyword))))) + (_ (error "Unknown keyword: %s" keyword))))) (org-export-register-backend (org-export-create-backend :name child :parent parent :transcoders transcoders :options options :filters filters - :blocks blocks :menu menu-entry)))) @@ -1259,7 +1302,7 @@ The back-end could then be called with, for example: ;; `org-export-options-alist' variable. ;; ;; 2. Tree properties are extracted directly from the parsed tree, -;; just before export, by `org-export-collect-tree-properties'. +;; just before export, by `org-export--collect-tree-properties'. ;;;; Environment Options ;; @@ -1304,7 +1347,7 @@ inferior to file-local settings." ;; First install #+BIND variables since these must be set before ;; global options are read. (dolist (pair (org-export--list-bound-variables)) - (org-set-local (car pair) (nth 1 pair))) + (set (make-local-variable (car pair)) (nth 1 pair))) ;; Get and prioritize export options... (org-combine-plists ;; ... from global variables... @@ -1314,25 +1357,7 @@ inferior to file-local settings." ;; ... from in-buffer settings... (org-export--get-inbuffer-options backend) ;; ... and from subtree, when appropriate. - (and subtreep (org-export--get-subtree-options backend)) - ;; Eventually add misc. properties. - (list - :back-end - backend - :translate-alist (org-export-get-all-transcoders backend) - :id-alist - ;; Collect id references. - (let (alist) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward "\\[\\[id:\\S-+?\\]" nil t) - (let ((link (org-element-context))) - (when (eq (org-element-type link) 'link) - (let* ((id (org-element-property :path link)) - (file (car (org-id-find id)))) - (when file - (push (cons id (file-relative-name file)) alist))))))) - alist)))) + (and subtreep (org-export--get-subtree-options backend)))) (defun org-export--parse-option-keyword (options &optional backend) "Parse an OPTIONS line and return values as a plist. @@ -1380,8 +1405,9 @@ for export. Return options as a plist." (cache (list (cons "TITLE" (or (org-entry-get (point) "EXPORT_TITLE" 'selective) - (progn (looking-at org-complex-heading-regexp) - (org-match-string-no-properties 4)))))) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp) + (match-string-no-properties 4)))))) ;; Look for both general keywords and back-end specific ;; options, with priority given to the latter. (options (append (and backend (org-export-get-all-options backend)) @@ -1401,7 +1427,7 @@ for export. Return options as a plist." (setq plist (plist-put plist property - (case (nth 4 option) + (cl-case (nth 4 option) (parse (org-element-parse-secondary-string value (org-element-restriction 'keyword))) @@ -1417,9 +1443,7 @@ which back-end specific options should also be read in the process. Assume buffer is in Org mode. Narrowing, if any, is ignored." - (let* (plist - get-options ; For byte-compiler. - (case-fold-search t) + (let* ((case-fold-search t) (options (append ;; Priority is given to back-end specific options. (and backend (org-export-get-all-options backend)) @@ -1427,110 +1451,124 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." (regexp (format "^[ \t]*#\\+%s:" (regexp-opt (nconc (delq nil (mapcar #'cadr options)) org-export-special-keywords)))) - (find-properties - (lambda (keyword) - ;; Return all properties associated to KEYWORD. - (let (properties) - (dolist (option options properties) - (when (equal (nth 1 option) keyword) - (pushnew (car option) properties)))))) - to-parse - (get-options - (lambda (&optional files plist) - ;; Recursively read keywords in buffer. FILES is a list - ;; of files read so far. PLIST is the current property - ;; list obtained. - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let ((key (org-element-property :key element)) - (val (org-element-property :value element))) - (cond - ;; Options in `org-export-special-keywords'. - ((equal key "SETUPFILE") - (let ((file (expand-file-name - (org-remove-double-quotes (org-trim val))))) - ;; Avoid circular dependencies. - (unless (member file files) - (with-temp-buffer - (setq default-directory + plist to-parse) + (letrec ((find-properties + (lambda (keyword) + ;; Return all properties associated to KEYWORD. + (let (properties) + (dolist (option options properties) + (when (equal (nth 1 option) keyword) + (cl-pushnew (car option) properties)))))) + (get-options + (lambda (&optional files) + ;; Recursively read keywords in buffer. FILES is + ;; a list of files read so far. PLIST is the current + ;; property list obtained. + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((key (org-element-property :key element)) + (val (org-element-property :value element))) + (cond + ;; Options in `org-export-special-keywords'. + ((equal key "SETUPFILE") + (let ((file + (expand-file-name + (org-unbracket-string "\"" "\"" (org-trim val))))) + ;; Avoid circular dependencies. + (unless (member file files) + (with-temp-buffer + (setq default-directory (file-name-directory file)) - (insert (org-file-contents file 'noerror)) - (let ((org-inhibit-startup t)) (org-mode)) - (setq plist (funcall get-options - (cons file files) plist)))))) - ((equal key "OPTIONS") - (setq plist - (org-combine-plists - plist - (org-export--parse-option-keyword val backend)))) - ((equal key "FILETAGS") - (setq plist - (org-combine-plists + (insert (org-file-contents file 'noerror)) + (let ((org-inhibit-startup t)) (org-mode)) + (funcall get-options (cons file files)))))) + ((equal key "OPTIONS") + (setq plist + (org-combine-plists + plist + (org-export--parse-option-keyword + val backend)))) + ((equal key "FILETAGS") + (setq plist + (org-combine-plists + plist + (list :filetags + (org-uniquify + (append + (org-split-string val ":") + (plist-get plist :filetags))))))) + (t + ;; Options in `org-export-options-alist'. + (dolist (property (funcall find-properties key)) + (setq plist - (list :filetags - (org-uniquify - (append (org-split-string val ":") - (plist-get plist :filetags))))))) - (t - ;; Options in `org-export-options-alist'. - (dolist (property (funcall find-properties key)) - (setq - plist - (plist-put - plist property - ;; Handle value depending on specified - ;; BEHAVIOR. - (case (nth 4 (assq property options)) - (parse - (unless (memq property to-parse) - (push property to-parse)) - ;; Even if `parse' implies `space' - ;; behavior, we separate line with "\n" - ;; so as to preserve line-breaks. - ;; However, empty lines are forbidden - ;; since `parse' doesn't allow more than - ;; one paragraph. - (let ((old (plist-get plist property))) - (cond ((not (org-string-nw-p val)) old) - (old (concat old "\n" val)) - (t val)))) - (space - (if (not (plist-get plist property)) - (org-trim val) - (concat (plist-get plist property) - " " - (org-trim val)))) - (newline - (org-trim - (concat (plist-get plist property) - "\n" - (org-trim val)))) - (split `(,@(plist-get plist property) - ,@(org-split-string val))) - ((t) val) - (otherwise - (if (not (plist-member plist property)) val - (plist-get plist property))))))))))))) - plist)))) - ;; Read options in the current buffer and return value. - (let ((options (funcall get-options - (and buffer-file-name (list buffer-file-name)) - nil))) + (plist-put + plist property + ;; Handle value depending on specified + ;; BEHAVIOR. + (cl-case (nth 4 (assq property options)) + (parse + (unless (memq property to-parse) + (push property to-parse)) + ;; Even if `parse' implies `space' + ;; behavior, we separate line with + ;; "\n" so as to preserve + ;; line-breaks. However, empty + ;; lines are forbidden since `parse' + ;; doesn't allow more than one + ;; paragraph. + (let ((old (plist-get plist property))) + (cond ((not (org-string-nw-p val)) old) + (old (concat old "\n" val)) + (t val)))) + (space + (if (not (plist-get plist property)) + (org-trim val) + (concat (plist-get plist property) + " " + (org-trim val)))) + (newline + (org-trim + (concat (plist-get plist property) + "\n" + (org-trim val)))) + (split `(,@(plist-get plist property) + ,@(org-split-string val))) + ((t) val) + (otherwise + (if (not (plist-member plist property)) val + (plist-get plist property))))))))))))))))) + ;; Read options in the current buffer and return value. + (funcall get-options (and buffer-file-name (list buffer-file-name))) ;; Parse properties in TO-PARSE. Remove newline characters not ;; involved in line breaks to simulate `space' behavior. ;; Finally return options. - (dolist (p to-parse options) + (dolist (p to-parse plist) (let ((value (org-element-parse-secondary-string - (plist-get options p) + (plist-get plist p) (org-element-restriction 'keyword)))) (org-element-map value 'plain-text (lambda (s) (org-element-set-element s (replace-regexp-in-string "\n" " " s)))) - (setq options (plist-put options p value))))))) + (setq plist (plist-put plist p value))))))) + +(defun org-export--get-export-attributes + (&optional backend subtreep visible-only body-only) + "Return properties related to export process, as a plist. +Optional arguments BACKEND, SUBTREEP, VISIBLE-ONLY and BODY-ONLY +are like the arguments with the same names of function +`org-export-as'." + (list :export-options (delq nil + (list (and subtreep 'subtree) + (and visible-only 'visible-only) + (and body-only 'body-only))) + :back-end backend + :translate-alist (org-export-get-all-transcoders backend) + :exported-data (make-hash-table :test #'eq :size 4001))) (defun org-export--get-buffer-attributes () "Return properties related to buffer attributes, as a plist." @@ -1566,37 +1604,37 @@ process." Also look for BIND keywords in setup files. The return value is an alist where associations are (VARIABLE-NAME VALUE)." (when org-export-allow-bind-keywords - (let* (collect-bind ; For byte-compiler. - (collect-bind - (lambda (files alist) - ;; Return an alist between variable names and their - ;; value. FILES is a list of setup files names read so - ;; far, used to avoid circular dependencies. ALIST is - ;; the alist collected so far. - (let ((case-fold-search t)) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let ((val (org-element-property :value element))) - (if (equal (org-element-property :key element) "BIND") - (push (read (format "(%s)" val)) alist) - ;; Enter setup file. - (let ((file (expand-file-name - (org-remove-double-quotes val)))) - (unless (member file files) - (with-temp-buffer - (setq default-directory - (file-name-directory file)) - (let ((org-inhibit-startup t)) (org-mode)) - (insert (org-file-contents file 'noerror)) - (setq alist - (funcall collect-bind - (cons file files) - alist)))))))))) - alist))))) + (letrec ((collect-bind + (lambda (files alist) + ;; Return an alist between variable names and their + ;; value. FILES is a list of setup files names read + ;; so far, used to avoid circular dependencies. ALIST + ;; is the alist collected so far. + (let ((case-fold-search t)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) + "BIND") + (push (read (format "(%s)" val)) alist) + ;; Enter setup file. + (let ((file (expand-file-name + (org-unbracket-string "\"" "\"" val)))) + (unless (member file files) + (with-temp-buffer + (setq default-directory + (file-name-directory file)) + (let ((org-inhibit-startup t)) (org-mode)) + (insert (org-file-contents file 'noerror)) + (setq alist + (funcall collect-bind + (cons file files) + alist)))))))))) + alist))))) ;; Return value in appropriate order of appearance. (nreverse (funcall collect-bind nil nil))))) @@ -1612,7 +1650,7 @@ BLOB is the element or object considered." ;; ;; Tree properties are information extracted from parse tree. They ;; are initialized at the beginning of the transcoding process by -;; `org-export-collect-tree-properties'. +;; `org-export--collect-tree-properties'. ;; ;; Dedicated functions focus on computing the value of specific tree ;; properties during initialization. Thus, @@ -1623,7 +1661,7 @@ BLOB is the element or object considered." ;; `org-export--collect-headline-numbering' builds an alist between ;; headlines and their numbering. -(defun org-export-collect-tree-properties (data info) +(defun org-export--collect-tree-properties (data info) "Extract tree properties from parse tree. DATA is the parse tree from which information is retrieved. INFO @@ -1631,17 +1669,17 @@ is a list holding export options. Following tree properties are set or updated: -`:exported-data' Hash table used to memoize results from - `org-export-data'. - `:headline-offset' Offset between true level of headlines and local level. An offset of -1 means a headline of level 2 should be considered as a level 1 headline in the context. -`:headline-numbering' Alist of all headlines as key an the +`:headline-numbering' Alist of all headlines as key and the associated numbering as value. +`:id-alist' Alist of all ID references as key and associated file + as value. + Return updated plist." ;; Install the parse tree in the communication channel. (setq info (plist-put info :parse-tree data)) @@ -1651,12 +1689,18 @@ Return updated plist." (plist-put info :headline-offset (- 1 (org-export--get-min-level data info)))) - ;; Properties order doesn't matter: get the rest of the tree - ;; properties. - (nconc - `(:headline-numbering ,(org-export--collect-headline-numbering data info) - :exported-data ,(make-hash-table :test 'eq :size 4001)) - info)) + ;; From now on, properties order doesn't matter: get the rest of the + ;; tree properties. + (org-combine-plists + info + (list :headline-numbering (org-export--collect-headline-numbering data info) + :id-alist + (org-element-map data 'link + (lambda (l) + (and (string= (org-element-property :type l) "id") + (let* ((id (org-element-property :path l)) + (file (car (org-id-find id)))) + (and file (cons id (file-relative-name file)))))))))) (defun org-export--get-min-level (data options) "Return minimum exportable headline's level in DATA. @@ -1664,14 +1708,12 @@ DATA is parsed tree as returned by `org-element-parse-buffer'. OPTIONS is a plist holding export options." (catch 'exit (let ((min-level 10000)) - (mapc - (lambda (blob) - (when (and (eq (org-element-type blob) 'headline) - (not (org-element-property :footnote-section-p blob)) - (not (memq blob (plist-get options :ignore-list)))) - (setq min-level (min (org-element-property :level blob) min-level))) - (when (= min-level 1) (throw 'exit 1))) - (org-element-contents data)) + (dolist (datum (org-element-contents data)) + (when (and (eq (org-element-type datum) 'headline) + (not (org-element-property :footnote-section-p datum)) + (not (memq datum (plist-get options :ignore-list)))) + (setq min-level (min (org-element-property :level datum) min-level)) + (when (= min-level 1) (throw 'exit 1)))) ;; If no headline was found, for the sake of consistency, set ;; minimum level to 1 nonetheless. (if (= min-level 10000) 1 min-level)))) @@ -1694,55 +1736,58 @@ for a footnotes section." (1- (org-export-get-relative-level headline options)))) (cons headline - (loop for n across numbering - for idx from 0 to org-export-max-depth - when (< idx relative-level) collect n - when (= idx relative-level) collect (aset numbering idx (1+ n)) - when (> idx relative-level) do (aset numbering idx 0)))))) + (cl-loop + for n across numbering + for idx from 0 to org-export-max-depth + when (< idx relative-level) collect n + when (= idx relative-level) collect (aset numbering idx (1+ n)) + when (> idx relative-level) do (aset numbering idx 0)))))) options))) (defun org-export--selected-trees (data info) "List headlines and inlinetasks with a select tag in their tree. DATA is parsed data as returned by `org-element-parse-buffer'. INFO is a plist holding export options." - (let* (selected-trees - walk-data ; For byte-compiler. - (walk-data - (function - (lambda (data genealogy) - (let ((type (org-element-type data))) - (cond - ((memq type '(headline inlinetask)) - (let ((tags (org-element-property :tags data))) - (if (loop for tag in (plist-get info :select-tags) - thereis (member tag tags)) - ;; When a select tag is found, mark full - ;; genealogy and every headline within the tree - ;; as acceptable. - (setq selected-trees - (append - genealogy - (org-element-map data '(headline inlinetask) - #'identity) - selected-trees)) - ;; If at a headline, continue searching in tree, - ;; recursively. - (when (eq type 'headline) - (dolist (el (org-element-contents data)) - (funcall walk-data el (cons data genealogy))))))) - ((or (eq type 'org-data) - (memq type org-element-greater-elements)) - (dolist (el (org-element-contents data)) - (funcall walk-data el genealogy))))))))) - (funcall walk-data data nil) - selected-trees)) + (let ((select (plist-get info :select-tags))) + (if (cl-some (lambda (tag) (member tag select)) (plist-get info :filetags)) + ;; If FILETAGS contains a select tag, every headline or + ;; inlinetask is returned. + (org-element-map data '(headline inlinetask) #'identity) + (letrec ((selected-trees nil) + (walk-data + (lambda (data genealogy) + (let ((type (org-element-type data))) + (cond + ((memq type '(headline inlinetask)) + (let ((tags (org-element-property :tags data))) + (if (cl-some (lambda (tag) (member tag select)) tags) + ;; When a select tag is found, mark full + ;; genealogy and every headline within the + ;; tree as acceptable. + (setq selected-trees + (append + genealogy + (org-element-map data '(headline inlinetask) + #'identity) + selected-trees)) + ;; If at a headline, continue searching in + ;; tree, recursively. + (when (eq type 'headline) + (dolist (el (org-element-contents data)) + (funcall walk-data el (cons data genealogy))))))) + ((or (eq type 'org-data) + (memq type org-element-greater-elements)) + (dolist (el (org-element-contents data)) + (funcall walk-data el genealogy)))))))) + (funcall walk-data data nil) + selected-trees)))) (defun org-export--skip-p (blob options selected) "Non-nil when element or object BLOB should be skipped during export. OPTIONS is the plist holding export options. SELECTED, when non-nil, is a list of headlines or inlinetasks belonging to a tree with a select tag." - (case (org-element-type blob) + (cl-case (org-element-type blob) (clock (not (plist-get options :with-clocks))) (drawer (let ((with-drawers-p (plist-get options :with-drawers))) @@ -1764,13 +1809,13 @@ a tree with a select tag." (todo (org-element-property :todo-keyword blob)) (todo-type (org-element-property :todo-type blob)) (archived (plist-get options :with-archived-trees)) - (tags (org-element-property :tags blob))) + (tags (org-export-get-tags blob options nil t))) (or (and (eq (org-element-type blob) 'inlinetask) (not (plist-get options :with-inlinetasks))) ;; Ignore subtrees with an exclude tag. - (loop for k in (plist-get options :exclude-tags) - thereis (member k tags)) + (cl-loop for k in (plist-get options :exclude-tags) + thereis (member k tags)) ;; When a select tag is present in the buffer, ignore any tree ;; without it. (and selected (not (memq blob selected))) @@ -1812,7 +1857,7 @@ a tree with a select tag." (lambda (obj) (or (not (stringp obj)) (org-string-nw-p obj))) options t)))) - (case (plist-get options :with-timestamps) + (cl-case (plist-get options :with-timestamps) ((nil) t) (active (not (memq (org-element-property :type blob) '(active active-range)))) @@ -1842,7 +1887,7 @@ a tree with a select tag." INFO is a plist containing export directives." (let ((type (org-element-type blob))) ;; Return contents only for complete parse trees. - (if (eq type 'org-data) (lambda (blob contents info) contents) + (if (eq type 'org-data) (lambda (_datum contents _info) contents) (let ((transcoder (cdr (assq type (plist-get info :translate-alist))))) (and (functionp transcoder) transcoder))))) @@ -1854,91 +1899,103 @@ string. INFO is a plist holding export options. Return a string." (or (gethash data (plist-get info :exported-data)) - (let* ((type (org-element-type data)) - (results - (cond - ;; Ignored element/object. - ((memq data (plist-get info :ignore-list)) nil) - ;; Plain text. - ((eq type 'plain-text) - (org-export-filter-apply-functions - (plist-get info :filter-plain-text) - (let ((transcoder (org-export-transcoder data info))) - (if transcoder (funcall transcoder data info) data)) - info)) - ;; Secondary string. - ((not type) - (mapconcat (lambda (obj) (org-export-data obj info)) data "")) - ;; Element/Object without contents or, as a special - ;; case, headline with archive tag and archived trees - ;; restricted to title only. - ((or (not (org-element-contents data)) - (and (eq type 'headline) - (eq (plist-get info :with-archived-trees) 'headline) - (org-element-property :archivedp data))) - (let ((transcoder (org-export-transcoder data info))) - (or (and (functionp transcoder) - (funcall transcoder data nil info)) - ;; Export snippets never return a nil value so - ;; that white spaces following them are never - ;; ignored. - (and (eq type 'export-snippet) "")))) - ;; Element/Object with contents. - (t - (let ((transcoder (org-export-transcoder data info))) - (when transcoder - (let* ((greaterp (memq type org-element-greater-elements)) - (objectp - (and (not greaterp) - (memq type org-element-recursive-objects))) - (contents - (mapconcat - (lambda (element) (org-export-data element info)) - (org-element-contents - (if (or greaterp objectp) data - ;; Elements directly containing - ;; objects must have their indentation - ;; normalized first. - (org-element-normalize-contents - data - ;; When normalizing contents of the - ;; first paragraph in an item or - ;; a footnote definition, ignore - ;; first line's indentation: there is - ;; none and it might be misleading. - (when (eq type 'paragraph) - (let ((parent (org-export-get-parent data))) + ;; Handle broken links according to + ;; `org-export-with-broken-links'. + (cl-macrolet + ((broken-link-handler + (&rest body) + `(condition-case err + (progn ,@body) + (org-link-broken + (pcase (plist-get info :with-broken-links) + (`nil (user-error "Unable to resolve link: %S" (nth 1 err))) + (`mark (org-export-data + (format "[BROKEN LINK: %s]" (nth 1 err)) info)) + (_ nil)))))) + (let* ((type (org-element-type data)) + (parent (org-export-get-parent data)) + (results + (cond + ;; Ignored element/object. + ((memq data (plist-get info :ignore-list)) nil) + ;; Plain text. + ((eq type 'plain-text) + (org-export-filter-apply-functions + (plist-get info :filter-plain-text) + (let ((transcoder (org-export-transcoder data info))) + (if transcoder (funcall transcoder data info) data)) + info)) + ;; Secondary string. + ((not type) + (mapconcat (lambda (obj) (org-export-data obj info)) data "")) + ;; Element/Object without contents or, as a special + ;; case, headline with archive tag and archived trees + ;; restricted to title only. + ((or (not (org-element-contents data)) + (and (eq type 'headline) + (eq (plist-get info :with-archived-trees) 'headline) + (org-element-property :archivedp data))) + (let ((transcoder (org-export-transcoder data info))) + (or (and (functionp transcoder) + (broken-link-handler + (funcall transcoder data nil info))) + ;; Export snippets never return a nil value so + ;; that white spaces following them are never + ;; ignored. + (and (eq type 'export-snippet) "")))) + ;; Element/Object with contents. + (t + (let ((transcoder (org-export-transcoder data info))) + (when transcoder + (let* ((greaterp (memq type org-element-greater-elements)) + (objectp + (and (not greaterp) + (memq type org-element-recursive-objects))) + (contents + (mapconcat + (lambda (element) (org-export-data element info)) + (org-element-contents + (if (or greaterp objectp) data + ;; Elements directly containing + ;; objects must have their indentation + ;; normalized first. + (org-element-normalize-contents + data + ;; When normalizing contents of the + ;; first paragraph in an item or + ;; a footnote definition, ignore + ;; first line's indentation: there is + ;; none and it might be misleading. + (when (eq type 'paragraph) (and (eq (car (org-element-contents parent)) data) (memq (org-element-type parent) - '(footnote-definition item)))))))) - ""))) - (funcall transcoder data - (if (not greaterp) contents - (org-element-normalize-string contents)) - info)))))))) - ;; Final result will be memoized before being returned. - (puthash - data - (cond - ((not results) "") - ((memq type '(org-data plain-text nil)) results) - ;; Append the same white space between elements or objects - ;; as in the original buffer, and call appropriate filters. - (t - (let ((results - (org-export-filter-apply-functions - (plist-get info (intern (format ":filter-%s" type))) - (let ((post-blank (or (org-element-property :post-blank data) - 0))) - (if (memq type org-element-all-elements) - (concat (org-element-normalize-string results) - (make-string post-blank ?\n)) - (concat results (make-string post-blank ?\s)))) - info))) - results))) - (plist-get info :exported-data))))) + '(footnote-definition item))))))) + ""))) + (broken-link-handler + (funcall transcoder data + (if (not greaterp) contents + (org-element-normalize-string contents)) + info))))))))) + ;; Final result will be memoized before being returned. + (puthash + data + (cond + ((not results) "") + ((memq type '(org-data plain-text nil)) results) + ;; Append the same white space between elements or objects + ;; as in the original buffer, and call appropriate filters. + (t + (org-export-filter-apply-functions + (plist-get info (intern (format ":filter-%s" type))) + (let ((blank (or (org-element-property :post-blank data) 0))) + (if (eq (org-element-class data parent) 'object) + (concat results (make-string blank ?\s)) + (concat (org-element-normalize-string results) + (make-string blank ?\n)))) + info))) + (plist-get info :exported-data)))))) (defun org-export-data-with-backend (data backend info) "Convert DATA into BACKEND format. @@ -1972,7 +2029,8 @@ contents, as a string or nil. When optional argument WITH-AFFILIATED is non-nil, add affiliated keywords before output." (let ((type (org-element-type blob))) - (concat (and with-affiliated (memq type org-element-all-elements) + (concat (and with-affiliated + (eq (org-element-class blob) 'element) (org-element--interpret-affiliated-keywords blob)) (funcall (intern (format "org-element-%s-interpreter" type)) blob contents)))) @@ -2437,29 +2495,27 @@ Return the updated communication channel." (let (plist) ;; Install user-defined filters with `org-export-filters-alist' ;; and filters already in INFO (through ext-plist mechanism). - (mapc (lambda (p) - (let* ((prop (car p)) - (info-value (plist-get info prop)) - (default-value (symbol-value (cdr p)))) - (setq plist - (plist-put plist prop - ;; Filters in INFO will be called - ;; before those user provided. - (append (if (listp info-value) info-value - (list info-value)) - default-value))))) - org-export-filters-alist) + (dolist (p org-export-filters-alist) + (let* ((prop (car p)) + (info-value (plist-get info prop)) + (default-value (symbol-value (cdr p)))) + (setq plist + (plist-put plist prop + ;; Filters in INFO will be called + ;; before those user provided. + (append (if (listp info-value) info-value + (list info-value)) + default-value))))) ;; Prepend back-end specific filters to that list. - (mapc (lambda (p) - ;; Single values get consed, lists are appended. - (let ((key (car p)) (value (cdr p))) - (when value - (setq plist - (plist-put - plist key - (if (atom value) (cons value (plist-get plist key)) - (append value (plist-get plist key)))))))) - (org-export-get-all-filters (plist-get info :back-end))) + (dolist (p (org-export-get-all-filters (plist-get info :back-end))) + ;; Single values get consed, lists are appended. + (let ((key (car p)) (value (cdr p))) + (when value + (setq plist + (plist-put + plist key + (if (atom value) (cons value (plist-get plist key)) + (append value (plist-get plist key)))))))) ;; Return new communication channel. (org-combine-plists info plist))) @@ -2572,17 +2628,14 @@ The function assumes BUFFER's major mode is `org-mode'." (goto-char ,(point)) ;; Overlays with invisible property. ,@(let (ov-set) - (mapc - (lambda (ov) - (let ((invis-prop (overlay-get ov 'invisible))) - (when invis-prop - (push `(overlay-put - (make-overlay ,(overlay-start ov) - ,(overlay-end ov)) - 'invisible (quote ,invis-prop)) - ov-set)))) - (overlays-in (point-min) (point-max))) - ov-set))))) + (dolist (ov (overlays-in (point-min) (point-max)) ov-set) + (let ((invis-prop (overlay-get ov 'invisible))) + (when invis-prop + (push `(overlay-put + (make-overlay ,(overlay-start ov) + ,(overlay-end ov)) + 'invisible (quote ,invis-prop)) + ov-set))))))))) (defun org-export--delete-comments () "Delete commented areas in the buffer. @@ -2598,12 +2651,12 @@ the document. Narrowing, if any, is ignored." comment-re))) (while (re-search-forward regexp nil t) (let ((element (org-element-at-point))) - (case (org-element-type element) - ((headline inlinetask) + (pcase (org-element-type element) + ((or `headline `inlinetask) (when (org-element-property :commentedp element) (delete-region (org-element-property :begin element) (org-element-property :end element)))) - ((comment comment-block) + ((or `comment `comment-block) (let* ((parent (org-element-property :parent element)) (start (org-element-property :begin element)) (end (org-element-property :end element)) @@ -2622,7 +2675,7 @@ the document. Narrowing, if any, is ignored." end) (progn (forward-line -1) - (or (org-looking-at-p "^[ \t]*$") + (or (looking-at-p "^[ \t]*$") (org-with-limited-levels (org-at-heading-p))))))))) (delete-region start end) @@ -2634,33 +2687,47 @@ DATA is the parse tree to traverse. INFO is the plist holding export info. Also set `:ignore-list' in INFO to a list of objects which should be ignored during export, but not removed from tree." - (let* (walk-data - ignore - ;; First find trees containing a select tag, if any. - (selected (org-export--selected-trees data info)) - (walk-data - (lambda (data) - ;; Prune non-exportable elements and objects from tree. - ;; As a special case, special rows and cells from tables - ;; are stored in IGNORE, as they still need to be accessed - ;; during export. - (when data - (let ((type (org-element-type data))) - (if (org-export--skip-p data info selected) - (if (memq type '(table-cell table-row)) (push data ignore) - (org-element-extract-element data)) - (if (and (eq type 'headline) - (eq (plist-get info :with-archived-trees) 'headline) - (org-element-property :archivedp data)) - ;; If headline is archived but tree below has to - ;; be skipped, remove contents. - (org-element-set-contents data) - ;; Move into recursive objects/elements. - (mapc walk-data (org-element-contents data))) - ;; Move into secondary string, if any. - (dolist (p (cdr (assq type - org-element-secondary-value-alist))) - (mapc walk-data (org-element-property p data))))))))) + (letrec ((ignore nil) + ;; First find trees containing a select tag, if any. + (selected (org-export--selected-trees data info)) + (walk-data + (lambda (data) + ;; Prune non-exportable elements and objects from tree. + ;; As a special case, special rows and cells from tables + ;; are stored in IGNORE, as they still need to be + ;; accessed during export. + (when data + (let ((type (org-element-type data))) + (if (org-export--skip-p data info selected) + (if (memq type '(table-cell table-row)) (push data ignore) + (org-element-extract-element data)) + (if (and (eq type 'headline) + (eq (plist-get info :with-archived-trees) + 'headline) + (org-element-property :archivedp data)) + ;; If headline is archived but tree below has + ;; to be skipped, remove contents. + (org-element-set-contents data) + ;; Move into recursive objects/elements. + (mapc walk-data (org-element-contents data))) + ;; Move into secondary string, if any. + (dolist (p (cdr (assq type + org-element-secondary-value-alist))) + (mapc walk-data (org-element-property p data)))))))) + (definitions + ;; Collect definitions before possibly pruning them so as + ;; to avoid parsing them again if they are required. + (org-element-map data '(footnote-definition footnote-reference) + (lambda (f) + (cond + ((eq (org-element-type f) 'footnote-definition) f) + ((eq (org-element-property :type f) 'standard) nil) + (t (let ((label (org-element-property :label f))) + (when label ;Skip anonymous references. + (apply + #'org-element-create + 'footnote-definition `(:label ,label :post-blank 1) + (org-element-contents f)))))))))) ;; If a select tag is active, also ignore the section before the ;; first headline, if any. (when selected @@ -2669,16 +2736,156 @@ from tree." (org-element-extract-element first-element)))) ;; Prune tree and communication channel. (funcall walk-data data) - (dolist (entry - (append - ;; Priority is given to back-end specific options. - (org-export-get-all-options (plist-get info :back-end)) - org-export-options-alist)) + (dolist (entry (append + ;; Priority is given to back-end specific options. + (org-export-get-all-options (plist-get info :back-end)) + org-export-options-alist)) (when (eq (nth 4 entry) 'parse) (funcall walk-data (plist-get info (car entry))))) + (let ((missing (org-export--missing-definitions data definitions))) + (funcall walk-data missing) + (org-export--install-footnote-definitions missing data)) ;; Eventually set `:ignore-list'. (plist-put info :ignore-list ignore))) +(defun org-export--missing-definitions (tree definitions) + "List footnote definitions missing from TREE. +Missing definitions are searched within DEFINITIONS, which is +a list of footnote definitions or in the widened buffer." + (let* ((list-labels + (lambda (data) + ;; List all footnote labels encountered in DATA. Inline + ;; footnote references are ignored. + (org-element-map data 'footnote-reference + (lambda (reference) + (and (eq (org-element-property :type reference) 'standard) + (org-element-property :label reference)))))) + defined undefined missing-definitions) + ;; Partition DIRECT-REFERENCES between DEFINED and UNDEFINED + ;; references. + (let ((known-definitions + (org-element-map tree '(footnote-reference footnote-definition) + (lambda (f) + (and (or (eq (org-element-type f) 'footnote-definition) + (eq (org-element-property :type f) 'inline)) + (org-element-property :label f))))) + seen) + (dolist (l (funcall list-labels tree)) + (cond ((member l seen)) + ((member l known-definitions) (push l defined)) + (t (push l undefined))))) + ;; Complete MISSING-DEFINITIONS by finding the definition of every + ;; undefined label, first by looking into DEFINITIONS, then by + ;; searching the widened buffer. This is a recursive process + ;; since definitions found can themselves contain an undefined + ;; reference. + (while undefined + (let* ((label (pop undefined)) + (definition + (cond + ((cl-some + (lambda (d) (and (equal (org-element-property :label d) label) + d)) + definitions)) + ((pcase (org-footnote-get-definition label) + (`(,_ ,beg . ,_) + (org-with-wide-buffer + (goto-char beg) + (let ((datum (org-element-context))) + (if (eq (org-element-type datum) 'footnote-reference) + datum + ;; Parse definition with contents. + (save-restriction + (narrow-to-region + (org-element-property :begin datum) + (org-element-property :end datum)) + (org-element-map (org-element-parse-buffer) + 'footnote-definition #'identity nil t)))))) + (_ nil))) + (t (user-error "Definition not found for footnote %s" label))))) + (push label defined) + (push definition missing-definitions) + ;; Look for footnote references within DEFINITION, since + ;; we may need to also find their definition. + (dolist (l (funcall list-labels definition)) + (unless (or (member l defined) ;Known label + (member l undefined)) ;Processed later + (push l undefined))))) + ;; MISSING-DEFINITIONS may contain footnote references with inline + ;; definitions. Make sure those are changed into real footnote + ;; definitions. + (mapcar (lambda (d) + (if (eq (org-element-type d) 'footnote-definition) d + (let ((label (org-element-property :label d))) + (apply #'org-element-create + 'footnote-definition `(:label ,label :post-blank 1) + (org-element-contents d))))) + missing-definitions))) + +(defun org-export--install-footnote-definitions (definitions tree) + "Install footnote definitions in tree. + +DEFINITIONS is the list of footnote definitions to install. TREE +is the parse tree. + +If there is a footnote section in TREE, definitions found are +appended to it. If `org-footnote-section' is non-nil, a new +footnote section containing all definitions is inserted in TREE. +Otherwise, definitions are appended at the end of the section +containing their first reference." + (cond + ((null definitions)) + ;; If there is a footnote section, insert definitions there. + ((let ((footnote-section + (org-element-map tree 'headline + (lambda (h) (and (org-element-property :footnote-section-p h) h)) + nil t))) + (and footnote-section + (apply #'org-element-adopt-elements + footnote-section + (nreverse definitions))))) + ;; If there should be a footnote section, create one containing all + ;; the definitions at the end of the tree. + (org-footnote-section + (org-element-adopt-elements + tree + (org-element-create 'headline + (list :footnote-section-p t + :level 1 + :title org-footnote-section) + (apply #'org-element-create + 'section + nil + (nreverse definitions))))) + ;; Otherwise add each definition at the end of the section where it + ;; is first referenced. + (t + (letrec ((seen nil) + (insert-definitions + (lambda (data) + ;; Insert footnote definitions in the same section as + ;; their first reference in DATA. + (org-element-map data 'footnote-reference + (lambda (reference) + (when (eq (org-element-property :type reference) 'standard) + (let ((label (org-element-property :label reference))) + (unless (member label seen) + (push label seen) + (let ((definition + (cl-some + (lambda (d) + (and (equal (org-element-property :label d) + label) + d)) + definitions))) + (org-element-adopt-elements + (org-element-lineage reference '(section)) + definition) + ;; Also insert definitions for nested + ;; references, if any. + (funcall insert-definitions definition)))))))))) + (funcall insert-definitions tree))))) + (defun org-export--remove-uninterpreted-data (data info) "Change uninterpreted elements back into Org syntax. DATA is the parse tree. INFO is a plist containing export @@ -2705,7 +2912,7 @@ returned by the function." subscript superscript underline) (lambda (blob) (let ((new - (case (org-element-type blob) + (cl-case (org-element-type blob) ;; ... entities... (entity (and (not (plist-get info :with-entities)) @@ -2717,7 +2924,7 @@ returned by the function." ;; ... emphasis... ((bold italic strike-through underline) (and (not (plist-get info :with-emphasize)) - (let ((marker (case (org-element-type blob) + (let ((marker (cl-case (org-element-type blob) (bold "*") (italic "/") (strike-through "+") @@ -2762,131 +2969,6 @@ returned by the function." ;; Return modified parse tree. data) -(defun org-export--merge-external-footnote-definitions (tree) - "Insert footnote definitions outside parsing scope in TREE. - -If there is a footnote section in TREE, definitions found are -appended to it. If `org-footnote-section' is non-nil, a new -footnote section containing all definitions is inserted in TREE. -Otherwise, definitions are appended at the end of the section -containing their first reference. - -Only definitions actually referred to within TREE, directly or -not, are considered." - (let* ((collect-labels - (lambda (data) - (org-element-map data 'footnote-reference - (lambda (f) - (and (eq (org-element-property :type f) 'standard) - (org-element-property :label f)))))) - (referenced-labels (funcall collect-labels tree))) - (when referenced-labels - (let* ((definitions) - (push-definition - (lambda (datum) - (case (org-element-type datum) - (footnote-definition - (push (save-restriction - (narrow-to-region (org-element-property :begin datum) - (org-element-property :end datum)) - (org-element-map (org-element-parse-buffer) - 'footnote-definition #'identity nil t)) - definitions)) - (footnote-reference - (let ((label (org-element-property :label datum)) - (cbeg (org-element-property :contents-begin datum))) - (when (and label cbeg - (eq (org-element-property :type datum) 'inline)) - (push - (apply #'org-element-create - 'footnote-definition - (list :label label :post-blank 1) - (org-element-parse-secondary-string - (buffer-substring - cbeg (org-element-property :contents-end datum)) - (org-element-restriction 'footnote-reference))) - definitions)))))))) - ;; Collect all out of scope definitions. - (save-excursion - (goto-char (point-min)) - (org-with-wide-buffer - (while (re-search-backward org-footnote-re nil t) - (funcall push-definition (org-element-context)))) - (goto-char (point-max)) - (org-with-wide-buffer - (while (re-search-forward org-footnote-re nil t) - (funcall push-definition (org-element-context))))) - ;; Filter out definitions referenced neither in the original - ;; tree nor in the external definitions. - (let* ((directly-referenced - (org-remove-if-not - (lambda (d) - (member (org-element-property :label d) referenced-labels)) - definitions)) - (all-labels - (append (funcall collect-labels directly-referenced) - referenced-labels))) - (setq definitions - (org-remove-if-not - (lambda (d) - (member (org-element-property :label d) all-labels)) - definitions))) - ;; Install definitions in subtree. - (cond - ((null definitions)) - ;; If there is a footnote section, insert them here. - ((let ((footnote-section - (org-element-map tree 'headline - (lambda (h) - (and (org-element-property :footnote-section-p h) h)) - nil t))) - (and footnote-section - (apply #'org-element-adopt-elements (nreverse definitions))))) - ;; If there should be a footnote section, create one containing - ;; all the definitions at the end of the tree. - (org-footnote-section - (org-element-adopt-elements - tree - (org-element-create 'headline - (list :footnote-section-p t - :level 1 - :title org-footnote-section) - (apply #'org-element-create - 'section - nil - (nreverse definitions))))) - ;; Otherwise add each definition at the end of the section where - ;; it is first referenced. - (t - (let* ((seen) - (insert-definitions) ; For byte-compiler. - (insert-definitions - (lambda (data) - ;; Insert definitions in the same section as their - ;; first reference in DATA. - (org-element-map tree 'footnote-reference - (lambda (f) - (when (eq (org-element-property :type f) 'standard) - (let ((label (org-element-property :label f))) - (unless (member label seen) - (push label seen) - (let ((definition - (catch 'found - (dolist (d definitions) - (when (equal - (org-element-property :label d) - label) - (setq definitions - (delete d definitions)) - (throw 'found d)))))) - (when definition - (org-element-adopt-elements - (org-element-lineage f '(section)) - definition) - (funcall insert-definitions - definition))))))))))) - (funcall insert-definitions tree)))))))) - ;;;###autoload (defun org-export-as (backend &optional subtreep visible-only body-only ext-plist) @@ -2934,11 +3016,8 @@ Return code as a string." ;; attributes, unavailable in its copy. (let* ((org-export-current-backend (org-export-backend-name backend)) (info (org-combine-plists - (list :export-options - (delq nil - (list (and subtreep 'subtree) - (and visible-only 'visible-only) - (and body-only 'body-only)))) + (org-export--get-export-attributes + backend subtreep visible-only body-only) (org-export--get-buffer-attributes))) (parsed-keywords (delq nil @@ -2963,9 +3042,10 @@ Return code as a string." ;; again after executing Babel code. (org-set-regexps-and-options) (org-update-radio-target-regexp) - (org-export-execute-babel-code) - (org-set-regexps-and-options) - (org-update-radio-target-regexp) + (when org-export-babel-evaluate + (org-babel-exp-process-buffer) + (org-set-regexps-and-options) + (org-update-radio-target-regexp)) ;; Run last hook with current back-end's name as argument. ;; Update buffer properties and radio targets one last time ;; before parsing. @@ -3013,8 +3093,6 @@ Return code as a string." parsed-keywords) ;; Parse buffer. (setq tree (org-element-parse-buffer nil visible-only)) - ;; Merge footnote definitions outside scope into parse tree. - (org-export--merge-external-footnote-definitions tree) ;; Prune tree from non-exported elements and transform ;; uninterpreted elements or objects in both parse tree and ;; communication channel. @@ -3026,9 +3104,7 @@ Return code as a string." (plist-get info :filter-parse-tree) tree info)) ;; Now tree is complete, compute its properties and add them ;; to communication channel. - (setq info - (org-combine-plists - info (org-export-collect-tree-properties tree info))) + (setq info (org-export--collect-tree-properties tree info)) ;; Eventually transcode TREE. Wrap the resulting string into ;; a template. (let* ((body (org-element-normalize-string @@ -3146,7 +3222,7 @@ locally for the subtree through node properties." (< (+ width (length (car items)) 1) fill-column)) (let ((item (pop items))) (insert " " item) - (incf width (1+ (length item)))))) + (cl-incf width (1+ (length item)))))) (insert "\n"))))) ;; Then the rest of keywords, in the order specified in either ;; `org-export-options-alist' or respective export back-ends. @@ -3213,8 +3289,7 @@ storing and resolving footnotes. It is created automatically." (setq matched (replace-match "" nil nil matched 1))) (expand-file-name - (org-remove-double-quotes - matched) + (org-unbracket-string "\"" "\"" matched) dir))) (setq value (replace-match "" nil nil value))))) (only-contents @@ -3228,10 +3303,12 @@ storing and resolving footnotes. It is created automatically." value) (prog1 (match-string 1 value) (setq value (replace-match "" nil nil value))))) - (env (cond ((string-match "\\<example\\>" value) - 'literal) - ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value) - 'literal))) + (env (cond + ((string-match "\\<example\\>" value) 'literal) + ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value) + 'literal) + ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value) + 'literal))) ;; Minimal level of included file defaults to the child ;; level of the current headline, if any, or one. It ;; only applies is the file is meant to be included as @@ -3243,12 +3320,11 @@ storing and resolving footnotes. It is created automatically." (setq value (replace-match "" nil nil value))) (get-text-property (point) :org-include-induced-level)))) - (src-args (and (eq env 'literal) - (match-string 1 value))) + (args (and (eq env 'literal) (match-string 1 value))) (block (and (string-match "\\<\\(\\S-+\\)\\>" value) (match-string 1 value)))) ;; Remove keyword. - (delete-region (point) (progn (forward-line) (point))) + (delete-region (point) (line-beginning-position 2)) (cond ((not file) nil) ((not (file-readable-p file)) @@ -3262,10 +3338,8 @@ storing and resolving footnotes. It is created automatically." (cond ((eq env 'literal) (insert - (let ((ind-str (make-string ind ? )) - (arg-str (if (stringp src-args) - (format " %s" src-args) - "")) + (let ((ind-str (make-string ind ?\s)) + (arg-str (if (stringp args) (format " %s" args) "")) (contents (org-escape-code-in-string (org-export--prepare-file-contents file lines)))) @@ -3273,7 +3347,7 @@ storing and resolving footnotes. It is created automatically." ind-str block arg-str contents ind-str block)))) ((stringp block) (insert - (let ((ind-str (make-string ind ? )) + (let ((ind-str (make-string ind ?\s)) (contents (org-export--prepare-file-contents file lines))) (format "%s#+BEGIN_%s\n%s%s#+END_%s\n" @@ -3292,7 +3366,7 @@ storing and resolving footnotes. It is created automatically." (org-export--prepare-file-contents file lines ind minlevel (or (gethash file file-prefix) - (puthash file (incf current-prefix) file-prefix)) + (puthash file (cl-incf current-prefix) file-prefix)) footnotes))) (org-export-expand-include-keyword (cons (list file lines) included) @@ -3304,7 +3378,7 @@ storing and resolving footnotes. It is created automatically." (unless included (org-with-wide-buffer (goto-char (point-max)) - (maphash (lambda (k v) (insert (format "\n[%s] %s\n" k v))) + (maphash (lambda (k v) (insert (format "\n[fn:%s] %s\n" k v))) footnotes))))))))))) (defun org-export--inclusion-absolute-lines (file location only-contents lines) @@ -3338,7 +3412,7 @@ Return a string of lines to be included in the format expected by (memq (org-element-type element) '(headline inlinetask))) ;; Skip planning line and property-drawer. (goto-char (point-min)) - (when (org-looking-at-p org-planning-line-re) (forward-line)) + (when (looking-at-p org-planning-line-re) (forward-line)) (when (looking-at org-property-drawer-re) (goto-char (match-end 0))) (unless (bolp) (forward-line)) (narrow-to-region (point) (point-max)))) @@ -3366,7 +3440,7 @@ Return a string of lines to be included in the format expected by (save-excursion (+ start-line (let ((counter 0)) - (while (< (point) end) (incf counter) (forward-line)) + (while (< (point) end) (cl-incf counter) (forward-line)) counter)))))))) (defun org-export--prepare-file-contents @@ -3425,7 +3499,7 @@ the included document." (unless (eq major-mode 'org-mode) (let ((org-inhibit-startup t)) (org-mode))) (goto-char (point-min)) - (let ((ind-str (make-string ind ? ))) + (let ((ind-str (make-string ind ?\s))) (while (not (or (eobp) (looking-at org-outline-regexp-bol))) ;; Do not move footnote definitions out of column 0. (unless (and (looking-at org-footnote-definition-re) @@ -3461,17 +3535,14 @@ the included document." (marker-max (point-max-marker)) (get-new-label (lambda (label) - ;; Generate new label from LABEL. If LABEL is akin to - ;; [1] convert it to [fn:--ID-1]. Otherwise add "-ID-" - ;; after "fn:". - (if (org-string-match-p "\\`[0-9]+\\'" label) - (format "fn:--%d-%s" id label) - (format "fn:-%d-%s" id (substring label 3))))) + ;; Generate new label from LABEL by prefixing it with + ;; "-ID-". + (format "-%d-%s" id label))) (set-new-label (lambda (f old new) ;; Replace OLD label with NEW in footnote F. (save-excursion - (goto-char (1+ (org-element-property :begin f))) + (goto-char (+ (org-element-property :begin f) 4)) (looking-at (regexp-quote old)) (replace-match new)))) (seen-alist)) @@ -3507,14 +3578,6 @@ the included document." (set-marker marker-max nil))) (org-element-normalize-string (buffer-string)))) -(defun org-export-execute-babel-code () - "Execute every Babel code in the visible part of current buffer." - ;; Get a pristine copy of current buffer so Babel references can be - ;; properly resolved. - (let ((reference (org-export-copy-buffer))) - (unwind-protect (org-babel-exp-process-buffer reference) - (kill-buffer reference)))) - (defun org-export--copy-to-kill-ring-p () "Return a non-nil value when output should be added to the kill ring. See also `org-export-copy-to-kill-ring'." @@ -3666,16 +3729,28 @@ definition can be found, raise an error." (let ((hash (make-hash-table :test #'equal))) (plist-put info :footnote-definition-cache hash) hash)))) - (or (gethash label cache) - (puthash label - (org-element-map (plist-get info :parse-tree) - '(footnote-definition footnote-reference) - (lambda (f) - (and (equal (org-element-property :label f) label) - (org-element-contents f))) - info t) - cache) - (error "Definition not found for footnote %s" label)))))) + (or + (gethash label cache) + (puthash label + (org-element-map (plist-get info :parse-tree) + '(footnote-definition footnote-reference) + (lambda (f) + (cond + ;; Skip any footnote with a different label. + ;; Also skip any standard footnote reference + ;; with the same label since those cannot + ;; contain a definition. + ((not (equal (org-element-property :label f) label)) nil) + ((eq (org-element-property :type f) 'standard) nil) + ((org-element-contents f)) + ;; Even if the contents are empty, we can not + ;; return nil since that would eventually raise + ;; the error. Instead, return the equivalent + ;; empty string. + (t ""))) + info t) + cache) + (error "Definition not found for footnote %s" label)))))) (defun org-export--footnote-reference-map (function data info &optional body-first) @@ -3684,41 +3759,41 @@ INFO is a plist containing export state. By default, as soon as a new footnote reference is encountered, FUNCTION is called onto its definition. However, if BODY-FIRST is non-nil, this step is delayed until the end of the process." - (let* ((definitions) - (seen-refs) - (search-ref) ; For byte-compiler. - (search-ref - (lambda (data delayp) - ;; Search footnote references through DATA, filling - ;; SEEN-REFS along the way. When DELAYP is non-nil, store - ;; footnote definitions so they can be entered later. - (org-element-map data 'footnote-reference - (lambda (f) - (funcall function f) - (let ((--label (org-element-property :label f))) - (unless (and --label (member --label seen-refs)) - (when --label (push --label seen-refs)) - ;; Search for subsequent references in footnote - ;; definition so numbering follows reading logic, - ;; unless DELAYP in non-nil. - (cond - (delayp - (push (org-export-get-footnote-definition f info) - definitions)) - ;; Do not force entering inline definitions, - ;; since `org-element-map' already traverses them - ;; at the right time. - ((eq (org-element-property :type f) 'inline)) - (t (funcall search-ref - (org-export-get-footnote-definition f info) - nil)))))) - info nil - ;; Don't enter footnote definitions since it will happen - ;; when their first reference is found. Moreover, if - ;; DELAYP is non-nil, make sure we postpone entering - ;; definitions of inline references. - (if delayp '(footnote-definition footnote-reference) - 'footnote-definition))))) + (letrec ((definitions nil) + (seen-refs nil) + (search-ref + (lambda (data delayp) + ;; Search footnote references through DATA, filling + ;; SEEN-REFS along the way. When DELAYP is non-nil, + ;; store footnote definitions so they can be entered + ;; later. + (org-element-map data 'footnote-reference + (lambda (f) + (funcall function f) + (let ((--label (org-element-property :label f))) + (unless (and --label (member --label seen-refs)) + (when --label (push --label seen-refs)) + ;; Search for subsequent references in footnote + ;; definition so numbering follows reading + ;; logic, unless DELAYP in non-nil. + (cond + (delayp + (push (org-export-get-footnote-definition f info) + definitions)) + ;; Do not force entering inline definitions, + ;; since `org-element-map' already traverses + ;; them at the right time. + ((eq (org-element-property :type f) 'inline)) + (t (funcall search-ref + (org-export-get-footnote-definition f info) + nil)))))) + info nil + ;; Don't enter footnote definitions since it will + ;; happen when their first reference is found. + ;; Moreover, if DELAYP is non-nil, make sure we + ;; postpone entering definitions of inline references. + (if delayp '(footnote-definition footnote-reference) + 'footnote-definition))))) (funcall search-ref data body-first) (funcall search-ref (nreverse definitions) nil))) @@ -3744,7 +3819,7 @@ for inlined footnotes. Unreferenced definitions are ignored." ;; Collect footnote number, label and definition. (let ((l (org-element-property :label f))) (unless (and l (member l labels)) - (incf n) + (cl-incf n) (push (list n l (org-export-get-footnote-definition f info)) alist)) (when l (push l labels)))) (or data (plist-get info :parse-tree)) info body-first) @@ -3803,8 +3878,8 @@ process, leading to a different order when footnotes are nested." ((and label l (string= label l)) (throw 'exit (1+ count))) ;; Otherwise store label and increase counter if label ;; wasn't encountered yet. - ((not l) (incf count)) - ((not (member l seen)) (push l seen) (incf count))))) + ((not l) (cl-incf count)) + ((not (member l seen)) (push l seen) (cl-incf count))))) (or data (plist-get info :parse-tree)) info body-first)))) @@ -3861,7 +3936,7 @@ INFO is a plist holding contextual information." (defun org-export-numbered-headline-p (headline info) "Return a non-nil value if HEADLINE element should be numbered. INFO is a plist used as a communication channel." - (unless (org-some + (unless (cl-some (lambda (head) (org-not-nil (org-element-property :UNNUMBERED head))) (org-element-lineage headline nil t)) (let ((sec-num (plist-get info :section-numbers)) @@ -3890,18 +3965,13 @@ INFO is a plist used as a communication channel." ELEMENT has either an `headline' or an `inlinetask' type. INFO is a plist used as a communication channel. -Select tags (see `org-export-select-tags') and exclude tags (see -`org-export-exclude-tags') are removed from the list. - When non-nil, optional argument TAGS should be a list of strings. Any tag belonging to this list will also be removed. When optional argument INHERITED is non-nil, tags can also be inherited from parent headlines and FILETAGS keywords." - (org-remove-if - (lambda (tag) (or (member tag (plist-get info :select-tags)) - (member tag (plist-get info :exclude-tags)) - (member tag tags))) + (cl-remove-if + (lambda (tag) (member tag tags)) (if (not inherited) (org-element-property :tags element) ;; Build complete list of inherited tags. (let ((current-tag-list (org-element-property :tags element))) @@ -3926,7 +3996,7 @@ Return value is a string or nil." (let ((headline (if (eq (org-element-type blob) 'headline) blob (org-export-get-parent-headline blob)))) (if (not inherited) (org-element-property property blob) - (let ((parent headline) value) + (let ((parent headline)) (catch 'found (while parent (when (plist-member (nth 1 parent) property) @@ -3951,10 +4021,9 @@ fail, the fall-back value is \"???\"." (and file (file-name-sans-extension (file-name-nondirectory file)))) "???")) -(defun org-export-get-alt-title (headline info) +(defun org-export-get-alt-title (headline _) "Return alternative title for HEADLINE, as a secondary string. -INFO is a plist used as a communication channel. If no optional -title is defined, fall-back to the regular title." +If no optional title is defined, fall-back to the regular title." (let ((alt (org-element-property :ALT_TITLE headline))) (if alt (org-element-parse-secondary-string alt (org-element-restriction 'headline) headline) @@ -4004,7 +4073,7 @@ meant to be translated with `org-export-data' or alike." ;;;; For Links ;; ;; `org-export-custom-protocol-maybe' handles custom protocol defined -;; with `org-add-link-type', which see. +;; in `org-link-parameters'. ;; ;; `org-export-get-coderef-format' returns an appropriate format ;; string for coderefs. @@ -4014,11 +4083,11 @@ meant to be translated with `org-export-data' or alike." ;; ;; `org-export-resolve-fuzzy-link' searches destination of fuzzy links ;; (i.e. links with "fuzzy" as type) within the parsed tree, and -;; returns an appropriate unique identifier when found, or nil. +;; returns an appropriate unique identifier. ;; ;; `org-export-resolve-id-link' returns the first headline with ;; specified id or custom-id in parse tree, the path to the external -;; file with the id or nil when neither was found. +;; file with the id. ;; ;; `org-export-resolve-coderef' associates a reference to a line ;; number in the element it belongs, or returns the reference itself @@ -4026,6 +4095,12 @@ meant to be translated with `org-export-data' or alike." ;; ;; `org-export-file-uri' expands a filename as stored in :path value ;; of a "file" link into a file URI. +;; +;; Broken links raise a `org-link-broken' error, which is caught by +;; `org-export-data' for further processing, depending on +;; `org-export-with-broken-links' value. + +(org-define-error 'org-link-broken "Unable to resolve link; aborting") (defun org-export-custom-protocol-maybe (link desc backend) "Try exporting LINK with a dedicated function. @@ -4041,7 +4116,7 @@ The function ignores links with an implicit type (e.g., (let ((type (org-element-property :type link))) (unless (or (member type '("coderef" "custom-id" "fuzzy" "radio")) (not backend)) - (let ((protocol (nth 2 (assoc type org-link-protocols)))) + (let ((protocol (org-link-get-parameter type :export))) (and (functionp protocol) (funcall protocol (org-link-unescape (org-element-property :path link)) @@ -4076,8 +4151,8 @@ This only applies to links without a description." (catch 'exit (dolist (rule (or rules org-export-default-inline-image-rule)) (and (string= (org-element-property :type link) (car rule)) - (org-string-match-p (cdr rule) - (org-element-property :path link)) + (string-match-p (cdr rule) + (org-element-property :path link)) (throw 'exit t))))))) (defun org-export-resolve-coderef (ref info) @@ -4103,11 +4178,69 @@ error if no block contains REF." (when (re-search-backward ref-re nil t) (cond ((org-element-property :use-labels el) ref) - ((eq (org-element-property :number-lines el) 'continued) - (+ (org-export-get-loc el info) (line-number-at-pos))) - (t (line-number-at-pos))))))) + (t (+ (or (org-export-get-loc el info) 0) (line-number-at-pos)))))))) info 'first-match) - (user-error "Unable to resolve code reference: %s" ref))) + (signal 'org-link-broken (list ref)))) + +(defun org-export-search-cells (datum) + "List search cells for element or object DATUM. + +A search cell follows the pattern (TYPE . SEARCH) where + + TYPE is a symbol among `headline', `custom-id', `target' and + `other'. + + SEARCH is the string a link is expected to match. More + accurately, it is + + - headline's title, as a list of strings, if TYPE is + `headline'. + + - CUSTOM_ID value, as a string, if TYPE is `custom-id'. + + - target's or radio-target's name as a list of strings if + TYPE is `target'. + + - NAME affiliated keyword is TYPE is `other'. + +A search cell is the internal representation of a fuzzy link. It +ignores white spaces and statistics cookies, if applicable." + (pcase (org-element-type datum) + (`headline + (let ((title (split-string + (replace-regexp-in-string + "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" "" + (org-element-property :raw-value datum))))) + (delq nil + (list + (cons 'headline title) + (cons 'other title) + (let ((custom-id (org-element-property :custom-id datum))) + (and custom-id (cons 'custom-id custom-id))))))) + (`target + (list (cons 'target (split-string (org-element-property :value datum))))) + ((and (let name (org-element-property :name datum)) + (guard name)) + (list (cons 'other (split-string name)))) + (_ nil))) + +(defun org-export-string-to-search-cell (s) + "Return search cells associated to string S. +S is either the path of a fuzzy link or a search option, i.e., it +tries to match either a headline (through custom ID or title), +a target or a named element." + (pcase (string-to-char s) + (?* (list (cons 'headline (split-string (substring s 1))))) + (?# (list (cons 'custom-id (substring s 1)))) + ((let search (split-string s)) + (list (cons 'target search) (cons 'other search))))) + +(defun org-export-match-search-cell-p (datum cells) + "Non-nil when DATUM matches search cells CELLS. +DATUM is an element or object. CELLS is a list of search cells, +as returned by `org-export-search-cells'." + (let ((targets (org-export-search-cells datum))) + (and targets (cl-some (lambda (cell) (member cell targets)) cells)))) (defun org-export-resolve-fuzzy-link (link info) "Return LINK destination. @@ -4128,54 +4261,37 @@ Return value can be an object or an element: Assume LINK type is \"fuzzy\". White spaces are not significant." - (let* ((raw-path (org-link-unescape (org-element-property :path link))) - (headline-only (eq (string-to-char raw-path) ?*)) - ;; Split PATH at white spaces so matches are space - ;; insensitive. - (path (org-split-string - (if headline-only (substring raw-path 1) raw-path))) + (let* ((search-cells (org-export-string-to-search-cell + (org-link-unescape (org-element-property :path link)))) (link-cache (or (plist-get info :resolve-fuzzy-link-cache) (plist-get (plist-put info :resolve-fuzzy-link-cache (make-hash-table :test #'equal)) :resolve-fuzzy-link-cache))) - (cached (gethash path link-cache 'not-found))) + (cached (gethash search-cells link-cache 'not-found))) (if (not (eq cached 'not-found)) cached - (let ((ast (plist-get info :parse-tree))) + (let ((matches + (org-element-map (plist-get info :parse-tree) + (cons 'target org-element-all-elements) + (lambda (datum) + (and (org-export-match-search-cell-p datum search-cells) + datum))))) + (unless matches + (signal 'org-link-broken + (list (org-element-property :raw-path link)))) (puthash - path - (cond - ;; First try to find a matching "<<path>>" unless user - ;; specified he was looking for a headline (path starts with - ;; a "*" character). - ((and (not headline-only) - (org-element-map ast 'target - (lambda (datum) - (and (equal (org-split-string - (org-element-property :value datum)) - path) - datum)) - info 'first-match))) - ;; Then try to find an element with a matching "#+NAME: path" - ;; affiliated keyword. - ((and (not headline-only) - (org-element-map ast org-element-all-elements - (lambda (datum) - (let ((name (org-element-property :name datum))) - (and name (equal (org-split-string name) path) datum))) - info 'first-match))) - ;; Try to find a matching headline. - ((org-element-map ast 'headline - (lambda (h) - (and (equal (org-split-string - (replace-regexp-in-string - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" - (org-element-property :raw-value h))) - path) - h)) - info 'first-match)) - (t (user-error "Unable to resolve link \"%s\"" raw-path))) + search-cells + ;; There can be multiple matches for un-typed searches, i.e., + ;; for searches not starting with # or *. In this case, + ;; prioritize targets and names over headline titles. + ;; Matching both a name and a target is not valid, and + ;; therefore undefined. + (or (cl-some (lambda (datum) + (and (not (eq (org-element-type datum) 'headline)) + datum)) + matches) + (car matches)) link-cache))))) (defun org-export-resolve-id-link (link info) @@ -4196,7 +4312,7 @@ tree or a file name. Assume LINK type is either \"id\" or info 'first-match) ;; Otherwise, look for external files. (cdr (assoc id (plist-get info :id-alist))) - (user-error "Unable to resolve ID \"%s\"" id)))) + (signal 'org-link-broken (list id))))) (defun org-export-resolve-radio-link (link info) "Return radio-target object referenced as LINK destination. @@ -4219,7 +4335,7 @@ has type \"radio\"." (defun org-export-file-uri (filename) "Return file URI associated to FILENAME." - (cond ((org-string-match-p "\\`//" filename) (concat "file:" filename)) + (cond ((string-match-p "\\`//" filename) (concat "file:" filename)) ((not (file-name-absolute-p filename)) filename) ((org-file-remote-p filename) (concat "file:/" filename)) (t (concat "file://" (expand-file-name filename))))) @@ -4228,29 +4344,63 @@ has type \"radio\"." ;;;; For References ;; ;; `org-export-get-reference' associate a unique reference for any -;; object or element. +;; object or element. It uses `org-export-new-reference' and +;; `org-export-format-reference' to, respectively, generate new +;; internal references and turn them into a string suitable for +;; output. ;; ;; `org-export-get-ordinal' associates a sequence number to any object ;; or element. +(defun org-export-new-reference (references) + "Return a unique reference, among REFERENCES. +REFERENCES is an alist whose values are in-use references, as +numbers. Returns a number, which is the internal representation +of a reference. See also `org-export-format-reference'." + ;; Generate random 7 digits hexadecimal numbers. Collisions + ;; increase exponentially with the numbers of references. However, + ;; the odds for encountering at least one collision with 1000 active + ;; references in the same document are roughly 0.2%, so this + ;; shouldn't be the bottleneck. + (let ((new (random #x10000000))) + (while (rassq new references) (setq new (random #x10000000))) + new)) + +(defun org-export-format-reference (reference) + "Format REFERENCE into a string. +REFERENCE is a number representing a reference, as returned by +`org-export-new-reference', which see." + (format "org%07x" reference)) + (defun org-export-get-reference (datum info) "Return a unique reference for DATUM, as a string. + DATUM is either an element or an object. INFO is the current -export state, as a plist. Returned reference consists of -alphanumeric characters only." - (let ((type (org-element-type datum)) - (cache (or (plist-get info :internal-references) - (let ((h (make-hash-table :test #'eq))) - (plist-put info :internal-references h) - h)))) - (or (gethash datum cache) - (puthash datum - (format "org%s%d" - (if type - (replace-regexp-in-string "-" "" (symbol-name type)) - "secondarystring") - (incf (gethash type cache 0))) - cache)))) +export state, as a plist. + +This function checks `:crossrefs' property in INFO for search +cells matching DATUM before creating a new reference. Returned +reference consists of alphanumeric characters only." + (let ((cache (plist-get info :internal-references))) + (or (car (rassq datum cache)) + (let* ((crossrefs (plist-get info :crossrefs)) + (cells (org-export-search-cells datum)) + ;; If any other published document relies on an + ;; association between a search cell and a reference, + ;; make sure to preserve it. See + ;; `org-publish-resolve-external-link' for details. + (new (or (cdr (cl-some (lambda (c) (assoc c crossrefs)) cells)) + (org-export-new-reference cache))) + (reference-string (org-export-format-reference new))) + ;; Cache contains both data already associated to + ;; a reference and in-use internal references, so as to make + ;; unique references. + (dolist (cell cells) (push (cons cell new) cache)) + ;; Keep an associated related to DATUM as not every object + ;; and element can be associated to a search cell. + (push (cons reference-string datum) cache) + (plist-put info :internal-references cache) + reference-string)))) (defun org-export-get-ordinal (element info &optional types predicate) "Return ordinal number of an element or object. @@ -4282,7 +4432,7 @@ objects of the same type." (org-element-lineage element '(footnote-definition footnote-reference headline item table)))) - (case (org-element-type element) + (cl-case (org-element-type element) ;; Special case 1: A headline returns its number as a list. (headline (org-export-get-headline-number element info)) ;; Special case 2: An item returns its number as a list. @@ -4302,8 +4452,8 @@ objects of the same type." (lambda (el) (cond ((eq element el) (1+ counter)) - ((not predicate) (incf counter) nil) - ((funcall predicate el info) (incf counter) nil))) + ((not predicate) (cl-incf counter) nil) + ((funcall predicate el info) (cl-incf counter) nil))) info 'first-match))))) @@ -4330,32 +4480,34 @@ objects of the same type." ;; code in a format suitable for plain text or verbatim output. (defun org-export-get-loc (element info) - "Return accumulated lines of code up to ELEMENT. - -INFO is the plist used as a communication channel. - -ELEMENT is excluded from count." - (let ((loc 0)) - (org-element-map (plist-get info :parse-tree) - `(src-block example-block ,(org-element-type element)) - (lambda (el) - (cond - ;; ELEMENT is reached: Quit the loop. - ((eq el element)) - ;; Only count lines from src-block and example-block elements - ;; with a "+n" or "-n" switch. A "-n" switch resets counter. - ((not (memq (org-element-type el) '(src-block example-block))) nil) - ((let ((linums (org-element-property :number-lines el))) - (when linums - ;; Accumulate locs or reset them. - (let ((lines (org-count-lines - (org-trim (org-element-property :value el))))) - (setq loc (if (eq linums 'new) lines (+ loc lines)))))) - ;; Return nil to stay in the loop. - nil))) - info 'first-match) - ;; Return value. - loc)) + "Return count of lines of code before ELEMENT. + +ELEMENT is an example-block or src-block element. INFO is the +plist used as a communication channel. + +Count includes every line of code in example-block or src-block +with a \"+n\" or \"-n\" switch before block. Return nil if +ELEMENT doesn't allow line numbering." + (pcase (org-element-property :number-lines element) + (`(new . ,n) n) + (`(continued . ,n) + (let ((loc 0)) + (org-element-map (plist-get info :parse-tree) '(src-block example-block) + (lambda (el) + ;; ELEMENT is reached: Quit loop and return locs. + (if (eq el element) (+ loc n) + ;; Only count lines from src-block and example-block + ;; elements with a "+n" or "-n" switch. + (let ((linum (org-element-property :number-lines el))) + (when linum + (let ((lines (org-count-lines + (org-trim (org-element-property :value el))))) + ;; Accumulate locs or reset them. + (pcase linum + (`(new . ,n) (setq loc (+ n lines))) + (`(continued . ,n) (cl-incf loc (+ n lines))))))) + nil)) ;Return nil to stay in the loop. + info 'first-match))))) (defun org-export-unravel-code (element) "Clean source code and extract references out of it. @@ -4377,24 +4529,17 @@ reference on that line (string)." (if (or org-src-preserve-indentation (org-element-property :preserve-indent element)) value - (org-element-remove-indentation value))))) - ;; Get format used for references. - (label-fmt (regexp-quote - (or (org-element-property :label-fmt element) - org-coderef-label-format))) + (org-remove-indentation value))))) ;; Build a regexp matching a loc with a reference. - (with-ref-re - (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$" - (replace-regexp-in-string - "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t)))) + (ref-re (org-src-coderef-regexp (org-src-coderef-format element)))) ;; Return value. (cons ;; Code with references removed. (org-element-normalize-string (mapconcat (lambda (loc) - (incf line) - (if (not (string-match with-ref-re loc)) loc + (cl-incf line) + (if (not (string-match ref-re loc)) loc ;; Ref line: remove ref, and signal its position in REFS. (push (cons line (match-string 3 loc)) refs) (replace-match "" nil nil loc 1))) @@ -4426,7 +4571,7 @@ be nil. It can be obtained through the use of (org-element-normalize-string (mapconcat (lambda (--loc) - (incf --line) + (cl-incf --line) (let ((--ref (cdr (assq --line ref-alist)))) (funcall fun --loc (and num-lines (+ num-lines --line)) --ref))) --locs "\n")))) @@ -4451,9 +4596,7 @@ code." (let* ((refs (and (org-element-property :retain-labels element) (cdr code-info))) ;; Handle line numbering. - (num-start (case (org-element-property :number-lines element) - (continued (org-export-get-loc element info)) - (new 0))) + (num-start (org-export-get-loc element info)) (num-fmt (and num-start (format "%%%ds " @@ -4517,16 +4660,14 @@ All special columns will be ignored during export." ;; only empty cells as special. (let ((special-column-p 'empty)) (catch 'exit - (mapc - (lambda (row) - (when (eq (org-element-property :type row) 'standard) - (let ((value (org-element-contents - (car (org-element-contents row))))) - (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) - (setq special-column-p 'special)) - ((not value)) - (t (throw 'exit nil)))))) - (org-element-contents table)) + (dolist (row (org-element-contents table)) + (when (eq (org-element-property :type row) 'standard) + (let ((value (org-element-contents + (car (org-element-contents row))))) + (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) + (setq special-column-p 'special)) + ((not value)) + (t (throw 'exit nil)))))) (eq special-column-p 'special)))) (defun org-export-table-has-header-p (table info) @@ -4549,18 +4690,15 @@ A table has a header when it contains at least two row groups." (cond ((> rowgroup 1) t) ((and row-flag (eq (org-element-property :type row) 'rule)) - (incf rowgroup) (setq row-flag nil)) + (cl-incf rowgroup) (setq row-flag nil)) ((and (not row-flag) (eq (org-element-property :type row) 'standard)) (setq row-flag t) nil))) info 'first-match) cache))))) -(defun org-export-table-row-is-special-p (table-row info) +(defun org-export-table-row-is-special-p (table-row _) "Non-nil if TABLE-ROW is considered special. - -INFO is a plist used as the communication channel. - All special rows will be ignored during export." (when (eq (org-element-property :type table-row) 'standard) (let ((first-cell (org-element-contents @@ -4577,19 +4715,17 @@ All special rows will be ignored during export." ;; ... it contains only alignment cookies and empty cells. (let ((special-row-p 'empty)) (catch 'exit - (mapc - (lambda (cell) - (let ((value (org-element-contents cell))) - ;; Since VALUE is a secondary string, the following - ;; checks avoid expanding it with `org-export-data'. - (cond ((not value)) - ((and (not (cdr value)) - (stringp (car value)) - (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" - (car value))) - (setq special-row-p 'cookie)) - (t (throw 'exit nil))))) - (org-element-contents table-row)) + (dolist (cell (org-element-contents table-row)) + (let ((value (org-element-contents cell))) + ;; Since VALUE is a secondary string, the following + ;; checks avoid expanding it with `org-export-data'. + (cond ((not value)) + ((and (not (cdr value)) + (stringp (car value)) + (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" + (car value))) + (setq special-row-p 'cookie)) + (t (throw 'exit nil))))) (eq special-row-p 'cookie))))))) (defun org-export-table-row-group (table-row info) @@ -4612,7 +4748,7 @@ header." (lambda (row) (if (eq (org-element-property :type row) 'rule) (setq row-flag nil) - (unless row-flag (incf group) (setq row-flag t))) + (unless row-flag (cl-incf group) (setq row-flag t))) (when (eq table-row row) (puthash table-row group cache))) info 'first-match)))))) @@ -4712,14 +4848,14 @@ Possible values are `left', `right' and `center'." (org-element-contents (elt (org-element-contents row) column)) info))) - (incf total-cells) + (cl-incf total-cells) ;; Treat an empty cell as a number if it follows ;; a number. (if (not (or (string-match org-table-number-regexp value) (and (string= value "") previous-cell-number-p))) (setq previous-cell-number-p nil) (setq previous-cell-number-p t) - (incf number-cells)))))) + (cl-incf number-cells)))))) ;; Return value. Alignment specified by cookies has ;; precedence over alignment deduced from cell's contents. (aset align-vector @@ -4752,14 +4888,13 @@ Returned borders ignore special rows." ;; another regular row has to be found above that rule. (let (rule-flag) (catch 'exit - (mapc (lambda (row) - (cond ((eq (org-element-property :type row) 'rule) - (setq rule-flag t)) - ((not (org-export-table-row-is-special-p row info)) - (if rule-flag (throw 'exit (push 'above borders)) - (throw 'exit nil))))) - ;; Look at every row before the current one. - (cdr (memq row (reverse (org-element-contents table))))) + ;; Look at every row before the current one. + (dolist (row (cdr (memq row (reverse (org-element-contents table))))) + (cond ((eq (org-element-property :type row) 'rule) + (setq rule-flag t)) + ((not (org-export-table-row-is-special-p row info)) + (if rule-flag (throw 'exit (push 'above borders)) + (throw 'exit nil))))) ;; No rule above, or rule found starts the table (ignoring any ;; special row): TABLE-CELL is at the top of the table. (when rule-flag (push 'above borders)) @@ -4768,14 +4903,13 @@ Returned borders ignore special rows." ;; non-regular row below is a rule. (let (rule-flag) (catch 'exit - (mapc (lambda (row) - (cond ((eq (org-element-property :type row) 'rule) - (setq rule-flag t)) - ((not (org-export-table-row-is-special-p row info)) - (if rule-flag (throw 'exit (push 'below borders)) - (throw 'exit nil))))) - ;; Look at every row after the current one. - (cdr (memq row (org-element-contents table)))) + ;; Look at every row after the current one. + (dolist (row (cdr (memq row (org-element-contents table)))) + (cond ((eq (org-element-property :type row) 'rule) + (setq rule-flag t)) + ((not (org-export-table-row-is-special-p row info)) + (if rule-flag (throw 'exit (push 'below borders)) + (throw 'exit nil))))) ;; No rule below, or rule found ends the table (modulo some ;; special row): TABLE-CELL is at the bottom of the table. (when rule-flag (push 'below borders)) @@ -4787,37 +4921,35 @@ Returned borders ignore special rows." (catch 'exit (let ((column (let ((cells (org-element-contents row))) (- (length cells) (length (memq table-cell cells)))))) - (mapc - (lambda (row) - (unless (eq (org-element-property :type row) 'rule) - (when (equal (org-element-contents - (car (org-element-contents row))) - '("/")) - (let ((column-groups - (mapcar - (lambda (cell) - (let ((value (org-element-contents cell))) - (when (member value '(("<") ("<>") (">") nil)) - (car value)))) - (org-element-contents row)))) - ;; There's a left border when previous cell, if - ;; any, ends a group, or current one starts one. - (when (or (and (not (zerop column)) - (member (elt column-groups (1- column)) - '(">" "<>"))) - (member (elt column-groups column) '("<" "<>"))) - (push 'left borders)) - ;; There's a right border when next cell, if any, - ;; starts a group, or current one ends one. - (when (or (and (/= (1+ column) (length column-groups)) - (member (elt column-groups (1+ column)) - '("<" "<>"))) - (member (elt column-groups column) '(">" "<>"))) - (push 'right borders)) - (throw 'exit nil))))) - ;; Table rows are read in reverse order so last column groups - ;; row has precedence over any previous one. - (reverse (org-element-contents table))))) + ;; Table rows are read in reverse order so last column groups + ;; row has precedence over any previous one. + (dolist (row (reverse (org-element-contents table))) + (unless (eq (org-element-property :type row) 'rule) + (when (equal (org-element-contents + (car (org-element-contents row))) + '("/")) + (let ((column-groups + (mapcar + (lambda (cell) + (let ((value (org-element-contents cell))) + (when (member value '(("<") ("<>") (">") nil)) + (car value)))) + (org-element-contents row)))) + ;; There's a left border when previous cell, if + ;; any, ends a group, or current one starts one. + (when (or (and (not (zerop column)) + (member (elt column-groups (1- column)) + '(">" "<>"))) + (member (elt column-groups column) '("<" "<>"))) + (push 'left borders)) + ;; There's a right border when next cell, if any, + ;; starts a group, or current one ends one. + (when (or (and (/= (1+ column) (length column-groups)) + (member (elt column-groups (1+ column)) + '("<" "<>"))) + (member (elt column-groups column) '(">" "<>"))) + (push 'right borders)) + (throw 'exit nil))))))) ;; Return value. borders)) @@ -4892,7 +5024,7 @@ special columns and separators." (lambda (row) (cond ((eq row table-row) number) ((eq (org-element-property :type row) 'standard) - (incf number) nil))) + (cl-incf number) nil))) info 'first-match)))) (defun org-export-table-dimensions (table info) @@ -4908,10 +5040,10 @@ rows (resp. columns)." (org-element-map table 'table-row (lambda (row) (when (eq (org-element-property :type row) 'standard) - (incf rows) + (cl-incf rows) (unless first-row (setq first-row row)))) info) ;; Set number of columns. - (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info) + (org-element-map first-row 'table-cell (lambda (_) (cl-incf columns)) info) ;; Return value. (cons rows columns))) @@ -4931,7 +5063,7 @@ function returns nil for other cells." (let ((col-count 0)) (org-element-map table-row 'table-cell (lambda (cell) - (if (eq cell table-cell) col-count (incf col-count) nil)) + (if (eq cell table-cell) col-count (cl-incf col-count) nil)) info 'first-match)))))) (defun org-export-get-table-cell-at (address table info) @@ -4951,12 +5083,12 @@ return nil." (lambda (row) (cond ((eq (org-element-property :type row) 'rule) nil) ((= row-count row-pos) row) - (t (incf row-count) nil))) + (t (cl-incf row-count) nil))) info 'first-match)) 'table-cell (lambda (cell) (if (= column-count column-pos) cell - (incf column-count) nil)) + (cl-incf column-count) nil)) info 'first-match))) @@ -5064,10 +5196,6 @@ Return a list of src-block elements with a caption." ;; ;; Dictionary for smart quotes is stored in ;; `org-export-smart-quotes-alist'. -;; -;; Internally, regexps matching potential smart quotes (checks at -;; string boundaries are also necessary) are defined in -;; `org-export-smart-quotes-regexps'. (defconst org-export-smart-quotes-alist '(("da" @@ -5122,6 +5250,16 @@ Return a list of src-block elements with a caption." (secondary-closing :utf-8 " »" :html " »" :latex "\\fg{}" :texinfo "@tie{}@guillemetright{}") (apostrophe :utf-8 "’" :html "’")) + ("is" + (primary-opening + :utf-8 "„" :html "„" :latex "\"`" :texinfo "@quotedblbase{}") + (primary-closing + :utf-8 "“" :html "“" :latex "\"'" :texinfo "@quotedblleft{}") + (secondary-opening + :utf-8 "‚" :html "‚" :latex "\\glq{}" :texinfo "@quotesinglbase{}") + (secondary-closing + :utf-8 "‘" :html "‘" :latex "\\grq{}" :texinfo "@quoteleft{}") + (apostrophe :utf-8 "’" :html "’")) ("no" ;; https://nn.wikipedia.org/wiki/Sitatteikn (primary-opening @@ -5200,7 +5338,11 @@ INFO is the current export state, as a plist." (value (gethash parent cache 'missing-data))) (if (not (eq value 'missing-data)) (cdr (assq s value)) (let (level1-open full-status) - (org-element-map parent 'plain-text + (org-element-map + (let ((secondary (org-element-secondary-p s))) + (if secondary (org-element-property secondary parent) + (org-element-contents parent))) + 'plain-text (lambda (text) (let ((start 0) current-status) (while (setq start (string-match "['\"]" text start)) @@ -5223,7 +5365,7 @@ INFO is the current export state, as a plist." (let ((p (org-export-get-previous-element text info))) (cond ((not p) nil) - ((stringp p) (substring p (1- (length p)))) + ((stringp p) (substring p -1)) ((memq (org-element-property :post-blank p) '(0 nil)) 'no-blank) @@ -5257,7 +5399,7 @@ INFO is the current export state, as a plist." (allow-close 'secondary-closing) (t 'apostrophe))))) current-status) - (setq start (1+ start))) + (cl-incf start)) (when current-status (push (cons text (nreverse current-status)) full-status)))) info nil org-element-recursive-objects) @@ -5303,9 +5445,6 @@ Return the new string." ;; defsubst org-export-get-parent must be defined before first use -(define-obsolete-function-alias - 'org-export-get-genealogy 'org-element-lineage "25.1") - (defun org-export-get-parent-headline (blob) "Return BLOB parent headline or nil. BLOB is the element or object being considered." @@ -5344,7 +5483,7 @@ all of them." ((null n) (throw 'exit obj)) ((not (wholenump n)) (push obj prev)) ((zerop n) (throw 'exit prev)) - (t (decf n) (push obj prev))))))) + (t (cl-decf n) (push obj prev))))))) (defun org-export-get-next-element (blob info &optional n) "Return next element or object. @@ -5370,7 +5509,7 @@ them." ((null n) (throw 'exit obj)) ((not (wholenump n)) (push obj next)) ((zerop n) (throw 'exit (nreverse next))) - (t (decf n) (push obj next))))))) + (t (cl-decf n) (push obj next))))))) ;;;; Translation @@ -5457,6 +5596,7 @@ them." ("es" :ascii "Ecuacion" :html "Ecuación" :default "Ecuación") ("et" :html "Võrrand" :utf-8 "Võrrand") ("fr" :ascii "Equation" :default "Équation") + ("is" :default "Jafna") ("ja" :default "方程式") ("no" :default "Ligning") ("nb" :default "Ligning") @@ -5471,6 +5611,7 @@ them." ("de" :default "Abbildung") ("es" :default "Figura") ("et" :default "Joonis") + ("is" :default "Mynd") ("ja" :default "図" :html "図") ("no" :default "Illustrasjon") ("nb" :default "Illustrasjon") @@ -5485,6 +5626,7 @@ them." ("es" :default "Figura %d:") ("et" :default "Joonis %d:") ("fr" :default "Figure %d :" :html "Figure %d :") + ("is" :default "Mynd %d") ("ja" :default "図%d: " :html "図%d: ") ("no" :default "Illustrasjon %d") ("nb" :default "Illustrasjon %d") @@ -5537,6 +5679,7 @@ them." ("es" :ascii "Indice de tablas" :html "Índice de tablas" :default "Índice de tablas") ("et" :default "Tabelite nimekiri") ("fr" :default "Liste des tableaux") + ("is" :default "Töfluskrá" :html "Töfluskrá") ("ja" :default "表目次") ("no" :default "Tabeller") ("nb" :default "Tabeller") @@ -5593,6 +5736,7 @@ them." ("es" :default "Tabla") ("et" :default "Tabel") ("fr" :default "Tableau") + ("is" :default "Tafla") ("ja" :default "表" :html "表") ("pt_BR" :default "Tabela") ("ru" :html "Таблица" @@ -5604,6 +5748,7 @@ them." ("es" :default "Tabla %d") ("et" :default "Tabel %d") ("fr" :default "Tableau %d :") + ("is" :default "Tafla %d") ("ja" :default "表%d:" :html "表%d:") ("no" :default "Tabell %d") ("nb" :default "Tabell %d") @@ -5938,24 +6083,17 @@ Return file name as a string." (let* ((visited-file (buffer-file-name (buffer-base-buffer))) (base-name ;; File name may come from EXPORT_FILE_NAME subtree - ;; property, assuming point is at beginning of said - ;; sub-tree. + ;; property. (file-name-sans-extension - (or (and subtreep - (org-entry-get - (save-excursion - (ignore-errors (org-back-to-heading) (point))) - "EXPORT_FILE_NAME" 'selective)) + (or (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective)) ;; File name may be extracted from buffer's associated ;; file, if any. (and visited-file (file-name-nondirectory visited-file)) ;; Can't determine file name on our own: Ask user. - (let ((read-file-name-function - (and org-completion-use-ido 'ido-read-file-name))) - (read-file-name - "Output file: " pub-dir nil nil nil - (lambda (name) - (string= (file-name-extension name t) extension))))))) + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (name) + (string= (file-name-extension name t) extension)))))) (output-file ;; Build file name. Enforce EXTENSION over whatever user ;; may have come up with. PUB-DIR, if defined, always has @@ -5969,7 +6107,7 @@ Return file name as a string." (t (concat (file-name-as-directory ".") base-name extension))))) ;; If writing to OUTPUT-FILE would overwrite original file, append ;; EXTENSION another time to final name. - (if (and visited-file (org-file-equal-p visited-file output-file)) + (if (and visited-file (file-equal-p visited-file output-file)) (concat output-file extension) output-file))) @@ -5990,68 +6128,21 @@ removed beforehand. Return the new stack." "Menu for asynchronous export results and running processes." (interactive) (let ((buffer (get-buffer-create "*Org Export Stack*"))) - (set-buffer buffer) - (when (zerop (buffer-size)) (org-export-stack-mode)) - (org-export-stack-refresh) + (with-current-buffer buffer + (org-export-stack-mode) + (tabulated-list-print t)) (pop-to-buffer buffer)) (message "Type \"q\" to quit, \"?\" for help")) -(defun org-export--stack-source-at-point () - "Return source from export results at point in stack." - (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents)))) - (if (not source) (error "Source unavailable, please refresh buffer") - (let ((source-name (if (stringp source) source (buffer-name source)))) - (if (save-excursion - (beginning-of-line) - (looking-at (concat ".* +" (regexp-quote source-name) "$"))) - source - ;; SOURCE is not consistent with current line. The stack - ;; view is outdated. - (error "Source unavailable; type `g' to update buffer")))))) - (defun org-export-stack-clear () "Remove all entries from export stack." (interactive) (setq org-export-stack-contents nil)) -(defun org-export-stack-refresh (&rest dummy) - "Refresh the asynchronous export stack. -DUMMY is ignored. Unavailable sources are removed from the list. -Return the new stack." - (let ((inhibit-read-only t)) - (org-preserve-lc - (erase-buffer) - (insert (concat - (let ((counter 0)) - (mapconcat - (lambda (entry) - (let ((proc-p (processp (nth 2 entry)))) - (concat - ;; Back-end. - (format " %-12s " (or (nth 1 entry) "")) - ;; Age. - (let ((data (nth 2 entry))) - (if proc-p (format " %6s " (process-status data)) - ;; Compute age of the results. - (org-format-seconds - "%4h:%.2m " - (float-time (time-since data))))) - ;; Source. - (format " %s" - (let ((source (car entry))) - (if (stringp source) source - (buffer-name source))))))) - ;; Clear stack from exited processes, dead buffers or - ;; non-existent files. - (setq org-export-stack-contents - (org-remove-if-not - (lambda (el) - (if (processp (nth 2 el)) - (buffer-live-p (process-buffer (nth 2 el))) - (let ((source (car el))) - (if (bufferp source) (buffer-live-p source) - (file-exists-p source))))) - org-export-stack-contents)) "\n"))))))) +(defun org-export-stack-refresh () + "Refresh the export stack." + (interactive) + (tabulated-list-print t)) (defun org-export-stack-remove (&optional source) "Remove export results at point from stack. @@ -6059,7 +6150,7 @@ If optional argument SOURCE is non-nil, remove it instead." (interactive) (let ((source (or source (org-export--stack-source-at-point)))) (setq org-export-stack-contents - (org-remove-if (lambda (el) (equal (car el) source)) + (cl-remove-if (lambda (el) (equal (car el) source)) org-export-stack-contents)))) (defun org-export-stack-view (&optional in-emacs) @@ -6075,11 +6166,10 @@ within Emacs." (defvar org-export-stack-mode-map (let ((km (make-sparse-keymap))) + (set-keymap-parent km tabulated-list-mode-map) (define-key km " " 'next-line) - (define-key km "n" 'next-line) (define-key km "\C-n" 'next-line) (define-key km [down] 'next-line) - (define-key km "p" 'previous-line) (define-key km "\C-p" 'previous-line) (define-key km "\C-?" 'previous-line) (define-key km [up] 'previous-line) @@ -6090,31 +6180,85 @@ within Emacs." km) "Keymap for Org Export Stack.") -(define-derived-mode org-export-stack-mode special-mode "Org-Stack" +(define-derived-mode org-export-stack-mode tabulated-list-mode "Org-Stack" "Mode for displaying asynchronous export stack. -Type \\[org-export-stack] to visualize the asynchronous export +Type `\\[org-export-stack]' to visualize the asynchronous export stack. -In an Org Export Stack buffer, use \\<org-export-stack-mode-map>\\[org-export-stack-view] to view export output -on current line, \\[org-export-stack-remove] to remove it from the stack and \\[org-export-stack-clear] to clear +In an Org Export Stack buffer, use \ +\\<org-export-stack-mode-map>`\\[org-export-stack-view]' to view export output +on current line, `\\[org-export-stack-remove]' to remove it from the stack and \ +`\\[org-export-stack-clear]' to clear stack completely. -Removing entries in an Org Export Stack buffer doesn't affect -files or buffers, only the display. +Removing entries in a stack buffer does not affect files +or buffers, only display. \\{org-export-stack-mode-map}" - (abbrev-mode 0) - (auto-fill-mode 0) - (setq buffer-read-only t - buffer-undo-list t - truncate-lines t - header-line-format - '(:eval - (format " %-12s | %6s | %s" "Back-End" "Age" "Source"))) - (org-add-hook 'post-command-hook 'org-export-stack-refresh nil t) - (set (make-local-variable 'revert-buffer-function) - 'org-export-stack-refresh)) + (setq tabulated-list-format + (vector (list "#" 4 #'org-export--stack-num-predicate) + (list "Back-End" 12 t) + (list "Age" 6 nil) + (list "Source" 0 nil))) + (setq tabulated-list-sort-key (cons "#" nil)) + (setq tabulated-list-entries #'org-export--stack-generate) + (add-hook 'tabulated-list-revert-hook #'org-export--stack-generate nil t) + (add-hook 'post-command-hook #'org-export-stack-refresh nil t) + (tabulated-list-init-header)) + +(defun org-export--stack-generate () + "Generate the asynchronous export stack for display. +Unavailable sources are removed from the list. Return a list +appropriate for `tabulated-list-print'." + ;; Clear stack from exited processes, dead buffers or non-existent + ;; files. + (setq org-export-stack-contents + (cl-remove-if-not + (lambda (el) + (if (processp (nth 2 el)) + (buffer-live-p (process-buffer (nth 2 el))) + (let ((source (car el))) + (if (bufferp source) (buffer-live-p source) + (file-exists-p source))))) + org-export-stack-contents)) + ;; Update `tabulated-list-entries'. + (let ((counter 0)) + (mapcar + (lambda (entry) + (let ((source (car entry))) + (list source + (vector + ;; Counter. + (number-to-string (cl-incf counter)) + ;; Back-End. + (if (nth 1 entry) (symbol-name (nth 1 entry)) "") + ;; Age. + (let ((info (nth 2 entry))) + (if (processp info) (symbol-name (process-status info)) + (format-seconds "%h:%.2m" (float-time (time-since info))))) + ;; Source. + (if (stringp source) source (buffer-name source)))))) + org-export-stack-contents))) + +(defun org-export--stack-num-predicate (a b) + (< (string-to-number (aref (nth 1 a) 0)) + (string-to-number (aref (nth 1 b) 0)))) + +(defun org-export--stack-source-at-point () + "Return source from export results at point in stack." + (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents)))) + (if (not source) (error "Source unavailable, please refresh buffer") + (let ((source-name (if (stringp source) source (buffer-name source)))) + (if (save-excursion + (beginning-of-line) + (looking-at-p (concat ".* +" (regexp-quote source-name) "$"))) + source + ;; SOURCE is not consistent with current line. The stack + ;; view is outdated. + (error (substitute-command-keys + "Source unavailable; type `\\[org-export-stack-refresh]' \ +to refresh buffer"))))))) @@ -6140,10 +6284,12 @@ SPC and DEL (resp. C-n and C-p) keys. Set variable `org-export-dispatch-use-expert-ui' to switch to one flavor or the other. -When ARG is \\[universal-argument], repeat the last export action, with the same set -of options used back then, on the current buffer. +When ARG is `\\[universal-argument]', repeat the last export action, with the\ + same +set of options used back then, on the current buffer. -When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack." +When ARG is `\\[universal-argument] \\[universal-argument]', display the \ +asynchronous export stack." (interactive "P") (let* ((input (cond ((equal arg '(16)) '(stack)) @@ -6168,7 +6314,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron (optns (cdr input))) (unless (memq 'subtree optns) (move-marker org-export-dispatch-last-position nil)) - (case action + (cl-case action ;; First handle special hard-coded actions. (template (org-export-insert-default-template nil optns)) (stack (org-export-stack)) @@ -6177,7 +6323,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron (publish-current-project (org-publish-current-project (memq 'force optns) (memq 'async optns))) (publish-choose-project - (org-publish (assoc (org-icompleting-read + (org-publish (assoc (completing-read "Publish project: " org-publish-project-alist nil t) org-publish-project-alist) @@ -6228,12 +6374,12 @@ back to standard interface." ;; on the first key, if any. A nil value means KEY will ;; only be activated at first level. (if (or (eq access-key t) (eq access-key first-key)) - (org-propertize key 'face 'org-warning) + (propertize key 'face 'org-warning) key))) (fontify-value (lambda (value) ;; Fontify VALUE string. - (org-propertize value 'face 'font-lock-variable-name-face))) + (propertize value 'face 'font-lock-variable-name-face))) ;; Prepare menu entries by extracting them from registered ;; back-ends and sorting them by access key and by ordinal, ;; if any. @@ -6307,7 +6453,7 @@ back to standard interface." (concat (mapconcat (lambda (sub-entry) - (incf index) + (cl-incf index) (format (if (zerop (mod index 2)) " [%s] %-26s" "[%s] %s\n") @@ -6378,7 +6524,7 @@ back to standard interface." standard-prompt allowed-keys entries options first-key expertp)))) (defun org-export--dispatch-action - (prompt allowed-keys entries options first-key expertp) + (prompt allowed-keys entries options first-key expertp) "Read a character from command input and act accordingly. PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is @@ -6396,7 +6542,7 @@ options as CDR." (while (and (setq key (read-char-exclusive prompt)) (not expertp) (memq key '(14 16 ?\s ?\d))) - (case key + (cl-case key (14 (if (not (pos-visible-in-window-p (point-max))) (ignore-errors (scroll-up 1)) (message "End of buffer") @@ -6433,8 +6579,8 @@ options as CDR." ;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1). ((memq key '(2 22 19 6 1)) (org-export--dispatch-ui - (let ((option (case key (2 'body) (22 'visible) (19 'subtree) - (6 'force) (1 'async)))) + (let ((option (cl-case key (2 'body) (22 'visible) (19 'subtree) + (6 'force) (1 'async)))) (if (memq option options) (remq option options) (cons option options))) first-key expertp)) @@ -6446,7 +6592,7 @@ options as CDR." ;; Publishing actions are hard-coded. Send a special ;; signal to `org-export-dispatch'. ((eq first-key ?P) - (case key + (cl-case key (?f 'publish-current-file) (?p 'publish-current-project) (?x 'publish-choose-project) @@ -6455,10 +6601,9 @@ options as CDR." ;; path. Indeed, derived backends can share the same ;; FIRST-KEY. (t (catch 'found - (mapc (lambda (entry) - (let ((match (assq key (nth 2 entry)))) - (when match (throw 'found (nth 2 match))))) - (member (assq first-key entries) entries))))) + (dolist (entry (member (assq first-key entries) entries)) + (let ((match (assq key (nth 2 entry)))) + (when match (throw 'found (nth 2 match)))))))) options)) ;; Otherwise, enter sub-menu. (t (org-export--dispatch-ui options key expertp))))) diff --git a/mk/default.mk b/mk/default.mk index 72068d1..0e639d1 100644 --- a/mk/default.mk +++ b/mk/default.mk @@ -150,6 +150,10 @@ RM = rm -f # How to remove files recursively RMR = rm -fr +# How to change file permissions +# currently only needed for git-annex due to its "lockdown" feature +CHMOD = chmod + # How to copy the lisp files and elc files to their destination. # CP = cp -p # try this if you have no install CP = install -m 644 -p diff --git a/mk/org-fixup.el b/mk/org-fixup.el index e57eb65..ac28963 100644 --- a/mk/org-fixup.el +++ b/mk/org-fixup.el @@ -41,14 +41,14 @@ the Git work tree)." ;;; Code: ;;;\#\#\#autoload \(defun org-release () - \"The release version of org-mode. - Inserted by installing org-mode or when a release is made.\" + \"The release version of Org. +Inserted by installing Org mode or when a release is made.\" (let ((org-release \"" org-release "\")) org-release)) ;;;\#\#\#autoload \(defun org-git-version () \"The Git version of org-mode. - Inserted by installing org-mode or when a release is made.\" +Inserted by installing Org or when a release is made.\" (let ((org-git-version \"" org-git-version "\")) org-git-version)) ;;;\#\#\#autoload diff --git a/mk/targets.mk b/mk/targets.mk index d390fdb..0ccb6ea 100644 --- a/mk/targets.mk +++ b/mk/targets.mk @@ -37,7 +37,7 @@ endif CONF_BASE = EMACS DESTDIR ORGCM ORG_MAKE_DOC CONF_DEST = lispdir infodir datadir testdir CONF_TEST = BTEST_PRE BTEST_POST BTEST_OB_LANGUAGES BTEST_EXTRA BTEST_RE -CONF_EXEC = CP MKDIR RM RMR FIND SUDO PDFTEX TEXI2PDF TEXI2HTML MAKEINFO INSTALL_INFO +CONF_EXEC = CP MKDIR RM RMR FIND CHMOD SUDO PDFTEX TEXI2PDF TEXI2HTML MAKEINFO INSTALL_INFO CONF_CALL = BATCH BATCHL ELC ELCDIR NOBATCH BTEST MAKE_LOCAL_MK MAKE_ORG_INSTALL MAKE_ORG_VERSION config-eol:: EOL = \# config-eol:: config-all @@ -137,11 +137,11 @@ cleandirs: clean: cleanlisp cleandoc cleanall: cleandirs cleantest cleanaddcontrib - -$(FIND) . \( -name \*~ -o -name \*# -o -name .#\* \) -exec $(RM) {} \; - -$(FIND) $(CLEANDIRS) \( -name \*~ -o -name \*.elc \) -exec $(RM) {} \; + -$(FIND) . \( -name \*~ -o -name \*# -o -name .#\* \) -exec $(RM) {} + + -$(FIND) $(CLEANDIRS) \( -name \*~ -o -name \*.elc \) -exec $(RM) {} + $(CLEANDIRS:%=clean%): - -$(FIND) $(@:clean%=%) \( -name \*~ -o -name \*.elc \) -exec $(RM) {} \; + -$(FIND) $(@:clean%=%) \( -name \*~ -o -name \*.elc \) -exec $(RM) {} + cleanelc: $(MAKE) -C lisp $@ @@ -158,4 +158,10 @@ cleandocs: -$(FIND) doc -name \*~ -exec $(RM) {} \; cleantest: - $(RMR) $(testdir) +# git-annex creates non-writable directories so that the files within +# them can't be removed; if rm fails, try to recover by making all +# directories writable + -$(RMR) $(testdir) || { \ + $(FIND) $(testdir) -type d -exec $(CHMOD) u+w {} + && \ + $(RMR) $(testdir) ; \ + } diff --git a/mk/version.mk b/mk/version.mk index ba98992..63d9cef 100644 --- a/mk/version.mk +++ b/mk/version.mk @@ -1,2 +1,2 @@ -ORGVERSION ?= 8.3.4 -GITVERSION ?= 8.3.4-dist +ORGVERSION ?= 9.0 +GITVERSION ?= 9.0-dist |