aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/org/ob-C.el31
-rw-r--r--lisp/org/ob-R.el4
-rw-r--r--lisp/org/ob-clojure.el106
-rw-r--r--lisp/org/ob-core.el24
-rw-r--r--lisp/org/ob-exp.el23
-rw-r--r--lisp/org/ob-gnuplot.el2
-rw-r--r--lisp/org/ob-hledger.el70
-rw-r--r--lisp/org/ob-lilypond.el2
-rw-r--r--lisp/org/ob-lua.el8
-rw-r--r--lisp/org/ob-maxima.el8
-rw-r--r--lisp/org/ob-plantuml.el28
-rw-r--r--lisp/org/ob-scala.el114
-rw-r--r--lisp/org/ob-scheme.el156
-rw-r--r--lisp/org/ob-sql.el59
-rw-r--r--lisp/org/ob-sqlite.el5
-rw-r--r--lisp/org/ob-tangle.el3
-rw-r--r--lisp/org/ob-vala.el115
-rw-r--r--lisp/org/org-agenda.el1378
-rw-r--r--lisp/org/org-archive.el22
-rw-r--r--lisp/org/org-attach.el76
-rw-r--r--lisp/org/org-bbdb.el55
-rw-r--r--lisp/org/org-bibtex.el13
-rw-r--r--lisp/org/org-capture.el398
-rw-r--r--lisp/org/org-clock.el204
-rw-r--r--lisp/org/org-colview.el266
-rw-r--r--lisp/org/org-compat.el335
-rw-r--r--lisp/org/org-datetree.el53
-rw-r--r--lisp/org/org-duration.el446
-rw-r--r--lisp/org/org-element.el251
-rw-r--r--lisp/org/org-entities.el2
-rw-r--r--lisp/org/org-gnus.el283
-rw-r--r--lisp/org/org-habit.el2
-rw-r--r--lisp/org/org-info.el22
-rw-r--r--lisp/org/org-lint.el19
-rw-r--r--lisp/org/org-list.el62
-rw-r--r--lisp/org/org-macro.el72
-rw-r--r--lisp/org/org-macs.el84
-rw-r--r--lisp/org/org-mouse.el23
-rw-r--r--lisp/org/org-protocol.el17
-rw-r--r--lisp/org/org-src.el29
-rw-r--r--lisp/org/org-table.el262
-rw-r--r--lisp/org/org-timer.el2
-rw-r--r--lisp/org/org-version.el4
-rw-r--r--lisp/org/org.el2160
-rw-r--r--lisp/org/ox-ascii.el11
-rw-r--r--lisp/org/ox-beamer.el62
-rw-r--r--lisp/org/ox-html.el204
-rw-r--r--lisp/org/ox-icalendar.el129
-rw-r--r--lisp/org/ox-latex.el91
-rw-r--r--lisp/org/ox-md.el119
-rw-r--r--lisp/org/ox-odt.el13
-rw-r--r--lisp/org/ox-org.el3
-rw-r--r--lisp/org/ox-publish.el664
-rw-r--r--lisp/org/ox-texinfo.el271
-rw-r--r--lisp/org/ox.el619
55 files changed, 5283 insertions, 4201 deletions
diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el
index 86047eeeccf..78528a882bc 100644
--- a/lisp/org/ob-C.el
+++ b/lisp/org/ob-C.el
@@ -46,6 +46,19 @@
46 46
47(defvar org-babel-default-header-args:C '()) 47(defvar org-babel-default-header-args:C '())
48 48
49(defconst org-babel-header-args:C '((includes . :any)
50 (defines . :any)
51 (main . :any)
52 (flags . :any)
53 (cmdline . :any)
54 (libs . :any))
55 "C/C++-specific header arguments.")
56
57(defconst org-babel-header-args:C++
58 (append '((namespaces . :any))
59 org-babel-header-args:C)
60 "C++-specific header arguments.")
61
49(defcustom org-babel-C-compiler "gcc" 62(defcustom org-babel-C-compiler "gcc"
50 "Command used to compile a C source code file into an executable. 63 "Command used to compile a C source code file into an executable.
51May be either a command in the path, like gcc 64May be either a command in the path, like gcc
@@ -196,15 +209,18 @@ its header arguments."
196 (colnames (cdr (assq :colname-names params))) 209 (colnames (cdr (assq :colname-names params)))
197 (main-p (not (string= (cdr (assq :main params)) "no"))) 210 (main-p (not (string= (cdr (assq :main params)) "no")))
198 (includes (org-babel-read 211 (includes (org-babel-read
199 (or (cdr (assq :includes params)) 212 (cdr (assq :includes params))
200 (org-entry-get nil "includes" t))
201 nil)) 213 nil))
202 (defines (org-babel-read 214 (defines (org-babel-read
203 (or (cdr (assq :defines params)) 215 (cdr (assq :defines params))
204 (org-entry-get nil "defines" t)) 216 nil))
205 nil))) 217 (namespaces (org-babel-read
218 (cdr (assq :namespaces params))
219 nil)))
206 (when (stringp includes) 220 (when (stringp includes)
207 (setq includes (split-string includes))) 221 (setq includes (split-string includes)))
222 (when (stringp namespaces)
223 (setq namespaces (split-string namespaces)))
208 (when (stringp defines) 224 (when (stringp defines)
209 (let ((y nil) 225 (let ((y nil)
210 (result (list t))) 226 (result (list t)))
@@ -224,6 +240,11 @@ its header arguments."
224 (mapconcat 240 (mapconcat
225 (lambda (inc) (format "#define %s" inc)) 241 (lambda (inc) (format "#define %s" inc))
226 (if (listp defines) defines (list defines)) "\n") 242 (if (listp defines) defines (list defines)) "\n")
243 ;; namespaces
244 (mapconcat
245 (lambda (inc) (format "using namespace %s;" inc))
246 namespaces
247 "\n")
227 ;; variables 248 ;; variables
228 (mapconcat 'org-babel-C-var-to-C vars "\n") 249 (mapconcat 'org-babel-C-var-to-C vars "\n")
229 ;; table sizes 250 ;; table sizes
diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el
index ded825b1d01..6781fb30a3b 100644
--- a/lisp/org/ob-R.el
+++ b/lisp/org/ob-R.el
@@ -159,10 +159,10 @@ This function is called by `org-babel-execute-src-block'."
159 (result-type (cdr (assq :result-type params))) 159 (result-type (cdr (assq :result-type params)))
160 (session (org-babel-R-initiate-session 160 (session (org-babel-R-initiate-session
161 (cdr (assq :session params)) params)) 161 (cdr (assq :session params)) params))
162 (colnames-p (cdr (assq :colnames params)))
163 (rownames-p (cdr (assq :rownames params)))
164 (graphics-file (and (member "graphics" (assq :result-params params)) 162 (graphics-file (and (member "graphics" (assq :result-params params))
165 (org-babel-graphical-output-file params))) 163 (org-babel-graphical-output-file params)))
164 (colnames-p (unless graphics-file (cdr (assq :colnames params))))
165 (rownames-p (unless graphics-file (cdr (assq :rownames params))))
166 (full-body 166 (full-body
167 (let ((inside 167 (let ((inside
168 (list (org-babel-expand-body:R body params graphics-file)))) 168 (list (org-babel-expand-body:R body params graphics-file))))
diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el
index b99035b4cce..b49bfe58898 100644
--- a/lisp/org/ob-clojure.el
+++ b/lisp/org/ob-clojure.el
@@ -2,7 +2,7 @@
2 2
3;; Copyright (C) 2009-2017 Free Software Foundation, Inc. 3;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
4 4
5;; Author: Joel Boehland, Eric Schulte, Oleh Krehel 5;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
6;; 6;;
7;; Keywords: literate programming, reproducible research 7;; Keywords: literate programming, reproducible research
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
@@ -43,19 +43,34 @@
43(require 'ob) 43(require 'ob)
44 44
45(declare-function cider-current-connection "ext:cider-client" (&optional type)) 45(declare-function cider-current-connection "ext:cider-client" (&optional type))
46(declare-function cider-current-session "ext:cider-client" ()) 46(declare-function cider-current-ns "ext:cider-client" ())
47(declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2))
47(declare-function nrepl-dict-get "ext:nrepl-client" (dict key)) 48(declare-function nrepl-dict-get "ext:nrepl-client" (dict key))
49(declare-function nrepl-dict-put "ext:nrepl-client" (dict key value))
50(declare-function nrepl-request:eval "ext:nrepl-client"
51 (input callback connection &optional session ns line column additional-params))
48(declare-function nrepl-sync-request:eval "ext:nrepl-client" 52(declare-function nrepl-sync-request:eval "ext:nrepl-client"
49 (input connection session &optional ns)) 53 (input connection session &optional ns))
50(declare-function org-trim "org" (s &optional keep-lead)) 54(declare-function org-trim "org" (s &optional keep-lead))
51(declare-function slime-eval "ext:slime" (sexp &optional package)) 55(declare-function slime-eval "ext:slime" (sexp &optional package))
52 56
57(defvar nrepl-sync-request-timeout)
58
53(defvar org-babel-tangle-lang-exts) 59(defvar org-babel-tangle-lang-exts)
54(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) 60(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
55 61
56(defvar org-babel-default-header-args:clojure '()) 62(defvar org-babel-default-header-args:clojure '())
57(defvar org-babel-header-args:clojure '((package . :any))) 63(defvar org-babel-header-args:clojure '((package . :any)))
58 64
65(defcustom org-babel-clojure-sync-nrepl-timeout 10
66 "Timeout value, in seconds, of a Clojure sync call.
67If the value is nil, timeout is disabled."
68 :group 'org-babel
69 :type 'integer
70 :version "26.1"
71 :package-version '(Org . "9.1")
72 :safe #'wholenump)
73
59(defcustom org-babel-clojure-backend 74(defcustom org-babel-clojure-backend
60 (cond ((featurep 'cider) 'cider) 75 (cond ((featurep 'cider) 'cider)
61 (t 'slime)) 76 (t 'slime))
@@ -84,21 +99,86 @@
84 body))) 99 body)))
85 100
86(defun org-babel-execute:clojure (body params) 101(defun org-babel-execute:clojure (body params)
87 "Execute a block of Clojure code with Babel." 102 "Execute a block of Clojure code with Babel.
103The underlying process performed by the code block can be output
104using the :show-process parameter."
88 (let ((expanded (org-babel-expand-body:clojure body params)) 105 (let ((expanded (org-babel-expand-body:clojure body params))
89 result) 106 (response (list 'dict))
107 result)
90 (cl-case org-babel-clojure-backend 108 (cl-case org-babel-clojure-backend
91 (cider 109 (cider
92 (require 'cider) 110 (require 'cider)
93 (let ((result-params (cdr (assq :result-params params)))) 111 (let ((result-params (cdr (assq :result-params params)))
94 (setq result 112 (show (cdr (assq :show-process params))))
95 (nrepl-dict-get 113 (if (member show '(nil "no"))
96 (nrepl-sync-request:eval 114 ;; Run code without showing the process.
97 expanded (cider-current-connection) (cider-current-session)) 115 (progn
98 (if (or (member "output" result-params) 116 (setq response
99 (member "pp" result-params)) 117 (let ((nrepl-sync-request-timeout
100 "out" 118 org-babel-clojure-sync-nrepl-timeout))
101 "value"))))) 119 (nrepl-sync-request:eval expanded
120 (cider-current-connection)
121 (cider-current-ns))))
122 (setq result
123 (concat
124 (nrepl-dict-get response
125 (if (or (member "output" result-params)
126 (member "pp" result-params))
127 "out"
128 "value"))
129 (nrepl-dict-get response "ex")
130 (nrepl-dict-get response "root-ex")
131 (nrepl-dict-get response "err"))))
132 ;; Show the process in an output buffer/window.
133 (let ((process-buffer (switch-to-buffer-other-window
134 "*Clojure Show Process Sub Buffer*"))
135 status)
136 ;; Run the Clojure code in nREPL.
137 (nrepl-request:eval
138 expanded
139 (lambda (resp)
140 (when (member "out" resp)
141 ;; Print the output of the nREPL in the output buffer.
142 (princ (nrepl-dict-get resp "out") process-buffer))
143 (when (member "ex" resp)
144 ;; In case there is an exception, then add it to the
145 ;; output buffer as well.
146 (princ (nrepl-dict-get resp "ex") process-buffer)
147 (princ (nrepl-dict-get resp "root-ex") process-buffer))
148 (when (member "err" resp)
149 ;; In case there is an error, then add it to the
150 ;; output buffer as well.
151 (princ (nrepl-dict-get resp "err") process-buffer))
152 (nrepl--merge response resp)
153 ;; Update the status of the nREPL output session.
154 (setq status (nrepl-dict-get response "status")))
155 (cider-current-connection)
156 (cider-current-ns))
157
158 ;; Wait until the nREPL code finished to be processed.
159 (while (not (member "done" status))
160 (nrepl-dict-put response "status" (remove "need-input" status))
161 (accept-process-output nil 0.01)
162 (redisplay))
163
164 ;; Delete the show buffer & window when the processing is
165 ;; finalized.
166 (mapc #'delete-window
167 (get-buffer-window-list process-buffer nil t))
168 (kill-buffer process-buffer)
169
170 ;; Put the output or the value in the result section of
171 ;; the code block.
172 (setq result
173 (concat
174 (nrepl-dict-get response
175 (if (or (member "output" result-params)
176 (member "pp" result-params))
177 "out"
178 "value"))
179 (nrepl-dict-get response "ex")
180 (nrepl-dict-get response "root-ex")
181 (nrepl-dict-get response "err")))))))
102 (slime 182 (slime
103 (require 'slime) 183 (require 'slime)
104 (with-temp-buffer 184 (with-temp-buffer
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index e18716823df..c7c03845451 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -82,7 +82,6 @@
82(declare-function org-reverse-string "org" (string)) 82(declare-function org-reverse-string "org" (string))
83(declare-function org-set-outline-overlay-data "org" (data)) 83(declare-function org-set-outline-overlay-data "org" (data))
84(declare-function org-show-context "org" (&optional key)) 84(declare-function org-show-context "org" (&optional key))
85(declare-function org-split-string "org" (string &optional separators))
86(declare-function org-src-coderef-format "org-src" (element)) 85(declare-function org-src-coderef-format "org-src" (element))
87(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) 86(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
88(declare-function org-table-align "org-table" ()) 87(declare-function org-table-align "org-table" ())
@@ -179,6 +178,14 @@ This string must include a \"%s\" which will be replaced by the results."
179 :package-version '(Org . "9.0") 178 :package-version '(Org . "9.0")
180 :safe #'booleanp) 179 :safe #'booleanp)
181 180
181(defcustom org-babel-uppercase-example-markers nil
182 "When non-nil, begin/end example markers will be inserted in upper case."
183 :group 'org-babel
184 :type 'boolean
185 :version "26.1"
186 :package-version '(Org . "9.1")
187 :safe #'booleanp)
188
182(defun org-babel-noweb-wrap (&optional regexp) 189(defun org-babel-noweb-wrap (&optional regexp)
183 (concat org-babel-noweb-wrap-start 190 (concat org-babel-noweb-wrap-start
184 (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") 191 (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
@@ -234,11 +241,9 @@ should be asked whether to allow evaluation."
234 (query (or (equal eval "query") 241 (query (or (equal eval "query")
235 (and export (equal eval "query-export")) 242 (and export (equal eval "query-export"))
236 (if (functionp org-confirm-babel-evaluate) 243 (if (functionp org-confirm-babel-evaluate)
237 (save-excursion 244 (funcall org-confirm-babel-evaluate
238 (goto-char (nth 5 info)) 245 ;; Language, code block body.
239 (funcall org-confirm-babel-evaluate 246 (nth 0 info) (nth 1 info))
240 ;; language, code block body
241 (nth 0 info) (nth 1 info)))
242 org-confirm-babel-evaluate)))) 247 org-confirm-babel-evaluate))))
243 (cond 248 (cond
244 (noeval nil) 249 (noeval nil)
@@ -2348,7 +2353,7 @@ INFO may provide the values of these header arguments (in the
2348 ((assq :wrap (nth 2 info)) 2353 ((assq :wrap (nth 2 info))
2349 (let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS"))) 2354 (let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS")))
2350 (funcall wrap (concat "#+BEGIN_" name) 2355 (funcall wrap (concat "#+BEGIN_" name)
2351 (concat "#+END_" (car (org-split-string name))) 2356 (concat "#+END_" (car (split-string name)))
2352 nil nil (concat "{{{results(@@" name ":") "@@)}}}"))) 2357 nil nil (concat "{{{results(@@" name ":") "@@)}}}")))
2353 ((member "html" result-params) 2358 ((member "html" result-params)
2354 (funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil 2359 (funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil
@@ -2483,15 +2488,12 @@ file's directory then expand relative links."
2483 result) 2488 result)
2484 (if description (concat "[" description "]") "")))) 2489 (if description (concat "[" description "]") ""))))
2485 2490
2486(defvar org-babel-capitalize-example-region-markers nil
2487 "Make true to capitalize begin/end example markers inserted by code blocks.")
2488
2489(defun org-babel-examplify-region (beg end &optional results-switches inline) 2491(defun org-babel-examplify-region (beg end &optional results-switches inline)
2490 "Comment out region using the inline `==' or `: ' org example quote." 2492 "Comment out region using the inline `==' or `: ' org example quote."
2491 (interactive "*r") 2493 (interactive "*r")
2492 (let ((maybe-cap 2494 (let ((maybe-cap
2493 (lambda (str) 2495 (lambda (str)
2494 (if org-babel-capitalize-example-region-markers (upcase str) str)))) 2496 (if org-babel-uppercase-example-markers (upcase str) str))))
2495 (if inline 2497 (if inline
2496 (save-excursion 2498 (save-excursion
2497 (goto-char beg) 2499 (goto-char beg)
diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el
index dc9c53aade6..9606d3e474f 100644
--- a/lisp/org/ob-exp.el
+++ b/lisp/org/ob-exp.el
@@ -38,19 +38,18 @@
38 38
39(defvar org-src-preserve-indentation) 39(defvar org-src-preserve-indentation)
40 40
41(defcustom org-export-babel-evaluate t 41(defcustom org-export-use-babel t
42 "Switch controlling code evaluation during export. 42 "Switch controlling code evaluation and header processing during export.
43When set to nil no code will be evaluated as part of the export 43When set to nil no code will be evaluated as part of the export
44process and no header arguments will be obeyed. When set to 44process and no header arguments will be obeyed. Users who wish
45`inline-only', only inline code blocks will be executed. Users 45to avoid evaluating code on export should use the header argument
46who wish to avoid evaluating code on export should use the header 46`:eval never-export'."
47argument `:eval never-export'."
48 :group 'org-babel 47 :group 'org-babel
49 :version "24.1" 48 :version "24.1"
50 :type '(choice (const :tag "Never" nil) 49 :type '(choice (const :tag "Never" nil)
51 (const :tag "Only inline code" inline-only) 50 (const :tag "Always" t))
52 (const :tag "Always" t))) 51 :safe #'null)
53(put 'org-export-babel-evaluate 'safe-local-variable #'null) 52
54 53
55(defmacro org-babel-exp--at-source (&rest body) 54(defmacro org-babel-exp--at-source (&rest body)
56 "Evaluate BODY at the source of the Babel block at point. 55 "Evaluate BODY at the source of the Babel block at point.
@@ -128,12 +127,10 @@ this template."
128(defun org-babel-exp-process-buffer () 127(defun org-babel-exp-process-buffer ()
129 "Execute all Babel blocks in current buffer." 128 "Execute all Babel blocks in current buffer."
130 (interactive) 129 (interactive)
131 (when org-export-babel-evaluate 130 (when org-export-use-babel
132 (save-window-excursion 131 (save-window-excursion
133 (let ((case-fold-search t) 132 (let ((case-fold-search t)
134 (regexp (if (eq org-export-babel-evaluate 'inline-only) 133 (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")
135 "\\(call\\|src\\)_"
136 "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)"))
137 ;; Get a pristine copy of current buffer so Babel 134 ;; Get a pristine copy of current buffer so Babel
138 ;; references are properly resolved and source block 135 ;; references are properly resolved and source block
139 ;; context is preserved. 136 ;; context is preserved.
diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el
index f35374758f6..763386270d7 100644
--- a/lisp/org/ob-gnuplot.el
+++ b/lisp/org/ob-gnuplot.el
@@ -40,7 +40,7 @@
40;;; Code: 40;;; Code:
41(require 'ob) 41(require 'ob)
42 42
43(declare-function org-time-string-to-time "org" (s &optional buffer pos)) 43(declare-function org-time-string-to-time "org" (s &optional zone))
44(declare-function org-combine-plists "org" (&rest plists)) 44(declare-function org-combine-plists "org" (&rest plists))
45(declare-function orgtbl-to-generic "org-table" (table params)) 45(declare-function orgtbl-to-generic "org-table" (table params))
46(declare-function gnuplot-mode "ext:gnuplot-mode" ()) 46(declare-function gnuplot-mode "ext:gnuplot-mode" ())
diff --git a/lisp/org/ob-hledger.el b/lisp/org/ob-hledger.el
new file mode 100644
index 00000000000..86276aad810
--- /dev/null
+++ b/lisp/org/ob-hledger.el
@@ -0,0 +1,70 @@
1;; ob-ledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
4
5;; Author: Simon Michael
6;; Keywords: literate programming, reproducible research, plain text accounting
7;; Homepage: http://orgmode.org
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; Babel support for evaluating hledger entries.
27;;
28;; Based on ob-ledger.el.
29;; If the source block is empty, hledger will use a default journal file,
30;; probably ~/.hledger.journal (it may not notice your $LEDGER_FILE env var).
31;; So make ~/.hledger.journal a symbolic link to the real file if necessary.
32
33;;; Code:
34(require 'ob)
35
36(defvar org-babel-default-header-args:hledger
37 '((:results . "output") (:exports . "results") (:cmdline . "bal"))
38 "Default arguments to use when evaluating a hledger source block.")
39
40(defun org-babel-execute:hledger (body params)
41 "Execute a block of hledger entries with org-babel.
42This function is called by `org-babel-execute-src-block'."
43 (message "executing hledger source code block")
44 (letrec ( ;(result-params (split-string (or (cdr (assq :results params)) "")))
45 (cmdline (cdr (assq :cmdline params)))
46 (in-file (org-babel-temp-file "hledger-"))
47 (out-file (org-babel-temp-file "hledger-output-"))
48 (hledgercmd (concat "hledger"
49 (if (> (length body) 0)
50 (concat " -f " (org-babel-process-file-name in-file))
51 "")
52 " " cmdline)))
53 (with-temp-file in-file (insert body))
54;; TODO This is calling for some refactoring:
55;; (concat "hledger" (if ...) " " cmdline)
56;; could be built only once and bound to a symbol.
57 (message "%s" hledgercmd)
58 (with-output-to-string
59 (shell-command (concat hledgercmd " > " (org-babel-process-file-name out-file))))
60 (with-temp-buffer (insert-file-contents out-file) (buffer-string))))
61
62(defun org-babel-prep-session:hledger (_session _params)
63 (error "hledger does not support sessions"))
64
65(provide 'ob-hledger)
66
67
68
69;;; ob-hledger.el ends here
70;; TODO Unit tests are more than welcome, too.
diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el
index 3320a7e55b4..0cc85685e91 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -89,7 +89,7 @@ you can leave the string empty on this case."
89 (string :tag "Lilypond ") 89 (string :tag "Lilypond ")
90 (string :tag "PDF Viewer ") 90 (string :tag "PDF Viewer ")
91 (string :tag "MIDI Player")) 91 (string :tag "MIDI Player"))
92 :version "24.3" 92 :version "24.4"
93 :package-version '(Org . "8.2.7") 93 :package-version '(Org . "8.2.7")
94 :set 94 :set
95 (lambda (_symbol value) 95 (lambda (_symbol value)
diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el
index 4fd7a323825..fc9d9f2f0e2 100644
--- a/lisp/org/ob-lua.el
+++ b/lisp/org/ob-lua.el
@@ -49,7 +49,7 @@
49 49
50(defcustom org-babel-lua-command "lua" 50(defcustom org-babel-lua-command "lua"
51 "Name of the command for executing Lua code." 51 "Name of the command for executing Lua code."
52 :version "24.5" 52 :version "26.1"
53 :package-version '(Org . "8.3") 53 :package-version '(Org . "8.3")
54 :group 'org-babel 54 :group 'org-babel
55 :type 'string) 55 :type 'string)
@@ -58,21 +58,21 @@
58 "Preferred lua mode for use in running lua interactively. 58 "Preferred lua mode for use in running lua interactively.
59This will typically be 'lua-mode." 59This will typically be 'lua-mode."
60 :group 'org-babel 60 :group 'org-babel
61 :version "24.5" 61 :version "26.1"
62 :package-version '(Org . "8.3") 62 :package-version '(Org . "8.3")
63 :type 'symbol) 63 :type 'symbol)
64 64
65(defcustom org-babel-lua-hline-to "None" 65(defcustom org-babel-lua-hline-to "None"
66 "Replace hlines in incoming tables with this when translating to lua." 66 "Replace hlines in incoming tables with this when translating to lua."
67 :group 'org-babel 67 :group 'org-babel
68 :version "24.5" 68 :version "26.1"
69 :package-version '(Org . "8.3") 69 :package-version '(Org . "8.3")
70 :type 'string) 70 :type 'string)
71 71
72(defcustom org-babel-lua-None-to 'hline 72(defcustom org-babel-lua-None-to 'hline
73 "Replace 'None' in lua tables with this before returning." 73 "Replace 'None' in lua tables with this before returning."
74 :group 'org-babel 74 :group 'org-babel
75 :version "24.5" 75 :version "26.1"
76 :package-version '(Org . "8.3") 76 :package-version '(Org . "8.3")
77 :type 'symbol) 77 :type 'symbol)
78 78
diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el
index b2680aa7b6f..224b3605035 100644
--- a/lisp/org/ob-maxima.el
+++ b/lisp/org/ob-maxima.el
@@ -48,9 +48,13 @@
48 48
49(defun org-babel-maxima-expand (body params) 49(defun org-babel-maxima-expand (body params)
50 "Expand a block of Maxima code according to its header arguments." 50 "Expand a block of Maxima code according to its header arguments."
51 (let ((vars (org-babel--get-vars params))) 51 (let ((vars (org-babel--get-vars params))
52 (epilogue (cdr (assq :epilogue params)))
53 (prologue (cdr (assq :prologue params))))
52 (mapconcat 'identity 54 (mapconcat 'identity
53 (list 55 (list
56 ;; Any code from the specified prologue at the start.
57 prologue
54 ;; graphic output 58 ;; graphic output
55 (let ((graphic-file (ignore-errors (org-babel-graphical-output-file params)))) 59 (let ((graphic-file (ignore-errors (org-babel-graphical-output-file params))))
56 (if graphic-file 60 (if graphic-file
@@ -62,6 +66,8 @@
62 (mapconcat 'org-babel-maxima-var-to-maxima vars "\n") 66 (mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
63 ;; body 67 ;; body
64 body 68 body
69 ;; Any code from the specified epilogue at the end.
70 epilogue
65 "gnuplot_close ()$") 71 "gnuplot_close ()$")
66 "\n"))) 72 "\n")))
67 73
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index 20dc25f6484..8093100edaf 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -46,6 +46,31 @@
46 :version "24.1" 46 :version "24.1"
47 :type 'string) 47 :type 'string)
48 48
49(defun org-babel-variable-assignments:plantuml (params)
50 "Return a list of PlantUML statements assigning the block's variables.
51PARAMS is a property list of source block parameters, which may
52contain multiple entries for the key `:var'. `:var' entries in PARAMS
53are expected to be scalar variables."
54 (mapcar
55 (lambda (pair)
56 (format "!define %s %s"
57 (car pair)
58 (replace-regexp-in-string "\"" "" (cdr pair))))
59 (org-babel--get-vars params)))
60
61(defun org-babel-plantuml-make-body (body params)
62 "Return PlantUML input string.
63BODY is the content of the source block and PARAMS is a property list
64of source block parameters. This function relies on the
65`org-babel-expand-body:generic' function to extract `:var' entries
66from PARAMS and on the `org-babel-variable-assignments:plantuml'
67function to convert variables to PlantUML assignments."
68 (concat
69 "@startuml\n"
70 (org-babel-expand-body:generic
71 body params (org-babel-variable-assignments:plantuml params))
72 "\n@enduml"))
73
49(defun org-babel-execute:plantuml (body params) 74(defun org-babel-execute:plantuml (body params)
50 "Execute a block of plantuml code with org-babel. 75 "Execute a block of plantuml code with org-babel.
51This function is called by `org-babel-execute-src-block'." 76This function is called by `org-babel-execute-src-block'."
@@ -54,6 +79,7 @@ This function is called by `org-babel-execute-src-block'."
54 (cmdline (cdr (assq :cmdline params))) 79 (cmdline (cdr (assq :cmdline params)))
55 (in-file (org-babel-temp-file "plantuml-")) 80 (in-file (org-babel-temp-file "plantuml-"))
56 (java (or (cdr (assq :java params)) "")) 81 (java (or (cdr (assq :java params)) ""))
82 (full-body (org-babel-plantuml-make-body body params))
57 (cmd (if (string= "" org-plantuml-jar-path) 83 (cmd (if (string= "" org-plantuml-jar-path)
58 (error "`org-plantuml-jar-path' is not set") 84 (error "`org-plantuml-jar-path' is not set")
59 (concat "java " java " -jar " 85 (concat "java " java " -jar "
@@ -85,7 +111,7 @@ This function is called by `org-babel-execute-src-block'."
85 (org-babel-process-file-name out-file))))) 111 (org-babel-process-file-name out-file)))))
86 (unless (file-exists-p org-plantuml-jar-path) 112 (unless (file-exists-p org-plantuml-jar-path)
87 (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) 113 (error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
88 (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) 114 (with-temp-file in-file (insert full-body))
89 (message "%s" cmd) (org-babel-eval cmd "") 115 (message "%s" cmd) (org-babel-eval cmd "")
90 nil)) ;; signal that output has already been written to file 116 nil)) ;; signal that output has already been written to file
91 117
diff --git a/lisp/org/ob-scala.el b/lisp/org/ob-scala.el
deleted file mode 100644
index d00b97c3db4..00000000000
--- a/lisp/org/ob-scala.el
+++ /dev/null
@@ -1,114 +0,0 @@
1;;; ob-scala.el --- Babel Functions for Scala -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
4
5;; Author: Andrzej Lichnerowicz
6;; Keywords: literate programming, reproducible research
7;; Homepage: http://orgmode.org
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
23
24;;; Commentary:
25;; Currently only supports the external execution. No session support yet.
26
27;;; Requirements:
28;; - Scala language :: http://www.scala-lang.org/
29;; - Scala major mode :: Can be installed from Scala sources
30;; https://github.com/scala/scala-dist/blob/master/tool-support/src/emacs/scala-mode.el
31
32;;; Code:
33(require 'ob)
34
35(defvar org-babel-tangle-lang-exts) ;; Autoloaded
36(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala"))
37(defvar org-babel-default-header-args:scala '())
38(defvar org-babel-scala-command "scala"
39 "Name of the command to use for executing Scala code.")
40
41(defun org-babel-execute:scala (body params)
42 "Execute a block of Scala code with org-babel. This function is
43called by `org-babel-execute-src-block'"
44 (message "executing Scala source code block")
45 (let* ((processed-params (org-babel-process-params params))
46 (session (org-babel-scala-initiate-session (nth 0 processed-params)))
47 (result-params (nth 2 processed-params))
48 (result-type (cdr (assq :result-type params)))
49 (full-body (org-babel-expand-body:generic
50 body params))
51 (result (org-babel-scala-evaluate
52 session full-body result-type result-params)))
53
54 (org-babel-reassemble-table
55 result
56 (org-babel-pick-name
57 (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
58 (org-babel-pick-name
59 (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
60
61(defvar org-babel-scala-wrapper-method
62
63"var str_result :String = null;
64
65Console.withOut(new java.io.OutputStream() {def write(b: Int){
66}}) {
67 str_result = {
68%s
69 }.toString
70}
71
72print(str_result)
73")
74
75
76(defun org-babel-scala-evaluate
77 (session body &optional result-type result-params)
78 "Evaluate BODY in external Scala process.
79If RESULT-TYPE equals `output' then return standard output as a string.
80If RESULT-TYPE equals `value' then return the value of the last statement
81in BODY as elisp."
82 (when session (error "Sessions are not (yet) supported for Scala"))
83 (pcase result-type
84 (`output
85 (let ((src-file (org-babel-temp-file "scala-")))
86 (with-temp-file src-file (insert body))
87 (org-babel-eval
88 (concat org-babel-scala-command " " src-file) "")))
89 (`value
90 (let* ((src-file (org-babel-temp-file "scala-"))
91 (wrapper (format org-babel-scala-wrapper-method body)))
92 (with-temp-file src-file (insert wrapper))
93 (let ((raw (org-babel-eval
94 (concat org-babel-scala-command " " src-file) "")))
95 (org-babel-result-cond result-params
96 raw
97 (org-babel-script-escape raw)))))))
98
99
100(defun org-babel-prep-session:scala (_session _params)
101 "Prepare SESSION according to the header arguments specified in PARAMS."
102 (error "Sessions are not (yet) supported for Scala"))
103
104(defun org-babel-scala-initiate-session (&optional _session)
105 "If there is not a current inferior-process-buffer in SESSION
106then create. Return the initialized session. Sessions are not
107supported in Scala."
108 nil)
109
110(provide 'ob-scala)
111
112
113
114;;; ob-scala.el ends here
diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el
index 2782853220b..f67080adfd3 100644
--- a/lisp/org/ob-scheme.el
+++ b/lisp/org/ob-scheme.el
@@ -44,37 +44,51 @@
44(defvar geiser-impl--implementation) ; Defined in geiser-impl.el 44(defvar geiser-impl--implementation) ; Defined in geiser-impl.el
45(defvar geiser-default-implementation) ; Defined in geiser-impl.el 45(defvar geiser-default-implementation) ; Defined in geiser-impl.el
46(defvar geiser-active-implementations) ; Defined in geiser-impl.el 46(defvar geiser-active-implementations) ; Defined in geiser-impl.el
47(defvar geiser-debug-show-debug-p) ; Defined in geiser-debug.el
48(defvar geiser-debug-jump-to-debug-p) ; Defined in geiser-debug.el
49(defvar geiser-repl-use-other-window) ; Defined in geiser-repl.el
50(defvar geiser-repl-window-allow-split) ; Defined in geiser-repl.el
47 51
48(declare-function run-geiser "ext:geiser-repl" (impl)) 52(declare-function run-geiser "ext:geiser-repl" (impl))
49(declare-function geiser-mode "ext:geiser-mode" ()) 53(declare-function geiser-mode "ext:geiser-mode" ())
50(declare-function geiser-eval-region "ext:geiser-mode" 54(declare-function geiser-eval-region "ext:geiser-mode"
51 (start end &optional and-go raw nomsg)) 55 (start end &optional and-go raw nomsg))
52(declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg)) 56(declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg))
57(declare-function geiser-eval--retort-output "ext:geiser-eval" (ret))
58(declare-function geiser-eval--retort-result-str "ext:geiser-eval" (ret prefix))
59
60(defcustom org-babel-scheme-null-to 'hline
61 "Replace `null' and empty lists in scheme tables with this before returning."
62 :group 'org-babel
63 :version "26.1"
64 :package-version '(Org . "9.1")
65 :type 'symbol)
53 66
54(defvar org-babel-default-header-args:scheme '() 67(defvar org-babel-default-header-args:scheme '()
55 "Default header arguments for scheme code blocks.") 68 "Default header arguments for scheme code blocks.")
56 69
57(defun org-babel-expand-body:scheme (body params) 70(defun org-babel-expand-body:scheme (body params)
58 "Expand BODY according to PARAMS, return the expanded body." 71 "Expand BODY according to PARAMS, return the expanded body."
59 (let ((vars (org-babel--get-vars params))) 72 (let ((vars (org-babel--get-vars params))
60 (if (> (length vars) 0) 73 (prepends (cdr (assq :prologue params))))
61 (concat "(let (" 74 (concat (and prepends (concat prepends "\n"))
62 (mapconcat 75 (if (null vars) body
63 (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) 76 (format "(let (%s)\n%s\n)"
64 vars "\n ") 77 (mapconcat
65 ")\n" body ")") 78 (lambda (var)
66 body))) 79 (format "%S" (print `(,(car var) ',(cdr var)))))
67 80 vars
68 81 "\n ")
69(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal) 82 body)))))
83
84
85(defvar org-babel-scheme-repl-map (make-hash-table :test #'equal)
70 "Map of scheme sessions to session names.") 86 "Map of scheme sessions to session names.")
71 87
72(defun org-babel-scheme-cleanse-repl-map () 88(defun org-babel-scheme-cleanse-repl-map ()
73 "Remove dead buffers from the REPL map." 89 "Remove dead buffers from the REPL map."
74 (maphash 90 (maphash
75 (lambda (x y) 91 (lambda (x y) (unless (buffer-name y) (remhash x org-babel-scheme-repl-map)))
76 (when (not (buffer-name y))
77 (remhash x org-babel-scheme-repl-map)))
78 org-babel-scheme-repl-map)) 92 org-babel-scheme-repl-map))
79 93
80(defun org-babel-scheme-get-session-buffer (session-name) 94(defun org-babel-scheme-get-session-buffer (session-name)
@@ -112,12 +126,9 @@ If the session is unnamed (nil), generate a name.
112 126
113If the session is `none', use nil for the session name, and 127If the session is `none', use nil for the session name, and
114org-babel-scheme-execute-with-geiser will use a temporary session." 128org-babel-scheme-execute-with-geiser will use a temporary session."
115 (let ((result 129 (cond ((not name) (concat buffer " " (symbol-name impl) " REPL"))
116 (cond ((not name) 130 ((string= name "none") nil)
117 (concat buffer " " (symbol-name impl) " REPL")) 131 (name)))
118 ((string= name "none") nil)
119 (name))))
120 result))
121 132
122(defmacro org-babel-scheme-capture-current-message (&rest body) 133(defmacro org-babel-scheme-capture-current-message (&rest body)
123 "Capture current message in both interactive and noninteractive mode" 134 "Capture current message in both interactive and noninteractive mode"
@@ -145,37 +156,46 @@ is true; otherwise returns the last value."
145 (with-temp-buffer 156 (with-temp-buffer
146 (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl)) 157 (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
147 (newline) 158 (newline)
148 (insert (if output 159 (insert code)
149 (format "(with-output-to-string (lambda () %s))" code)
150 code))
151 (geiser-mode) 160 (geiser-mode)
152 (let ((repl-buffer (save-current-buffer 161 (let ((geiser-repl-window-allow-split nil)
153 (org-babel-scheme-get-repl impl repl)))) 162 (geiser-repl-use-other-window nil))
154 (when (not (eq impl (org-babel-scheme-get-buffer-impl 163 (let ((repl-buffer (save-current-buffer
155 (current-buffer)))) 164 (org-babel-scheme-get-repl impl repl))))
156 (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) 165 (when (not (eq impl (org-babel-scheme-get-buffer-impl
157 (org-babel-scheme-get-buffer-impl (current-buffer)) 166 (current-buffer))))
158 (symbolp (org-babel-scheme-get-buffer-impl 167 (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
159 (current-buffer))))) 168 (org-babel-scheme-get-buffer-impl (current-buffer))
160 (setq geiser-repl--repl repl-buffer) 169 (symbolp (org-babel-scheme-get-buffer-impl
161 (setq geiser-impl--implementation nil) 170 (current-buffer)))))
162 (setq result (org-babel-scheme-capture-current-message 171 (setq geiser-repl--repl repl-buffer)
163 (geiser-eval-region (point-min) (point-max)))) 172 (setq geiser-impl--implementation nil)
164 (setq result 173 (let ((geiser-debug-jump-to-debug-p nil)
165 (if (and (stringp result) (equal (substring result 0 3) "=> ")) 174 (geiser-debug-show-debug-p nil))
166 (replace-regexp-in-string "^=> " "" result) 175 (let ((ret (geiser-eval-region (point-min) (point-max))))
167 "\"An error occurred.\"")) 176 (setq result (if output
168 (when (not repl) 177 (geiser-eval--retort-output ret)
169 (save-current-buffer (set-buffer repl-buffer) 178 (geiser-eval--retort-result-str ret "")))))
170 (geiser-repl-exit)) 179 (when (not repl)
171 (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) 180 (save-current-buffer (set-buffer repl-buffer)
172 (kill-buffer repl-buffer)) 181 (geiser-repl-exit))
173 (setq result (if (or (string= result "#<void>") 182 (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
174 (string= result "#<unspecified>")) 183 (kill-buffer repl-buffer)))))
175 nil
176 result))))
177 result)) 184 result))
178 185
186(defun org-babel-scheme--table-or-string (results)
187 "Convert RESULTS into an appropriate elisp value.
188If the results look like a list or tuple, then convert them into an
189Emacs-lisp table, otherwise return the results as a string."
190 (let ((res (org-babel-script-escape results)))
191 (cond ((listp res)
192 (mapcar (lambda (el)
193 (if (or (null el) (eq el 'null))
194 org-babel-scheme-null-to
195 el))
196 res))
197 (t res))))
198
179(defun org-babel-execute:scheme (body params) 199(defun org-babel-execute:scheme (body params)
180 "Execute a block of Scheme code with org-babel. 200 "Execute a block of Scheme code with org-babel.
181This function is called by `org-babel-execute-src-block'" 201This function is called by `org-babel-execute-src-block'"
@@ -184,24 +204,28 @@ This function is called by `org-babel-execute-src-block'"
184 "^ ?\\*\\([^*]+\\)\\*" "\\1" 204 "^ ?\\*\\([^*]+\\)\\*" "\\1"
185 (buffer-name source-buffer)))) 205 (buffer-name source-buffer))))
186 (save-excursion 206 (save-excursion
187 (org-babel-reassemble-table 207 (let* ((result-type (cdr (assq :result-type params)))
188 (let* ((result-type (cdr (assq :result-type params))) 208 (impl (or (when (cdr (assq :scheme params))
189 (impl (or (when (cdr (assq :scheme params)) 209 (intern (cdr (assq :scheme params))))
190 (intern (cdr (assq :scheme params)))) 210 geiser-default-implementation
191 geiser-default-implementation 211 (car geiser-active-implementations)))
192 (car geiser-active-implementations))) 212 (session (org-babel-scheme-make-session-name
193 (session (org-babel-scheme-make-session-name 213 source-buffer-name (cdr (assq :session params)) impl))
194 source-buffer-name (cdr (assq :session params)) impl)) 214 (full-body (org-babel-expand-body:scheme body params))
195 (full-body (org-babel-expand-body:scheme body params))) 215 (result
196 (org-babel-scheme-execute-with-geiser 216 (org-babel-scheme-execute-with-geiser
197 full-body ; code 217 full-body ; code
198 (string= result-type "output") ; output? 218 (string= result-type "output") ; output?
199 impl ; implementation 219 impl ; implementation
200 (and (not (string= session "none")) session))) ; session 220 (and (not (string= session "none")) session)))) ; session
201 (org-babel-pick-name (cdr (assq :colname-names params)) 221 (let ((table
202 (cdr (assq :colnames params))) 222 (org-babel-reassemble-table
203 (org-babel-pick-name (cdr (assq :rowname-names params)) 223 result
204 (cdr (assq :rownames params))))))) 224 (org-babel-pick-name (cdr (assq :colname-names params))
225 (cdr (assq :colnames params)))
226 (org-babel-pick-name (cdr (assq :rowname-names params))
227 (cdr (assq :rownames params))))))
228 (org-babel-scheme--table-or-string table))))))
205 229
206(provide 'ob-scheme) 230(provide 'ob-scheme)
207 231
diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el
index 7c3ee120d77..9250825d4e5 100644
--- a/lisp/org/ob-sql.el
+++ b/lisp/org/ob-sql.el
@@ -43,15 +43,25 @@
43;; - colnames (default, nil, means "yes") 43;; - colnames (default, nil, means "yes")
44;; - result-params 44;; - result-params
45;; - out-file 45;; - out-file
46;;
46;; The following are used but not really implemented for SQL: 47;; The following are used but not really implemented for SQL:
47;; - colname-names 48;; - colname-names
48;; - rownames 49;; - rownames
49;; - rowname-names 50;; - rowname-names
50;; 51;;
52;; Engines supported:
53;; - mysql
54;; - dbi
55;; - mssql
56;; - sqsh
57;; - postgresql
58;; - oracle
59;; - vertica
60;;
51;; TODO: 61;; TODO:
52;; 62;;
53;; - support for sessions 63;; - support for sessions
54;; - support for more engines (currently only supports mysql) 64;; - support for more engines
55;; - what's a reasonable way to drop table data into SQL? 65;; - what's a reasonable way to drop table data into SQL?
56;; 66;;
57 67
@@ -116,6 +126,28 @@ SQL Server on Windows and Linux platform."
116 (when database (format "-d \"%s\"" database)))) 126 (when database (format "-d \"%s\"" database))))
117 " ")) 127 " "))
118 128
129(defun org-babel-sql-dbstring-sqsh (host user password database)
130 "Make sqsh commmand line args for database connection.
131\"sqsh\" is one method to access Sybase or MS SQL via Linux platform"
132 (mapconcat #'identity
133 (delq nil
134 (list (when host (format "-S \"%s\"" host))
135 (when user (format "-U \"%s\"" user))
136 (when password (format "-P \"%s\"" password))
137 (when database (format "-D \"%s\"" database))))
138 " "))
139
140(defun org-babel-sql-dbstring-vertica (host port user password database)
141 "Make Vertica command line args for database connection. Pass nil to omit that arg."
142 (mapconcat #'identity
143 (delq nil
144 (list (when host (format "-h %s" host))
145 (when port (format "-p %d" port))
146 (when user (format "-U %s" user))
147 (when password (format "-w %s" (shell-quote-argument password) ))
148 (when database (format "-d %s" database))))
149 " "))
150
119(defun org-babel-sql-convert-standard-filename (file) 151(defun org-babel-sql-convert-standard-filename (file)
120 "Convert FILE to OS standard file name. 152 "Convert FILE to OS standard file name.
121If in Cygwin environment, uses Cygwin specific function to 153If in Cygwin environment, uses Cygwin specific function to
@@ -179,6 +211,20 @@ footer=off -F \"\t\" %s -f %s -o %s %s"
179 (org-babel-process-file-name in-file) 211 (org-babel-process-file-name in-file)
180 (org-babel-process-file-name out-file) 212 (org-babel-process-file-name out-file)
181 (or cmdline ""))) 213 (or cmdline "")))
214 (`sqsh (format "sqsh %s %s -i %s -o %s -m csv"
215 (or cmdline "")
216 (org-babel-sql-dbstring-sqsh
217 dbhost dbuser dbpassword database)
218 (org-babel-sql-convert-standard-filename
219 (org-babel-process-file-name in-file))
220 (org-babel-sql-convert-standard-filename
221 (org-babel-process-file-name out-file))))
222 (`vertica (format "vsql %s -f %s -o %s %s"
223 (org-babel-sql-dbstring-vertica
224 dbhost dbport dbuser dbpassword database)
225 (org-babel-process-file-name in-file)
226 (org-babel-process-file-name out-file)
227 (or cmdline "")))
182 (`oracle (format 228 (`oracle (format
183 "sqlplus -s %s < %s > %s" 229 "sqlplus -s %s < %s > %s"
184 (org-babel-sql-dbstring-oracle 230 (org-babel-sql-dbstring-oracle
@@ -203,18 +249,21 @@ SET MARKUP HTML OFF SPOOL OFF
203SET COLSEP '|' 249SET COLSEP '|'
204 250
205") 251")
206 (`mssql "SET NOCOUNT ON 252 ((or `mssql `sqsh) "SET NOCOUNT ON
207 253
208") 254")
255 (`vertica "\\a\n")
209 (_ "")) 256 (_ ""))
210 (org-babel-expand-body:sql body params))) 257 (org-babel-expand-body:sql body params)
258 ;; "sqsh" requires "go" inserted at EOF.
259 (if (string= engine "sqsh") "\ngo" "")))
211 (org-babel-eval command "") 260 (org-babel-eval command "")
212 (org-babel-result-cond result-params 261 (org-babel-result-cond result-params
213 (with-temp-buffer 262 (with-temp-buffer
214 (progn (insert-file-contents-literally out-file) (buffer-string))) 263 (progn (insert-file-contents-literally out-file) (buffer-string)))
215 (with-temp-buffer 264 (with-temp-buffer
216 (cond 265 (cond
217 ((memq (intern engine) '(dbi mysql postgresql)) 266 ((memq (intern engine) '(dbi mysql postgresql sqsh vertica))
218 ;; Add header row delimiter after column-names header in first line 267 ;; Add header row delimiter after column-names header in first line
219 (cond 268 (cond
220 (colnames-p 269 (colnames-p
@@ -239,7 +288,7 @@ SET COLSEP '|'
239 (goto-char (point-max)) 288 (goto-char (point-max))
240 (forward-char -1)) 289 (forward-char -1))
241 (write-file out-file)))) 290 (write-file out-file))))
242 (org-table-import out-file '(16)) 291 (org-table-import out-file (if (string= engine "sqsh") '(4) '(16)))
243 (org-babel-reassemble-table 292 (org-babel-reassemble-table
244 (mapcar (lambda (x) 293 (mapcar (lambda (x)
245 (if (string= (car x) header-delim) 294 (if (string= (car x) header-delim)
diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el
index 50e8ac1ab90..38058274a9a 100644
--- a/lisp/org/ob-sqlite.el
+++ b/lisp/org/ob-sqlite.el
@@ -123,10 +123,7 @@ This function is called by `org-babel-execute-src-block'."
123 (if (listp val) 123 (if (listp val)
124 (let ((data-file (org-babel-temp-file "sqlite-data-"))) 124 (let ((data-file (org-babel-temp-file "sqlite-data-")))
125 (with-temp-file data-file 125 (with-temp-file data-file
126 (insert (orgtbl-to-csv 126 (insert (orgtbl-to-csv val nil)))
127 val '(:fmt (lambda (el) (if (stringp el)
128 el
129 (format "%S" el)))))))
130 data-file) 127 data-file)
131 (if (stringp val) val (format "%S" val)))) 128 (if (stringp val) val (format "%S" val))))
132 body))) 129 body)))
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index ed09ff563a8..adc6806766d 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -29,13 +29,13 @@
29 29
30(require 'cl-lib) 30(require 'cl-lib)
31(require 'org-src) 31(require 'org-src)
32(require 'org-macs)
32 33
33(declare-function make-directory "files" (dir &optional parents)) 34(declare-function make-directory "files" (dir &optional parents))
34(declare-function org-at-heading-p "org" (&optional ignored)) 35(declare-function org-at-heading-p "org" (&optional ignored))
35(declare-function org-babel-update-block-body "ob-core" (new-body)) 36(declare-function org-babel-update-block-body "ob-core" (new-body))
36(declare-function org-back-to-heading "org" (&optional invisible-ok)) 37(declare-function org-back-to-heading "org" (&optional invisible-ok))
37(declare-function org-before-first-heading-p "org" ()) 38(declare-function org-before-first-heading-p "org" ())
38(declare-function org-edit-special "org" (&optional arg))
39(declare-function org-element-at-point "org-element" ()) 39(declare-function org-element-at-point "org-element" ())
40(declare-function org-element-type "org-element" (element)) 40(declare-function org-element-type "org-element" (element))
41(declare-function org-fill-template "org" (template alist)) 41(declare-function org-fill-template "org" (template alist))
@@ -45,7 +45,6 @@
45(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) 45(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
46(declare-function org-remove-indentation "org" (code &optional n)) 46(declare-function org-remove-indentation "org" (code &optional n))
47(declare-function org-store-link "org" (arg)) 47(declare-function org-store-link "org" (arg))
48(declare-function org-string-nw-p "org-macs" (s))
49(declare-function org-trim "org" (s &optional keep-lead)) 48(declare-function org-trim "org" (s &optional keep-lead))
50(declare-function outline-previous-heading "outline" ()) 49(declare-function outline-previous-heading "outline" ())
51(declare-function org-id-find "org-id" (id &optional markerp)) 50(declare-function org-id-find "org-id" (id &optional markerp))
diff --git a/lisp/org/ob-vala.el b/lisp/org/ob-vala.el
new file mode 100644
index 00000000000..3998e2d4e28
--- /dev/null
+++ b/lisp/org/ob-vala.el
@@ -0,0 +1,115 @@
1;;; ob-vala.el --- Babel functions for Vala evaluation -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; Author: Christian Garbs <mitch@cgarbs.de>
6;; Keywords: literate programming, reproducible research
7;; Homepage: http://orgmode.org
8
9;;; License:
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; ob-vala.el provides Babel support for the Vala language
27;; (see http://live.gnome.org/Vala for details)
28
29;;; Requirements:
30
31;; - Vala compiler binary (valac)
32;; - Vala development environment (Vala libraries etc.)
33;;
34;; vala-mode.el is nice to have for code formatting, but is not needed
35;; for ob-vala.el
36
37;;; Code:
38
39(require 'ob)
40
41(declare-function org-trim "org" (s &optional keep-lead))
42
43;; File extension.
44(add-to-list 'org-babel-tangle-lang-exts '("vala" . "vala"))
45
46;; Header arguments empty by default.
47(defvar org-babel-default-header-args:vala '())
48
49(defcustom org-babel-vala-compiler "valac"
50 "Command used to compile a C source code file into an executable.
51May be either a command in the path, like \"valac\"
52or an absolute path name, like \"/usr/local/bin/valac\".
53Parameters may be used like this: \"valac -v\""
54 :group 'org-babel
55 :version "26.1"
56 :package-version '(Org . "9.1")
57 :type 'string)
58
59;; This is the main function which is called to evaluate a code
60;; block.
61;;
62;; - run Vala compiler and create a binary in a temporary file
63;; - compiler/linker flags can be set via :flags header argument
64;; - if compilation succeeded, run the binary
65;; - commandline parameters to the binary can be set via :cmdline
66;; header argument
67;; - stdout will be parsed as RESULT (control via :result-params
68;; header argument)
69;;
70;; There is no session support because Vala is a compiled language.
71;;
72;; This function is heavily based on ob-C.el
73(defun org-babel-execute:vala (body params)
74 "Execute a block of Vala code with Babel.
75This function is called by `org-babel-execute-src-block'."
76 (message "executing Vala source code block")
77 (let* ((tmp-src-file (org-babel-temp-file
78 "vala-src-"
79 ".vala"))
80 (tmp-bin-file (org-babel-temp-file "vala-bin-" org-babel-exeext))
81 (cmdline (cdr (assq :cmdline params)))
82 (flags (cdr (assq :flags params))))
83 (with-temp-file tmp-src-file (insert body))
84 (org-babel-eval
85 (format "%s %s -o %s %s"
86 org-babel-vala-compiler
87 (mapconcat #'identity
88 (if (listp flags) flags (list flags)) " ")
89 (org-babel-process-file-name tmp-bin-file)
90 (org-babel-process-file-name tmp-src-file)) "")
91 (when (file-executable-p tmp-bin-file)
92 (let ((results
93 (org-trim
94 (org-babel-eval
95 (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
96 (org-babel-reassemble-table
97 (org-babel-result-cond (cdr (assq :result-params params))
98 (org-babel-read results)
99 (let ((tmp-file (org-babel-temp-file "vala-")))
100 (with-temp-file tmp-file (insert results))
101 (org-babel-import-elisp-from-file tmp-file)))
102 (org-babel-pick-name
103 (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
104 (org-babel-pick-name
105 (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))))
106
107(defun org-babel-prep-session:vala (_session _params)
108 "Prepare a session.
109This function does nothing as Vala is a compiled language with no
110support for sessions."
111 (error "Vala is a compiled language -- no support for sessions"))
112
113(provide 'ob-vala)
114
115;;; ob-vala.el ends here
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index a1ff76b36db..cf7a4dbf38b 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -277,10 +277,7 @@ list are are
277 277
278 :deadline List deadline due on that date. When the date is today, 278 :deadline List deadline due on that date. When the date is today,
279 also list any deadlines past due, or due within 279 also list any deadlines past due, or due within
280 `org-deadline-warning-days'. `:deadline' must appear before 280 `org-deadline-warning-days'.
281 `:scheduled' if the setting of
282 `org-agenda-skip-scheduled-if-deadline-is-shown' is to have
283 any effect.
284 281
285 :deadline* Same as above, but only include the deadline if it has an 282 :deadline* Same as above, but only include the deadline if it has an
286 hour specification as [h]h:mm. 283 hour specification as [h]h:mm.
@@ -327,12 +324,14 @@ the daily/weekly agenda, see `org-agenda-skip-function'.")
327 (string)) 324 (string))
328 (list :tag "Number of days in agenda" 325 (list :tag "Number of days in agenda"
329 (const org-agenda-span) 326 (const org-agenda-span)
330 (choice (const :tag "Day" day) 327 (list
331 (const :tag "Week" week) 328 (const :format "" quote)
332 (const :tag "Fortnight" fortnight) 329 (choice (const :tag "Day" day)
333 (const :tag "Month" month) 330 (const :tag "Week" week)
334 (const :tag "Year" year) 331 (const :tag "Fortnight" fortnight)
335 (integer :tag "Custom"))) 332 (const :tag "Month" month)
333 (const :tag "Year" year)
334 (integer :tag "Custom"))))
336 (list :tag "Fixed starting date" 335 (list :tag "Fixed starting date"
337 (const org-agenda-start-day) 336 (const org-agenda-start-day)
338 (string :value "2007-11-01")) 337 (string :value "2007-11-01"))
@@ -975,18 +974,6 @@ will only be dimmed."
975 (const :tag "Dim to a gray face" t) 974 (const :tag "Dim to a gray face" t)
976 (const :tag "Make invisible" invisible))) 975 (const :tag "Make invisible" invisible)))
977 976
978(defcustom org-timeline-show-empty-dates 3
979 "Non-nil means `org-timeline' also shows dates without an entry.
980When nil, only the days which actually have entries are shown.
981When t, all days between the first and the last date are shown.
982When an integer, show also empty dates, but if there is a gap of more than
983N days, just insert a special line indicating the size of the gap."
984 :group 'org-agenda-skip
985 :type '(choice
986 (const :tag "None" nil)
987 (const :tag "All" t)
988 (integer :tag "at most")))
989
990(defgroup org-agenda-startup nil 977(defgroup org-agenda-startup nil
991 "Options concerning initial settings in the Agenda in Org Mode." 978 "Options concerning initial settings in the Agenda in Org Mode."
992 :tag "Org Agenda Startup" 979 :tag "Org Agenda Startup"
@@ -1081,7 +1068,7 @@ have been removed when this is called, as will any matches for regular
1081expressions listed in `org-agenda-entry-text-exclude-regexps'.") 1068expressions listed in `org-agenda-entry-text-exclude-regexps'.")
1082 1069
1083(defvar org-agenda-include-inactive-timestamps nil 1070(defvar org-agenda-include-inactive-timestamps nil
1084 "Non-nil means include inactive time stamps in agenda and timeline. 1071 "Non-nil means include inactive time stamps in agenda.
1085Dynamically scoped.") 1072Dynamically scoped.")
1086 1073
1087(defgroup org-agenda-windows nil 1074(defgroup org-agenda-windows nil
@@ -1155,17 +1142,17 @@ When nil, only the days which actually have entries are shown."
1155 1142
1156(defcustom org-agenda-format-date 'org-agenda-format-date-aligned 1143(defcustom org-agenda-format-date 'org-agenda-format-date-aligned
1157 "Format string for displaying dates in the agenda. 1144 "Format string for displaying dates in the agenda.
1158Used by the daily/weekly agenda and by the timeline. This should be 1145Used by the daily/weekly agenda. This should be a format string
1159a format string understood by `format-time-string', or a function returning 1146understood by `format-time-string', or a function returning the
1160the formatted date as a string. The function must take a single argument, 1147formatted date as a string. The function must take a single
1161a calendar-style date list like (month day year)." 1148argument, a calendar-style date list like (month day year)."
1162 :group 'org-agenda-daily/weekly 1149 :group 'org-agenda-daily/weekly
1163 :type '(choice 1150 :type '(choice
1164 (string :tag "Format string") 1151 (string :tag "Format string")
1165 (function :tag "Function"))) 1152 (function :tag "Function")))
1166 1153
1167(defun org-agenda-format-date-aligned (date) 1154(defun org-agenda-format-date-aligned (date)
1168 "Format a DATE string for display in the daily/weekly agenda, or timeline. 1155 "Format a DATE string for display in the daily/weekly agenda.
1169This function makes sure that dates are aligned for easy reading." 1156This function makes sure that dates are aligned for easy reading."
1170 (require 'cal-iso) 1157 (require 'cal-iso)
1171 (let* ((dayname (calendar-day-name date)) 1158 (let* ((dayname (calendar-day-name date))
@@ -1225,8 +1212,7 @@ For example, 9:30am would become 09:30 rather than 9:30."
1225 1212
1226(defcustom org-agenda-weekend-days '(6 0) 1213(defcustom org-agenda-weekend-days '(6 0)
1227 "Which days are weekend? 1214 "Which days are weekend?
1228These days get the special face `org-agenda-date-weekend' in the agenda 1215These days get the special face `org-agenda-date-weekend' in the agenda."
1229and timeline buffers."
1230 :group 'org-agenda-daily/weekly 1216 :group 'org-agenda-daily/weekly
1231 :type '(set :greedy t 1217 :type '(set :greedy t
1232 (const :tag "Monday" 1) 1218 (const :tag "Monday" 1)
@@ -1260,17 +1246,43 @@ Custom commands can set this variable in the options section."
1260 :version "24.1" 1246 :version "24.1"
1261 :type 'boolean) 1247 :type 'boolean)
1262 1248
1263(defcustom org-agenda-repeating-timestamp-show-all t 1249(defcustom org-agenda-show-future-repeats t
1264 "Non-nil means show all occurrences of a repeating stamp in the agenda. 1250 "Non-nil shows repeated entries in the future part of the agenda.
1265When set to a list of strings, only show occurrences of repeating 1251When set to the symbol `next' only the first future repeat is shown."
1266stamps for these TODO keywords. When nil, only one occurrence is 1252 :group 'org-agenda-daily/weekly
1267shown, either today or the nearest into the future." 1253 :type '(choice
1254 (const :tag "Show all repeated entries" t)
1255 (const :tag "Show next repeated entry" next)
1256 (const :tag "Do not show repeated entries" nil))
1257 :version "26.1"
1258 :package-version '(Org . "9.1")
1259 :safe #'symbolp)
1260
1261(defcustom org-agenda-prefer-last-repeat nil
1262 "Non-nil sets date for repeated entries to their last repeat.
1263
1264When nil, display SCHEDULED and DEADLINE dates at their base
1265date, and in today's agenda, as a reminder. Display plain
1266time-stamps, on the other hand, at every repeat date in the past
1267in addition to the base date.
1268
1269When non-nil, show a repeated entry at its latest repeat date,
1270possibly being today even if it wasn't marked as done. This
1271setting is useful if you do not always mark repeated entries as
1272done and, yet, consider that reaching repeat date starts the task
1273anew.
1274
1275When set to a list of strings, prefer last repeats only for
1276entries with these TODO keywords."
1268 :group 'org-agenda-daily/weekly 1277 :group 'org-agenda-daily/weekly
1269 :type '(choice 1278 :type '(choice
1270 (const :tag "Show repeating stamps" t) 1279 (const :tag "Prefer last repeat" t)
1271 (repeat :tag "Show repeating stamps for these TODO keywords" 1280 (const :tag "Prefer base date" nil)
1272 (string :tag "TODO Keyword")) 1281 (repeat :tag "Prefer last repeat for entries with these TODO keywords"
1273 (const :tag "Don't show repeating stamps" nil))) 1282 (string :tag "TODO keyword")))
1283 :version "26.1"
1284 :package-version '(Org . "9.1")
1285 :safe (lambda (x) (or (booleanp x) (consp x))))
1274 1286
1275(defcustom org-scheduled-past-days 10000 1287(defcustom org-scheduled-past-days 10000
1276 "Number of days to continue listing scheduled items not marked DONE. 1288 "Number of days to continue listing scheduled items not marked DONE.
@@ -1278,7 +1290,19 @@ When an item is scheduled on a date, it shows up in the agenda on
1278this day and will be listed until it is marked done or for the 1290this day and will be listed until it is marked done or for the
1279number of days given here." 1291number of days given here."
1280 :group 'org-agenda-daily/weekly 1292 :group 'org-agenda-daily/weekly
1281 :type 'integer) 1293 :type 'integer
1294 :safe 'integerp)
1295
1296(defcustom org-deadline-past-days 10000
1297 "Number of days to warn about missed deadlines.
1298When an item has deadline on a date, it shows up in the agenda on
1299this day and will appear as a reminder until it is marked DONE or
1300for the number of days given here."
1301 :group 'org-agenda-daily/weekly
1302 :type 'integer
1303 :version "26.1"
1304 :package-version '(Org . "9.1")
1305 :safe 'integerp)
1282 1306
1283(defcustom org-agenda-log-mode-items '(closed clock) 1307(defcustom org-agenda-log-mode-items '(closed clock)
1284 "List of items that should be shown in agenda log mode. 1308 "List of items that should be shown in agenda log mode.
@@ -1421,7 +1445,7 @@ E.g. when this is set to 1, the search view will only
1421show headlines of level 1. When set to 0, the default 1445show headlines of level 1. When set to 0, the default
1422value, don't limit agenda view by outline level." 1446value, don't limit agenda view by outline level."
1423 :group 'org-agenda-search-view 1447 :group 'org-agenda-search-view
1424 :version "24.4" 1448 :version "26.1"
1425 :package-version '(Org . "8.3") 1449 :package-version '(Org . "8.3")
1426 :type 'integer) 1450 :type 'integer)
1427 1451
@@ -1453,11 +1477,12 @@ the variable `org-agenda-time-grid'."
1453 1477
1454(defcustom org-agenda-time-grid 1478(defcustom org-agenda-time-grid
1455 '((daily today require-timed) 1479 '((daily today require-timed)
1456 "----------------" 1480 (800 1000 1200 1400 1600 1800 2000)
1457 (800 1000 1200 1400 1600 1800 2000)) 1481 "......"
1482 "----------------")
1458 1483
1459 "The settings for time grid for agenda display. 1484 "The settings for time grid for agenda display.
1460This is a list of three items. The first item is again a list. It contains 1485This is a list of four items. The first item is again a list. It contains
1461symbols specifying conditions when the grid should be displayed: 1486symbols specifying conditions when the grid should be displayed:
1462 1487
1463 daily if the agenda shows a single day 1488 daily if the agenda shows a single day
@@ -1466,10 +1491,14 @@ symbols specifying conditions when the grid should be displayed:
1466 require-timed show grid only if at least one item has a time specification 1491 require-timed show grid only if at least one item has a time specification
1467 remove-match skip grid times already present in an entry 1492 remove-match skip grid times already present in an entry
1468 1493
1469The second item is a string which will be placed behind the grid time. 1494The second item is a list of integers, indicating the times that
1495should have a grid line.
1470 1496
1471The third item is a list of integers, indicating the times that should have 1497The third item is a string which will be placed right after the
1472a grid line." 1498times that have a grid line.
1499
1500The fourth item is a string placed after the grid times. This
1501will align with agenda items"
1473 :group 'org-agenda-time-grid 1502 :group 'org-agenda-time-grid
1474 :type 1503 :type
1475 '(list 1504 '(list
@@ -1481,8 +1510,9 @@ a grid line."
1481 require-timed) 1510 require-timed)
1482 (const :tag "Skip grid times already present in an entry" 1511 (const :tag "Skip grid times already present in an entry"
1483 remove-match)) 1512 remove-match))
1484 (string :tag "Grid String") 1513 (repeat :tag "Grid Times" (integer :tag "Time"))
1485 (repeat :tag "Grid Times" (integer :tag "Time")))) 1514 (string :tag "Grid String (after agenda times)")
1515 (string :tag "Grid String (aligns with agenda items)")))
1486 1516
1487(defcustom org-agenda-show-current-time-in-grid t 1517(defcustom org-agenda-show-current-time-in-grid t
1488 "Non-nil means show the current time in the time grid." 1518 "Non-nil means show the current time in the time grid."
@@ -1610,13 +1640,12 @@ When nil, such items are sorted as 0 minutes effort."
1610 1640
1611(defcustom org-agenda-prefix-format 1641(defcustom org-agenda-prefix-format
1612 '((agenda . " %i %-12:c%?-12t% s") 1642 '((agenda . " %i %-12:c%?-12t% s")
1613 (timeline . " % s")
1614 (todo . " %i %-12:c") 1643 (todo . " %i %-12:c")
1615 (tags . " %i %-12:c") 1644 (tags . " %i %-12:c")
1616 (search . " %i %-12:c")) 1645 (search . " %i %-12:c"))
1617 "Format specifications for the prefix of items in the agenda views. 1646 "Format specifications for the prefix of items in the agenda views.
1618An alist with five entries, each for the different agenda types. The 1647An alist with five entries, each for the different agenda types. The
1619keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'. 1648keys of the sublists are `agenda', `todo', `search' and `tags'.
1620The values are format strings. 1649The values are format strings.
1621 1650
1622This format works similar to a printf format, with the following meaning: 1651This format works similar to a printf format, with the following meaning:
@@ -1669,11 +1698,12 @@ Custom commands can set this variable in the options section."
1669 (string :tag "General format") 1698 (string :tag "General format")
1670 (list :greedy t :tag "View dependent" 1699 (list :greedy t :tag "View dependent"
1671 (cons (const agenda) (string :tag "Format")) 1700 (cons (const agenda) (string :tag "Format"))
1672 (cons (const timeline) (string :tag "Format"))
1673 (cons (const todo) (string :tag "Format")) 1701 (cons (const todo) (string :tag "Format"))
1674 (cons (const tags) (string :tag "Format")) 1702 (cons (const tags) (string :tag "Format"))
1675 (cons (const search) (string :tag "Format")))) 1703 (cons (const search) (string :tag "Format"))))
1676 :group 'org-agenda-line-format) 1704 :group 'org-agenda-line-format
1705 :version "26.1"
1706 :package-version '(Org . "9.1"))
1677 1707
1678(defvar org-prefix-format-compiled nil 1708(defvar org-prefix-format-compiled nil
1679 "The compiled prefix format and associated variables. 1709 "The compiled prefix format and associated variables.
@@ -1795,7 +1825,7 @@ given agenda type.
1795 1825
1796This can be set to a list of agenda types in which the agenda 1826This can be set to a list of agenda types in which the agenda
1797must display the inherited tags. Available types are `todo', 1827must display the inherited tags. Available types are `todo',
1798`agenda', `search' and `timeline'. 1828`agenda' and `search'.
1799 1829
1800When set to nil, never show inherited tags in agenda lines." 1830When set to nil, never show inherited tags in agenda lines."
1801 :group 'org-agenda-line-format 1831 :group 'org-agenda-line-format
@@ -1807,7 +1837,7 @@ When set to nil, never show inherited tags in agenda lines."
1807 (repeat :tag "Show inherited tags only in selected agenda types" 1837 (repeat :tag "Show inherited tags only in selected agenda types"
1808 (symbol :tag "Agenda type")))) 1838 (symbol :tag "Agenda type"))))
1809 1839
1810(defcustom org-agenda-use-tag-inheritance '(todo search timeline agenda) 1840(defcustom org-agenda-use-tag-inheritance '(todo search agenda)
1811 "List of agenda view types where to use tag inheritance. 1841 "List of agenda view types where to use tag inheritance.
1812 1842
1813In tags/tags-todo/tags-tree agenda views, tag inheritance is 1843In tags/tags-todo/tags-tree agenda views, tag inheritance is
@@ -1816,7 +1846,7 @@ controlled by `org-use-tag-inheritance'. In other agenda types,
1816agenda entries. Still, you may want the agenda to be aware of 1846agenda entries. Still, you may want the agenda to be aware of
1817the inherited tags anyway, e.g. for later tag filtering. 1847the inherited tags anyway, e.g. for later tag filtering.
1818 1848
1819Allowed value are `todo', `search', `timeline' and `agenda'. 1849Allowed value are `todo', `search' and `agenda'.
1820 1850
1821This variable has no effect if `org-agenda-show-inherited-tags' 1851This variable has no effect if `org-agenda-show-inherited-tags'
1822is set to `always'. In that case, the agenda is aware of those 1852is set to `always'. In that case, the agenda is aware of those
@@ -1825,7 +1855,8 @@ tags.
1825The default value sets tags in every agenda type. Setting this 1855The default value sets tags in every agenda type. Setting this
1826option to nil will speed up non-tags agenda view a lot." 1856option to nil will speed up non-tags agenda view a lot."
1827 :group 'org-agenda 1857 :group 'org-agenda
1828 :version "24.3" 1858 :version "26.1"
1859 :package-version '(Org . "9.1")
1829 :type '(choice 1860 :type '(choice
1830 (const :tag "Use tag inheritance in all agenda types" t) 1861 (const :tag "Use tag inheritance in all agenda types" t)
1831 (repeat :tag "Use tag inheritance in selected agenda types" 1862 (repeat :tag "Use tag inheritance in selected agenda types"
@@ -1854,13 +1885,21 @@ When this is the symbol `prefix', only remove tags when
1854(defvaralias 'org-agenda-remove-tags-when-in-prefix 1885(defvaralias 'org-agenda-remove-tags-when-in-prefix
1855 'org-agenda-remove-tags) 1886 'org-agenda-remove-tags)
1856 1887
1857(defcustom org-agenda-tags-column -80 1888(defcustom org-agenda-tags-column 'auto
1858 "Shift tags in agenda items to this column. 1889 "Shift tags in agenda items to this column.
1859If this number is positive, it specifies the column. If it is negative, 1890If set to `auto', tags will be automatically aligned to the right
1860it means that the tags should be flushright to that column. For example, 1891edge of the window.
1861-80 works well for a normal 80 character screen." 1892
1893If set to a positive number, tags will be left-aligned to that
1894column. If set to a negative number, tags will be right-aligned
1895to that column. For example, -80 works well for a normal 80
1896character screen."
1862 :group 'org-agenda-line-format 1897 :group 'org-agenda-line-format
1863 :type 'integer) 1898 :type '(choice
1899 (const :tag "Automatically align to right edge of window" auto)
1900 (integer :tag "Specific column" -80))
1901 :package-version '(Org . "9.1")
1902 :version "26.1")
1864 1903
1865(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) 1904(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
1866 1905
@@ -2259,7 +2298,7 @@ The following commands are available:
2259(org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines) 2298(org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines)
2260(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) 2299(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
2261(org-defkey org-agenda-mode-map "r" 'org-agenda-redo) 2300(org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
2262(org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t))) 2301(org-defkey org-agenda-mode-map "g" 'org-agenda-redo-all)
2263(org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort) 2302(org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort)
2264(org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort) 2303(org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort)
2265(org-defkey org-agenda-mode-map "\C-c\C-x\C-e" 2304(org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
@@ -2310,6 +2349,7 @@ The following commands are available:
2310(org-defkey org-agenda-mode-map "b" 'org-agenda-earlier) 2349(org-defkey org-agenda-mode-map "b" 'org-agenda-earlier)
2311(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) 2350(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
2312(org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) 2351(org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
2352(org-defkey org-agenda-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock-from-agenda)
2313 2353
2314(org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add) 2354(org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add)
2315(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract) 2355(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract)
@@ -2323,6 +2363,7 @@ The following commands are available:
2323(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category) 2363(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
2324(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline) 2364(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline)
2325(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) 2365(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
2366(org-defkey org-agenda-mode-map "\C-c\C-x_" 'org-timer-stop)
2326(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note) 2367(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
2327(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) 2368(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
2328(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) 2369(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
@@ -2340,7 +2381,7 @@ The following commands are available:
2340 ("Agenda Files") 2381 ("Agenda Files")
2341 "--" 2382 "--"
2342 ("Agenda Dates" 2383 ("Agenda Dates"
2343 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)] 2384 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)]
2344 ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] 2385 ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
2345 ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] 2386 ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
2346 ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)]) 2387 ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
@@ -2386,7 +2427,7 @@ The following commands are available:
2386 "--" 2427 "--"
2387 ["Show Logbook entries" org-agenda-log-mode 2428 ["Show Logbook entries" org-agenda-log-mode
2388 :style toggle :selected org-agenda-show-log 2429 :style toggle :selected org-agenda-show-log
2389 :active (org-agenda-check-type nil 'agenda 'timeline) 2430 :active (org-agenda-check-type nil 'agenda)
2390 :keys "v l (or just l)"] 2431 :keys "v l (or just l)"]
2391 ["Include archived trees" org-agenda-archives-mode 2432 ["Include archived trees" org-agenda-archives-mode
2392 :style toggle :selected org-agenda-archives-mode :active t 2433 :style toggle :selected org-agenda-archives-mode :active t
@@ -2443,13 +2484,13 @@ The following commands are available:
2443 ["Schedule" org-agenda-schedule t] 2484 ["Schedule" org-agenda-schedule t]
2444 ["Set Deadline" org-agenda-deadline t] 2485 ["Set Deadline" org-agenda-deadline t]
2445 "--" 2486 "--"
2446 ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] 2487 ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)]
2447 ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] 2488 ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)]
2448 ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"] 2489 ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"]
2449 ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"] 2490 ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"]
2450 ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"] 2491 ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"]
2451 ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"] 2492 ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"]
2452 ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) 2493 ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)])
2453 ("Clock and Effort" 2494 ("Clock and Effort"
2454 ["Clock in" org-agenda-clock-in t] 2495 ["Clock in" org-agenda-clock-in t]
2455 ["Clock out" org-agenda-clock-out t] 2496 ["Clock out" org-agenda-clock-out t]
@@ -2465,12 +2506,12 @@ The following commands are available:
2465 ["Decrease Priority" org-agenda-priority-down t] 2506 ["Decrease Priority" org-agenda-priority-down t]
2466 ["Show Priority" org-show-priority t]) 2507 ["Show Priority" org-show-priority t])
2467 ("Calendar/Diary" 2508 ("Calendar/Diary"
2468 ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)] 2509 ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)]
2469 ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)] 2510 ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)]
2470 ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)] 2511 ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)]
2471 ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)] 2512 ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)]
2472 ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)] 2513 ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)]
2473 ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)] 2514 ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)]
2474 "--" 2515 "--"
2475 ["Create iCalendar File" org-icalendar-combine-agenda-files t]) 2516 ["Create iCalendar File" org-icalendar-combine-agenda-files t])
2476 "--" 2517 "--"
@@ -2606,8 +2647,7 @@ type."
2606 (const agenda) 2647 (const agenda)
2607 (const todo) 2648 (const todo)
2608 (const tags) 2649 (const tags)
2609 (const search) 2650 (const search))
2610 (const timeline))
2611 (integer :tag "Max number of entries"))))) 2651 (integer :tag "Max number of entries")))))
2612 2652
2613(defcustom org-agenda-max-todos nil 2653(defcustom org-agenda-max-todos nil
@@ -2625,8 +2665,7 @@ type."
2625 (const agenda) 2665 (const agenda)
2626 (const todo) 2666 (const todo)
2627 (const tags) 2667 (const tags)
2628 (const search) 2668 (const search))
2629 (const timeline))
2630 (integer :tag "Max number of TODOs"))))) 2669 (integer :tag "Max number of TODOs")))))
2631 2670
2632(defcustom org-agenda-max-tags nil 2671(defcustom org-agenda-max-tags nil
@@ -2644,8 +2683,7 @@ type."
2644 (const agenda) 2683 (const agenda)
2645 (const todo) 2684 (const todo)
2646 (const tags) 2685 (const tags)
2647 (const search) 2686 (const search))
2648 (const timeline))
2649 (integer :tag "Max number of tagged entries"))))) 2687 (integer :tag "Max number of tagged entries")))))
2650 2688
2651(defcustom org-agenda-max-effort nil 2689(defcustom org-agenda-max-effort nil
@@ -2663,8 +2701,7 @@ to limit entries to in this type."
2663 (const agenda) 2701 (const agenda)
2664 (const todo) 2702 (const todo)
2665 (const tags) 2703 (const tags)
2666 (const search) 2704 (const search))
2667 (const timeline))
2668 (integer :tag "Max number of minutes"))))) 2705 (integer :tag "Max number of minutes")))))
2669 2706
2670(defvar org-agenda-keep-restricted-file-list nil) 2707(defvar org-agenda-keep-restricted-file-list nil)
@@ -2683,7 +2720,6 @@ T Call `org-todo-list' to display the global todo list, select only
2683m Call `org-tags-view' to display headlines with tags matching 2720m Call `org-tags-view' to display headlines with tags matching
2684 a condition (the user is prompted for the condition). 2721 a condition (the user is prompted for the condition).
2685M Like `m', but select only TODO entries, no ordinary headlines. 2722M Like `m', but select only TODO entries, no ordinary headlines.
2686L Create a timeline for the current buffer.
2687e Export views to associated files. 2723e Export views to associated files.
2688s Search entries for keywords. 2724s Search entries for keywords.
2689S Search entries for keywords, only with TODO keywords. 2725S Search entries for keywords, only with TODO keywords.
@@ -2846,12 +2882,6 @@ Pressing `<' twice means to restrict to the current subtree or region
2846 (copy-sequence note)) 2882 (copy-sequence note))
2847 nil 'face 'org-warning))))))) 2883 nil 'face 'org-warning)))))))
2848 t t)) 2884 t t))
2849 ((equal org-keys "L")
2850 (unless (derived-mode-p 'org-mode)
2851 (user-error "This is not an Org file"))
2852 (unless restriction
2853 (put 'org-agenda-files 'org-restrict (list bfn))
2854 (org-call-with-arg 'org-timeline arg)))
2855 ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects)) 2885 ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
2856 ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files)) 2886 ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
2857 ((equal org-keys "!") (customize-variable 'org-stuck-projects)) 2887 ((equal org-keys "!") (customize-variable 'org-stuck-projects))
@@ -2901,15 +2931,15 @@ Agenda views are separated by `org-agenda-block-separator'."
2901 (erase-buffer) 2931 (erase-buffer)
2902 (insert (eval-when-compile 2932 (insert (eval-when-compile
2903 (let ((header 2933 (let ((header
2904 "Press key for an agenda command: < Buffer, subtree/region restriction 2934 "Press key for an agenda command:
2905-------------------------------- > Remove restriction 2935-------------------------------- < Buffer, subtree/region restriction
2906a Agenda for current week or day e Export agenda views 2936a Agenda for current week or day > Remove restriction
2907t List of all TODO entries T Entries with special TODO kwd 2937t List of all TODO entries e Export agenda views
2908m Match a TAGS/PROP/TODO query M Like m, but only TODO entries 2938m Match a TAGS/PROP/TODO query T Entries with special TODO kwd
2909s Search for keywords S Like s, but only TODO entries 2939s Search for keywords M Like m, but only TODO entries
2910L Timeline for current buffer # List stuck projects (!=configure) 2940/ Multi-occur S Like s, but only TODO entries
2911/ Multi-occur C Configure custom agenda commands 2941? Find :FLAGGED: entries C Configure custom agenda commands
2912? Find :FLAGGED: entries * Toggle sticky agenda views 2942* Toggle sticky agenda views # List stuck projects (!=configure)
2913") 2943")
2914 (start 0)) 2944 (start 0))
2915 (while (string-match 2945 (while (string-match
@@ -3344,6 +3374,7 @@ the agenda to write."
3344 (save-window-excursion 3374 (save-window-excursion
3345 (let ((bs (copy-sequence (buffer-string))) 3375 (let ((bs (copy-sequence (buffer-string)))
3346 (extension (file-name-extension file)) 3376 (extension (file-name-extension file))
3377 (default-directory (file-name-directory file))
3347 beg content) 3378 beg content)
3348 (with-temp-buffer 3379 (with-temp-buffer
3349 (rename-buffer org-agenda-write-buffer-name t) 3380 (rename-buffer org-agenda-write-buffer-name t)
@@ -3374,7 +3405,8 @@ the agenda to write."
3374 (kill-buffer (current-buffer)) 3405 (kill-buffer (current-buffer))
3375 (message "Org file written to %s" file))) 3406 (message "Org file written to %s" file)))
3376 ((member extension '("html" "htm")) 3407 ((member extension '("html" "htm"))
3377 (require 'htmlize) 3408 (or (require 'htmlize nil t)
3409 (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
3378 (set-buffer (htmlize-buffer (current-buffer))) 3410 (set-buffer (htmlize-buffer (current-buffer)))
3379 (when org-agenda-export-html-style 3411 (when org-agenda-export-html-style
3380 ;; replace <style> section with org-agenda-export-html-style 3412 ;; replace <style> section with org-agenda-export-html-style
@@ -3858,35 +3890,53 @@ dimming them."
3858 (when (eq (overlay-get o 'org-type) 'org-blocked-todo) 3890 (when (eq (overlay-get o 'org-type) 'org-blocked-todo)
3859 (delete-overlay o))) 3891 (delete-overlay o)))
3860 (save-excursion 3892 (save-excursion
3861 (let ((inhibit-read-only t) 3893 (let ((inhibit-read-only t))
3862 (org-depend-tag-blocked nil)
3863 org-blocked-by-checkboxes)
3864 (goto-char (point-min)) 3894 (goto-char (point-min))
3865 (while (let ((pos (text-property-not-all 3895 (while (let ((pos (text-property-not-all
3866 (point) (point-max) 'todo-state nil))) 3896 (point) (point-max) 'org-todo-blocked nil)))
3867 (when pos (goto-char pos))) 3897 (when pos (goto-char pos)))
3868 (setq org-blocked-by-checkboxes nil) 3898 (let* ((invisible (eq (org-get-at-bol 'org-todo-blocked) 'invisible))
3869 (let ((marker (org-get-at-bol 'org-hd-marker))) 3899 (ov (make-overlay (if invisible
3870 (when (and (markerp marker) 3900 (line-end-position 0)
3871 (with-current-buffer (marker-buffer marker) 3901 (line-beginning-position))
3872 (save-excursion (goto-char marker) 3902 (line-end-position))))
3873 (org-entry-blocked-p)))) 3903 (if invisible
3874 ;; Entries blocked by checkboxes cannot be made invisible. 3904 (overlay-put ov 'invisible t)
3875 ;; See `org-agenda-dim-blocked-tasks' for details. 3905 (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
3876 (let* ((really-invisible 3906 (overlay-put ov 'org-type 'org-blocked-todo))
3877 (and (not org-blocked-by-checkboxes)
3878 (or invisible (eq org-agenda-dim-blocked-tasks
3879 'invisible))))
3880 (ov (make-overlay (if really-invisible (line-end-position 0)
3881 (line-beginning-position))
3882 (line-end-position))))
3883 (if really-invisible (overlay-put ov 'invisible t)
3884 (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
3885 (overlay-put ov 'org-type 'org-blocked-todo))))
3886 (forward-line)))) 3907 (forward-line))))
3887 (when (called-interactively-p 'interactive) 3908 (when (called-interactively-p 'interactive)
3888 (message "Dim or hide blocked tasks...done"))) 3909 (message "Dim or hide blocked tasks...done")))
3889 3910
3911(defun org-agenda--mark-blocked-entry (entry)
3912 "For ENTRY a string with the text property `org-hd-marker', if
3913the header at `org-hd-marker' is blocked according to
3914`org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is
3915'invisible and the header is not blocked by checkboxes, set the
3916text property `org-todo-blocked' to 'invisible, otherwise set it
3917to t."
3918 (when (get-text-property 0 'todo-state entry)
3919 (let ((entry-marker (get-text-property 0 'org-hd-marker entry))
3920 (org-blocked-by-checkboxes nil)
3921 ;; Necessary so that `org-entry-blocked-p' does not change
3922 ;; the buffer.
3923 (org-depend-tag-blocked nil))
3924 (when entry-marker
3925 (let ((blocked
3926 (with-current-buffer (marker-buffer entry-marker)
3927 (save-excursion
3928 (goto-char entry-marker)
3929 (org-entry-blocked-p)))))
3930 (when blocked
3931 (let ((really-invisible
3932 (and (not org-blocked-by-checkboxes)
3933 (eq org-agenda-dim-blocked-tasks 'invisible))))
3934 (put-text-property
3935 0 (length entry) 'org-todo-blocked
3936 (if really-invisible 'invisible t)
3937 entry)))))))
3938 entry)
3939
3890(defvar org-agenda-skip-function nil 3940(defvar org-agenda-skip-function nil
3891 "Function to be called at each match during agenda construction. 3941 "Function to be called at each match during agenda construction.
3892If this function returns nil, the current match should not be skipped. 3942If this function returns nil, the current match should not be skipped.
@@ -4012,152 +4062,7 @@ This check for agenda markers in all agenda buffers currently active."
4012 'org-agenda-date-weekend) 4062 'org-agenda-date-weekend)
4013 (t 'org-agenda-date))) 4063 (t 'org-agenda-date)))
4014 4064
4015;;; Agenda timeline 4065(defvar org-agenda-show-log-scoped)
4016
4017(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
4018(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
4019
4020(defun org-timeline (&optional dotodo)
4021 "Show a time-sorted view of the entries in the current Org file.
4022
4023Only entries with a time stamp of today or later will be listed.
4024
4025With `\\[universal-argument]' prefix, all unfinished TODO items will also be \
4026shown,
4027under the current date.
4028
4029If the buffer contains an active region, only check the region
4030for dates."
4031 (interactive "P")
4032 (let* ((dopast t)
4033 (org-agenda-show-log-scoped org-agenda-show-log)
4034 (org-agenda-show-log org-agenda-show-log-scoped)
4035 (entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
4036 (current-buffer))))
4037 (date (calendar-current-date))
4038 (beg (if (org-region-active-p) (region-beginning) (point-min)))
4039 (end (if (org-region-active-p) (region-end) (point-max)))
4040 (day-numbers (org-get-all-dates
4041 beg end 'no-ranges
4042 t org-agenda-show-log-scoped ; always include today
4043 org-timeline-show-empty-dates))
4044 (org-deadline-warning-days 0)
4045 (org-agenda-only-exact-dates t)
4046 (today (org-today))
4047 (past t)
4048 args
4049 s e rtn d emptyp)
4050 (setq org-agenda-redo-command
4051 (list 'let
4052 (list (list 'org-agenda-show-log 'org-agenda-show-log))
4053 (list 'org-switch-to-buffer-other-window (current-buffer))
4054 (list 'org-timeline (list 'quote dotodo))))
4055 (put 'org-agenda-redo-command 'org-lprops nil)
4056 (if (not dopast)
4057 ;; Remove past dates from the list of dates.
4058 (setq day-numbers (delq nil (mapcar (lambda(x)
4059 (if (>= x today) x nil))
4060 day-numbers))))
4061 (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry)))
4062 (org-compile-prefix-format 'timeline)
4063 (org-set-sorting-strategy 'timeline)
4064 (if org-agenda-show-log-scoped (push :closed args))
4065 (push :timestamp args)
4066 (push :deadline args)
4067 (push :scheduled args)
4068 (push :sexp args)
4069 (if dotodo (push :todo args))
4070 (insert "Timeline of file " entry "\n")
4071 (add-text-properties (point-min) (point)
4072 (list 'face 'org-agenda-structure))
4073 (org-agenda-mark-header-line (point-min))
4074 (while (setq d (pop day-numbers))
4075 (if (and (listp d) (eq (car d) :omitted))
4076 (progn
4077 (setq s (point))
4078 (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
4079 (put-text-property s (1- (point)) 'face 'org-agenda-structure))
4080 (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
4081 (if (and (>= d today)
4082 dopast
4083 past)
4084 (progn
4085 (setq past nil)
4086 (insert (make-string 79 ?-) "\n")))
4087 (setq date (calendar-gregorian-from-absolute d))
4088 (setq s (point))
4089 (setq rtn (and (not emptyp)
4090 (apply 'org-agenda-get-day-entries entry
4091 date args)))
4092 (if (or rtn (equal d today) org-timeline-show-empty-dates)
4093 (progn
4094 (insert
4095 (if (stringp org-agenda-format-date)
4096 (format-time-string org-agenda-format-date
4097 (org-time-from-absolute date))
4098 (funcall org-agenda-format-date date))
4099 "\n")
4100 (put-text-property s (1- (point)) 'face
4101 (org-agenda-get-day-face date))
4102 (put-text-property s (1- (point)) 'org-date-line t)
4103 (put-text-property s (1- (point)) 'org-agenda-date-header t)
4104 (if (equal d today)
4105 (put-text-property s (1- (point)) 'org-today t))
4106 (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\n"))
4107 (put-text-property s (1- (point)) 'day d)))))
4108 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
4109 (point-min)))
4110 (add-text-properties
4111 (point-min) (point-max)
4112 `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command))
4113 (org-agenda-finalize)
4114 (setq buffer-read-only t)))
4115
4116(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re)
4117 "Return a list of all relevant day numbers from BEG to END buffer positions.
4118If NO-RANGES is non-nil, include only the start and end dates of a range,
4119not every single day in the range. If FORCE-TODAY is non-nil, make
4120sure that TODAY is included in the list. If INACTIVE is non-nil, also
4121inactive time stamps (those in square brackets) are included.
4122When EMPTY is non-nil, also include days without any entries."
4123 (let ((re (concat
4124 (if pre-re pre-re "")
4125 (if inactive org-ts-regexp-both org-ts-regexp)))
4126 dates dates1 date day day1 day2 ts1 ts2 pos)
4127 (if force-today
4128 (setq dates (list (org-today))))
4129 (save-excursion
4130 (goto-char beg)
4131 (while (re-search-forward re end t)
4132 (setq day (time-to-days (org-time-string-to-time
4133 (substring (match-string 1) 0 10)
4134 (current-buffer) (match-beginning 0))))
4135 (or (memq day dates) (push day dates)))
4136 (unless no-ranges
4137 (goto-char beg)
4138 (while (re-search-forward org-tr-regexp end t)
4139 (setq pos (match-beginning 0))
4140 (setq ts1 (substring (match-string 1) 0 10)
4141 ts2 (substring (match-string 2) 0 10)
4142 day1 (time-to-days (org-time-string-to-time
4143 ts1 (current-buffer) pos))
4144 day2 (time-to-days (org-time-string-to-time
4145 ts2 (current-buffer) pos)))
4146 (while (< (setq day1 (1+ day1)) day2)
4147 (or (memq day1 dates) (push day1 dates)))))
4148 (setq dates (sort dates '<))
4149 (when empty
4150 (while (setq day (pop dates))
4151 (setq day2 (car dates))
4152 (push day dates1)
4153 (when (and day2 empty)
4154 (if (or (eq empty t)
4155 (and (numberp empty) (<= (- day2 day) empty)))
4156 (while (< (setq day (1+ day)) day2)
4157 (push (list day) dates1))
4158 (push (cons :omitted (- day2 day)) dates1))))
4159 (setq dates (nreverse dates1)))
4160 dates)))
4161 4066
4162;;; Agenda Daily/Weekly 4067;;; Agenda Daily/Weekly
4163 4068
@@ -4463,8 +4368,9 @@ as a whole, to include whitespace.
4463 with a colon, this will mean that the (non-regexp) snippets of the 4368 with a colon, this will mean that the (non-regexp) snippets of the
4464 Boolean search must match as full words. 4369 Boolean search must match as full words.
4465 4370
4466This command searches the agenda files, and in addition the files listed 4371This command searches the agenda files, and in addition the files
4467in `org-agenda-text-search-extra-files'." 4372listed in `org-agenda-text-search-extra-files' unless a restriction lock
4373is active."
4468 (interactive "P") 4374 (interactive "P")
4469 (if org-agenda-overriding-arguments 4375 (if org-agenda-overriding-arguments
4470 (setq todo-only (car org-agenda-overriding-arguments) 4376 (setq todo-only (car org-agenda-overriding-arguments)
@@ -4520,7 +4426,7 @@ in `org-agenda-text-search-extra-files'."
4520 (if (or org-agenda-search-view-always-boolean 4426 (if (or org-agenda-search-view-always-boolean
4521 (member (string-to-char words) '(?- ?+ ?\{))) 4427 (member (string-to-char words) '(?- ?+ ?\{)))
4522 (setq boolean t)) 4428 (setq boolean t))
4523 (setq words (org-split-string words)) 4429 (setq words (split-string words))
4524 (let (www w) 4430 (let (www w)
4525 (while (setq w (pop words)) 4431 (while (setq w (pop words))
4526 (while (and (string-match "\\\\\\'" w) words) 4432 (while (and (string-match "\\\\\\'" w) words)
@@ -4574,10 +4480,20 @@ in `org-agenda-text-search-extra-files'."
4574 (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" 4480 (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
4575 regexp)))) 4481 regexp))))
4576 (setq files (org-agenda-files nil 'ifmode)) 4482 (setq files (org-agenda-files nil 'ifmode))
4577 (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) 4483 ;; Add `org-agenda-text-search-extra-files' unless there is some
4578 (pop org-agenda-text-search-extra-files) 4484 ;; restriction.
4579 (setq files (org-add-archive-files files))) 4485 (unless (get 'org-agenda-files 'org-restrict)
4580 (setq files (append files org-agenda-text-search-extra-files) 4486 (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
4487 (pop org-agenda-text-search-extra-files)
4488 (setq files (org-add-archive-files files))))
4489 ;; Uniquify files. However, let `org-check-agenda-file' handle
4490 ;; non-existent ones.
4491 (setq files (cl-remove-duplicates
4492 (append files org-agenda-text-search-extra-files)
4493 :test (lambda (a b)
4494 (and (file-exists-p a)
4495 (file-exists-p b)
4496 (file-equal-p a b))))
4581 rtnall nil) 4497 rtnall nil)
4582 (while (setq file (pop files)) 4498 (while (setq file (pop files))
4583 (setq ee nil) 4499 (setq ee nil)
@@ -4632,12 +4548,12 @@ in `org-agenda-text-search-extra-files'."
4632 (point-at-bol) 4548 (point-at-bol)
4633 (if hdl-only (point-at-eol) end))) 4549 (if hdl-only (point-at-eol) end)))
4634 (mapc (lambda (wr) (when (string-match wr str) 4550 (mapc (lambda (wr) (when (string-match wr str)
4635 (goto-char (1- end)) 4551 (goto-char (1- end))
4636 (throw :skip t))) 4552 (throw :skip t)))
4637 regexps-) 4553 regexps-)
4638 (mapc (lambda (wr) (unless (string-match wr str) 4554 (mapc (lambda (wr) (unless (string-match wr str)
4639 (goto-char (1- end)) 4555 (goto-char (1- end))
4640 (throw :skip t))) 4556 (throw :skip t)))
4641 (if todo-only 4557 (if todo-only
4642 (cons (concat "^\\*+[ \t]+" 4558 (cons (concat "^\\*+[ \t]+"
4643 org-not-done-regexp) 4559 org-not-done-regexp)
@@ -4913,43 +4829,6 @@ used by user-defined selections using `org-agenda-skip-function'.")
4913This variable should not be set directly, but custom commands can bind it 4829This variable should not be set directly, but custom commands can bind it
4914in the options section.") 4830in the options section.")
4915 4831
4916(defun org-agenda-skip-entry-when-regexp-matches ()
4917 "Check if the current entry contains match for `org-agenda-skip-regexp'.
4918If yes, it returns the end position of this entry, causing agenda commands
4919to skip the entry but continuing the search in the subtree. This is a
4920function that can be put into `org-agenda-skip-function' for the duration
4921of a command."
4922 (let ((end (save-excursion (org-end-of-subtree t)))
4923 skip)
4924 (save-excursion
4925 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
4926 (and skip end)))
4927
4928(defun org-agenda-skip-subtree-when-regexp-matches ()
4929 "Check if the current subtree contains match for `org-agenda-skip-regexp'.
4930If yes, it returns the end position of this tree, causing agenda commands
4931to skip this subtree. This is a function that can be put into
4932`org-agenda-skip-function' for the duration of a command."
4933 (let ((end (save-excursion (org-end-of-subtree t)))
4934 skip)
4935 (save-excursion
4936 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
4937 (and skip end)))
4938
4939(defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
4940 "Check if the current subtree contains match for `org-agenda-skip-regexp'.
4941If yes, it returns the end position of the current entry (NOT the tree),
4942causing agenda commands to skip the entry but continuing the search in
4943the subtree. This is a function that can be put into
4944`org-agenda-skip-function' for the duration of a command. An important
4945use of this function is for the stuck project list."
4946 (let ((end (save-excursion (org-end-of-subtree t)))
4947 (entry-end (save-excursion (outline-next-heading) (1- (point))))
4948 skip)
4949 (save-excursion
4950 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
4951 (and skip entry-end)))
4952
4953(defun org-agenda-skip-entry-if (&rest conditions) 4832(defun org-agenda-skip-entry-if (&rest conditions)
4954 "Skip entry if any of CONDITIONS is true. 4833 "Skip entry if any of CONDITIONS is true.
4955See `org-agenda-skip-if' for details." 4834See `org-agenda-skip-if' for details."
@@ -4999,39 +4878,41 @@ keywords. Possible classes are: `todo', `done', `any'.
4999If any of these conditions is met, this function returns the end point of 4878If any of these conditions is met, this function returns the end point of
5000the entity, causing the search to continue from there. This is a function 4879the entity, causing the search to continue from there. This is a function
5001that can be put into `org-agenda-skip-function' for the duration of a command." 4880that can be put into `org-agenda-skip-function' for the duration of a command."
5002 (let (beg end m) 4881 (org-back-to-heading t)
5003 (org-back-to-heading t) 4882 (let* ((beg (point))
5004 (setq beg (point) 4883 (end (if subtree (save-excursion (org-end-of-subtree t) (point))
5005 end (if subtree 4884 (org-entry-end-position)))
5006 (progn (org-end-of-subtree t) (point)) 4885 (planning-end (if subtree end (line-end-position 2)))
5007 (progn (outline-next-heading) (1- (point))))) 4886 m)
5008 (goto-char beg)
5009 (and 4887 (and
5010 (or 4888 (or (and (memq 'scheduled conditions)
5011 (and (memq 'scheduled conditions) 4889 (re-search-forward org-scheduled-time-regexp planning-end t))
5012 (re-search-forward org-scheduled-time-regexp end t)) 4890 (and (memq 'notscheduled conditions)
5013 (and (memq 'notscheduled conditions) 4891 (not
5014 (not (re-search-forward org-scheduled-time-regexp end t))) 4892 (save-excursion
5015 (and (memq 'deadline conditions) 4893 (re-search-forward org-scheduled-time-regexp planning-end t))))
5016 (re-search-forward org-deadline-time-regexp end t)) 4894 (and (memq 'deadline conditions)
5017 (and (memq 'notdeadline conditions) 4895 (re-search-forward org-deadline-time-regexp planning-end t))
5018 (not (re-search-forward org-deadline-time-regexp end t))) 4896 (and (memq 'notdeadline conditions)
5019 (and (memq 'timestamp conditions) 4897 (not
5020 (re-search-forward org-ts-regexp end t)) 4898 (save-excursion
5021 (and (memq 'nottimestamp conditions) 4899 (re-search-forward org-deadline-time-regexp planning-end t))))
5022 (not (re-search-forward org-ts-regexp end t))) 4900 (and (memq 'timestamp conditions)
5023 (and (setq m (memq 'regexp conditions)) 4901 (re-search-forward org-ts-regexp end t))
5024 (stringp (nth 1 m)) 4902 (and (memq 'nottimestamp conditions)
5025 (re-search-forward (nth 1 m) end t)) 4903 (not (save-excursion (re-search-forward org-ts-regexp end t))))
5026 (and (setq m (memq 'notregexp conditions)) 4904 (and (setq m (memq 'regexp conditions))
5027 (stringp (nth 1 m)) 4905 (stringp (nth 1 m))
5028 (not (re-search-forward (nth 1 m) end t))) 4906 (re-search-forward (nth 1 m) end t))
5029 (and (or 4907 (and (setq m (memq 'notregexp conditions))
5030 (setq m (memq 'nottodo conditions)) 4908 (stringp (nth 1 m))
5031 (setq m (memq 'todo-unblocked conditions)) 4909 (not (save-excursion (re-search-forward (nth 1 m) end t))))
5032 (setq m (memq 'nottodo-unblocked conditions)) 4910 (and (or
5033 (setq m (memq 'todo conditions))) 4911 (setq m (memq 'nottodo conditions))
5034 (org-agenda-skip-if-todo m end))) 4912 (setq m (memq 'todo-unblocked conditions))
4913 (setq m (memq 'nottodo-unblocked conditions))
4914 (setq m (memq 'todo conditions)))
4915 (org-agenda-skip-if-todo m end)))
5035 end))) 4916 end)))
5036 4917
5037(defun org-agenda-skip-if-todo (args end) 4918(defun org-agenda-skip-if-todo (args end)
@@ -5040,43 +4921,36 @@ ARGS is a list with first element either `todo', `nottodo',
5040`todo-unblocked' or `nottodo-unblocked'. The remainder is either 4921`todo-unblocked' or `nottodo-unblocked'. The remainder is either
5041a list of TODO keywords, or a state symbol `todo' or `done' or 4922a list of TODO keywords, or a state symbol `todo' or `done' or
5042`any'." 4923`any'."
5043 (let ((kw (car args)) 4924 (let ((todo-re
5044 (arg (cadr args)) 4925 (concat "^\\*+[ \t]+"
5045 todo-wds todo-re) 4926 (regexp-opt
5046 (setq todo-wds 4927 (pcase args
5047 (org-uniquify 4928 (`(,_ todo)
5048 (cond 4929 (org-delete-all org-done-keywords
5049 ((listp arg) ;; list of keywords 4930 (copy-sequence org-todo-keywords-1)))
5050 (if (member "*" arg) 4931 (`(,_ done) org-done-keywords)
5051 (mapcar 'substring-no-properties org-todo-keywords-1) 4932 (`(,_ any) org-todo-keywords-1)
5052 arg)) 4933 (`(,_ ,(pred atom))
5053 ((symbolp arg) ;; keyword class name 4934 (error "Invalid TODO class or type: %S" args))
5054 (cond 4935 (`(,_ ,(pred (member "*"))) org-todo-keywords-1)
5055 ((eq arg 'todo) 4936 (`(,_ ,todo-list) todo-list))
5056 (org-delete-all org-done-keywords 4937 'words))))
5057 (mapcar 'substring-no-properties 4938 (pcase args
5058 org-todo-keywords-1))) 4939 (`(todo . ,_)
5059 ((eq arg 'done) org-done-keywords) 4940 (let (case-fold-search) (re-search-forward todo-re end t)))
5060 ((eq arg 'any) 4941 (`(nottodo . ,_)
5061 (mapcar 'substring-no-properties org-todo-keywords-1))))))) 4942 (not (let (case-fold-search) (re-search-forward todo-re end t))))
5062 (setq todo-re 4943 (`(todo-unblocked . ,_)
5063 (concat "^\\*+[ \t]+\\<\\(" 4944 (catch :unblocked
5064 (mapconcat 'identity todo-wds "\\|") 4945 (while (let (case-fold-search) (re-search-forward todo-re end t))
5065 "\\)\\>")) 4946 (when (org-entry-blocked-p) (throw :unblocked t)))
5066 (cond 4947 nil))
5067 ((eq kw 'todo) (re-search-forward todo-re end t)) 4948 (`(nottodo-unblocked . ,_)
5068 ((eq kw 'nottodo) (not (re-search-forward todo-re end t))) 4949 (catch :unblocked
5069 ((eq kw 'todo-unblocked) 4950 (while (let (case-fold-search) (re-search-forward todo-re end t))
5070 (catch 'unblocked 4951 (when (org-entry-blocked-p) (throw :unblocked nil)))
5071 (while (re-search-forward todo-re end t) 4952 t))
5072 (or (org-entry-blocked-p) (throw 'unblocked t))) 4953 (`(,type . ,_) (error "Unknown TODO skip type: %S" type)))))
5073 nil))
5074 ((eq kw 'nottodo-unblocked)
5075 (catch 'unblocked
5076 (while (re-search-forward todo-re end t)
5077 (or (org-entry-blocked-p) (throw 'unblocked nil)))
5078 t))
5079 )))
5080 4954
5081;;;###autoload 4955;;;###autoload
5082(defun org-agenda-list-stuck-projects (&rest ignore) 4956(defun org-agenda-list-stuck-projects (&rest ignore)
@@ -5639,9 +5513,6 @@ displayed in agenda view."
5639 (looking-at org-ts-regexp-both) 5513 (looking-at org-ts-regexp-both)
5640 (match-string 0)))) 5514 (match-string 0))))
5641 (todo-state (org-get-todo-state)) 5515 (todo-state (org-get-todo-state))
5642 (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
5643 (member todo-state
5644 org-agenda-repeating-timestamp-show-all)))
5645 (warntime (get-text-property (point) 'org-appt-warntime)) 5516 (warntime (get-text-property (point) 'org-appt-warntime))
5646 (done? (member todo-state org-done-keywords))) 5517 (done? (member todo-state org-done-keywords)))
5647 ;; Possibly skip done tasks. 5518 ;; Possibly skip done tasks.
@@ -5650,22 +5521,39 @@ displayed in agenda view."
5650 ;; S-exp entry doesn't match current day: skip it. 5521 ;; S-exp entry doesn't match current day: skip it.
5651 (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date))) 5522 (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date)))
5652 (throw :skip nil)) 5523 (throw :skip nil))
5653 ;; When time-stamp doesn't match CURRENT but has a repeater, 5524 (when repeat
5654 ;; make sure it repeats on CURRENT. Furthermore, if 5525 (let* ((past
5655 ;; SHOW-ALL is nil, ensure that repeats are only the first 5526 ;; A repeating time stamp is shown at its base
5656 ;; before and the first after today. 5527 ;; date and every repeated date up to TODAY. If
5657 (when (and repeat 5528 ;; `org-agenda-prefer-last-repeat' is non-nil,
5658 (if show-all 5529 ;; however, only the last repeat before today
5659 (/= current 5530 ;; (inclusive) is shown.
5660 (org-agenda--timestamp-to-absolute 5531 (org-agenda--timestamp-to-absolute
5661 repeat current 'future (current-buffer) pos)) 5532 repeat
5662 (and (/= current 5533 (if (or (> current today)
5663 (org-agenda--timestamp-to-absolute 5534 (eq org-agenda-prefer-last-repeat t)
5664 repeat today 'past (current-buffer) pos)) 5535 (member todo-state org-agenda-prefer-last-repeat))
5665 (/= current 5536 today
5666 (org-agenda--timestamp-to-absolute 5537 current)
5667 repeat today 'future (current-buffer) pos))))) 5538 'past (current-buffer) pos))
5668 (throw :skip nil)) 5539 (future
5540 ;; Display every repeated date past TODAY
5541 ;; (exclusive) unless
5542 ;; `org-agenda-show-future-repeats' is nil. If
5543 ;; this variable is set to `next', only display
5544 ;; the first repeated date after TODAY
5545 ;; (exclusive).
5546 (cond
5547 ((<= current today) past)
5548 ((not org-agenda-show-future-repeats) past)
5549 (t
5550 (let ((base (if (eq org-agenda-show-future-repeats 'next)
5551 (1+ today)
5552 current)))
5553 (org-agenda--timestamp-to-absolute
5554 repeat base 'future (current-buffer) pos))))))
5555 (when (and (/= current past) (/= current future))
5556 (throw :skip nil))))
5669 (save-excursion 5557 (save-excursion
5670 (re-search-backward org-outline-regexp-bol nil t) 5558 (re-search-backward org-outline-regexp-bol nil t)
5671 ;; Possibly skip time-stamp when a deadline is set. 5559 ;; Possibly skip time-stamp when a deadline is set.
@@ -5835,7 +5723,8 @@ then those holidays will be skipped."
5835 (list 5723 (list
5836 (if (memq 'closed items) (concat "\\<" org-closed-string)) 5724 (if (memq 'closed items) (concat "\\<" org-closed-string))
5837 (if (memq 'clock items) (concat "\\<" org-clock-string)) 5725 (if (memq 'clock items) (concat "\\<" org-clock-string))
5838 (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?")))) 5726 (if (memq 'state items)
5727 (format "- State \"%s\".*?" org-todo-regexp)))))
5839 (parts-re (if parts (mapconcat 'identity parts "\\|") 5728 (parts-re (if parts (mapconcat 'identity parts "\\|")
5840 (error "`org-agenda-log-mode-items' is empty"))) 5729 (error "`org-agenda-log-mode-items' is empty")))
5841 (regexp (concat 5730 (regexp (concat
@@ -5923,8 +5812,7 @@ then those holidays will be skipped."
5923 "Add overlays, showing issues with clocking. 5812 "Add overlays, showing issues with clocking.
5924See also the user option `org-agenda-clock-consistency-checks'." 5813See also the user option `org-agenda-clock-consistency-checks'."
5925 (interactive) 5814 (interactive)
5926 (let* ((org-time-clocksum-use-effort-durations nil) 5815 (let* ((pl org-agenda-clock-consistency-checks)
5927 (pl org-agenda-clock-consistency-checks)
5928 (re (concat "^[ \t]*" 5816 (re (concat "^[ \t]*"
5929 org-clock-string 5817 org-clock-string
5930 "[ \t]+" 5818 "[ \t]+"
@@ -5932,14 +5820,14 @@ See also the user option `org-agenda-clock-consistency-checks'."
5932 "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second 5820 "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
5933 (tlstart 0.) 5821 (tlstart 0.)
5934 (tlend 0.) 5822 (tlend 0.)
5935 (maxtime (org-hh:mm-string-to-minutes 5823 (maxtime (org-duration-to-minutes
5936 (or (plist-get pl :max-duration) "24:00"))) 5824 (or (plist-get pl :max-duration) "24:00")))
5937 (mintime (org-hh:mm-string-to-minutes 5825 (mintime (org-duration-to-minutes
5938 (or (plist-get pl :min-duration) 0))) 5826 (or (plist-get pl :min-duration) 0)))
5939 (maxgap (org-hh:mm-string-to-minutes 5827 (maxgap (org-duration-to-minutes
5940 ;; default 30:00 means never complain 5828 ;; default 30:00 means never complain
5941 (or (plist-get pl :max-gap) "30:00"))) 5829 (or (plist-get pl :max-gap) "30:00")))
5942 (gapok (mapcar 'org-hh:mm-string-to-minutes 5830 (gapok (mapcar #'org-duration-to-minutes
5943 (plist-get pl :gap-ok-around))) 5831 (plist-get pl :gap-ok-around)))
5944 (def-face (or (plist-get pl :default-face) 5832 (def-face (or (plist-get pl :default-face)
5945 '((:background "DarkRed") (:foreground "white")))) 5833 '((:background "DarkRed") (:foreground "white"))))
@@ -5973,14 +5861,12 @@ See also the user option `org-agenda-clock-consistency-checks'."
5973 ((> dt (* 60 maxtime)) 5861 ((> dt (* 60 maxtime))
5974 ;; a very long clocking chunk 5862 ;; a very long clocking chunk
5975 (setq issue (format "Clocking interval is very long: %s" 5863 (setq issue (format "Clocking interval is very long: %s"
5976 (org-minutes-to-clocksum-string 5864 (org-duration-from-minutes (floor (/ dt 60.))))
5977 (floor (/ (float dt) 60.))))
5978 face (or (plist-get pl :long-face) face))) 5865 face (or (plist-get pl :long-face) face)))
5979 ((< dt (* 60 mintime)) 5866 ((< dt (* 60 mintime))
5980 ;; a very short clocking chunk 5867 ;; a very short clocking chunk
5981 (setq issue (format "Clocking interval is very short: %s" 5868 (setq issue (format "Clocking interval is very short: %s"
5982 (org-minutes-to-clocksum-string 5869 (org-duration-from-minutes (floor (/ dt 60.))))
5983 (floor (/ (float dt) 60.))))
5984 face (or (plist-get pl :short-face) face))) 5870 face (or (plist-get pl :short-face) face)))
5985 ((and (> tlend 0) (< ts tlend)) 5871 ((and (> tlend 0) (< ts tlend))
5986 ;; Two clock entries are overlapping 5872 ;; Two clock entries are overlapping
@@ -6066,27 +5952,33 @@ specification like [h]h:mm."
6066 (pos (1- (match-beginning 1))) 5952 (pos (1- (match-beginning 1)))
6067 (todo-state (save-match-data (org-get-todo-state))) 5953 (todo-state (save-match-data (org-get-todo-state)))
6068 (done? (member todo-state org-done-keywords)) 5954 (done? (member todo-state org-done-keywords))
6069 (show-all (or (eq org-agenda-repeating-timestamp-show-all t) 5955 (sexp? (string-prefix-p "%%" s))
6070 (member todo-state 5956 ;; DEADLINE is the deadline date for the entry. It is
6071 org-agenda-repeating-timestamp-show-all))) 5957 ;; either the base date or the last repeat, according
6072 (sexp? (string-prefix-p "%%" s)) 5958 ;; to `org-agenda-prefer-last-repeat'.
6073 ;; DEADLINE is the bare deadline date, i.e., without 5959 (deadline
6074 ;; any repeater, or the last repeat if SHOW-ALL is 5960 (cond
6075 ;; non-nil. REPEAT is closest repeat after CURRENT, if 5961 (sexp? (org-agenda--timestamp-to-absolute s current))
6076 ;; all repeated time stamps are to be shown, or after 5962 ((or (eq org-agenda-prefer-last-repeat t)
6077 ;; TODAY otherwise. REPEAT only applies to future 5963 (member todo-state org-agenda-prefer-last-repeat))
6078 ;; dates. 5964 (org-agenda--timestamp-to-absolute
6079 (deadline (cond 5965 s today 'past (current-buffer) pos))
6080 (sexp? (org-agenda--timestamp-to-absolute s current)) 5966 (t (org-agenda--timestamp-to-absolute s))))
6081 (show-all (org-agenda--timestamp-to-absolute s)) 5967 ;; REPEAT is the future repeat closest from CURRENT,
6082 (t (org-agenda--timestamp-to-absolute 5968 ;; according to `org-agenda-show-future-repeats'. If
6083 s today 'past (current-buffer) pos)))) 5969 ;; the latter is nil, or if the time stamp has no
6084 (repeat (cond (sexp? deadline) 5970 ;; repeat part, default to DEADLINE.
6085 ((< current today) deadline) 5971 (repeat
6086 (t 5972 (cond
6087 (org-agenda--timestamp-to-absolute 5973 (sexp? deadline)
6088 s (if show-all current today) 'future 5974 ((<= current today) deadline)
6089 (current-buffer) pos)))) 5975 ((not org-agenda-show-future-repeats) deadline)
5976 (t
5977 (let ((base (if (eq org-agenda-show-future-repeats 'next)
5978 (1+ today)
5979 current)))
5980 (org-agenda--timestamp-to-absolute
5981 s base 'future (current-buffer) pos)))))
6090 (diff (- deadline current)) 5982 (diff (- deadline current))
6091 (suppress-prewarning 5983 (suppress-prewarning
6092 (let ((scheduled 5984 (let ((scheduled
@@ -6111,17 +6003,17 @@ specification like [h]h:mm."
6111 (let ((org-deadline-warning-days suppress-prewarning)) 6003 (let ((org-deadline-warning-days suppress-prewarning))
6112 (org-get-wdays s)) 6004 (org-get-wdays s))
6113 (org-get-wdays s)))) 6005 (org-get-wdays s))))
6114 ;; When to show a deadline in the calendar: if the 6006 (cond
6115 ;; expiration is within WDAYS warning time. Past-due 6007 ;; Only display deadlines at their base date, at future
6116 ;; deadlines are only shown on today agenda. 6008 ;; repeat occurrences or in today agenda.
6117 (when (cond ((= current deadline) nil) 6009 ((= current deadline) nil)
6118 ((< deadline today) 6010 ((= current repeat) nil)
6119 (and (not today?) 6011 ((not today?) (throw :skip nil))
6120 (or (< current today) (/= repeat current)))) 6012 ;; Upcoming deadline: display within warning period WDAYS.
6121 ((> deadline current) 6013 ((> deadline current) (when (> diff wdays) (throw :skip nil)))
6122 (or (not today?) (> diff wdays))) 6014 ;; Overdue deadline: warn about it for
6123 (t (/= repeat current))) 6015 ;; `org-deadline-past-days' duration.
6124 (throw :skip nil)) 6016 (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
6125 ;; Possibly skip done tasks. 6017 ;; Possibly skip done tasks.
6126 (when (and done? 6018 (when (and done?
6127 (or org-agenda-skip-deadline-if-done 6019 (or org-agenda-skip-deadline-if-done
@@ -6131,8 +6023,8 @@ specification like [h]h:mm."
6131 (re-search-backward "^\\*+[ \t]+" nil t) 6023 (re-search-backward "^\\*+[ \t]+" nil t)
6132 (goto-char (match-end 0)) 6024 (goto-char (match-end 0))
6133 (let* ((category (org-get-category)) 6025 (let* ((category (org-get-category))
6134 (level 6026 (level (make-string (org-reduced-level (org-outline-level))
6135 (make-string (org-reduced-level (org-outline-level)) ?\s)) 6027 ?\s))
6136 (head (buffer-substring (point) (line-end-position))) 6028 (head (buffer-substring (point) (line-end-position)))
6137 (inherited-tags 6029 (inherited-tags
6138 (or (eq org-agenda-show-inherited-tags 'always) 6030 (or (eq org-agenda-show-inherited-tags 'always)
@@ -6154,23 +6046,16 @@ specification like [h]h:mm."
6154 (item 6046 (item
6155 (org-agenda-format-item 6047 (org-agenda-format-item
6156 ;; Insert appropriate suffixes before deadlines. 6048 ;; Insert appropriate suffixes before deadlines.
6049 ;; Those only apply to today agenda.
6157 (pcase-let ((`(,now ,future ,past) 6050 (pcase-let ((`(,now ,future ,past)
6158 org-agenda-deadline-leaders)) 6051 org-agenda-deadline-leaders))
6159 (cond 6052 (cond
6160 ;; Future (i.e., repeated) deadlines are 6053 ((and today? (< deadline today)) (format past (- diff)))
6161 ;; displayed as new headlines. 6054 ((and today? (> deadline today)) (format future diff))
6162 ((> current today) now) 6055 (t now)))
6163 ;; When SHOW-ALL is nil, prefer repeated 6056 head level category tags time))
6164 ;; deadlines over reminders of past deadlines.
6165 ((and (not show-all) (= repeat today)) now)
6166 ((= deadline current) now)
6167 ((< deadline current) (format past (- diff)))
6168 (t (format future diff))))
6169 head level category tags
6170 (and (or (= repeat current) (= deadline current))
6171 time)))
6172 (face (org-agenda-deadline-face 6057 (face (org-agenda-deadline-face
6173 (- 1 (/ (float (- deadline current)) (max wdays 1))))) 6058 (- 1 (/ (float diff) (max wdays 1)))))
6174 (upcoming? (and today? (> deadline today))) 6059 (upcoming? (and today? (> deadline today)))
6175 (warntime (get-text-property (point) 'org-appt-warntime))) 6060 (warntime (get-text-property (point) 'org-appt-warntime)))
6176 (org-add-props item props 6061 (org-add-props item props
@@ -6184,9 +6069,7 @@ specification like [h]h:mm."
6184 ;; Overdue deadlines get the highest priority 6069 ;; Overdue deadlines get the highest priority
6185 ;; increase, then imminent deadlines and eventually 6070 ;; increase, then imminent deadlines and eventually
6186 ;; more distant deadlines. 6071 ;; more distant deadlines.
6187 (let ((adjust (cond ((not today?) 0) 6072 (let ((adjust (if today? (- diff) 0)))
6188 ((and (not show-all) (= repeat current)) 0)
6189 (t (- diff)))))
6190 (+ adjust (org-get-priority item))) 6073 (+ adjust (org-get-priority item)))
6191 'todo-state todo-state 6074 'todo-state todo-state
6192 'type (if upcoming? "upcoming-deadline" "deadline") 6075 'type (if upcoming? "upcoming-deadline" "deadline")
@@ -6236,28 +6119,33 @@ scheduled items with an hour specification like [h]h:mm."
6236 (pos (1- (match-beginning 1))) 6119 (pos (1- (match-beginning 1)))
6237 (todo-state (save-match-data (org-get-todo-state))) 6120 (todo-state (save-match-data (org-get-todo-state)))
6238 (donep (member todo-state org-done-keywords)) 6121 (donep (member todo-state org-done-keywords))
6239 (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
6240 (member todo-state
6241 org-agenda-repeating-timestamp-show-all)))
6242 (sexp? (string-prefix-p "%%" s)) 6122 (sexp? (string-prefix-p "%%" s))
6243 ;; SCHEDULE is the bare scheduled date, i.e., without 6123 ;; SCHEDULE is the scheduled date for the entry. It is
6244 ;; any repeater if non-nil, or last repeat if SHOW-ALL 6124 ;; either the bare date or the last repeat, according
6245 ;; is nil. REPEAT is the closest repeat after CURRENT, 6125 ;; to `org-agenda-prefer-last-repeat'.
6246 ;; if all repeated time stamps are to be shown, or 6126 (schedule
6247 ;; after TODAY otherwise. REPEAT only applies to 6127 (cond
6248 ;; future dates. 6128 (sexp? (org-agenda--timestamp-to-absolute s current))
6249 (schedule (cond 6129 ((or (eq org-agenda-prefer-last-repeat t)
6250 (sexp? (org-agenda--timestamp-to-absolute s current)) 6130 (member todo-state org-agenda-prefer-last-repeat))
6251 (show-all (org-agenda--timestamp-to-absolute s)) 6131 (org-agenda--timestamp-to-absolute
6252 (t (org-agenda--timestamp-to-absolute 6132 s today 'past (current-buffer) pos))
6253 s today 'past (current-buffer) pos)))) 6133 (t (org-agenda--timestamp-to-absolute s))))
6254 (repeat (cond 6134 ;; REPEAT is the future repeat closest from CURRENT,
6255 (sexp? schedule) 6135 ;; according to `org-agenda-show-future-repeats'. If
6256 ((< current today) schedule) 6136 ;; the latter is nil, or if the time stamp has no
6257 (t 6137 ;; repeat part, default to SCHEDULE.
6258 (org-agenda--timestamp-to-absolute 6138 (repeat
6259 s (if show-all current today) 'future 6139 (cond
6260 (current-buffer) pos)))) 6140 (sexp? schedule)
6141 ((<= current today) schedule)
6142 ((not org-agenda-show-future-repeats) schedule)
6143 (t
6144 (let ((base (if (eq org-agenda-show-future-repeats 'next)
6145 (1+ today)
6146 current)))
6147 (org-agenda--timestamp-to-absolute
6148 s base 'future (current-buffer) pos)))))
6261 (diff (- current schedule)) 6149 (diff (- current schedule))
6262 (warntime (get-text-property (point) 'org-appt-warntime)) 6150 (warntime (get-text-property (point) 'org-appt-warntime))
6263 (pastschedp (< schedule today)) 6151 (pastschedp (< schedule today))
@@ -6300,9 +6188,9 @@ scheduled items with an hour specification like [h]h:mm."
6300 (when (or (and (> ddays 0) (< diff ddays)) 6188 (when (or (and (> ddays 0) (< diff ddays))
6301 (> diff org-scheduled-past-days) 6189 (> diff org-scheduled-past-days)
6302 (> schedule current) 6190 (> schedule current)
6303 (and (< schedule current) 6191 (and (/= current schedule)
6304 (not todayp) 6192 (/= current today)
6305 (/= repeat current))) 6193 (/= current repeat)))
6306 (throw :skip nil))) 6194 (throw :skip nil)))
6307 ;; Possibly skip done tasks. 6195 ;; Possibly skip done tasks.
6308 (when (and donep 6196 (when (and donep
@@ -6318,7 +6206,9 @@ scheduled items with an hour specification like [h]h:mm."
6318 habitp)) 6206 habitp))
6319 nil) 6207 nil)
6320 (`repeated-after-deadline 6208 (`repeated-after-deadline
6321 (>= repeat (time-to-days (org-get-deadline-time (point))))) 6209 (let ((deadline (time-to-days
6210 (org-get-deadline-time (point)))))
6211 (and (<= schedule deadline) (> current deadline))))
6322 (`not-today pastschedp) 6212 (`not-today pastschedp)
6323 (`t t) 6213 (`t t)
6324 (_ nil)) 6214 (_ nil))
@@ -6345,8 +6235,8 @@ scheduled items with an hour specification like [h]h:mm."
6345 (memq 'agenda 6235 (memq 'agenda
6346 org-agenda-use-tag-inheritance))))) 6236 org-agenda-use-tag-inheritance)))))
6347 (tags (org-get-tags-at nil (not inherited-tags))) 6237 (tags (org-get-tags-at nil (not inherited-tags)))
6348 (level 6238 (level (make-string (org-reduced-level (org-outline-level))
6349 (make-string (org-reduced-level (org-outline-level)) ?\s)) 6239 ?\s))
6350 (head (buffer-substring (point) (line-end-position))) 6240 (head (buffer-substring (point) (line-end-position)))
6351 (time 6241 (time
6352 (cond 6242 (cond
@@ -6358,21 +6248,11 @@ scheduled items with an hour specification like [h]h:mm."
6358 (t 'time))) 6248 (t 'time)))
6359 (item 6249 (item
6360 (org-agenda-format-item 6250 (org-agenda-format-item
6361 (pcase-let ((`(,first ,next) org-agenda-scheduled-leaders)) 6251 (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
6362 (cond 6252 ;; Show a reminder of a past scheduled today.
6363 ;; If CURRENT is in the future, don't use past 6253 (if (and todayp pastschedp)
6364 ;; scheduled prefix. 6254 (format past diff)
6365 ((> current today) first) 6255 first))
6366 ;; SHOW-ALL focuses on future repeats. If one
6367 ;; such repeat happens today, ignore late
6368 ;; schedule reminder. However, still report
6369 ;; such reminders when repeat happens later.
6370 ((and (not show-all) (= repeat today)) first)
6371 ;; Initial report.
6372 ((= schedule current) first)
6373 ;; Subsequent reminders. Count from base
6374 ;; schedule.
6375 (t (format next diff))))
6376 head level category tags time nil habitp)) 6256 head level category tags time nil habitp))
6377 (face (cond ((and (not habitp) pastschedp) 6257 (face (cond ((and (not habitp) pastschedp)
6378 'org-scheduled-previously) 6258 'org-scheduled-previously)
@@ -6419,8 +6299,26 @@ scheduled items with an hour specification like [h]h:mm."
6419 (end-time (match-string 2))) 6299 (end-time (match-string 2)))
6420 (setq s1 (match-string 1) 6300 (setq s1 (match-string 1)
6421 s2 (match-string 2) 6301 s2 (match-string 2)
6422 d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos)) 6302 d1 (time-to-days
6423 d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos))) 6303 (condition-case err
6304 (org-time-string-to-time s1)
6305 (error
6306 (error
6307 "Bad timestamp %S at %d in buffer %S\nError was: %s"
6308 s1
6309 pos
6310 (current-buffer)
6311 (error-message-string err)))))
6312 d2 (time-to-days
6313 (condition-case err
6314 (org-time-string-to-time s2)
6315 (error
6316 (error
6317 "Bad timestamp %S at %d in buffer %S\nError was: %s"
6318 s2
6319 pos
6320 (current-buffer)
6321 (error-message-string err))))))
6424 (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) 6322 (if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
6425 ;; Only allow days between the limits, because the normal 6323 ;; Only allow days between the limits, because the normal
6426 ;; date stamps will catch the limits. 6324 ;; date stamps will catch the limits.
@@ -6555,6 +6453,7 @@ Any match of REMOVE-RE will be removed from TXT."
6555 (get-text-property 1 'effort txt))) 6453 (get-text-property 1 'effort txt)))
6556 ;; time, tag, effort are needed for the eval of the prefix format 6454 ;; time, tag, effort are needed for the eval of the prefix format
6557 (tag (if tags (nth (1- (length tags)) tags) "")) 6455 (tag (if tags (nth (1- (length tags)) tags) ""))
6456 (time-grid-trailing-characters (nth 2 org-agenda-time-grid))
6558 time 6457 time
6559 (ts (if dotime (concat 6458 (ts (if dotime (concat
6560 (if (stringp dotime) dotime "") 6459 (if (stringp dotime) dotime "")
@@ -6588,18 +6487,19 @@ Any match of REMOVE-RE will be removed from TXT."
6588 (if s1 (setq s1 (org-get-time-of-day s1 'string t))) 6487 (if s1 (setq s1 (org-get-time-of-day s1 'string t)))
6589 (if s2 (setq s2 (org-get-time-of-day s2 'string t))) 6488 (if s2 (setq s2 (org-get-time-of-day s2 'string t)))
6590 6489
6591 ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set 6490 ;; Try to set s2 if s1 and
6592 (let (org-time-clocksum-use-effort-durations) 6491 ;; `org-agenda-default-appointment-duration' are set
6593 (when (and s1 (not s2) org-agenda-default-appointment-duration) 6492 (when (and s1 (not s2) org-agenda-default-appointment-duration)
6594 (setq s2 6493 (setq s2
6595 (org-minutes-to-clocksum-string 6494 (org-duration-from-minutes
6596 (+ (org-hh:mm-string-to-minutes s1) 6495 (+ (org-duration-to-minutes s1 t)
6597 org-agenda-default-appointment-duration))))) 6496 org-agenda-default-appointment-duration)
6497 nil t)))
6598 6498
6599 ;; Compute the duration 6499 ;; Compute the duration
6600 (when s2 6500 (when s2
6601 (setq duration (- (org-hh:mm-string-to-minutes s2) 6501 (setq duration (- (org-duration-to-minutes s2)
6602 (org-hh:mm-string-to-minutes s1))))) 6502 (org-duration-to-minutes s1)))))
6603 6503
6604 (when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt) 6504 (when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt)
6605 ;; Tags are in the string 6505 ;; Tags are in the string
@@ -6632,8 +6532,8 @@ Any match of REMOVE-RE will be removed from TXT."
6632 (s1 (concat 6532 (s1 (concat
6633 (org-agenda-time-of-day-to-ampm-maybe s1) 6533 (org-agenda-time-of-day-to-ampm-maybe s1)
6634 (if org-agenda-timegrid-use-ampm 6534 (if org-agenda-timegrid-use-ampm
6635 "........ " 6535 (concat time-grid-trailing-characters " ")
6636 "......"))) 6536 time-grid-trailing-characters)))
6637 (t "")) 6537 (t ""))
6638 extra (or (and (not habitp) extra) "") 6538 extra (or (and (not habitp) extra) "")
6639 category (if (symbolp category) (symbol-name category) category) 6539 category (if (symbolp category) (symbol-name category) category)
@@ -6726,8 +6626,8 @@ TODAYP is t when the current agenda view is on today."
6726 (let* ((have (delq nil (mapcar 6626 (let* ((have (delq nil (mapcar
6727 (lambda (x) (get-text-property 1 'time-of-day x)) 6627 (lambda (x) (get-text-property 1 'time-of-day x))
6728 list))) 6628 list)))
6729 (string (nth 1 org-agenda-time-grid)) 6629 (string (nth 3 org-agenda-time-grid))
6730 (gridtimes (nth 2 org-agenda-time-grid)) 6630 (gridtimes (nth 1 org-agenda-time-grid))
6731 (req (car org-agenda-time-grid)) 6631 (req (car org-agenda-time-grid))
6732 (remove (member 'remove-match req)) 6632 (remove (member 'remove-match req))
6733 new time) 6633 new time)
@@ -6910,6 +6810,8 @@ The optional argument TYPE tells the agenda type."
6910 (setq list (org-agenda-limit-entries list 'tags max-tags))) 6810 (setq list (org-agenda-limit-entries list 'tags max-tags)))
6911 (when max-entries 6811 (when max-entries
6912 (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries))) 6812 (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
6813 (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
6814 (setq list (mapcar #'org-agenda--mark-blocked-entry list)))
6913 (mapconcat 'identity list "\n"))) 6815 (mapconcat 'identity list "\n")))
6914 6816
6915(defun org-agenda-limit-entries (list prop limit &optional fn) 6817(defun org-agenda-limit-entries (list prop limit &optional fn)
@@ -7186,6 +7088,22 @@ their type."
7186 'help-echo "Agendas are currently limited to this subtree.") 7088 'help-echo "Agendas are currently limited to this subtree.")
7187(delete-overlay org-agenda-restriction-lock-overlay) 7089(delete-overlay org-agenda-restriction-lock-overlay)
7188 7090
7091(defun org-agenda-set-restriction-lock-from-agenda (arg)
7092 "Set the restriction lock to the agenda item at point from within the agenda.
7093When called with a `\\[universal-argument]' prefix, restrict to
7094the file which contains the item.
7095Argument ARG is the prefix argument."
7096 (interactive "P")
7097 (unless (derived-mode-p 'org-agenda-mode)
7098 (user-error "Not in an Org agenda buffer"))
7099 (let* ((marker (or (org-get-at-bol 'org-marker)
7100 (org-agenda-error)))
7101 (buffer (marker-buffer marker))
7102 (pos (marker-position marker)))
7103 (with-current-buffer buffer
7104 (goto-char pos)
7105 (org-agenda-set-restriction-lock arg))))
7106
7189;;;###autoload 7107;;;###autoload
7190(defun org-agenda-set-restriction-lock (&optional type) 7108(defun org-agenda-set-restriction-lock (&optional type)
7191 "Set restriction lock for agenda, to current subtree or file. 7109 "Set restriction lock for agenda, to current subtree or file.
@@ -7261,14 +7179,13 @@ in the file. Otherwise, restriction will be to the current subtree."
7261(defun org-agenda-check-type (error &rest types) 7179(defun org-agenda-check-type (error &rest types)
7262 "Check if agenda buffer is of allowed type. 7180 "Check if agenda buffer is of allowed type.
7263If ERROR is non-nil, throw an error, otherwise just return nil. 7181If ERROR is non-nil, throw an error, otherwise just return nil.
7264Allowed types are `agenda' `timeline' `todo' `tags' `search'." 7182Allowed types are `agenda' `todo' `tags' `search'."
7265 (if (not org-agenda-type) 7183 (cond ((not org-agenda-type)
7266 (error "No Org agenda currently displayed") 7184 (error "No Org agenda currently displayed"))
7267 (if (memq org-agenda-type types) 7185 ((memq org-agenda-type types) t)
7268 t 7186 (error
7269 (if error 7187 (error "Not allowed in %s-type agenda buffers" org-agenda-type))
7270 (error "Not allowed in %s-type agenda buffers" org-agenda-type) 7188 (t nil)))
7271 nil))))
7272 7189
7273(defun org-agenda-Quit () 7190(defun org-agenda-Quit ()
7274 "Exit the agenda, killing the agenda buffer. 7191 "Exit the agenda, killing the agenda buffer.
@@ -7424,6 +7341,17 @@ in the agenda."
7424 (org-goto-line line) 7341 (org-goto-line line)
7425 (recenter window-line))) 7342 (recenter window-line)))
7426 7343
7344(defun org-agenda-redo-all (&optional exhaustive)
7345 "Rebuild all agenda views in the current buffer.
7346With a prefix argument, do so in all agenda buffers."
7347 (interactive "P")
7348 (if exhaustive
7349 (dolist (buffer (buffer-list))
7350 (with-current-buffer buffer
7351 (when (derived-mode-p 'org-agenda-mode)
7352 (org-agenda-redo t))))
7353 (org-agenda-redo t)))
7354
7427(defvar org-global-tags-completion-table nil) 7355(defvar org-global-tags-completion-table nil)
7428(defvar org-agenda-filter-form nil) 7356(defvar org-agenda-filter-form nil)
7429(defvar org-agenda-filtered-by-category nil) 7357(defvar org-agenda-filtered-by-category nil)
@@ -7583,8 +7511,9 @@ also press `-' or `+' to switch between filtering and excluding."
7583 (unless char 7511 (unless char
7584 (while (not (memq char valid-char-list)) 7512 (while (not (memq char valid-char-list))
7585 (message 7513 (message
7586 "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit" 7514 "%s by tag [%s ]:tag-char, [TAB]:tag, %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
7587 (if exclude "Exclude" "Filter") tag-chars 7515 (if exclude "Exclude" "Filter")
7516 tag-chars
7588 (if org-agenda-auto-exclude-function "[RET], " "") 7517 (if org-agenda-auto-exclude-function "[RET], " "")
7589 (if expand "" ", no grouptag expand")) 7518 (if expand "" ", no grouptag expand"))
7590 (setq char (read-char-exclusive)) 7519 (setq char (read-char-exclusive))
@@ -7721,7 +7650,7 @@ E looks like \"+<2:25\"."
7721 ((equal op ??) op) 7650 ((equal op ??) op)
7722 (t '=))) 7651 (t '=)))
7723 (list 'org-agenda-compare-effort (list 'quote op) 7652 (list 'org-agenda-compare-effort (list 'quote op)
7724 (org-duration-string-to-minutes e)))) 7653 (org-duration-to-minutes e))))
7725 7654
7726(defun org-agenda-compare-effort (op value) 7655(defun org-agenda-compare-effort (op value)
7727 "Compare the effort of the current line with VALUE, using OP. 7656 "Compare the effort of the current line with VALUE, using OP.
@@ -7854,7 +7783,7 @@ Negative selection means regexp must not match for selection of an entry."
7854 (org-agenda-manipulate-query ?\})) 7783 (org-agenda-manipulate-query ?\}))
7855(defun org-agenda-manipulate-query (char) 7784(defun org-agenda-manipulate-query (char)
7856 (cond 7785 (cond
7857 ((memq org-agenda-type '(timeline agenda)) 7786 ((eq org-agenda-type 'agenda)
7858 (let ((org-agenda-include-inactive-timestamps t)) 7787 (let ((org-agenda-include-inactive-timestamps t))
7859 (org-agenda-redo)) 7788 (org-agenda-redo))
7860 (message "Display now includes inactive timestamps as well")) 7789 (message "Display now includes inactive timestamps as well"))
@@ -7917,7 +7846,7 @@ Negative selection means regexp must not match for selection of an entry."
7917(defun org-agenda-goto-today () 7846(defun org-agenda-goto-today ()
7918 "Go to today." 7847 "Go to today."
7919 (interactive) 7848 (interactive)
7920 (org-agenda-check-type t 'timeline 'agenda) 7849 (org-agenda-check-type t 'agenda)
7921 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 7850 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
7922 (curspan (nth 2 args)) 7851 (curspan (nth 2 args))
7923 (tdpos (text-property-any (point-min) (point-max) 'org-today t))) 7852 (tdpos (text-property-any (point-min) (point-max) 'org-today t)))
@@ -8044,7 +7973,7 @@ With prefix ARG, go backward that many times the current span."
8044 (?D (call-interactively 'org-agenda-toggle-diary)) 7973 (?D (call-interactively 'org-agenda-toggle-diary))
8045 (?\! (call-interactively 'org-agenda-toggle-deadlines)) 7974 (?\! (call-interactively 'org-agenda-toggle-deadlines))
8046 (?\[ (let ((org-agenda-include-inactive-timestamps t)) 7975 (?\[ (let ((org-agenda-include-inactive-timestamps t))
8047 (org-agenda-check-type t 'timeline 'agenda) 7976 (org-agenda-check-type t 'agenda)
8048 (org-agenda-redo)) 7977 (org-agenda-redo))
8049 (message "Display now includes inactive timestamps as well")) 7978 (message "Display now includes inactive timestamps as well"))
8050 (?q (message "Abort")) 7979 (?q (message "Abort"))
@@ -8171,7 +8100,7 @@ so that the date SD will be in that range."
8171(defun org-agenda-next-date-line (&optional arg) 8100(defun org-agenda-next-date-line (&optional arg)
8172 "Jump to the next line indicating a date in agenda buffer." 8101 "Jump to the next line indicating a date in agenda buffer."
8173 (interactive "p") 8102 (interactive "p")
8174 (org-agenda-check-type t 'agenda 'timeline) 8103 (org-agenda-check-type t 'agenda)
8175 (beginning-of-line 1) 8104 (beginning-of-line 1)
8176 ;; This does not work if user makes date format that starts with a blank 8105 ;; This does not work if user makes date format that starts with a blank
8177 (if (looking-at "^\\S-") (forward-char 1)) 8106 (if (looking-at "^\\S-") (forward-char 1))
@@ -8184,7 +8113,7 @@ so that the date SD will be in that range."
8184(defun org-agenda-previous-date-line (&optional arg) 8113(defun org-agenda-previous-date-line (&optional arg)
8185 "Jump to the previous line indicating a date in agenda buffer." 8114 "Jump to the previous line indicating a date in agenda buffer."
8186 (interactive "p") 8115 (interactive "p")
8187 (org-agenda-check-type t 'agenda 'timeline) 8116 (org-agenda-check-type t 'agenda)
8188 (beginning-of-line 1) 8117 (beginning-of-line 1)
8189 (if (not (re-search-backward "^\\S-" nil t arg)) 8118 (if (not (re-search-backward "^\\S-" nil t arg))
8190 (error "No previous date before this line in this buffer"))) 8119 (error "No previous date before this line in this buffer")))
@@ -8263,7 +8192,7 @@ configured in `org-agenda-log-mode-items'.
8263With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \ 8192With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \
8264log items, nothing else." 8193log items, nothing else."
8265 (interactive "P") 8194 (interactive "P")
8266 (org-agenda-check-type t 'agenda 'timeline) 8195 (org-agenda-check-type t 'agenda)
8267 (setq org-agenda-show-log 8196 (setq org-agenda-show-log
8268 (cond 8197 (cond
8269 ((equal special '(16)) 'only) 8198 ((equal special '(16)) 'only)
@@ -9040,7 +8969,11 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
9040 8969
9041(defun org-agenda-align-tags (&optional line) 8970(defun org-agenda-align-tags (&optional line)
9042 "Align all tags in agenda items to `org-agenda-tags-column'." 8971 "Align all tags in agenda items to `org-agenda-tags-column'."
9043 (let ((inhibit-read-only t) l c) 8972 (let ((inhibit-read-only t)
8973 (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
8974 (- (window-text-width))
8975 org-agenda-tags-column))
8976 l c)
9044 (save-excursion 8977 (save-excursion
9045 (goto-char (if line (point-at-bol) (point-min))) 8978 (goto-char (if line (point-at-bol) (point-min)))
9046 (while (re-search-forward "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" 8979 (while (re-search-forward "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
@@ -9225,7 +9158,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
9225(defun org-agenda-date-later (arg &optional what) 9158(defun org-agenda-date-later (arg &optional what)
9226 "Change the date of this item to ARG day(s) later." 9159 "Change the date of this item to ARG day(s) later."
9227 (interactive "p") 9160 (interactive "p")
9228 (org-agenda-check-type t 'agenda 'timeline) 9161 (org-agenda-check-type t 'agenda)
9229 (org-agenda-check-no-diary) 9162 (org-agenda-check-no-diary)
9230 (let* ((marker (or (org-get-at-bol 'org-marker) 9163 (let* ((marker (or (org-get-at-bol 'org-marker)
9231 (org-agenda-error))) 9164 (org-agenda-error)))
@@ -9236,8 +9169,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
9236 (with-current-buffer buffer 9169 (with-current-buffer buffer
9237 (widen) 9170 (widen)
9238 (goto-char pos) 9171 (goto-char pos)
9239 (if (not (org-at-timestamp-p)) 9172 (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
9240 (error "Cannot find time stamp"))
9241 (when (and org-agenda-move-date-from-past-immediately-to-today 9173 (when (and org-agenda-move-date-from-past-immediately-to-today
9242 (equal arg 1) 9174 (equal arg 1)
9243 (or (not what) (eq what 'day)) 9175 (or (not what) (eq what 'day))
@@ -9309,7 +9241,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
9309The prefix ARG is passed to the `org-time-stamp' command and can therefore 9241The prefix ARG is passed to the `org-time-stamp' command and can therefore
9310be used to request time specification in the time stamp." 9242be used to request time specification in the time stamp."
9311 (interactive "P") 9243 (interactive "P")
9312 (org-agenda-check-type t 'agenda 'timeline) 9244 (org-agenda-check-type t 'agenda)
9313 (org-agenda-check-no-diary) 9245 (org-agenda-check-no-diary)
9314 (let* ((marker (or (org-get-at-bol 'org-marker) 9246 (let* ((marker (or (org-get-at-bol 'org-marker)
9315 (org-agenda-error))) 9247 (org-agenda-error)))
@@ -9319,8 +9251,7 @@ be used to request time specification in the time stamp."
9319 (with-current-buffer buffer 9251 (with-current-buffer buffer
9320 (widen) 9252 (widen)
9321 (goto-char pos) 9253 (goto-char pos)
9322 (if (not (org-at-timestamp-p t)) 9254 (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
9323 (error "Cannot find time stamp"))
9324 (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) 9255 (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
9325 (org-agenda-show-new-time marker org-last-changed-timestamp)) 9256 (org-agenda-show-new-time marker org-last-changed-timestamp))
9326 (message "Time stamp changed to %s" org-last-changed-timestamp))) 9257 (message "Time stamp changed to %s" org-last-changed-timestamp)))
@@ -9329,7 +9260,7 @@ be used to request time specification in the time stamp."
9329 "Schedule the item at point. 9260 "Schedule the item at point.
9330ARG is passed through to `org-schedule'." 9261ARG is passed through to `org-schedule'."
9331 (interactive "P") 9262 (interactive "P")
9332 (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) 9263 (org-agenda-check-type t 'agenda 'todo 'tags 'search)
9333 (org-agenda-check-no-diary) 9264 (org-agenda-check-no-diary)
9334 (let* ((marker (or (org-get-at-bol 'org-marker) 9265 (let* ((marker (or (org-get-at-bol 'org-marker)
9335 (org-agenda-error))) 9266 (org-agenda-error)))
@@ -9350,7 +9281,7 @@ ARG is passed through to `org-schedule'."
9350 "Schedule the item at point. 9281 "Schedule the item at point.
9351ARG is passed through to `org-deadline'." 9282ARG is passed through to `org-deadline'."
9352 (interactive "P") 9283 (interactive "P")
9353 (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) 9284 (org-agenda-check-type t 'agenda 'todo 'tags 'search)
9354 (org-agenda-check-no-diary) 9285 (org-agenda-check-no-diary)
9355 (let* ((marker (or (org-get-at-bol 'org-marker) 9286 (let* ((marker (or (org-get-at-bol 'org-marker)
9356 (org-agenda-error))) 9287 (org-agenda-error)))
@@ -9659,7 +9590,7 @@ entries in that Org file."
9659 9590
9660(defun org-agenda-execute-calendar-command (cmd) 9591(defun org-agenda-execute-calendar-command (cmd)
9661 "Execute a calendar command from the agenda with date from cursor." 9592 "Execute a calendar command from the agenda with date from cursor."
9662 (org-agenda-check-type t 'agenda 'timeline) 9593 (org-agenda-check-type t 'agenda)
9663 (require 'diary-lib) 9594 (require 'diary-lib)
9664 (unless (get-text-property (min (1- (point-max)) (point)) 'day) 9595 (unless (get-text-property (min (1- (point-max)) (point)) 'day)
9665 (user-error "Don't know which date to use for the calendar command")) 9596 (user-error "Don't know which date to use for the calendar command"))
@@ -9709,7 +9640,7 @@ argument, latitude and longitude will be prompted for."
9709(defun org-agenda-goto-calendar () 9640(defun org-agenda-goto-calendar ()
9710 "Open the Emacs calendar with the date at the cursor." 9641 "Open the Emacs calendar with the date at the cursor."
9711 (interactive) 9642 (interactive)
9712 (org-agenda-check-type t 'agenda 'timeline) 9643 (org-agenda-check-type t 'agenda)
9713 (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) 9644 (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
9714 (user-error "Don't know which date to open in calendar"))) 9645 (user-error "Don't know which date to open in calendar")))
9715 (date (calendar-gregorian-from-absolute day)) 9646 (date (calendar-gregorian-from-absolute day))
@@ -9734,7 +9665,7 @@ This is a command that has to be installed in `calendar-mode-map'."
9734 9665
9735(defun org-agenda-convert-date () 9666(defun org-agenda-convert-date ()
9736 (interactive) 9667 (interactive)
9737 (org-agenda-check-type t 'agenda 'timeline) 9668 (org-agenda-check-type t 'agenda)
9738 (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) 9669 (let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
9739 date s) 9670 date s)
9740 (unless day 9671 (unless day
@@ -9884,178 +9815,191 @@ bulk action."
9884 "Execute an remote-editing action on all marked entries. 9815 "Execute an remote-editing action on all marked entries.
9885The prefix arg is passed through to the command if possible." 9816The prefix arg is passed through to the command if possible."
9886 (interactive "P") 9817 (interactive "P")
9887 ;; Make sure we have markers, and only valid ones 9818 ;; Make sure we have markers, and only valid ones.
9888 (unless org-agenda-bulk-marked-entries (user-error "No entries are marked")) 9819 (unless org-agenda-bulk-marked-entries (user-error "No entries are marked"))
9889 (mapc 9820 (dolist (m org-agenda-bulk-marked-entries)
9890 (lambda (m) 9821 (unless (and (markerp m)
9891 (unless (and (markerp m) 9822 (marker-buffer m)
9892 (marker-buffer m) 9823 (buffer-live-p (marker-buffer m))
9893 (buffer-live-p (marker-buffer m)) 9824 (marker-position m))
9894 (marker-position m)) 9825 (user-error "Marker %s for bulk command is invalid" m)))
9895 (user-error "Marker %s for bulk command is invalid" m))) 9826
9896 org-agenda-bulk-marked-entries) 9827 ;; Prompt for the bulk command.
9897 9828 (message
9898 ;; Prompt for the bulk command 9829 (concat (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")
9899 (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: "))) 9830 "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
9900 (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile " 9831 "[S]catter [f]unction "
9901 "[S]catter [f]unction " 9832 (and org-agenda-bulk-custom-functions
9902 (when org-agenda-bulk-custom-functions 9833 (format " Custom: [%s]"
9903 (concat " Custom: [" 9834 (mapconcat (lambda (f) (char-to-string (car f)))
9904 (mapconcat (lambda(f) (char-to-string (car f))) 9835 org-agenda-bulk-custom-functions
9905 org-agenda-bulk-custom-functions "") 9836 "")))))
9906 "]")))) 9837 (catch 'exit
9907 (catch 'exit 9838 (let* ((org-log-refile (if org-log-refile 'time nil))
9908 (let* ((action (read-char-exclusive)) 9839 (entries (reverse org-agenda-bulk-marked-entries))
9909 (org-log-refile (if org-log-refile 'time nil)) 9840 (org-overriding-default-time
9910 (entries (reverse org-agenda-bulk-marked-entries)) 9841 (and (get-text-property (point) 'org-agenda-date-header)
9911 (org-overriding-default-time 9842 (org-get-cursor-date)))
9912 (if (get-text-property (point) 'org-agenda-date-header) 9843 redo-at-end
9913 (org-get-cursor-date))) 9844 cmd)
9914 redo-at-end 9845 (pcase (read-char-exclusive)
9915 cmd rfloc state e tag pos (cnt 0) (cntskip 0)) 9846 (?p
9916 (cond 9847 (let ((org-agenda-persistent-marks
9917 ((equal action ?p) 9848 (not org-agenda-persistent-marks)))
9918 (let ((org-agenda-persistent-marks 9849 (org-agenda-bulk-action)
9919 (not org-agenda-persistent-marks))) 9850 (throw 'exit nil)))
9920 (org-agenda-bulk-action) 9851
9921 (throw 'exit nil))) 9852 (?$
9922 9853 (setq cmd #'org-agenda-archive))
9923 ((equal action ?$) 9854
9924 (setq cmd '(org-agenda-archive))) 9855 (?A
9925 9856 (setq cmd #'org-agenda-archive-to-archive-sibling))
9926 ((equal action ?A) 9857
9927 (setq cmd '(org-agenda-archive-to-archive-sibling))) 9858 ((or ?r ?w)
9928 9859 (let ((refile-location
9929 ((member action '(?r ?w)) 9860 (org-refile-get-location
9930 (setq rfloc (org-refile-get-location 9861 "Refile to"
9931 "Refile to" 9862 (marker-buffer (car entries))
9932 (marker-buffer (car entries)) 9863 org-refile-allow-creating-parent-nodes)))
9933 org-refile-allow-creating-parent-nodes)) 9864 (when (nth 3 refile-location)
9934 (if (nth 3 rfloc) 9865 (setcar (nthcdr 3 refile-location)
9935 (setcar (nthcdr 3 rfloc) 9866 (move-marker
9936 (move-marker (make-marker) (nth 3 rfloc) 9867 (make-marker)
9937 (or (get-file-buffer (nth 1 rfloc)) 9868 (nth 3 refile-location)
9938 (find-buffer-visiting (nth 1 rfloc)) 9869 (or (get-file-buffer (nth 1 refile-location))
9939 (error "This should not happen"))))) 9870 (find-buffer-visiting (nth 1 refile-location))
9940 9871 (error "This should not happen")))))
9941 (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t) 9872
9942 redo-at-end t)) 9873 (setq cmd `(lambda () (org-agenda-refile nil ',refile-location t)))
9943 9874 (setq redo-at-end t)))
9944 ((equal action ?t) 9875
9945 (setq state (completing-read 9876 (?t
9877 (let ((state (completing-read
9946 "Todo state: " 9878 "Todo state: "
9947 (with-current-buffer (marker-buffer (car entries)) 9879 (with-current-buffer (marker-buffer (car entries))
9948 (mapcar #'list org-todo-keywords-1)))) 9880 (mapcar #'list org-todo-keywords-1)))))
9949 (setq cmd `(let ((org-inhibit-blocking t) 9881 (setq cmd `(lambda ()
9950 (org-inhibit-logging 'note)) 9882 (let ((org-inhibit-blocking t)
9951 (org-agenda-todo ,state)))) 9883 (org-inhibit-logging 'note))
9952 9884 (org-agenda-todo ,state))))))
9953 ((memq action '(?- ?+)) 9885
9954 (setq tag (completing-read 9886 ((and (or ?- ?+) action)
9887 (let ((tag (completing-read
9955 (format "Tag to %s: " (if (eq action ?+) "add" "remove")) 9888 (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
9956 (with-current-buffer (marker-buffer (car entries)) 9889 (with-current-buffer (marker-buffer (car entries))
9957 (delq nil 9890 (delq nil
9958 (mapcar (lambda (x) (and (stringp (car x)) x)) 9891 (mapcar (lambda (x) (and (stringp (car x)) x))
9959 org-current-tag-alist))))) 9892 org-current-tag-alist))))))
9960 (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) 9893 (setq cmd
9961 9894 `(lambda ()
9962 ((memq action '(?s ?d)) 9895 (org-agenda-set-tags ,tag
9963 (let* ((time 9896 ,(if (eq action ?+) ''on ''off))))))
9964 (unless arg 9897
9965 (org-read-date 9898 (?s
9966 nil nil nil 9899 (let ((time
9967 (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to") 9900 (and (not arg)
9968 org-overriding-default-time))) 9901 (org-read-date nil nil nil "(Re)Schedule to"
9969 (c1 (if (eq action ?s) 'org-agenda-schedule 9902 org-overriding-default-time))))
9970 'org-agenda-deadline))) 9903 ;; Make sure to not prompt for a note when bulk
9971 ;; Make sure to not prompt for a note when bulk 9904 ;; rescheduling as Org cannot cope with simultaneous notes.
9972 ;; rescheduling as Org cannot cope with simultaneous 9905 ;; Besides, it could be annoying depending on the number of
9973 ;; notes. Besides, it could be annoying depending on the 9906 ;; items re-scheduled.
9974 ;; number of items re-scheduled. 9907 (setq cmd
9975 (setq cmd `(eval '(let ((org-log-reschedule 9908 `(lambda ()
9976 (and org-log-reschedule 'time)) 9909 (let ((org-log-reschedule (and org-log-reschedule 'time)))
9977 (org-log-redeadline 9910 (org-agenda-schedule arg ,time))))))
9978 (and org-log-redeadline 'time))) 9911 (?d
9979 (,c1 arg ,time)))))) 9912 (let ((time
9980 9913 (and (not arg)
9981 ((equal action ?S) 9914 (org-read-date nil nil nil "(Re)Set Deadline to"
9982 (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) 9915 org-overriding-default-time))))
9983 (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type) 9916 ;; Make sure to not prompt for a note when bulk
9984 (let ((days (read-number 9917 ;; rescheduling as Org cannot cope with simultaneous
9985 (format "Scatter tasks across how many %sdays: " 9918 ;; notes. Besides, it could be annoying depending on the
9986 (if arg "week" "")) 7))) 9919 ;; number of items re-scheduled.
9987 (setq cmd 9920 (setq cmd
9988 `(let ((distance (1+ (random ,days)))) 9921 `(lambda ()
9989 (if arg 9922 (let ((org-log-redeadline (and org-log-redeadline 'time)))
9990 (let ((dist distance) 9923 (org-agenda-deadline arg ,time))))))
9991 (day-of-week 9924
9992 (calendar-day-of-week 9925 (?S
9993 (calendar-gregorian-from-absolute (org-today))))) 9926 (unless (org-agenda-check-type nil 'agenda 'todo)
9994 (dotimes (i (1+ dist)) 9927 (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type))
9995 (while (member day-of-week org-agenda-weekend-days) 9928 (let ((days (read-number
9996 (cl-incf distance) 9929 (format "Scatter tasks across how many %sdays: "
9997 (cl-incf day-of-week) 9930 (if arg "week" ""))
9998 (when (= day-of-week 7) 9931 7)))
9999 (setq day-of-week 0))) 9932 (setq cmd
10000 (cl-incf day-of-week) 9933 `(lambda ()
10001 (when (= day-of-week 7) 9934 (let ((distance (1+ (random ,days))))
10002 (setq day-of-week 0))))) 9935 (when arg
10003 ;; silently fail when try to replan a sexp entry 9936 (let ((dist distance)
10004 (condition-case nil 9937 (day-of-week
10005 (let* ((date (calendar-gregorian-from-absolute 9938 (calendar-day-of-week
10006 (+ (org-today) distance))) 9939 (calendar-gregorian-from-absolute (org-today)))))
10007 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) 9940 (dotimes (i (1+ dist))
10008 (nth 2 date)))) 9941 (while (member day-of-week org-agenda-weekend-days)
10009 (org-agenda-schedule nil time)) 9942 (cl-incf distance)
10010 (error nil))))))) 9943 (cl-incf day-of-week)
10011 9944 (when (= day-of-week 7)
10012 ((assoc action org-agenda-bulk-custom-functions) 9945 (setq day-of-week 0)))
10013 (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions))) 9946 (cl-incf day-of-week)
10014 redo-at-end t)) 9947 (when (= day-of-week 7)
10015 9948 (setq day-of-week 0)))))
10016 ((equal action ?f) 9949 ;; Silently fail when try to replan a sexp entry.
10017 (setq cmd (list (intern 9950 (ignore-errors
10018 (completing-read "Function: " 9951 (let* ((date (calendar-gregorian-from-absolute
10019 obarray 'fboundp t nil nil))))) 9952 (+ (org-today) distance)))
10020 9953 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
10021 (t (user-error "Invalid bulk action"))) 9954 (nth 2 date))))
10022 9955 (org-agenda-schedule nil time))))))))
10023 ;; Sort the markers, to make sure that parents are handled before children 9956
10024 (setq entries (sort entries 9957 (?f
10025 (lambda (a b) 9958 (setq cmd
10026 (cond 9959 (intern
10027 ((equal (marker-buffer a) (marker-buffer b)) 9960 (completing-read "Function: " obarray #'fboundp t nil nil))))
10028 (< (marker-position a) (marker-position b))) 9961
10029 (t 9962 (action
10030 (string< (buffer-name (marker-buffer a)) 9963 (pcase (assoc action org-agenda-bulk-custom-functions)
10031 (buffer-name (marker-buffer b)))))))) 9964 (`(,_ ,f) (setq cmd f) (setq redo-at-end t))
10032 9965 (_ (user-error "Invalid bulk action: %c" action)))))
10033 ;; Now loop over all markers and apply cmd 9966
10034 (while (setq e (pop entries)) 9967 ;; Sort the markers, to make sure that parents are handled
10035 (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e)) 9968 ;; before children.
10036 (if (not pos) 9969 (setq entries (sort entries
10037 (progn (message "Skipping removed entry at %s" e) 9970 (lambda (a b)
10038 (setq cntskip (1+ cntskip))) 9971 (cond
10039 (goto-char pos) 9972 ((eq (marker-buffer a) (marker-buffer b))
10040 (let (org-loop-over-headlines-in-active-region) 9973 (< (marker-position a) (marker-position b)))
10041 (eval cmd)) 9974 (t
10042 ;; `post-command-hook' is not run yet. We make sure any 9975 (string< (buffer-name (marker-buffer a))
10043 ;; pending log note is processed. 9976 (buffer-name (marker-buffer b))))))))
10044 (when (or (memq 'org-add-log-note (default-value 'post-command-hook)) 9977
10045 (memq 'org-add-log-note post-command-hook)) 9978 ;; Now loop over all markers and apply CMD.
10046 (org-add-log-note)) 9979 (let ((processed 0)
10047 (setq cnt (1+ cnt)))) 9980 (skipped 0))
9981 (dolist (e entries)
9982 (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e)))
9983 (if (not pos)
9984 (progn (message "Skipping removed entry at %s" e)
9985 (cl-incf skipped))
9986 (goto-char pos)
9987 (let (org-loop-over-headlines-in-active-region) (funcall cmd))
9988 ;; `post-command-hook' is not run yet. We make sure any
9989 ;; pending log note is processed.
9990 (when (or (memq 'org-add-log-note (default-value 'post-command-hook))
9991 (memq 'org-add-log-note post-command-hook))
9992 (org-add-log-note))
9993 (cl-incf processed))))
10048 (when redo-at-end (org-agenda-redo)) 9994 (when redo-at-end (org-agenda-redo))
10049 (unless org-agenda-persistent-marks 9995 (unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
10050 (org-agenda-bulk-unmark-all))
10051 (message "Acted on %d entries%s%s" 9996 (message "Acted on %d entries%s%s"
10052 cnt 9997 processed
10053 (if (= cntskip 0) 9998 (if (= skipped 0)
10054 "" 9999 ""
10055 (format ", skipped %d (disappeared before their turn)" 10000 (format ", skipped %d (disappeared before their turn)"
10056 cntskip)) 10001 skipped))
10057 (if (not org-agenda-persistent-marks) 10002 (if (not org-agenda-persistent-marks) "" " (kept marked)"))))))
10058 "" " (kept marked)"))))))
10059 10003
10060(defun org-agenda-capture (&optional with-time) 10004(defun org-agenda-capture (&optional with-time)
10061 "Call `org-capture' with the date at point. 10005 "Call `org-capture' with the date at point.
@@ -10249,9 +10193,7 @@ to override `appt-message-warning-time'."
10249 "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) 10193 "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
10250 (concat (match-string 1 tod) ":" 10194 (concat (match-string 1 tod) ":"
10251 (match-string 2 tod)))) 10195 (match-string 2 tod))))
10252 (when (if (version< emacs-version "23.3") 10196 (when (appt-add tod evt wrn)
10253 (appt-add tod evt)
10254 (appt-add tod evt wrn))
10255 (setq cnt (1+ cnt)))))) 10197 (setq cnt (1+ cnt))))))
10256 entries) 10198 entries)
10257 (org-release-buffers org-agenda-new-buffers) 10199 (org-release-buffers org-agenda-new-buffers)
diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el
index 41b75660b33..03376172a62 100644
--- a/lisp/org/org-archive.el
+++ b/lisp/org/org-archive.el
@@ -340,14 +340,20 @@ direct children of this heading."
340 (and (looking-at "[ \t\r\n]*") 340 (and (looking-at "[ \t\r\n]*")
341 ;; datetree archives don't need so much spacing. 341 ;; datetree archives don't need so much spacing.
342 (replace-match (if datetree-date "\n" "\n\n")))) 342 (replace-match (if datetree-date "\n" "\n\n"))))
343 ;; No specific heading, just go to end of file. 343 ;; No specific heading, just go to end of file, or to the
344 (goto-char (point-max)) 344 ;; beginning, depending on `org-archive-reversed-order'.
345 ;; Subtree narrowing can let the buffer end on 345 (if org-archive-reversed-order
346 ;; a headline. `org-paste-subtree' then deletes it. 346 (progn
347 ;; To prevent this, make sure visible part of buffer 347 (goto-char (point-min))
348 ;; always terminates on a new line, while limiting 348 (unless (org-at-heading-p) (outline-next-heading))
349 ;; number of blank lines in a date tree. 349 (insert "\n") (backward-char 1))
350 (unless (and datetree-date (bolp)) (insert "\n"))) 350 (goto-char (point-max))
351 ;; Subtree narrowing can let the buffer end on
352 ;; a headline. `org-paste-subtree' then deletes it.
353 ;; To prevent this, make sure visible part of buffer
354 ;; always terminates on a new line, while limiting
355 ;; number of blank lines in a date tree.
356 (unless (and datetree-date (bolp)) (insert "\n"))))
351 ;; Paste 357 ;; Paste
352 (org-paste-subtree (org-get-valid-level level (and heading 1))) 358 (org-paste-subtree (org-get-valid-level level (and heading 1)))
353 ;; Shall we append inherited tags? 359 ;; Shall we append inherited tags?
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
index 1feb99c0a08..38b79cecfe4 100644
--- a/lisp/org/org-attach.el
+++ b/lisp/org/org-attach.el
@@ -42,6 +42,8 @@
42(require 'org-id) 42(require 'org-id)
43(require 'vc-git) 43(require 'vc-git)
44 44
45(declare-function dired-dwim-target-directory "dired-aux")
46
45(defgroup org-attach nil 47(defgroup org-attach nil
46 "Options concerning entry attachments in Org mode." 48 "Options concerning entry attachments in Org mode."
47 :tag "Org Attach" 49 :tag "Org Attach"
@@ -142,7 +144,7 @@ When set to `query', ask the user instead."
142 "Confirmation preference for automatically getting annex files. 144 "Confirmation preference for automatically getting annex files.
143If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get." 145If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get."
144 :group 'org-attach 146 :group 'org-attach
145 :package-version '(Org . "9") 147 :package-version '(Org . "9.0")
146 :version "26.1" 148 :version "26.1"
147 :type '(choice 149 :type '(choice
148 (const :tag "confirm with `y-or-n-p'" ask) 150 (const :tag "confirm with `y-or-n-p'" ask)
@@ -173,6 +175,7 @@ Shows a list of commands and prompts for another key to execute a command."
173 175
174a Select a file and attach it to the task, using `org-attach-method'. 176a Select a file and attach it to the task, using `org-attach-method'.
175c/m/l/y Attach a file using copy/move/link/symbolic-link method. 177c/m/l/y Attach a file using copy/move/link/symbolic-link method.
178u Attach a file from URL (downloading it).
176n Create a new attachment, as an Emacs buffer. 179n Create a new attachment, as an Emacs buffer.
177z Synchronize the current task with its attachment 180z Synchronize the current task with its attachment
178 directory, in case you added attachments yourself. 181 directory, in case you added attachments yourself.
@@ -186,7 +189,7 @@ d Delete one attachment, you will be prompted for a file name.
186D Delete all of a task's attachments. A safer way is 189D Delete all of a task's attachments. A safer way is
187 to open the directory in dired and delete from there. 190 to open the directory in dired and delete from there.
188 191
189s Set a specific attachment directory for this entry. 192s Set a specific attachment directory for this entry or reset to default.
190i Make children of the current entry inherit its attachment directory."))) 193i Make children of the current entry inherit its attachment directory.")))
191 (org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) 194 (org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
192 (message "Select command: [acmlzoOfFdD]") 195 (message "Select command: [acmlzoOfFdD]")
@@ -202,6 +205,8 @@ i Make children of the current entry inherit its attachment directory.")))
202 (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) 205 (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
203 ((memq c '(?y ?\C-y)) 206 ((memq c '(?y ?\C-y))
204 (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) 207 (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
208 ((memq c '(?u ?\C-u))
209 (let ((org-attach-method 'url)) (call-interactively 'org-attach-url)))
205 ((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new)) 210 ((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new))
206 ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync)) 211 ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
207 ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open)) 212 ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
@@ -270,14 +275,30 @@ Throw an error if we cannot root the directory."
270 (buffer-file-name (buffer-base-buffer)) 275 (buffer-file-name (buffer-base-buffer))
271 (error "Need absolute `org-attach-directory' to attach in buffers without filename"))) 276 (error "Need absolute `org-attach-directory' to attach in buffers without filename")))
272 277
273(defun org-attach-set-directory () 278(defun org-attach-set-directory (&optional arg)
274 "Set the ATTACH_DIR property of the current entry. 279 "Set the ATTACH_DIR node property and ask to move files there.
275The property defines the directory that is used for attachments 280The property defines the directory that is used for attachments
276of the entry." 281of the entry. When called with `\\[universal-argument]', reset \
277 (interactive) 282the directory to
278 (let ((dir (org-entry-get nil "ATTACH_DIR"))) 283the default ID based one."
279 (setq dir (read-directory-name "Attachment directory: " dir)) 284 (interactive "P")
280 (org-entry-put nil "ATTACH_DIR" dir))) 285 (let ((old (org-attach-dir))
286 (new
287 (progn
288 (if arg (org-entry-delete nil "ATTACH_DIR")
289 (let ((dir (read-directory-name
290 "Attachment directory: "
291 (org-entry-get nil
292 "ATTACH_DIR"
293 (and org-attach-allow-inheritance t)))))
294 (org-entry-put nil "ATTACH_DIR" dir)))
295 (org-attach-dir t))))
296 (unless (or (string= old new)
297 (not old))
298 (when (yes-or-no-p "Copy over attachments from old directory? ")
299 (copy-directory old new t nil t))
300 (when (yes-or-no-p (concat "Delete " old))
301 (delete-directory old t)))))
281 302
282(defun org-attach-set-inherit () 303(defun org-attach-set-inherit ()
283 "Set the ATTACH_DIR_INHERIT property of the current entry. 304 "Set the ATTACH_DIR_INHERIT property of the current entry.
@@ -363,34 +384,47 @@ Only do this when `org-attach-store-link-p' is non-nil."
363 (file-name-nondirectory file)) 384 (file-name-nondirectory file))
364 org-stored-links))) 385 org-stored-links)))
365 386
387(defun org-attach-url (url)
388 (interactive "MURL of the file to attach: \n")
389 (org-attach-attach url))
390
366(defun org-attach-attach (file &optional visit-dir method) 391(defun org-attach-attach (file &optional visit-dir method)
367 "Move/copy/link FILE into the attachment directory of the current task. 392 "Move/copy/link FILE into the attachment directory of the current task.
368If VISIT-DIR is non-nil, visit the directory with dired. 393If VISIT-DIR is non-nil, visit the directory with dired.
369METHOD may be `cp', `mv', `ln', or `lns' default taken from 394METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
370`org-attach-method'." 395`org-attach-method'."
371 (interactive "fFile to keep as an attachment: \nP") 396 (interactive
397 (list
398 (read-file-name "File to keep as an attachment:"
399 (or (progn
400 (require 'dired-aux)
401 (dired-dwim-target-directory))
402 default-directory))
403 current-prefix-arg
404 nil))
372 (setq method (or method org-attach-method)) 405 (setq method (or method org-attach-method))
373 (let ((basename (file-name-nondirectory file))) 406 (let ((basename (file-name-nondirectory file)))
374 (when (and org-attach-file-list-property (not org-attach-inherited)) 407 (when (and org-attach-file-list-property (not org-attach-inherited))
375 (org-entry-add-to-multivalued-property 408 (org-entry-add-to-multivalued-property
376 (point) org-attach-file-list-property basename)) 409 (point) org-attach-file-list-property basename))
377 (let* ((attach-dir (org-attach-dir t)) 410 (let* ((attach-dir (org-attach-dir t))
378 (fname (expand-file-name basename attach-dir))) 411 (fname (expand-file-name basename attach-dir)))
379 (cond 412 (cond
380 ((eq method 'mv) (rename-file file fname)) 413 ((eq method 'mv) (rename-file file fname))
381 ((eq method 'cp) (copy-file file fname)) 414 ((eq method 'cp) (copy-file file fname))
382 ((eq method 'ln) (add-name-to-file file fname)) 415 ((eq method 'ln) (add-name-to-file file fname))
383 ((eq method 'lns) (make-symbolic-link file fname))) 416 ((eq method 'lns) (make-symbolic-link file fname))
417 ((eq method 'url) (url-copy-file file fname)))
384 (when org-attach-commit 418 (when org-attach-commit
385 (org-attach-commit)) 419 (org-attach-commit))
386 (org-attach-tag) 420 (org-attach-tag)
387 (cond ((eq org-attach-store-link-p 'attached) 421 (cond ((eq org-attach-store-link-p 'attached)
388 (org-attach-store-link fname)) 422 (org-attach-store-link fname))
389 ((eq org-attach-store-link-p t) 423 ((eq org-attach-store-link-p t)
390 (org-attach-store-link file))) 424 (org-attach-store-link file)))
391 (if visit-dir 425 (if visit-dir
392 (dired attach-dir) 426 (dired attach-dir)
393 (message "File \"%s\" is now a task attachment." basename))))) 427 (message "File %S is now a task attachment." basename)))))
394 428
395(defun org-attach-attach-cp () 429(defun org-attach-attach-cp ()
396 "Attach a file by copying it." 430 "Attach a file by copying it."
diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el
index 2189b2050a5..889271affea 100644
--- a/lisp/org/org-bbdb.el
+++ b/lisp/org/org-bbdb.el
@@ -138,6 +138,24 @@
138 :group 'org-bbdb-anniversaries 138 :group 'org-bbdb-anniversaries
139 :require 'bbdb) 139 :require 'bbdb)
140 140
141(defcustom org-bbdb-general-anniversary-description-after 7
142 "When to switch anniversary descriptions to a more general format.
143
144Anniversary descriptions include the point in time, when the
145anniversary appears. This is, in its most general form, just the
146date of the anniversary. Or more specific terms, like \"today\",
147\"tomorrow\" or \"in n days\" are used to describe the time span.
148
149If the anniversary happens in less than that number of days, the
150specific description is used. Otherwise, the general one is
151used."
152 :group 'org-bbdb-anniversaries
153 :version "26.1"
154 :package-version '(Org . "9.1")
155 :type 'integer
156 :require 'bbdb
157 :safe #'integerp)
158
141(defcustom org-bbdb-anniversary-format-alist 159(defcustom org-bbdb-anniversary-format-alist
142 '(("birthday" . 160 '(("birthday" .
143 (lambda (name years suffix) 161 (lambda (name years suffix)
@@ -412,7 +430,25 @@ This is used by Org to re-create the anniversary hash table."
412 (mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i))) 430 (mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i)))
413 (number-sequence 0 (1- n))))) 431 (number-sequence 0 (1- n)))))
414 432
415;;;###autoload 433(defun org-bbdb-anniversary-description (agenda-date anniv-date)
434 "Return a string used to incorporate into an agenda anniversary entry.
435The calculation of the anniversary description string is based on
436the difference between the anniversary date, given as ANNIV-DATE,
437and the date on which the entry appears in the agenda, given as
438AGENDA-DATE. This makes it possible to have different entries
439for the same event depending on if it occurs in the next few days
440or far away in the future."
441 (let ((delta (- (calendar-absolute-from-gregorian anniv-date)
442 (calendar-absolute-from-gregorian agenda-date))))
443
444 (cond
445 ((= delta 0) " -- today\\&")
446 ((= delta 1) " -- tomorrow\\&")
447 ((< delta org-bbdb-general-anniversary-description-after) (format " -- in %d days\\&" delta))
448 ((pcase-let ((`(,month ,day ,year) anniv-date))
449 (format " -- %d-%02d-%02d\\&" year month day))))))
450
451
416(defun org-bbdb-anniversaries-future (&optional n) 452(defun org-bbdb-anniversaries-future (&optional n)
417 "Return list of anniversaries for today and the next n-1 days (default n=7)." 453 "Return list of anniversaries for today and the next n-1 days (default n=7)."
418 (let ((n (or n 7))) 454 (let ((n (or n 7)))
@@ -425,19 +461,17 @@ must be positive"))
425 ;; Function to annotate text of each element of l with the 461 ;; Function to annotate text of each element of l with the
426 ;; anniversary date d. 462 ;; anniversary date d.
427 (annotate-descriptions 463 (annotate-descriptions
428 (lambda (d l) 464 (lambda (agenda-date d l)
429 (mapcar (lambda (x) 465 (mapcar (lambda (x)
430 ;; The assumption here is that x is a bbdb link 466 ;; The assumption here is that x is a bbdb link
431 ;; of the form [[bbdb:name][description]]. 467 ;; of the form [[bbdb:name][description]].
432 ;; This function rather arbitrarily modifies 468 ;; This function rather arbitrarily modifies
433 ;; the description by adding the date to it in 469 ;; the description by adding the date to it in
434 ;; a fixed format. 470 ;; a fixed format.
435 (string-match "]]" x) 471 (let ((desc (org-bbdb-anniversary-description
436 (replace-match (format " -- %d-%02d-%02d\\&" 472 agenda-date d)))
437 (nth 2 d) 473 (string-match "]]" x)
438 (nth 0 d) 474 (replace-match desc nil nil x)))
439 (nth 1 d))
440 nil nil x))
441 l)))) 475 l))))
442 ;; Map a function that generates anniversaries for each date 476 ;; Map a function that generates anniversaries for each date
443 ;; over the dates and nconc the results into a single list. When 477 ;; over the dates and nconc the results into a single list. When
@@ -447,12 +481,13 @@ must be positive"))
447 (apply #'nconc 481 (apply #'nconc
448 (mapcar 482 (mapcar
449 (lambda (d) 483 (lambda (d)
450 (let ((date d)) 484 (let ((agenda-date date)
485 (date d))
451 ;; Rebind 'date' so that org-bbdb-anniversaries will 486 ;; Rebind 'date' so that org-bbdb-anniversaries will
452 ;; be fooled into giving us the list for the given 487 ;; be fooled into giving us the list for the given
453 ;; date and then annotate the descriptions for that 488 ;; date and then annotate the descriptions for that
454 ;; date. 489 ;; date.
455 (funcall annotate-descriptions d (org-bbdb-anniversaries)))) 490 (funcall annotate-descriptions agenda-date d (org-bbdb-anniversaries))))
456 dates))))) 491 dates)))))
457 492
458(defun org-bbdb-complete-link () 493(defun org-bbdb-complete-link ()
diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el
index 9c10393c001..8876085fd77 100644
--- a/lisp/org/org-bibtex.el
+++ b/lisp/org/org-bibtex.el
@@ -237,6 +237,17 @@ a missing title field."
237 :version "24.1" 237 :version "24.1"
238 :type 'boolean) 238 :type 'boolean)
239 239
240(defcustom org-bibtex-headline-format-function
241 (lambda (entry) (cdr (assq :title entry)))
242 "Function returning the headline text for `org-bibtex-write'.
243It should take a single argument, the bibtex entry (an alist as
244returned by `org-bibtex-read'). The default value simply returns
245the entry title."
246 :group 'org-bibtex
247 :version "26.1"
248 :package-version '(Org . "9.1")
249 :type 'function)
250
240(defcustom org-bibtex-export-arbitrary-fields nil 251(defcustom org-bibtex-export-arbitrary-fields nil
241 "When converting to bibtex allow fields not defined in `org-bibtex-fields'. 252 "When converting to bibtex allow fields not defined in `org-bibtex-fields'.
242This only has effect if `org-bibtex-prefix' is defined, so as to 253This only has effect if `org-bibtex-prefix' is defined, so as to
@@ -678,7 +689,7 @@ Return the number of saved entries."
678 (val (lambda (field) (cdr (assoc field entry)))) 689 (val (lambda (field) (cdr (assoc field entry))))
679 (togtag (lambda (tag) (org-toggle-tag tag 'on)))) 690 (togtag (lambda (tag) (org-toggle-tag tag 'on))))
680 (org-insert-heading) 691 (org-insert-heading)
681 (insert (funcall val :title)) 692 (insert (funcall org-bibtex-headline-format-function entry))
682 (org-bibtex-put "TITLE" (funcall val :title)) 693 (org-bibtex-put "TITLE" (funcall val :title))
683 (org-bibtex-put org-bibtex-type-property-name 694 (org-bibtex-put org-bibtex-type-property-name
684 (downcase (funcall val :type))) 695 (downcase (funcall val :type)))
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index 4a438d050b0..862cdb27623 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -56,6 +56,7 @@
56(declare-function org-decrypt-entry "org-crypt" ()) 56(declare-function org-decrypt-entry "org-crypt" ())
57(declare-function org-encrypt-entry "org-crypt" ()) 57(declare-function org-encrypt-entry "org-crypt" ())
58(declare-function org-table-analyze "org-table" ()) 58(declare-function org-table-analyze "org-table" ())
59(declare-function org-table-current-dline "org-table" ())
59(declare-function org-table-goto-line "org-table" (N)) 60(declare-function org-table-goto-line "org-table" (N))
60 61
61(defvar org-end-time-was-given) 62(defvar org-end-time-was-given)
@@ -83,6 +84,36 @@
83 :tag "Org Capture" 84 :tag "Org Capture"
84 :group 'org) 85 :group 'org)
85 86
87(defun org-capture-upgrade-templates (templates)
88 "Update the template list to the new format.
89TEMPLATES is a template list, as in `org-capture-templates'. The
90new format unifies all the date/week tree targets into one that
91also allows for an optional outline path to specify a target."
92 (let ((modified-templates
93 (mapcar
94 (lambda (entry)
95 (pcase entry
96 ;; Match templates with an obsolete "tree" target type. Replace
97 ;; it with common `file+olp-datetree'. Add new properties
98 ;; (i.e., `:time-prompt' and `:tree-type') if needed.
99 (`(,key ,desc ,type (file+datetree . ,path) ,tpl . ,props)
100 `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl ,@props))
101 (`(,key ,desc ,type (file+datetree+prompt . ,path) ,tpl . ,props)
102 `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
103 :time-prompt t ,@props))
104 (`(,key ,desc ,type (file+weektree . ,path) ,tpl . ,props)
105 `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
106 :tree-type week ,@props))
107 (`(,key ,desc ,type (file+weektree+prompt . ,path) ,tpl . ,props)
108 `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
109 :tree-type week :time-prompt t ,@props))
110 ;; Other templates are left unchanged.
111 (_ entry)))
112 templates)))
113 (unless (equal modified-templates templates)
114 (message "Deprecated date/weektree capture templates changed to `file+olp+datetree'."))
115 modified-templates))
116
86(defcustom org-capture-templates nil 117(defcustom org-capture-templates nil
87 "Templates for the creation of new entries. 118 "Templates for the creation of new entries.
88 119
@@ -124,8 +155,8 @@ target Specification of where the captured item should be placed.
124 155
125 Most target specifications contain a file name. If that file 156 Most target specifications contain a file name. If that file
126 name is the empty string, it defaults to `org-default-notes-file'. 157 name is the empty string, it defaults to `org-default-notes-file'.
127 A file can also be given as a variable, function, or Emacs Lisp 158 A file can also be given as a variable or as a function called
128 form. When an absolute path is not specified for a 159 with no argument. When an absolute path is not specified for a
129 target, it is taken as relative to `org-directory'. 160 target, it is taken as relative to `org-directory'.
130 161
131 Valid values are: 162 Valid values are:
@@ -140,22 +171,17 @@ target Specification of where the captured item should be placed.
140 Fast configuration if the target heading is unique in the file 171 Fast configuration if the target heading is unique in the file
141 172
142 (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...) 173 (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...)
143 For non-unique headings, the full path is safer 174 For non-unique headings, the full outline path is safer
144 175
145 (file+regexp \"path/to/file\" \"regexp to find location\") 176 (file+regexp \"path/to/file\" \"regexp to find location\")
146 File to the entry matching regexp 177 File to the entry matching regexp
147 178
148 (file+datetree \"path/to/file\") 179 (file+olp+datetree \"path/to/file\" \"Level 1 heading\" ...)
149 Will create a heading in a date tree for today's date 180 Will create a heading in a date tree for today's date.
150 181 If no heading is given, the tree will be on top level.
151 (file+datetree+prompt \"path/to/file\") 182 To prompt for date instead of using TODAY, use the
152 Will create a heading in a date tree, prompts for date 183 :time-prompt property. To create a week-tree, use the
153 184 :tree-type property.
154 (file+weektree \"path/to/file\")
155 Will create a heading in a week tree for today's date
156
157 (file+weektree+prompt \"path/to/file\")
158 Will create a heading in a week tree, prompts for date
159 185
160 (file+function \"path/to/file\" function-finding-location) 186 (file+function \"path/to/file\" function-finding-location)
161 A function to find the right location in the file 187 A function to find the right location in the file
@@ -213,6 +239,11 @@ properties are:
213 When setting both to t, the current clock will run and 239 When setting both to t, the current clock will run and
214 the previous one will not be resumed. 240 the previous one will not be resumed.
215 241
242 :time-prompt Prompt for a date/time to be used for date/week trees
243 and when filling the template.
244
245 :tree-type When `week', make a week tree instead of the month tree.
246
216 :unnarrowed Do not narrow the target buffer, simply show the 247 :unnarrowed Do not narrow the target buffer, simply show the
217 full buffer. Default is to narrow it so that you 248 full buffer. Default is to narrow it so that you
218 only see the new stuff. 249 only see the new stuff.
@@ -299,6 +330,7 @@ When you need to insert a literal percent sign in the template,
299you can escape ambiguous cases with a backward slash, e.g., \\%i." 330you can escape ambiguous cases with a backward slash, e.g., \\%i."
300 :group 'org-capture 331 :group 'org-capture
301 :version "24.1" 332 :version "24.1"
333 :set (lambda (s v) (set s (org-capture-upgrade-templates v)))
302 :type 334 :type
303 (let ((file-variants '(choice :tag "Filename " 335 (let ((file-variants '(choice :tag "Filename "
304 (file :tag "Literal") 336 (file :tag "Literal")
@@ -339,18 +371,11 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
339 (const :format "" file+regexp) 371 (const :format "" file+regexp)
340 ,file-variants 372 ,file-variants
341 (regexp :tag " Regexp")) 373 (regexp :tag " Regexp"))
342 (list :tag "File & Date tree" 374 (list :tag "File [ & Outline path ] & Date tree"
343 (const :format "" file+datetree) 375 (const :format "" file+olp+datetree)
344 ,file-variants) 376 ,file-variants
345 (list :tag "File & Date tree, prompt for date" 377 (option (repeat :tag "Outline path" :inline t
346 (const :format "" file+datetree+prompt) 378 (string :tag "Headline"))))
347 ,file-variants)
348 (list :tag "File & Week tree"
349 (const :format "" file+weektree)
350 ,file-variants)
351 (list :tag "File & Week tree, prompt for date"
352 (const :format "" file+weektree+prompt)
353 ,file-variants)
354 (list :tag "File & function" 379 (list :tag "File & function"
355 (const :format "" file+function) 380 (const :format "" file+function)
356 ,file-variants 381 ,file-variants
@@ -379,8 +404,10 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
379 ((const :format "%v " :clock-in) (const t)) 404 ((const :format "%v " :clock-in) (const t))
380 ((const :format "%v " :clock-keep) (const t)) 405 ((const :format "%v " :clock-keep) (const t))
381 ((const :format "%v " :clock-resume) (const t)) 406 ((const :format "%v " :clock-resume) (const t))
407 ((const :format "%v " :time-prompt) (const t))
408 ((const :format "%v " :tree-type) (const week))
382 ((const :format "%v " :unnarrowed) (const t)) 409 ((const :format "%v " :unnarrowed) (const t))
383 ((const :format "%v " :table-line-pos) (const t)) 410 ((const :format "%v " :table-line-pos) (string))
384 ((const :format "%v " :kill-buffer) (const t))))))))) 411 ((const :format "%v " :kill-buffer) (const t)))))))))
385 412
386(defcustom org-capture-before-finalize-hook nil 413(defcustom org-capture-before-finalize-hook nil
@@ -564,6 +591,9 @@ the last note stored.
564 591
565When called with a `C-0' (zero) prefix, insert a template at point. 592When called with a `C-0' (zero) prefix, insert a template at point.
566 593
594When called with a `C-1' (one) prefix, force prompting for a date when
595a datetree entry is made.
596
567ELisp programs can set KEYS to a string associated with a template 597ELisp programs can set KEYS to a string associated with a template
568in `org-capture-templates'. In this case, interactive selection 598in `org-capture-templates'. In this case, interactive selection
569will be bypassed. 599will be bypassed.
@@ -581,7 +611,6 @@ of the day at point (if any) or the current HH:MM time."
581 ((equal goto '(4)) (org-capture-goto-target)) 611 ((equal goto '(4)) (org-capture-goto-target))
582 ((equal goto '(16)) (org-capture-goto-last-stored)) 612 ((equal goto '(16)) (org-capture-goto-last-stored))
583 (t 613 (t
584 ;; FIXME: Are these needed?
585 (let* ((orig-buf (current-buffer)) 614 (let* ((orig-buf (current-buffer))
586 (annotation (if (and (boundp 'org-capture-link-is-already-stored) 615 (annotation (if (and (boundp 'org-capture-link-is-already-stored)
587 org-capture-link-is-already-stored) 616 org-capture-link-is-already-stored)
@@ -818,13 +847,17 @@ for `entry'-type templates"))
818 (let* ((base (or (buffer-base-buffer) (current-buffer))) 847 (let* ((base (or (buffer-base-buffer) (current-buffer)))
819 (pos (make-marker)) 848 (pos (make-marker))
820 (org-capture-is-refiling t) 849 (org-capture-is-refiling t)
821 (kill-buffer (org-capture-get :kill-buffer 'local))) 850 (kill-buffer (org-capture-get :kill-buffer 'local))
851 (jump-to-captured (org-capture-get :jump-to-captured 'local)))
822 ;; Since `org-capture-finalize' may alter buffer contents (e.g., 852 ;; Since `org-capture-finalize' may alter buffer contents (e.g.,
823 ;; empty lines) around entry, use a marker to refer to the 853 ;; empty lines) around entry, use a marker to refer to the
824 ;; headline to be refiled. Place the marker in the base buffer, 854 ;; headline to be refiled. Place the marker in the base buffer,
825 ;; as the current indirect one is going to be killed. 855 ;; as the current indirect one is going to be killed.
826 (set-marker pos (save-excursion (org-back-to-heading t) (point)) base) 856 (set-marker pos (save-excursion (org-back-to-heading t) (point)) base)
827 (org-capture-put :kill-buffer nil) 857 ;; `org-capture-finalize' calls `org-capture-goto-last-stored' too
858 ;; early. We want to wait for the refiling to be over, so we
859 ;; control when the latter function is called.
860 (org-capture-put :kill-buffer nil :jump-to-captured nil)
828 (unwind-protect 861 (unwind-protect
829 (progn 862 (progn
830 (org-capture-finalize) 863 (org-capture-finalize)
@@ -833,7 +866,8 @@ for `entry'-type templates"))
833 (org-with-wide-buffer 866 (org-with-wide-buffer
834 (goto-char pos) 867 (goto-char pos)
835 (call-interactively 'org-refile)))) 868 (call-interactively 'org-refile))))
836 (when kill-buffer (kill-buffer base))) 869 (when kill-buffer (kill-buffer base))
870 (when jump-to-captured (org-capture-goto-last-stored)))
837 (set-marker pos nil)))) 871 (set-marker pos nil))))
838 872
839(defun org-capture-kill () 873(defun org-capture-kill ()
@@ -869,170 +903,171 @@ for `entry'-type templates"))
869(defun org-capture-set-target-location (&optional target) 903(defun org-capture-set-target-location (&optional target)
870 "Find TARGET buffer and position. 904 "Find TARGET buffer and position.
871Store them in the capture property list." 905Store them in the capture property list."
872 (let ((target-entry-p t) decrypted-hl-pos) 906 (let ((target-entry-p t))
873 (setq target (or target (org-capture-get :target)))
874 (save-excursion 907 (save-excursion
875 (cond 908 (pcase (or target (org-capture-get :target))
876 ((eq (car target) 'file) 909 (`(file ,path)
877 (set-buffer (org-capture-target-buffer (nth 1 target))) 910 (set-buffer (org-capture-target-buffer path))
878 (org-capture-put-target-region-and-position) 911 (org-capture-put-target-region-and-position)
879 (widen) 912 (widen)
880 (setq target-entry-p nil)) 913 (setq target-entry-p nil))
881 914 (`(id ,id)
882 ((eq (car target) 'id) 915 (pcase (org-id-find id)
883 (let ((loc (org-id-find (nth 1 target)))) 916 (`(,path . ,position)
884 (if (not loc) 917 (set-buffer (org-capture-target-buffer path))
885 (error "Cannot find target ID \"%s\"" (nth 1 target))
886 (set-buffer (org-capture-target-buffer (car loc)))
887 (widen) 918 (widen)
888 (org-capture-put-target-region-and-position) 919 (org-capture-put-target-region-and-position)
889 (goto-char (cdr loc))))) 920 (goto-char position))
890 921 (_ (error "Cannot find target ID \"%s\"" id))))
891 ((eq (car target) 'file+headline) 922 (`(file+headline ,path ,headline)
892 (set-buffer (org-capture-target-buffer (nth 1 target))) 923 (set-buffer (org-capture-target-buffer path))
893 (unless (derived-mode-p 'org-mode) 924 (unless (derived-mode-p 'org-mode)
894 (error 925 (error "Target buffer \"%s\" for file+headline not in Org mode"
895 "Target buffer \"%s\" for file+headline should be in Org mode" 926 (current-buffer)))
896 (current-buffer))) 927 (org-capture-put-target-region-and-position)
897 (org-capture-put-target-region-and-position) 928 (widen)
898 (widen) 929 (goto-char (point-min))
899 (let ((hd (nth 2 target))) 930 (if (re-search-forward (format org-complex-heading-regexp-format
900 (goto-char (point-min)) 931 (regexp-quote headline))
901 (if (re-search-forward 932 nil t)
902 (format org-complex-heading-regexp-format (regexp-quote hd)) 933 (goto-char (line-beginning-position))
903 nil t) 934 (goto-char (point-max))
904 (goto-char (point-at-bol)) 935 (or (bolp) (insert "\n"))
905 (goto-char (point-max)) 936 (insert "* " headline "\n")
906 (or (bolp) (insert "\n")) 937 (beginning-of-line 0)))
907 (insert "* " hd "\n") 938 (`(file+olp ,path . ,outline-path)
908 (beginning-of-line 0)))) 939 (let ((m (org-find-olp (cons (org-capture-expand-file path)
909 940 outline-path))))
910 ((eq (car target) 'file+olp) 941 (set-buffer (marker-buffer m))
911 (let ((m (org-find-olp 942 (org-capture-put-target-region-and-position)
912 (cons (org-capture-expand-file (nth 1 target)) 943 (widen)
913 (cddr target))))) 944 (goto-char m)
914 (set-buffer (marker-buffer m)) 945 (set-marker m nil)))
915 (org-capture-put-target-region-and-position) 946 (`(file+regexp ,path ,regexp)
916 (widen) 947 (set-buffer (org-capture-target-buffer path))
917 (goto-char m))) 948 (org-capture-put-target-region-and-position)
918 949 (widen)
919 ((eq (car target) 'file+regexp) 950 (goto-char (point-min))
920 (set-buffer (org-capture-target-buffer (nth 1 target))) 951 (if (not (re-search-forward regexp nil t))
921 (org-capture-put-target-region-and-position) 952 (error "No match for target regexp in file %s" path)
922 (widen) 953 (goto-char (if (org-capture-get :prepend)
923 (goto-char (point-min)) 954 (match-beginning 0)
924 (if (re-search-forward (nth 2 target) nil t) 955 (match-end 0)))
925 (progn 956 (org-capture-put :exact-position (point))
926 (goto-char (if (org-capture-get :prepend) 957 (setq target-entry-p
927 (match-beginning 0) (match-end 0))) 958 (and (derived-mode-p 'org-mode) (org-at-heading-p)))))
928 (org-capture-put :exact-position (point)) 959 (`(file+olp+datetree ,path . ,outline-path)
929 (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) 960 (let ((m (if outline-path
930 (error "No match for target regexp in file %s" (nth 1 target)))) 961 (org-find-olp (cons (org-capture-expand-file path)
931 962 outline-path))
932 ((memq (car target) '(file+datetree file+datetree+prompt file+weektree file+weektree+prompt)) 963 (set-buffer (org-capture-target-buffer path))
933 (require 'org-datetree) 964 (point-marker))))
934 (set-buffer (org-capture-target-buffer (nth 1 target))) 965 (set-buffer (marker-buffer m))
935 (unless (derived-mode-p 'org-mode) 966 (org-capture-put-target-region-and-position)
936 (error "Target buffer \"%s\" for %s should be in Org mode" 967 (widen)
937 (current-buffer) 968 (goto-char m)
938 (car target))) 969 (set-marker m nil)
939 (org-capture-put-target-region-and-position) 970 (require 'org-datetree)
940 (widen) 971 (org-capture-put-target-region-and-position)
941 ;; Make a date/week tree entry, with the current date (or 972 (widen)
942 ;; yesterday, if we are extending dates for a couple of hours) 973 ;; Make a date/week tree entry, with the current date (or
943 (funcall 974 ;; yesterday, if we are extending dates for a couple of hours)
944 (cond 975 (funcall
945 ((memq (car target) '(file+weektree file+weektree+prompt)) 976 (if (eq (org-capture-get :tree-type) 'week)
946 #'org-datetree-find-iso-week-create) 977 #'org-datetree-find-iso-week-create
947 (t #'org-datetree-find-date-create)) 978 #'org-datetree-find-date-create)
948 (calendar-gregorian-from-absolute 979 (calendar-gregorian-from-absolute
949 (cond 980 (cond
950 (org-overriding-default-time 981 (org-overriding-default-time
951 ;; use the overriding default time 982 ;; Use the overriding default time.
952 (time-to-days org-overriding-default-time)) 983 (time-to-days org-overriding-default-time))
953 984 ((or (org-capture-get :time-prompt)
954 ((memq (car target) '(file+datetree+prompt file+weektree+prompt)) 985 (equal current-prefix-arg 1))
955 ;; prompt for date 986 ;; Prompt for date.
956 (let ((prompt-time (org-read-date 987 (let ((prompt-time (org-read-date
957 nil t nil "Date for tree entry:" 988 nil t nil "Date for tree entry:"
958 (current-time)))) 989 (current-time))))
959 (org-capture-put 990 (org-capture-put
960 :default-time 991 :default-time
961 (cond ((and (or (not (boundp 'org-time-was-given)) 992 (cond ((and (or (not (boundp 'org-time-was-given))
962 (not org-time-was-given)) 993 (not org-time-was-given))
963 (not (= (time-to-days prompt-time) (org-today)))) 994 (not (= (time-to-days prompt-time) (org-today))))
964 ;; Use 00:00 when no time is given for another date than today? 995 ;; Use 00:00 when no time is given for another
965 (apply #'encode-time 996 ;; date than today?
966 (append '(0 0 0) 997 (apply #'encode-time
967 (cl-cdddr (decode-time prompt-time))))) 998 (append '(0 0 0)
968 ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer) 999 (cl-cdddr (decode-time prompt-time)))))
969 ;; Replace any time range by its start 1000 ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)"
970 (apply 'encode-time 1001 org-read-date-final-answer)
971 (org-read-date-analyze 1002 ;; Replace any time range by its start.
972 (replace-match "\\1 \\2" nil nil org-read-date-final-answer) 1003 (apply #'encode-time
973 prompt-time (decode-time prompt-time)))) 1004 (org-read-date-analyze
974 (t prompt-time))) 1005 (replace-match "\\1 \\2" nil nil
975 (time-to-days prompt-time))) 1006 org-read-date-final-answer)
976 (t 1007 prompt-time (decode-time prompt-time))))
977 ;; current date, possibly corrected for late night workers 1008 (t prompt-time)))
978 (org-today)))))) 1009 (time-to-days prompt-time)))
979 1010 (t
980 ((eq (car target) 'file+function) 1011 ;; Current date, possibly corrected for late night
981 (set-buffer (org-capture-target-buffer (nth 1 target))) 1012 ;; workers.
982 (org-capture-put-target-region-and-position) 1013 (org-today))))
983 (widen) 1014 ;; the following is the keep-restriction argument for
984 (funcall (nth 2 target)) 1015 ;; org-datetree-find-date-create
985 (org-capture-put :exact-position (point)) 1016 (if outline-path 'subtree-at-point))))
986 (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) 1017 (`(file+function ,path ,function)
987 1018 (set-buffer (org-capture-target-buffer path))
988 ((eq (car target) 'function) 1019 (org-capture-put-target-region-and-position)
989 (funcall (nth 1 target)) 1020 (widen)
990 (org-capture-put :exact-position (point)) 1021 (funcall function)
991 (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) 1022 (org-capture-put :exact-position (point))
992 1023 (setq target-entry-p
993 ((eq (car target) 'clock) 1024 (and (derived-mode-p 'org-mode) (org-at-heading-p))))
994 (if (and (markerp org-clock-hd-marker) 1025 (`(function ,fun)
995 (marker-buffer org-clock-hd-marker)) 1026 (funcall fun)
996 (progn (set-buffer (marker-buffer org-clock-hd-marker)) 1027 (org-capture-put :exact-position (point))
997 (org-capture-put-target-region-and-position) 1028 (setq target-entry-p
998 (widen) 1029 (and (derived-mode-p 'org-mode) (org-at-heading-p))))
999 (goto-char org-clock-hd-marker)) 1030 (`(clock)
1000 (error "No running clock that could be used as capture target"))) 1031 (if (and (markerp org-clock-hd-marker)
1001 1032 (marker-buffer org-clock-hd-marker))
1002 (t (error "Invalid capture target specification"))) 1033 (progn (set-buffer (marker-buffer org-clock-hd-marker))
1003 1034 (org-capture-put-target-region-and-position)
1004 (when (and (featurep 'org-crypt) (org-at-encrypted-entry-p)) 1035 (widen)
1005 (org-decrypt-entry) 1036 (goto-char org-clock-hd-marker))
1006 (setq decrypted-hl-pos 1037 (error "No running clock that could be used as capture target")))
1007 (save-excursion (and (org-back-to-heading t) (point))))) 1038 (target (error "Invalid capture target specification: %S" target)))
1008 1039
1009 (org-capture-put :buffer (current-buffer) :pos (point) 1040 (org-capture-put :buffer (current-buffer)
1041 :pos (point)
1010 :target-entry-p target-entry-p 1042 :target-entry-p target-entry-p
1011 :decrypted decrypted-hl-pos)))) 1043 :decrypted
1044 (and (featurep 'org-crypt)
1045 (org-at-encrypted-entry-p)
1046 (save-excursion
1047 (org-decrypt-entry)
1048 (and (org-back-to-heading t) (point))))))))
1012 1049
1013(defun org-capture-expand-file (file) 1050(defun org-capture-expand-file (file)
1014 "Expand functions, symbols and file names for FILE. 1051 "Expand functions, symbols and file names for FILE.
1015When FILE is a function, call it. When it is a form, evaluate 1052When FILE is a function, call it. When it is a form, evaluate
1016it. When it is a variable, retrieve the value. When it is 1053it. When it is a variable, return its value. When it is
1017a string, treat it as a file name, possibly expanding it 1054a string, treat it as a file name, possibly expanding it
1018according to `org-directory', and return it. If it is the empty 1055according to `org-directory', and return it. If it is the empty
1019string, however, return `org-default-notes-file'. In any other 1056string, however, return `org-default-notes-file'. In any other
1020case, raise an error." 1057case, raise an error."
1021 (cond 1058 (let ((location (cond ((equal file "") org-default-notes-file)
1022 ((equal file "") org-default-notes-file) 1059 ((stringp file) (expand-file-name file org-directory))
1023 ((stringp file) (expand-file-name file org-directory)) 1060 ((functionp file) (funcall file))
1024 ((functionp file) (funcall file)) 1061 ((and (symbolp file) (boundp file)) (symbol-value file))
1025 ((and (symbolp file) (boundp file)) (symbol-value file)) 1062 (t nil))))
1026 ((consp file) (eval file)) 1063 (or (org-string-nw-p location)
1027 (t file))) 1064 (error "Invalid file location: %S" location))))
1028 1065
1029(defun org-capture-target-buffer (file) 1066(defun org-capture-target-buffer (file)
1030 "Get a buffer for FILE. 1067 "Get a buffer for FILE.
1031FILE is a generalized file location, as handled by 1068FILE is a generalized file location, as handled by
1032`org-capture-expand-file'." 1069`org-capture-expand-file'."
1033 (let ((file (or (org-string-nw-p (org-capture-expand-file file)) 1070 (let ((file (org-capture-expand-file file)))
1034 org-default-notes-file
1035 (error "No notes file specified, and no default available"))))
1036 (or (org-find-base-buffer-visiting file) 1071 (or (org-find-base-buffer-visiting file)
1037 (progn (org-capture-put :new-buffer t) 1072 (progn (org-capture-put :new-buffer t)
1038 (find-file-noselect file))))) 1073 (find-file-noselect file)))))
@@ -1062,7 +1097,7 @@ may have been stored before."
1062(defun org-capture-place-entry () 1097(defun org-capture-place-entry ()
1063 "Place the template as a new Org entry." 1098 "Place the template as a new Org entry."
1064 (let ((reversed? (org-capture-get :prepend)) 1099 (let ((reversed? (org-capture-get :prepend))
1065 level) 1100 (level 1))
1066 (when (org-capture-get :exact-position) 1101 (when (org-capture-get :exact-position)
1067 (goto-char (org-capture-get :exact-position))) 1102 (goto-char (org-capture-get :exact-position)))
1068 (cond 1103 (cond
@@ -1523,7 +1558,8 @@ is selected, only the bare key is returned."
1523Lisp programs can force the template by setting KEYS to a string." 1558Lisp programs can force the template by setting KEYS to a string."
1524 (let ((org-capture-templates 1559 (let ((org-capture-templates
1525 (or (org-contextualize-keys 1560 (or (org-contextualize-keys
1526 org-capture-templates org-capture-templates-contexts) 1561 (org-capture-upgrade-templates org-capture-templates)
1562 org-capture-templates-contexts)
1527 '(("t" "Task" entry (file+headline "" "Tasks") 1563 '(("t" "Task" entry (file+headline "" "Tasks")
1528 "* TODO %?\n %u\n %a"))))) 1564 "* TODO %?\n %u\n %a")))))
1529 (if keys 1565 (if keys
@@ -1651,7 +1687,7 @@ The template may still contain \"%?\" for cursor positioning."
1651 (let* ((inside-sexp? (org-capture-inside-embedded-elisp-p)) 1687 (let* ((inside-sexp? (org-capture-inside-embedded-elisp-p))
1652 (replacement 1688 (replacement
1653 (pcase (string-to-char value) 1689 (pcase (string-to-char value)
1654 (?< (format-time-string time-string)) 1690 (?< (format-time-string time-string time))
1655 (?: 1691 (?:
1656 (or (plist-get org-store-link-plist (intern value)) 1692 (or (plist-get org-store-link-plist (intern value))
1657 "")) 1693 ""))
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 7d7640db588..8df185d2e91 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -39,7 +39,6 @@
39 39
40(defvar org-frame-title-format-backup frame-title-format) 40(defvar org-frame-title-format-backup frame-title-format)
41(defvar org-time-stamp-formats) 41(defvar org-time-stamp-formats)
42(defvar org-ts-what)
43 42
44 43
45(defgroup org-clock nil 44(defgroup org-clock nil
@@ -523,6 +522,16 @@ of a different task.")
523(define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto) 522(define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto)
524(define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu) 523(define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu)
525 524
525(defun org-clock--translate (s language)
526 "Translate string S into using string LANGUAGE.
527Assume S in the English term to translate. Return S as-is if it
528cannot be translated."
529 (or (nth (pcase s
530 ("File" 1) ("L" 2) ("Timestamp" 3) ("Headline" 4) ("Time" 5)
531 ("ALL" 6) ("Total time" 7) ("File time" 8) ("Clock summary at" 9))
532 (assoc-string language org-clock-clocktable-language-setup t))
533 s))
534
526(defun org-clock-menu () 535(defun org-clock-menu ()
527 (interactive) 536 (interactive)
528 (popup-menu 537 (popup-menu
@@ -582,8 +591,9 @@ of a different task.")
582 "Hook called in task selection just before prompting the user.") 591 "Hook called in task selection just before prompting the user.")
583 592
584(defun org-clock-select-task (&optional prompt) 593(defun org-clock-select-task (&optional prompt)
585 "Select a task that was recently associated with clocking." 594 "Select a task that was recently associated with clocking.
586 (interactive) 595Return marker position of the selected task. Raise an error if
596there is no recent clock to choose from."
587 (let (och chl sel-list rpl (i 0) s) 597 (let (och chl sel-list rpl (i 0) s)
588 ;; Remove successive dups from the clock history to consider 598 ;; Remove successive dups from the clock history to consider
589 (dolist (c org-clock-history) 599 (dolist (c org-clock-history)
@@ -668,20 +678,19 @@ If an effort estimate was defined for the current item, use
668If not, show simply the clocked time like 01:50." 678If not, show simply the clocked time like 01:50."
669 (let ((clocked-time (org-clock-get-clocked-time))) 679 (let ((clocked-time (org-clock-get-clocked-time)))
670 (if org-clock-effort 680 (if org-clock-effort
671 (let* ((effort-in-minutes 681 (let* ((effort-in-minutes (org-duration-to-minutes org-clock-effort))
672 (org-duration-string-to-minutes org-clock-effort))
673 (work-done-str 682 (work-done-str
674 (propertize 683 (propertize
675 (org-minutes-to-clocksum-string clocked-time) 684 (org-duration-from-minutes clocked-time)
676 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text)) 685 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text))
677 'org-mode-line-clock-overrun 'org-mode-line-clock))) 686 'org-mode-line-clock-overrun 'org-mode-line-clock)))
678 (effort-str (org-minutes-to-clocksum-string effort-in-minutes)) 687 (effort-str (org-duration-from-minutes effort-in-minutes))
679 (clockstr (propertize 688 (clockstr (propertize
680 (concat " [%s/" effort-str 689 (concat " [%s/" effort-str
681 "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") 690 "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")")
682 'face 'org-mode-line-clock))) 691 'face 'org-mode-line-clock)))
683 (format clockstr work-done-str)) 692 (format clockstr work-done-str))
684 (propertize (concat " [" (org-minutes-to-clocksum-string clocked-time) 693 (propertize (concat " [" (org-duration-from-minutes clocked-time)
685 "]" (format " (%s)" org-clock-heading)) 694 "]" (format " (%s)" org-clock-heading))
686 'face 'org-mode-line-clock)))) 695 'face 'org-mode-line-clock))))
687 696
@@ -751,15 +760,15 @@ clocked item, and the value displayed in the mode line."
751 ;; A string. See if it is a delta 760 ;; A string. See if it is a delta
752 (setq sign (string-to-char value)) 761 (setq sign (string-to-char value))
753 (if (member sign '(?- ?+)) 762 (if (member sign '(?- ?+))
754 (setq current (org-duration-string-to-minutes current) 763 (setq current (org-duration-to-minutes current)
755 value (substring value 1)) 764 value (substring value 1))
756 (setq current 0)) 765 (setq current 0))
757 (setq value (org-duration-string-to-minutes value)) 766 (setq value (org-duration-to-minutes value))
758 (if (equal ?- sign) 767 (if (equal ?- sign)
759 (setq value (- current value)) 768 (setq value (- current value))
760 (if (equal ?+ sign) (setq value (+ current value))))) 769 (if (equal ?+ sign) (setq value (+ current value)))))
761 (setq value (max 0 value) 770 (setq value (max 0 value)
762 org-clock-effort (org-minutes-to-clocksum-string value)) 771 org-clock-effort (org-duration-from-minutes value))
763 (org-entry-put org-clock-marker "Effort" org-clock-effort) 772 (org-entry-put org-clock-marker "Effort" org-clock-effort)
764 (org-clock-update-mode-line) 773 (org-clock-update-mode-line)
765 (message "Effort is now %s" org-clock-effort)) 774 (message "Effort is now %s" org-clock-effort))
@@ -772,7 +781,7 @@ clocked item, and the value displayed in the mode line."
772 "Show notification if we spent more time than we estimated before. 781 "Show notification if we spent more time than we estimated before.
773Notification is shown only once." 782Notification is shown only once."
774 (when (org-clocking-p) 783 (when (org-clocking-p)
775 (let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort)) 784 (let ((effort-in-minutes (org-duration-to-minutes org-clock-effort))
776 (clocked-time (org-clock-get-clocked-time))) 785 (clocked-time (org-clock-get-clocked-time)))
777 (if (setq org-clock-task-overrun 786 (if (setq org-clock-task-overrun
778 (if (or (null effort-in-minutes) (zerop effort-in-minutes)) 787 (if (or (null effort-in-minutes) (zerop effort-in-minutes))
@@ -1193,9 +1202,7 @@ time as the start time. See `org-clock-continuously' to make this
1193the default behavior." 1202the default behavior."
1194 (interactive "P") 1203 (interactive "P")
1195 (setq org-clock-notification-was-shown nil) 1204 (setq org-clock-notification-was-shown nil)
1196 (org-refresh-properties 1205 (org-refresh-effort-properties)
1197 org-effort-property '((effort . identity)
1198 (effort-minutes . org-duration-string-to-minutes)))
1199 (catch 'abort 1206 (catch 'abort
1200 (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) 1207 (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
1201 (org-clocking-p))) 1208 (org-clocking-p)))
@@ -1620,8 +1627,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
1620 (when org-clock-out-switch-to-state 1627 (when org-clock-out-switch-to-state
1621 (save-excursion 1628 (save-excursion
1622 (org-back-to-heading t) 1629 (org-back-to-heading t)
1623 (let ((org-inhibit-logging t) 1630 (let ((org-clock-out-when-done nil))
1624 (org-clock-out-when-done nil))
1625 (cond 1631 (cond
1626 ((functionp org-clock-out-switch-to-state) 1632 ((functionp org-clock-out-switch-to-state)
1627 (let ((case-fold-search nil)) 1633 (let ((case-fold-search nil))
@@ -1636,7 +1642,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
1636 (org-todo org-clock-out-switch-to-state)))))) 1642 (org-todo org-clock-out-switch-to-state))))))
1637 (force-mode-line-update) 1643 (force-mode-line-update)
1638 (message (concat "Clock stopped at %s after " 1644 (message (concat "Clock stopped at %s after "
1639 (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s") 1645 (org-duration-from-minutes (+ (* 60 h) m)) "%s")
1640 te (if remove " => LINE REMOVED" "")) 1646 te (if remove " => LINE REMOVED" ""))
1641 (run-hooks 'org-clock-out-hook) 1647 (run-hooks 'org-clock-out-hook)
1642 (unless (org-clocking-p) 1648 (unless (org-clocking-p)
@@ -1674,11 +1680,11 @@ Optional argument N tells to change by that many units."
1674 "Change CLOCK timestamps synchronously at cursor. 1680 "Change CLOCK timestamps synchronously at cursor.
1675UPDOWN tells whether to change `up' or `down'. 1681UPDOWN tells whether to change `up' or `down'.
1676Optional argument N tells to change by that many units." 1682Optional argument N tells to change by that many units."
1677 (setq org-ts-what nil) 1683 (let ((tschange (if (eq updown 'up) 'org-timestamp-up
1678 (when (org-at-timestamp-p t) 1684 'org-timestamp-down))
1679 (let ((tschange (if (eq updown 'up) 'org-timestamp-up 1685 (timestamp? (org-at-timestamp-p 'lax))
1680 'org-timestamp-down)) 1686 ts1 begts1 ts2 begts2 updatets1 tdiff)
1681 ts1 begts1 ts2 begts2 updatets1 tdiff) 1687 (when timestamp?
1682 (save-excursion 1688 (save-excursion
1683 (move-beginning-of-line 1) 1689 (move-beginning-of-line 1)
1684 (re-search-forward org-ts-regexp3 nil t) 1690 (re-search-forward org-ts-regexp3 nil t)
@@ -1690,24 +1696,24 @@ Optional argument N tells to change by that many units."
1690 (if (not ts2) 1696 (if (not ts2)
1691 ;; fall back on org-timestamp-up if there is only one 1697 ;; fall back on org-timestamp-up if there is only one
1692 (funcall tschange n) 1698 (funcall tschange n)
1693 ;; setq this so that (boundp 'org-ts-what is non-nil)
1694 (funcall tschange n) 1699 (funcall tschange n)
1695 (let ((ts (if updatets1 ts2 ts1)) 1700 (let ((ts (if updatets1 ts2 ts1))
1696 (begts (if updatets1 begts1 begts2))) 1701 (begts (if updatets1 begts1 begts2)))
1697 (setq tdiff 1702 (setq tdiff
1698 (time-subtract 1703 (time-subtract
1699 (org-time-string-to-time org-last-changed-timestamp) 1704 (org-time-string-to-time org-last-changed-timestamp t)
1700 (org-time-string-to-time ts))) 1705 (org-time-string-to-time ts t)))
1701 (save-excursion 1706 (save-excursion
1702 (goto-char begts) 1707 (goto-char begts)
1703 (org-timestamp-change 1708 (org-timestamp-change
1704 (round (/ (float-time tdiff) 1709 (round (/ (float-time tdiff)
1705 (cond ((eq org-ts-what 'minute) 60) 1710 (pcase timestamp?
1706 ((eq org-ts-what 'hour) 3600) 1711 (`minute 60)
1707 ((eq org-ts-what 'day) (* 24 3600)) 1712 (`hour 3600)
1708 ((eq org-ts-what 'month) (* 24 3600 31)) 1713 (`day (* 24 3600))
1709 ((eq org-ts-what 'year) (* 24 3600 365.2))))) 1714 (`month (* 24 3600 31))
1710 org-ts-what 'updown))))))) 1715 (`year (* 24 3600 365.2)))))
1716 timestamp? 'updown)))))))
1711 1717
1712;;;###autoload 1718;;;###autoload
1713(defun org-clock-cancel () 1719(defun org-clock-cancel ()
@@ -1942,7 +1948,7 @@ Use `\\[org-clock-remove-overlays]' to remove the subtree times."
1942 (cond (todayp " for today") 1948 (cond (todayp " for today")
1943 (customp " (custom)") 1949 (customp " (custom)")
1944 (t ""))) 1950 (t "")))
1945 (org-minutes-to-clocksum-string 1951 (org-duration-from-minutes
1946 org-clock-file-total-minutes) 1952 org-clock-file-total-minutes)
1947 " (%d hours and %d minutes)") 1953 " (%d hours and %d minutes)")
1948 h m))) 1954 h m)))
@@ -1968,7 +1974,7 @@ will be easy to remove."
1968 ?\·) 1974 ?\·)
1969 '(face shadow)) 1975 '(face shadow))
1970 (org-add-props 1976 (org-add-props
1971 (format " %9s " (org-minutes-to-clocksum-string time)) 1977 (format " %9s " (org-duration-from-minutes time))
1972 '(face org-clock-overlay)) 1978 '(face org-clock-overlay))
1973 "")) 1979 ""))
1974 (overlay-put ov 'display tx) 1980 (overlay-put ov 'display tx)
@@ -2376,6 +2382,7 @@ the currently selected interval size."
2376 (`file-with-archives 2382 (`file-with-archives
2377 (and buffer-file-name 2383 (and buffer-file-name
2378 (org-add-archive-files (list buffer-file-name)))) 2384 (org-add-archive-files (list buffer-file-name))))
2385 ((pred functionp) (funcall scope))
2379 ((pred consp) scope) 2386 ((pred consp) scope)
2380 (_ (or (buffer-file-name) (current-buffer))))) 2387 (_ (or (buffer-file-name) (current-buffer)))))
2381 (block (plist-get params :block)) 2388 (block (plist-get params :block))
@@ -2456,20 +2463,12 @@ from the dynamic block definition."
2456 ;; someone wants to write their own special formatter, this maybe 2463 ;; someone wants to write their own special formatter, this maybe
2457 ;; much easier because there can be a fixed format with a 2464 ;; much easier because there can be a fixed format with a
2458 ;; well-defined number of columns... 2465 ;; well-defined number of columns...
2459 (let* ((hlchars '((1 . "*") (2 . "/"))) 2466 (let* ((lang (or (plist-get params :lang) "en"))
2460 (lwords (assoc (or (plist-get params :lang)
2461 (bound-and-true-p org-export-default-language)
2462 "en")
2463 org-clock-clocktable-language-setup))
2464 (multifile (plist-get params :multifile)) 2467 (multifile (plist-get params :multifile))
2465 (block (plist-get params :block)) 2468 (block (plist-get params :block))
2466 (sort (plist-get params :sort)) 2469 (sort (plist-get params :sort))
2467 (header (plist-get params :header)) 2470 (header (plist-get params :header))
2468 (ws (or (plist-get params :wstart) 1))
2469 (ms (or (plist-get params :mstart) 1))
2470 (link (plist-get params :link)) 2471 (link (plist-get params :link))
2471 (org-time-clocksum-use-effort-durations
2472 (plist-get params :effort-durations))
2473 (maxlevel (or (plist-get params :maxlevel) 3)) 2472 (maxlevel (or (plist-get params :maxlevel) 3))
2474 (emph (plist-get params :emphasize)) 2473 (emph (plist-get params :emphasize))
2475 (compact? (plist-get params :compact)) 2474 (compact? (plist-get params :compact))
@@ -2494,49 +2493,40 @@ from the dynamic block definition."
2494 (indent (or compact? (plist-get params :indent))) 2493 (indent (or compact? (plist-get params :indent)))
2495 (formula (plist-get params :formula)) 2494 (formula (plist-get params :formula))
2496 (case-fold-search t) 2495 (case-fold-search t)
2497 range-text total-time recalc narrow-cut-p) 2496 (total-time (apply #'+ (mapcar #'cadr tables)))
2497 recalc narrow-cut-p)
2498 2498
2499 (when (and narrow (integerp narrow) link) 2499 (when (and narrow (integerp narrow) link)
2500 ;; We cannot have both integer narrow and link. 2500 ;; We cannot have both integer narrow and link.
2501 (message 2501 (message "Using hard narrowing in clocktable to allow for links")
2502 "Using hard narrowing in clocktable to allow for links")
2503 (setq narrow (intern (format "%d!" narrow)))) 2502 (setq narrow (intern (format "%d!" narrow))))
2504 2503
2505 (when narrow 2504 (pcase narrow
2506 (cond 2505 ((or `nil (pred integerp)) nil) ;nothing to do
2507 ((integerp narrow)) 2506 ((and (pred symbolp)
2508 ((and (symbolp narrow) 2507 (guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow))))
2509 (string-match "\\`[0-9]+!\\'" (symbol-name narrow))) 2508 (setq narrow-cut-p t)
2510 (setq narrow-cut-p t 2509 (setq narrow (string-to-number (symbol-name narrow))))
2511 narrow (string-to-number (substring (symbol-name narrow) 2510 (_ (error "Invalid value %s of :narrow property in clock table" narrow)))
2512 0 -1))))
2513 (t
2514 (error "Invalid value %s of :narrow property in clock table"
2515 narrow))))
2516
2517 (when block
2518 ;; Get the range text for the header.
2519 (setq range-text (nth 2 (org-clock-special-range block nil t ws ms))))
2520
2521 ;; Compute the total time.
2522 (setq total-time (apply #'+ (mapcar #'cadr tables)))
2523 2511
2524 ;; Now we need to output this tsuff. 2512 ;; Now we need to output this table stuff.
2525 (goto-char ipos) 2513 (goto-char ipos)
2526 2514
2527 ;; Insert the text *before* the actual table. 2515 ;; Insert the text *before* the actual table.
2528 (insert-before-markers 2516 (insert-before-markers
2529 (or header 2517 (or header
2530 ;; Format the standard header. 2518 ;; Format the standard header.
2531 (concat 2519 (format "#+CAPTION: %s %s%s\n"
2532 "#+CAPTION: " 2520 (org-clock--translate "Clock summary at" lang)
2533 (nth 9 lwords) " [" 2521 (format-time-string (org-time-stamp-format t t))
2534 (substring 2522 (if block
2535 (format-time-string (cdr org-time-stamp-formats)) 2523 (let ((range-text
2536 1 -1) 2524 (nth 2 (org-clock-special-range
2537 "]" 2525 block nil t
2538 (if block (concat ", for " range-text ".") "") 2526 (plist-get params :wstart)
2539 "\n"))) 2527 (plist-get params :mstart)))))
2528 (format ", for %s." range-text))
2529 ""))))
2540 2530
2541 ;; Insert the narrowing line 2531 ;; Insert the narrowing line
2542 (when (and narrow (integerp narrow) (not narrow-cut-p)) 2532 (when (and narrow (integerp narrow) (not narrow-cut-p))
@@ -2545,36 +2535,45 @@ from the dynamic block definition."
2545 (if multifile "|" "") ;file column, maybe 2535 (if multifile "|" "") ;file column, maybe
2546 (if level? "|" "") ;level column, maybe 2536 (if level? "|" "") ;level column, maybe
2547 (if timestamp "|" "") ;timestamp column, maybe 2537 (if timestamp "|" "") ;timestamp column, maybe
2548 (if properties (make-string (length properties) ?|) "") ;properties columns, maybe 2538 (if properties ;properties columns, maybe
2549 (format "<%d>| |\n" narrow))) ; headline and time columns 2539 (make-string (length properties) ?|)
2540 "")
2541 (format "<%d>| |\n" narrow))) ;headline and time columns
2550 2542
2551 ;; Insert the table header line 2543 ;; Insert the table header line
2552 (insert-before-markers 2544 (insert-before-markers
2553 "|" ;table line starter 2545 "|" ;table line starter
2554 (if multifile (concat (nth 1 lwords) "|") "") ;file column, maybe 2546 (if multifile ;file column, maybe
2555 (if level? (concat (nth 2 lwords) "|") "") ;level column, maybe 2547 (concat (org-clock--translate "File" lang) "|")
2556 (if timestamp (concat (nth 3 lwords) "|") "") ;timestamp column, maybe 2548 "")
2549 (if level? ;level column, maybe
2550 (concat (org-clock--translate "L" lang) "|")
2551 "")
2552 (if timestamp ;timestamp column, maybe
2553 (concat (org-clock--translate "Timestamp" lang) "|")
2554 "")
2557 (if properties ;properties columns, maybe 2555 (if properties ;properties columns, maybe
2558 (concat (mapconcat #'identity properties "|") "|") 2556 (concat (mapconcat #'identity properties "|") "|")
2559 "") 2557 "")
2560 (concat (nth 4 lwords) "|") ;headline 2558 (concat (org-clock--translate "Headline" lang)"|")
2561 (concat (nth 5 lwords) "|") ;time column 2559 (concat (org-clock--translate "Time" lang) "|")
2562 (make-string (max 0 (1- time-columns)) ?|) ;other time columns 2560 (make-string (max 0 (1- time-columns)) ?|) ;other time columns
2563 (if (eq formula '%) "%|\n" "\n")) 2561 (if (eq formula '%) "%|\n" "\n"))
2564 2562
2565 ;; Insert the total time in the table 2563 ;; Insert the total time in the table
2566 (insert-before-markers 2564 (insert-before-markers
2567 "|-\n" ;a hline 2565 "|-\n" ;a hline
2568 "|" ;table line starter 2566 "|" ;table line starter
2569 (if multifile (concat "| " (nth 6 lwords) " ") "") 2567 (if multifile (format "| %s " (org-clock--translate "ALL" lang)) "")
2570 ;file column, maybe 2568 ;file column, maybe
2571 (if level? "|" "") ;level column, maybe 2569 (if level? "|" "") ;level column, maybe
2572 (if timestamp "|" "") ;timestamp column, maybe 2570 (if timestamp "|" "") ;timestamp column, maybe
2573 (make-string (length properties) ?|) ;properties columns, maybe 2571 (make-string (length properties) ?|) ;properties columns, maybe
2574 (concat (format org-clock-total-time-cell-format (nth 7 lwords)) 2572 (concat (format org-clock-total-time-cell-format
2573 (org-clock--translate "Total time" lang))
2575 "| ") 2574 "| ")
2576 (format org-clock-total-time-cell-format 2575 (format org-clock-total-time-cell-format
2577 (org-minutes-to-clocksum-string (or total-time 0))) ;time 2576 (org-duration-from-minutes (or total-time 0))) ;time
2578 "|" 2577 "|"
2579 (make-string (max 0 (1- time-columns)) ?|) 2578 (make-string (max 0 (1- time-columns)) ?|)
2580 (cond ((not (eq formula '%)) "") 2579 (cond ((not (eq formula '%)) "")
@@ -2595,7 +2594,7 @@ from the dynamic block definition."
2595 (insert-before-markers 2594 (insert-before-markers
2596 (format (concat "| %s %s | %s%s" 2595 (format (concat "| %s %s | %s%s"
2597 (format org-clock-file-time-cell-format 2596 (format org-clock-file-time-cell-format
2598 (nth 8 lwords)) 2597 (org-clock--translate "File time" lang))
2599 " | *%s*|\n") 2598 " | *%s*|\n")
2600 (file-name-nondirectory file-name) 2599 (file-name-nondirectory file-name)
2601 (if level? "| " "") ;level column, maybe 2600 (if level? "| " "") ;level column, maybe
@@ -2603,7 +2602,7 @@ from the dynamic block definition."
2603 (if properties ;properties columns, maybe 2602 (if properties ;properties columns, maybe
2604 (make-string (length properties) ?|) 2603 (make-string (length properties) ?|)
2605 "") 2604 "")
2606 (org-minutes-to-clocksum-string file-time)))) ;time 2605 (org-duration-from-minutes file-time)))) ;time
2607 2606
2608 ;; Get the list of node entries and iterate over it 2607 ;; Get the list of node entries and iterate over it
2609 (when (> maxlevel 0) 2608 (when (> maxlevel 0)
@@ -2619,15 +2618,18 @@ from the dynamic block definition."
2619 (org-shorten-string (match-string 3 headline) 2618 (org-shorten-string (match-string 3 headline)
2620 narrow)) 2619 narrow))
2621 (org-shorten-string headline narrow)))) 2620 (org-shorten-string headline narrow))))
2622 (let ((hlc (if emph (or (cdr (assoc level hlchars)) "") ""))) 2621 (cl-flet ((format-field (f) (format (cond ((not emph) "%s |")
2622 ((= level 1) "*%s* |")
2623 ((= level 2) "/%s/ |")
2624 (t "%s |"))
2625 f)))
2623 (insert-before-markers 2626 (insert-before-markers
2624 "|" ;start the table line 2627 "|" ;start the table line
2625 (if multifile "|" "") ;free space for file name column? 2628 (if multifile "|" "") ;free space for file name column?
2626 (if level? (format "%d|" level) "") ;level, maybe 2629 (if level? (format "%d|" level) "") ;level, maybe
2627 (if timestamp (concat ts "|") "") ;timestamp, maybe 2630 (if timestamp (concat ts "|") "") ;timestamp, maybe
2628 (if properties ;properties columns, maybe 2631 (if properties ;properties columns, maybe
2629 (concat (mapconcat (lambda (p) 2632 (concat (mapconcat (lambda (p) (or (cdr (assoc p props)) ""))
2630 (or (cdr (assoc p props)) ""))
2631 properties 2633 properties
2632 "|") 2634 "|")
2633 "|") 2635 "|")
@@ -2635,10 +2637,10 @@ from the dynamic block definition."
2635 (if indent ;indentation 2637 (if indent ;indentation
2636 (org-clocktable-indent-string level) 2638 (org-clocktable-indent-string level)
2637 "") 2639 "")
2638 hlc headline hlc "|" ;headline 2640 (format-field headline)
2639 ;; Empty fields for higher levels. 2641 ;; Empty fields for higher levels.
2640 (make-string (max 0 (1- (min time-columns level))) ?|) 2642 (make-string (max 0 (1- (min time-columns level))) ?|)
2641 hlc (org-minutes-to-clocksum-string time) hlc "|" ; time 2643 (format-field (org-duration-from-minutes time))
2642 (make-string (max 0 (- time-columns level)) ?|) 2644 (make-string (max 0 (- time-columns level)) ?|)
2643 (if (eq formula '%) 2645 (if (eq formula '%)
2644 (format "%.1f |" (* 100 (/ time (float total-time)))) 2646 (format "%.1f |" (* 100 (/ time (float total-time))))
@@ -2814,9 +2816,7 @@ PROPERTIES: The list properties specified in the `:properties' parameter
2814 (when (and time (> time 0) (org-at-heading-p)) 2816 (when (and time (> time 0) (org-at-heading-p))
2815 (let ((level (org-reduced-level (org-current-level)))) 2817 (let ((level (org-reduced-level (org-current-level))))
2816 (when (<= level maxlevel) 2818 (when (<= level maxlevel)
2817 (let* ((headline (replace-regexp-in-string 2819 (let* ((headline (org-get-heading t t t t))
2818 (format "\\`%s[ \t]+" org-comment-string) ""
2819 (nth 4 (org-heading-components))))
2820 (hdl 2820 (hdl
2821 (if (not link) headline 2821 (if (not link) headline
2822 (let ((search 2822 (let ((search
@@ -2834,11 +2834,9 @@ PROPERTIES: The list properties specified in the `:properties' parameter
2834 headline))))))) 2834 headline)))))))
2835 (tsp 2835 (tsp
2836 (and timestamp 2836 (and timestamp
2837 (let ((p (org-entry-properties (point) 'special))) 2837 (cl-some (lambda (p) (org-entry-get (point) p))
2838 (or (cdr (assoc "SCHEDULED" p)) 2838 '("SCHEDULED" "DEADLINE" "TIMESTAMP"
2839 (cdr (assoc "DEADLINE" p)) 2839 "TIMESTAMP_IA"))))
2840 (cdr (assoc "TIMESTAMP" p))
2841 (cdr (assoc "TIMESTAMP_IA" p))))))
2842 (props 2840 (props
2843 (and properties 2841 (and properties
2844 (delq nil 2842 (delq nil
diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index d800652cff0..242bdc26550 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -94,12 +94,9 @@ in `org-columns-summary-types-default', which see."
94 94
95;;; Column View 95;;; Column View
96 96
97(defvar org-columns-overlays nil 97(defvar-local org-columns-overlays nil
98 "Holds the list of current column overlays.") 98 "Holds the list of current column overlays.")
99 99
100(defvar org-columns--time 0.0
101 "Number of seconds since the epoch, as a floating point number.")
102
103(defvar-local org-columns-current-fmt nil 100(defvar-local org-columns-current-fmt nil
104 "Local variable, holds the currently active column format.") 101 "Local variable, holds the currently active column format.")
105 102
@@ -110,12 +107,15 @@ This is the compiled version of the format.")
110(defvar-local org-columns-current-maxwidths nil 107(defvar-local org-columns-current-maxwidths nil
111 "Currently active maximum column widths, as a vector.") 108 "Currently active maximum column widths, as a vector.")
112 109
113(defvar org-columns-begin-marker (make-marker) 110(defvar-local org-columns-begin-marker nil
114 "Points to the position where last a column creation command was called.") 111 "Points to the position where last a column creation command was called.")
115 112
116(defvar org-columns-top-level-marker (make-marker) 113(defvar-local org-columns-top-level-marker nil
117 "Points to the position where current columns region starts.") 114 "Points to the position where current columns region starts.")
118 115
116(defvar org-columns--time 0.0
117 "Number of seconds since the epoch, as a floating point number.")
118
119(defvar org-columns-map (make-sparse-keymap) 119(defvar org-columns-map (make-sparse-keymap)
120 "The keymap valid in column display.") 120 "The keymap valid in column display.")
121 121
@@ -264,7 +264,7 @@ possible to override it with optional argument COMPILED-FMT."
264 org-agenda-columns-add-appointments-to-effort-sum 264 org-agenda-columns-add-appointments-to-effort-sum
265 (string= p (upcase org-effort-property)) 265 (string= p (upcase org-effort-property))
266 (get-text-property (point) 'duration) 266 (get-text-property (point) 'duration)
267 (propertize (org-minutes-to-clocksum-string 267 (propertize (org-duration-from-minutes
268 (get-text-property (point) 'duration)) 268 (get-text-property (point) 'duration))
269 'face 'org-warning)) 269 'face 'org-warning))
270 ""))) 270 "")))
@@ -458,23 +458,22 @@ for the duration of the command.")
458(defun org-columns-remove-overlays () 458(defun org-columns-remove-overlays ()
459 "Remove all currently active column overlays." 459 "Remove all currently active column overlays."
460 (interactive) 460 (interactive)
461 (when (marker-buffer org-columns-begin-marker) 461 (when org-columns-overlays
462 (with-current-buffer (marker-buffer org-columns-begin-marker) 462 (when (local-variable-p 'org-previous-header-line-format)
463 (when (local-variable-p 'org-previous-header-line-format) 463 (setq header-line-format org-previous-header-line-format)
464 (setq header-line-format org-previous-header-line-format) 464 (kill-local-variable 'org-previous-header-line-format)
465 (kill-local-variable 'org-previous-header-line-format) 465 (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local))
466 (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local)) 466 (set-marker org-columns-begin-marker nil)
467 (move-marker org-columns-begin-marker nil) 467 (set-marker org-columns-top-level-marker nil)
468 (move-marker org-columns-top-level-marker nil) 468 (org-with-silent-modifications
469 (org-with-silent-modifications 469 (mapc #'delete-overlay org-columns-overlays)
470 (mapc 'delete-overlay org-columns-overlays) 470 (setq org-columns-overlays nil)
471 (setq org-columns-overlays nil) 471 (let ((inhibit-read-only t))
472 (let ((inhibit-read-only t)) 472 (remove-text-properties (point-min) (point-max) '(read-only t))))
473 (remove-text-properties (point-min) (point-max) '(read-only t)))) 473 (when org-columns-flyspell-was-active
474 (when org-columns-flyspell-was-active 474 (flyspell-mode 1))
475 (flyspell-mode 1)) 475 (when (local-variable-p 'org-colview-initial-truncate-line-value)
476 (when (local-variable-p 'org-colview-initial-truncate-line-value) 476 (setq truncate-lines org-colview-initial-truncate-line-value))))
477 (setq truncate-lines org-colview-initial-truncate-line-value)))))
478 477
479(defun org-columns-compact-links (s) 478(defun org-columns-compact-links (s)
480 "Replace [[link][desc]] with [desc] or [link]." 479 "Replace [[link][desc]] with [desc] or [link]."
@@ -613,20 +612,20 @@ Where possible, use the standard interface for changing this line."
613 (let* ((pom (or (org-get-at-bol 'org-marker) 612 (let* ((pom (or (org-get-at-bol 'org-marker)
614 (org-get-at-bol 'org-hd-marker) 613 (org-get-at-bol 'org-hd-marker)
615 (point))) 614 (point)))
616 (key (get-char-property (point) 'org-columns-key)) 615 (key (concat (or (get-char-property (point) 'org-columns-key)
617 (key1 (concat key "_ALL")) 616 (user-error "No column to edit at point"))
618 (allowed (org-entry-get pom key1 t)) 617 "_ALL"))
619 nval) 618 (allowed (org-entry-get pom key t))
619 (new-value (read-string "Allowed: " allowed)))
620 ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.???? 620 ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.????
621 ;; FIXME: Write back to #+PROPERTY setting if that is needed. 621 ;; FIXME: Write back to #+PROPERTY setting if that is needed.
622 (setq nval (read-string "Allowed: " allowed))
623 (org-entry-put 622 (org-entry-put
624 (cond ((marker-position org-entry-property-inherited-from) 623 (cond ((marker-position org-entry-property-inherited-from)
625 org-entry-property-inherited-from) 624 org-entry-property-inherited-from)
626 ((marker-position org-columns-top-level-marker) 625 ((marker-position org-columns-top-level-marker)
627 org-columns-top-level-marker) 626 org-columns-top-level-marker)
628 (t pom)) 627 (t pom))
629 key1 nval))) 628 key new-value)))
630 629
631(defun org-columns--call (fun) 630(defun org-columns--call (fun)
632 "Call function FUN while preserving heading visibility. 631 "Call function FUN while preserving heading visibility.
@@ -760,6 +759,8 @@ current specifications. This function also sets
760(defun org-columns-goto-top-level () 759(defun org-columns-goto-top-level ()
761 "Move to the beginning of the column view area. 760 "Move to the beginning of the column view area.
762Also sets `org-columns-top-level-marker' to the new position." 761Also sets `org-columns-top-level-marker' to the new position."
762 (unless (markerp org-columns-top-level-marker)
763 (setq org-columns-top-level-marker (make-marker)))
763 (goto-char 764 (goto-char
764 (move-marker 765 (move-marker
765 org-columns-top-level-marker 766 org-columns-top-level-marker
@@ -782,7 +783,9 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
782 (interactive "P") 783 (interactive "P")
783 (org-columns-remove-overlays) 784 (org-columns-remove-overlays)
784 (when global (goto-char (point-min))) 785 (when global (goto-char (point-min)))
785 (move-marker org-columns-begin-marker (point)) 786 (if (markerp org-columns-begin-marker)
787 (move-marker org-columns-begin-marker (point))
788 (setq org-columns-begin-marker (point-marker)))
786 (org-columns-goto-top-level) 789 (org-columns-goto-top-level)
787 ;; Initialize `org-columns-current-fmt' and 790 ;; Initialize `org-columns-current-fmt' and
788 ;; `org-columns-current-fmt-compiled'. 791 ;; `org-columns-current-fmt-compiled'.
@@ -940,29 +943,28 @@ starting the current column display, or in a #+COLUMNS line of
940the current buffer." 943the current buffer."
941 (let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))) 944 (let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)))
942 (setq-local org-columns-current-fmt fmt) 945 (setq-local org-columns-current-fmt fmt)
943 (when (marker-position org-columns-top-level-marker) 946 (when org-columns-overlays
944 (org-with-wide-buffer 947 (org-with-point-at org-columns-top-level-marker
945 (goto-char org-columns-top-level-marker) 948 (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS"))
946 (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS")) 949 (org-entry-put nil "COLUMNS" fmt)
947 (org-entry-put nil "COLUMNS" fmt) 950 (goto-char (point-min))
948 (goto-char (point-min)) 951 (let ((case-fold-search t))
949 (let ((case-fold-search t)) 952 ;; Try to replace the first COLUMNS keyword available.
950 ;; Try to replace the first COLUMNS keyword available. 953 (catch :found
951 (catch :found 954 (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t)
952 (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t) 955 (let ((element (save-match-data (org-element-at-point))))
953 (let ((element (save-match-data (org-element-at-point)))) 956 (when (and (eq (org-element-type element) 'keyword)
954 (when (and (eq (org-element-type element) 'keyword) 957 (equal (org-element-property :key element)
955 (equal (org-element-property :key element) 958 "COLUMNS"))
956 "COLUMNS")) 959 (replace-match (concat " " fmt) t t nil 1)
957 (replace-match (concat " " fmt) t t nil 1) 960 (throw :found nil))))
958 (throw :found nil)))) 961 ;; No COLUMNS keyword in the buffer. Insert one at the
959 ;; No COLUMNS keyword in the buffer. Insert one at the 962 ;; beginning, right before the first heading, if any.
960 ;; beginning, right before the first heading, if any. 963 (goto-char (point-min))
961 (goto-char (point-min)) 964 (unless (org-at-heading-p t) (outline-next-heading))
962 (unless (org-at-heading-p t) (outline-next-heading)) 965 (let ((inhibit-read-only t))
963 (let ((inhibit-read-only t)) 966 (insert-before-markers "#+COLUMNS: " fmt "\n"))))
964 (insert-before-markers "#+COLUMNS: " fmt "\n")))) 967 (setq-local org-columns-default-format fmt))))))
965 (setq-local org-columns-default-format fmt))))))
966 968
967(defun org-columns-update (property) 969(defun org-columns-update (property)
968 "Recompute PROPERTY, and update the columns display for it." 970 "Recompute PROPERTY, and update the columns display for it."
@@ -994,18 +996,17 @@ the current buffer."
994(defun org-columns-redo () 996(defun org-columns-redo ()
995 "Construct the column display again." 997 "Construct the column display again."
996 (interactive) 998 (interactive)
997 (message "Recomputing columns...") 999 (when org-columns-overlays
998 (org-with-wide-buffer 1000 (message "Recomputing columns...")
999 (when (marker-position org-columns-begin-marker) 1001 (org-with-point-at org-columns-begin-marker
1000 (goto-char org-columns-begin-marker)) 1002 (org-columns-remove-overlays)
1001 (org-columns-remove-overlays) 1003 (if (derived-mode-p 'org-mode)
1002 (if (derived-mode-p 'org-mode) 1004 ;; Since we already know the columns format, provide it
1003 ;; Since we already know the columns format, provide it instead 1005 ;; instead of computing again.
1004 ;; of computing again. 1006 (call-interactively #'org-columns org-columns-current-fmt)
1005 (call-interactively #'org-columns org-columns-current-fmt) 1007 (org-agenda-redo)
1006 (org-agenda-redo) 1008 (call-interactively #'org-agenda-columns)))
1007 (call-interactively #'org-agenda-columns))) 1009 (message "Recomputing columns...done")))
1008 (message "Recomputing columns...done"))
1009 1010
1010(defun org-columns-uncompile-format (compiled) 1011(defun org-columns-uncompile-format (compiled)
1011 "Turn the compiled columns format back into a string representation. 1012 "Turn the compiled columns format back into a string representation.
@@ -1060,63 +1061,40 @@ This function updates `org-columns-current-fmt-compiled'."
1060 1061
1061;;;; Column View Summary 1062;;;; Column View Summary
1062 1063
1063(defconst org-columns--duration-re 1064(defun org-columns--age-to-minutes (s)
1064 (concat "[0-9.]+ *" (regexp-opt (mapcar #'car org-effort-durations))) 1065 "Turn age string S into a number of minutes.
1065 "Regexp matching a duration.")
1066
1067(defun org-columns--time-to-seconds (s)
1068 "Turn time string S into a number of seconds.
1069A time is expressed as HH:MM, HH:MM:SS, or with units defined in
1070`org-effort-durations'. Plain numbers are considered as hours."
1071 (cond
1072 ((string-match-p org-columns--duration-re s)
1073 (* 60 (org-duration-string-to-minutes s)))
1074 ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\'" s)
1075 (+ (* 3600 (string-to-number (match-string 1 s)))
1076 (* 60 (string-to-number (match-string 2 s)))
1077 (if (match-end 3) (string-to-number (match-string 3 s)) 0)))
1078 (t (* 3600 (string-to-number s)))))
1079
1080(defun org-columns--age-to-seconds (s)
1081 "Turn age string S into a number of seconds.
1082An age is either computed from a given time-stamp, or indicated 1066An age is either computed from a given time-stamp, or indicated
1083as days/hours/minutes/seconds." 1067as a canonical duration, i.e., using units defined in
1068`org-duration-canonical-units'."
1084 (cond 1069 (cond
1085 ((string-match-p org-ts-regexp s) 1070 ((string-match-p org-ts-regexp s)
1086 (floor 1071 (/ (- org-columns--time
1087 (- org-columns--time 1072 (float-time (apply #'encode-time (org-parse-time-string s nil t))))
1088 (float-time (apply #'encode-time (org-parse-time-string s nil t)))))) 1073 60))
1089 ;; Match own output for computations in upper levels. 1074 ((org-duration-p s) (org-duration-to-minutes s t)) ;skip user units
1090 ((string-match "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" s)
1091 (+ (* 86400 (string-to-number (match-string 1 s)))
1092 (* 3600 (string-to-number (match-string 2 s)))
1093 (* 60 (string-to-number (match-string 3 s)))
1094 (string-to-number (match-string 4 s))))
1095 (t (user-error "Invalid age: %S" s)))) 1075 (t (user-error "Invalid age: %S" s))))
1096 1076
1077(defun org-columns--format-age (minutes)
1078 "Format MINUTES float as an age string."
1079 (org-duration-from-minutes minutes
1080 '(("d" . nil) ("h" . nil) ("min" . nil))
1081 t)) ;ignore user's custom units
1082
1097(defun org-columns--summary-apply-times (fun times) 1083(defun org-columns--summary-apply-times (fun times)
1098 "Apply FUN to time values TIMES. 1084 "Apply FUN to time values TIMES.
1099If TIMES contains any time value expressed as a duration, return 1085Return the result as a duration."
1100the result as a duration. If it contains any H:M:S, use that 1086 (org-duration-from-minutes
1101format instead. Otherwise, use H:M format." 1087 (apply fun
1102 (let* ((hms-flag nil) 1088 (mapcar (lambda (time)
1103 (duration-flag nil) 1089 ;; Unlike to `org-duration-to-minutes' standard
1104 (seconds 1090 ;; behavior, we want to consider plain numbers as
1105 (apply fun 1091 ;; hours. As a consequence, we treat them
1106 (mapcar 1092 ;; differently.
1107 (lambda (time) 1093 (if (string-match-p "\\`[0-9]+\\(?:\\.[0-9]*\\)?\\'" time)
1108 (cond 1094 (* 60 (string-to-number time))
1109 (duration-flag) 1095 (org-duration-to-minutes time)))
1110 ((string-match-p org-columns--duration-re time) 1096 times))
1111 (setq duration-flag t)) 1097 (org-duration-h:mm-only-p times)))
1112 (hms-flag)
1113 ((string-match-p "\\`[0-9]+:[0-9]+:[0-9]+\\'" time)
1114 (setq hms-flag t)))
1115 (org-columns--time-to-seconds time))
1116 times))))
1117 (cond (duration-flag (org-minutes-to-clocksum-string (/ seconds 60.0)))
1118 (hms-flag (format-seconds "%h:%.2m:%.2s" seconds))
1119 (t (format-seconds "%h:%.2m" seconds)))))
1120 1098
1121(defun org-columns--compute-spec (spec &optional update) 1099(defun org-columns--compute-spec (spec &optional update)
1122 "Update tree according to SPEC. 1100 "Update tree according to SPEC.
@@ -1283,21 +1261,18 @@ When PRINTF is non-nil, use it to format the result."
1283 1261
1284(defun org-columns--summary-min-age (ages _) 1262(defun org-columns--summary-min-age (ages _)
1285 "Compute the minimum time among AGES." 1263 "Compute the minimum time among AGES."
1286 (format-seconds 1264 (org-columns--format-age
1287 "%dd %.2hh %mm %ss" 1265 (apply #'min (mapcar #'org-columns--age-to-minutes ages))))
1288 (apply #'min (mapcar #'org-columns--age-to-seconds ages))))
1289 1266
1290(defun org-columns--summary-max-age (ages _) 1267(defun org-columns--summary-max-age (ages _)
1291 "Compute the maximum time among AGES." 1268 "Compute the maximum time among AGES."
1292 (format-seconds 1269 (org-columns--format-age
1293 "%dd %.2hh %mm %ss" 1270 (apply #'max (mapcar #'org-columns--age-to-minutes ages))))
1294 (apply #'max (mapcar #'org-columns--age-to-seconds ages))))
1295 1271
1296(defun org-columns--summary-mean-age (ages _) 1272(defun org-columns--summary-mean-age (ages _)
1297 "Compute the minimum time among AGES." 1273 "Compute the minimum time among AGES."
1298 (format-seconds 1274 (org-columns--format-age
1299 "%dd %.2hh %mm %ss" 1275 (/ (apply #'+ (mapcar #'org-columns--age-to-minutes ages))
1300 (/ (apply #'+ (mapcar #'org-columns--age-to-seconds ages))
1301 (float (length ages))))) 1276 (float (length ages)))))
1302 1277
1303(defun org-columns--summary-estimate (estimates _) 1278(defun org-columns--summary-estimate (estimates _)
@@ -1515,7 +1490,9 @@ PARAMS is a property list of parameters:
1515 "Turn on or update column view in the agenda." 1490 "Turn on or update column view in the agenda."
1516 (interactive) 1491 (interactive)
1517 (org-columns-remove-overlays) 1492 (org-columns-remove-overlays)
1518 (move-marker org-columns-begin-marker (point)) 1493 (if (markerp org-columns-begin-marker)
1494 (move-marker org-columns-begin-marker (point))
1495 (setq org-columns-begin-marker (point-marker)))
1519 (let* ((org-columns--time (float-time (current-time))) 1496 (let* ((org-columns--time (float-time (current-time)))
1520 (fmt 1497 (fmt
1521 (cond 1498 (cond
@@ -1634,26 +1611,23 @@ This will add overlays to the date lines, to show the summary for each day."
1634 1611
1635(defun org-agenda-colview-compute (fmt) 1612(defun org-agenda-colview-compute (fmt)
1636 "Compute the relevant columns in the contributing source buffers." 1613 "Compute the relevant columns in the contributing source buffers."
1637 (let ((files org-agenda-contributing-files) 1614 (dolist (file org-agenda-contributing-files)
1638 (org-columns-begin-marker (make-marker)) 1615 (let ((b (find-buffer-visiting file)))
1639 (org-columns-top-level-marker (make-marker))) 1616 (with-current-buffer (or (buffer-base-buffer b) b)
1640 (dolist (f files) 1617 (org-with-wide-buffer
1641 (let ((b (find-buffer-visiting f))) 1618 (org-with-silent-modifications
1642 (with-current-buffer (or (buffer-base-buffer b) b) 1619 (remove-text-properties (point-min) (point-max) '(org-summaries t)))
1643 (org-with-wide-buffer 1620 (goto-char (point-min))
1644 (org-with-silent-modifications 1621 (org-columns-get-format-and-top-level)
1645 (remove-text-properties (point-min) (point-max) '(org-summaries t))) 1622 (dolist (spec fmt)
1646 (goto-char (point-min)) 1623 (let ((prop (car spec)))
1647 (org-columns-get-format-and-top-level) 1624 (cond
1648 (dolist (spec fmt) 1625 ((equal prop "CLOCKSUM") (org-clock-sum))
1649 (let ((prop (car spec))) 1626 ((equal prop "CLOCKSUM_T") (org-clock-sum-today))
1650 (cond 1627 ((and (nth 3 spec)
1651 ((equal prop "CLOCKSUM") (org-clock-sum)) 1628 (let ((a (assoc prop org-columns-current-fmt-compiled)))
1652 ((equal prop "CLOCKSUM_T") (org-clock-sum-today)) 1629 (equal (nth 3 a) (nth 3 spec))))
1653 ((and (nth 3 spec) 1630 (org-columns-compute prop))))))))))
1654 (let ((a (assoc prop org-columns-current-fmt-compiled)))
1655 (equal (nth 3 a) (nth 3 spec))))
1656 (org-columns-compute prop)))))))))))
1657 1631
1658 1632
1659(provide 'org-colview) 1633(provide 'org-colview)
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index 26ac54eb01d..c963f06b559 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -35,8 +35,10 @@
35(declare-function org-at-table.el-p "org" (&optional table-type)) 35(declare-function org-at-table.el-p "org" (&optional table-type))
36(declare-function org-element-at-point "org-element" ()) 36(declare-function org-element-at-point "org-element" ())
37(declare-function org-element-type "org-element" (element)) 37(declare-function org-element-type "org-element" (element))
38(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
38(declare-function org-link-set-parameters "org" (type &rest rest)) 39(declare-function org-link-set-parameters "org" (type &rest rest))
39(declare-function org-table-end (&optional table-type)) 40(declare-function org-table-end (&optional table-type))
41(declare-function outline-next-heading "outline" ())
40(declare-function table--at-cell-p "table" (position &optional object at-column)) 42(declare-function table--at-cell-p "table" (position &optional object at-column))
41 43
42(defvar org-table-any-border-regexp) 44(defvar org-table-any-border-regexp)
@@ -44,9 +46,8 @@
44(defvar org-table-tab-recognizes-table.el) 46(defvar org-table-tab-recognizes-table.el)
45(defvar org-table1-hline-regexp) 47(defvar org-table1-hline-regexp)
46 48
47;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-' 49;;; Emacs < 25.1 compatibility
48;; prefix, `find-tag' is replaced with `xref-find-definition' and 50
49;; `x-get-selection' with `gui-get-selection'.
50(when (< emacs-major-version 25) 51(when (< emacs-major-version 25)
51 (defalias 'outline-hide-entry 'hide-entry) 52 (defalias 'outline-hide-entry 'hide-entry)
52 (defalias 'outline-hide-sublevels 'hide-sublevels) 53 (defalias 'outline-hide-sublevels 'hide-sublevels)
@@ -66,6 +67,48 @@
66 (decode-time time) 67 (decode-time time)
67 (decode-time time zone))) 68 (decode-time time zone)))
68 69
70(unless (fboundp 'directory-name-p)
71 (defun directory-name-p (name)
72 "Return non-nil if NAME ends with a directory separator character."
73 (let ((len (length name))
74 (lastc ?.))
75 (if (> len 0)
76 (setq lastc (aref name (1- len))))
77 (or (= lastc ?/)
78 (and (memq system-type '(windows-nt ms-dos))
79 (= lastc ?\\))))))
80
81(unless (fboundp 'directory-files-recursively)
82 (defun directory-files-recursively (dir regexp &optional include-directories)
83 "Return list of all files under DIR that have file names matching REGEXP.
84This function works recursively. Files are returned in \"depth first\"
85order, and files from each directory are sorted in alphabetical order.
86Each file name appears in the returned list in its absolute form.
87Optional argument INCLUDE-DIRECTORIES non-nil means also include in the
88output directories whose names match REGEXP."
89 (let ((result nil)
90 (files nil)
91 ;; When DIR is "/", remote file names like "/method:" could
92 ;; also be offered. We shall suppress them.
93 (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
94 (dolist (file (sort (file-name-all-completions "" dir)
95 'string<))
96 (unless (member file '("./" "../"))
97 (if (directory-name-p file)
98 (let* ((leaf (substring file 0 (1- (length file))))
99 (full-file (expand-file-name leaf dir)))
100 ;; Don't follow symlinks to other directories.
101 (unless (file-symlink-p full-file)
102 (setq result
103 (nconc result (directory-files-recursively
104 full-file regexp include-directories))))
105 (when (and include-directories
106 (string-match regexp leaf))
107 (setq result (nconc result (list full-file)))))
108 (when (string-match regexp file)
109 (push (expand-file-name file dir) files)))))
110 (nconc result (nreverse files)))))
111
69 112
70;;; Obsolete aliases (remove them after the next major release). 113;;; Obsolete aliases (remove them after the next major release).
71 114
@@ -89,7 +132,7 @@
89(defmacro org-re (s) 132(defmacro org-re (s)
90 "Replace posix classes in regular expression S." 133 "Replace posix classes in regular expression S."
91 (declare (debug (form)) 134 (declare (debug (form))
92 (obsolete "you can safely remove it." "Org 9.0")) 135 (obsolete "you can safely remove it." "Org 9.0"))
93 s) 136 s)
94 137
95;;;; Functions from cl-lib that Org used to have its own implementation of. 138;;;; Functions from cl-lib that Org used to have its own implementation of.
@@ -107,8 +150,8 @@
107Counting starts at 1." 150Counting starts at 1."
108 (cl-subseq list (1- start) end)) 151 (cl-subseq list (1- start) end))
109(make-obsolete 'org-sublist 152(make-obsolete 'org-sublist
110 "use cl-subseq (note the 0-based counting)." 153 "use cl-subseq (note the 0-based counting)."
111 "Org 9.0") 154 "Org 9.0")
112 155
113 156
114;;;; Functions available since Emacs 24.3 157;;;; Functions available since Emacs 24.3
@@ -126,25 +169,15 @@ Counting starts at 1."
126;;;; Functions and variables from previous releases now obsolete. 169;;;; Functions and variables from previous releases now obsolete.
127(define-obsolete-function-alias 'org-element-remove-indentation 170(define-obsolete-function-alias 'org-element-remove-indentation
128 'org-remove-indentation "Org 9.0") 171 'org-remove-indentation "Org 9.0")
129(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics
130 'org-checkbox-hierarchical-statistics "Org 8.0")
131(define-obsolete-variable-alias 'org-description-max-indent
132 'org-list-description-max-indent "Org 8.0")
133(define-obsolete-variable-alias 'org-latex-create-formula-image-program 172(define-obsolete-variable-alias 'org-latex-create-formula-image-program
134 'org-preview-latex-default-process "Org 9.0") 173 'org-preview-latex-default-process "Org 9.0")
135(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory 174(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory
136 'org-preview-latex-image-directory "Org 9.0") 175 'org-preview-latex-image-directory "Org 9.0")
137(define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0") 176(define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0")
138(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0") 177(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0")
139(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3") 178(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3")
140(define-obsolete-function-alias 'org-speed-command-default-hook
141 'org-speed-command-activate "Org 8.0")
142(define-obsolete-function-alias 'org-babel-speed-command-hook
143 'org-babel-speed-command-activate "Org 8.0")
144(define-obsolete-function-alias 'org-image-file-name-regexp 179(define-obsolete-function-alias 'org-image-file-name-regexp
145 'image-file-name-regexp "Org 9.0") 180 'image-file-name-regexp "Org 9.0")
146(define-obsolete-function-alias 'org-get-legal-level
147 'org-get-valid-level "Org 7.8")
148(define-obsolete-function-alias 'org-completing-read-no-i 181(define-obsolete-function-alias 'org-completing-read-no-i
149 'completing-read "Org 9.0") 182 'completing-read "Org 9.0")
150(define-obsolete-function-alias 'org-icompleting-read 183(define-obsolete-function-alias 'org-icompleting-read
@@ -156,47 +189,27 @@ Counting starts at 1."
156 'org-agenda-ignore-properties "Org 9.0") 189 'org-agenda-ignore-properties "Org 9.0")
157(define-obsolete-function-alias 'org-preview-latex-fragment 190(define-obsolete-function-alias 'org-preview-latex-fragment
158 'org-toggle-latex-fragment "Org 8.3") 191 'org-toggle-latex-fragment "Org 8.3")
159(define-obsolete-function-alias 'org-display-inline-modification-hook
160 'org-display-inline-remove-overlay "Org 8.0")
161(define-obsolete-function-alias 'org-export-get-genealogy 192(define-obsolete-function-alias 'org-export-get-genealogy
162 'org-element-lineage "Org 9.0") 193 'org-element-lineage "Org 9.0")
163(define-obsolete-variable-alias 'org-latex-with-hyperref 194(define-obsolete-variable-alias 'org-latex-with-hyperref
164 'org-latex-hyperref-template "Org 9.0") 195 'org-latex-hyperref-template "Org 9.0")
165(define-obsolete-variable-alias 'org-link-to-org-use-id
166 'org-id-link-to-org-use-id "Org 8.0")
167(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0") 196(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0")
168(define-obsolete-variable-alias 'org-clock-modeline-total
169 'org-clock-mode-line-total "Org 8.0")
170(define-obsolete-function-alias 'org-protocol-unhex-compound
171 'org-link-unescape-compound "Org 7.8")
172(define-obsolete-function-alias 'org-protocol-unhex-string
173 'org-link-unescape "Org 7.8")
174(define-obsolete-function-alias 'org-protocol-unhex-single-byte-sequence
175 'org-link-unescape-single-byte-sequence "Org 7.8")
176(define-obsolete-variable-alias 'org-export-htmlized-org-css-url 197(define-obsolete-variable-alias 'org-export-htmlized-org-css-url
177 'org-org-htmlized-css-url "Org 8.2") 198 'org-org-htmlized-css-url "Org 8.2")
178(define-obsolete-variable-alias 'org-alphabetical-lists
179 'org-list-allow-alphabetical "Org 8.0")
180(define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0") 199(define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0")
181(define-obsolete-variable-alias 'org-agenda-menu-two-column
182 'org-agenda-menu-two-columns "Org 8.0")
183(define-obsolete-variable-alias 'org-finalize-agenda-hook
184 'org-agenda-finalize-hook "Org 8.0")
185(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "Org 7.8")
186(define-obsolete-function-alias 'org-agenda-post-command-hook
187 'org-agenda-update-agenda-type "Org 8.0")
188(define-obsolete-function-alias 'org-agenda-todayp 200(define-obsolete-function-alias 'org-agenda-todayp
189 'org-agenda-today-p "Org 9.0") 201 'org-agenda-today-p "Org 9.0")
190(define-obsolete-function-alias 'org-babel-examplize-region 202(define-obsolete-function-alias 'org-babel-examplize-region
191 'org-babel-examplify-region "Org 9.0") 203 'org-babel-examplify-region "Org 9.0")
204(define-obsolete-variable-alias 'org-babel-capitalize-example-region-markers
205 'org-babel-uppercase-example-markers "Org 9.1")
206
192(define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0") 207(define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0")
193(define-obsolete-variable-alias 'org-html-style-include-scripts
194 'org-html-head-include-scripts "Org 8.0")
195(define-obsolete-variable-alias 'org-html-style-include-default
196 'org-html-head-include-default-style "Org 8.0")
197(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") 208(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
198(define-obsolete-function-alias 'org-insert-columns-dblock 209(define-obsolete-function-alias 'org-insert-columns-dblock
199 'org-columns-insert-dblock "Org 9.0") 210 'org-columns-insert-dblock "Org 9.0")
211(define-obsolete-variable-alias 'org-export-babel-evaluate
212 'org-export-use-babel "Org 9.1")
200(define-obsolete-function-alias 'org-activate-bracket-links 213(define-obsolete-function-alias 'org-activate-bracket-links
201 'org-activate-links "Org 9.0") 214 'org-activate-links "Org 9.0")
202(define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0") 215(define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0")
@@ -207,18 +220,8 @@ Counting starts at 1."
207 (save-match-data 220 (save-match-data
208 (eq 'fixed-width (org-element-type (org-element-at-point))))) 221 (eq 'fixed-width (org-element-type (org-element-at-point)))))
209(make-obsolete 'org-in-fixed-width-region-p 222(make-obsolete 'org-in-fixed-width-region-p
210 "use `org-element' library" 223 "use `org-element' library"
211 "Org 9.0") 224 "Org 9.0")
212
213(defcustom org-read-date-minibuffer-setup-hook nil
214 "Hook to be used to set up keys for the date/time interface.
215Add key definitions to `minibuffer-local-map', which will be a
216temporary copy."
217 :group 'org-time
218 :type 'hook)
219(make-obsolete-variable
220 'org-read-date-minibuffer-setup-hook
221 "set `org-read-date-minibuffer-local-map' instead." "Org 8.0")
222 225
223(defun org-compatible-face (inherits specs) 226(defun org-compatible-face (inherits specs)
224 "Make a compatible face specification. 227 "Make a compatible face specification.
@@ -267,26 +270,23 @@ See `org-link-parameters' for documentation on the other parameters."
267 (when (and org-table-tab-recognizes-table.el (org-at-table.el-p)) 270 (when (and org-table-tab-recognizes-table.el (org-at-table.el-p))
268 (beginning-of-line) 271 (beginning-of-line)
269 (unless (or (looking-at org-table-dataline-regexp) 272 (unless (or (looking-at org-table-dataline-regexp)
270 (not (looking-at org-table1-hline-regexp))) 273 (not (looking-at org-table1-hline-regexp)))
271 (forward-line) 274 (forward-line)
272 (when (looking-at org-table-any-border-regexp) 275 (when (looking-at org-table-any-border-regexp)
273 (forward-line -2))) 276 (forward-line -2)))
274 (if (re-search-forward "|" (org-table-end t) t) 277 (if (re-search-forward "|" (org-table-end t) t)
275 (progn 278 (progn
276 (require 'table) 279 (require 'table)
277 (if (table--at-cell-p (point)) t 280 (if (table--at-cell-p (point)) t
278 (message "recognizing table.el table...") 281 (message "recognizing table.el table...")
279 (table-recognize-table) 282 (table-recognize-table)
280 (message "recognizing table.el table...done"))) 283 (message "recognizing table.el table...done")))
281 (error "This should not happen")))) 284 (error "This should not happen"))))
282 285
283;; Not used by Org core since commit 6d1e3082, Feb 2010. 286;; Not used by Org core since commit 6d1e3082, Feb 2010.
284(make-obsolete 'org-table-recognize-table.el 287(make-obsolete 'org-table-recognize-table.el
285 "please notify the org mailing list if you use this function." 288 "please notify the org mailing list if you use this function."
286 "Org 9.0") 289 "Org 9.0")
287
288(define-obsolete-function-alias
289 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string "Org 8.0")
290 290
291(defun org-remove-angle-brackets (s) 291(defun org-remove-angle-brackets (s)
292 (org-unbracket-string "<" ">" s)) 292 (org-unbracket-string "<" ">" s))
@@ -296,9 +296,91 @@ See `org-link-parameters' for documentation on the other parameters."
296 (org-unbracket-string "\"" "\"" s)) 296 (org-unbracket-string "\"" "\"" s))
297(make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0") 297(make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0")
298 298
299(defcustom org-publish-sitemap-file-entry-format "%t"
300 "Format string for site-map file entry.
301You could use brackets to delimit on what part the link will be.
302
303%t is the title.
304%a is the author.
305%d is the date formatted using `org-publish-sitemap-date-format'."
306 :group 'org-export-publish
307 :type 'string)
308(make-obsolete-variable
309 'org-publish-sitemap-file-entry-format
310 "set `:sitemap-format-entry' in `org-publish-project-alist' instead."
311 "Org 9.1")
312
313(defvar org-agenda-skip-regexp)
314(defun org-agenda-skip-entry-when-regexp-matches ()
315 "Check if the current entry contains match for `org-agenda-skip-regexp'.
316If yes, it returns the end position of this entry, causing agenda commands
317to skip the entry but continuing the search in the subtree. This is a
318function that can be put into `org-agenda-skip-function' for the duration
319of a command."
320 (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
321 (let ((end (save-excursion (org-end-of-subtree t)))
322 skip)
323 (save-excursion
324 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
325 (and skip end)))
326
327(defun org-agenda-skip-subtree-when-regexp-matches ()
328 "Check if the current subtree contains match for `org-agenda-skip-regexp'.
329If yes, it returns the end position of this tree, causing agenda commands
330to skip this subtree. This is a function that can be put into
331`org-agenda-skip-function' for the duration of a command."
332 (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
333 (let ((end (save-excursion (org-end-of-subtree t)))
334 skip)
335 (save-excursion
336 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
337 (and skip end)))
338
339(defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
340 "Check if the current subtree contains match for `org-agenda-skip-regexp'.
341If yes, it returns the end position of the current entry (NOT the tree),
342causing agenda commands to skip the entry but continuing the search in
343the subtree. This is a function that can be put into
344`org-agenda-skip-function' for the duration of a command. An important
345use of this function is for the stuck project list."
346 (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
347 (let ((end (save-excursion (org-end-of-subtree t)))
348 (entry-end (save-excursion (outline-next-heading) (1- (point))))
349 skip)
350 (save-excursion
351 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
352 (and skip entry-end)))
353
354(define-obsolete-function-alias 'org-minutes-to-clocksum-string
355 'org-duration-from-minutes "Org 9.1")
356
357(define-obsolete-function-alias 'org-hh:mm-string-to-minutes
358 'org-duration-to-minutes "Org 9.1")
359
360(define-obsolete-function-alias 'org-duration-string-to-minutes
361 'org-duration-to-minutes "Org 9.1")
362
363(make-obsolete-variable 'org-time-clocksum-format
364 "set `org-duration-format' instead." "Org 9.1")
365
366(make-obsolete-variable 'org-time-clocksum-use-fractional
367 "set `org-duration-format' instead." "Org 9.1")
368
369(make-obsolete-variable 'org-time-clocksum-fractional-format
370 "set `org-duration-format' instead." "Org 9.1")
371
372(make-obsolete-variable 'org-time-clocksum-use-effort-durations
373 "set `org-duration-units' instead." "Org 9.1")
374
299(define-obsolete-function-alias 'org-babel-number-p 375(define-obsolete-function-alias 'org-babel-number-p
300 'org-babel--string-to-number "Org 9.0") 376 'org-babel--string-to-number "Org 9.0")
301 377
378(define-obsolete-variable-alias 'org-usenet-links-prefer-google
379 'org-gnus-prefer-web-links "Org 9.1")
380
381(define-obsolete-variable-alias 'org-texinfo-def-table-markup
382 'org-texinfo-table-default-markup "Org 9.1")
383
302;;; The function was made obsolete by commit 65399674d5 of 2013-02-22. 384;;; The function was made obsolete by commit 65399674d5 of 2013-02-22.
303;;; This make-obsolete call was added 2016-09-01. 385;;; This make-obsolete call was added 2016-09-01.
304(make-obsolete 'org-capture-import-remember-templates 386(make-obsolete 'org-capture-import-remember-templates
@@ -306,7 +388,6 @@ See `org-link-parameters' for documentation on the other parameters."
306 "Org 9.0") 388 "Org 9.0")
307 389
308 390
309
310;;;; Obsolete link types 391;;;; Obsolete link types
311 392
312(eval-after-load 'org 393(eval-after-load 'org
@@ -320,40 +401,40 @@ See `org-link-parameters' for documentation on the other parameters."
320 401
321(defun org-version-check (version feature level) 402(defun org-version-check (version feature level)
322 (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) 403 (let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
323 (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) 404 (v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
324 (rmaj (or (nth 0 v1) 99)) 405 (rmaj (or (nth 0 v1) 99))
325 (rmin (or (nth 1 v1) 99)) 406 (rmin (or (nth 1 v1) 99))
326 (rbld (or (nth 2 v1) 99)) 407 (rbld (or (nth 2 v1) 99))
327 (maj (or (nth 0 v2) 0)) 408 (maj (or (nth 0 v2) 0))
328 (min (or (nth 1 v2) 0)) 409 (min (or (nth 1 v2) 0))
329 (bld (or (nth 2 v2) 0))) 410 (bld (or (nth 2 v2) 0)))
330 (if (or (< maj rmaj) 411 (if (or (< maj rmaj)
331 (and (= maj rmaj) 412 (and (= maj rmaj)
332 (< min rmin)) 413 (< min rmin))
333 (and (= maj rmaj) 414 (and (= maj rmaj)
334 (= min rmin) 415 (= min rmin)
335 (< bld rbld))) 416 (< bld rbld)))
336 (if (eq level :predicate) 417 (if (eq level :predicate)
337 ;; just return if we have the version 418 ;; just return if we have the version
338 nil 419 nil
339 (let ((msg (format "Emacs %s or greater is recommended for %s" 420 (let ((msg (format "Emacs %s or greater is recommended for %s"
340 version feature))) 421 version feature)))
341 (display-warning 'org msg level) 422 (display-warning 'org msg level)
342 t)) 423 t))
343 t))) 424 t)))
344 425
345(defun org-get-x-clipboard (value) 426(defun org-get-x-clipboard (value)
346 "Get the value of the X or Windows clipboard." 427 "Get the value of the X or Windows clipboard."
347 (cond ((and (eq window-system 'x) 428 (cond ((and (eq window-system 'x)
348 (fboundp 'gui-get-selection)) ;Silence byte-compiler. 429 (fboundp 'gui-get-selection)) ;Silence byte-compiler.
349 (org-no-properties 430 (org-no-properties
350 (ignore-errors 431 (ignore-errors
351 (or (gui-get-selection value 'UTF8_STRING) 432 (or (gui-get-selection value 'UTF8_STRING)
352 (gui-get-selection value 'COMPOUND_TEXT) 433 (gui-get-selection value 'COMPOUND_TEXT)
353 (gui-get-selection value 'STRING) 434 (gui-get-selection value 'STRING)
354 (gui-get-selection value 'TEXT))))) 435 (gui-get-selection value 'TEXT)))))
355 ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) 436 ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
356 (w32-get-clipboard-data)))) 437 (w32-get-clipboard-data))))
357 438
358(defun org-add-props (string plist &rest props) 439(defun org-add-props (string plist &rest props)
359 "Add text properties to entire string, from beginning to end. 440 "Add text properties to entire string, from beginning to end.
@@ -365,20 +446,20 @@ that will be added to PLIST. Returns the string that was modified."
365(put 'org-add-props 'lisp-indent-function 2) 446(put 'org-add-props 'lisp-indent-function 2)
366 447
367(defun org-fit-window-to-buffer (&optional window max-height min-height 448(defun org-fit-window-to-buffer (&optional window max-height min-height
368 shrink-only) 449 shrink-only)
369 "Fit WINDOW to the buffer, but only if it is not a side-by-side window. 450 "Fit WINDOW to the buffer, but only if it is not a side-by-side window.
370WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are 451WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are
371passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call 452passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call
372`shrink-window-if-larger-than-buffer' instead, the height limit is 453`shrink-window-if-larger-than-buffer' instead, the height limit is
373ignored in this case." 454ignored in this case."
374 (cond ((if (fboundp 'window-full-width-p) 455 (cond ((if (fboundp 'window-full-width-p)
375 (not (window-full-width-p window)) 456 (not (window-full-width-p window))
376 ;; do nothing if another window would suffer 457 ;; do nothing if another window would suffer
377 (> (frame-width) (window-width window)))) 458 (> (frame-width) (window-width window))))
378 ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) 459 ((and (fboundp 'fit-window-to-buffer) (not shrink-only))
379 (fit-window-to-buffer window max-height min-height)) 460 (fit-window-to-buffer window max-height min-height))
380 ((fboundp 'shrink-window-if-larger-than-buffer) 461 ((fboundp 'shrink-window-if-larger-than-buffer)
381 (shrink-window-if-larger-than-buffer window))) 462 (shrink-window-if-larger-than-buffer window)))
382 (or window (selected-window))) 463 (or window (selected-window)))
383 464
384;; `set-transient-map' is only in Emacs >= 24.4 465;; `set-transient-map' is only in Emacs >= 24.4
@@ -400,7 +481,7 @@ Unlike to `use-region-p', this function also checks
400 481
401(defun org-cursor-to-region-beginning () 482(defun org-cursor-to-region-beginning ()
402 (when (and (org-region-active-p) 483 (when (and (org-region-active-p)
403 (> (point) (region-beginning))) 484 (> (point) (region-beginning)))
404 (exchange-point-and-mark))) 485 (exchange-point-and-mark)))
405 486
406;;; Invisibility compatibility 487;;; Invisibility compatibility
@@ -410,8 +491,8 @@ Unlike to `use-region-p', this function also checks
410 (if (fboundp 'remove-from-invisibility-spec) 491 (if (fboundp 'remove-from-invisibility-spec)
411 (remove-from-invisibility-spec arg) 492 (remove-from-invisibility-spec arg)
412 (if (consp buffer-invisibility-spec) 493 (if (consp buffer-invisibility-spec)
413 (setq buffer-invisibility-spec 494 (setq buffer-invisibility-spec
414 (delete arg buffer-invisibility-spec))))) 495 (delete arg buffer-invisibility-spec)))))
415 496
416(defun org-in-invisibility-spec-p (arg) 497(defun org-in-invisibility-spec-p (arg)
417 "Is ARG a member of `buffer-invisibility-spec'?" 498 "Is ARG a member of `buffer-invisibility-spec'?"
@@ -422,9 +503,9 @@ Unlike to `use-region-p', this function also checks
422 "Move to column COLUMN. 503 "Move to column COLUMN.
423Pass COLUMN and FORCE to `move-to-column'." 504Pass COLUMN and FORCE to `move-to-column'."
424 (let ((buffer-invisibility-spec 505 (let ((buffer-invisibility-spec
425 (if (listp buffer-invisibility-spec) 506 (if (listp buffer-invisibility-spec)
426 (remove '(org-filtered) buffer-invisibility-spec) 507 (remove '(org-filtered) buffer-invisibility-spec)
427 buffer-invisibility-spec))) 508 buffer-invisibility-spec)))
428 (move-to-column column force))) 509 (move-to-column column force)))
429 510
430(defmacro org-find-library-dir (library) 511(defmacro org-find-library-dir (library)
@@ -436,12 +517,12 @@ Pass COLUMN and FORCE to `move-to-column'."
436 (while (string-match "\n" s start) 517 (while (string-match "\n" s start)
437 (setq start (match-end 0) n (1+ n))) 518 (setq start (match-end 0) n (1+ n)))
438 (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n)) 519 (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
439 (setq n (1- n))) 520 (setq n (1- n)))
440 n)) 521 n))
441 522
442(defun org-kill-new (string &rest args) 523(defun org-kill-new (string &rest args)
443 (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t) 524 (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t)
444 string) 525 string)
445 (apply 'kill-new string args)) 526 (apply 'kill-new string args))
446 527
447;; `font-lock-ensure' is only available from 24.4.50 on 528;; `font-lock-ensure' is only available from 24.4.50 on
@@ -465,7 +546,7 @@ Let-bind some variables to nil around BODY to achieve the desired
465effect, which variables to use depends on the Emacs version." 546effect, which variables to use depends on the Emacs version."
466 (if (org-version-check "24.2.50" "" :predicate) 547 (if (org-version-check "24.2.50" "" :predicate)
467 `(let (pop-up-frames display-buffer-alist) 548 `(let (pop-up-frames display-buffer-alist)
468 ,@body) 549 ,@body)
469 `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) 550 `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
470 ,@body))) 551 ,@body)))
471 552
@@ -473,19 +554,19 @@ effect, which variables to use depends on the Emacs version."
473(defmacro org-check-version () 554(defmacro org-check-version ()
474 "Try very hard to provide sensible version strings." 555 "Try very hard to provide sensible version strings."
475 (let* ((org-dir (org-find-library-dir "org")) 556 (let* ((org-dir (org-find-library-dir "org"))
476 (org-version.el (concat org-dir "org-version.el")) 557 (org-version.el (concat org-dir "org-version.el"))
477 (org-fixup.el (concat org-dir "../mk/org-fixup.el"))) 558 (org-fixup.el (concat org-dir "../mk/org-fixup.el")))
478 (if (require 'org-version org-version.el 'noerror) 559 (if (require 'org-version org-version.el 'noerror)
479 '(progn 560 '(progn
480 (autoload 'org-release "org-version.el") 561 (autoload 'org-release "org-version.el")
481 (autoload 'org-git-version "org-version.el")) 562 (autoload 'org-git-version "org-version.el"))
482 (if (require 'org-fixup org-fixup.el 'noerror) 563 (if (require 'org-fixup org-fixup.el 'noerror)
483 '(org-fixup) 564 '(org-fixup)
484 ;; provide fallback definitions and complain 565 ;; provide fallback definitions and complain
485 (warn "Could not define org version correctly. Check installation!") 566 (warn "Could not define org version correctly. Check installation!")
486 '(progn 567 '(progn
487 (defun org-release () "N/A") 568 (defun org-release () "N/A")
488 (defun org-git-version () "N/A !!check installation!!")))))) 569 (defun org-git-version () "N/A !!check installation!!"))))))
489 570
490(defmacro org-with-silent-modifications (&rest body) 571(defmacro org-with-silent-modifications (&rest body)
491 (if (fboundp 'with-silent-modifications) 572 (if (fboundp 'with-silent-modifications)
@@ -501,7 +582,7 @@ an error is signaled without being caught by a `condition-case'.
501Implements `define-error' for older emacsen." 582Implements `define-error' for older emacsen."
502 (if (fboundp 'define-error) (define-error name message) 583 (if (fboundp 'define-error) (define-error name message)
503 (put name 'error-conditions 584 (put name 'error-conditions
504 (copy-sequence (cons name (get 'error 'error-conditions)))))) 585 (copy-sequence (cons name (get 'error 'error-conditions))))))
505 586
506(unless (fboundp 'string-suffix-p) 587(unless (fboundp 'string-suffix-p)
507 ;; From Emacs subr.el. 588 ;; From Emacs subr.el.
@@ -511,8 +592,8 @@ If IGNORE-CASE is non-nil, the comparison is done without paying
511attention to case differences." 592attention to case differences."
512 (let ((start-pos (- (length string) (length suffix)))) 593 (let ((start-pos (- (length string) (length suffix))))
513 (and (>= start-pos 0) 594 (and (>= start-pos 0)
514 (eq t (compare-strings suffix nil nil 595 (eq t (compare-strings suffix nil nil
515 string start-pos nil ignore-case)))))) 596 string start-pos nil ignore-case))))))
516 597
517(provide 'org-compat) 598(provide 'org-compat)
518 599
diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el
index b7852baf10a..308f42ff6cf 100644
--- a/lisp/org/org-datetree.el
+++ b/lisp/org/org-datetree.el
@@ -54,16 +54,25 @@ Added time stamp is active unless value is `inactive'."
54 "Find or create an entry for date D. 54 "Find or create an entry for date D.
55If KEEP-RESTRICTION is non-nil, do not widen the buffer. 55If KEEP-RESTRICTION is non-nil, do not widen the buffer.
56When it is nil, the buffer will be widened to make sure an existing date 56When it is nil, the buffer will be widened to make sure an existing date
57tree can be found." 57tree can be found. If it is the sympol `subtree-at-point', then the tree
58will be built under the headline at point."
58 (setq-local org-datetree-base-level 1) 59 (setq-local org-datetree-base-level 1)
59 (or keep-restriction (widen))
60 (save-restriction 60 (save-restriction
61 (let ((prop (org-find-property "DATE_TREE"))) 61 (if (eq keep-restriction 'subtree-at-point)
62 (when prop 62 (progn
63 (goto-char prop) 63 (unless (org-at-heading-p) (error "Not at heading"))
64 (setq-local org-datetree-base-level 64 (widen)
65 (org-get-valid-level (org-current-level) 1)) 65 (org-narrow-to-subtree)
66 (org-narrow-to-subtree))) 66 (setq-local org-datetree-base-level
67 (org-get-valid-level (org-current-level) 1)))
68 (unless keep-restriction (widen))
69 ;; Support the old way of tree placement, using a property
70 (let ((prop (org-find-property "DATE_TREE")))
71 (when prop
72 (goto-char prop)
73 (setq-local org-datetree-base-level
74 (org-get-valid-level (org-current-level) 1))
75 (org-narrow-to-subtree))))
67 (goto-char (point-min)) 76 (goto-char (point-min))
68 (let ((year (calendar-extract-year d)) 77 (let ((year (calendar-extract-year d))
69 (month (calendar-extract-month d)) 78 (month (calendar-extract-month d))
@@ -84,18 +93,26 @@ tree can be found."
84 "Find or create an ISO week entry for date D. 93 "Find or create an ISO week entry for date D.
85Compared to `org-datetree-find-date-create' this function creates 94Compared to `org-datetree-find-date-create' this function creates
86entries ordered by week instead of months. 95entries ordered by week instead of months.
87If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it 96When it is nil, the buffer will be widened to make sure an existing date
88is nil, the buffer will be widened to make sure an existing date 97tree can be found. If it is the sympol `subtree-at-point', then the tree
89tree can be found." 98will be built under the headline at point."
90 (setq-local org-datetree-base-level 1) 99 (setq-local org-datetree-base-level 1)
91 (or keep-restriction (widen))
92 (save-restriction 100 (save-restriction
93 (let ((prop (org-find-property "WEEK_TREE"))) 101 (if (eq keep-restriction 'subtree-at-point)
94 (when prop 102 (progn
95 (goto-char prop) 103 (unless (org-at-heading-p) (error "Not at heading"))
96 (setq-local org-datetree-base-level 104 (widen)
97 (org-get-valid-level (org-current-level) 1)) 105 (org-narrow-to-subtree)
98 (org-narrow-to-subtree))) 106 (setq-local org-datetree-base-level
107 (org-get-valid-level (org-current-level) 1)))
108 (unless keep-restriction (widen))
109 ;; Support the old way of tree placement, using a property
110 (let ((prop (org-find-property "WEEK_TREE")))
111 (when prop
112 (goto-char prop)
113 (setq-local org-datetree-base-level
114 (org-get-valid-level (org-current-level) 1))
115 (org-narrow-to-subtree))))
99 (goto-char (point-min)) 116 (goto-char (point-min))
100 (require 'cal-iso) 117 (require 'cal-iso)
101 (let* ((year (calendar-extract-year d)) 118 (let* ((year (calendar-extract-year d))
diff --git a/lisp/org/org-duration.el b/lisp/org/org-duration.el
new file mode 100644
index 00000000000..3e5f0f56a5b
--- /dev/null
+++ b/lisp/org/org-duration.el
@@ -0,0 +1,446 @@
1;;; org-duration.el --- Library handling durations -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
6;; Keywords: outlines, hypermedia, calendar, wp
7
8;; This program is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; This program is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program. If not, see <https://www.gnu.org/licenses/>.
20
21;;; Commentary:
22
23;; This library provides tools to manipulate durations. A duration
24;; can have multiple formats:
25;;
26;; - 3:12
27;; - 1:23:45
28;; - 1y 3d 3h 4min
29;; - 3d 13:35
30;; - 2.35h
31;;
32;; More accurately, it consists of numbers and units, as defined in
33;; variable `org-duration-units', separated with white spaces, and
34;; a "H:MM" or "H:MM:SS" part. White spaces are tolerated between the
35;; number and its relative unit. Variable `org-duration-format'
36;; controls durations default representation.
37;;
38;; The library provides functions allowing to convert a duration to,
39;; and from, a number of minutes: `org-duration-to-minutes' and
40;; `org-duration-from-minutes'. It also provides two lesser tools:
41;; `org-duration-p', and `org-duration-h:mm-only-p'.
42;;
43;; Users can set the number of minutes per unit, or define new units,
44;; in `org-duration-units'. The library also supports canonical
45;; duration, i.e., a duration that doesn't depend on user's settings,
46;; through optional arguments.
47
48;;; Code:
49
50(require 'cl-lib)
51(require 'org-macs)
52(declare-function org-trim "org-trim" (s &optional keep-lead))
53
54
55;;; Public variables
56
57(defconst org-duration-canonical-units
58 `(("min" . 1)
59 ("h" . 60)
60 ("d" . ,(* 60 24)))
61 "Canonical time duration units.
62See `org-duration-units' for details.")
63
64(defcustom org-duration-units
65 `(("min" . 1)
66 ("h" . 60)
67 ("d" . ,(* 60 24))
68 ("w" . ,(* 60 24 7))
69 ("m" . ,(* 60 24 30))
70 ("y" . ,(* 60 24 365.25)))
71 "Conversion factor to minutes for a duration.
72
73Each entry has the form (UNIT . MODIFIER).
74
75In a duration string, a number followed by UNIT is multiplied by
76the specified number of MODIFIER to obtain a duration in minutes.
77
78For example, the following value
79
80 \\=`((\"min\" . 1)
81 (\"h\" . 60)
82 (\"d\" . ,(* 60 8))
83 (\"w\" . ,(* 60 8 5))
84 (\"m\" . ,(* 60 8 5 4))
85 (\"y\" . ,(* 60 8 5 4 10)))
86
87is meaningful if you work an average of 8 hours per day, 5 days
88a week, 4 weeks a month and 10 months a year.
89
90When setting this variable outside the Customize interface, make
91sure to call the following command:
92
93 \\[org-duration-set-regexps]"
94 :group 'org-agenda
95 :version "26.1"
96 :package-version '(Org . "9.1")
97 :set (lambda (var val) (set-default var val) (org-duration-set-regexps))
98 :initialize 'custom-initialize-changed
99 :type '(choice
100 (const :tag "H:MM" 'h:mm)
101 (const :tag "H:MM:SS" 'h:mm:ss)
102 (alist :key-type (string :tag "Unit")
103 :value-type (number :tag "Modifier"))))
104
105(defcustom org-duration-format '(("d" . nil) (special . h:mm))
106 "Format definition for a duration.
107
108The value can be set to, respectively, the symbols `h:mm:ss' or
109`h:mm', which means a duration is expressed as, respectively,
110a \"H:MM:SS\" or \"H:MM\" string.
111
112Alternatively, the value can be a list of entries following the
113pattern:
114
115 (UNIT . REQUIRED?)
116
117UNIT is a unit string, as defined in `org-duration-units'. The
118time duration is formatted using only the time components that
119are specified here.
120
121Units with a zero value are skipped, unless REQUIRED? is non-nil.
122In that case, the unit is always used.
123
124Eventually, the list can contain one of the following special
125entries:
126
127 (special . h:mm)
128 (special . h:mm:ss)
129
130 Units shorter than an hour are ignored. The hours and
131 minutes part of the duration is expressed unconditionally
132 with H:MM, or H:MM:SS, pattern.
133
134 (special . PRECISION)
135
136 A duration is expressed with a single unit, PRECISION being
137 the number of decimal places to show. The unit chosen is the
138 first one required or with a non-zero integer part. If there
139 is no such unit, the smallest one is used.
140
141For example,
142
143 ((\"d\" . nil) (\"h\" . t) (\"min\" . t))
144
145means a duration longer than a day is expressed in days, hours
146and minutes, whereas a duration shorter than a day is always
147expressed in hours and minutes, even when shorter than an hour.
148
149On the other hand, the value
150
151 ((\"d\" . nil) (\"min\" . nil))
152
153means a duration longer than a day is expressed in days and
154minutes, whereas a duration shorter than a day is expressed
155entirely in minutes, even when longer than an hour.
156
157The following format
158
159 ((\"d\" . nil) (special . h:mm))
160
161means that any duration longer than a day is expressed with both
162a \"d\" unit and a \"H:MM\" part, whereas a duration shorter than
163a day is expressed only as a \"H:MM\" string.
164
165Eventually,
166
167 ((\"d\" . nil) (\"h\" . nil) (special . 2))
168
169expresses a duration longer than a day as a decimal number, with
170a 2-digits fractional part, of \"d\" unit. A duration shorter
171than a day uses \"h\" unit instead."
172 :group 'org-time
173 :group 'org-clock
174 :version "26.1"
175 :package-version '(Org . "9.1")
176 :type '(choice
177 (const :tag "Use H:MM" h:mm)
178 (const :tag "Use H:MM:SS" h:mm:ss)
179 (repeat :tag "Use units"
180 (choice
181 (cons :tag "Use units"
182 (string :tag "Unit")
183 (choice (const :tag "Skip when zero" nil)
184 (const :tag "Always used" t)))
185 (cons :tag "Use a single decimal unit"
186 (const special)
187 (integer :tag "Number of decimals"))
188 (cons :tag "Use both units and H:MM"
189 (const special)
190 (const h:mm))
191 (cons :tag "Use both units and H:MM:SS"
192 (const special)
193 (const h:mm:ss))))))
194
195
196;;; Internal variables and functions
197
198(defconst org-duration--h:mm-re
199 "\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{1,2\\}[ \t]*\\'"
200 "Regexp matching a duration expressed with H:MM or H:MM:SS format.
201See `org-duration--h:mm:ss-re' to only match the latter. Hours
202can use any number of digits.")
203
204(defconst org-duration--h:mm:ss-re
205 "\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{2\\}[ \t]*\\'"
206 "Regexp matching a duration expressed H:MM:SS format.
207See `org-duration--h:mm-re' to also support H:MM format. Hours
208can use any number of digits.")
209
210(defvar org-duration--unit-re nil
211 "Regexp matching a duration with an unit.
212Allowed units are defined in `org-duration-units'. Match group
2131 contains the bare number. Match group 2 contains the unit.")
214
215(defvar org-duration--full-re nil
216 "Regexp matching a duration expressed with units.
217Allowed units are defined in `org-duration-units'.")
218
219(defvar org-duration--mixed-re nil
220 "Regexp matching a duration expressed with units and H:MM or H:MM:SS format.
221Allowed units are defined in `org-duration-units'. Match group
2221 contains units part. Match group 2 contains H:MM or H:MM:SS
223part.")
224
225(defun org-duration--modifier (unit &optional canonical)
226 "Return modifier associated to string UNIT.
227When optional argument CANONICAL is non-nil, refer to
228`org-duration-canonical-units' instead of `org-duration-units'."
229 (or (cdr (assoc unit (if canonical
230 org-duration-canonical-units
231 org-duration-units)))
232 (error "Unknown unit: %S" unit)))
233
234
235;;; Public functions
236
237;;;###autoload
238(defun org-duration-set-regexps ()
239 "Set duration related regexps."
240 (interactive)
241 (setq org-duration--unit-re
242 (concat "\\([0-9]+\\(?:\\.[0-9]*\\)?\\)[ \t]*"
243 ;; Since user-defined units in `org-duration-units'
244 ;; can differ from canonical units in
245 ;; `org-duration-canonical-units', include both in
246 ;; regexp.
247 (regexp-opt (mapcar #'car (append org-duration-canonical-units
248 org-duration-units))
249 t)))
250 (setq org-duration--full-re
251 (format "\\`[ \t]*%s\\(?:[ \t]+%s\\)*[ \t]*\\'"
252 org-duration--unit-re
253 org-duration--unit-re))
254 (setq org-duration--mixed-re
255 (format "\\`[ \t]*\\(?1:%s\\(?:[ \t]+%s\\)*\\)[ \t]+\
256\\(?2:[0-9]+\\(?::[0-9][0-9]\\)\\{1,2\\}\\)[ \t]*\\'"
257 org-duration--unit-re
258 org-duration--unit-re)))
259
260;;;###autoload
261(defun org-duration-p (s)
262 "Non-nil when string S is a time duration."
263 (and (stringp s)
264 (or (string-match-p org-duration--full-re s)
265 (string-match-p org-duration--mixed-re s)
266 (string-match-p org-duration--h:mm-re s))))
267
268;;;###autoload
269(defun org-duration-to-minutes (duration &optional canonical)
270 "Return number of minutes of DURATION string.
271
272When optional argument CANONICAL is non-nil, ignore
273`org-duration-units' and use standard time units value.
274
275A bare number is translated into minutes. The empty string is
276translated into 0.0.
277
278Return value as a float. Raise an error if duration format is
279not recognized."
280 (cond
281 ((equal duration "") 0.0)
282 ((numberp duration) (float duration))
283 ((string-match-p org-duration--h:mm-re duration)
284 (pcase-let ((`(,hours ,minutes ,seconds)
285 (mapcar #'string-to-number (split-string duration ":"))))
286 (+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
287 ((string-match-p org-duration--full-re duration)
288 (let ((minutes 0)
289 (s 0))
290 (while (string-match org-duration--unit-re duration s)
291 (setq s (match-end 0))
292 (let ((value (string-to-number (match-string 1 duration)))
293 (unit (match-string 2 duration)))
294 (cl-incf minutes (* value (org-duration--modifier unit canonical)))))
295 (float minutes)))
296 ((string-match org-duration--mixed-re duration)
297 (let ((units-part (match-string 1 duration))
298 (hms-part (match-string 2 duration)))
299 (+ (org-duration-to-minutes units-part)
300 (org-duration-to-minutes hms-part))))
301 ((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
302 (float (string-to-number duration)))
303 (t (error "Invalid duration format: %S" duration))))
304
305;;;###autoload
306(defun org-duration-from-minutes (minutes &optional fmt canonical)
307 "Return duration string for a given number of MINUTES.
308
309Format duration according to `org-duration-format' or FMT, when
310non-nil.
311
312When optional argument CANONICAL is non-nil, ignore
313`org-duration-units' and use standard time units value.
314
315Raise an error if expected format is unknown."
316 (pcase (or fmt org-duration-format)
317 (`h:mm
318 (let ((minutes (floor minutes)))
319 (format "%d:%02d" (/ minutes 60) (mod minutes 60))))
320 (`h:mm:ss
321 (let* ((whole-minutes (floor minutes))
322 (seconds (floor (* 60 (- minutes whole-minutes)))))
323 (format "%s:%02d"
324 (org-duration-from-minutes whole-minutes 'h:mm)
325 seconds)))
326 ((pred atom) (error "Invalid duration format specification: %S" fmt))
327 ;; Mixed format. Call recursively the function on both parts.
328 ((and duration-format
329 (let `(special . ,(and mode (or `h:mm:ss `h:mm)))
330 (assq 'special duration-format)))
331 (let* ((truncated-format
332 ;; Remove "special" mode from duration format in order to
333 ;; recurse properly. Also remove units smaller or equal
334 ;; to an hour since H:MM part takes care of it.
335 (cl-remove-if-not
336 (lambda (pair)
337 (pcase pair
338 (`(,(and unit (pred stringp)) . ,_)
339 (> (org-duration--modifier unit canonical) 60))
340 (_ nil)))
341 duration-format))
342 (min-modifier ;smallest modifier above hour
343 (and truncated-format
344 (apply #'min
345 (mapcar (lambda (p)
346 (org-duration--modifier (car p) canonical))
347 truncated-format)))))
348 (if (or (null min-modifier) (< minutes min-modifier))
349 ;; There is not unit above the hour or the smallest unit
350 ;; above the hour is too large for the number of minutes we
351 ;; need to represent. Use H:MM or H:MM:SS syntax.
352 (org-duration-from-minutes minutes mode canonical)
353 ;; Represent minutes above hour using provided units and H:MM
354 ;; or H:MM:SS below.
355 (let* ((units-part (* min-modifier (/ (floor minutes) min-modifier)))
356 (minutes-part (- minutes units-part)))
357 (concat
358 (org-duration-from-minutes units-part truncated-format canonical)
359 " "
360 (org-duration-from-minutes minutes-part mode))))))
361 ;; Units format.
362 (duration-format
363 (let* ((fractional
364 (let ((digits (cdr (assq 'special duration-format))))
365 (and digits
366 (or (wholenump digits)
367 (error "Unknown formatting directive: %S" digits))
368 (format "%%.%df" digits))))
369 (selected-units
370 (sort (cl-remove-if
371 ;; Ignore special format cells.
372 (lambda (pair) (pcase pair (`(special . ,_) t) (_ nil)))
373 duration-format)
374 (lambda (a b)
375 (> (org-duration--modifier (car a) canonical)
376 (org-duration--modifier (car b) canonical))))))
377 (cond
378 ;; Fractional duration: use first unit that is either required
379 ;; or smaller than MINUTES.
380 (fractional
381 (let* ((unit (car
382 (or (cl-find-if
383 (lambda (pair)
384 (pcase pair
385 (`(,u . ,req?)
386 (or req?
387 (<= (org-duration--modifier u canonical)
388 minutes)))))
389 selected-units)
390 ;; Fall back to smallest unit.
391 (org-last selected-units))))
392 (modifier (org-duration--modifier unit canonical)))
393 (concat (format fractional (/ (float minutes) modifier)) unit)))
394 ;; Otherwise build duration string according to available
395 ;; units.
396 ((org-string-nw-p
397 (org-trim
398 (mapconcat
399 (lambda (units)
400 (pcase-let* ((`(,unit . ,required?) units)
401 (modifier (org-duration--modifier unit canonical)))
402 (cond ((<= modifier minutes)
403 (let ((value (if (integerp modifier)
404 (/ (floor minutes) modifier)
405 (floor (/ minutes modifier)))))
406 (cl-decf minutes (* value modifier))
407 (format " %d%s" value unit)))
408 (required? (concat " 0" unit))
409 (t ""))))
410 selected-units
411 ""))))
412 ;; No unit can properly represent MINUTES. Use the smallest
413 ;; one anyway.
414 (t
415 (pcase-let ((`((,unit . ,_)) (last selected-units)))
416 (concat "0" unit))))))))
417
418;;;###autoload
419(defun org-duration-h:mm-only-p (times)
420 "Non-nil when every duration in TIMES has \"H:MM\" or \"H:MM:SS\" format.
421
422TIMES is a list of duration strings.
423
424Return nil if any duration is expressed with units, as defined in
425`org-duration-units'. Otherwise, if any duration is expressed
426with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
427`h:mm'."
428 (let (hms-flag)
429 (catch :exit
430 (dolist (time times)
431 (cond ((string-match-p org-duration--full-re time)
432 (throw :exit nil))
433 ((string-match-p org-duration--mixed-re time)
434 (throw :exit nil))
435 (hms-flag nil)
436 ((string-match-p org-duration--h:mm:ss-re time)
437 (setq hms-flag 'h:mm:ss))))
438 (or hms-flag 'h:mm))))
439
440
441;;; Initialization
442
443(org-duration-set-regexps)
444
445(provide 'org-duration)
446;;; org-duration.el ends here
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index f370eb06073..f2b3002f1fd 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -294,12 +294,11 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
294 (italic ,@standard-set) 294 (italic ,@standard-set)
295 (item ,@standard-set-no-line-break) 295 (item ,@standard-set-no-line-break)
296 (keyword ,@(remq 'footnote-reference standard-set)) 296 (keyword ,@(remq 'footnote-reference standard-set))
297 ;; Ignore all links excepted plain links and angular links in 297 ;; Ignore all links in a link description. Also ignore
298 ;; a link description. Also ignore radio-targets and line 298 ;; radio-targets and line breaks.
299 ;; breaks.
300 (link bold code entity export-snippet inline-babel-call inline-src-block 299 (link bold code entity export-snippet inline-babel-call inline-src-block
301 italic latex-fragment macro simple-link statistics-cookie 300 italic latex-fragment macro statistics-cookie strike-through
302 strike-through subscript superscript underline verbatim) 301 subscript superscript underline verbatim)
303 (paragraph ,@standard-set) 302 (paragraph ,@standard-set)
304 ;; Remove any variable object from radio target as it would 303 ;; Remove any variable object from radio target as it would
305 ;; prevent it from being properly recognized. 304 ;; prevent it from being properly recognized.
@@ -458,7 +457,7 @@ Return value is the property name, as a keyword, or nil."
458 (and (memq object (org-element-property p parent)) 457 (and (memq object (org-element-property p parent))
459 (throw 'exit p)))))) 458 (throw 'exit p))))))
460 459
461(defun org-element-class (datum &optional parent) 460(defsubst org-element-class (datum &optional parent)
462 "Return class for ELEMENT, as a symbol. 461 "Return class for ELEMENT, as a symbol.
463Class is either `element' or `object'. Optional argument PARENT 462Class is either `element' or `object'. Optional argument PARENT
464is the element or object containing DATUM. It defaults to the 463is the element or object containing DATUM. It defaults to the
@@ -2703,7 +2702,7 @@ keywords. Otherwise, return nil.
2703Assume point is at the first tilde marker." 2702Assume point is at the first tilde marker."
2704 (save-excursion 2703 (save-excursion
2705 (unless (bolp) (backward-char 1)) 2704 (unless (bolp) (backward-char 1))
2706 (when (looking-at org-emph-re) 2705 (when (looking-at org-verbatim-re)
2707 (let ((begin (match-beginning 2)) 2706 (let ((begin (match-beginning 2))
2708 (value (match-string-no-properties 4)) 2707 (value (match-string-no-properties 4))
2709 (post-blank (progn (goto-char (match-end 2)) 2708 (post-blank (progn (goto-char (match-end 2))
@@ -3720,7 +3719,7 @@ and cdr is a plist with `:value', `:begin', `:end' and
3720Assume point is at the first equal sign marker." 3719Assume point is at the first equal sign marker."
3721 (save-excursion 3720 (save-excursion
3722 (unless (bolp) (backward-char 1)) 3721 (unless (bolp) (backward-char 1))
3723 (when (looking-at org-emph-re) 3722 (when (looking-at org-verbatim-re)
3724 (let ((begin (match-beginning 2)) 3723 (let ((begin (match-beginning 2))
3725 (value (match-string-no-properties 4)) 3724 (value (match-string-no-properties 4))
3726 (post-blank (progn (goto-char (match-end 2)) 3725 (post-blank (progn (goto-char (match-end 2))
@@ -4389,8 +4388,7 @@ to an appropriate container (e.g., a paragraph)."
4389 (org-element-target-parser))) 4388 (org-element-target-parser)))
4390 (or (and (memq 'timestamp restriction) 4389 (or (and (memq 'timestamp restriction)
4391 (org-element-timestamp-parser)) 4390 (org-element-timestamp-parser))
4392 (and (or (memq 'link restriction) 4391 (and (memq 'link restriction)
4393 (memq 'simple-link restriction))
4394 (org-element-link-parser))))) 4392 (org-element-link-parser)))))
4395 (?\\ 4393 (?\\
4396 (if (eq (aref result 1) ?\\) 4394 (if (eq (aref result 1) ?\\)
@@ -4411,8 +4409,7 @@ to an appropriate container (e.g., a paragraph)."
4411 (and (memq 'statistics-cookie restriction) 4409 (and (memq 'statistics-cookie restriction)
4412 (org-element-statistics-cookie-parser))))) 4410 (org-element-statistics-cookie-parser)))))
4413 ;; This is probably a plain link. 4411 ;; This is probably a plain link.
4414 (_ (and (or (memq 'link restriction) 4412 (_ (and (memq 'link restriction)
4415 (memq 'simple-link restriction))
4416 (org-element-link-parser))))))) 4413 (org-element-link-parser)))))))
4417 (or (eobp) (forward-char)))) 4414 (or (eobp) (forward-char))))
4418 (cond (found) 4415 (cond (found)
@@ -4759,9 +4756,6 @@ indentation removed from its contents."
4759;; associated to a key, obtained with `org-element--cache-key'. This 4756;; associated to a key, obtained with `org-element--cache-key'. This
4760;; mechanism is robust enough to preserve total order among elements 4757;; mechanism is robust enough to preserve total order among elements
4761;; even when the tree is only partially synchronized. 4758;; even when the tree is only partially synchronized.
4762;;
4763;; Objects contained in an element are stored in a hash table,
4764;; `org-element--cache-objects'.
4765 4759
4766 4760
4767(defvar org-element-use-cache nil 4761(defvar org-element-use-cache nil
@@ -4793,34 +4787,6 @@ Each node of the tree contains an element. Comparison is done
4793with `org-element--cache-compare'. This cache is used in 4787with `org-element--cache-compare'. This cache is used in
4794`org-element-at-point'.") 4788`org-element-at-point'.")
4795 4789
4796(defvar org-element--cache-objects nil
4797 "Hash table used as to cache objects.
4798Key is an element, as returned by `org-element-at-point', and
4799value is an alist where each association is:
4800
4801 (PARENT COMPLETEP . OBJECTS)
4802
4803where PARENT is an element or object, COMPLETEP is a boolean,
4804non-nil when all direct children of parent are already cached and
4805OBJECTS is a list of such children, as objects, from farthest to
4806closest.
4807
4808In the following example, \\alpha, bold object and \\beta are
4809contained within a paragraph
4810
4811 \\alpha *\\beta*
4812
4813If the paragraph is completely parsed, OBJECTS-DATA will be
4814
4815 ((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT)
4816 (BOLD-OBJECT t ENTITY-OBJECT))
4817
4818whereas in a partially parsed paragraph, it could be
4819
4820 ((PARAGRAPH nil ENTITY-OBJECT))
4821
4822This cache is used in `org-element-context'.")
4823
4824(defvar org-element--cache-sync-requests nil 4790(defvar org-element--cache-sync-requests nil
4825 "List of pending synchronization requests. 4791 "List of pending synchronization requests.
4826 4792
@@ -5057,36 +5023,28 @@ the cache."
5057 (`nil lower) 5023 (`nil lower)
5058 (_ upper)))) 5024 (_ upper))))
5059 5025
5060(defun org-element--cache-put (element &optional data) 5026(defun org-element--cache-put (element)
5061 "Store ELEMENT in current buffer's cache, if allowed. 5027 "Store ELEMENT in current buffer's cache, if allowed."
5062When optional argument DATA is non-nil, assume is it object data 5028 (when (org-element--cache-active-p)
5063relative to ELEMENT and store it in the objects cache." 5029 (when org-element--cache-sync-requests
5064 (cond ((not (org-element--cache-active-p)) nil) 5030 ;; During synchronization, first build an appropriate key for
5065 ((not data) 5031 ;; the new element so `avl-tree-enter' can insert it at the
5066 (when org-element--cache-sync-requests 5032 ;; right spot in the cache.
5067 ;; During synchronization, first build an appropriate key 5033 (let ((keys (org-element--cache-find
5068 ;; for the new element so `avl-tree-enter' can insert it at 5034 (org-element-property :begin element) 'both)))
5069 ;; the right spot in the cache. 5035 (puthash element
5070 (let ((keys (org-element--cache-find 5036 (org-element--cache-generate-key
5071 (org-element-property :begin element) 'both))) 5037 (and (car keys) (org-element--cache-key (car keys)))
5072 (puthash element 5038 (cond ((cdr keys) (org-element--cache-key (cdr keys)))
5073 (org-element--cache-generate-key 5039 (org-element--cache-sync-requests
5074 (and (car keys) (org-element--cache-key (car keys))) 5040 (aref (car org-element--cache-sync-requests) 0))))
5075 (cond ((cdr keys) (org-element--cache-key (cdr keys))) 5041 org-element--cache-sync-keys)))
5076 (org-element--cache-sync-requests 5042 (avl-tree-enter org-element--cache element)))
5077 (aref (car org-element--cache-sync-requests) 0))))
5078 org-element--cache-sync-keys)))
5079 (avl-tree-enter org-element--cache element))
5080 ;; Headlines are not stored in cache, so objects in titles are
5081 ;; not stored either.
5082 ((eq (org-element-type element) 'headline) nil)
5083 (t (puthash element data org-element--cache-objects))))
5084 5043
5085(defsubst org-element--cache-remove (element) 5044(defsubst org-element--cache-remove (element)
5086 "Remove ELEMENT from cache. 5045 "Remove ELEMENT from cache.
5087Assume ELEMENT belongs to cache and that a cache is active." 5046Assume ELEMENT belongs to cache and that a cache is active."
5088 (avl-tree-delete org-element--cache element) 5047 (avl-tree-delete org-element--cache element))
5089 (remhash element org-element--cache-objects))
5090 5048
5091 5049
5092;;;; Synchronization 5050;;;; Synchronization
@@ -5342,11 +5300,7 @@ request."
5342 (throw 'interrupt nil)) 5300 (throw 'interrupt nil))
5343 ;; Shift element. 5301 ;; Shift element.
5344 (unless (zerop offset) 5302 (unless (zerop offset)
5345 (org-element--cache-shift-positions data offset) 5303 (org-element--cache-shift-positions data offset))
5346 ;; Shift associated objects data, if any.
5347 (dolist (object-data (gethash data org-element--cache-objects))
5348 (dolist (object (cddr object-data))
5349 (org-element--cache-shift-positions object offset))))
5350 (let ((begin (org-element-property :begin data))) 5304 (let ((begin (org-element-property :begin data)))
5351 ;; Update PARENT and re-parent DATA, only when 5305 ;; Update PARENT and re-parent DATA, only when
5352 ;; necessary. Propagate new structures for lists. 5306 ;; necessary. Propagate new structures for lists.
@@ -5712,7 +5666,6 @@ buffers."
5712 (when (and org-element-use-cache (derived-mode-p 'org-mode)) 5666 (when (and org-element-use-cache (derived-mode-p 'org-mode))
5713 (setq-local org-element--cache 5667 (setq-local org-element--cache
5714 (avl-tree-create #'org-element--cache-compare)) 5668 (avl-tree-create #'org-element--cache-compare))
5715 (setq-local org-element--cache-objects (make-hash-table :test #'eq))
5716 (setq-local org-element--cache-sync-keys 5669 (setq-local org-element--cache-sync-keys
5717 (make-hash-table :weakness 'key :test #'eq)) 5670 (make-hash-table :weakness 'key :test #'eq))
5718 (setq-local org-element--cache-change-warning nil) 5671 (setq-local org-element--cache-change-warning nil)
@@ -5869,114 +5822,54 @@ Providing it allows for quicker computation."
5869 (or (< pos cend) (and (= pos cend) (eobp)))) 5822 (or (< pos cend) (and (= pos cend) (eobp))))
5870 (narrow-to-region cbeg cend) 5823 (narrow-to-region cbeg cend)
5871 (throw 'objects-forbidden element)))) 5824 (throw 'objects-forbidden element))))
5872 ;; At a planning line, if point is at a timestamp, return it,
5873 ;; otherwise, return element.
5874 ((eq type 'planning)
5875 (dolist (p '(:closed :deadline :scheduled))
5876 (let ((timestamp (org-element-property p element)))
5877 (when (and timestamp
5878 (<= (org-element-property :begin timestamp) pos)
5879 (> (org-element-property :end timestamp) pos))
5880 (throw 'objects-forbidden timestamp))))
5881 ;; All other locations cannot contain objects: bail out.
5882 (throw 'objects-forbidden element))
5883 (t (throw 'objects-forbidden element))) 5825 (t (throw 'objects-forbidden element)))
5884 (goto-char (point-min)) 5826 (goto-char (point-min))
5885 (let ((restriction (org-element-restriction type)) 5827 (let ((restriction (org-element-restriction type))
5886 (parent element) 5828 (parent element)
5887 (cache (cond ((not (org-element--cache-active-p)) nil) 5829 last)
5888 (org-element--cache-objects 5830 (catch 'exit
5889 (gethash element org-element--cache-objects)) 5831 (while t
5890 (t (org-element-cache-reset) nil))) 5832 (let ((next (org-element--object-lex restriction)))
5891 next object-data last) 5833 (when next (org-element-put-property next :parent parent))
5892 (prog1 5834 ;; Process NEXT, if any, in order to know if we need to
5893 (catch 'exit 5835 ;; skip it, return it or move into it.
5894 (while t 5836 (if (or (not next) (> (org-element-property :begin next) pos))
5895 ;; When entering PARENT for the first time, get list 5837 (throw 'exit (or last parent))
5896 ;; of objects within known so far. Store it in 5838 (let ((end (org-element-property :end next))
5897 ;; OBJECT-DATA. 5839 (cbeg (org-element-property :contents-begin next))
5898 (unless next 5840 (cend (org-element-property :contents-end next)))
5899 (let ((data (assq parent cache))) 5841 (cond
5900 (if data (setq object-data data) 5842 ;; Skip objects ending before point. Also skip
5901 (push (setq object-data (list parent nil)) cache)))) 5843 ;; objects ending at point unless it is also the
5902 ;; Find NEXT object for analysis. 5844 ;; end of buffer, since we want to return the
5903 (catch 'found 5845 ;; innermost object.
5904 ;; If NEXT is non-nil, we already exhausted the 5846 ((and (<= end pos) (/= (point-max) end))
5905 ;; cache so we can parse buffer to find the object 5847 (goto-char end)
5906 ;; after it. 5848 ;; For convenience, when object ends at POS,
5907 (if next (setq next (org-element--object-lex restriction)) 5849 ;; without any space, store it in LAST, as we
5908 ;; Otherwise, check if cache can help us. 5850 ;; will return it if no object starts here.
5909 (let ((objects (cddr object-data)) 5851 (when (and (= end pos)
5910 (completep (nth 1 object-data))) 5852 (not (memq (char-before) '(?\s ?\t))))
5911 (cond 5853 (setq last next)))
5912 ((and (not objects) completep) (throw 'exit parent)) 5854 ;; If POS is within a container object, move into
5913 ((not objects) 5855 ;; that object.
5914 (setq next (org-element--object-lex restriction))) 5856 ((and cbeg cend
5915 (t 5857 (>= pos cbeg)
5916 (let ((cache-limit 5858 (or (< pos cend)
5917 (org-element-property :end (car objects)))) 5859 ;; At contents' end, if there is no
5918 (if (>= cache-limit pos) 5860 ;; space before point, also move into
5919 ;; Cache contains the information needed. 5861 ;; object, for consistency with
5920 (dolist (object objects (throw 'exit parent)) 5862 ;; convenience feature above.
5921 (when (<= (org-element-property :begin object) 5863 (and (= pos cend)
5922 pos) 5864 (or (= (point-max) pos)
5923 (if (>= (org-element-property :end object) 5865 (not (memq (char-before pos)
5924 pos) 5866 '(?\s ?\t)))))))
5925 (throw 'found (setq next object)) 5867 (goto-char cbeg)
5926 (throw 'exit parent)))) 5868 (narrow-to-region (point) cend)
5927 (goto-char cache-limit) 5869 (setq parent next)
5928 (setq next 5870 (setq restriction (org-element-restriction next)))
5929 (org-element--object-lex restriction)))))))) 5871 ;; Otherwise, return NEXT.
5930 ;; If we have a new object to analyze, store it in 5872 (t (throw 'exit next)))))))))))))
5931 ;; cache. Otherwise record that there is nothing
5932 ;; more to parse in this element at this depth.
5933 (if next
5934 (progn (org-element-put-property next :parent parent)
5935 (push next (cddr object-data)))
5936 (setcar (cdr object-data) t)))
5937 ;; Process NEXT, if any, in order to know if we need
5938 ;; to skip it, return it or move into it.
5939 (if (or (not next) (> (org-element-property :begin next) pos))
5940 (throw 'exit (or last parent))
5941 (let ((end (org-element-property :end next))
5942 (cbeg (org-element-property :contents-begin next))
5943 (cend (org-element-property :contents-end next)))
5944 (cond
5945 ;; Skip objects ending before point. Also skip
5946 ;; objects ending at point unless it is also the
5947 ;; end of buffer, since we want to return the
5948 ;; innermost object.
5949 ((and (<= end pos) (/= (point-max) end))
5950 (goto-char end)
5951 ;; For convenience, when object ends at POS,
5952 ;; without any space, store it in LAST, as we
5953 ;; will return it if no object starts here.
5954 (when (and (= end pos)
5955 (not (memq (char-before) '(?\s ?\t))))
5956 (setq last next)))
5957 ;; If POS is within a container object, move
5958 ;; into that object.
5959 ((and cbeg cend
5960 (>= pos cbeg)
5961 (or (< pos cend)
5962 ;; At contents' end, if there is no
5963 ;; space before point, also move into
5964 ;; object, for consistency with
5965 ;; convenience feature above.
5966 (and (= pos cend)
5967 (or (= (point-max) pos)
5968 (not (memq (char-before pos)
5969 '(?\s ?\t)))))))
5970 (goto-char cbeg)
5971 (narrow-to-region (point) cend)
5972 (setq parent next
5973 restriction (org-element-restriction next)
5974 next nil
5975 object-data nil))
5976 ;; Otherwise, return NEXT.
5977 (t (throw 'exit next)))))))
5978 ;; Store results in cache, if applicable.
5979 (org-element--cache-put element cache)))))))
5980 5873
5981(defun org-element-lineage (blob &optional types with-self) 5874(defun org-element-lineage (blob &optional types with-self)
5982 "List all ancestors of a given element or object. 5875 "List all ancestors of a given element or object.
diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el
index 573ffa07100..a138764fad1 100644
--- a/lisp/org/org-entities.el
+++ b/lisp/org/org-entities.el
@@ -295,6 +295,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
295 ("yen" "\\textyen{}" nil "&yen;" "yen" "¥" "¥") 295 ("yen" "\\textyen{}" nil "&yen;" "yen" "¥" "¥")
296 ("euro" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€") 296 ("euro" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
297 ("EUR" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€") 297 ("EUR" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
298 ("dollar" "\\$" nil "$" "$" "$" "$")
299 ("USD" "\\$" nil "$" "$" "$" "$")
298 300
299 "** Property Marks" 301 "** Property Marks"
300 ("copy" "\\textcopyright{}" nil "&copy;" "(c)" "©" "©") 302 ("copy" "\\textcopyright{}" nil "&copy;" "(c)" "©" "©")
diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el
index ba57971771f..687bc08b16e 100644
--- a/lisp/org/org-gnus.el
+++ b/lisp/org/org-gnus.el
@@ -33,18 +33,15 @@
33 33
34(require 'org) 34(require 'org)
35(require 'gnus-util) 35(require 'gnus-util)
36(eval-when-compile (require 'gnus-sum))
37 36
38;; Declare external functions and variables 37
38;;; Declare external functions and variables
39 39
40(declare-function message-fetch-field "message" (header &optional not-all)) 40(declare-function message-fetch-field "message" (header &optional not-all))
41(declare-function message-narrow-to-head-1 "message" nil)
42(declare-function gnus-summary-last-subject "gnus-sum" nil)
43(declare-function nnvirtual-map-article "nnvirtual" (article)) 41(declare-function nnvirtual-map-article "nnvirtual" (article))
44 42
45;; Customization variables 43
46 44;;; Customization variables
47(defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)
48 45
49(defcustom org-gnus-prefer-web-links nil 46(defcustom org-gnus-prefer-web-links nil
50 "If non-nil, `org-store-link' creates web links to Google groups or Gmane. 47 "If non-nil, `org-store-link' creates web links to Google groups or Gmane.
@@ -54,18 +51,6 @@ negates this setting for the duration of the command."
54 :group 'org-link-store 51 :group 'org-link-store
55 :type 'boolean) 52 :type 'boolean)
56 53
57(defcustom org-gnus-nnimap-query-article-no-from-file nil
58 "If non-nil, `org-gnus-follow-link' will try to translate
59Message-Ids to article numbers by querying the .overview file.
60Normally, this translation is done by querying the IMAP server,
61which is usually very fast. Unfortunately, some (maybe badly
62configured) IMAP servers don't support this operation quickly.
63So if following a link to a Gnus article takes ages, try setting
64this variable to t."
65 :group 'org-link-store
66 :version "24.1"
67 :type 'boolean)
68
69(defcustom org-gnus-no-server nil 54(defcustom org-gnus-no-server nil
70 "Should Gnus be started using `gnus-no-server'?" 55 "Should Gnus be started using `gnus-no-server'?"
71 :group 'org-gnus 56 :group 'org-gnus
@@ -73,30 +58,14 @@ this variable to t."
73 :package-version '(Org . "8.0") 58 :package-version '(Org . "8.0")
74 :type 'boolean) 59 :type 'boolean)
75 60
76;; Install the link type 61
77(org-link-set-parameters "gnus" :follow #'org-gnus-open :store #'org-gnus-store-link) 62;;; Install the link type
78 63
79;; Implementation 64(org-link-set-parameters "gnus"
80 65 :follow #'org-gnus-open
81(defun org-gnus-nnimap-cached-article-number (group server message-id) 66 :store #'org-gnus-store-link)
82 "Return cached article number (uid) of message in GROUP on SERVER. 67
83MESSAGE-ID is the message-id header field that identifies the 68;;; Implementation
84message. If the uid is not cached, return nil."
85 (with-temp-buffer
86 (let ((nov (and (fboundp 'nnimap-group-overview-filename)
87 ;; nnimap-group-overview-filename was removed from
88 ;; Gnus in September 2010, and therefore should
89 ;; only be present in Emacs 23.1.
90 (nnimap-group-overview-filename group server))))
91 (when (and nov (file-exists-p nov))
92 (mm-insert-file-contents nov)
93 (set-buffer-modified-p nil)
94 (goto-char (point-min))
95 (catch 'found
96 (while (search-forward message-id nil t)
97 (let ((hdr (split-string (thing-at-point 'line) "\t")))
98 (if (string= (nth 4 hdr) message-id)
99 (throw 'found (nth 0 hdr))))))))))
100 69
101(defun org-gnus-group-link (group) 70(defun org-gnus-group-link (group)
102 "Create a link to the Gnus group GROUP. 71 "Create a link to the Gnus group GROUP.
@@ -139,84 +108,75 @@ If `org-store-link' was called with a prefix arg the meaning of
139 108
140(defun org-gnus-store-link () 109(defun org-gnus-store-link ()
141 "Store a link to a Gnus folder or message." 110 "Store a link to a Gnus folder or message."
142 (cond 111 (pcase major-mode
143 ((eq major-mode 'gnus-group-mode) 112 (`gnus-group-mode
144 (let* ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus 113 (let ((group (gnus-group-group-name)))
145 (gnus-group-group-name)) ; version 114 (when group
146 ((fboundp 'gnus-group-name) 115 (org-store-link-props :type "gnus" :group group)
147 (gnus-group-name)) 116 (let ((description (org-gnus-group-link group)))
148 (t "???"))) 117 (org-add-link-props :link description :description description)
149 desc link) 118 description))))
150 (when group 119 ((or `gnus-summary-mode `gnus-article-mode)
151 (org-store-link-props :type "gnus" :group group) 120 (let* ((group
152 (setq desc (org-gnus-group-link group) 121 (pcase (gnus-find-method-for-group gnus-newsgroup-name)
153 link desc) 122 (`(nnvirtual . ,_)
154 (org-add-link-props :link link :description desc) 123 (car (nnvirtual-map-article (gnus-summary-article-number))))
155 link))) 124 (`(nnir . ,_)
156 125 (nnir-article-group (gnus-summary-article-number)))
157 ((memq major-mode '(gnus-summary-mode gnus-article-mode)) 126 (_ gnus-newsgroup-name)))
158 (let* ((group gnus-newsgroup-name) 127 (header (with-current-buffer gnus-summary-buffer
159 (header (with-current-buffer gnus-summary-buffer 128 (gnus-summary-article-header)))
160 (gnus-summary-article-header))) 129 (from (mail-header-from header))
161 (from (mail-header-from header)) 130 (message-id (org-unbracket-string "<" ">" (mail-header-id header)))
162 (message-id (org-unbracket-string "<" ">" (mail-header-id header))) 131 (date (org-trim (mail-header-date header)))
163 (date (org-trim (mail-header-date header))) 132 ;; Remove text properties of subject string to avoid Emacs
164 (subject (copy-sequence (mail-header-subject header))) 133 ;; bug #3506.
165 (to (cdr (assq 'To (mail-header-extra header)))) 134 (subject (org-no-properties
166 newsgroups x-no-archive desc link) 135 (copy-sequence (mail-header-subject header))))
167 (cl-case (car (gnus-find-method-for-group gnus-newsgroup-name)) 136 (to (cdr (assq 'To (mail-header-extra header))))
168 (nnvirtual 137 newsgroups x-no-archive)
169 (setq group (car (nnvirtual-map-article 138 ;; Fetching an article is an expensive operation; newsgroup and
170 (gnus-summary-article-number))))) 139 ;; x-no-archive are only needed for web links.
171 (nnir 140 (when (org-xor current-prefix-arg org-gnus-prefer-web-links)
172 (setq group (nnir-article-group (gnus-summary-article-number))))) 141 ;; Make sure the original article buffer is up-to-date.
173 ;; Remove text properties of subject string to avoid Emacs bug 142 (save-window-excursion (gnus-summary-select-article))
174 ;; #3506 143 (setq to (or to (gnus-fetch-original-field "To")))
175 (set-text-properties 0 (length subject) nil subject) 144 (setq newsgroups (gnus-fetch-original-field "Newsgroups"))
176 145 (setq x-no-archive (gnus-fetch-original-field "x-no-archive")))
177 ;; Fetching an article is an expensive operation; newsgroup and 146 (org-store-link-props :type "gnus" :from from :date date :subject subject
178 ;; x-no-archive are only needed for web links. 147 :message-id message-id :group group :to to)
179 (when (org-xor current-prefix-arg org-gnus-prefer-web-links) 148 (let ((link (org-gnus-article-link
180 ;; Make sure the original article buffer is up-to-date 149 group newsgroups message-id x-no-archive))
181 (save-window-excursion (gnus-summary-select-article)) 150 (description (org-email-link-description)))
182 (setq to (or to (gnus-fetch-original-field "To")) 151 (org-add-link-props :link link :description description)
183 newsgroups (gnus-fetch-original-field "Newsgroups") 152 link)))
184 x-no-archive (gnus-fetch-original-field "x-no-archive"))) 153 (`message-mode
185 (org-store-link-props :type "gnus" :from from :date date :subject subject 154 (setq org-store-link-plist nil) ;reset
186 :message-id message-id :group group :to to) 155 (save-excursion
187 (setq desc (org-email-link-description) 156 (save-restriction
188 link (org-gnus-article-link 157 (message-narrow-to-headers)
189 group newsgroups message-id x-no-archive)) 158 (unless (message-fetch-field "Message-ID")
190 (org-add-link-props :link link :description desc) 159 (message-generate-headers '(Message-ID)))
191 link)) 160 (goto-char (point-min))
192 ((eq major-mode 'message-mode) 161 (re-search-forward "^Message-ID:" nil t)
193 (setq org-store-link-plist nil) ; reset 162 (put-text-property (line-beginning-position) (line-end-position)
194 (save-excursion 163 'message-deletable nil)
195 (save-restriction 164 (let ((gcc (org-last (message-unquote-tokens
196 (message-narrow-to-headers) 165 (message-tokenize-header
197 (and (not (message-fetch-field "Message-ID")) 166 (mail-fetch-field "gcc" nil t) " ,"))))
198 (message-generate-headers '(Message-ID))) 167 (id (org-unbracket-string "<" ">"
199 (goto-char (point-min)) 168 (mail-fetch-field "Message-ID")))
200 (re-search-forward "^Message-ID: *.*$" nil t) 169 (to (mail-fetch-field "To"))
201 (put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil) 170 (from (mail-fetch-field "From"))
202 (let ((gcc (car (last 171 (subject (mail-fetch-field "Subject"))
203 (message-unquote-tokens 172 newsgroup xarchive) ;those are always nil for gcc
204 (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,"))))) 173 (unless gcc (error "Can not create link: No Gcc header found"))
205 (id (org-unbracket-string "<" ">" (mail-fetch-field "Message-ID"))) 174 (org-store-link-props :type "gnus" :from from :subject subject
206 (to (mail-fetch-field "To")) 175 :message-id id :group gcc :to to)
207 (from (mail-fetch-field "From")) 176 (let ((link (org-gnus-article-link gcc newsgroup id xarchive))
208 (subject (mail-fetch-field "Subject")) 177 (description (org-email-link-description)))
209 desc link 178 (org-add-link-props :link link :description description)
210 newsgroup xarchive) ; those are always nil for gcc 179 link)))))))
211 (and (not gcc)
212 (error "Can not create link: No Gcc header found"))
213 (org-store-link-props :type "gnus" :from from :subject subject
214 :message-id id :group gcc :to to)
215 (setq desc (org-email-link-description)
216 link (org-gnus-article-link
217 gcc newsgroup id xarchive))
218 (org-add-link-props :link link :description desc)
219 link))))))
220 180
221(defun org-gnus-open-nntp (path) 181(defun org-gnus-open-nntp (path)
222 "Follow the nntp: link specified by PATH." 182 "Follow the nntp: link specified by PATH."
@@ -230,64 +190,51 @@ If `org-store-link' was called with a prefix arg the meaning of
230 190
231(defun org-gnus-open (path) 191(defun org-gnus-open (path)
232 "Follow the Gnus message or folder link specified by PATH." 192 "Follow the Gnus message or folder link specified by PATH."
233 (let (group article) 193 (unless (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)
234 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 194 (error "Error in Gnus link %S" path))
235 (error "Error in Gnus link")) 195 (let ((group (match-string-no-properties 1 path))
236 (setq group (match-string 1 path) 196 (article (match-string-no-properties 3 path)))
237 article (match-string 3 path))
238 (when group
239 (setq group (org-no-properties group)))
240 (when article
241 (setq article (org-no-properties article)))
242 (org-gnus-follow-link group article))) 197 (org-gnus-follow-link group article)))
243 198
244(defun org-gnus-follow-link (&optional group article) 199(defun org-gnus-follow-link (&optional group article)
245 "Follow a Gnus link to GROUP and ARTICLE." 200 "Follow a Gnus link to GROUP and ARTICLE."
246 (require 'gnus) 201 (require 'gnus)
247 (funcall (cdr (assq 'gnus org-link-frame-setup))) 202 (funcall (cdr (assq 'gnus org-link-frame-setup)))
248 (if gnus-other-frame-object (select-frame gnus-other-frame-object)) 203 (when gnus-other-frame-object (select-frame gnus-other-frame-object))
249 (setq group (org-no-properties group)) 204 (let ((group (org-no-properties group))
250 (setq article (org-no-properties article)) 205 (article (org-no-properties article)))
251 (cond ((and group article) 206 (cond
252 (gnus-activate-group group) 207 ((and group article)
253 (condition-case nil 208 (gnus-activate-group group)
254 (let* ((method (gnus-find-method-for-group group)) 209 (condition-case nil
255 (backend (car method)) 210 (let ((msg "Couldn't follow Gnus link. Summary couldn't be opened."))
256 (server (cadr method))) 211 (pcase (gnus-find-method-for-group group)
257 (cond 212 (`(nndoc . ,_)
258 ((eq backend 'nndoc) 213 (if (gnus-group-read-group t nil group)
259 (if (gnus-group-read-group t nil group) 214 (gnus-summary-goto-article article nil t)
215 (message msg)))
216 (_
217 (let ((articles 1)
218 group-opened)
219 (while (and (not group-opened)
220 ;; Stop on integer overflows.
221 (> articles 0))
222 (setq group-opened (gnus-group-read-group articles t group))
223 (setq articles (if (< articles 16)
224 (1+ articles)
225 (* articles 2))))
226 (if group-opened
260 (gnus-summary-goto-article article nil t) 227 (gnus-summary-goto-article article nil t)
261 (message "Couldn't follow gnus link. %s" 228 (message msg))))))
262 "The summary couldn't be opened."))) 229 (quit
263 (t 230 (message "Couldn't follow Gnus link. The linked group is empty."))))
264 (let ((articles 1) 231 (group (gnus-group-jump-to-group group)))))
265 group-opened)
266 (when (and (eq backend 'nnimap)
267 org-gnus-nnimap-query-article-no-from-file)
268 (setq article
269 (or (org-gnus-nnimap-cached-article-number
270 (nth 1 (split-string group ":"))
271 server (concat "<" article ">")) article)))
272 (while (and (not group-opened)
273 ;; stop on integer overflows
274 (> articles 0))
275 (setq group-opened (gnus-group-read-group
276 articles t group)
277 articles (if (< articles 16)
278 (1+ articles)
279 (* articles 2))))
280 (if group-opened
281 (gnus-summary-goto-article article nil t)
282 (message "Couldn't follow gnus link. %s"
283 "The summary couldn't be opened."))))))
284 (quit (message "Couldn't follow gnus link. %s"
285 "The linked group is empty."))))
286 (group (gnus-group-jump-to-group group))))
287 232
288(defun org-gnus-no-new-news () 233(defun org-gnus-no-new-news ()
289 "Like `\\[gnus]' but doesn't check for new news." 234 "Like `\\[gnus]' but doesn't check for new news."
290 (if (not (gnus-alive-p)) (if org-gnus-no-server (gnus-no-server) (gnus)))) 235 (cond ((gnus-alive-p) nil)
236 (org-gnus-no-server (gnus-no-server))
237 (t (gnus))))
291 238
292(provide 'org-gnus) 239(provide 'org-gnus)
293 240
diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index 6ca9b79f0f0..89b75e6f680 100644
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -170,7 +170,7 @@ This list represents a \"habit\" for the rest of this module."
170 (if pom (goto-char pom)) 170 (if pom (goto-char pom))
171 (cl-assert (org-is-habit-p (point))) 171 (cl-assert (org-is-habit-p (point)))
172 (let* ((scheduled (org-get-scheduled-time (point))) 172 (let* ((scheduled (org-get-scheduled-time (point)))
173 (scheduled-repeat (org-get-repeat org-scheduled-string)) 173 (scheduled-repeat (org-get-repeat (org-entry-get (point) "SCHEDULED")))
174 (end (org-entry-end-position)) 174 (end (org-entry-end-position))
175 (habit-entry (org-no-properties (nth 4 (org-heading-components)))) 175 (habit-entry (org-no-properties (nth 4 (org-heading-components))))
176 closed-dates deadline dr-days sr-days sr-type) 176 closed-dates deadline dr-days sr-days sr-type)
diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el
index 088e0c7aa73..7f859f9040d 100644
--- a/lisp/org/org-info.el
+++ b/lisp/org/org-info.el
@@ -129,15 +129,19 @@ See `org-info-emacs-documents' and `org-info-other-documents' for details."
129(defun org-info-export (path desc format) 129(defun org-info-export (path desc format)
130 "Export an info link. 130 "Export an info link.
131See `org-link-parameters' for details about PATH, DESC and FORMAT." 131See `org-link-parameters' for details about PATH, DESC and FORMAT."
132 (when (eq format 'html) 132 (let* ((parts (split-string path "[#:]:?"))
133 (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" path) 133 (manual (car parts))
134 (string-match "\\(.*\\)" path)) 134 (node (or (nth 1 parts) "Top")))
135 (let ((filename (match-string 1 path)) 135 (pcase format
136 (node (or (match-string 2 path) "Top"))) 136 (`html
137 (format "<a href=\"%s#%s\">%s</a>" 137 (format "<a href=\"%s#%s\">%s</a>"
138 (org-info-map-html-url filename) 138 (org-info-map-html-url manual)
139 (org-info--expand-node-name node) 139 (org-info--expand-node-name node)
140 (or desc path))))) 140 (or desc path)))
141 (`texinfo
142 (let ((title (or desc "")))
143 (format "@ref{%s,%s,,%s,}" node title manual)))
144 (_ nil))))
141 145
142(provide 'org-info) 146(provide 'org-info)
143 147
diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el
index 2b9585112c5..8372ae0fb85 100644
--- a/lisp/org/org-lint.el
+++ b/lisp/org/org-lint.el
@@ -89,6 +89,7 @@
89;; - spurious macro arguments or invalid macro templates 89;; - spurious macro arguments or invalid macro templates
90;; - special properties in properties drawer 90;; - special properties in properties drawer
91;; - obsolete syntax for PROPERTIES drawers 91;; - obsolete syntax for PROPERTIES drawers
92;; - Invalid EFFORT property value
92;; - missing definition for footnote references 93;; - missing definition for footnote references
93;; - missing reference for footnote definitions 94;; - missing reference for footnote definitions
94;; - non-footnote definitions in footnote section 95;; - non-footnote definitions in footnote section
@@ -242,6 +243,10 @@
242 :description "Report obsolete syntax for properties drawers" 243 :description "Report obsolete syntax for properties drawers"
243 :categories '(obsolete properties)) 244 :categories '(obsolete properties))
244 (make-org-lint-checker 245 (make-org-lint-checker
246 :name 'invalid-effort-property
247 :description "Report invalid duration in EFFORT property"
248 :categories '(properties))
249 (make-org-lint-checker
245 :name 'undefined-footnote-reference 250 :name 'undefined-footnote-reference
246 :description "Report missing definition for footnote references" 251 :description "Report missing definition for footnote references"
247 :categories '(footnote)) 252 :categories '(footnote))
@@ -348,7 +353,7 @@ called with one argument, the key used for comparison."
348 (org-lint--collect-duplicates 353 (org-lint--collect-duplicates
349 ast 354 ast
350 'target 355 'target
351 (lambda (target) (org-split-string (org-element-property :value target))) 356 (lambda (target) (split-string (org-element-property :value target)))
352 (lambda (target _) (org-element-property :begin target)) 357 (lambda (target _) (org-element-property :begin target))
353 (lambda (key) 358 (lambda (key)
354 (format "Duplicate target <<%s>>" (mapconcat #'identity key " "))))) 359 (format "Duplicate target <<%s>>" (mapconcat #'identity key " ")))))
@@ -542,6 +547,16 @@ Use :header-args: instead"
542 "Incorrect contents for PROPERTIES drawer" 547 "Incorrect contents for PROPERTIES drawer"
543 "Incorrect location for PROPERTIES drawer")))))))) 548 "Incorrect location for PROPERTIES drawer"))))))))
544 549
550(defun org-lint-invalid-effort-property (ast)
551 (org-element-map ast 'node-property
552 (lambda (p)
553 (when (equal "EFFORT" (org-element-property :key p))
554 (let ((value (org-element-property :value p)))
555 (and (org-string-nw-p value)
556 (not (org-duration-p value))
557 (list (org-element-property :begin p)
558 (format "Invalid effort duration format: %S" value))))))))
559
545(defun org-lint-link-to-local-file (ast) 560(defun org-lint-link-to-local-file (ast)
546 (org-element-map ast 'link 561 (org-element-map ast 'link
547 (lambda (l) 562 (lambda (l)
@@ -985,7 +1000,7 @@ Use \"export %s\" instead"
985 (unless (memq allowed-values '(:any nil)) 1000 (unless (memq allowed-values '(:any nil))
986 (let ((values (cdr header)) 1001 (let ((values (cdr header))
987 groups-alist) 1002 groups-alist)
988 (dolist (v (if (stringp values) (org-split-string values) 1003 (dolist (v (if (stringp values) (split-string values)
989 (list values))) 1004 (list values)))
990 (let ((valid-value nil)) 1005 (let ((valid-value nil))
991 (catch 'exit 1006 (catch 'exit
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index e4848f9f614..8ea569f99c8 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -149,7 +149,7 @@
149(declare-function org-remove-indentation "org" (code &optional n)) 149(declare-function org-remove-indentation "org" (code &optional n))
150(declare-function org-show-subtree "org" ()) 150(declare-function org-show-subtree "org" ())
151(declare-function org-sort-remove-invisible "org" (S)) 151(declare-function org-sort-remove-invisible "org" (S))
152(declare-function org-time-string-to-seconds "org" (s)) 152(declare-function org-time-string-to-seconds "org" (s &optional zone))
153(declare-function org-timer-hms-to-secs "org-timer" (hms)) 153(declare-function org-timer-hms-to-secs "org-timer" (hms))
154(declare-function org-timer-item "org-timer" (&optional arg)) 154(declare-function org-timer-item "org-timer" (&optional arg))
155(declare-function org-trim "org" (s &optional keep-lead)) 155(declare-function org-trim "org" (s &optional keep-lead))
@@ -2250,6 +2250,7 @@ If CHECKBOX is non-nil, add a checkbox next to the bullet.
2250 2250
2251Return t when things worked, nil when we are not in an item, or 2251Return t when things worked, nil when we are not in an item, or
2252item is invisible." 2252item is invisible."
2253 (interactive "P")
2253 (let ((itemp (org-in-item-p)) 2254 (let ((itemp (org-in-item-p))
2254 (pos (point))) 2255 (pos (point)))
2255 ;; If cursor isn't is a list or if list is invisible, return nil. 2256 ;; If cursor isn't is a list or if list is invisible, return nil.
@@ -3324,23 +3325,28 @@ Valid parameters are:
3324 3325
3325 Strings to start or end a list item, and to start a list item 3326 Strings to start or end a list item, and to start a list item
3326 with a counter. They can also be set to a function returning 3327 with a counter. They can also be set to a function returning
3327 a string or nil, which will be called with the depth of the 3328 a string or nil, which will be called with two arguments: the
3328 item, counting from 1. 3329 type of list and the depth of the item, counting from 1.
3329 3330
3330:icount 3331:icount
3331 3332
3332 Strings to start a list item with a counter. It can also be 3333 Strings to start a list item with a counter. It can also be
3333 set to a function returning a string or nil, which will be 3334 set to a function returning a string or nil, which will be
3334 called with two arguments: the depth of the item, counting from 3335 called with three arguments: the type of list, the depth of the
3335 1, and the counter. Its value, when non-nil, has precedence 3336 item, counting from 1, and the counter. Its value, when
3336 over `:istart'. 3337 non-nil, has precedence over `:istart'.
3337 3338
3338:isep 3339:isep
3339 3340
3340 String used to separate items. It can also be set to 3341 String used to separate items. It can also be set to
3341 a function returning a string or nil, which will be called with 3342 a function returning a string or nil, which will be called with
3342 the depth of the items, counting from 1. It always start on 3343 two arguments: the type of list and the depth of the item,
3343 a new line. 3344 counting from 1. It always start on a new line.
3345
3346:ifmt
3347
3348 Function to be applied to the contents of every item. It is
3349 called with two arguments: the type of list and the contents.
3344 3350
3345:cbon, :cboff, :cbtrans 3351:cbon, :cboff, :cbtrans
3346 3352
@@ -3471,6 +3477,7 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
3471 (iend (plist-get params :iend)) 3477 (iend (plist-get params :iend))
3472 (isep (plist-get params :isep)) 3478 (isep (plist-get params :isep))
3473 (icount (plist-get params :icount)) 3479 (icount (plist-get params :icount))
3480 (ifmt (plist-get params :ifmt))
3474 (cboff (plist-get params :cboff)) 3481 (cboff (plist-get params :cboff))
3475 (cbon (plist-get params :cbon)) 3482 (cbon (plist-get params :cbon))
3476 (cbtrans (plist-get params :cbtrans)) 3483 (cbtrans (plist-get params :cbtrans))
@@ -3484,9 +3491,9 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
3484 (tag (org-element-property :tag item)) 3491 (tag (org-element-property :tag item))
3485 (depth (org-list--depth item)) 3492 (depth (org-list--depth item))
3486 (separator (and (org-export-get-next-element item info) 3493 (separator (and (org-export-get-next-element item info)
3487 (org-list--generic-eval isep depth))) 3494 (org-list--generic-eval isep type depth)))
3488 (closing (pcase (org-list--generic-eval iend depth) 3495 (closing (pcase (org-list--generic-eval iend type depth)
3489 ((or `nil `"") "\n") 3496 ((or `nil "") "\n")
3490 ((and (guard separator) s) 3497 ((and (guard separator) s)
3491 (if (equal (substring s -1) "\n") s (concat s "\n"))) 3498 (if (equal (substring s -1) "\n") s (concat s "\n")))
3492 (s s)))) 3499 (s s))))
@@ -3503,10 +3510,10 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
3503 ;; Build output. 3510 ;; Build output.
3504 (concat 3511 (concat
3505 (let ((c (org-element-property :counter item))) 3512 (let ((c (org-element-property :counter item)))
3506 (if c (org-list--generic-eval icount depth c) 3513 (if (and c icount) (org-list--generic-eval icount type depth c)
3507 (org-list--generic-eval istart depth))) 3514 (org-list--generic-eval istart type depth)))
3508 (let ((body 3515 (let ((body
3509 (if (or istart iend icount cbon cboff cbtrans (not backend) 3516 (if (or istart iend icount ifmt cbon cboff cbtrans (not backend)
3510 (and (eq type 'descriptive) 3517 (and (eq type 'descriptive)
3511 (or dtstart dtend ddstart ddend))) 3518 (or dtstart dtend ddstart ddend)))
3512 (concat 3519 (concat
@@ -3522,7 +3529,11 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
3522 (org-element-interpret-data tag)) 3529 (org-element-interpret-data tag))
3523 dtend)) 3530 dtend))
3524 (and tag ddstart) 3531 (and tag ddstart)
3525 (if (= (length contents) 0) "" (substring contents 0 -1)) 3532 (let ((contents
3533 (if (= (length contents) 0) ""
3534 (substring contents 0 -1))))
3535 (if ifmt (org-list--generic-eval ifmt type contents)
3536 contents))
3526 (and tag ddend)) 3537 (and tag ddend))
3527 (org-export-with-backend backend item contents info)))) 3538 (org-export-with-backend backend item contents info))))
3528 ;; Remove final newline. 3539 ;; Remove final newline.
@@ -3555,6 +3566,25 @@ PARAMS is a property list with overruling parameters for
3555 (require 'ox-texinfo) 3566 (require 'ox-texinfo)
3556 (org-list-to-generic list (org-combine-plists '(:backend texinfo) params))) 3567 (org-list-to-generic list (org-combine-plists '(:backend texinfo) params)))
3557 3568
3569(defun org-list-to-org (list &optional params)
3570 "Convert LIST into an Org plain list.
3571LIST is as returned by `org-list-parse-list'. PARAMS is a property list
3572with overruling parameters for `org-list-to-generic'."
3573 (let* ((make-item
3574 (lambda (type _depth &optional c)
3575 (concat (if (eq type 'ordered) "1. " "- ")
3576 (and c (format "[@%d] " c)))))
3577 (defaults
3578 (list :istart make-item
3579 :icount make-item
3580 :ifmt (lambda (_type contents)
3581 (replace-regexp-in-string "\n" "\n " contents))
3582 :dtend " :: "
3583 :cbon "[X] "
3584 :cboff "[ ] "
3585 :cbtrans "[-] ")))
3586 (org-list-to-generic list (org-combine-plists defaults params))))
3587
3558(defun org-list-to-subtree (list &optional params) 3588(defun org-list-to-subtree (list &optional params)
3559 "Convert LIST into an Org subtree. 3589 "Convert LIST into an Org subtree.
3560LIST is as returned by `org-list-to-lisp'. PARAMS is a property 3590LIST is as returned by `org-list-to-lisp'. PARAMS is a property
@@ -3566,7 +3596,7 @@ list with overruling parameters for `org-list-to-generic'."
3566 (org-previous-line-empty-p))))) 3596 (org-previous-line-empty-p)))))
3567 (level (org-reduced-level (or (org-current-level) 0))) 3597 (level (org-reduced-level (or (org-current-level) 0)))
3568 (make-stars 3598 (make-stars
3569 (lambda (depth) 3599 (lambda (_type depth &optional _count)
3570 ;; Return the string for the heading, depending on DEPTH 3600 ;; Return the string for the heading, depending on DEPTH
3571 ;; of current sub-list. 3601 ;; of current sub-list.
3572 (let ((oddeven-level (+ level depth))) 3602 (let ((oddeven-level (+ level depth)))
diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el
index cddc09e902f..1d2823ea0f9 100644
--- a/lisp/org/org-macro.el
+++ b/lisp/org/org-macro.el
@@ -36,8 +36,11 @@
36 36
37;; Along with macros defined through #+MACRO: keyword, default 37;; Along with macros defined through #+MACRO: keyword, default
38;; templates include the following hard-coded macros: 38;; templates include the following hard-coded macros:
39;; {{{time(format-string)}}}, {{{property(node-property)}}}, 39;; {{{time(format-string)}}},
40;; {{{input-file}}} and {{{modification-time(format-string)}}}. 40;; {{{property(node-property)}}},
41;; {{{input-file}}},
42;; {{{modification-time(format-string)}}},
43;; {{{n(counter,action}}}.
41 44
42;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}}, 45;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}},
43;; {{{email}}} and {{{title}}} macros. 46;; {{{email}}} and {{{title}}} macros.
@@ -52,9 +55,11 @@
52(declare-function org-element-macro-parser "org-element" ()) 55(declare-function org-element-macro-parser "org-element" ())
53(declare-function org-element-property "org-element" (property element)) 56(declare-function org-element-property "org-element" (property element))
54(declare-function org-element-type "org-element" (element)) 57(declare-function org-element-type "org-element" (element))
55(declare-function org-file-contents "org" (file &optional noerror)) 58(declare-function org-file-contents "org" (file &optional noerror nocache))
59(declare-function org-file-url-p "org" (file))
56(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) 60(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
57(declare-function org-mode "org" ()) 61(declare-function org-mode "org" ())
62(declare-function org-trim "org" (s &optional keep-lead))
58(declare-function vc-backend "vc-hooks" (f)) 63(declare-function vc-backend "vc-hooks" (f))
59(declare-function vc-call "vc-hooks" (fun file &rest args) t) 64(declare-function vc-call "vc-hooks" (fun file &rest args) t)
60(declare-function vc-exec-after "vc-dispatcher" (code)) 65(declare-function vc-exec-after "vc-dispatcher" (code))
@@ -99,16 +104,21 @@ Return an alist containing all macro templates found."
99 (if old-cell (setcdr old-cell template) 104 (if old-cell (setcdr old-cell template)
100 (push (cons name template) templates)))) 105 (push (cons name template) templates))))
101 ;; Enter setup file. 106 ;; Enter setup file.
102 (let ((file (expand-file-name 107 (let* ((uri (org-unbracket-string "\"" "\"" (org-trim val)))
103 (org-unbracket-string "\"" "\"" val)))) 108 (uri-is-url (org-file-url-p uri))
104 (unless (member file files) 109 (uri (if uri-is-url
110 uri
111 (expand-file-name uri))))
112 ;; Avoid circular dependencies.
113 (unless (member uri files)
105 (with-temp-buffer 114 (with-temp-buffer
106 (setq default-directory 115 (unless uri-is-url
107 (file-name-directory file)) 116 (setq default-directory
117 (file-name-directory uri)))
108 (org-mode) 118 (org-mode)
109 (insert (org-file-contents file 'noerror)) 119 (insert (org-file-contents uri 'noerror))
110 (setq templates 120 (setq templates
111 (funcall collect-macros (cons file files) 121 (funcall collect-macros (cons uri files)
112 templates))))))))))) 122 templates)))))))))))
113 templates)))) 123 templates))))
114 (funcall collect-macros nil nil))) 124 (funcall collect-macros nil nil)))
@@ -126,7 +136,7 @@ function installs the following ones: \"property\",
126 (let ((old-template (assoc (car cell) templates))) 136 (let ((old-template (assoc (car cell) templates)))
127 (if old-template (setcdr old-template (cdr cell)) 137 (if old-template (setcdr old-template (cdr cell))
128 (push cell templates)))))) 138 (push cell templates))))))
129 ;; Install hard-coded macros. 139 ;; Install "property", "time" macros.
130 (mapc update-templates 140 (mapc update-templates
131 (list (cons "property" 141 (list (cons "property"
132 "(eval (save-excursion 142 "(eval (save-excursion
@@ -140,6 +150,7 @@ function installs the following ones: \"property\",
140 l))))) 150 l)))))
141 (org-entry-get nil \"$1\" 'selective)))") 151 (org-entry-get nil \"$1\" 'selective)))")
142 (cons "time" "(eval (format-time-string \"$1\"))"))) 152 (cons "time" "(eval (format-time-string \"$1\"))")))
153 ;; Install "input-file", "modification-time" macros.
143 (let ((visited-file (buffer-file-name (buffer-base-buffer)))) 154 (let ((visited-file (buffer-file-name (buffer-base-buffer))))
144 (when (and visited-file (file-exists-p visited-file)) 155 (when (and visited-file (file-exists-p visited-file))
145 (mapc update-templates 156 (mapc update-templates
@@ -149,6 +160,10 @@ function installs the following ones: \"property\",
149 (prin1-to-string visited-file) 160 (prin1-to-string visited-file)
150 (prin1-to-string 161 (prin1-to-string
151 (nth 5 (file-attributes visited-file))))))))) 162 (nth 5 (file-attributes visited-file)))))))))
163 ;; Initialize and install "n" macro.
164 (org-macro--counter-initialize)
165 (funcall update-templates
166 (cons "n" "(eval (org-macro--counter-increment \"$1\" \"$2\"))"))
152 (setq org-macro-templates templates))) 167 (setq org-macro-templates templates)))
153 168
154(defun org-macro-expand (macro templates) 169(defun org-macro-expand (macro templates)
@@ -276,6 +291,9 @@ Return a list of arguments, as strings. This is the opposite of
276 s nil t) 291 s nil t)
277 "\000")) 292 "\000"))
278 293
294
295;;; Helper functions and variables for internal macros
296
279(defun org-macro--vc-modified-time (file) 297(defun org-macro--vc-modified-time (file)
280 (save-window-excursion 298 (save-window-excursion
281 (when (vc-backend file) 299 (when (vc-backend file)
@@ -300,6 +318,38 @@ Return a list of arguments, as strings. This is the opposite of
300 (kill-buffer buf)) 318 (kill-buffer buf))
301 date)))) 319 date))))
302 320
321(defvar org-macro--counter-table nil
322 "Hash table containing counter value per name.")
323
324(defun org-macro--counter-initialize ()
325 "Initialize `org-macro--counter-table'."
326 (setq org-macro--counter-table (make-hash-table :test #'equal)))
327
328(defun org-macro--counter-increment (name &optional action)
329 "Increment counter NAME.
330NAME is a string identifying the counter.
331
332When non-nil, optional argument ACTION is a string.
333
334If the string is \"-\", keep the NAME counter at its current
335value, i.e. do not increment.
336
337If the string represents an integer, set the counter to this number.
338
339Any other non-empty string resets the counter to 1."
340 (let ((name-trimmed (org-trim name))
341 (action-trimmed (when (org-string-nw-p action)
342 (org-trim action))))
343 (puthash name-trimmed
344 (cond ((not (org-string-nw-p action-trimmed))
345 (1+ (gethash name-trimmed org-macro--counter-table 0)))
346 ((string= "-" action-trimmed)
347 (gethash name-trimmed org-macro--counter-table 1))
348 ((string-match-p "\\`[0-9]+\\'" action-trimmed)
349 (string-to-number action-trimmed))
350 (t 1))
351 org-macro--counter-table)))
352
303 353
304(provide 'org-macro) 354(provide 'org-macro)
305;;; org-macro.el ends here 355;;; org-macro.el ends here
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index e656eaa0230..1118214c4f1 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -45,6 +45,90 @@ Otherwise, return nil."
45 (string-match-p "[^ \r\t\n]" s) 45 (string-match-p "[^ \r\t\n]" s)
46 s)) 46 s))
47 47
48(defun org-split-string (string &optional separators)
49 "Splits STRING into substrings at SEPARATORS.
50
51SEPARATORS is a regular expression. When nil, it defaults to
52\"[ \f\t\n\r\v]+\".
53
54Unlike to `split-string', matching SEPARATORS at the beginning
55and end of string are ignored."
56 (let ((separators (or separators "[ \f\t\n\r\v]+")))
57 (when (string-match (concat "\\`" separators) string)
58 (setq string (replace-match "" nil nil string)))
59 (when (string-match (concat separators "\\'") string)
60 (setq string (replace-match "" nil nil string)))
61 (split-string string separators)))
62
63(defun org-string-display (string)
64 "Return STRING as it is displayed in the current buffer.
65This function takes into consideration `invisible' and `display'
66text properties."
67 (let* ((build-from-parts
68 (lambda (s property filter)
69 ;; Build a new string out of string S. On every group of
70 ;; contiguous characters with the same PROPERTY value,
71 ;; call FILTER on the properties list at the beginning of
72 ;; the group. If it returns a string, replace the
73 ;; characters in the group with it. Otherwise, preserve
74 ;; those characters.
75 (let ((len (length s))
76 (new "")
77 (i 0)
78 (cursor 0))
79 (while (setq i (text-property-not-all i len property nil s))
80 (let ((end (next-single-property-change i property s len))
81 (value (funcall filter (text-properties-at i s))))
82 (when value
83 (setq new (concat new (substring s cursor i) value))
84 (setq cursor end))
85 (setq i end)))
86 (concat new (substring s cursor)))))
87 (prune-invisible
88 (lambda (s)
89 (funcall build-from-parts s 'invisible
90 (lambda (props)
91 ;; If `invisible' property in PROPS means text
92 ;; is to be invisible, return the empty string.
93 ;; Otherwise return nil so that the part is
94 ;; skipped.
95 (and (or (eq t buffer-invisibility-spec)
96 (assoc-string (plist-get props 'invisible)
97 buffer-invisibility-spec))
98 "")))))
99 (replace-display
100 (lambda (s)
101 (funcall build-from-parts s 'display
102 (lambda (props)
103 ;; If there is any string specification in
104 ;; `display' property return it. Also attach
105 ;; other text properties on the part to that
106 ;; string (face...).
107 (let* ((display (plist-get props 'display))
108 (value (if (stringp display) display
109 (cl-some #'stringp display))))
110 (when value
111 (apply
112 #'propertize
113 ;; Displayed string could contain
114 ;; invisible parts, but no nested display.
115 (funcall prune-invisible value)
116 (plist-put props
117 'display
118 (and (not (stringp display))
119 (cl-remove-if #'stringp
120 display)))))))))))
121 ;; `display' property overrides `invisible' one. So we first
122 ;; replace characters with `display' property. Then we remove
123 ;; invisible characters.
124 (funcall prune-invisible (funcall replace-display string))))
125
126(defun org-string-width (string)
127 "Return width of STRING when displayed in the current buffer.
128Unlike to `string-width', this function takes into consideration
129`invisible' and `display' text properties."
130 (string-width (org-string-display string)))
131
48(defun org-not-nil (v) 132(defun org-not-nil (v)
49 "If V not nil, and also not the string \"nil\", then return V. 133 "If V not nil, and also not the string \"nil\", then return V.
50Otherwise return nil." 134Otherwise return nil."
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index 8e61cfc32e7..7c982423228 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -391,8 +391,8 @@ DEFAULT is returned if no priority is given in the headline."
391(defun org-mouse-delete-timestamp () 391(defun org-mouse-delete-timestamp ()
392 "Deletes the current timestamp as well as the preceding keyword. 392 "Deletes the current timestamp as well as the preceding keyword.
393SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" 393SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
394 (when (or (org-at-date-range-p) (org-at-timestamp-p)) 394 (when (or (org-at-date-range-p) (org-at-timestamp-p 'lax))
395 (replace-match "") ; delete the timestamp 395 (replace-match "") ;delete the timestamp
396 (skip-chars-backward " :A-Z") 396 (skip-chars-backward " :A-Z")
397 (when (looking-at " *[A-Z][A-Z]+:") 397 (when (looking-at " *[A-Z][A-Z]+:")
398 (replace-match "")))) 398 (replace-match ""))))
@@ -516,7 +516,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
516 ["Check Phrase ..." org-occur] 516 ["Check Phrase ..." org-occur]
517 "--" 517 "--"
518 ["Display Agenda" org-agenda-list t] 518 ["Display Agenda" org-agenda-list t]
519 ["Display Timeline" org-timeline t]
520 ["Display TODO List" org-todo-list t] 519 ["Display TODO List" org-todo-list t]
521 ("Display Tags" 520 ("Display Tags"
522 ,@(org-mouse-keyword-menu 521 ,@(org-mouse-keyword-menu
@@ -715,7 +714,7 @@ This means, between the beginning of line and the point."
715 (org-tags-sparse-tree nil ,(match-string 1))] 714 (org-tags-sparse-tree nil ,(match-string 1))]
716 "--" 715 "--"
717 ,@(org-mouse-tag-menu)))) 716 ,@(org-mouse-tag-menu))))
718 ((org-at-timestamp-p) 717 ((org-at-timestamp-p 'lax)
719 (popup-menu 718 (popup-menu
720 '(nil 719 '(nil
721 ["Show Day" org-open-at-point t] 720 ["Show Day" org-open-at-point t]
@@ -1044,21 +1043,21 @@ This means, between the beginning of line and the point."
1044 org-agenda-undo-list)] 1043 org-agenda-undo-list)]
1045 ["Rebuild Buffer" org-agenda-redo t] 1044 ["Rebuild Buffer" org-agenda-redo t]
1046 ["New Diary Entry" 1045 ["New Diary Entry"
1047 org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t] 1046 org-agenda-diary-entry (org-agenda-check-type nil 'agenda) t]
1048 "--" 1047 "--"
1049 ["Goto Today" org-agenda-goto-today 1048 ["Goto Today" org-agenda-goto-today
1050 (org-agenda-check-type nil 'agenda 'timeline) t] 1049 (org-agenda-check-type nil 'agenda) t]
1051 ["Display Calendar" org-agenda-goto-calendar 1050 ["Display Calendar" org-agenda-goto-calendar
1052 (org-agenda-check-type nil 'agenda 'timeline) t] 1051 (org-agenda-check-type nil 'agenda) t]
1053 ("Calendar Commands" 1052 ("Calendar Commands"
1054 ["Phases of the Moon" org-agenda-phases-of-moon 1053 ["Phases of the Moon" org-agenda-phases-of-moon
1055 (org-agenda-check-type nil 'agenda 'timeline)] 1054 (org-agenda-check-type nil 'agenda)]
1056 ["Sunrise/Sunset" org-agenda-sunrise-sunset 1055 ["Sunrise/Sunset" org-agenda-sunrise-sunset
1057 (org-agenda-check-type nil 'agenda 'timeline)] 1056 (org-agenda-check-type nil 'agenda)]
1058 ["Holidays" org-agenda-holidays 1057 ["Holidays" org-agenda-holidays
1059 (org-agenda-check-type nil 'agenda 'timeline)] 1058 (org-agenda-check-type nil 'agenda)]
1060 ["Convert" org-agenda-convert-date 1059 ["Convert" org-agenda-convert-date
1061 (org-agenda-check-type nil 'agenda 'timeline)] 1060 (org-agenda-check-type nil 'agenda)]
1062 "--" 1061 "--"
1063 ["Create iCalendar file" org-icalendar-combine-agenda-files t]) 1062 ["Create iCalendar file" org-icalendar-combine-agenda-files t])
1064 "--" 1063 "--"
@@ -1071,7 +1070,7 @@ This means, between the beginning of line and the point."
1071 "--" 1070 "--"
1072 ["Show Logbook entries" org-agenda-log-mode 1071 ["Show Logbook entries" org-agenda-log-mode
1073 :style toggle :selected org-agenda-show-log 1072 :style toggle :selected org-agenda-show-log
1074 :active (org-agenda-check-type nil 'agenda 'timeline)] 1073 :active (org-agenda-check-type nil 'agenda)]
1075 ["Include Diary" org-agenda-toggle-diary 1074 ["Include Diary" org-agenda-toggle-diary
1076 :style toggle :selected org-agenda-include-diary 1075 :style toggle :selected org-agenda-include-diary
1077 :active (org-agenda-check-type nil 'agenda)] 1076 :active (org-agenda-check-type nil 'agenda)]
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 6e61a8dcc34..d92bfc6a158 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -194,7 +194,14 @@ Example:
194 :working-suffix \".org\" 194 :working-suffix \".org\"
195 :base-url \"http://localhost/org/\" 195 :base-url \"http://localhost/org/\"
196 :working-directory \"/home/user/org/\" 196 :working-directory \"/home/user/org/\"
197 :rewrites ((\"org/?$\" . \"index.php\"))))) 197 :rewrites ((\"org/?$\" . \"index.php\")))
198 (\"Hugo based blog\"
199 :base-url \"https://www.site.com/\"
200 :working-directory \"~/site/content/post/\"
201 :online-suffix \".html\"
202 :working-suffix \".md\"
203 :rewrites ((\"\\(https://site.com/[0-9]+/[0-9]+/[0-9]+/\\)\" . \".md\")))))
204
198 205
199 The last line tells `org-protocol-open-source' to open 206 The last line tells `org-protocol-open-source' to open
200 /home/user/org/index.php, if the URL cannot be mapped to an existing 207 /home/user/org/index.php, if the URL cannot be mapped to an existing
@@ -556,8 +563,12 @@ The location for a browser's bookmark should look like this:
556 ;; Try to match a rewritten URL and map it to 563 ;; Try to match a rewritten URL and map it to
557 ;; a real file. Compare redirects without 564 ;; a real file. Compare redirects without
558 ;; suffix. 565 ;; suffix.
559 (when (string-match-p (car rewrite) f1) 566 (when (string-match (car rewrite) f1)
560 (throw 'result (concat wdir (cdr rewrite)))))))) 567 (let ((replacement
568 (concat (directory-file-name
569 (replace-match "" nil nil f1 1))
570 (cdr rewrite))))
571 (throw 'result (concat wdir replacement))))))))
561 ;; -- end of redirects -- 572 ;; -- end of redirects --
562 573
563 (if (file-readable-p the-file) 574 (if (file-readable-p the-file)
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index da08777a44c..99d7c6f7fda 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -338,7 +338,7 @@ where BEG and END are buffer positions and CONTENTS is a string."
338 (skip-chars-backward " \r\t\n") 338 (skip-chars-backward " \r\t\n")
339 (line-beginning-position 1)) 339 (line-beginning-position 1))
340 (org-element-property :value datum))) 340 (org-element-property :value datum)))
341 ((memq type '(fixed-width table)) 341 ((memq type '(fixed-width latex-environment table))
342 (let ((beg (org-element-property :post-affiliated datum)) 342 (let ((beg (org-element-property :post-affiliated datum))
343 (end (progn (goto-char (org-element-property :end datum)) 343 (end (progn (goto-char (org-element-property :end datum))
344 (skip-chars-backward " \r\t\n") 344 (skip-chars-backward " \r\t\n")
@@ -881,6 +881,28 @@ Throw an error when not at such a table."
881 (table-recognize) 881 (table-recognize)
882 t)) 882 t))
883 883
884(defun org-edit-latex-environment ()
885 "Edit LaTeX environment at point.
886\\<org-src-mode-map>
887The LaTeX environment is copied into a new buffer. Major mode is
888set to the one associated to \"latex\" in `org-src-lang-modes',
889or to `latex-mode' if there is none.
890
891When done, exit with `\\[org-edit-src-exit]'. The edited text \
892will then replace
893the LaTeX environment in the Org mode buffer."
894 (interactive)
895 (let ((element (org-element-at-point)))
896 (unless (and (eq (org-element-type element) 'latex-environment)
897 (org-src--on-datum-p element))
898 (user-error "Not in a LaTeX environment"))
899 (org-src--edit-element
900 element
901 (org-src--construct-edit-buffer-name (buffer-name) "LaTeX environment")
902 (org-src--get-lang-mode "latex")
903 t)
904 t))
905
884(defun org-edit-export-block () 906(defun org-edit-export-block ()
885 "Edit export block at point. 907 "Edit export block at point.
886\\<org-src-mode-map> 908\\<org-src-mode-map>
@@ -898,7 +920,10 @@ Throw an error when not at an export block."
898 (unless (and (eq (org-element-type element) 'export-block) 920 (unless (and (eq (org-element-type element) 'export-block)
899 (org-src--on-datum-p element)) 921 (org-src--on-datum-p element))
900 (user-error "Not in an export block")) 922 (user-error "Not in an export block"))
901 (let* ((type (downcase (org-element-property :type element))) 923 (let* ((type (downcase (or (org-element-property :type element)
924 ;; Missing export-block type. Fallback
925 ;; to default mode.
926 "fundamental")))
902 (mode (org-src--get-lang-mode type))) 927 (mode (org-src--get-lang-mode type)))
903 (unless (functionp mode) (error "No such language mode: %s" mode)) 928 (unless (functionp mode) (error "No such language mode: %s" mode))
904 (org-src--edit-element 929 (org-src--edit-element
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 60f55799c99..ae437908643 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -65,11 +65,12 @@
65 65
66(declare-function calc-eval "calc" (str &optional separator &rest args)) 66(declare-function calc-eval "calc" (str &optional separator &rest args))
67 67
68(defvar orgtbl-mode) ; defined below
69(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
70(defvar constants-unit-system) 68(defvar constants-unit-system)
69(defvar org-element-use-cache)
71(defvar org-export-filters-alist) 70(defvar org-export-filters-alist)
72(defvar org-table-follow-field-mode) 71(defvar org-table-follow-field-mode)
72(defvar orgtbl-mode) ; defined below
73(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
73(defvar sort-fold-case) 74(defvar sort-fold-case)
74 75
75(defvar orgtbl-after-send-table-hook nil 76(defvar orgtbl-after-send-table-hook nil
@@ -80,17 +81,17 @@ are not run.")
80 81
81(defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ") 82(defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ")
82 83
83(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) 84(defcustom orgtbl-optimized t
84 "Non-nil means use the optimized table editor version for `orgtbl-mode'. 85 "Non-nil means use the optimized table editor version for `orgtbl-mode'.
86
85In the optimized version, the table editor takes over all simple keys that 87In the optimized version, the table editor takes over all simple keys that
86normally just insert a character. In tables, the characters are inserted 88normally just insert a character. In tables, the characters are inserted
87in a way to minimize disturbing the table structure (i.e. in overwrite mode 89in a way to minimize disturbing the table structure (i.e. in overwrite mode
88for empty fields). Outside tables, the correct binding of the keys is 90for empty fields). Outside tables, the correct binding of the keys is
89restored. 91restored.
90 92
91The default for this option is t if the optimized version is also used in 93Changing this variable requires a restart of Emacs to become
92Org mode. See the variable `org-enable-table-editor' for details. Changing 94effective."
93this variable requires a restart of Emacs to become effective."
94 :group 'org-table 95 :group 'org-table
95 :type 'boolean) 96 :type 'boolean)
96 97
@@ -207,8 +208,7 @@ removal/insertion."
207(defcustom org-table-auto-blank-field t 208(defcustom org-table-auto-blank-field t
208 "Non-nil means automatically blank table field when starting to type into it. 209 "Non-nil means automatically blank table field when starting to type into it.
209This only happens when typing immediately after a field motion 210This only happens when typing immediately after a field motion
210command (TAB, S-TAB or RET). 211command (TAB, S-TAB or RET)."
211Only relevant when `org-enable-table-editor' is equal to `optimized'."
212 :group 'org-table-editing 212 :group 'org-table-editing
213 :type 'boolean) 213 :type 'boolean)
214 214
@@ -293,13 +293,25 @@ relies on the variables to be present in the list."
293The default value is `hours', and will output the results as a 293The default value is `hours', and will output the results as a
294number of hours. Other allowed values are `seconds', `minutes' and 294number of hours. Other allowed values are `seconds', `minutes' and
295`days', and the output will be a fraction of seconds, minutes or 295`days', and the output will be a fraction of seconds, minutes or
296days." 296days. `hh:mm' selects to use hours and minutes, ignoring seconds.
297The `U' flag in a table formula will select this specific format for
298a single formula."
297 :group 'org-table-calculation 299 :group 'org-table-calculation
298 :version "24.1" 300 :version "24.1"
299 :type '(choice (symbol :tag "Seconds" 'seconds) 301 :type '(choice (symbol :tag "Seconds" 'seconds)
300 (symbol :tag "Minutes" 'minutes) 302 (symbol :tag "Minutes" 'minutes)
301 (symbol :tag "Hours " 'hours) 303 (symbol :tag "Hours " 'hours)
302 (symbol :tag "Days " 'days))) 304 (symbol :tag "Days " 'days)
305 (symbol :tag "HH:MM " 'hh:mm)))
306
307(defcustom org-table-duration-hour-zero-padding t
308 "Non-nil means hours in table duration computations should be zero-padded.
309So this is about 08:32:34 versus 8:33:34."
310 :group 'org-table-calculation
311 :version "26.1"
312 :package-version '(Org . "9.1")
313 :type 'boolean
314 :safe #'booleanp)
303 315
304(defcustom org-table-formula-field-format "%s" 316(defcustom org-table-formula-field-format "%s"
305 "Format for fields which contain the result of a formula. 317 "Format for fields which contain the result of a formula.
@@ -796,7 +808,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
796 ;; Find fields that are wider than FMAX, and shorten them. 808 ;; Find fields that are wider than FMAX, and shorten them.
797 (when fmax 809 (when fmax
798 (dolist (x column) 810 (dolist (x column)
799 (when (> (org-string-width x) fmax) 811 (when (> (string-width x) fmax)
800 (org-add-props x nil 812 (org-add-props x nil
801 'help-echo 813 'help-echo
802 (concat 814 (concat
@@ -824,7 +836,7 @@ edit. Full value is:\n"
824 (list 'display org-narrow-column-arrow) 836 (list 'display org-narrow-column-arrow)
825 x)))))) 837 x))))))
826 ;; Get the maximum width for each column 838 ;; Get the maximum width for each column
827 (push (apply #'max (or fmax 1) 1 (mapcar #'org-string-width column)) 839 (push (or fmax (apply #'max 1 (mapcar #'org-string-width column)))
828 lengths) 840 lengths)
829 ;; Get the fraction of numbers among non-empty cells to 841 ;; Get the fraction of numbers among non-empty cells to
830 ;; decide about alignment of the column. 842 ;; decide about alignment of the column.
@@ -1018,20 +1030,23 @@ Before doing so, re-align the table if necessary."
1018 (interactive) 1030 (interactive)
1019 (org-table-justify-field-maybe) 1031 (org-table-justify-field-maybe)
1020 (org-table-maybe-recalculate-line) 1032 (org-table-maybe-recalculate-line)
1021 (if (and org-table-automatic-realign 1033 (when (and org-table-automatic-realign
1022 org-table-may-need-update) 1034 org-table-may-need-update)
1023 (org-table-align)) 1035 (org-table-align))
1024 (if (org-at-table-hline-p) 1036 (when (org-at-table-hline-p)
1025 (end-of-line 1)) 1037 (end-of-line))
1026 (condition-case nil 1038 (let ((start (org-table-begin))
1027 (progn 1039 (origin (point)))
1028 (re-search-backward "|" (org-table-begin)) 1040 (condition-case nil
1029 (re-search-backward "|" (org-table-begin))) 1041 (progn
1030 (error (user-error "Cannot move to previous table field"))) 1042 (search-backward "|" start nil 2)
1031 (while (looking-at "|\\(-\\|[ \t]*$\\)") 1043 (while (looking-at-p "|\\(?:-\\|[ \t]*$\\)")
1032 (re-search-backward "|" (org-table-begin))) 1044 (search-backward "|" start)))
1033 (if (looking-at "| ?") 1045 (error
1034 (goto-char (match-end 0)))) 1046 (goto-char origin)
1047 (user-error "Cannot move to previous table field"))))
1048 (when (looking-at "| ?")
1049 (goto-char (match-end 0))))
1035 1050
1036(defun org-table-beginning-of-field (&optional n) 1051(defun org-table-beginning-of-field (&optional n)
1037 "Move to the beginning of the current table field. 1052 "Move to the beginning of the current table field.
@@ -1121,28 +1136,28 @@ to a number. In the case of a timestamp, increment by days."
1121 txt txt-up inc) 1136 txt txt-up inc)
1122 (org-table-check-inside-data-field) 1137 (org-table-check-inside-data-field)
1123 (if (not non-empty) 1138 (if (not non-empty)
1124 (save-excursion 1139 (save-excursion
1125 (setq txt 1140 (setq txt
1126 (catch 'exit 1141 (catch 'exit
1127 (while (progn (beginning-of-line 1) 1142 (while (progn (beginning-of-line 1)
1128 (re-search-backward org-table-dataline-regexp 1143 (re-search-backward org-table-dataline-regexp
1129 beg t)) 1144 beg t))
1130 (org-table-goto-column colpos t) 1145 (org-table-goto-column colpos t)
1131 (if (and (looking-at 1146 (if (and (looking-at
1132 "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") 1147 "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
1133 (<= (setq n (1- n)) 0)) 1148 (<= (setq n (1- n)) 0))
1134 (throw 'exit (match-string 1)))))) 1149 (throw 'exit (match-string 1))))))
1135 (setq field-up 1150 (setq field-up
1136 (catch 'exit 1151 (catch 'exit
1137 (while (progn (beginning-of-line 1) 1152 (while (progn (beginning-of-line 1)
1138 (re-search-backward org-table-dataline-regexp 1153 (re-search-backward org-table-dataline-regexp
1139 beg t)) 1154 beg t))
1140 (org-table-goto-column colpos t) 1155 (org-table-goto-column colpos t)
1141 (if (and (looking-at 1156 (if (and (looking-at
1142 "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") 1157 "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
1143 (<= (setq n (1- n)) 0)) 1158 (<= (setq n (1- n)) 0))
1144 (throw 'exit (match-string 1)))))) 1159 (throw 'exit (match-string 1))))))
1145 (setq non-empty-up (and field-up (string-match "[^ \t]" field-up)))) 1160 (setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
1146 ;; Above field was not empty, go down to the next row 1161 ;; Above field was not empty, go down to the next row
1147 (setq txt (org-trim field)) 1162 (setq txt (org-trim field))
1148 (org-table-next-row) 1163 (org-table-next-row)
@@ -1169,7 +1184,7 @@ to a number. In the case of a timestamp, increment by days."
1169 (setq txt (calc-eval (concat txt "+" (number-to-string inc))))) 1184 (setq txt (calc-eval (concat txt "+" (number-to-string inc)))))
1170 (insert txt) 1185 (insert txt)
1171 (org-move-to-column col) 1186 (org-move-to-column col)
1172 (if (and org-table-copy-increment (org-at-timestamp-p t)) 1187 (if (and org-table-copy-increment (org-at-timestamp-p 'lax))
1173 (org-timestamp-up-day inc) 1188 (org-timestamp-up-day inc)
1174 (org-table-maybe-recalculate-line)) 1189 (org-table-maybe-recalculate-line))
1175 (org-table-align) 1190 (org-table-align)
@@ -1317,22 +1332,15 @@ value."
1317(defun org-table-current-column () 1332(defun org-table-current-column ()
1318 "Find out which column we are in." 1333 "Find out which column we are in."
1319 (interactive) 1334 (interactive)
1320 (when (called-interactively-p 'any) (org-table-check-inside-data-field))
1321 (save-excursion 1335 (save-excursion
1322 (let ((column 0) (pos (point))) 1336 (let ((column 0) (pos (point)))
1323 (beginning-of-line) 1337 (beginning-of-line)
1324 (while (search-forward "|" pos t) (cl-incf column)) 1338 (while (search-forward "|" pos t) (cl-incf column))
1325 (when (called-interactively-p 'interactive)
1326 (message "In table column %d" column))
1327 column))) 1339 column)))
1328 1340
1329;;;###autoload
1330(defun org-table-current-dline () 1341(defun org-table-current-dline ()
1331 "Find out what table data line we are in. 1342 "Find out what table data line we are in.
1332Only data lines count for this." 1343Only data lines count for this."
1333 (interactive)
1334 (when (called-interactively-p 'any)
1335 (org-table-check-inside-data-field))
1336 (save-excursion 1344 (save-excursion
1337 (let ((c 0) 1345 (let ((c 0)
1338 (pos (line-beginning-position))) 1346 (pos (line-beginning-position)))
@@ -1340,8 +1348,6 @@ Only data lines count for this."
1340 (while (<= (point) pos) 1348 (while (<= (point) pos)
1341 (when (looking-at org-table-dataline-regexp) (cl-incf c)) 1349 (when (looking-at org-table-dataline-regexp) (cl-incf c))
1342 (forward-line)) 1350 (forward-line))
1343 (when (called-interactively-p 'any)
1344 (message "This is table line %d" c))
1345 c))) 1351 c)))
1346 1352
1347;;;###autoload 1353;;;###autoload
@@ -1734,8 +1740,9 @@ function is being called interactively."
1734 (cond ((string-match org-ts-regexp-both f) 1740 (cond ((string-match org-ts-regexp-both f)
1735 (float-time 1741 (float-time
1736 (org-time-string-to-time (match-string 0 f)))) 1742 (org-time-string-to-time (match-string 0 f))))
1737 ((string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" f) 1743 ((org-duration-p f) (org-duration-to-minutes f))
1738 (org-hh:mm-string-to-minutes f)) 1744 ((string-match "\\<[0-9]+:[0-9]\\{2\\}\\>" f)
1745 (org-duration-to-minutes (match-string 0 f)))
1739 (t 0)))) 1746 (t 0))))
1740 ((?f ?F) 1747 ((?f ?F)
1741 (or getkey-func 1748 (or getkey-func
@@ -1827,7 +1834,6 @@ lines."
1827 (user-error "First cut/copy a region to paste!")) 1834 (user-error "First cut/copy a region to paste!"))
1828 (org-table-check-inside-data-field) 1835 (org-table-check-inside-data-field)
1829 (let* ((column (org-table-current-column)) 1836 (let* ((column (org-table-current-column))
1830 (org-enable-table-editor t)
1831 (org-table-automatic-realign nil)) 1837 (org-table-automatic-realign nil))
1832 (org-table-save-field 1838 (org-table-save-field
1833 (dolist (row org-table-clip) 1839 (dolist (row org-table-clip)
@@ -2002,11 +2008,15 @@ blank, and the content is appended to the field above."
2002;;;###autoload 2008;;;###autoload
2003(defun org-table-edit-field (arg) 2009(defun org-table-edit-field (arg)
2004 "Edit table field in a different window. 2010 "Edit table field in a different window.
2005This is mainly useful for fields that contain hidden parts. When called 2011This is mainly useful for fields that contain hidden parts.
2006with a `\\[universal-argument]' prefix, just make the full field \ 2012
2007visible so that it can be 2013When called with a `\\[universal-argument]' prefix, just make the full field
2008edited in place." 2014visible so that it can be edited in place.
2015
2016When called with a `\\[universal-argument] \\[universal-argument]' prefix, \
2017toggle `org-table-follow-field-mode'."
2009 (interactive "P") 2018 (interactive "P")
2019 (unless (org-at-table-p) (user-error "Not at a table"))
2010 (cond 2020 (cond
2011 ((equal arg '(16)) 2021 ((equal arg '(16))
2012 (org-table-follow-field-mode (if org-table-follow-field-mode -1 1))) 2022 (org-table-follow-field-mode (if org-table-follow-field-mode -1 1)))
@@ -2673,17 +2683,25 @@ For details, see the Org mode manual.
2673 2683
2674This function can also be called from Lisp programs and offers 2684This function can also be called from Lisp programs and offers
2675additional arguments: EQUATION can be the formula to apply. If this 2685additional arguments: EQUATION can be the formula to apply. If this
2676argument is given, the user will not be prompted. SUPPRESS-ALIGN is 2686argument is given, the user will not be prompted.
2677used to speed-up recursive calls by by-passing unnecessary aligns. 2687
2688SUPPRESS-ALIGN is used to speed-up recursive calls by by-passing
2689unnecessary aligns.
2690
2678SUPPRESS-CONST suppresses the interpretation of constants in the 2691SUPPRESS-CONST suppresses the interpretation of constants in the
2679formula, assuming that this has been done already outside the function. 2692formula, assuming that this has been done already outside the
2680SUPPRESS-STORE means the formula should not be stored, either because 2693function.
2681it is already stored, or because it is a modified equation that should 2694
2682not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to 2695SUPPRESS-STORE means the formula should not be stored, either
2683`org-table-analyze'." 2696because it is already stored, or because it is a modified
2697equation that should not overwrite the stored one.
2698
2699SUPPRESS-ANALYSIS prevents analyzing the table and checking
2700location of point."
2684 (interactive "P") 2701 (interactive "P")
2685 (org-table-check-inside-data-field) 2702 (unless suppress-analysis
2686 (or suppress-analysis (org-table-analyze)) 2703 (org-table-check-inside-data-field)
2704 (org-table-analyze))
2687 (if (equal arg '(16)) 2705 (if (equal arg '(16))
2688 (let ((eq (org-table-current-field-formula))) 2706 (let ((eq (org-table-current-field-formula)))
2689 (org-table-get-field nil eq) 2707 (org-table-get-field nil eq)
@@ -2722,15 +2740,14 @@ not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to
2722 (?s . sci) (?e . eng)))) 2740 (?s . sci) (?e . eng))))
2723 n)))) 2741 n))))
2724 (setq fmt (replace-match "" t t fmt))) 2742 (setq fmt (replace-match "" t t fmt)))
2725 (if (string-match "T" fmt) 2743 (if (string-match "[tTU]" fmt)
2726 (setq duration t numbers t 2744 (let ((ff (match-string 0 fmt)))
2727 duration-output-format nil 2745 (setq duration t numbers t
2728 fmt (replace-match "" t t fmt))) 2746 duration-output-format
2729 (if (string-match "t" fmt) 2747 (cond ((equal ff "T") nil)
2730 (setq duration t 2748 ((equal ff "t") org-table-duration-custom-format)
2731 duration-output-format org-table-duration-custom-format 2749 ((equal ff "U") 'hh:mm))
2732 numbers t 2750 fmt (replace-match "" t t fmt))))
2733 fmt (replace-match "" t t fmt)))
2734 (if (string-match "N" fmt) 2751 (if (string-match "N" fmt)
2735 (setq numbers t 2752 (setq numbers t
2736 fmt (replace-match "" t t fmt))) 2753 fmt (replace-match "" t t fmt)))
@@ -2918,7 +2935,14 @@ $1-> %s\n" orig formula form0 form))
2918 (when (consp ev) (setq fmt nil ev "#ERROR")) 2935 (when (consp ev) (setq fmt nil ev "#ERROR"))
2919 (org-table-justify-field-maybe 2936 (org-table-justify-field-maybe
2920 (format org-table-formula-field-format 2937 (format org-table-formula-field-format
2921 (if fmt (format fmt (string-to-number ev)) ev))) 2938 (cond
2939 ((not (stringp ev)) ev)
2940 (fmt (format fmt (string-to-number ev)))
2941 ;; Replace any active time stamp in the result with
2942 ;; an inactive one. Dates in tables are likely
2943 ;; piece of regular data, not meant to appear in the
2944 ;; agenda.
2945 (t (replace-regexp-in-string org-ts-regexp "[\\1]" ev)))))
2922 (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) 2946 (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
2923 (call-interactively 'org-return) 2947 (call-interactively 'org-return)
2924 (setq ndown 0))) 2948 (setq ndown 0)))
@@ -3751,7 +3775,17 @@ minutes or seconds."
3751 (format "%.1f" (/ (float secs0) 60))) 3775 (format "%.1f" (/ (float secs0) 60)))
3752 ((eq output-format 'seconds) 3776 ((eq output-format 'seconds)
3753 (format "%d" secs0)) 3777 (format "%d" secs0))
3754 (t (format-seconds "%.2h:%.2m:%.2s" secs0))))) 3778 ((eq output-format 'hh:mm)
3779 ;; Ignore seconds
3780 (substring (format-seconds
3781 (if org-table-duration-hour-zero-padding
3782 "%.2h:%.2m:%.2s" "%h:%.2m:%.2s")
3783 secs0)
3784 0 -3))
3785 (t (format-seconds
3786 (if org-table-duration-hour-zero-padding
3787 "%.2h:%.2m:%.2s" "%h:%.2m:%.2s")
3788 secs0)))))
3755 (if (< secs 0) (concat "-" res) res))) 3789 (if (< secs 0) (concat "-" res) res)))
3756 3790
3757(defun org-table-fedit-convert-buffer (function) 3791(defun org-table-fedit-convert-buffer (function)
@@ -4867,7 +4901,8 @@ This may be either a string or a function of two arguments:
4867 ;; Initialize communication channel in INFO. 4901 ;; Initialize communication channel in INFO.
4868 (with-temp-buffer 4902 (with-temp-buffer
4869 (let ((org-inhibit-startup t)) (org-mode)) 4903 (let ((org-inhibit-startup t)) (org-mode))
4870 (let ((standard-output (current-buffer))) 4904 (let ((standard-output (current-buffer))
4905 (org-element-use-cache nil))
4871 (dolist (e table) 4906 (dolist (e table)
4872 (cond ((eq e 'hline) (princ "|--\n")) 4907 (cond ((eq e 'hline) (princ "|--\n"))
4873 ((consp e) 4908 ((consp e)
@@ -4991,9 +5026,12 @@ information."
4991 ((plist-member params :hline) 5026 ((plist-member params :hline)
4992 (org-table--generic-apply (plist-get params :hline) ":hline")) 5027 (org-table--generic-apply (plist-get params :hline) ":hline"))
4993 (backend `(org-export-with-backend ',backend row nil info))) 5028 (backend `(org-export-with-backend ',backend row nil info)))
4994 (let ((headerp (org-export-table-row-in-header-p row info)) 5029 (let ((headerp ,(and (or hlfmt hlstart hlend)
4995 (lastp (not (org-export-get-next-element row info))) 5030 '(org-export-table-row-in-header-p row info)))
4996 (last-header-p (org-export-table-row-ends-header-p row info))) 5031 (last-header-p
5032 ,(and (or hllfmt hllstart hllend)
5033 '(org-export-table-row-ends-header-p row info)))
5034 (lastp (not (org-export-get-next-element row info))))
4997 (when contents 5035 (when contents
4998 ;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or 5036 ;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or
4999 ;; `:hllfmt' to CONTENTS. Otherwise, fallback on 5037 ;; `:hllfmt' to CONTENTS. Otherwise, fallback on
@@ -5070,25 +5108,33 @@ information."
5070 (sep (plist-get params :sep)) 5108 (sep (plist-get params :sep))
5071 (hsep (plist-get params :hsep))) 5109 (hsep (plist-get params :hsep)))
5072 `(lambda (cell contents info) 5110 `(lambda (cell contents info)
5073 (let ((headerp (org-export-table-row-in-header-p 5111 ;; Make sure that contents are exported as Org data when :raw
5074 (org-export-get-parent-element cell) info)) 5112 ;; parameter is non-nil.
5075 (column (1+ (cdr (org-export-table-cell-address cell info))))) 5113 ,(when (and backend (plist-get params :raw))
5076 ;; Make sure that contents are exported as Org data when :raw 5114 `(setq contents
5077 ;; parameter is non-nil. 5115 ;; Since we don't know what are the pseudo object
5078 ,(when (and backend (plist-get params :raw)) 5116 ;; types defined in backend, we cannot pass them to
5079 `(setq contents 5117 ;; `org-element-interpret-data'. As a consequence,
5080 ;; Since we don't know what are the pseudo object 5118 ;; they will be treated as pseudo elements, and will
5081 ;; types defined in backend, we cannot pass them to 5119 ;; have newlines appended instead of spaces.
5082 ;; `org-element-interpret-data'. As a consequence, 5120 ;; Therefore, we must make sure :post-blank value is
5083 ;; they will be treated as pseudo elements, and 5121 ;; really turned into spaces.
5084 ;; will have newlines appended instead of spaces. 5122 (replace-regexp-in-string
5085 ;; Therefore, we must make sure :post-blank value 5123 "\n" " "
5086 ;; is really turned into spaces. 5124 (org-trim
5087 (replace-regexp-in-string 5125 (org-element-interpret-data
5088 "\n" " " 5126 (org-element-contents cell))))))
5089 (org-trim 5127
5090 (org-element-interpret-data 5128 (let ((headerp ,(and (or hfmt hsep)
5091 (org-element-contents cell)))))) 5129 '(org-export-table-row-in-header-p
5130 (org-export-get-parent-element cell) info)))
5131 (column
5132 ;; Call costly `org-export-table-cell-address' only if
5133 ;; absolutely necessary, i.e., if one
5134 ;; of :fmt :efmt :hmft has a "plist type" value.
5135 ,(and (cl-some (lambda (v) (integerp (car-safe v)))
5136 (list efmt hfmt fmt))
5137 '(1+ (cdr (org-export-table-cell-address cell info))))))
5092 (when contents 5138 (when contents
5093 ;; Check if we can apply `:efmt' on CONTENTS. 5139 ;; Check if we can apply `:efmt' on CONTENTS.
5094 ,(when efmt 5140 ,(when efmt
diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el
index 88dc1a85009..5acf526f183 100644
--- a/lisp/org/org-timer.el
+++ b/lisp/org/org-timer.el
@@ -436,7 +436,7 @@ using three `C-u' prefix arguments."
436 (if (numberp org-timer-default-timer) 436 (if (numberp org-timer-default-timer)
437 (number-to-string org-timer-default-timer) 437 (number-to-string org-timer-default-timer)
438 org-timer-default-timer)) 438 org-timer-default-timer))
439 (effort-minutes (ignore-errors (org-get-at-eol 'effort-minutes 1))) 439 (effort-minutes (ignore-errors (floor (org-get-at-eol 'effort-minutes 1))))
440 (minutes (or (and (numberp opt) (number-to-string opt)) 440 (minutes (or (and (numberp opt) (number-to-string opt))
441 (and (not (equal opt '(64))) 441 (and (not (equal opt '(64)))
442 effort-minutes 442 effort-minutes
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 182290a707e..523afd1ad33 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -5,13 +5,13 @@
5(defun org-release () 5(defun org-release ()
6 "The release version of Org. 6 "The release version of Org.
7Inserted by installing Org mode or when a release is made." 7Inserted by installing Org mode or when a release is made."
8 (let ((org-release "9.0.10")) 8 (let ((org-release "9.1.1"))
9 org-release)) 9 org-release))
10;;;###autoload 10;;;###autoload
11(defun org-git-version () 11(defun org-git-version ()
12 "The Git version of org-mode. 12 "The Git version of org-mode.
13Inserted by installing Org or when a release is made." 13Inserted by installing Org or when a release is made."
14 (let ((org-git-version "release_9.0.10")) 14 (let ((org-git-version "release_9.1.1-37-gb1e8b5"))
15 org-git-version)) 15 org-git-version))
16 16
17(provide 'org-version) 17(provide 'org-version)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index f8a2596ec62..c5759cb537b 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -130,6 +130,8 @@ Stars are put in group 1 and the trimmed body in group 2.")
130(declare-function org-clock-update-time-maybe "org-clock" ()) 130(declare-function org-clock-update-time-maybe "org-clock" ())
131(declare-function org-clocking-buffer "org-clock" ()) 131(declare-function org-clocking-buffer "org-clock" ())
132(declare-function org-clocktable-shift "org-clock" (dir n)) 132(declare-function org-clocktable-shift "org-clock" (dir n))
133(declare-function
134 org-duration-from-minutes "org-duration" (minutes &optional fmt canonical))
133(declare-function org-element-at-point "org-element" ()) 135(declare-function org-element-at-point "org-element" ())
134(declare-function org-element-cache-refresh "org-element" (pos)) 136(declare-function org-element-cache-refresh "org-element" (pos))
135(declare-function org-element-cache-reset "org-element" (&optional all)) 137(declare-function org-element-cache-reset "org-element" (&optional all))
@@ -169,6 +171,9 @@ Stars are put in group 1 and the trimmed body in group 2.")
169(declare-function org-table-next-row "org-table" ()) 171(declare-function org-table-next-row "org-table" ())
170(declare-function org-table-paste-rectangle "org-table" ()) 172(declare-function org-table-paste-rectangle "org-table" ())
171(declare-function org-table-recalculate "org-table" (&optional all noalign)) 173(declare-function org-table-recalculate "org-table" (&optional all noalign))
174(declare-function
175 org-table-sort-lines "org-table"
176 (&optional with-case sorting-type getkey-func compare-func interactive?))
172(declare-function org-table-wrap-region "org-table" (arg)) 177(declare-function org-table-wrap-region "org-table" (arg))
173(declare-function org-tags-view "org-agenda" (&optional todo-only match)) 178(declare-function org-tags-view "org-agenda" (&optional todo-only match))
174(declare-function orgtbl-ascii-plot "org-table" (&optional ask)) 179(declare-function orgtbl-ascii-plot "org-table" (&optional ask))
@@ -177,6 +182,8 @@ Stars are put in group 1 and the trimmed body in group 2.")
177(declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist)) 182(declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist))
178(declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?)) 183(declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?))
179 184
185(defvar ffap-url-regexp) ;Silence byte-compiler
186
180(defsubst org-uniquify (list) 187(defsubst org-uniquify (list)
181 "Non-destructively remove duplicate elements from LIST." 188 "Non-destructively remove duplicate elements from LIST."
182 (let ((res (copy-sequence list))) (delete-dups res))) 189 (let ((res (copy-sequence list))) (delete-dups res)))
@@ -265,11 +272,13 @@ requirements) is loaded."
265 (const :tag "CSS" css) 272 (const :tag "CSS" css)
266 (const :tag "Ditaa" ditaa) 273 (const :tag "Ditaa" ditaa)
267 (const :tag "Dot" dot) 274 (const :tag "Dot" dot)
275 (const :tag "Ebnf2ps" ebnf2ps)
268 (const :tag "Emacs Lisp" emacs-lisp) 276 (const :tag "Emacs Lisp" emacs-lisp)
269 (const :tag "Forth" forth) 277 (const :tag "Forth" forth)
270 (const :tag "Fortran" fortran) 278 (const :tag "Fortran" fortran)
271 (const :tag "Gnuplot" gnuplot) 279 (const :tag "Gnuplot" gnuplot)
272 (const :tag "Haskell" haskell) 280 (const :tag "Haskell" haskell)
281 (const :tag "hledger" hledger)
273 (const :tag "IO" io) 282 (const :tag "IO" io)
274 (const :tag "J" J) 283 (const :tag "J" J)
275 (const :tag "Java" java) 284 (const :tag "Java" java)
@@ -299,7 +308,7 @@ requirements) is loaded."
299 (const :tag "Sql" sql) 308 (const :tag "Sql" sql)
300 (const :tag "Sqlite" sqlite) 309 (const :tag "Sqlite" sqlite)
301 (const :tag "Stan" stan) 310 (const :tag "Stan" stan)
302 (const :tag "ebnf2ps" ebnf2ps)) 311 (const :tag "Vala" vala))
303 :value-type (boolean :tag "Activate" :value t))) 312 :value-type (boolean :tag "Activate" :value t)))
304 313
305;;;; Customization variables 314;;;; Customization variables
@@ -526,11 +535,12 @@ but the stars and the body are.")
526An archived subtree does not open during visibility cycling, and does 535An archived subtree does not open during visibility cycling, and does
527not contribute to the agenda listings.") 536not contribute to the agenda listings.")
528 537
529(defconst org-comment-string "COMMENT" 538(eval-and-compile
530 "Entries starting with this keyword will never be exported. 539 (defconst org-comment-string "COMMENT"
540 "Entries starting with this keyword will never be exported.
531\\<org-mode-map> 541\\<org-mode-map>
532An entry can be toggled between COMMENT and normal with 542An entry can be toggled between COMMENT and normal with
533`\\[org-toggle-comment]'.") 543`\\[org-toggle-comment]'."))
534 544
535 545
536;;;; LaTeX Environments and Fragments 546;;;; LaTeX Environments and Fragments
@@ -713,7 +723,6 @@ For export specific modules, see also `org-export-backends'."
713 723
714 (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) 724 (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
715 (const :tag "C bookmark: Org links to bookmarks" org-bookmark) 725 (const :tag "C bookmark: Org links to bookmarks" org-bookmark)
716 (const :tag "C bullets: Add overlays to headlines stars" org-bullets)
717 (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) 726 (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
718 (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) 727 (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
719 (const :tag "C collector: Collect properties into tables" org-collector) 728 (const :tag "C collector: Collect properties into tables" org-collector)
@@ -1725,37 +1734,6 @@ This also applied for speedbar access."
1725 :tag "Org Table" 1734 :tag "Org Table"
1726 :group 'org) 1735 :group 'org)
1727 1736
1728(defcustom org-enable-table-editor 'optimized
1729 "Non-nil means lines starting with \"|\" are handled by the table editor.
1730When nil, such lines will be treated like ordinary lines.
1731
1732When equal to the symbol `optimized', the table editor will be optimized to
1733do the following:
1734- Automatic overwrite mode in front of whitespace in table fields.
1735 This makes the structure of the table stay in tact as long as the edited
1736 field does not exceed the column width.
1737- Minimize the number of realigns. Normally, the table is aligned each time
1738 TAB or RET are pressed to move to another field. With optimization this
1739 happens only if changes to a field might have changed the column width.
1740Optimization requires replacing the functions `self-insert-command',
1741`delete-char', and `backward-delete-char' in Org buffers, with a
1742slight (in fact: unnoticeable) speed impact for normal typing. Org is very
1743good at guessing when a re-align will be necessary, but you can always
1744force one with `\\[org-ctrl-c-ctrl-c]'.
1745
1746If you would like to use the optimized version in Org mode, but the
1747un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
1748
1749This variable can be used to turn on and off the table editor during a session,
1750but in order to toggle optimization, a restart is required.
1751
1752See also the variable `org-table-auto-blank-field'."
1753 :group 'org-table
1754 :type '(choice
1755 (const :tag "off" nil)
1756 (const :tag "on" t)
1757 (const :tag "on, optimized" optimized)))
1758
1759(defcustom org-self-insert-cluster-for-undo nil 1737(defcustom org-self-insert-cluster-for-undo nil
1760 "Non-nil means cluster self-insert commands for undo when possible. 1738 "Non-nil means cluster self-insert commands for undo when possible.
1761If this is set, then, like in the Emacs command loop, 20 consecutive 1739If this is set, then, like in the Emacs command loop, 20 consecutive
@@ -1789,7 +1767,6 @@ The value of this is taken from the #+LINK lines.")
1789 ("http" :follow (lambda (path) (browse-url (concat "http:" path)))) 1767 ("http" :follow (lambda (path) (browse-url (concat "http:" path))))
1790 ("https" :follow (lambda (path) (browse-url (concat "https:" path)))) 1768 ("https" :follow (lambda (path) (browse-url (concat "https:" path))))
1791 ("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path)))) 1769 ("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path))))
1792 ("message" :follow (lambda (path) (browse-url (concat "message:" path))))
1793 ("news" :follow (lambda (path) (browse-url (concat "news:" path)))) 1770 ("news" :follow (lambda (path) (browse-url (concat "news:" path))))
1794 ("shell" :follow org--open-shell-link)) 1771 ("shell" :follow org--open-shell-link))
1795 "An alist of properties that defines all the links in Org mode. 1772 "An alist of properties that defines all the links in Org mode.
@@ -1830,7 +1807,9 @@ activation. The function must accept (link-start link-end path bracketp)
1830as arguments." 1807as arguments."
1831 :group 'org-link 1808 :group 'org-link
1832 :type '(alist :tag "Link display parameters" 1809 :type '(alist :tag "Link display parameters"
1833 :value-type plist)) 1810 :value-type plist)
1811 :version "26.1"
1812 :package-version '(Org . "9.1"))
1834 1813
1835(defun org-link-get-parameter (type key) 1814(defun org-link-get-parameter (type key)
1836 "Get TYPE link property for KEY. 1815 "Get TYPE link property for KEY.
@@ -1949,10 +1928,10 @@ in the Org buffer so that the change takes effect."
1949 1928
1950(defcustom org-make-link-description-function nil 1929(defcustom org-make-link-description-function nil
1951 "Function to use for generating link descriptions from links. 1930 "Function to use for generating link descriptions from links.
1952When nil, the link location will be used. This function must take 1931This function must take two parameters: the first one is the
1953two parameters: the first one is the link, the second one is the 1932link, the second one is the description generated by
1954description generated by `org-insert-link'. The function should 1933`org-insert-link'. The function should return the description to
1955return the description to use." 1934use."
1956 :group 'org-link 1935 :group 'org-link
1957 :type '(choice (const nil) (function))) 1936 :type '(choice (const nil) (function)))
1958 1937
@@ -2074,7 +2053,7 @@ In tables, the special behavior of RET has precedence."
2074A longer mouse click will still set point. Needs to be set 2053A longer mouse click will still set point. Needs to be set
2075before org.el is loaded." 2054before org.el is loaded."
2076 :group 'org-link-follow 2055 :group 'org-link-follow
2077 :version "24.4" 2056 :version "26.1"
2078 :package-version '(Org . "8.3") 2057 :package-version '(Org . "8.3")
2079 :type '(choice 2058 :type '(choice
2080 (const :tag "A double click follows the link" double) 2059 (const :tag "A double click follows the link" double)
@@ -2554,13 +2533,16 @@ When the value is `file', also include the file name (without directory)
2554into the path. In this case, you can also stop the completion after 2533into the path. In this case, you can also stop the completion after
2555the file name, to get entries inserted as top level in the file. 2534the file name, to get entries inserted as top level in the file.
2556 2535
2557When `full-file-path', include the full file path." 2536When `full-file-path', include the full file path.
2537
2538When `buffer-name', use the buffer name."
2558 :group 'org-refile 2539 :group 'org-refile
2559 :type '(choice 2540 :type '(choice
2560 (const :tag "Not" nil) 2541 (const :tag "Not" nil)
2561 (const :tag "Yes" t) 2542 (const :tag "Yes" t)
2562 (const :tag "Start with file name" file) 2543 (const :tag "Start with file name" file)
2563 (const :tag "Start with full file path" full-file-path))) 2544 (const :tag "Start with full file path" full-file-path)
2545 (const :tag "Start with buffer name" buffer-name)))
2564 2546
2565(defcustom org-outline-path-complete-in-steps t 2547(defcustom org-outline-path-complete-in-steps t
2566 "Non-nil means complete the outline path in hierarchical steps. 2548 "Non-nil means complete the outline path in hierarchical steps.
@@ -3252,135 +3234,6 @@ commands, if custom time display is turned on at the time of export."
3252 (concat "[" (substring f 1 -1) "]") 3234 (concat "[" (substring f 1 -1) "]")
3253 f))) 3235 f)))
3254 3236
3255(defcustom org-time-clocksum-format
3256 '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t)
3257 "The format string used when creating CLOCKSUM lines.
3258This is also used when Org mode generates a time duration.
3259
3260The value can be a single format string containing two
3261%-sequences, which will be filled with the number of hours and
3262minutes in that order.
3263
3264Alternatively, the value can be a plist associating any of the
3265keys :years, :months, :weeks, :days, :hours or :minutes with
3266format strings. The time duration is formatted using only the
3267time components that are needed and concatenating the results.
3268If a time unit in absent, it falls back to the next smallest
3269unit.
3270
3271The keys :require-years, :require-months, :require-days,
3272:require-weeks, :require-hours, :require-minutes are also
3273meaningful. A non-nil value for these keys indicates that the
3274corresponding time component should always be included, even if
3275its value is 0.
3276
3277
3278For example,
3279
3280 (:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\"
3281 :require-minutes t)
3282
3283means durations longer than a day will be expressed in days,
3284hours and minutes, and durations less than a day will always be
3285expressed in hours and minutes (even for durations less than an
3286hour).
3287
3288The value
3289
3290 (:days \"%dd\" :minutes \"%dm\")
3291
3292means durations longer than a day will be expressed in days and
3293minutes, and durations less than a day will be expressed entirely
3294in minutes (even for durations longer than an hour)."
3295 :group 'org-time
3296 :group 'org-clock
3297 :version "24.4"
3298 :package-version '(Org . "8.0")
3299 :type '(choice (string :tag "Format string")
3300 (set :tag "Plist"
3301 (group :inline t (const :tag "Years" :years)
3302 (string :tag "Format string"))
3303 (group :inline t
3304 (const :tag "Always show years" :require-years)
3305 (const t))
3306 (group :inline t (const :tag "Months" :months)
3307 (string :tag "Format string"))
3308 (group :inline t
3309 (const :tag "Always show months" :require-months)
3310 (const t))
3311 (group :inline t (const :tag "Weeks" :weeks)
3312 (string :tag "Format string"))
3313 (group :inline t
3314 (const :tag "Always show weeks" :require-weeks)
3315 (const t))
3316 (group :inline t (const :tag "Days" :days)
3317 (string :tag "Format string"))
3318 (group :inline t
3319 (const :tag "Always show days" :require-days)
3320 (const t))
3321 (group :inline t (const :tag "Hours" :hours)
3322 (string :tag "Format string"))
3323 (group :inline t
3324 (const :tag "Always show hours" :require-hours)
3325 (const t))
3326 (group :inline t (const :tag "Minutes" :minutes)
3327 (string :tag "Format string"))
3328 (group :inline t
3329 (const :tag "Always show minutes" :require-minutes)
3330 (const t)))))
3331
3332(defcustom org-time-clocksum-use-fractional nil
3333 "When non-nil, `\\[org-clock-display]' uses fractional times.
3334See `org-time-clocksum-format' for more on time clock formats."
3335 :group 'org-time
3336 :group 'org-clock
3337 :version "24.3"
3338 :type 'boolean)
3339
3340(defcustom org-time-clocksum-use-effort-durations nil
3341 "When non-nil, `\\[org-clock-display]' uses effort durations.
3342E.g. by default, one day is considered to be a 8 hours effort,
3343so a task that has been clocked for 16 hours will be displayed
3344as during 2 days in the clock display or in the clocktable.
3345
3346See `org-effort-durations' on how to set effort durations
3347and `org-time-clocksum-format' for more on time clock formats."
3348 :group 'org-time
3349 :group 'org-clock
3350 :version "24.4"
3351 :package-version '(Org . "8.0")
3352 :type 'boolean)
3353
3354(defcustom org-time-clocksum-fractional-format "%.2f"
3355 "The format string used when creating CLOCKSUM lines,
3356or when Org mode generates a time duration, if
3357`org-time-clocksum-use-fractional' is enabled.
3358
3359The value can be a single format string containing one
3360%-sequence, which will be filled with the number of hours as
3361a float.
3362
3363Alternatively, the value can be a plist associating any of the
3364keys :years, :months, :weeks, :days, :hours or :minutes with
3365a format string. The time duration is formatted using the
3366largest time unit which gives a non-zero integer part. If all
3367specified formats have zero integer part, the smallest time unit
3368is used."
3369 :group 'org-time
3370 :type '(choice (string :tag "Format string")
3371 (set (group :inline t (const :tag "Years" :years)
3372 (string :tag "Format string"))
3373 (group :inline t (const :tag "Months" :months)
3374 (string :tag "Format string"))
3375 (group :inline t (const :tag "Weeks" :weeks)
3376 (string :tag "Format string"))
3377 (group :inline t (const :tag "Days" :days)
3378 (string :tag "Format string"))
3379 (group :inline t (const :tag "Hours" :hours)
3380 (string :tag "Format string"))
3381 (group :inline t (const :tag "Minutes" :minutes)
3382 (string :tag "Format string")))))
3383
3384(defcustom org-deadline-warning-days 14 3237(defcustom org-deadline-warning-days 14
3385 "Number of days before expiration during which a deadline becomes active. 3238 "Number of days before expiration during which a deadline becomes active.
3386This variable governs the display in sparse trees and in the agenda. 3239This variable governs the display in sparse trees and in the agenda.
@@ -3795,7 +3648,7 @@ and the clock summary:
3795 3648
3796 ((\"Remaining\" (lambda(value) 3649 ((\"Remaining\" (lambda(value)
3797 (let ((clocksum (org-clock-sum-current-item)) 3650 (let ((clocksum (org-clock-sum-current-item))
3798 (effort (org-duration-string-to-minutes 3651 (effort (org-duration-to-minutes
3799 (org-entry-get (point) \"Effort\")))) 3652 (org-entry-get (point) \"Effort\"))))
3800 (org-minutes-to-clocksum-string (- effort clocksum))))))" 3653 (org-minutes-to-clocksum-string (- effort clocksum))))))"
3801 :group 'org-properties 3654 :group 'org-properties
@@ -4470,8 +4323,10 @@ After a match, the match groups contain these elements:
44703 The leading marker like * or /, indicating the type of highlighting 43233 The leading marker like * or /, indicating the type of highlighting
44714 The text between the emphasis markers, not including the markers 43244 The text between the emphasis markers, not including the markers
44725 The character after the match, empty at the end of a line") 43255 The character after the match, empty at the end of a line")
4326
4473(defvar org-verbatim-re nil 4327(defvar org-verbatim-re nil
4474 "Regular expression for matching verbatim text.") 4328 "Regular expression for matching verbatim text.")
4329
4475(defvar org-emphasis-regexp-components) ; defined just below 4330(defvar org-emphasis-regexp-components) ; defined just below
4476(defvar org-emphasis-alist) ; defined just below 4331(defvar org-emphasis-alist) ; defined just below
4477(defun org-set-emph-re (var val) 4332(defun org-set-emph-re (var val)
@@ -4480,60 +4335,23 @@ After a match, the match groups contain these elements:
4480 (when (and (boundp 'org-emphasis-alist) 4335 (when (and (boundp 'org-emphasis-alist)
4481 (boundp 'org-emphasis-regexp-components) 4336 (boundp 'org-emphasis-regexp-components)
4482 org-emphasis-alist org-emphasis-regexp-components) 4337 org-emphasis-alist org-emphasis-regexp-components)
4483 (let* ((e org-emphasis-regexp-components) 4338 (pcase-let*
4484 (pre (car e)) 4339 ((`(,pre ,post ,border ,body ,nl) org-emphasis-regexp-components)
4485 (post (nth 1 e)) 4340 (body (if (<= nl 0) body
4486 (border (nth 2 e)) 4341 (format "%s*?\\(?:\n%s*?\\)\\{0,%d\\}" body body nl)))
4487 (body (nth 3 e)) 4342 (template
4488 (nl (nth 4 e)) 4343 (format (concat "\\([%s]\\|^\\)" ;before markers
4489 (body1 (concat body "*?")) 4344 "\\(\\([%%s]\\)\\([^%s]\\|[^%s]%s[^%s]\\)\\3\\)"
4490 (markers (mapconcat 'car org-emphasis-alist "")) 4345 "\\([%s]\\|$\\)") ;after markers
4491 (vmarkers (mapconcat 4346 pre border border body border post)))
4492 (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) "")) 4347 (setq org-emph-re (format template "*/_+"))
4493 org-emphasis-alist ""))) 4348 (setq org-verbatim-re (format template "=~")))))
4494 ;; make sure special characters appear at the right position in the class
4495 (if (string-match "\\^" markers)
4496 (setq markers (concat (replace-match "" t t markers) "^")))
4497 (if (string-match "-" markers)
4498 (setq markers (concat (replace-match "" t t markers) "-")))
4499 (if (string-match "\\^" vmarkers)
4500 (setq vmarkers (concat (replace-match "" t t vmarkers) "^")))
4501 (if (string-match "-" vmarkers)
4502 (setq vmarkers (concat (replace-match "" t t vmarkers) "-")))
4503 (if (> nl 0)
4504 (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0,"
4505 (int-to-string nl) "\\}")))
4506 ;; Make the regexp
4507 (setq org-emph-re
4508 (concat "\\([" pre "]\\|^\\)"
4509 "\\("
4510 "\\([" markers "]\\)"
4511 "\\("
4512 "[^" border "]\\|"
4513 "[^" border "]"
4514 body1
4515 "[^" border "]"
4516 "\\)"
4517 "\\3\\)"
4518 "\\([" post "]\\|$\\)"))
4519 (setq org-verbatim-re
4520 (concat "\\([" pre "]\\|^\\)"
4521 "\\("
4522 "\\([" vmarkers "]\\)"
4523 "\\("
4524 "[^" border "]\\|"
4525 "[^" border "]"
4526 body1
4527 "[^" border "]"
4528 "\\)"
4529 "\\3\\)"
4530 "\\([" post "]\\|$\\)")))))
4531 4349
4532;; This used to be a defcustom (Org <8.0) but allowing the users to 4350;; This used to be a defcustom (Org <8.0) but allowing the users to
4533;; set this option proved cumbersome. See this message/thread: 4351;; set this option proved cumbersome. See this message/thread:
4534;; http://article.gmane.org/gmane.emacs.orgmode/68681 4352;; http://article.gmane.org/gmane.emacs.orgmode/68681
4535(defvar org-emphasis-regexp-components 4353(defvar org-emphasis-regexp-components
4536 '(" \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1) 4354 '("- \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1)
4537 "Components used to build the regular expression for emphasis. 4355 "Components used to build the regular expression for emphasis.
4538This is a list with five entries. Terminology: In an emphasis string 4356This is a list with five entries. Terminology: In an emphasis string
4539like \" *strong word* \", we call the initial space PREMATCH, the final 4357like \" *strong word* \", we call the initial space PREMATCH, the final
@@ -4647,32 +4465,24 @@ This is needed for font-lock setup.")
4647 4465
4648(defun org-at-table-p (&optional table-type) 4466(defun org-at-table-p (&optional table-type)
4649 "Non-nil if the cursor is inside an Org table. 4467 "Non-nil if the cursor is inside an Org table.
4650If TABLE-TYPE is non-nil, also check for table.el-type tables. 4468If TABLE-TYPE is non-nil, also check for table.el-type tables."
4651If `org-enable-table-editor' is nil, return nil unconditionally." 4469 (and (org-match-line (if table-type "[ \t]*[|+]" "[ \t]*|"))
4652 (and 4470 (or (not (derived-mode-p 'org-mode))
4653 org-enable-table-editor 4471 (let ((e (org-element-lineage (org-element-at-point) '(table) t)))
4654 (save-excursion 4472 (and e (or table-type
4655 (beginning-of-line) 4473 (eq 'org (org-element-property :type e))))))))
4656 (looking-at-p (if table-type "[ \t]*[|+]" "[ \t]*|")))
4657 (or (not (derived-mode-p 'org-mode))
4658 (let ((e (org-element-lineage (org-element-at-point) '(table) t)))
4659 (and e (or table-type (eq (org-element-property :type e) 'org)))))))
4660 4474
4661(defun org-at-table.el-p () 4475(defun org-at-table.el-p ()
4662 "Non-nil when point is at a table.el table." 4476 "Non-nil when point is at a table.el table."
4663 (and (save-excursion (beginning-of-line) (looking-at "[ \t]*[|+]")) 4477 (and (org-match-line "[ \t]*[|+]")
4664 (let ((element (org-element-at-point))) 4478 (let ((element (org-element-at-point)))
4665 (and (eq (org-element-type element) 'table) 4479 (and (eq (org-element-type element) 'table)
4666 (eq (org-element-property :type element) 'table.el))))) 4480 (eq (org-element-property :type element) 'table.el)))))
4667 4481
4668(defun org-at-table-hline-p () 4482(defun org-at-table-hline-p ()
4669 "Non-nil when point is inside a hline in a table. 4483 "Non-nil when point is inside a hline in a table.
4670Assume point is already in a table. If `org-enable-table-editor' 4484Assume point is already in a table."
4671is nil, return nil unconditionally." 4485 (org-match-line org-table-hline-regexp))
4672 (and org-enable-table-editor
4673 (save-excursion
4674 (beginning-of-line)
4675 (looking-at org-table-hline-regexp))))
4676 4486
4677(defun org-table-map-tables (function &optional quietly) 4487(defun org-table-map-tables (function &optional quietly)
4678 "Apply FUNCTION to the start of all tables in the buffer." 4488 "Apply FUNCTION to the start of all tables in the buffer."
@@ -5275,7 +5085,7 @@ Return value contains the following keys: `archive', `category',
5275 ((equal key "CONSTANTS") 5085 ((equal key "CONSTANTS")
5276 (let* ((constants (assq 'constants alist)) 5086 (let* ((constants (assq 'constants alist))
5277 (store (cdr constants))) 5087 (store (cdr constants)))
5278 (dolist (pair (org-split-string value)) 5088 (dolist (pair (split-string value))
5279 (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" 5089 (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)"
5280 pair) 5090 pair)
5281 (let* ((name (match-string 1 pair)) 5091 (let* ((name (match-string 1 pair))
@@ -5290,7 +5100,7 @@ Return value contains the following keys: `archive', `category',
5290 (let ((old (assq 'filetags alist)) 5100 (let ((old (assq 'filetags alist))
5291 (new (apply #'nconc 5101 (new (apply #'nconc
5292 (mapcar (lambda (x) (org-split-string x ":")) 5102 (mapcar (lambda (x) (org-split-string x ":"))
5293 (org-split-string value))))) 5103 (split-string value)))))
5294 (if old (setcdr old (append new (cdr old))) 5104 (if old (setcdr old (append new (cdr old)))
5295 (push (cons 'filetags new) alist))))) 5105 (push (cons 'filetags new) alist)))))
5296 ((equal key "LINK") 5106 ((equal key "LINK")
@@ -5306,7 +5116,7 @@ Return value contains the following keys: `archive', `category',
5306 (push (cons 'scripts (read (match-string 1 value))) alist))) 5116 (push (cons 'scripts (read (match-string 1 value))) alist)))
5307 ((equal key "PRIORITIES") 5117 ((equal key "PRIORITIES")
5308 (push (cons 'priorities 5118 (push (cons 'priorities
5309 (let ((prio (org-split-string value))) 5119 (let ((prio (split-string value)))
5310 (if (< (length prio) 3) '(?A ?C ?B) 5120 (if (< (length prio) 3) '(?A ?C ?B)
5311 (mapcar #'string-to-char prio)))) 5121 (mapcar #'string-to-char prio))))
5312 alist)) 5122 alist))
@@ -5323,8 +5133,8 @@ Return value contains the following keys: `archive', `category',
5323 (let ((startup (assq 'startup alist))) 5133 (let ((startup (assq 'startup alist)))
5324 (if startup 5134 (if startup
5325 (setcdr startup 5135 (setcdr startup
5326 (append (cdr startup) (org-split-string value))) 5136 (append (cdr startup) (split-string value)))
5327 (push (cons 'startup (org-split-string value)) alist)))) 5137 (push (cons 'startup (split-string value)) alist))))
5328 ((equal key "TAGS") 5138 ((equal key "TAGS")
5329 (let ((tag-cell (assq 'tags alist))) 5139 (let ((tag-cell (assq 'tags alist)))
5330 (if tag-cell 5140 (if tag-cell
@@ -5333,7 +5143,7 @@ Return value contains the following keys: `archive', `category',
5333 ((member key '("TODO" "SEQ_TODO" "TYP_TODO")) 5143 ((member key '("TODO" "SEQ_TODO" "TYP_TODO"))
5334 (let ((todo (assq 'todo alist)) 5144 (let ((todo (assq 'todo alist))
5335 (value (cons (if (equal key "TYP_TODO") 'type 'sequence) 5145 (value (cons (if (equal key "TYP_TODO") 'type 'sequence)
5336 (org-split-string value)))) 5146 (split-string value))))
5337 (if todo (push value (cdr todo)) 5147 (if todo (push value (cdr todo))
5338 (push (list 'todo value) alist)))) 5148 (push (list 'todo value) alist))))
5339 ((equal key "SETUPFILE") 5149 ((equal key "SETUPFILE")
@@ -5441,17 +5251,62 @@ a string, summarizing TAGS, as a list of strings."
5441 (setq current-group (list tag)))) 5251 (setq current-group (list tag))))
5442 (_ nil))))) 5252 (_ nil)))))
5443 5253
5444(defun org-file-contents (file &optional noerror) 5254(defvar org--file-cache (make-hash-table :test #'equal)
5445 "Return the contents of FILE, as a string." 5255 "Hash table to store contents of files referenced via a URL.
5446 (if (and file (file-readable-p file)) 5256This is the cache of file URLs read using `org-file-contents'.")
5257
5258(defun org-reset-file-cache ()
5259 "Reset the cache of files downloaded by `org-file-contents'."
5260 (clrhash org--file-cache))
5261
5262(defun org-file-url-p (file)
5263 "Non-nil if FILE is a URL."
5264 (require 'ffap)
5265 (string-match-p ffap-url-regexp file))
5266
5267(defun org-file-contents (file &optional noerror nocache)
5268 "Return the contents of FILE, as a string.
5269
5270FILE can be a file name or URL.
5271
5272If FILE is a URL, download the contents. If the URL contents are
5273already cached in the `org--file-cache' hash table, the download step
5274is skipped.
5275
5276If NOERROR is non-nil, ignore the error when unable to read the FILE
5277from file or URL.
5278
5279If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version
5280is available. This option applies only if FILE is a URL."
5281 (let* ((is-url (org-file-url-p file))
5282 (cache (and is-url
5283 (not nocache)
5284 (gethash file org--file-cache))))
5285 (cond
5286 (cache)
5287 (is-url
5288 (with-current-buffer (url-retrieve-synchronously file)
5289 (goto-char (point-min))
5290 ;; Move point to after the url-retrieve header.
5291 (search-forward "\n\n" nil :move)
5292 ;; Search for the success code only in the url-retrieve header.
5293 (if (save-excursion (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror))
5294 ;; Update the cache `org--file-cache' and return contents.
5295 (puthash file
5296 (buffer-substring-no-properties (point) (point-max))
5297 org--file-cache)
5298 (funcall (if noerror #'message #'user-error)
5299 "Unable to fetch file from %S"
5300 file))))
5301 (t
5447 (with-temp-buffer 5302 (with-temp-buffer
5448 (insert-file-contents file) 5303 (condition-case err
5449 (buffer-string)) 5304 (progn
5450 (funcall (if noerror 'message 'error) 5305 (insert-file-contents file)
5451 "Cannot read file \"%s\"%s" 5306 (buffer-string))
5452 file 5307 (file-error
5453 (let ((from (buffer-file-name (buffer-base-buffer)))) 5308 (funcall (if noerror #'message #'user-error)
5454 (if from (concat " (referenced in file \"" from "\")") ""))))) 5309 (error-message-string err)))))))))
5455 5310
5456(defun org-extract-log-state-settings (x) 5311(defun org-extract-log-state-settings (x)
5457 "Extract the log state setting from a TODO keyword string. 5312 "Extract the log state setting from a TODO keyword string.
@@ -5697,10 +5552,13 @@ The following commands are available:
5697 5552
5698;; Update `customize-package-emacs-version-alist' 5553;; Update `customize-package-emacs-version-alist'
5699(add-to-list 'customize-package-emacs-version-alist 5554(add-to-list 'customize-package-emacs-version-alist
5700 '(Org ("6.21b" . "23.1") ("6.33x" . "23.2") 5555 '(Org ("8.0" . "24.4")
5701 ("7.8.11" . "24.1") ("7.9.4" . "24.3") 5556 ("8.1" . "24.4")
5702 ("8.2.6" . "24.4") ("8.2.10" . "24.5") 5557 ("8.2" . "24.4")
5703 ("9.0" . "26.1"))) 5558 ("8.2.7" . "24.4")
5559 ("8.3" . "26.1")
5560 ("9.0" . "26.1")
5561 ("9.1" . "26.1")))
5704 5562
5705(defvar org-mode-transpose-word-syntax-table 5563(defvar org-mode-transpose-word-syntax-table
5706 (let ((st (make-syntax-table text-mode-syntax-table))) 5564 (let ((st (make-syntax-table text-mode-syntax-table)))
@@ -5884,32 +5742,40 @@ This should be called after the variable `org-link-parameters' has changed."
5884 5742
5885(defun org-do-emphasis-faces (limit) 5743(defun org-do-emphasis-faces (limit)
5886 "Run through the buffer and emphasize strings." 5744 "Run through the buffer and emphasize strings."
5887 (let (rtn a) 5745 (let ((quick-re (format "\\([%s]\\|^\\)\\([~=*/_+]\\)"
5888 (while (and (not rtn) (re-search-forward org-emph-re limit t)) 5746 (car org-emphasis-regexp-components))))
5889 (let* ((border (char-after (match-beginning 3))) 5747 (catch :exit
5890 (bre (regexp-quote (char-to-string border)))) 5748 (while (re-search-forward quick-re limit t)
5891 (when (and (not (= border (char-after (match-beginning 4)))) 5749 (let* ((marker (match-string 2))
5892 (not (string-match-p (concat bre ".*" bre) 5750 (verbatim? (member marker '("~" "="))))
5893 (replace-regexp-in-string 5751 (when (save-excursion
5894 "\n" " " 5752 (goto-char (match-beginning 0))
5895 (substring (match-string 2) 1 -1))))) 5753 ;; Do not match headline stars. Do not consider
5896 (setq rtn t) 5754 ;; stars of a headline as closing marker for bold
5897 (setq a (assoc (match-string 3) org-emphasis-alist)) 5755 ;; markup either. Do not match table hlines.
5898 (font-lock-prepend-text-property (match-beginning 2) (match-end 2) 5756 (and
5899 'face 5757 (not (looking-at-p org-outline-regexp-bol))
5900 (nth 1 a)) 5758 (not (and (equal marker "+")
5901 (and (nth 2 a) 5759 (org-match-line
5902 (org-remove-flyspell-overlays-in 5760 "^[ \t]*\\(|[-+]+|?\\|\\+[-+]+\\+\\)[ \t]*$")))
5903 (match-beginning 0) (match-end 0))) 5761 (looking-at (if verbatim? org-verbatim-re org-emph-re))
5904 (add-text-properties (match-beginning 2) (match-end 2) 5762 (not (string-match-p
5905 '(font-lock-multiline t org-emphasis t)) 5763 (concat org-outline-regexp-bol "\\'")
5906 (when org-hide-emphasis-markers 5764 (match-string 0)))))
5907 (add-text-properties (match-end 4) (match-beginning 5) 5765 (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist)))
5908 '(invisible org-link)) 5766 (font-lock-prepend-text-property
5909 (add-text-properties (match-beginning 3) (match-end 3) 5767 (match-beginning 2) (match-end 2) 'face face)
5910 '(invisible org-link))))) 5768 (when verbatim?
5911 (goto-char (1+ (match-beginning 0)))) 5769 (org-remove-flyspell-overlays-in
5912 rtn)) 5770 (match-beginning 0) (match-end 0)))
5771 (add-text-properties (match-beginning 2) (match-end 2)
5772 '(font-lock-multiline t org-emphasis t))
5773 (when org-hide-emphasis-markers
5774 (add-text-properties (match-end 4) (match-beginning 5)
5775 '(invisible org-link))
5776 (add-text-properties (match-beginning 3) (match-end 3)
5777 '(invisible org-link)))
5778 (throw :exit t))))))))
5913 5779
5914(defun org-emphasize (&optional char) 5780(defun org-emphasize (&optional char)
5915 "Insert or change an emphasis, i.e. a font like bold or italic. 5781 "Insert or change an emphasis, i.e. a font like bold or italic.
@@ -6040,7 +5906,7 @@ This includes angle, plain, and bracket links."
6040 "When non-nil, fontify code in code blocks. 5906 "When non-nil, fontify code in code blocks.
6041See also the `org-block' face." 5907See also the `org-block' face."
6042 :type 'boolean 5908 :type 'boolean
6043 :version "24.4" 5909 :version "26.1"
6044 :package-version '(Org . "8.3") 5910 :package-version '(Org . "8.3")
6045 :group 'org-appearance 5911 :group 'org-appearance
6046 :group 'org-babel) 5912 :group 'org-babel)
@@ -6752,17 +6618,13 @@ and subscripts."
6752 (nth (if table-p 3 1) org-script-display) 6618 (nth (if table-p 3 1) org-script-display)
6753 (nth (if table-p 2 0) org-script-display))) 6619 (nth (if table-p 2 0) org-script-display)))
6754 (add-text-properties (match-beginning 2) (match-end 2) 6620 (add-text-properties (match-beginning 2) (match-end 2)
6755 (list 'invisible t 6621 (list 'invisible t))
6756 'org-dwidth t 'org-dwidth-n 1)) 6622 (when (and (eq (char-after (match-beginning 3)) ?{)
6757 (if (and (eq (char-after (match-beginning 3)) ?{) 6623 (eq (char-before (match-end 3)) ?}))
6758 (eq (char-before (match-end 3)) ?})) 6624 (add-text-properties (match-beginning 3) (1+ (match-beginning 3))
6759 (progn 6625 (list 'invisible t))
6760 (add-text-properties 6626 (add-text-properties (1- (match-end 3)) (match-end 3)
6761 (match-beginning 3) (1+ (match-beginning 3)) 6627 (list 'invisible t))))
6762 (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))
6763 (add-text-properties
6764 (1- (match-end 3)) (match-end 3)
6765 (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))))
6766 t))) 6628 t)))
6767 6629
6768;;;; Visibility cycling, including org-goto and indirect buffer 6630;;;; Visibility cycling, including org-goto and indirect buffer
@@ -7837,15 +7699,38 @@ When NEXT is non-nil, check the next line instead."
7837When NEXT is non-nil, check the next line instead." 7699When NEXT is non-nil, check the next line instead."
7838 (org--line-empty-p 2)) 7700 (org--line-empty-p 2))
7839 7701
7702(defun org--blank-before-heading-p (&optional parent)
7703 "Non-nil when an empty line should precede a new heading here.
7704When optional argument PARENT is non-nil, consider parent
7705headline instead of current one."
7706 (pcase (assq 'heading org-blank-before-new-entry)
7707 (`(heading . auto)
7708 (save-excursion
7709 (org-with-limited-levels
7710 (unless (and (org-before-first-heading-p)
7711 (not (outline-next-heading)))
7712 (org-back-to-heading t)
7713 (when parent (org-up-heading-safe))
7714 (cond ((not (bobp))
7715 (org-previous-line-empty-p))
7716 ((outline-next-heading)
7717 (org-previous-line-empty-p))
7718 ;; Ignore trailing spaces on last buffer line.
7719 ((progn (skip-chars-backward " \t") (bolp))
7720 (org-previous-line-empty-p))
7721 (t nil))))))
7722 (`(heading . ,value) value)
7723 (_ nil)))
7724
7840(defun org-insert-heading (&optional arg invisible-ok top) 7725(defun org-insert-heading (&optional arg invisible-ok top)
7841 "Insert a new heading or an item with the same depth at point. 7726 "Insert a new heading or an item with the same depth at point.
7842 7727
7843If point is at the beginning of a heading or a list item, insert 7728If point is at the beginning of a heading, insert a new heading
7844a new heading or a new item above the current one. When at the 7729or a new headline above the current one. When at the beginning
7845beginning of a regular line of text, turn it into a heading. 7730of a regular line of text, turn it into a heading.
7846 7731
7847If point is in the middle of a line, split it and create a new 7732If point is in the middle of a line, split it and create a new
7848headline/item with the text in the current line after point (see 7733headline with the text in the current line after point (see
7849`org-M-RET-may-split-line' on how to modify this behavior). As 7734`org-M-RET-may-split-line' on how to modify this behavior). As
7850a special case, on a headline, splitting can only happen on the 7735a special case, on a headline, splitting can only happen on the
7851title itself. E.g., this excludes breaking stars or tags. 7736title itself. E.g., this excludes breaking stars or tags.
@@ -7869,186 +7754,107 @@ command.
7869When optional argument TOP is non-nil, insert a level 1 heading, 7754When optional argument TOP is non-nil, insert a level 1 heading,
7870unconditionally." 7755unconditionally."
7871 (interactive "P") 7756 (interactive "P")
7872 (let ((itemp (and (not top) (org-in-item-p))) 7757 (let* ((blank? (org--blank-before-heading-p (equal arg '(16))))
7873 (may-split (org-get-alist-option org-M-RET-may-split-line 'headline)) 7758 (level (org-current-level))
7874 (respect-content (or org-insert-heading-respect-content 7759 (stars (make-string (if (and level (not top)) level 1) ?*)))
7875 (equal arg '(4))))
7876 (initial-content ""))
7877
7878 (cond 7760 (cond
7879 7761 ((or org-insert-heading-respect-content
7880 ((or (= (buffer-size) 0) 7762 (member arg '((4) (16)))
7881 (and (not (save-excursion 7763 (and (not invisible-ok)
7882 (and (ignore-errors (org-back-to-heading invisible-ok)) 7764 (invisible-p (max (1- (point)) (point-min)))))
7883 (org-at-heading-p)))) 7765 ;; Position point at the location of insertion.
7884 (or arg (not itemp)))) 7766 (if (not level) ;before first headline
7885 ;; At beginning of buffer or so high up that only a heading 7767 (org-with-limited-levels (outline-next-heading))
7886 ;; makes sense. 7768 ;; Make sure we end up on a visible headline if INVISIBLE-OK
7887 (cond ((and (bolp) (not respect-content)) (insert "* ")) 7769 ;; is nil.
7888 ((not respect-content) 7770 (org-with-limited-levels (org-back-to-heading invisible-ok))
7889 (unless may-split (end-of-line)) 7771 (cond ((equal arg '(16))
7890 (insert "\n* ")) 7772 (org-up-heading-safe)
7891 ((re-search-forward org-outline-regexp-bol nil t) 7773 (org-end-of-subtree t t))
7892 (beginning-of-line) 7774 (t
7893 (insert "* \n") 7775 (org-end-of-subtree t t))))
7894 (backward-char)) 7776 (unless (bolp) (insert "\n")) ;ensure final newline
7895 (t (goto-char (point-max)) 7777 (unless (and blank? (org-previous-line-empty-p))
7896 (insert "\n* "))) 7778 (org-N-empty-lines-before-current (if blank? 1 0)))
7897 (run-hooks 'org-insert-heading-hook)) 7779 (insert stars " \n")
7898 7780 (forward-char -1))
7899 ((and itemp (not (member arg '((4) (16)))) (org-insert-item))) 7781 ;; At a headline...
7900 7782 ((org-at-heading-p)
7783 (cond ((bolp)
7784 (when blank? (save-excursion (insert "\n")))
7785 (save-excursion (insert stars " \n"))
7786 (unless (and blank? (org-previous-line-empty-p))
7787 (org-N-empty-lines-before-current (if blank? 1 0)))
7788 (end-of-line))
7789 ((and (org-get-alist-option org-M-RET-may-split-line 'headline)
7790 (org-match-line org-complex-heading-regexp)
7791 (org-pos-in-match-range (point) 4))
7792 ;; Grab the text that should moved to the new headline.
7793 ;; Preserve tags.
7794 (let ((split (delete-and-extract-region (point) (match-end 4))))
7795 (if (looking-at "[ \t]*$") (replace-match "")
7796 (org-set-tags nil t))
7797 (end-of-line)
7798 (when blank? (insert "\n"))
7799 (insert "\n" stars " ")
7800 (when (org-string-nw-p split) (insert split))
7801 (when (eobp) (save-excursion (insert "\n")))))
7802 (t
7803 (end-of-line)
7804 (when blank? (insert "\n"))
7805 (insert "\n" stars " ")
7806 (when (eobp) (save-excursion (insert "\n"))))))
7807 ;; On regular text, turn line into a headline or split, if
7808 ;; appropriate.
7809 ((bolp)
7810 (insert stars " ")
7811 (unless (and blank? (org-previous-line-empty-p))
7812 (org-N-empty-lines-before-current (if blank? 1 0))))
7901 (t 7813 (t
7902 ;; Maybe move at the end of the subtree 7814 (unless (org-get-alist-option org-M-RET-may-split-line 'headline)
7903 (when (equal arg '(16)) 7815 (end-of-line))
7904 (org-up-heading-safe) 7816 (insert "\n" stars " ")
7905 (org-end-of-subtree t)) 7817 (unless (and blank? (org-previous-line-empty-p))
7906 ;; Insert a heading 7818 (org-N-empty-lines-before-current (if blank? 1 0))))))
7907 (save-restriction 7819 (run-hooks 'org-insert-heading-hook))
7908 (widen) 7820
7909 (let* ((level nil) 7821(defun org-N-empty-lines-before-current (n)
7910 (on-heading (org-at-heading-p))
7911 (empty-line-p (if on-heading
7912 (org-previous-line-empty-p)
7913 ;; We will decide later
7914 nil))
7915 ;; Get a level string to fall back on.
7916 (fix-level
7917 (if (org-before-first-heading-p) "*"
7918 (save-excursion
7919 (org-back-to-heading t)
7920 (when (org-previous-line-empty-p) (setq empty-line-p t))
7921 (looking-at org-outline-regexp)
7922 (make-string (1- (length (match-string 0))) ?*))))
7923 (stars
7924 (save-excursion
7925 (condition-case nil
7926 (if top "* "
7927 (org-back-to-heading invisible-ok)
7928 (when (and (not on-heading)
7929 (featurep 'org-inlinetask)
7930 (integerp org-inlinetask-min-level)
7931 (>= (length (match-string 0))
7932 org-inlinetask-min-level))
7933 ;; Find a heading level before the inline
7934 ;; task.
7935 (while (and (setq level (org-up-heading-safe))
7936 (>= level org-inlinetask-min-level)))
7937 (if (org-at-heading-p)
7938 (org-back-to-heading invisible-ok)
7939 (error "This should not happen")))
7940 (unless (and (save-excursion
7941 (save-match-data
7942 (org-backward-heading-same-level
7943 1 invisible-ok))
7944 (= (point) (match-beginning 0)))
7945 (not (org-next-line-empty-p)))
7946 (setq empty-line-p (or empty-line-p
7947 (org-previous-line-empty-p))))
7948 (match-string 0))
7949 (error (or fix-level "* ")))))
7950 (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
7951 (blank (if (eq blank-a 'auto) empty-line-p blank-a)))
7952
7953 ;; If we insert after content, move there and clean up
7954 ;; whitespace.
7955 (when respect-content
7956 (if (not (org-before-first-heading-p))
7957 (org-end-of-subtree nil t)
7958 (re-search-forward org-outline-regexp-bol)
7959 (beginning-of-line 0))
7960 (skip-chars-backward " \r\t\n")
7961 (and (not (looking-back "^\\*+" (line-beginning-position)))
7962 (looking-at "[ \t]+") (replace-match ""))
7963 (unless (eobp) (forward-char 1))
7964 (when (looking-at "^\\*")
7965 (unless (bobp) (backward-char 1))
7966 (insert "\n")))
7967
7968 ;; If we are splitting, grab the text that should be moved
7969 ;; to the new headline.
7970 (when may-split
7971 (if (org-at-heading-p)
7972 ;; This is a heading: split intelligently (keeping
7973 ;; tags).
7974 (let ((pos (point)))
7975 (beginning-of-line)
7976 (let ((case-fold-search nil))
7977 (unless (looking-at org-complex-heading-regexp)
7978 (error "This should not happen")))
7979 (when (and (match-beginning 4)
7980 (> pos (match-beginning 4))
7981 (< pos (match-end 4)))
7982 (setq initial-content (buffer-substring pos (match-end 4)))
7983 (goto-char pos)
7984 (delete-region (point) (match-end 4))
7985 (if (looking-at "[ \t]*$")
7986 (replace-match "")
7987 (insert (make-string (length initial-content) ?\s)))
7988 (setq initial-content (org-trim initial-content)))
7989 (goto-char pos))
7990 ;; A normal line.
7991 (setq initial-content
7992 (org-trim
7993 (delete-and-extract-region (point) (line-end-position))))))
7994
7995 ;; If we are at the beginning of the line, insert before it.
7996 ;; Otherwise, after it.
7997 (cond
7998 ((and (bolp) (looking-at "[ \t]*$")))
7999 ((bolp) (save-excursion (insert "\n")))
8000 (t (end-of-line)
8001 (insert "\n")))
8002
8003 ;; Insert the new heading
8004 (insert stars)
8005 (just-one-space)
8006 (insert initial-content)
8007 (unless (and blank (org-previous-line-empty-p))
8008 (org-N-empty-lines-before-current (if blank 1 0)))
8009 ;; Adjust visibility, which may be messed up if we removed
8010 ;; blank lines while previous entry was hidden.
8011 (let ((bol (line-beginning-position)))
8012 (dolist (o (overlays-at (1- bol)))
8013 (when (and (eq (overlay-get o 'invisible) 'outline)
8014 (eq (overlay-end o) bol))
8015 (move-overlay o (overlay-start o) (1- bol)))))
8016 (run-hooks 'org-insert-heading-hook)))))))
8017
8018(defun org-N-empty-lines-before-current (N)
8019 "Make the number of empty lines before current exactly N. 7822 "Make the number of empty lines before current exactly N.
8020So this will delete or add empty lines." 7823So this will delete or add empty lines."
8021 (save-excursion 7824 (let ((column (current-column)))
8022 (beginning-of-line) 7825 (beginning-of-line)
8023 (let ((p (point))) 7826 (unless (bobp)
8024 (skip-chars-backward " \r\t\n") 7827 (let ((start (save-excursion
8025 (unless (bolp) (forward-line)) 7828 (skip-chars-backward " \r\t\n")
8026 (delete-region (point) p)) 7829 (line-end-position))))
8027 (when (> N 0) (insert (make-string N ?\n))))) 7830 (delete-region start (line-end-position 0))))
8028 7831 (insert (make-string n ?\n))
8029(defun org-get-heading (&optional no-tags no-todo) 7832 (move-to-column column)))
7833
7834(defun org-get-heading (&optional no-tags no-todo no-priority no-comment)
8030 "Return the heading of the current entry, without the stars. 7835 "Return the heading of the current entry, without the stars.
8031When NO-TAGS is non-nil, don't include tags. 7836When NO-TAGS is non-nil, don't include tags.
8032When NO-TODO is non-nil, don't include TODO keywords." 7837When NO-TODO is non-nil, don't include TODO keywords.
7838When NO-PRIORITY is non-nil, don't include priority cookie.
7839When NO-COMMENT is non-nil, don't include COMMENT string."
8033 (save-excursion 7840 (save-excursion
8034 (org-back-to-heading t) 7841 (org-back-to-heading t)
8035 (let ((case-fold-search nil)) 7842 (let ((case-fold-search nil))
8036 (cond 7843 (looking-at org-complex-heading-regexp)
8037 ((and no-tags no-todo) 7844 (let ((todo (and (not no-todo) (match-string 2)))
8038 (looking-at org-complex-heading-regexp) 7845 (priority (and (not no-priority) (match-string 3)))
8039 ;; Return value has to be a string, but match group 4 is 7846 (headline (pcase (match-string 4)
8040 ;; optional. 7847 (`nil "")
8041 (or (match-string 4) "")) 7848 ((and (guard no-comment) h)
8042 (no-tags 7849 (replace-regexp-in-string
8043 (looking-at (concat org-outline-regexp 7850 (eval-when-compile
8044 "\\(.*?\\)" 7851 (format "\\`%s[ \t]+" org-comment-string))
8045 "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$")) 7852 "" h))
8046 (match-string 1)) 7853 (h h)))
8047 (no-todo 7854 (tags (and (not no-tags) (match-string 5))))
8048 (looking-at org-todo-line-regexp) 7855 (mapconcat #'identity
8049 (match-string 3)) 7856 (delq nil (list todo priority headline tags))
8050 (t (looking-at org-heading-regexp) 7857 " ")))))
8051 (match-string 2))))))
8052 7858
8053(defvar orgstruct-mode) ; defined below 7859(defvar orgstruct-mode) ; defined below
8054 7860
@@ -8273,13 +8079,14 @@ time to headlines when structure editing, based on the value of
8273 (if org-odd-levels-only 2 1)) 8079 (if org-odd-levels-only 2 1))
8274 8080
8275(defun org-get-valid-level (level &optional change) 8081(defun org-get-valid-level (level &optional change)
8276 "Rectify a level change under the influence of `org-odd-levels-only' 8082 "Rectify a level change under the influence of `org-odd-levels-only'.
8277LEVEL is a current level, CHANGE is by how much the level should be 8083LEVEL is a current level, CHANGE is by how much the level should
8278modified. Even if CHANGE is nil, LEVEL may be returned modified because 8084be modified. Even if CHANGE is nil, LEVEL may be returned
8279even level numbers will become the next higher odd number." 8085modified because even level numbers will become the next higher
8086odd number. Returns values greater than 0."
8280 (if org-odd-levels-only 8087 (if org-odd-levels-only
8281 (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) 8088 (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
8282 ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) 8089 ((> change 0) (1+ (* 2 (/ (+ (1- level) (* 2 change)) 2))))
8283 ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) 8090 ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
8284 (max 1 (+ level (or change 0))))) 8091 (max 1 (+ level (or change 0)))))
8285 8092
@@ -8976,29 +8783,25 @@ with the original repeater."
8976 8783
8977;;; Outline Sorting 8784;;; Outline Sorting
8978 8785
8979(defun org-sort (with-case) 8786(defun org-sort (&optional with-case)
8980 "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'. 8787 "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'.
8981Optional argument WITH-CASE means sort case-sensitively." 8788Optional argument WITH-CASE means sort case-sensitively."
8982 (interactive "P") 8789 (interactive "P")
8983 (cond 8790 (org-call-with-arg
8984 ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case)) 8791 (cond ((org-at-table-p) #'org-table-sort-lines)
8985 ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case)) 8792 ((org-at-item-p) #'org-sort-list)
8986 (t 8793 (t #'org-sort-entries))
8987 (org-call-with-arg 'org-sort-entries with-case)))) 8794 with-case))
8988 8795
8989(defun org-sort-remove-invisible (s) 8796(defun org-sort-remove-invisible (s)
8990 "Remove invisible links from string S." 8797 "Remove invisible part of links and emphasis markers from string S."
8991 (remove-text-properties 0 (length s) org-rm-props s) 8798 (remove-text-properties 0 (length s) org-rm-props s)
8992 (while (string-match org-bracket-link-regexp s) 8799 (replace-regexp-in-string
8993 (setq s (replace-match (if (match-end 2) 8800 org-verbatim-re (lambda (m) (format "%s " (match-string 4 m)))
8994 (match-string 3 s) 8801 (replace-regexp-in-string
8995 (match-string 1 s)) 8802 org-emph-re (lambda (m) (format " %s " (match-string 4 m)))
8996 t t s))) 8803 (org-link-display-format s)
8997 (let ((st (format " %s " s))) 8804 t t) t t))
8998 (while (string-match org-emph-re st)
8999 (setq st (replace-match (format " %s " (match-string 4 st)) t t st)))
9000 (setq s (substring st 1 -1)))
9001 s)
9002 8805
9003(defvar org-priority-regexp) ; defined later in the file 8806(defvar org-priority-regexp) ; defined later in the file
9004 8807
@@ -9141,7 +8944,7 @@ function is being called interactively."
9141 ;; The clock marker is lost when using `sort-subr'; mark 8944 ;; The clock marker is lost when using `sort-subr'; mark
9142 ;; the clock with temporary `:org-clock-marker-backup' 8945 ;; the clock with temporary `:org-clock-marker-backup'
9143 ;; text property. 8946 ;; text property.
9144 (when (and (eq (org-clocking-buffer) (current-buffer)) 8947 (when (and (eq (org-clock-is-active) (current-buffer))
9145 (<= start (marker-position org-clock-marker)) 8948 (<= start (marker-position org-clock-marker))
9146 (>= end (marker-position org-clock-marker))) 8949 (>= end (marker-position org-clock-marker)))
9147 (org-with-silent-modifications 8950 (org-with-silent-modifications
@@ -9265,7 +9068,7 @@ function is being called interactively."
9265 "Regexp that matches the custom prefix of Org headlines in 9068 "Regexp that matches the custom prefix of Org headlines in
9266orgstruct(++)-mode." 9069orgstruct(++)-mode."
9267 :group 'org 9070 :group 'org
9268 :version "24.4" 9071 :version "26.1"
9269 :package-version '(Org . "8.3") 9072 :package-version '(Org . "8.3")
9270 :type 'regexp) 9073 :type 'regexp)
9271;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) 9074;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp)
@@ -9730,7 +9533,7 @@ sub-tree if optional argument INHERIT is non-nil."
9730 (org-refresh-properties 9533 (org-refresh-properties
9731 org-effort-property 9534 org-effort-property
9732 '((effort . identity) 9535 '((effort . identity)
9733 (effort-minutes . org-duration-string-to-minutes)))) 9536 (effort-minutes . org-duration-to-minutes))))
9734 9537
9735;;;; Link Stuff 9538;;;; Link Stuff
9736 9539
@@ -10113,7 +9916,7 @@ according to FMT (default from `org-email-link-description-format')."
10113 (org-back-to-heading t) 9916 (org-back-to-heading t)
10114 (org-element-property :raw-value (org-element-at-point)))))) 9917 (org-element-property :raw-value (org-element-at-point))))))
10115 (lines org-context-in-file-links)) 9918 (lines org-context-in-file-links))
10116 (or string (setq s (concat "*" s))) ; Add * for headlines 9919 (unless string (setq s (concat "*" s))) ;Add * for headlines
10117 (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) 9920 (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s))
10118 (when (and string (integerp lines) (> lines 0)) 9921 (when (and string (integerp lines) (> lines 0))
10119 (let ((slines (org-split-string s "\n"))) 9922 (let ((slines (org-split-string s "\n")))
@@ -10122,7 +9925,7 @@ according to FMT (default from `org-email-link-description-format')."
10122 'identity 9925 'identity
10123 (reverse (nthcdr (- (length slines) lines) 9926 (reverse (nthcdr (- (length slines) lines)
10124 (reverse slines))) "\n"))))) 9927 (reverse slines))) "\n")))))
10125 (mapconcat 'identity (org-split-string s "[ \t]+") " "))) 9928 (mapconcat #'identity (split-string s) " ")))
10126 9929
10127(defun org-make-link-string (link &optional description) 9930(defun org-make-link-string (link &optional description)
10128 "Make a link with brackets, consisting of LINK and DESCRIPTION." 9931 "Make a link with brackets, consisting of LINK and DESCRIPTION."
@@ -10343,15 +10146,14 @@ the current directory or below.
10343A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ 10146A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
10344prefix negates `org-keep-stored-link-after-insertion'. 10147prefix negates `org-keep-stored-link-after-insertion'.
10345 10148
10346If `org-make-link-description-function' is non-nil, this function will be
10347called with the link target, and the result will be the default
10348link description.
10349
10350If the LINK-LOCATION parameter is non-nil, this value will be used as 10149If the LINK-LOCATION parameter is non-nil, this value will be used as
10351the link location instead of reading one interactively. 10150the link location instead of reading one interactively.
10352 10151
10353If the DEFAULT-DESCRIPTION parameter is non-nil, this value will be used 10152If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
10354as the default description." 10153be used as the default description. Otherwise, if
10154`org-make-link-description-function' is non-nil, this function
10155will be called with the link target, and the result will be the
10156default link description."
10355 (interactive "P") 10157 (interactive "P")
10356 (let* ((wcf (current-window-configuration)) 10158 (let* ((wcf (current-window-configuration))
10357 (origbuf (current-buffer)) 10159 (origbuf (current-buffer))
@@ -10485,17 +10287,19 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
10485 (when (equal desc origpath) 10287 (when (equal desc origpath)
10486 (setq desc path))))) 10288 (setq desc path)))))
10487 10289
10488 (if org-make-link-description-function 10290 (unless auto-desc
10489 (setq desc 10291 (let ((initial-input
10490 (or (condition-case nil 10292 (cond
10491 (funcall org-make-link-description-function link desc) 10293 (default-description)
10492 (error (progn (message "Can't get link description from `%s'" 10294 ((not org-make-link-description-function) desc)
10493 (symbol-name org-make-link-description-function)) 10295 (t (condition-case nil
10494 (sit-for 2) nil))) 10296 (funcall org-make-link-description-function link desc)
10495 (read-string "Description: " default-description))) 10297 (error
10496 (if default-description (setq desc default-description) 10298 (message "Can't get link description from `%s'"
10497 (setq desc (or (and auto-desc desc) 10299 (symbol-name org-make-link-description-function))
10498 (read-string "Description: " desc))))) 10300 (sit-for 2)
10301 nil))))))
10302 (setq desc (read-string "Description: " initial-input))))
10499 10303
10500 (unless (string-match "\\S-" desc) (setq desc nil)) 10304 (unless (string-match "\\S-" desc) (setq desc nil))
10501 (when remove (apply 'delete-region remove)) 10305 (when remove (apply 'delete-region remove))
@@ -10831,13 +10635,8 @@ a timestamp or a link."
10831 (user-error "No link found")) 10635 (user-error "No link found"))
10832 ((eq type 'timestamp) (org-follow-timestamp-link)) 10636 ((eq type 'timestamp) (org-follow-timestamp-link))
10833 ((eq type 'link) 10637 ((eq type 'link)
10834 ;; When link is located within the description of another 10638 (let ((type (org-element-property :type context))
10835 ;; link (e.g., an inline image), always open the parent 10639 (path (org-link-unescape (org-element-property :path context))))
10836 ;; link.
10837 (let* ((link (let ((up (org-element-property :parent context)))
10838 (if (eq (org-element-type up) 'link) up context)))
10839 (type (org-element-property :type link))
10840 (path (org-link-unescape (org-element-property :path link))))
10841 ;; Switch back to REFERENCE-BUFFER needed when called in 10640 ;; Switch back to REFERENCE-BUFFER needed when called in
10842 ;; a temporary buffer through `org-open-link-from-string'. 10641 ;; a temporary buffer through `org-open-link-from-string'.
10843 (with-current-buffer (or reference-buffer (current-buffer)) 10642 (with-current-buffer (or reference-buffer (current-buffer))
@@ -10852,8 +10651,8 @@ a timestamp or a link."
10852 ;; ("open" function called with a single argument). 10651 ;; ("open" function called with a single argument).
10853 ;; If no such function is found, fallback to 10652 ;; If no such function is found, fallback to
10854 ;; `org-open-file'. 10653 ;; `org-open-file'.
10855 (let* ((option (org-element-property :search-option link)) 10654 (let* ((option (org-element-property :search-option context))
10856 (app (org-element-property :application link)) 10655 (app (org-element-property :application context))
10857 (dedicated-function 10656 (dedicated-function
10858 (org-link-get-parameter 10657 (org-link-get-parameter
10859 (if app (concat type "+" app) type) 10658 (if app (concat type "+" app) type)
@@ -10884,15 +10683,15 @@ a timestamp or a link."
10884 (org-with-wide-buffer 10683 (org-with-wide-buffer
10885 (if (equal type "radio") 10684 (if (equal type "radio")
10886 (org-search-radio-target 10685 (org-search-radio-target
10887 (org-element-property :path link)) 10686 (org-element-property :path context))
10888 (org-link-search 10687 (org-link-search
10889 (if (member type '("custom-id" "coderef")) 10688 (if (member type '("custom-id" "coderef"))
10890 (org-element-property :raw-link link) 10689 (org-element-property :raw-link context)
10891 path) 10690 path)
10892 ;; Prevent fuzzy links from matching 10691 ;; Prevent fuzzy links from matching
10893 ;; themselves. 10692 ;; themselves.
10894 (and (equal type "fuzzy") 10693 (and (equal type "fuzzy")
10895 (+ 2 (org-element-property :begin link))))) 10694 (+ 2 (org-element-property :begin context)))))
10896 (point)))) 10695 (point))))
10897 (unless (and (<= (point-min) destination) 10696 (unless (and (<= (point-min) destination)
10898 (>= (point-max) destination)) 10697 (>= (point-max) destination))
@@ -11019,7 +10818,7 @@ the window configuration before `org-open-at-point' was called using:
11019White spaces are not significant." 10818White spaces are not significant."
11020 (let ((re (format "<<<%s>>>" 10819 (let ((re (format "<<<%s>>>"
11021 (mapconcat #'regexp-quote 10820 (mapconcat #'regexp-quote
11022 (org-split-string target "[ \t\n]+") 10821 (split-string target)
11023 "[ \t]+\\(?:\n[ \t]*\\)?"))) 10822 "[ \t]+\\(?:\n[ \t]*\\)?")))
11024 (origin (point))) 10823 (origin (point)))
11025 (goto-char (point-min)) 10824 (goto-char (point-min))
@@ -11143,7 +10942,8 @@ of matched result, which is either `dedicated' or `fuzzy'."
11143 org-comment-string 10942 org-comment-string
11144 (mapconcat #'regexp-quote words ".+"))) 10943 (mapconcat #'regexp-quote words ".+")))
11145 (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]") 10944 (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]")
11146 (comment-re (format "\\`%s[ \t]+" org-comment-string))) 10945 (comment-re (eval-when-compile
10946 (format "\\`%s[ \t]+" org-comment-string))))
11147 (goto-char (point-min)) 10947 (goto-char (point-min))
11148 (catch :found 10948 (catch :found
11149 (while (re-search-forward title-re nil t) 10949 (while (re-search-forward title-re nil t)
@@ -11152,7 +10952,7 @@ of matched result, which is either `dedicated' or `fuzzy'."
11152 (replace-regexp-in-string 10952 (replace-regexp-in-string
11153 cookie-re "" 10953 cookie-re ""
11154 (replace-regexp-in-string 10954 (replace-regexp-in-string
11155 comment-re "" (org-get-heading t t))))) 10955 comment-re "" (org-get-heading t t t)))))
11156 (throw :found t))) 10956 (throw :found t)))
11157 nil))) 10957 nil)))
11158 (beginning-of-line) 10958 (beginning-of-line)
@@ -11303,7 +11103,7 @@ or to another Org file, automatically push the old position onto the ring."
11303 (format "*Org Agenda(a:%s)" 11103 (format "*Org Agenda(a:%s)"
11304 (concat (substring t1 0 10) "--" (substring t2 0 10))))) 11104 (concat (substring t1 0 10) "--" (substring t2 0 10)))))
11305 (org-agenda-list nil tt1 (1+ (- tt2 tt1)))))) 11105 (org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
11306 ((org-at-timestamp-p t) 11106 ((org-at-timestamp-p 'lax)
11307 (let ((org-agenda-buffer-tmp-name 11107 (let ((org-agenda-buffer-tmp-name
11308 (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10)))) 11108 (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
11309 (org-agenda-list nil (time-to-days (org-time-string-to-time 11109 (org-agenda-list nil (time-to-days (org-time-string-to-time
@@ -11361,12 +11161,19 @@ If the file does not exist, an error is thrown."
11361 (search (concat file "::" search)) 11161 (search (concat file "::" search))
11362 (t file))) 11162 (t file)))
11363 (dlink (downcase link)) 11163 (dlink (downcase link))
11364 (old-buffer (current-buffer))
11365 (old-pos (point))
11366 (old-mode major-mode)
11367 (ext 11164 (ext
11368 (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile) 11165 (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile)
11369 (match-string 1 dfile))) 11166 (match-string 1 dfile)))
11167 (save-position-maybe
11168 (let ((old-buffer (current-buffer))
11169 (old-pos (point))
11170 (old-mode major-mode))
11171 (lambda ()
11172 (and (derived-mode-p 'org-mode)
11173 (eq old-mode 'org-mode)
11174 (or (not (eq old-buffer (current-buffer)))
11175 (not (eq old-pos (point))))
11176 (org-mark-ring-push old-pos old-buffer)))))
11370 cmd link-match-data) 11177 cmd link-match-data)
11371 (cond 11178 (cond
11372 ((member in-emacs '((16) system)) 11179 ((member in-emacs '((16) system))
@@ -11440,7 +11247,12 @@ If the file does not exist, an error is thrown."
11440 (widen) 11247 (widen)
11441 (cond (line (org-goto-line line) 11248 (cond (line (org-goto-line line)
11442 (when (derived-mode-p 'org-mode) (org-reveal))) 11249 (when (derived-mode-p 'org-mode) (org-reveal)))
11443 (search (org-link-search search)))) 11250 (search (condition-case err
11251 (org-link-search search)
11252 ;; Save position before error-ing out so user
11253 ;; can easily move back to the original buffer.
11254 (error (funcall save-position-maybe)
11255 (error (nth 1 err)))))))
11444 ((functionp cmd) 11256 ((functionp cmd)
11445 (save-match-data 11257 (save-match-data
11446 (set-match-data link-match-data) 11258 (set-match-data link-match-data)
@@ -11449,23 +11261,18 @@ If the file does not exist, an error is thrown."
11449 ;; FIXME: Remove this check when most default installations 11261 ;; FIXME: Remove this check when most default installations
11450 ;; of Emacs have at least Org 9.0. 11262 ;; of Emacs have at least Org 9.0.
11451 ((debug wrong-number-of-arguments wrong-type-argument 11263 ((debug wrong-number-of-arguments wrong-type-argument
11452 invalid-function) 11264 invalid-function)
11453 (user-error "Please see Org News for version 9.0 about \ 11265 (user-error "Please see Org News for version 9.0 about \
11454`org-file-apps'--Lisp error: %S" cmd))))) 11266`org-file-apps'--Lisp error: %S" cmd)))))
11455 ((consp cmd) 11267 ((consp cmd)
11456 ;; FIXME: Remove this check when most default installations of 11268 ;; FIXME: Remove this check when most default installations of
11457 ;; Emacs have at least Org 9.0. 11269 ;; Emacs have at least Org 9.0. Heads-up instead of silently
11458 ;; Heads-up instead of silently fall back to 11270 ;; fall back to `org-link-frame-setup' for an old usage of
11459 ;; `org-link-frame-setup' for an old usage of `org-file-apps' 11271 ;; `org-file-apps' with sexp instead of a function for `cmd'.
11460 ;; with sexp instead of a function for `cmd'.
11461 (user-error "Please see Org News for version 9.0 about \ 11272 (user-error "Please see Org News for version 9.0 about \
11462`org-file-apps'--Error: Deprecated usage of %S" cmd)) 11273`org-file-apps'--Error: Deprecated usage of %S" cmd))
11463 (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) 11274 (t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
11464 (and (derived-mode-p 'org-mode) 11275 (funcall save-position-maybe)))
11465 (eq old-mode 'org-mode)
11466 (or (not (eq old-buffer (current-buffer)))
11467 (not (eq old-pos (point))))
11468 (org-mark-ring-push old-pos old-buffer))))
11469 11276
11470(defun org-file-apps-entry-match-against-dlink-p (entry) 11277(defun org-file-apps-entry-match-against-dlink-p (entry)
11471 "This function returns non-nil if `entry' uses a regular 11278 "This function returns non-nil if `entry' uses a regular
@@ -11663,6 +11470,10 @@ order.")
11663 (setq f (and f (expand-file-name f))) 11470 (setq f (and f (expand-file-name f)))
11664 (when (eq org-refile-use-outline-path 'file) 11471 (when (eq org-refile-use-outline-path 'file)
11665 (push (list (file-name-nondirectory f) f nil nil) tgs)) 11472 (push (list (file-name-nondirectory f) f nil nil) tgs))
11473 (when (eq org-refile-use-outline-path 'buffer-name)
11474 (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs))
11475 (when (eq org-refile-use-outline-path 'full-file-path)
11476 (push (list (file-truename (buffer-file-name (buffer-base-buffer))) f nil nil) tgs))
11666 (org-with-wide-buffer 11477 (org-with-wide-buffer
11667 (goto-char (point-min)) 11478 (goto-char (point-min))
11668 (setq org-outline-path-cache nil) 11479 (setq org-outline-path-cache nil)
@@ -11682,7 +11493,7 @@ order.")
11682 (target 11493 (target
11683 (if (not org-refile-use-outline-path) heading 11494 (if (not org-refile-use-outline-path) heading
11684 (mapconcat 11495 (mapconcat
11685 #'org-protect-slash 11496 #'identity
11686 (append 11497 (append
11687 (pcase org-refile-use-outline-path 11498 (pcase org-refile-use-outline-path
11688 (`file (list (file-name-nondirectory 11499 (`file (list (file-name-nondirectory
@@ -11691,8 +11502,13 @@ order.")
11691 (`full-file-path 11502 (`full-file-path
11692 (list (buffer-file-name 11503 (list (buffer-file-name
11693 (buffer-base-buffer)))) 11504 (buffer-base-buffer))))
11505 (`buffer-name
11506 (list (buffer-name
11507 (buffer-base-buffer))))
11694 (_ nil)) 11508 (_ nil))
11695 (org-get-outline-path t t)) 11509 (mapcar (lambda (s) (replace-regexp-in-string
11510 "/" "\\/" s nil t))
11511 (org-get-outline-path t t)))
11696 "/")))) 11512 "/"))))
11697 (push (list target f re (org-refile-marker (point))) 11513 (push (list target f re (org-refile-marker (point)))
11698 tgs))) 11514 tgs)))
@@ -11705,9 +11521,6 @@ order.")
11705 (message "Getting targets...done") 11521 (message "Getting targets...done")
11706 (delete-dups (nreverse targets)))) 11522 (delete-dups (nreverse targets))))
11707 11523
11708(defun org-protect-slash (s)
11709 (replace-regexp-in-string "/" "\\/" s nil t))
11710
11711(defun org--get-outline-path-1 (&optional use-cache) 11524(defun org--get-outline-path-1 (&optional use-cache)
11712 "Return outline path to current headline. 11525 "Return outline path to current headline.
11713 11526
@@ -11967,7 +11780,6 @@ prefix argument (`C-u C-u C-u C-c C-w')."
11967 (if pos 11780 (if pos
11968 (progn 11781 (progn
11969 (goto-char pos) 11782 (goto-char pos)
11970 (looking-at org-outline-regexp)
11971 (setq level (org-get-valid-level (funcall outline-level) 1)) 11783 (setq level (org-get-valid-level (funcall outline-level) 1))
11972 (goto-char 11784 (goto-char
11973 (if reversed 11785 (if reversed
@@ -12332,6 +12144,7 @@ keywords relative to each registered export back-end."
12332 ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE") 12144 ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE")
12333 ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM") 12145 ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM")
12334 ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER") 12146 ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER")
12147 ("C" "#+BEGIN_COMMENT\n?\n#+END_COMMENT")
12335 ("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT") 12148 ("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT")
12336 ("L" "#+LaTeX: ") 12149 ("L" "#+LaTeX: ")
12337 ("h" "#+BEGIN_EXPORT html\n?\n#+END_EXPORT") 12150 ("h" "#+BEGIN_EXPORT html\n?\n#+END_EXPORT")
@@ -13047,7 +12860,7 @@ This hook runs even if there is no statistics cookie present, in which case
13047 (setq org-log-done nil 12860 (setq org-log-done nil
13048 org-log-repeat nil 12861 org-log-repeat nil
13049 org-todo-log-states nil) 12862 org-todo-log-states nil)
13050 (dolist (w (org-split-string value)) 12863 (dolist (w (split-string value))
13051 (let (a) 12864 (let (a)
13052 (cond 12865 (cond
13053 ((setq a (assoc w org-startup-options)) 12866 ((setq a (assoc w org-startup-options))
@@ -13179,16 +12992,27 @@ on INACTIVE-OK."
13179 (throw 'exit t))) 12992 (throw 'exit t)))
13180 nil))) 12993 nil)))
13181 12994
13182(defun org-get-repeat (&optional tagline) 12995(defun org-get-repeat (&optional timestamp)
13183 "Check if there is a deadline/schedule with repeater in this entry." 12996 "Check if there is a time-stamp with repeater in this entry.
12997
12998Return the repeater, as a string, or nil. Also return nil when
12999this function is called before first heading.
13000
13001When optional argument TIMESTAMP is a string, extract the
13002repeater from there instead."
13184 (save-match-data 13003 (save-match-data
13185 (save-excursion 13004 (cond (timestamp
13186 (org-back-to-heading t) 13005 (and (string-match org-repeat-re timestamp)
13187 (and (re-search-forward (if tagline 13006 (match-string-no-properties 1 timestamp)))
13188 (concat tagline "\\s-*" org-repeat-re) 13007 ((org-before-first-heading-p) nil)
13189 org-repeat-re) 13008 (t
13190 (org-entry-end-position) t) 13009 (save-excursion
13191 (match-string-no-properties 1))))) 13010 (org-back-to-heading t)
13011 (let ((end (org-entry-end-position)))
13012 (catch :repeat
13013 (while (re-search-forward org-repeat-re end t)
13014 (when (save-match-data (org-at-timestamp-p 'agenda))
13015 (throw :repeat (match-string-no-properties 1)))))))))))
13192 13016
13193(defvar org-last-changed-timestamp) 13017(defvar org-last-changed-timestamp)
13194(defvar org-last-inserted-timestamp) 13018(defvar org-last-inserted-timestamp)
@@ -13210,110 +13034,117 @@ This function is run automatically after each state change to a DONE state."
13210 (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year))) 13034 (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
13211 (msg "Entry repeats: ") 13035 (msg "Entry repeats: ")
13212 (org-log-done nil) 13036 (org-log-done nil)
13213 (org-todo-log-states nil)) 13037 (org-todo-log-states nil)
13214 (when (and repeat (not (zerop (string-to-number (substring repeat 1))))) 13038 (end (copy-marker (org-entry-end-position))))
13215 (when (eq org-log-repeat t) (setq org-log-repeat 'state)) 13039 (unwind-protect
13216 (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective) 13040 (when (and repeat (not (zerop (string-to-number (substring repeat 1)))))
13217 org-todo-repeat-to-state))) 13041 (when (eq org-log-repeat t) (setq org-log-repeat 'state))
13218 (org-todo (cond ((and to-state (member to-state org-todo-keywords-1)) 13042 (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
13219 to-state) 13043 org-todo-repeat-to-state)))
13220 ((eq interpret 'type) org-last-state) 13044 (org-todo (cond
13221 (head) 13045 ((and to-state (member to-state org-todo-keywords-1))
13222 (t 'none)))) 13046 to-state)
13223 (when (or org-log-repeat (org-entry-get nil "CLOCK")) 13047 ((eq interpret 'type) org-last-state)
13224 (org-entry-put nil "LAST_REPEAT" (format-time-string 13048 (head)
13225 (org-time-stamp-format t t)))) 13049 (t 'none))))
13226 (when org-log-repeat 13050 (org-back-to-heading t)
13227 (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) 13051 (org-add-planning-info nil nil 'closed)
13228 (memq 'org-add-log-note post-command-hook)) 13052 ;; When `org-log-repeat' is non-nil or entry contains
13229 ;; We are already setup for some record. 13053 ;; a clock, set LAST_REPEAT property.
13230 (when (eq org-log-repeat 'note) 13054 (when (or org-log-repeat
13231 ;; Make sure we take a note, not only a time stamp. 13055 (catch :clock
13232 (setq org-log-note-how 'note)) 13056 (save-excursion
13233 ;; Set up for taking a record. 13057 (while (re-search-forward org-clock-line-re end t)
13234 (org-add-log-setup 'state 13058 (when (org-at-clock-log-p) (throw :clock t))))))
13235 (or done-word (car org-done-keywords)) 13059 (org-entry-put nil "LAST_REPEAT" (format-time-string
13236 org-last-state 13060 (org-time-stamp-format t t)
13237 org-log-repeat))) 13061 (current-time))))
13238 (org-back-to-heading t) 13062 (when org-log-repeat
13239 (org-add-planning-info nil nil 'closed) 13063 (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
13240 (let ((end (save-excursion (outline-next-heading) (point))) 13064 (memq 'org-add-log-note post-command-hook))
13241 (planning-re (regexp-opt 13065 ;; We are already setup for some record.
13242 (list org-scheduled-string org-deadline-string)))) 13066 (when (eq org-log-repeat 'note)
13243 (while (re-search-forward org-ts-regexp end t) 13067 ;; Make sure we take a note, not only a time stamp.
13244 (let* ((ts (match-string 0)) 13068 (setq org-log-note-how 'note))
13245 (planning? (org-at-planning-p)) 13069 ;; Set up for taking a record.
13246 (type (if (not planning?) "Plain:" 13070 (org-add-log-setup 'state
13247 (save-excursion 13071 (or done-word (car org-done-keywords))
13248 (re-search-backward 13072 org-last-state
13249 planning-re (line-beginning-position) t) 13073 org-log-repeat)))
13250 (match-string 0))))) 13074 (let ((planning-re (regexp-opt
13251 (cond 13075 (list org-scheduled-string org-deadline-string))))
13252 ;; Ignore fake time-stamps (e.g., within comments). 13076 (while (re-search-forward org-ts-regexp end t)
13253 ((and (not planning?) 13077 (let* ((ts (match-string 0))
13254 (not (org-at-property-p)) 13078 (planning? (org-at-planning-p))
13255 (not (eq 'timestamp 13079 (type (if (not planning?) "Plain:"
13256 (org-element-type (save-excursion 13080 (save-excursion
13257 (backward-char) 13081 (re-search-backward
13258 (org-element-context))))))) 13082 planning-re (line-beginning-position) t)
13259 ;; Time-stamps without a repeater are usually skipped. 13083 (match-string 0)))))
13260 ;; However, a SCHEDULED time-stamp without one is 13084 (cond
13261 ;; removed, as it is considered as no longer relevant. 13085 ;; Ignore fake time-stamps (e.g., within comments).
13262 ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)) 13086 ((not (org-at-timestamp-p 'agenda)))
13263 (when (equal type org-scheduled-string) 13087 ;; Time-stamps without a repeater are usually
13264 (org-remove-timestamp-with-keyword type))) 13088 ;; skipped. However, a SCHEDULED time-stamp without
13265 (t 13089 ;; one is removed, as they are no longer relevant.
13266 (let ((n (string-to-number (match-string 2 ts))) 13090 ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
13267 (what (match-string 3 ts))) 13091 ts))
13268 (when (equal what "w") (setq n (* n 7) what "d")) 13092 (when (equal type org-scheduled-string)
13269 (when (and (equal what "h") 13093 (org-remove-timestamp-with-keyword type)))
13270 (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" 13094 (t
13271 ts))) 13095 (let ((n (string-to-number (match-string 2 ts)))
13272 (user-error 13096 (what (match-string 3 ts)))
13273 "Cannot repeat in Repeat in %d hour(s) because no hour \ 13097 (when (equal what "w") (setq n (* n 7) what "d"))
13098 (when (and (equal what "h")
13099 (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}"
13100 ts)))
13101 (user-error
13102 "Cannot repeat in Repeat in %d hour(s) because no hour \
13274has been set" 13103has been set"
13275 n)) 13104 n))
13276 ;; Preparation, see if we need to modify the start 13105 ;; Preparation, see if we need to modify the start
13277 ;; date for the change. 13106 ;; date for the change.
13278 (when (match-end 1) 13107 (when (match-end 1)
13279 (let ((time (save-match-data (org-time-string-to-time ts)))) 13108 (let ((time (save-match-data
13280 (cond 13109 (org-time-string-to-time ts))))
13281 ((equal (match-string 1 ts) ".") 13110 (cond
13282 ;; Shift starting date to today 13111 ((equal (match-string 1 ts) ".")
13283 (org-timestamp-change 13112 ;; Shift starting date to today
13284 (- (org-today) (time-to-days time)) 13113 (org-timestamp-change
13285 'day)) 13114 (- (org-today) (time-to-days time))
13286 ((equal (match-string 1 ts) "+") 13115 'day))
13287 (let ((nshiftmax 10) 13116 ((equal (match-string 1 ts) "+")
13288 (nshift 0)) 13117 (let ((nshiftmax 10)
13289 (while (or (= nshift 0) 13118 (nshift 0))
13290 (not (time-less-p (current-time) time))) 13119 (while (or (= nshift 0)
13291 (when (= (cl-incf nshift) nshiftmax) 13120 (not (time-less-p (current-time) time)))
13292 (or (y-or-n-p 13121 (when (= (cl-incf nshift) nshiftmax)
13293 (format "%d repeater intervals were not \ 13122 (or (y-or-n-p
13123 (format "%d repeater intervals were not \
13294enough to shift date past today. Continue? " 13124enough to shift date past today. Continue? "
13295 nshift)) 13125 nshift))
13296 (user-error "Abort"))) 13126 (user-error "Abort")))
13297 (org-timestamp-change n (cdr (assoc what whata))) 13127 (org-timestamp-change n (cdr (assoc what whata)))
13298 (org-at-timestamp-p t) 13128 (org-in-regexp org-ts-regexp3)
13129 (setq ts (match-string 1))
13130 (setq time
13131 (save-match-data
13132 (org-time-string-to-time ts)))))
13133 (org-timestamp-change (- n) (cdr (assoc what whata)))
13134 ;; Rematch, so that we have everything in place
13135 ;; for the real shift.
13136 (org-in-regexp org-ts-regexp3)
13299 (setq ts (match-string 1)) 13137 (setq ts (match-string 1))
13300 (setq time 13138 (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
13301 (save-match-data 13139 ts)))))
13302 (org-time-string-to-time ts))))) 13140 (save-excursion
13303 (org-timestamp-change (- n) (cdr (assoc what whata))) 13141 (org-timestamp-change n (cdr (assoc what whata)) nil t))
13304 ;; Rematch, so that we have everything in place 13142 (setq msg
13305 ;; for the real shift. 13143 (concat
13306 (org-at-timestamp-p t) 13144 msg type " " org-last-changed-timestamp " "))))))))
13307 (setq ts (match-string 1)) 13145 (setq org-log-post-message msg)
13308 (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" 13146 (message "%s" msg))
13309 ts))))) 13147 (set-marker end nil))))
13310 (save-excursion
13311 (org-timestamp-change n (cdr (assoc what whata)) nil t))
13312 (setq msg
13313 (concat
13314 msg type " " org-last-changed-timestamp " "))))))))
13315 (setq org-log-post-message msg)
13316 (message "%s" msg))))
13317 13148
13318(defun org-show-todo-tree (arg) 13149(defun org-show-todo-tree (arg)
13319 "Make a compact tree which shows all headlines marked with TODO. 13150 "Make a compact tree which shows all headlines marked with TODO.
@@ -13748,7 +13579,7 @@ EXTRA is additional text that will be inserted into the notes buffer."
13748 (setq txt (replace-match "" t t txt))) 13579 (setq txt (replace-match "" t t txt)))
13749 (when (string-match "\\s-+\\'" txt) 13580 (when (string-match "\\s-+\\'" txt)
13750 (setq txt (replace-match "" t t txt))) 13581 (setq txt (replace-match "" t t txt)))
13751 (setq lines (org-split-string txt "\n")) 13582 (setq lines (and (not (equal "" txt)) (org-split-string txt "\n")))
13752 (when (org-string-nw-p note) 13583 (when (org-string-nw-p note)
13753 (setq note 13584 (setq note
13754 (org-replace-escapes 13585 (org-replace-escapes
@@ -14235,8 +14066,8 @@ for inclusion. See `org-make-tags-matcher' for more information.
14235As a special case, it can also be set to t (respectively nil) in 14066As a special case, it can also be set to t (respectively nil) in
14236order to match all (respectively none) headline. 14067order to match all (respectively none) headline.
14237 14068
14238When TODO-ONLY is non-nil, only lines with a not-done TODO 14069When TODO-ONLY is non-nil, only lines with a TODO keyword are
14239keyword are included in the output. 14070included in the output.
14240 14071
14241START-LEVEL can be a string with asterisks, reducing the scope to 14072START-LEVEL can be a string with asterisks, reducing the scope to
14242headlines matching this string." 14073headlines matching this string."
@@ -14321,7 +14152,7 @@ headlines matching this string."
14321 (when (and 14152 (when (and
14322 14153
14323 ;; eval matcher only when the todo condition is OK 14154 ;; eval matcher only when the todo condition is OK
14324 (and (or (not todo-only) (member todo org-not-done-keywords)) 14155 (and (or (not todo-only) (member todo org-todo-keywords-1))
14325 (if (functionp matcher) 14156 (if (functionp matcher)
14326 (let ((case-fold-search t) (org-trust-scanner-tags t)) 14157 (let ((case-fold-search t) (org-trust-scanner-tags t))
14327 (funcall matcher todo tags-list level)) 14158 (funcall matcher todo tags-list level))
@@ -14335,7 +14166,7 @@ headlines matching this string."
14335 14166
14336 ;; Check if timestamps are deselecting this entry 14167 ;; Check if timestamps are deselecting this entry
14337 (or (not todo-only) 14168 (or (not todo-only)
14338 (and (member todo org-not-done-keywords) 14169 (and (member todo org-todo-keywords-1)
14339 (or (not org-agenda-tags-todo-honor-ignore-options) 14170 (or (not org-agenda-tags-todo-honor-ignore-options)
14340 (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))) 14171 (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
14341 14172
@@ -14877,34 +14708,32 @@ ignore inherited ones."
14877(defun org-toggle-tag (tag &optional onoff) 14708(defun org-toggle-tag (tag &optional onoff)
14878 "Toggle the tag TAG for the current line. 14709 "Toggle the tag TAG for the current line.
14879If ONOFF is `on' or `off', don't toggle but set to this state." 14710If ONOFF is `on' or `off', don't toggle but set to this state."
14880 (let (res current) 14711 (save-excursion
14881 (save-excursion 14712 (org-back-to-heading t)
14882 (org-back-to-heading t) 14713 (let ((current
14883 (if (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$" 14714 (when (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$"
14884 (point-at-eol) t) 14715 (line-end-position) t)
14885 (progn 14716 (let ((tags (match-string 1)))
14886 (setq current (match-string 1)) 14717 ;; Clear current tags.
14887 (replace-match "")) 14718 (replace-match "")
14888 (setq current "")) 14719 ;; Reverse the tags list so any new tag is appended to
14889 (setq current (nreverse (org-split-string current ":"))) 14720 ;; the current list of tags.
14890 (cond 14721 (nreverse (org-split-string tags ":")))))
14891 ((eq onoff 'on) 14722 res)
14892 (setq res t) 14723 (pcase onoff
14893 (or (member tag current) (push tag current))) 14724 (`off (setq current (delete tag current)))
14894 ((eq onoff 'off) 14725 ((or `on (guard (not (member tag current))))
14895 (or (not (member tag current)) (setq current (delete tag current)))) 14726 (setq res t)
14896 (t (if (member tag current) 14727 (cl-pushnew tag current :test #'equal))
14897 (setq current (delete tag current)) 14728 (_ (setq current (delete tag current))))
14898 (setq res t) 14729 (end-of-line)
14899 (push tag current))))
14900 (end-of-line 1)
14901 (if current 14730 (if current
14902 (progn 14731 (progn
14903 (insert " :" (mapconcat 'identity (nreverse current) ":") ":") 14732 (insert " :" (mapconcat #'identity (nreverse current) ":") ":")
14904 (org-set-tags nil t)) 14733 (org-set-tags nil t))
14905 (delete-horizontal-space)) 14734 (delete-horizontal-space))
14906 (run-hooks 'org-after-tags-change-hook)) 14735 (run-hooks 'org-after-tags-change-hook)
14907 res)) 14736 res)))
14908 14737
14909(defun org--align-tags-here (to-col) 14738(defun org--align-tags-here (to-col)
14910 "Align tags on the current headline to TO-COL. 14739 "Align tags on the current headline to TO-COL.
@@ -15311,7 +15140,7 @@ Returns the new tags string, or nil to not change the current settings."
15311 (setq rtn 15140 (setq rtn
15312 (catch 'exit 15141 (catch 'exit
15313 (while t 15142 (while t
15314 (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" 15143 (message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s"
15315 (if (not groups) "no " "") 15144 (if (not groups) "no " "")
15316 (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) 15145 (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
15317 (setq c (let ((inhibit-quit t)) (read-char-exclusive))) 15146 (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
@@ -15634,7 +15463,6 @@ See `org-property-re' for match data, if applicable."
15634(defun org-property-action () 15463(defun org-property-action ()
15635 "Do an action on properties." 15464 "Do an action on properties."
15636 (interactive) 15465 (interactive)
15637 (unless (org-at-property-p) (user-error "Not at a property"))
15638 (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") 15466 (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
15639 (let ((c (read-char-exclusive))) 15467 (let ((c (read-char-exclusive)))
15640 (cl-case c 15468 (cl-case c
@@ -15696,7 +15524,7 @@ When INCREMENT is non-nil, set the property to the next allowed value."
15696 (org-entry-put nil prop val)) 15524 (org-entry-put nil prop val))
15697 (org-refresh-property 15525 (org-refresh-property
15698 '((effort . identity) 15526 '((effort . identity)
15699 (effort-minutes . org-duration-string-to-minutes)) 15527 (effort-minutes . org-duration-to-minutes))
15700 val) 15528 val)
15701 (when (equal heading (bound-and-true-p org-clock-current-task)) 15529 (when (equal heading (bound-and-true-p org-clock-current-task))
15702 (setq org-clock-effort (get-text-property (point-at-bol) 'effort)) 15530 (setq org-clock-effort (get-text-property (point-at-bol) 'effort))
@@ -15734,8 +15562,7 @@ strings."
15734 (when (or (not specific) (string= specific "CLOCKSUM")) 15562 (when (or (not specific) (string= specific "CLOCKSUM"))
15735 (let ((clocksum (get-text-property (point) :org-clock-minutes))) 15563 (let ((clocksum (get-text-property (point) :org-clock-minutes)))
15736 (when clocksum 15564 (when clocksum
15737 (push (cons "CLOCKSUM" 15565 (push (cons "CLOCKSUM" (org-duration-from-minutes clocksum))
15738 (org-minutes-to-clocksum-string clocksum))
15739 props))) 15566 props)))
15740 (when specific (throw 'exit props))) 15567 (when specific (throw 'exit props)))
15741 (when (or (not specific) (string= specific "CLOCKSUM_T")) 15568 (when (or (not specific) (string= specific "CLOCKSUM_T"))
@@ -15743,7 +15570,7 @@ strings."
15743 :org-clock-minutes-today))) 15570 :org-clock-minutes-today)))
15744 (when clocksumt 15571 (when clocksumt
15745 (push (cons "CLOCKSUM_T" 15572 (push (cons "CLOCKSUM_T"
15746 (org-minutes-to-clocksum-string clocksumt)) 15573 (org-duration-from-minutes clocksumt))
15747 props))) 15574 props)))
15748 (when specific (throw 'exit props))) 15575 (when specific (throw 'exit props)))
15749 (when (or (not specific) (string= specific "ITEM")) 15576 (when (or (not specific) (string= specific "ITEM"))
@@ -16006,44 +15833,41 @@ non-nil when a property was removed."
16006(defun org-entry-add-to-multivalued-property (pom property value) 15833(defun org-entry-add-to-multivalued-property (pom property value)
16007 "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM." 15834 "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
16008 (let* ((old (org-entry-get pom property)) 15835 (let* ((old (org-entry-get pom property))
16009 (values (and old (org-split-string old "[ \t]")))) 15836 (values (and old (split-string old))))
16010 (setq value (org-entry-protect-space value)) 15837 (setq value (org-entry-protect-space value))
16011 (unless (member value values) 15838 (unless (member value values)
16012 (setq values (append values (list value))) 15839 (setq values (append values (list value)))
16013 (org-entry-put pom property 15840 (org-entry-put pom property (mapconcat #'identity values " ")))))
16014 (mapconcat 'identity values " ")))))
16015 15841
16016(defun org-entry-remove-from-multivalued-property (pom property value) 15842(defun org-entry-remove-from-multivalued-property (pom property value)
16017 "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM." 15843 "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
16018 (let* ((old (org-entry-get pom property)) 15844 (let* ((old (org-entry-get pom property))
16019 (values (and old (org-split-string old "[ \t]")))) 15845 (values (and old (split-string old))))
16020 (setq value (org-entry-protect-space value)) 15846 (setq value (org-entry-protect-space value))
16021 (when (member value values) 15847 (when (member value values)
16022 (setq values (delete value values)) 15848 (setq values (delete value values))
16023 (org-entry-put pom property 15849 (org-entry-put pom property (mapconcat #'identity values " ")))))
16024 (mapconcat 'identity values " ")))))
16025 15850
16026(defun org-entry-member-in-multivalued-property (pom property value) 15851(defun org-entry-member-in-multivalued-property (pom property value)
16027 "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?" 15852 "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
16028 (let* ((old (org-entry-get pom property)) 15853 (let* ((old (org-entry-get pom property))
16029 (values (and old (org-split-string old "[ \t]")))) 15854 (values (and old (split-string old))))
16030 (setq value (org-entry-protect-space value)) 15855 (setq value (org-entry-protect-space value))
16031 (member value values))) 15856 (member value values)))
16032 15857
16033(defun org-entry-get-multivalued-property (pom property) 15858(defun org-entry-get-multivalued-property (pom property)
16034 "Return a list of values in a multivalued property." 15859 "Return a list of values in a multivalued property."
16035 (let* ((value (org-entry-get pom property)) 15860 (let* ((value (org-entry-get pom property))
16036 (values (and value (org-split-string value "[ \t]")))) 15861 (values (and value (split-string value))))
16037 (mapcar 'org-entry-restore-space values))) 15862 (mapcar #'org-entry-restore-space values)))
16038 15863
16039(defun org-entry-put-multivalued-property (pom property &rest values) 15864(defun org-entry-put-multivalued-property (pom property &rest values)
16040 "Set multivalued PROPERTY at point-or-marker POM to VALUES. 15865 "Set multivalued PROPERTY at point-or-marker POM to VALUES.
16041VALUES should be a list of strings. Spaces will be protected." 15866VALUES should be a list of strings. Spaces will be protected."
16042 (org-entry-put pom property 15867 (org-entry-put pom property (mapconcat #'org-entry-protect-space values " "))
16043 (mapconcat 'org-entry-protect-space values " "))
16044 (let* ((value (org-entry-get pom property)) 15868 (let* ((value (org-entry-get pom property))
16045 (values (and value (org-split-string value "[ \t]")))) 15869 (values (and value (split-string value))))
16046 (mapcar 'org-entry-restore-space values))) 15870 (mapcar #'org-entry-restore-space values)))
16047 15871
16048(defun org-entry-protect-space (s) 15872(defun org-entry-protect-space (s)
16049 "Protect spaces and newline in string S." 15873 "Protect spaces and newline in string S."
@@ -16578,7 +16402,7 @@ completion."
16578 (when (equal prop org-effort-property) 16402 (when (equal prop org-effort-property)
16579 (org-refresh-property 16403 (org-refresh-property
16580 '((effort . identity) 16404 '((effort . identity)
16581 (effort-minutes . org-duration-string-to-minutes)) 16405 (effort-minutes . org-duration-to-minutes))
16582 nval) 16406 nval)
16583 (when (string= org-clock-current-task heading) 16407 (when (string= org-clock-current-task heading)
16584 (setq org-clock-effort nval) 16408 (setq org-clock-effort nval)
@@ -16607,6 +16431,8 @@ only headings."
16607 end found flevel) 16431 end found flevel)
16608 (unless buffer (error "File not found :%s" file)) 16432 (unless buffer (error "File not found :%s" file))
16609 (with-current-buffer buffer 16433 (with-current-buffer buffer
16434 (unless (derived-mode-p 'org-mode)
16435 (error "Buffer %s needs to be in Org mode" buffer))
16610 (org-with-wide-buffer 16436 (org-with-wide-buffer
16611 (goto-char (point-min)) 16437 (goto-char (point-min))
16612 (dolist (heading path) 16438 (dolist (heading path)
@@ -16679,7 +16505,6 @@ Return the position where this entry starts, or nil if there is no such entry."
16679(defvar org-last-changed-timestamp nil) 16505(defvar org-last-changed-timestamp nil)
16680(defvar org-last-inserted-timestamp nil 16506(defvar org-last-inserted-timestamp nil
16681 "The last time stamp inserted with `org-insert-time-stamp'.") 16507 "The last time stamp inserted with `org-insert-time-stamp'.")
16682(defvar org-ts-what) ; dynamically scoped parameter
16683 16508
16684(defun org-time-stamp (arg &optional inactive) 16509(defun org-time-stamp (arg &optional inactive)
16685 "Prompt for a date/time and insert a time stamp. 16510 "Prompt for a date/time and insert a time stamp.
@@ -16703,7 +16528,7 @@ non-nil."
16703 (let* ((ts (cond 16528 (let* ((ts (cond
16704 ((org-at-date-range-p t) 16529 ((org-at-date-range-p t)
16705 (match-string (if (< (point) (- (match-beginning 2) 2)) 1 2))) 16530 (match-string (if (< (point) (- (match-beginning 2) 2)) 1 2)))
16706 ((org-at-timestamp-p t) (match-string 0)))) 16531 ((org-at-timestamp-p 'lax) (match-string 0))))
16707 ;; Default time is either the timestamp at point or today. 16532 ;; Default time is either the timestamp at point or today.
16708 ;; When entering a range, only the range start is considered. 16533 ;; When entering a range, only the range start is considered.
16709 (default-time (if (not ts) (current-time) 16534 (default-time (if (not ts) (current-time)
@@ -16731,9 +16556,9 @@ non-nil."
16731 (ts 16556 (ts
16732 ;; Make sure we're on a timestamp. When in the middle of a date 16557 ;; Make sure we're on a timestamp. When in the middle of a date
16733 ;; range, move arbitrarily to range end. 16558 ;; range, move arbitrarily to range end.
16734 (unless (org-at-timestamp-p t) 16559 (unless (org-at-timestamp-p 'lax)
16735 (skip-chars-forward "-") 16560 (skip-chars-forward "-")
16736 (org-at-timestamp-p t)) 16561 (org-at-timestamp-p 'lax))
16737 (replace-match "") 16562 (replace-match "")
16738 (setq org-last-changed-timestamp 16563 (setq org-last-changed-timestamp
16739 (org-insert-time-stamp 16564 (org-insert-time-stamp
@@ -17411,24 +17236,19 @@ The command returns the inserted time stamp."
17411(defun org-display-custom-time (beg end) 17236(defun org-display-custom-time (beg end)
17412 "Overlay modified time stamp format over timestamp between BEG and END." 17237 "Overlay modified time stamp format over timestamp between BEG and END."
17413 (let* ((ts (buffer-substring beg end)) 17238 (let* ((ts (buffer-substring beg end))
17414 t1 w1 with-hm tf time str w2 (off 0)) 17239 t1 with-hm tf time str (off 0))
17415 (save-match-data 17240 (save-match-data
17416 (setq t1 (org-parse-time-string ts t)) 17241 (setq t1 (org-parse-time-string ts t))
17417 (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) 17242 (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
17418 (setq off (- (match-end 0) (match-beginning 0))))) 17243 (setq off (- (match-end 0) (match-beginning 0)))))
17419 (setq end (- end off)) 17244 (setq end (- end off))
17420 (setq w1 (- end beg) 17245 (setq with-hm (and (nth 1 t1) (nth 2 t1))
17421 with-hm (and (nth 1 t1) (nth 2 t1))
17422 tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats) 17246 tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)
17423 time (org-fix-decoded-time t1) 17247 time (org-fix-decoded-time t1)
17424 str (org-add-props 17248 str (org-add-props
17425 (format-time-string 17249 (format-time-string
17426 (substring tf 1 -1) (apply 'encode-time time)) 17250 (substring tf 1 -1) (apply 'encode-time time))
17427 nil 'mouse-face 'highlight) 17251 nil 'mouse-face 'highlight))
17428 w2 (length str))
17429 (unless (= w2 w1)
17430 (add-text-properties (1+ beg) (+ 2 beg)
17431 (list 'org-dwidth t 'org-dwidth-n (- w1 w2))))
17432 (put-text-property beg end 'display str))) 17252 (put-text-property beg end 'display str)))
17433 17253
17434(defun org-fix-decoded-time (time) 17254(defun org-fix-decoded-time (time)
@@ -17547,8 +17367,8 @@ both scheduled and deadline timestamps."
17547 'timestamp) 17367 'timestamp)
17548 (org-at-planning-p)) 17368 (org-at-planning-p))
17549 (time-less-p 17369 (time-less-p
17550 (org-time-string-to-time match) 17370 (org-time-string-to-time match t)
17551 (org-time-string-to-time d))))))) 17371 (org-time-string-to-time d t)))))))
17552 (message "%d entries before %s" 17372 (message "%d entries before %s"
17553 (org-occur regexp nil callback) 17373 (org-occur regexp nil callback)
17554 d))) 17374 d)))
@@ -17569,8 +17389,8 @@ both scheduled and deadline timestamps."
17569 'timestamp) 17389 'timestamp)
17570 (org-at-planning-p)) 17390 (org-at-planning-p))
17571 (not (time-less-p 17391 (not (time-less-p
17572 (org-time-string-to-time match) 17392 (org-time-string-to-time match t)
17573 (org-time-string-to-time d)))))))) 17393 (org-time-string-to-time d t))))))))
17574 (message "%d entries after %s" 17394 (message "%d entries after %s"
17575 (org-occur regexp nil callback) 17395 (org-occur regexp nil callback)
17576 d))) 17396 d)))
@@ -17593,11 +17413,11 @@ both scheduled and deadline timestamps."
17593 'timestamp) 17413 'timestamp)
17594 (org-at-planning-p)) 17414 (org-at-planning-p))
17595 (not (time-less-p 17415 (not (time-less-p
17596 (org-time-string-to-time match) 17416 (org-time-string-to-time match t)
17597 (org-time-string-to-time start-date))) 17417 (org-time-string-to-time start-date t)))
17598 (time-less-p 17418 (time-less-p
17599 (org-time-string-to-time match) 17419 (org-time-string-to-time match t)
17600 (org-time-string-to-time end-date)))))))) 17420 (org-time-string-to-time end-date t))))))))
17601 (message "%d entries between %s and %s" 17421 (message "%d entries between %s and %s"
17602 (org-occur regexp nil callback) start-date end-date))) 17422 (org-occur regexp nil callback) start-date end-date)))
17603 17423
@@ -17682,19 +17502,19 @@ days in order to avoid rounding problems."
17682 (push m l)) 17502 (push m l))
17683 (apply 'format fmt (nreverse l)))) 17503 (apply 'format fmt (nreverse l))))
17684 17504
17685(defun org-time-string-to-time (s &optional buffer pos) 17505(defun org-time-string-to-time (s &optional zone)
17686 "Convert a timestamp string into internal time." 17506 "Convert timestamp string S into internal time.
17687 (condition-case errdata 17507The optional ZONE is omitted or nil for Emacs local time, t for
17688 (apply 'encode-time (org-parse-time-string s)) 17508Universal Time, ‘wall’ for system wall clock time, or a string as
17689 (error (error "Bad timestamp `%s'%s\nError was: %s" 17509in the TZ environment variable."
17690 s (if (not (and buffer pos)) 17510 (apply #'encode-time (org-parse-time-string s nil zone)))
17691 ""
17692 (format-message " at %d in buffer `%s'" pos buffer))
17693 (cdr errdata)))))
17694 17511
17695(defun org-time-string-to-seconds (s) 17512(defun org-time-string-to-seconds (s &optional zone)
17696 "Convert a timestamp string to a number of seconds." 17513 "Convert a timestamp string S into a number of seconds.
17697 (float-time (org-time-string-to-time s))) 17514The optional ZONE is omitted or nil for Emacs local time, t for
17515Universal Time, ‘wall’ for system wall clock time, or a string as
17516in the TZ environment variable."
17517 (float-time (org-time-string-to-time s zone)))
17698 17518
17699(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp") 17519(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
17700 17520
@@ -17960,7 +17780,7 @@ With prefix ARG, change by that many units."
17960 "Increase the date in the time stamp by one day. 17780 "Increase the date in the time stamp by one day.
17961With prefix ARG, change that many days." 17781With prefix ARG, change that many days."
17962 (interactive "p") 17782 (interactive "p")
17963 (if (and (not (org-at-timestamp-p t)) 17783 (if (and (not (org-at-timestamp-p 'lax))
17964 (org-at-heading-p)) 17784 (org-at-heading-p))
17965 (org-todo 'up) 17785 (org-todo 'up)
17966 (org-timestamp-change (prefix-numeric-value arg) 'day 'updown))) 17786 (org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
@@ -17969,54 +17789,89 @@ With prefix ARG, change that many days."
17969 "Decrease the date in the time stamp by one day. 17789 "Decrease the date in the time stamp by one day.
17970With prefix ARG, change that many days." 17790With prefix ARG, change that many days."
17971 (interactive "p") 17791 (interactive "p")
17972 (if (and (not (org-at-timestamp-p t)) 17792 (if (and (not (org-at-timestamp-p 'lax))
17973 (org-at-heading-p)) 17793 (org-at-heading-p))
17974 (org-todo 'down) 17794 (org-todo 'down)
17975 (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown)) 17795 (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
17976 17796
17977(defun org-at-timestamp-p (&optional inactive-ok) 17797(defun org-at-timestamp-p (&optional extended)
17978 "Non-nil if point is inside a timestamp. 17798 "Non-nil if point is inside a timestamp.
17979 17799
17980When optional argument INACTIVE-OK is non-nil, also consider 17800By default, the function only consider syntactically valid active
17981inactive timestamps. 17801timestamps. However, the caller may have a broader definition
17802for timestamps. As a consequence, optional argument EXTENDED can
17803be set to the following values
17982 17804
17983When this function returns a non-nil value, match data is set 17805 `inactive'
17984according to `org-ts-regexp3' or `org-ts-regexp2', depending on 17806
17985INACTIVE-OK." 17807 Include also syntactically valid inactive timestamps.
17986 (interactive) 17808
17987 (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2)) 17809 `agenda'
17810
17811 Include timestamps allowed in Agenda, i.e., those in
17812 properties drawers, planning lines and clock lines.
17813
17814 `lax'
17815
17816 Ignore context. The function matches any part of the
17817 document looking like a timestamp. This includes comments,
17818 example blocks...
17819
17820For backward-compatibility with Org 9.0, every other non-nil
17821value is equivalent to `inactive'.
17822
17823When at a timestamp, return the position of the point as a symbol
17824among `bracket', `after', `year', `month', `hour', `minute',
17825`day' or a number of character from the last know part of the
17826time stamp.
17827
17828When matching, the match groups are the following:
17829 group 1: year
17830 group 2: month
17831 group 3: day number
17832 group 4: day name
17833 group 5: hours, if any
17834 group 6: minutes, if any"
17835 (let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2))
17988 (pos (point)) 17836 (pos (point))
17989 (ans (or (looking-at tsr) 17837 (match?
17990 (save-excursion 17838 (let ((boundaries (org-in-regexp regexp)))
17991 (skip-chars-backward "^[<\n\r\t") 17839 (save-match-data
17992 (when (> (point) (point-min)) (backward-char 1)) 17840 (cond ((null boundaries) nil)
17993 (and (looking-at tsr) 17841 ((eq extended 'lax) t)
17994 (> (- (match-end 0) pos) -1)))))) 17842 (t
17995 (and ans 17843 (or (and (eq extended 'agenda)
17996 (boundp 'org-ts-what) 17844 (or (org-at-planning-p)
17997 (setq org-ts-what 17845 (org-at-property-p)
17998 (cond 17846 (and (bound-and-true-p
17999 ((= pos (match-beginning 0)) 'bracket) 17847 org-agenda-include-inactive-timestamps)
18000 ;; Point is considered to be "on the bracket" whether 17848 (org-at-clock-log-p))))
18001 ;; it's really on it or right after it. 17849 (eq 'timestamp
18002 ((= pos (1- (match-end 0))) 'bracket) 17850 (save-excursion
18003 ((= pos (match-end 0)) 'after) 17851 (when (= pos (cdr boundaries)) (forward-char -1))
18004 ((org-pos-in-match-range pos 2) 'year) 17852 (org-element-type (org-element-context)))))))))))
18005 ((org-pos-in-match-range pos 3) 'month) 17853 (cond
18006 ((org-pos-in-match-range pos 7) 'hour) 17854 ((not match?) nil)
18007 ((org-pos-in-match-range pos 8) 'minute) 17855 ((= pos (match-beginning 0)) 'bracket)
18008 ((or (org-pos-in-match-range pos 4) 17856 ;; Distinguish location right before the closing bracket from
18009 (org-pos-in-match-range pos 5)) 'day) 17857 ;; right after it.
18010 ((and (> pos (or (match-end 8) (match-end 5))) 17858 ((= pos (1- (match-end 0))) 'bracket)
18011 (< pos (match-end 0))) 17859 ((= pos (match-end 0)) 'after)
18012 (- pos (or (match-end 8) (match-end 5)))) 17860 ((org-pos-in-match-range pos 2) 'year)
18013 (t 'day)))) 17861 ((org-pos-in-match-range pos 3) 'month)
18014 ans)) 17862 ((org-pos-in-match-range pos 7) 'hour)
17863 ((org-pos-in-match-range pos 8) 'minute)
17864 ((or (org-pos-in-match-range pos 4)
17865 (org-pos-in-match-range pos 5)) 'day)
17866 ((and (> pos (or (match-end 8) (match-end 5)))
17867 (< pos (match-end 0)))
17868 (- pos (or (match-end 8) (match-end 5))))
17869 (t 'day))))
18015 17870
18016(defun org-toggle-timestamp-type () 17871(defun org-toggle-timestamp-type ()
18017 "Toggle the type (<active> or [inactive]) of a time stamp." 17872 "Toggle the type (<active> or [inactive]) of a time stamp."
18018 (interactive) 17873 (interactive)
18019 (when (org-at-timestamp-p t) 17874 (when (org-at-timestamp-p 'lax)
18020 (let ((beg (match-beginning 0)) (end (match-end 0)) 17875 (let ((beg (match-beginning 0)) (end (match-end 0))
18021 (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]")))) 17876 (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]"))))
18022 (save-excursion 17877 (save-excursion
@@ -18027,11 +17882,10 @@ INACTIVE-OK."
18027 (message "Timestamp is now %sactive" 17882 (message "Timestamp is now %sactive"
18028 (if (equal (char-after beg) ?<) "" "in"))))) 17883 (if (equal (char-after beg) ?<) "" "in")))))
18029 17884
18030(defun org-at-clock-log-p nil 17885(defun org-at-clock-log-p ()
18031 "Is the cursor on the clock log line?" 17886 "Non-nil if point is on a clock log line."
18032 (save-excursion 17887 (and (org-match-line org-clock-line-re)
18033 (beginning-of-line) 17888 (eq (org-element-type (save-match-data (org-element-at-point))) 'clock)))
18034 (looking-at org-clock-line-re)))
18035 17889
18036(defvar org-clock-history) ; defined in org-clock.el 17890(defvar org-clock-history) ; defined in org-clock.el
18037(defvar org-clock-adjust-closest nil) ; defined in org-clock.el 17891(defvar org-clock-adjust-closest nil) ; defined in org-clock.el
@@ -18041,26 +17895,26 @@ The date will be changed by N times WHAT. WHAT can be `day', `month',
18041`year', `minute', `second'. If WHAT is not given, the cursor position 17895`year', `minute', `second'. If WHAT is not given, the cursor position
18042in the timestamp determines what will be changed. 17896in the timestamp determines what will be changed.
18043When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." 17897When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
18044 (let ((origin (point)) origin-cat 17898 (let ((origin (point))
17899 (timestamp? (org-at-timestamp-p 'lax))
17900 origin-cat
18045 with-hm inactive 17901 with-hm inactive
18046 (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) 17902 (dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
18047 org-ts-what
18048 extra rem 17903 extra rem
18049 ts time time0 fixnext clrgx) 17904 ts time time0 fixnext clrgx)
18050 (unless (org-at-timestamp-p t) 17905 (unless timestamp? (user-error "Not at a timestamp"))
18051 (user-error "Not at a timestamp")) 17906 (if (and (not what) (eq timestamp? 'bracket))
18052 (if (and (not what) (eq org-ts-what 'bracket))
18053 (org-toggle-timestamp-type) 17907 (org-toggle-timestamp-type)
18054 ;; Point isn't on brackets. Remember the part of the time-stamp 17908 ;; Point isn't on brackets. Remember the part of the time-stamp
18055 ;; the point was in. Indeed, size of time-stamps may change, 17909 ;; the point was in. Indeed, size of time-stamps may change,
18056 ;; but point must be kept in the same category nonetheless. 17910 ;; but point must be kept in the same category nonetheless.
18057 (setq origin-cat org-ts-what) 17911 (setq origin-cat timestamp?)
18058 (when (and (not what) (not (eq org-ts-what 'day)) 17912 (when (and (not what) (not (eq timestamp? 'day))
18059 org-display-custom-times 17913 org-display-custom-times
18060 (get-text-property (point) 'display) 17914 (get-text-property (point) 'display)
18061 (not (get-text-property (1- (point)) 'display))) 17915 (not (get-text-property (1- (point)) 'display)))
18062 (setq org-ts-what 'day)) 17916 (setq timestamp? 'day))
18063 (setq org-ts-what (or what org-ts-what) 17917 (setq timestamp? (or what timestamp?)
18064 inactive (= (char-after (match-beginning 0)) ?\[) 17918 inactive (= (char-after (match-beginning 0)) ?\[)
18065 ts (match-string 0)) 17919 ts (match-string 0))
18066 (replace-match "") 17920 (replace-match "")
@@ -18074,7 +17928,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
18074 (setq with-hm t)) 17928 (setq with-hm t))
18075 (setq time0 (org-parse-time-string ts)) 17929 (setq time0 (org-parse-time-string ts))
18076 (when (and updown 17930 (when (and updown
18077 (eq org-ts-what 'minute) 17931 (eq timestamp? 'minute)
18078 (not current-prefix-arg)) 17932 (not current-prefix-arg))
18079 ;; This looks like s-up and s-down. Change by one rounding step. 17933 ;; This looks like s-up and s-down. Change by one rounding step.
18080 (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) 17934 (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
@@ -18084,21 +17938,21 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
18084 (setq time 17938 (setq time
18085 (apply #'encode-time 17939 (apply #'encode-time
18086 (or (car time0) 0) 17940 (or (car time0) 0)
18087 (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) 17941 (+ (if (eq timestamp? 'minute) n 0) (nth 1 time0))
18088 (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) 17942 (+ (if (eq timestamp? 'hour) n 0) (nth 2 time0))
18089 (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) 17943 (+ (if (eq timestamp? 'day) n 0) (nth 3 time0))
18090 (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) 17944 (+ (if (eq timestamp? 'month) n 0) (nth 4 time0))
18091 (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) 17945 (+ (if (eq timestamp? 'year) n 0) (nth 5 time0))
18092 (nthcdr 6 time0))) 17946 (nthcdr 6 time0)))
18093 (when (and (member org-ts-what '(hour minute)) 17947 (when (and (memq timestamp? '(hour minute))
18094 extra 17948 extra
18095 (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) 17949 (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
18096 (setq extra (org-modify-ts-extra 17950 (setq extra (org-modify-ts-extra
18097 extra 17951 extra
18098 (if (eq org-ts-what 'hour) 2 5) 17952 (if (eq timestamp? 'hour) 2 5)
18099 n dm))) 17953 n dm)))
18100 (when (integerp org-ts-what) 17954 (when (integerp timestamp?)
18101 (setq extra (org-modify-ts-extra extra org-ts-what n dm))) 17955 (setq extra (org-modify-ts-extra extra timestamp? n dm)))
18102 (when (eq what 'calendar) 17956 (when (eq what 'calendar)
18103 (let ((cal-date (org-get-date-from-calendar))) 17957 (let ((cal-date (org-get-date-from-calendar)))
18104 (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month 17958 (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
@@ -18165,14 +18019,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
18165 (when (re-search-forward clrgx nil t) 18019 (when (re-search-forward clrgx nil t)
18166 (goto-char (match-beginning 1)) 18020 (goto-char (match-beginning 1))
18167 (let (org-clock-adjust-closest) 18021 (let (org-clock-adjust-closest)
18168 (org-timestamp-change n org-ts-what updown)) 18022 (org-timestamp-change n timestamp? updown))
18169 (message "Clock adjusted in %s for heading: %s" 18023 (message "Clock adjusted in %s for heading: %s"
18170 (file-name-nondirectory (buffer-file-name)) 18024 (file-name-nondirectory (buffer-file-name))
18171 (org-get-heading t t))))))))) 18025 (org-get-heading t t)))))))))
18172 ;; Try to recenter the calendar window, if any. 18026 ;; Try to recenter the calendar window, if any.
18173 (when (and org-calendar-follow-timestamp-change 18027 (when (and org-calendar-follow-timestamp-change
18174 (get-buffer-window "*Calendar*" t) 18028 (get-buffer-window "*Calendar*" t)
18175 (memq org-ts-what '(day month year))) 18029 (memq timestamp? '(day month year)))
18176 (org-recenter-calendar (time-to-days time)))))) 18030 (org-recenter-calendar (time-to-days time))))))
18177 18031
18178(defun org-modify-ts-extra (s pos n dm) 18032(defun org-modify-ts-extra (s pos n dm)
@@ -18226,17 +18080,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
18226If there is a time stamp in the current line, go to that date. 18080If there is a time stamp in the current line, go to that date.
18227A prefix ARG can be used to force the current date." 18081A prefix ARG can be used to force the current date."
18228 (interactive "P") 18082 (interactive "P")
18229 (let ((tsr org-ts-regexp) diff 18083 (let ((calendar-move-hook nil)
18230 (calendar-move-hook nil)
18231 (calendar-view-holidays-initially-flag nil) 18084 (calendar-view-holidays-initially-flag nil)
18232 (calendar-view-diary-initially-flag nil)) 18085 (calendar-view-diary-initially-flag nil)
18233 (when (or (org-at-timestamp-p) 18086 diff)
18234 (save-excursion 18087 (when (or (org-at-timestamp-p 'lax)
18235 (beginning-of-line 1) 18088 (org-match-line (concat ".*" org-ts-regexp)))
18236 (looking-at (concat ".*" tsr))))
18237 (let ((d1 (time-to-days (current-time))) 18089 (let ((d1 (time-to-days (current-time)))
18238 (d2 (time-to-days 18090 (d2 (time-to-days (org-time-string-to-time (match-string 1)))))
18239 (org-time-string-to-time (match-string 1)))))
18240 (setq diff (- d2 d1)))) 18091 (setq diff (- d2 d1))))
18241 (calendar) 18092 (calendar)
18242 (calendar-goto-today) 18093 (calendar-goto-today)
@@ -18252,7 +18103,7 @@ A prefix ARG can be used to force the current date."
18252 "Insert time stamp corresponding to cursor date in *Calendar* buffer. 18103 "Insert time stamp corresponding to cursor date in *Calendar* buffer.
18253If there is already a time stamp at the cursor position, update it." 18104If there is already a time stamp at the cursor position, update it."
18254 (interactive) 18105 (interactive)
18255 (if (org-at-timestamp-p t) 18106 (if (org-at-timestamp-p 'lax)
18256 (org-timestamp-change 0 'calendar) 18107 (org-timestamp-change 0 'calendar)
18257 (let ((cal-date (org-get-date-from-calendar))) 18108 (let ((cal-date (org-get-date-from-calendar)))
18258 (org-insert-time-stamp 18109 (org-insert-time-stamp
@@ -18281,113 +18132,6 @@ effort string \"2hours\" is equivalent to 120 minutes."
18281 :type '(alist :key-type (string :tag "Modifier") 18132 :type '(alist :key-type (string :tag "Modifier")
18282 :value-type (number :tag "Minutes"))) 18133 :value-type (number :tag "Minutes")))
18283 18134
18284(defun org-minutes-to-clocksum-string (m)
18285 "Format number of minutes as a clocksum string.
18286The format is determined by `org-time-clocksum-format',
18287`org-time-clocksum-use-fractional' and
18288`org-time-clocksum-fractional-format' and
18289`org-time-clocksum-use-effort-durations'."
18290 (let ((clocksum "")
18291 (m (round m)) ; Don't allow fractions of minutes
18292 h d w mo y fmt n)
18293 (setq h (if org-time-clocksum-use-effort-durations
18294 (cdr (assoc "h" org-effort-durations)) 60)
18295 d (if org-time-clocksum-use-effort-durations
18296 (/ (cdr (assoc "d" org-effort-durations)) h) 24)
18297 w (if org-time-clocksum-use-effort-durations
18298 (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7)
18299 mo (if org-time-clocksum-use-effort-durations
18300 (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30)
18301 y (if org-time-clocksum-use-effort-durations
18302 (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365))
18303 ;; fractional format
18304 (if org-time-clocksum-use-fractional
18305 (cond
18306 ;; single format string
18307 ((stringp org-time-clocksum-fractional-format)
18308 (format org-time-clocksum-fractional-format (/ m (float h))))
18309 ;; choice of fractional formats for different time units
18310 ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years))
18311 (> (/ (truncate m) (* y d h)) 0))
18312 (format fmt (/ m (* y d (float h)))))
18313 ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months))
18314 (> (/ (truncate m) (* mo d h)) 0))
18315 (format fmt (/ m (* mo d (float h)))))
18316 ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
18317 (> (/ (truncate m) (* w d h)) 0))
18318 (format fmt (/ m (* w d (float h)))))
18319 ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days))
18320 (> (/ (truncate m) (* d h)) 0))
18321 (format fmt (/ m (* d (float h)))))
18322 ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours))
18323 (> (/ (truncate m) h) 0))
18324 (format fmt (/ m (float h))))
18325 ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes))
18326 (format fmt m))
18327 ;; fall back to smallest time unit with a format
18328 ((setq fmt (plist-get org-time-clocksum-fractional-format :hours))
18329 (format fmt (/ m (float h))))
18330 ((setq fmt (plist-get org-time-clocksum-fractional-format :days))
18331 (format fmt (/ m (* d (float h)))))
18332 ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
18333 (format fmt (/ m (* w d (float h)))))
18334 ((setq fmt (plist-get org-time-clocksum-fractional-format :months))
18335 (format fmt (/ m (* mo d (float h)))))
18336 ((setq fmt (plist-get org-time-clocksum-fractional-format :years))
18337 (format fmt (/ m (* y d (float h))))))
18338 ;; standard (non-fractional) format, with single format string
18339 (if (stringp org-time-clocksum-format)
18340 (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n)))
18341 ;; separate formats components
18342 (and (setq fmt (plist-get org-time-clocksum-format :years))
18343 (or (> (setq n (/ (truncate m) (* y d h))) 0)
18344 (plist-get org-time-clocksum-format :require-years))
18345 (setq clocksum (concat clocksum (format fmt n))
18346 m (- m (* n y d h))))
18347 (and (setq fmt (plist-get org-time-clocksum-format :months))
18348 (or (> (setq n (/ (truncate m) (* mo d h))) 0)
18349 (plist-get org-time-clocksum-format :require-months))
18350 (setq clocksum (concat clocksum (format fmt n))
18351 m (- m (* n mo d h))))
18352 (and (setq fmt (plist-get org-time-clocksum-format :weeks))
18353 (or (> (setq n (/ (truncate m) (* w d h))) 0)
18354 (plist-get org-time-clocksum-format :require-weeks))
18355 (setq clocksum (concat clocksum (format fmt n))
18356 m (- m (* n w d h))))
18357 (and (setq fmt (plist-get org-time-clocksum-format :days))
18358 (or (> (setq n (/ (truncate m) (* d h))) 0)
18359 (plist-get org-time-clocksum-format :require-days))
18360 (setq clocksum (concat clocksum (format fmt n))
18361 m (- m (* n d h))))
18362 (and (setq fmt (plist-get org-time-clocksum-format :hours))
18363 (or (> (setq n (/ (truncate m) h)) 0)
18364 (plist-get org-time-clocksum-format :require-hours))
18365 (setq clocksum (concat clocksum (format fmt n))
18366 m (- m (* n h))))
18367 (and (setq fmt (plist-get org-time-clocksum-format :minutes))
18368 (or (> m 0) (plist-get org-time-clocksum-format :require-minutes))
18369 (setq clocksum (concat clocksum (format fmt m))))
18370 ;; return formatted time duration
18371 clocksum))))
18372
18373(defun org-hours-to-clocksum-string (n)
18374 (org-minutes-to-clocksum-string (* n 60)))
18375
18376(defun org-hh:mm-string-to-minutes (s)
18377 "Convert a string H:MM to a number of minutes.
18378If the string is just a number, interpret it as minutes.
18379In fact, the first hh:mm or number in the string will be taken,
18380there can be extra stuff in the string.
18381If no number is found, the return value is 0."
18382 (cond
18383 ((integerp s) s)
18384 ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
18385 (+ (* (string-to-number (match-string 1 s)) 60)
18386 (string-to-number (match-string 2 s))))
18387 ((string-match "\\([0-9]+\\)" s)
18388 (string-to-number (match-string 1 s)))
18389 (t 0)))
18390
18391(defcustom org-image-actual-width t 18135(defcustom org-image-actual-width t
18392 "Should we use the actual width of images when inlining them? 18136 "Should we use the actual width of images when inlining them?
18393 18137
@@ -18442,26 +18186,6 @@ The value is a list, with zero or more of the symbols `effort', `appt',
18442 :package-version '(Org . "8.3") 18186 :package-version '(Org . "8.3")
18443 :group 'org-agenda) 18187 :group 'org-agenda)
18444 18188
18445(defun org-duration-string-to-minutes (s &optional output-to-string)
18446 "Convert a duration string S to minutes.
18447
18448A bare number is interpreted as minutes, modifiers can be set by
18449customizing `org-effort-durations' (which see).
18450
18451Entries containing a colon are interpreted as H:MM by
18452`org-hh:mm-string-to-minutes'."
18453 (let ((result 0)
18454 (re (concat "\\([0-9.]+\\) *\\("
18455 (regexp-opt (mapcar 'car org-effort-durations))
18456 "\\)")))
18457 (while (string-match re s)
18458 (cl-incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
18459 (string-to-number (match-string 1 s))))
18460 (setq s (replace-match "" nil t s)))
18461 (setq result (floor result))
18462 (cl-incf result (org-hh:mm-string-to-minutes s))
18463 (if output-to-string (number-to-string result) result)))
18464
18465;;;; Files 18189;;;; Files
18466 18190
18467(defun org-save-all-org-buffers () 18191(defun org-save-all-org-buffers ()
@@ -19592,17 +19316,26 @@ boundaries."
19592 (when (fboundp 'clear-image-cache) (clear-image-cache))) 19316 (when (fboundp 'clear-image-cache) (clear-image-cache)))
19593 (org-with-wide-buffer 19317 (org-with-wide-buffer
19594 (goto-char (or beg (point-min))) 19318 (goto-char (or beg (point-min)))
19595 (let ((case-fold-search t) 19319 (let* ((case-fold-search t)
19596 (file-extension-re (image-file-name-regexp))) 19320 (file-extension-re (image-file-name-regexp))
19597 (while (re-search-forward "[][]\\[\\(?:file\\|[./~]\\)" end t) 19321 (link-abbrevs (mapcar #'car
19322 (append org-link-abbrev-alist-local
19323 org-link-abbrev-alist)))
19324 ;; Check absolute, relative file names and explicit
19325 ;; "file:" links. Also check link abbreviations since
19326 ;; some might expand to "file" links.
19327 (file-types-re (format "[][]\\[\\(?:file\\|[./~]%s\\)"
19328 (and link-abbrevs
19329 (format "\\|\\(?:%s:\\)"
19330 (regexp-opt link-abbrevs))))))
19331 (while (re-search-forward file-types-re end t)
19598 (let ((link (save-match-data (org-element-context)))) 19332 (let ((link (save-match-data (org-element-context))))
19599 ;; Check if we're at an inline image. 19333 ;; Check if we're at an inline image, i.e., an image file
19600 (when (and (equal (org-element-property :type link) "file") 19334 ;; link without a description (unless INCLUDE-LINKED is
19335 ;; non-nil).
19336 (when (and (equal "file" (org-element-property :type link))
19601 (or include-linked 19337 (or include-linked
19602 (not (org-element-property :contents-begin link))) 19338 (null (org-element-contents link)))
19603 (let ((parent (org-element-property :parent link)))
19604 (or (not (eq (org-element-type parent) 'link))
19605 (not (cdr (org-element-contents parent)))))
19606 (string-match-p file-extension-re 19339 (string-match-p file-extension-re
19607 (org-element-property :path link))) 19340 (org-element-property :path link)))
19608 (let ((file (expand-file-name 19341 (let ((file (expand-file-name
@@ -19650,23 +19383,13 @@ boundaries."
19650 nil 19383 nil
19651 :width width))) 19384 :width width)))
19652 (when image 19385 (when image
19653 (let* ((link 19386 (let ((ov (make-overlay
19654 ;; If inline image is the description 19387 (org-element-property :begin link)
19655 ;; of another link, be sure to 19388 (progn
19656 ;; consider the latter as the one to 19389 (goto-char
19657 ;; apply the overlay on. 19390 (org-element-property :end link))
19658 (let ((parent 19391 (skip-chars-backward " \t")
19659 (org-element-property :parent link))) 19392 (point)))))
19660 (if (eq (org-element-type parent) 'link)
19661 parent
19662 link)))
19663 (ov (make-overlay
19664 (org-element-property :begin link)
19665 (progn
19666 (goto-char
19667 (org-element-property :end link))
19668 (skip-chars-backward " \t")
19669 (point)))))
19670 (overlay-put ov 'display image) 19393 (overlay-put ov 'display image)
19671 (overlay-put ov 'face 'default) 19394 (overlay-put ov 'face 'default)
19672 (overlay-put ov 'org-image-overlay t) 19395 (overlay-put ov 'org-image-overlay t)
@@ -19690,6 +19413,14 @@ boundaries."
19690 19413
19691;;;; Key bindings 19414;;;; Key bindings
19692 19415
19416(defun org-remap (map &rest commands)
19417 "In MAP, remap the functions given in COMMANDS.
19418COMMANDS is a list of alternating OLDDEF NEWDEF command names."
19419 (let (new old)
19420 (while commands
19421 (setq old (pop commands) new (pop commands))
19422 (org-defkey map (vector 'remap old) new))))
19423
19693;; Outline functions from `outline-mode-prefix-map' 19424;; Outline functions from `outline-mode-prefix-map'
19694;; that can be remapped in Org: 19425;; that can be remapped in Org:
19695(define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree) 19426(define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree)
@@ -19742,6 +19473,7 @@ boundaries."
19742(org-defkey org-mode-map [(tab)] 'org-cycle) 19473(org-defkey org-mode-map [(tab)] 'org-cycle)
19743(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) 19474(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
19744(org-defkey org-mode-map "\M-\t" #'pcomplete) 19475(org-defkey org-mode-map "\M-\t" #'pcomplete)
19476
19745;; The following line is necessary under Suse GNU/Linux 19477;; The following line is necessary under Suse GNU/Linux
19746(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab) 19478(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)
19747(org-defkey org-mode-map [(shift tab)] 'org-shifttab) 19479(org-defkey org-mode-map [(shift tab)] 'org-shifttab)
@@ -19750,6 +19482,7 @@ boundaries."
19750(org-defkey org-mode-map [(shift return)] 'org-table-copy-down) 19482(org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
19751(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading) 19483(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
19752(org-defkey org-mode-map [(meta return)] 'org-meta-return) 19484(org-defkey org-mode-map [(meta return)] 'org-meta-return)
19485(org-defkey org-mode-map (kbd "M-RET") #'org-meta-return)
19753 19486
19754;; Cursor keys with modifiers 19487;; Cursor keys with modifiers
19755(org-defkey org-mode-map [(meta left)] 'org-metaleft) 19488(org-defkey org-mode-map [(meta left)] 'org-metaleft)
@@ -19814,8 +19547,13 @@ boundaries."
19814 (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown)) 19547 (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown))
19815 19548
19816;; All the other keys 19549;; All the other keys
19550(org-remap org-mode-map
19551 'self-insert-command 'org-self-insert-command
19552 'delete-char 'org-delete-char
19553 'delete-backward-char 'org-delete-backward-char)
19554(org-defkey org-mode-map "|" 'org-force-self-insert)
19817 19555
19818(org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up. 19556(org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up.
19819(org-defkey org-mode-map "\C-c\C-r" 'org-reveal) 19557(org-defkey org-mode-map "\C-c\C-r" 'org-reveal)
19820(if (boundp 'narrow-map) 19558(if (boundp 'narrow-map)
19821 (org-defkey narrow-map "s" 'org-narrow-to-subtree) 19559 (org-defkey narrow-map "s" 'org-narrow-to-subtree)
@@ -19854,7 +19592,6 @@ boundaries."
19854(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved 19592(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
19855(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. 19593(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res.
19856(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) 19594(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
19857(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
19858(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift) 19595(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift)
19859(org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible) 19596(org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible)
19860(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content) 19597(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content)
@@ -20079,7 +19816,7 @@ Use `org-speed-commands-user' for further customization."
20079 (cdr (assoc keys org-babel-key-bindings)))) 19816 (cdr (assoc keys org-babel-key-bindings))))
20080 19817
20081(defcustom org-speed-command-hook 19818(defcustom org-speed-command-hook
20082 '(org-speed-command-default-hook org-babel-speed-command-hook) 19819 '(org-speed-command-activate org-babel-speed-command-activate)
20083 "Hook for activating speed commands at strategic locations. 19820 "Hook for activating speed commands at strategic locations.
20084Hook functions are called in sequence until a valid handler is 19821Hook functions are called in sequence until a valid handler is
20085found. 19822found.
@@ -20243,6 +19980,7 @@ because, in this case the deletion might narrow the column."
20243 (org-check-before-invisible-edit 'delete-backward) 19980 (org-check-before-invisible-edit 'delete-backward)
20244 (if (and (org-at-table-p) 19981 (if (and (org-at-table-p)
20245 (eq N 1) 19982 (eq N 1)
19983 (not (org-region-active-p))
20246 (string-match "|" (buffer-substring (point-at-bol) (point))) 19984 (string-match "|" (buffer-substring (point-at-bol) (point)))
20247 (looking-at ".*?|")) 19985 (looking-at ".*?|"))
20248 (let ((pos (point)) 19986 (let ((pos (point))
@@ -20309,14 +20047,6 @@ because, in this case the deletion might narrow the column."
20309(put 'org-self-insert-command 'pabbrev-expand-after-command t) 20047(put 'org-self-insert-command 'pabbrev-expand-after-command t)
20310(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) 20048(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
20311 20049
20312(defun org-remap (map &rest commands)
20313 "In MAP, remap the functions given in COMMANDS.
20314COMMANDS is a list of alternating OLDDEF NEWDEF command names."
20315 (let (new old)
20316 (while commands
20317 (setq old (pop commands) new (pop commands))
20318 (org-defkey map (vector 'remap old) new))))
20319
20320(defun org-transpose-words () 20050(defun org-transpose-words ()
20321 "Transpose words for Org. 20051 "Transpose words for Org.
20322This uses the `org-mode-transpose-word-syntax-table' syntax 20052This uses the `org-mode-transpose-word-syntax-table' syntax
@@ -20327,15 +20057,6 @@ word constituents."
20327 (call-interactively 'transpose-words))) 20057 (call-interactively 'transpose-words)))
20328(org-remap org-mode-map 'transpose-words 'org-transpose-words) 20058(org-remap org-mode-map 'transpose-words 'org-transpose-words)
20329 20059
20330(when (eq org-enable-table-editor 'optimized)
20331 ;; If the user wants maximum table support, we need to hijack
20332 ;; some standard editing functions
20333 (org-remap org-mode-map
20334 'self-insert-command 'org-self-insert-command
20335 'delete-char 'org-delete-char
20336 'delete-backward-char 'org-delete-backward-char)
20337 (org-defkey org-mode-map "|" 'org-force-self-insert))
20338
20339(defvar org-ctrl-c-ctrl-c-hook nil 20060(defvar org-ctrl-c-ctrl-c-hook nil
20340 "Hook for functions attaching themselves to `C-c C-c'. 20061 "Hook for functions attaching themselves to `C-c C-c'.
20341 20062
@@ -20696,7 +20417,7 @@ depending on context. See the individual commands for more information."
20696 ((run-hook-with-args-until-success 'org-shiftup-hook)) 20417 ((run-hook-with-args-until-success 'org-shiftup-hook))
20697 ((and org-support-shift-select (org-region-active-p)) 20418 ((and org-support-shift-select (org-region-active-p))
20698 (org-call-for-shift-select 'previous-line)) 20419 (org-call-for-shift-select 'previous-line))
20699 ((org-at-timestamp-p t) 20420 ((org-at-timestamp-p 'lax)
20700 (call-interactively (if org-edit-timestamp-down-means-later 20421 (call-interactively (if org-edit-timestamp-down-means-later
20701 'org-timestamp-down 'org-timestamp-up))) 20422 'org-timestamp-down 'org-timestamp-up)))
20702 ((and (not (eq org-support-shift-select 'always)) 20423 ((and (not (eq org-support-shift-select 'always))
@@ -20720,7 +20441,7 @@ depending on context. See the individual commands for more information."
20720 ((run-hook-with-args-until-success 'org-shiftdown-hook)) 20441 ((run-hook-with-args-until-success 'org-shiftdown-hook))
20721 ((and org-support-shift-select (org-region-active-p)) 20442 ((and org-support-shift-select (org-region-active-p))
20722 (org-call-for-shift-select 'next-line)) 20443 (org-call-for-shift-select 'next-line))
20723 ((org-at-timestamp-p t) 20444 ((org-at-timestamp-p 'lax)
20724 (call-interactively (if org-edit-timestamp-down-means-later 20445 (call-interactively (if org-edit-timestamp-down-means-later
20725 'org-timestamp-up 'org-timestamp-down))) 20446 'org-timestamp-up 'org-timestamp-down)))
20726 ((and (not (eq org-support-shift-select 'always)) 20447 ((and (not (eq org-support-shift-select 'always))
@@ -20749,7 +20470,7 @@ Depending on context, this does one of the following:
20749 ((run-hook-with-args-until-success 'org-shiftright-hook)) 20470 ((run-hook-with-args-until-success 'org-shiftright-hook))
20750 ((and org-support-shift-select (org-region-active-p)) 20471 ((and org-support-shift-select (org-region-active-p))
20751 (org-call-for-shift-select 'forward-char)) 20472 (org-call-for-shift-select 'forward-char))
20752 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) 20473 ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-up-day))
20753 ((and (not (eq org-support-shift-select 'always)) 20474 ((and (not (eq org-support-shift-select 'always))
20754 (org-at-heading-p)) 20475 (org-at-heading-p))
20755 (let ((org-inhibit-logging 20476 (let ((org-inhibit-logging
@@ -20785,7 +20506,7 @@ Depending on context, this does one of the following:
20785 ((run-hook-with-args-until-success 'org-shiftleft-hook)) 20506 ((run-hook-with-args-until-success 'org-shiftleft-hook))
20786 ((and org-support-shift-select (org-region-active-p)) 20507 ((and org-support-shift-select (org-region-active-p))
20787 (org-call-for-shift-select 'backward-char)) 20508 (org-call-for-shift-select 'backward-char))
20788 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) 20509 ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-down-day))
20789 ((and (not (eq org-support-shift-select 'always)) 20510 ((and (not (eq org-support-shift-select 'always))
20790 (org-at-heading-p)) 20511 (org-at-heading-p))
20791 (let ((org-inhibit-logging 20512 (let ((org-inhibit-logging
@@ -20837,7 +20558,7 @@ Depending on context, this does one of the following:
20837 "Change timestamps synchronously up in CLOCK log lines. 20558 "Change timestamps synchronously up in CLOCK log lines.
20838Optional argument N tells to change by that many units." 20559Optional argument N tells to change by that many units."
20839 (interactive "P") 20560 (interactive "P")
20840 (if (and (org-at-clock-log-p) (org-at-timestamp-p t)) 20561 (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
20841 (let (org-support-shift-select) 20562 (let (org-support-shift-select)
20842 (org-clock-timestamps-up n)) 20563 (org-clock-timestamps-up n))
20843 (user-error "Not at a clock log"))) 20564 (user-error "Not at a clock log")))
@@ -20846,7 +20567,7 @@ Optional argument N tells to change by that many units."
20846 "Change timestamps synchronously down in CLOCK log lines. 20567 "Change timestamps synchronously down in CLOCK log lines.
20847Optional argument N tells to change by that many units." 20568Optional argument N tells to change by that many units."
20848 (interactive "P") 20569 (interactive "P")
20849 (if (and (org-at-clock-log-p) (org-at-timestamp-p t)) 20570 (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
20850 (let (org-support-shift-select) 20571 (let (org-support-shift-select)
20851 (org-clock-timestamps-down n)) 20572 (org-clock-timestamps-down n))
20852 (user-error "Not at a clock log"))) 20573 (user-error "Not at a clock log")))
@@ -20938,6 +20659,7 @@ When at a table, call the formula editor with `org-table-edit-formulas'.
20938When in a source code block, call `org-edit-src-code'. 20659When in a source code block, call `org-edit-src-code'.
20939When in a fixed-width region, call `org-edit-fixed-width-region'. 20660When in a fixed-width region, call `org-edit-fixed-width-region'.
20940When in an export block, call `org-edit-export-block'. 20661When in an export block, call `org-edit-export-block'.
20662When in a LaTeX environment, call `org-edit-latex-environment'.
20941When at an #+INCLUDE keyword, visit the included file. 20663When at an #+INCLUDE keyword, visit the included file.
20942When at a footnote reference, call `org-edit-footnote-reference' 20664When at a footnote reference, call `org-edit-footnote-reference'
20943On a link, call `ffap' to visit the link at point. 20665On a link, call `ffap' to visit the link at point.
@@ -20965,7 +20687,9 @@ Otherwise, return a user error."
20965 (format "[[%s]]" 20687 (format "[[%s]]"
20966 (expand-file-name 20688 (expand-file-name
20967 (let ((value (org-element-property :value element))) 20689 (let ((value (org-element-property :value element)))
20968 (cond ((not (org-string-nw-p value)) 20690 (cond ((org-file-url-p value)
20691 (user-error "The file is specified as a URL, cannot be edited"))
20692 ((not (org-string-nw-p value))
20969 (user-error "No file to edit")) 20693 (user-error "No file to edit"))
20970 ((string-match "\\`\"\\(.*?\\)\"" value) 20694 ((string-match "\\`\"\\(.*?\\)\"" value)
20971 (match-string 1 value)) 20695 (match-string 1 value))
@@ -20982,6 +20706,7 @@ Otherwise, return a user error."
20982 (`example-block (org-edit-src-code)) 20706 (`example-block (org-edit-src-code))
20983 (`export-block (org-edit-export-block)) 20707 (`export-block (org-edit-export-block))
20984 (`fixed-width (org-edit-fixed-width-region)) 20708 (`fixed-width (org-edit-fixed-width-region))
20709 (`latex-environment (org-edit-latex-environment))
20985 (_ 20710 (_
20986 ;; No notable element at point. Though, we may be at a link or 20711 ;; No notable element at point. Though, we may be at a link or
20987 ;; a footnote reference, which are objects. Thus, scan deeper. 20712 ;; a footnote reference, which are objects. Thus, scan deeper.
@@ -21194,22 +20919,21 @@ This command does many different things, depending on context:
21194 (if (eq (org-element-property :type context) 'table.el) 20919 (if (eq (org-element-property :type context) 'table.el)
21195 (message "%s" (substitute-command-keys "\\<org-mode-map>\ 20920 (message "%s" (substitute-command-keys "\\<org-mode-map>\
21196Use `\\[org-edit-special]' to edit table.el tables")) 20921Use `\\[org-edit-special]' to edit table.el tables"))
21197 (let ((org-enable-table-editor t)) 20922 (if (or (eq type 'table)
21198 (if (or (eq type 'table) 20923 ;; Check if point is at a TBLFM line.
21199 ;; Check if point is at a TBLFM line. 20924 (and (eq type 'table-row)
21200 (and (eq type 'table-row) 20925 (= (point) (org-element-property :end context))))
21201 (= (point) (org-element-property :end context)))) 20926 (save-excursion
21202 (save-excursion 20927 (if (org-at-TBLFM-p)
21203 (if (org-at-TBLFM-p) 20928 (progn (require 'org-table)
21204 (progn (require 'org-table) 20929 (org-table-calc-current-TBLFM))
21205 (org-table-calc-current-TBLFM)) 20930 (goto-char (org-element-property :contents-begin context))
21206 (goto-char (org-element-property :contents-begin context)) 20931 (org-call-with-arg 'org-table-recalculate (or arg t))
21207 (org-call-with-arg 'org-table-recalculate (or arg t)) 20932 (orgtbl-send-table 'maybe)))
21208 (orgtbl-send-table 'maybe))) 20933 (org-table-maybe-eval-formula)
21209 (org-table-maybe-eval-formula) 20934 (cond (arg (call-interactively #'org-table-recalculate))
21210 (cond (arg (call-interactively #'org-table-recalculate)) 20935 ((org-table-maybe-recalculate-line))
21211 ((org-table-maybe-recalculate-line)) 20936 (t (org-table-align))))))
21212 (t (org-table-align)))))))
21213 (`timestamp (org-timestamp-change 0 'day)) 20937 (`timestamp (org-timestamp-change 0 'day))
21214 ((and `nil (guard (org-at-heading-p))) 20938 ((and `nil (guard (org-at-heading-p)))
21215 ;; When point is on an unsupported object type, we can miss 20939 ;; When point is on an unsupported object type, we can miss
@@ -21228,7 +20952,8 @@ Use `\\[org-edit-special]' to edit table.el tables"))
21228 (funcall major-mode) 20952 (funcall major-mode)
21229 (hack-local-variables) 20953 (hack-local-variables)
21230 (when (and indent-status (not (bound-and-true-p org-indent-mode))) 20954 (when (and indent-status (not (bound-and-true-p org-indent-mode)))
21231 (org-indent-mode -1))) 20955 (org-indent-mode -1))
20956 (org-reset-file-cache))
21232 (message "%s restarted" major-mode)) 20957 (message "%s restarted" major-mode))
21233 20958
21234(defun org-kill-note-or-show-branches () 20959(defun org-kill-note-or-show-branches ()
@@ -21479,15 +21204,18 @@ number of stars to add."
21479 (forward-line))))))) 21204 (forward-line)))))))
21480 (unless toggled (message "Cannot toggle heading from here")))) 21205 (unless toggled (message "Cannot toggle heading from here"))))
21481 21206
21482(defun org-meta-return (&optional _arg) 21207(defun org-meta-return (&optional arg)
21483 "Insert a new heading or wrap a region in a table. 21208 "Insert a new heading or wrap a region in a table.
21484Calls `org-insert-heading' or `org-table-wrap-region', depending 21209Calls `org-insert-heading', `org-insert-item' or
21485on context. See the individual commands for more information." 21210`org-table-wrap-region', depending on context. When called with
21486 (interactive) 21211an argument, unconditionally call `org-insert-heading'."
21212 (interactive "P")
21487 (org-check-before-invisible-edit 'insert) 21213 (org-check-before-invisible-edit 'insert)
21488 (or (run-hook-with-args-until-success 'org-metareturn-hook) 21214 (or (run-hook-with-args-until-success 'org-metareturn-hook)
21489 (call-interactively (if (org-at-table-p) #'org-table-wrap-region 21215 (call-interactively (cond (arg #'org-insert-heading)
21490 #'org-insert-heading)))) 21216 ((org-at-table-p) #'org-table-wrap-region)
21217 ((org-in-item-p) #'org-insert-item)
21218 (t #'org-insert-heading)))))
21491 21219
21492;;; Menu entries 21220;;; Menu entries
21493 21221
@@ -21549,8 +21277,7 @@ on context. See the individual commands for more information."
21549 :style toggle 21277 :style toggle
21550 :selected (bound-and-true-p org-table-overlay-coordinates)] 21278 :selected (bound-and-true-p org-table-overlay-coordinates)]
21551 "--" 21279 "--"
21552 ["Create" org-table-create (and (not (org-at-table-p)) 21280 ["Create" org-table-create (not (org-at-table-p))]
21553 org-enable-table-editor)]
21554 ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] 21281 ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
21555 ["Import from File" org-table-import (not (org-at-table-p))] 21282 ["Import from File" org-table-import (not (org-at-table-p))]
21556 ["Export to File" org-table-export (org-at-table-p)] 21283 ["Export to File" org-table-export (org-at-table-p)]
@@ -21676,10 +21403,10 @@ on context. See the individual commands for more information."
21676 ["Timestamp" org-time-stamp (not (org-before-first-heading-p))] 21403 ["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
21677 ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))] 21404 ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
21678 ("Change Date" 21405 ("Change Date"
21679 ["1 Day Later" org-shiftright (org-at-timestamp-p)] 21406 ["1 Day Later" org-shiftright (org-at-timestamp-p 'lax)]
21680 ["1 Day Earlier" org-shiftleft (org-at-timestamp-p)] 21407 ["1 Day Earlier" org-shiftleft (org-at-timestamp-p 'lax)]
21681 ["1 ... Later" org-shiftup (org-at-timestamp-p)] 21408 ["1 ... Later" org-shiftup (org-at-timestamp-p 'lax)]
21682 ["1 ... Earlier" org-shiftdown (org-at-timestamp-p)]) 21409 ["1 ... Earlier" org-shiftdown (org-at-timestamp-p 'lax)])
21683 ["Compute Time Range" org-evaluate-time-range t] 21410 ["Compute Time Range" org-evaluate-time-range t]
21684 ["Schedule Item" org-schedule (not (org-before-first-heading-p))] 21411 ["Schedule Item" org-schedule (not (org-before-first-heading-p))]
21685 ["Deadline" org-deadline (not (org-before-first-heading-p))] 21412 ["Deadline" org-deadline (not (org-before-first-heading-p))]
@@ -21721,7 +21448,6 @@ on context. See the individual commands for more information."
21721 ("Special views current file" 21448 ("Special views current file"
21722 ["TODO Tree" org-show-todo-tree t] 21449 ["TODO Tree" org-show-todo-tree t]
21723 ["Check Deadlines" org-check-deadlines t] 21450 ["Check Deadlines" org-check-deadlines t]
21724 ["Timeline" org-timeline t]
21725 ["Tags/Property tree" org-match-sparse-tree t]) 21451 ["Tags/Property tree" org-match-sparse-tree t])
21726 "--" 21452 "--"
21727 ["Export/Publish..." org-export-dispatch t] 21453 ["Export/Publish..." org-export-dispatch t]
@@ -21966,10 +21692,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
21966 21692
21967(defun org-in-verbatim-emphasis () 21693(defun org-in-verbatim-emphasis ()
21968 (save-match-data 21694 (save-match-data
21969 (and (org-in-regexp org-emph-re 2) 21695 (and (org-in-regexp org-verbatim-re 2)
21970 (>= (point) (match-beginning 3)) 21696 (>= (point) (match-beginning 3))
21971 (<= (point) (match-end 4)) 21697 (<= (point) (match-end 4)))))
21972 (member (match-string 3) '("=" "~")))))
21973 21698
21974(defun org-overlay-display (ovl text &optional face evap) 21699(defun org-overlay-display (ovl text &optional face evap)
21975 "Make overlay OVL display TEXT with face FACE." 21700 "Make overlay OVL display TEXT with face FACE."
@@ -22017,30 +21742,6 @@ If DELETE is non-nil, delete all those overlays."
22017 (interactive "p") 21742 (interactive "p")
22018 (self-insert-command N)) 21743 (self-insert-command N))
22019 21744
22020(defun org-string-width (s)
22021 "Compute width of string, ignoring invisible characters.
22022This ignores character with invisibility property `org-link', and also
22023characters with property `org-cwidth', because these will become invisible
22024upon the next fontification round."
22025 (let (b l)
22026 (when (or (eq t buffer-invisibility-spec)
22027 (assq 'org-link buffer-invisibility-spec))
22028 (while (setq b (text-property-any 0 (length s)
22029 'invisible 'org-link s))
22030 (setq s (concat (substring s 0 b)
22031 (substring s (or (next-single-property-change
22032 b 'invisible s)
22033 (length s)))))))
22034 (while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
22035 (setq s (concat (substring s 0 b)
22036 (substring s (or (next-single-property-change
22037 b 'org-cwidth s)
22038 (length s))))))
22039 (setq l (string-width s) b -1)
22040 (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s))
22041 (setq l (- l (get-text-property b 'org-dwidth-n s))))
22042 l))
22043
22044(defun org-shorten-string (s maxlength) 21745(defun org-shorten-string (s maxlength)
22045 "Shorten string S so that it is no longer than MAXLENGTH characters. 21746 "Shorten string S so that it is no longer than MAXLENGTH characters.
22046If the string is shorter or has length MAXLENGTH, just return the 21747If the string is shorter or has length MAXLENGTH, just return the
@@ -22166,7 +21867,7 @@ wrapped to the length of that word.
22166IF WIDTH is nil and LINES is non-nil, the string is forced into at most that 21867IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
22167many lines, whatever width that takes. 21868many lines, whatever width that takes.
22168The return value is a list of lines, without newlines at the end." 21869The return value is a list of lines, without newlines at the end."
22169 (let* ((words (org-split-string string "[ \t\n]+")) 21870 (let* ((words (split-string string))
22170 (maxword (apply 'max (mapcar 'org-string-width words))) 21871 (maxword (apply 'max (mapcar 'org-string-width words)))
22171 w ll) 21872 w ll)
22172 (cond (width 21873 (cond (width
@@ -22193,29 +21894,6 @@ The return value is a list of lines, without newlines at the end."
22193 (setq lines (push line lines))) 21894 (setq lines (push line lines)))
22194 (nreverse lines))) 21895 (nreverse lines)))
22195 21896
22196(defun org-split-string (string &optional separators)
22197 "Splits STRING into substrings at SEPARATORS.
22198SEPARATORS is a regular expression.
22199No empty strings are returned if there are matches at the beginning
22200and end of string."
22201 ;; FIXME: why not use (split-string STRING SEPARATORS t)?
22202 (let ((start 0) notfirst list)
22203 (while (and (string-match (or separators "[ \f\t\n\r\v]+") string
22204 (if (and notfirst
22205 (= start (match-beginning 0))
22206 (< start (length string)))
22207 (1+ start) start))
22208 (< (match-beginning 0) (length string)))
22209 (setq notfirst t)
22210 (or (eq (match-beginning 0) 0)
22211 (and (eq (match-beginning 0) (match-end 0))
22212 (eq (match-beginning 0) start))
22213 (push (substring string start (match-beginning 0)) list))
22214 (setq start (match-end 0)))
22215 (or (eq start (length string))
22216 (push (substring string start) list))
22217 (nreverse list)))
22218
22219(defun org-quote-vert (s) 21897(defun org-quote-vert (s)
22220 "Replace \"|\" with \"\\vert\"." 21898 "Replace \"|\" with \"\\vert\"."
22221 (while (string-match "|" s) 21899 (while (string-match "|" s)
@@ -22696,7 +22374,8 @@ it for output."
22696 (?o . ,(shell-quote-argument out-dir)) 22374 (?o . ,(shell-quote-argument out-dir))
22697 (?O . ,(shell-quote-argument output)))))) 22375 (?O . ,(shell-quote-argument output))))))
22698 (dolist (command process) 22376 (dolist (command process)
22699 (shell-command (format-spec command spec) log-buf)))) 22377 (shell-command (format-spec command spec) log-buf))
22378 (when log-buf (with-current-buffer log-buf (compilation-mode)))))
22700 (_ (error "No valid command to process %S%s" source err-msg)))) 22379 (_ (error "No valid command to process %S%s" source err-msg))))
22701 ;; Check for process failure. Output file is expected to be 22380 ;; Check for process failure. Output file is expected to be
22702 ;; located in the same directory as SOURCE. 22381 ;; located in the same directory as SOURCE.
@@ -23094,6 +22773,7 @@ assumed to be significant there."
23094 (org-uniquify 22773 (org-uniquify
23095 (append fill-nobreak-predicate 22774 (append fill-nobreak-predicate
23096 '(org-fill-line-break-nobreak-p 22775 '(org-fill-line-break-nobreak-p
22776 org-fill-n-macro-as-item-nobreak-p
23097 org-fill-paragraph-with-timestamp-nobreak-p))))) 22777 org-fill-paragraph-with-timestamp-nobreak-p)))))
23098 (let ((paragraph-ending (substring org-element-paragraph-separate 1))) 22778 (let ((paragraph-ending (substring org-element-paragraph-separate 1)))
23099 (setq-local paragraph-start paragraph-ending) 22779 (setq-local paragraph-start paragraph-ending)
@@ -23113,9 +22793,15 @@ assumed to be significant there."
23113 22793
23114(defun org-fill-paragraph-with-timestamp-nobreak-p () 22794(defun org-fill-paragraph-with-timestamp-nobreak-p ()
23115 "Non-nil when a new line at point would split a timestamp." 22795 "Non-nil when a new line at point would split a timestamp."
23116 (and (org-at-timestamp-p t) 22796 (and (org-at-timestamp-p 'lax)
23117 (not (looking-at org-ts-regexp-both)))) 22797 (not (looking-at org-ts-regexp-both))))
23118 22798
22799(defun org-fill-n-macro-as-item-nobreak-p ()
22800 "Non-nil when a new line at point would create a new list."
22801 ;; During export, a "n" macro followed by a dot or a closing
22802 ;; parenthesis can end up being parsed as a new list item.
22803 (looking-at-p "[ \t]*{{{n\\(?:([^\n)]*)\\)?}}}[.)]\\(?:$\\| \\)"))
22804
23119(declare-function message-in-body-p "message" ()) 22805(declare-function message-in-body-p "message" ())
23120(defvar orgtbl-line-start-regexp) ; From org-table.el 22806(defvar orgtbl-line-start-regexp) ; From org-table.el
23121(defun org-adaptive-fill-function () 22807(defun org-adaptive-fill-function ()
@@ -23188,7 +22874,8 @@ matches in paragraphs or comments, use it."
23188 22874
23189(declare-function message-goto-body "message" ()) 22875(declare-function message-goto-body "message" ())
23190(defvar message-cite-prefix-regexp) ; From message.el 22876(defvar message-cite-prefix-regexp) ; From message.el
23191(defun org-fill-paragraph (&optional justify) 22877
22878(defun org-fill-element (&optional justify)
23192 "Fill element at point, when applicable. 22879 "Fill element at point, when applicable.
23193 22880
23194This function only applies to comment blocks, comments, example 22881This function only applies to comment blocks, comments, example
@@ -23203,126 +22890,160 @@ width for filling.
23203 22890
23204For convenience, when point is at a plain list, an item or 22891For convenience, when point is at a plain list, an item or
23205a footnote definition, try to fill the first paragraph within." 22892a footnote definition, try to fill the first paragraph within."
23206 (interactive) 22893 (with-syntax-table org-mode-transpose-word-syntax-table
23207 (if (and (derived-mode-p 'message-mode) 22894 ;; Move to end of line in order to get the first paragraph within
23208 (or (not (message-in-body-p)) 22895 ;; a plain list or a footnote definition.
23209 (save-excursion (move-beginning-of-line 1) 22896 (let ((element (save-excursion (end-of-line) (org-element-at-point))))
23210 (looking-at message-cite-prefix-regexp)))) 22897 ;; First check if point is in a blank line at the beginning of
23211 ;; First ensure filling is correct in message-mode. 22898 ;; the buffer. In that case, ignore filling.
23212 (let ((fill-paragraph-function 22899 (cl-case (org-element-type element)
23213 (cl-cadadr (assq 'fill-paragraph-function org-fb-vars))) 22900 ;; Use major mode filling function is src blocks.
23214 (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars))) 22901 (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
23215 (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars))) 22902 ;; Align Org tables, leave table.el tables as-is.
23216 (paragraph-separate 22903 (table-row (org-table-align) t)
23217 (cl-cadadr (assq 'paragraph-separate org-fb-vars)))) 22904 (table
23218 (fill-paragraph nil)) 22905 (when (eq (org-element-property :type element) 'org)
23219 (with-syntax-table org-mode-transpose-word-syntax-table 22906 (save-excursion
23220 ;; Move to end of line in order to get the first paragraph 22907 (goto-char (org-element-property :post-affiliated element))
23221 ;; within a plain list or a footnote definition. 22908 (org-table-align)))
23222 (let ((element (save-excursion 22909 t)
23223 (end-of-line) 22910 (paragraph
23224 (or (ignore-errors (org-element-at-point)) 22911 ;; Paragraphs may contain `line-break' type objects.
23225 (user-error "An element cannot be parsed line %d" 22912 (let ((beg (max (point-min)
23226 (line-number-at-pos (point))))))) 22913 (org-element-property :contents-begin element)))
23227 ;; First check if point is in a blank line at the beginning of 22914 (end (min (point-max)
23228 ;; the buffer. In that case, ignore filling. 22915 (org-element-property :contents-end element))))
23229 (cl-case (org-element-type element) 22916 ;; Do nothing if point is at an affiliated keyword.
23230 ;; Use major mode filling function is src blocks. 22917 (if (< (line-end-position) beg) t
23231 (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) 22918 (when (derived-mode-p 'message-mode)
23232 ;; Align Org tables, leave table.el tables as-is. 22919 ;; In `message-mode', do not fill following citation
23233 (table-row (org-table-align) t) 22920 ;; in current paragraph nor text before message body.
23234 (table 22921 (let ((body-start (save-excursion (message-goto-body))))
23235 (when (eq (org-element-property :type element) 'org) 22922 (when body-start (setq beg (max body-start beg))))
22923 (when (save-excursion
22924 (re-search-forward
22925 (concat "^" message-cite-prefix-regexp) end t))
22926 (setq end (match-beginning 0))))
22927 ;; Fill paragraph, taking line breaks into account.
23236 (save-excursion 22928 (save-excursion
23237 (goto-char (org-element-property :post-affiliated element)) 22929 (goto-char beg)
23238 (org-table-align))) 22930 (let ((cuts (list beg)))
23239 t) 22931 (while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
23240 (paragraph 22932 (when (eq 'line-break
23241 ;; Paragraphs may contain `line-break' type objects. 22933 (org-element-type
23242 (let ((beg (max (point-min) 22934 (save-excursion (backward-char)
23243 (org-element-property :contents-begin element))) 22935 (org-element-context))))
23244 (end (min (point-max) 22936 (push (point) cuts)))
23245 (org-element-property :contents-end element)))) 22937 (dolist (c (delq end cuts))
23246 ;; Do nothing if point is at an affiliated keyword. 22938 (fill-region-as-paragraph c end justify)
23247 (if (< (line-end-position) beg) t 22939 (setq end c))))
23248 (when (derived-mode-p 'message-mode) 22940 t)))
23249 ;; In `message-mode', do not fill following citation 22941 ;; Contents of `comment-block' type elements should be
23250 ;; in current paragraph nor text before message body. 22942 ;; filled as plain text, but only if point is within block
23251 (let ((body-start (save-excursion (message-goto-body)))) 22943 ;; markers.
23252 (when body-start (setq beg (max body-start beg)))) 22944 (comment-block
23253 (when (save-excursion 22945 (let* ((case-fold-search t)
23254 (re-search-forward 22946 (beg (save-excursion
23255 (concat "^" message-cite-prefix-regexp) end t)) 22947 (goto-char (org-element-property :begin element))
23256 (setq end (match-beginning 0)))) 22948 (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
23257 ;; Fill paragraph, taking line breaks into account. 22949 (forward-line)
23258 (save-excursion 22950 (point)))
23259 (goto-char beg) 22951 (end (save-excursion
23260 (let ((cuts (list beg))) 22952 (goto-char (org-element-property :end element))
23261 (while (re-search-forward "\\\\\\\\[ \t]*\n" end t) 22953 (re-search-backward "^[ \t]*#\\+end_comment" nil t)
23262 (when (eq 'line-break 22954 (line-beginning-position))))
23263 (org-element-type 22955 (if (or (< (point) beg) (> (point) end)) t
23264 (save-excursion (backward-char) 22956 (fill-region-as-paragraph
23265 (org-element-context)))) 22957 (save-excursion (end-of-line)
23266 (push (point) cuts))) 22958 (re-search-backward "^[ \t]*$" beg 'move)
23267 (dolist (c (delq end cuts)) 22959 (line-beginning-position))
23268 (fill-region-as-paragraph c end justify) 22960 (save-excursion (beginning-of-line)
23269 (setq end c)))) 22961 (re-search-forward "^[ \t]*$" end 'move)
23270 t))) 22962 (line-beginning-position))
23271 ;; Contents of `comment-block' type elements should be 22963 justify))))
23272 ;; filled as plain text, but only if point is within block 22964 ;; Fill comments.
23273 ;; markers. 22965 (comment
23274 (comment-block 22966 (let ((begin (org-element-property :post-affiliated element))
23275 (let* ((case-fold-search t) 22967 (end (org-element-property :end element)))
23276 (beg (save-excursion 22968 (when (and (>= (point) begin) (<= (point) end))
23277 (goto-char (org-element-property :begin element)) 22969 (let ((begin (save-excursion
23278 (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
23279 (forward-line)
23280 (point)))
23281 (end (save-excursion
23282 (goto-char (org-element-property :end element))
23283 (re-search-backward "^[ \t]*#\\+end_comment" nil t)
23284 (line-beginning-position))))
23285 (if (or (< (point) beg) (> (point) end)) t
23286 (fill-region-as-paragraph
23287 (save-excursion (end-of-line)
23288 (re-search-backward "^[ \t]*$" beg 'move)
23289 (line-beginning-position))
23290 (save-excursion (beginning-of-line)
23291 (re-search-forward "^[ \t]*$" end 'move)
23292 (line-beginning-position))
23293 justify))))
23294 ;; Fill comments.
23295 (comment
23296 (let ((begin (org-element-property :post-affiliated element))
23297 (end (org-element-property :end element)))
23298 (when (and (>= (point) begin) (<= (point) end))
23299 (let ((begin (save-excursion
23300 (end-of-line)
23301 (if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
23302 (progn (forward-line) (point))
23303 begin)))
23304 (end (save-excursion
23305 (end-of-line) 22970 (end-of-line)
23306 (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) 22971 (if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
23307 (1- (line-beginning-position)) 22972 (progn (forward-line) (point))
23308 (skip-chars-backward " \r\t\n") 22973 begin)))
23309 (line-end-position))))) 22974 (end (save-excursion
23310 ;; Do not fill comments when at a blank line. 22975 (end-of-line)
23311 (when (> end begin) 22976 (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
23312 (let ((fill-prefix 22977 (1- (line-beginning-position))
23313 (save-excursion 22978 (skip-chars-backward " \r\t\n")
23314 (beginning-of-line) 22979 (line-end-position)))))
23315 (looking-at "[ \t]*#") 22980 ;; Do not fill comments when at a blank line.
23316 (let ((comment-prefix (match-string 0))) 22981 (when (> end begin)
23317 (goto-char (match-end 0)) 22982 (let ((fill-prefix
23318 (if (looking-at adaptive-fill-regexp) 22983 (save-excursion
23319 (concat comment-prefix (match-string 0)) 22984 (beginning-of-line)
23320 (concat comment-prefix " ")))))) 22985 (looking-at "[ \t]*#")
23321 (save-excursion 22986 (let ((comment-prefix (match-string 0)))
23322 (fill-region-as-paragraph begin end justify)))))) 22987 (goto-char (match-end 0))
23323 t)) 22988 (if (looking-at adaptive-fill-regexp)
23324 ;; Ignore every other element. 22989 (concat comment-prefix (match-string 0))
23325 (otherwise t)))))) 22990 (concat comment-prefix " "))))))
22991 (save-excursion
22992 (fill-region-as-paragraph begin end justify))))))
22993 t))
22994 ;; Ignore every other element.
22995 (otherwise t)))))
22996
22997(defun org-fill-paragraph (&optional justify region)
22998 "Fill element at point, when applicable.
22999
23000This function only applies to comment blocks, comments, example
23001blocks and paragraphs. Also, as a special case, re-align table
23002when point is at one.
23003
23004For convenience, when point is at a plain list, an item or
23005a footnote definition, try to fill the first paragraph within.
23006
23007If JUSTIFY is non-nil (interactively, with prefix argument),
23008justify as well. If `sentence-end-double-space' is non-nil, then
23009period followed by one space does not end a sentence, so don't
23010break a line there. The variable `fill-column' controls the
23011width for filling.
23012
23013The REGION argument is non-nil if called interactively; in that
23014case, if Transient Mark mode is enabled and the mark is active,
23015fill each of the elements in the active region, instead of just
23016filling the current element."
23017 (interactive (progn
23018 (barf-if-buffer-read-only)
23019 (list (if current-prefix-arg 'full) t)))
23020 (cond
23021 ((and (derived-mode-p 'message-mode)
23022 (or (not (message-in-body-p))
23023 (save-excursion (move-beginning-of-line 1)
23024 (looking-at message-cite-prefix-regexp))))
23025 ;; First ensure filling is correct in message-mode.
23026 (let ((fill-paragraph-function
23027 (cl-cadadr (assq 'fill-paragraph-function org-fb-vars)))
23028 (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars)))
23029 (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars)))
23030 (paragraph-separate
23031 (cl-cadadr (assq 'paragraph-separate org-fb-vars))))
23032 (fill-paragraph nil)))
23033 ((and region transient-mark-mode mark-active
23034 (not (eq (region-beginning) (region-end))))
23035 (let ((origin (point-marker))
23036 (start (region-beginning)))
23037 (unwind-protect
23038 (progn
23039 (goto-char (region-end))
23040 (while (> (point) start)
23041 (org-backward-paragraph)
23042 (org-fill-element justify)))
23043 (goto-char origin)
23044 (set-marker origin nil))))
23045 (t (org-fill-element justify))))
23046(org-remap org-mode-map 'fill-paragraph 'org-fill-paragraph)
23326 23047
23327(defun org-auto-fill-function () 23048(defun org-auto-fill-function ()
23328 "Auto-fill function." 23049 "Auto-fill function."
@@ -23475,7 +23196,7 @@ region only contains such lines."
23475 23196
23476;; Org comments syntax is quite complex. It requires the entire line 23197;; Org comments syntax is quite complex. It requires the entire line
23477;; to be just a comment. Also, even with the right syntax at the 23198;; to be just a comment. Also, even with the right syntax at the
23478;; beginning of line, some some elements (i.e. verse-block or 23199;; beginning of line, some elements (e.g., verse-block or
23479;; example-block) don't accept comments. Usual Emacs comment commands 23200;; example-block) don't accept comments. Usual Emacs comment commands
23480;; cannot cope with those requirements. Therefore, Org replaces them. 23201;; cannot cope with those requirements. Therefore, Org replaces them.
23481 23202
@@ -23874,23 +23595,28 @@ depending on context."
23874This will call `forward-sentence' or `org-table-end-of-field', 23595This will call `forward-sentence' or `org-table-end-of-field',
23875depending on context." 23596depending on context."
23876 (interactive) 23597 (interactive)
23877 (let* ((element (org-element-at-point)) 23598 (if (and (org-at-heading-p)
23878 (contents-end (org-element-property :contents-end element)) 23599 (save-restriction (skip-chars-forward " \t") (not (eolp))))
23879 (table (org-element-lineage element '(table) t)))
23880 (if (and table
23881 (>= (point) (org-element-property :contents-begin table))
23882 (< (point) contents-end))
23883 (call-interactively #'org-table-end-of-field)
23884 (save-restriction 23600 (save-restriction
23885 (when (and contents-end 23601 (narrow-to-region (line-beginning-position) (line-end-position))
23886 (> (point-max) contents-end) 23602 (call-interactively #'forward-sentence))
23887 ;; Skip blank lines between elements. 23603 (let* ((element (org-element-at-point))
23888 (< (org-element-property :end element) 23604 (contents-end (org-element-property :contents-end element))
23889 (save-excursion (goto-char contents-end) 23605 (table (org-element-lineage element '(table) t)))
23890 (skip-chars-forward " \r\t\n")))) 23606 (if (and table
23891 (narrow-to-region (org-element-property :contents-begin element) 23607 (>= (point) (org-element-property :contents-begin table))
23892 contents-end)) 23608 (< (point) contents-end))
23893 (call-interactively #'forward-sentence))))) 23609 (call-interactively #'org-table-end-of-field)
23610 (save-restriction
23611 (when (and contents-end
23612 (> (point-max) contents-end)
23613 ;; Skip blank lines between elements.
23614 (< (org-element-property :end element)
23615 (save-excursion (goto-char contents-end)
23616 (skip-chars-forward " \r\t\n"))))
23617 (narrow-to-region (org-element-property :contents-begin element)
23618 contents-end))
23619 (call-interactively #'forward-sentence))))))
23894 23620
23895(define-key org-mode-map "\M-a" 'org-backward-sentence) 23621(define-key org-mode-map "\M-a" 'org-backward-sentence)
23896(define-key org-mode-map "\M-e" 'org-forward-sentence) 23622(define-key org-mode-map "\M-e" 'org-forward-sentence)
diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el
index ad78995ddfc..9e04387d9a2 100644
--- a/lisp/org/ox-ascii.el
+++ b/lisp/org/ox-ascii.el
@@ -341,13 +341,10 @@ Org mode, i.e. with \"=>\" as ellipsis."
341 :type 'boolean) 341 :type 'boolean)
342 342
343(defcustom org-ascii-table-use-ascii-art nil 343(defcustom org-ascii-table-use-ascii-art nil
344 "Non-nil means table.el tables are turned into ascii-art. 344 "Non-nil means \"table.el\" tables are turned into ASCII art.
345
346It only makes sense when export charset is `utf-8'. It is nil by 345It only makes sense when export charset is `utf-8'. It is nil by
347default since it requires ascii-art-to-unicode.el package. You 346default since it requires \"ascii-art-to-unicode.el\" package,
348can download it here: 347available through, e.g., GNU ELPA."
349
350 http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
351 :group 'org-export-ascii 348 :group 'org-export-ascii
352 :version "24.4" 349 :version "24.4"
353 :package-version '(Org . "8.0") 350 :package-version '(Org . "8.0")
@@ -404,7 +401,7 @@ The function must accept nine parameters:
404The function should return either the string to be exported or 401The function should return either the string to be exported or
405nil to ignore the inline task." 402nil to ignore the inline task."
406 :group 'org-export-ascii 403 :group 'org-export-ascii
407 :version "24.4" 404 :version "26.1"
408 :package-version '(Org . "8.3") 405 :package-version '(Org . "8.3")
409 :type 'function) 406 :type 'function)
410 407
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
index bb08d0c743e..5750d6dab03 100644
--- a/lisp/org/ox-beamer.el
+++ b/lisp/org/ox-beamer.el
@@ -423,33 +423,35 @@ used as a communication channel."
423 ;; Options, if any. 423 ;; Options, if any.
424 (let* ((beamer-opt (org-element-property :BEAMER_OPT headline)) 424 (let* ((beamer-opt (org-element-property :BEAMER_OPT headline))
425 (options 425 (options
426 ;; Collect options from default value and headline's 426 ;; Collect nonempty options from default value and
427 ;; properties. Also add a label for links. 427 ;; headline's properties. Also add a label for
428 (append 428 ;; links.
429 (org-split-string 429 (cl-remove-if-not 'org-string-nw-p
430 (plist-get info :beamer-frame-default-options) ",") 430 (append
431 (and beamer-opt 431 (org-split-string
432 (org-split-string 432 (plist-get info :beamer-frame-default-options) ",")
433 ;; Remove square brackets if user provided 433 (and beamer-opt
434 ;; them. 434 (org-split-string
435 (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt) 435 ;; Remove square brackets if user provided
436 (match-string 1 beamer-opt)) 436 ;; them.
437 ",")) 437 (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt)
438 ;; Provide an automatic label for the frame 438 (match-string 1 beamer-opt))
439 ;; unless the user specified one. Also refrain 439 ","))
440 ;; from labeling `allowframebreaks' frames; this 440 ;; Provide an automatic label for the frame
441 ;; is not allowed by beamer. 441 ;; unless the user specified one. Also refrain
442 (unless (and beamer-opt 442 ;; from labeling `allowframebreaks' frames; this
443 (or (string-match "\\(^\\|,\\)label=" beamer-opt) 443 ;; is not allowed by beamer.
444 (string-match "allowframebreaks" beamer-opt))) 444 (unless (and beamer-opt
445 (list 445 (or (string-match "\\(^\\|,\\)label=" beamer-opt)
446 (let ((label (org-beamer--get-label headline info))) 446 (string-match "allowframebreaks" beamer-opt)))
447 ;; Labels containing colons need to be 447 (list
448 ;; wrapped within braces. 448 (let ((label (org-beamer--get-label headline info)))
449 (format (if (string-match-p ":" label) 449 ;; Labels containing colons need to be
450 "label={%s}" 450 ;; wrapped within braces.
451 "label=%s") 451 (format (if (string-match-p ":" label)
452 label))))))) 452 "label={%s}"
453 "label=%s")
454 label))))))))
453 ;; Change options list into a string. 455 ;; Change options list into a string.
454 (org-beamer--normalize-argument 456 (org-beamer--normalize-argument
455 (mapconcat 457 (mapconcat
@@ -933,9 +935,9 @@ value."
933 org-beamer-environments-default))) 935 org-beamer-environments-default)))
934 ((and (equal property "BEAMER_col") 936 ((and (equal property "BEAMER_col")
935 (not (org-entry-get nil (concat property "_ALL") 'inherit))) 937 (not (org-entry-get nil (concat property "_ALL") 'inherit)))
936 ;; If no allowed values for BEAMER_col have been defined, 938 ;; If no allowed values for BEAMER_col have been defined, supply
937 ;; supply some 939 ;; some.
938 (org-split-string org-beamer-column-widths " ")))) 940 (split-string org-beamer-column-widths " "))))
939 941
940(add-hook 'org-property-allowed-value-functions 942(add-hook 'org-property-allowed-value-functions
941 'org-beamer-allowed-property-values) 943 'org-beamer-allowed-property-values)
diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el
index aec4efc4ca6..fb8c61334f5 100644
--- a/lisp/org/ox-html.el
+++ b/lisp/org/ox-html.el
@@ -101,6 +101,7 @@
101 (verbatim . org-html-verbatim) 101 (verbatim . org-html-verbatim)
102 (verse-block . org-html-verse-block)) 102 (verse-block . org-html-verse-block))
103 :filters-alist '((:filter-options . org-html-infojs-install-script) 103 :filters-alist '((:filter-options . org-html-infojs-install-script)
104 (:filter-parse-tree . org-html-image-link-filter)
104 (:filter-final-output . org-html-final-function)) 105 (:filter-final-output . org-html-final-function))
105 :menu-entry 106 :menu-entry
106 '(?h "Export to HTML" 107 '(?h "Export to HTML"
@@ -170,6 +171,11 @@
170 (:html-table-row-open-tag nil nil org-html-table-row-open-tag) 171 (:html-table-row-open-tag nil nil org-html-table-row-open-tag)
171 (:html-table-row-close-tag nil nil org-html-table-row-close-tag) 172 (:html-table-row-close-tag nil nil org-html-table-row-close-tag)
172 (:html-xml-declaration nil nil org-html-xml-declaration) 173 (:html-xml-declaration nil nil org-html-xml-declaration)
174 (:html-klipsify-src nil nil org-html-klipsify-src)
175 (:html-klipse-css nil nil org-html-klipse-css)
176 (:html-klipse-js nil nil org-html-klipse-js)
177 (:html-klipse-keep-old-src nil nil org-html-keep-old-src)
178 (:html-klipse-selection-script nil nil org-html-klipse-selection-script)
173 (:infojs-opt "INFOJS_OPT" nil nil) 179 (:infojs-opt "INFOJS_OPT" nil nil)
174 ;; Redefine regular options. 180 ;; Redefine regular options.
175 (:creator "CREATOR" nil org-html-creator-string) 181 (:creator "CREATOR" nil org-html-creator-string)
@@ -332,6 +338,7 @@ for the JavaScript code in this tag.
332 pre.src-fortran:before { content: 'Fortran'; } 338 pre.src-fortran:before { content: 'Fortran'; }
333 pre.src-gnuplot:before { content: 'gnuplot'; } 339 pre.src-gnuplot:before { content: 'gnuplot'; }
334 pre.src-haskell:before { content: 'Haskell'; } 340 pre.src-haskell:before { content: 'Haskell'; }
341 pre.src-hledger:before { content: 'hledger'; }
335 pre.src-java:before { content: 'Java'; } 342 pre.src-java:before { content: 'Java'; }
336 pre.src-js:before { content: 'Javascript'; } 343 pre.src-js:before { content: 'Javascript'; }
337 pre.src-latex:before { content: 'LaTeX'; } 344 pre.src-latex:before { content: 'LaTeX'; }
@@ -1532,6 +1539,46 @@ https://developer.mozilla.org/en-US/docs/Mozilla/Mobile/Viewport_meta_tag"
1532 (const "true") 1539 (const "true")
1533 (const "false")))))) 1540 (const "false"))))))
1534 1541
1542;; Handle source code blocks with Klipse
1543
1544(defcustom org-html-klipsify-src nil
1545 "When non-nil, source code blocks are editable in exported presentation."
1546 :group 'org-export-html
1547 :package-version '(Org . "9.1")
1548 :type 'boolean)
1549
1550(defcustom org-html-klipse-css
1551 "https://storage.googleapis.com/app.klipse.tech/css/codemirror.css"
1552 "Location of the codemirror CSS file for use with klipse."
1553 :group 'org-export-html
1554 :package-version '(Org . "9.1")
1555 :type 'string)
1556
1557(defcustom org-html-klipse-js
1558 "https://storage.googleapis.com/app.klipse.tech/plugin_prod/js/klipse_plugin.min.js"
1559 "Location of the klipse javascript file."
1560 :group 'org-export-html
1561 :type 'string)
1562
1563(defcustom org-html-klipse-selection-script
1564 "window.klipse_settings = {selector_eval_html: '.src-html',
1565 selector_eval_js: '.src-js',
1566 selector_eval_python_client: '.src-python',
1567 selector_eval_scheme: '.src-scheme',
1568 selector: '.src-clojure',
1569 selector_eval_ruby: '.src-ruby'};"
1570 "Javascript snippet to activate klipse."
1571 :group 'org-export-html
1572 :package-version '(Org . "9.1")
1573 :type 'string)
1574
1575(defcustom org-html-keep-old-src nil
1576 "When non-nil, use <pre class=\"\"> instead of <pre><code class=\"\">."
1577 :group 'org-export-html
1578 :package-version '(Org . "9.1")
1579 :type 'boolean)
1580
1581
1535;;;; Todos 1582;;;; Todos
1536 1583
1537(defcustom org-html-todo-kwd-class-prefix "" 1584(defcustom org-html-todo-kwd-class-prefix ""
@@ -1543,7 +1590,7 @@ CSS classes, then this prefix can be very useful."
1543 :group 'org-export-html 1590 :group 'org-export-html
1544 :type 'string) 1591 :type 'string)
1545 1592
1546 1593
1547;;; Internal Functions 1594;;; Internal Functions
1548 1595
1549(defun org-html-xhtml-p (info) 1596(defun org-html-xhtml-p (info)
@@ -1696,7 +1743,8 @@ If you then set `org-html-htmlize-output-type' to `css', calls
1696to the function `org-html-htmlize-region-for-paste' will 1743to the function `org-html-htmlize-region-for-paste' will
1697produce code that uses these same face definitions." 1744produce code that uses these same face definitions."
1698 (interactive) 1745 (interactive)
1699 (require 'htmlize) 1746 (or (require 'htmlize nil t)
1747 (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
1700 (and (get-buffer "*html*") (kill-buffer "*html*")) 1748 (and (get-buffer "*html*") (kill-buffer "*html*"))
1701 (with-temp-buffer 1749 (with-temp-buffer
1702 (let ((fl (face-list)) 1750 (let ((fl (face-list))
@@ -1765,27 +1813,30 @@ INFO is a plist used as a communication channel."
1765(defun org-html--build-meta-info (info) 1813(defun org-html--build-meta-info (info)
1766 "Return meta tags for exported document. 1814 "Return meta tags for exported document.
1767INFO is a plist used as a communication channel." 1815INFO is a plist used as a communication channel."
1768 (let ((protect-string 1816 (let* ((protect-string
1769 (lambda (str) 1817 (lambda (str)
1770 (replace-regexp-in-string 1818 (replace-regexp-in-string
1771 "\"" "&quot;" (org-html-encode-plain-text str)))) 1819 "\"" "&quot;" (org-html-encode-plain-text str))))
1772 (title (org-export-data (plist-get info :title) info)) 1820 (title (org-export-data (plist-get info :title) info))
1773 (author (and (plist-get info :with-author) 1821 ;; Set title to an invisible character instead of leaving it
1774 (let ((auth (plist-get info :author))) 1822 ;; empty, which is invalid.
1775 (and auth 1823 (title (if (org-string-nw-p title) title "&lrm;"))
1776 ;; Return raw Org syntax, skipping non 1824 (author (and (plist-get info :with-author)
1777 ;; exportable objects. 1825 (let ((auth (plist-get info :author)))
1778 (org-element-interpret-data 1826 (and auth
1779 (org-element-map auth 1827 ;; Return raw Org syntax, skipping non
1780 (cons 'plain-text org-element-all-objects) 1828 ;; exportable objects.
1781 'identity info)))))) 1829 (org-element-interpret-data
1782 (description (plist-get info :description)) 1830 (org-element-map auth
1783 (keywords (plist-get info :keywords)) 1831 (cons 'plain-text org-element-all-objects)
1784 (charset (or (and org-html-coding-system 1832 'identity info))))))
1785 (fboundp 'coding-system-get) 1833 (description (plist-get info :description))
1786 (coding-system-get org-html-coding-system 1834 (keywords (plist-get info :keywords))
1787 'mime-charset)) 1835 (charset (or (and org-html-coding-system
1788 "iso-8859-1"))) 1836 (fboundp 'coding-system-get)
1837 (coding-system-get org-html-coding-system
1838 'mime-charset))
1839 "iso-8859-1")))
1789 (concat 1840 (concat
1790 (when (plist-get info :time-stamp-file) 1841 (when (plist-get info :time-stamp-file)
1791 (format-time-string 1842 (format-time-string
@@ -1859,7 +1910,7 @@ INFO is a plist used as a communication channel."
1859INFO is a plist used as a communication channel." 1910INFO is a plist used as a communication channel."
1860 (when (and (memq (plist-get info :with-latex) '(mathjax t)) 1911 (when (and (memq (plist-get info :with-latex) '(mathjax t))
1861 (org-element-map (plist-get info :parse-tree) 1912 (org-element-map (plist-get info :parse-tree)
1862 '(latex-fragment latex-environment) 'identity info t)) 1913 '(latex-fragment latex-environment) #'identity info t nil t))
1863 (let ((template (plist-get info :html-mathjax-template)) 1914 (let ((template (plist-get info :html-mathjax-template))
1864 (options (plist-get info :html-mathjax-options)) 1915 (options (plist-get info :html-mathjax-options))
1865 (in-buffer (or (plist-get info :html-mathjax) ""))) 1916 (in-buffer (or (plist-get info :html-mathjax) "")))
@@ -2021,7 +2072,8 @@ holding export options."
2021 (format "<%s id=\"%s\">\n" (nth 1 div) (nth 2 div))) 2072 (format "<%s id=\"%s\">\n" (nth 1 div) (nth 2 div)))
2022 ;; Document title. 2073 ;; Document title.
2023 (when (plist-get info :with-title) 2074 (when (plist-get info :with-title)
2024 (let ((title (plist-get info :title)) 2075 (let ((title (and (plist-get info :with-title)
2076 (plist-get info :title)))
2025 (subtitle (plist-get info :subtitle)) 2077 (subtitle (plist-get info :subtitle))
2026 (html5-fancy (org-html--html5-fancy-p info))) 2078 (html5-fancy (org-html--html5-fancy-p info)))
2027 (when title 2079 (when title
@@ -2042,6 +2094,13 @@ holding export options."
2042 (format "</%s>\n" (nth 1 (assq 'content (plist-get info :html-divs)))) 2094 (format "</%s>\n" (nth 1 (assq 'content (plist-get info :html-divs))))
2043 ;; Postamble. 2095 ;; Postamble.
2044 (org-html--build-pre/postamble 'postamble info) 2096 (org-html--build-pre/postamble 'postamble info)
2097 ;; Possibly use the Klipse library live code blocks.
2098 (if (plist-get info :html-klipsify-src)
2099 (concat "<script>" (plist-get info :html-klipse-selection-script)
2100 "</script><script src=\""
2101 org-html-klipse-js
2102 "\"></script><link rel=\"stylesheet\" type=\"text/css\" href=\""
2103 org-html-klipse-css "\"/>"))
2045 ;; Closing document. 2104 ;; Closing document.
2046 "</body>\n</html>")) 2105 "</body>\n</html>"))
2047 2106
@@ -2107,7 +2166,9 @@ is the language used for CODE, as a string, or nil."
2107 ;; Simple transcoding. 2166 ;; Simple transcoding.
2108 (org-html-encode-plain-text code)) 2167 (org-html-encode-plain-text code))
2109 ;; Case 2: No htmlize or an inferior version of htmlize 2168 ;; Case 2: No htmlize or an inferior version of htmlize
2110 ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste))) 2169 ((not (and (or (require 'htmlize nil t)
2170 (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
2171 (fboundp 'htmlize-region-for-paste)))
2111 ;; Emit a warning. 2172 ;; Emit a warning.
2112 (message "Cannot fontify src block (htmlize.el >= 1.34 required)") 2173 (message "Cannot fontify src block (htmlize.el >= 1.34 required)")
2113 ;; Simple transcoding. 2174 ;; Simple transcoding.
@@ -2552,21 +2613,22 @@ holding contextual information."
2552 (cdr ids) ""))) 2613 (cdr ids) "")))
2553 (if (org-export-low-level-p headline info) 2614 (if (org-export-low-level-p headline info)
2554 ;; This is a deep sub-tree: export it as a list item. 2615 ;; This is a deep sub-tree: export it as a list item.
2555 (let* ((type (if numberedp 'ordered 'unordered)) 2616 (let* ((html-type (if numberedp "ol" "ul")))
2556 (itemized-body 2617 (concat
2557 (org-html-format-list-item 2618 (and (org-export-first-sibling-p headline info)
2558 contents type nil info nil 2619 (apply #'format "<%s class=\"org-%s\">\n"
2620 (make-list 2 html-type)))
2621 (org-html-format-list-item
2622 contents (if numberedp 'ordered 'unordered)
2623 nil info nil
2559 (concat (org-html--anchor preferred-id nil nil info) 2624 (concat (org-html--anchor preferred-id nil nil info)
2560 extra-ids 2625 extra-ids
2561 full-text)))) 2626 full-text)) "\n"
2562 (concat (and (org-export-first-sibling-p headline info) 2627 (and (org-export-last-sibling-p headline info)
2563 (org-html-begin-plain-list type)) 2628 (format "</%s>\n" html-type))))
2564 itemized-body 2629 ;; Standard headline. Export it as a section.
2565 (and (org-export-last-sibling-p headline info)
2566 (org-html-end-plain-list type))))
2567 (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline)) 2630 (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline))
2568 (first-content (car (org-element-contents headline)))) 2631 (first-content (car (org-element-contents headline))))
2569 ;; Standard headline. Export it as a section.
2570 (format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n" 2632 (format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n"
2571 (org-html--container headline info) 2633 (org-html--container headline info)
2572 (concat "outline-container-" 2634 (concat "outline-container-"
@@ -2692,7 +2754,8 @@ INFO is a plist holding contextual information. See
2692 (symbol-name checkbox)) "")) 2754 (symbol-name checkbox)) ""))
2693 (checkbox (concat (org-html-checkbox checkbox info) 2755 (checkbox (concat (org-html-checkbox checkbox info)
2694 (and checkbox " "))) 2756 (and checkbox " ")))
2695 (br (org-html-close-tag "br" nil info))) 2757 (br (org-html-close-tag "br" nil info))
2758 (extra-newline (if (and (org-string-nw-p contents) headline) "\n" "")))
2696 (concat 2759 (concat
2697 (pcase type 2760 (pcase type
2698 (`ordered 2761 (`ordered
@@ -2715,7 +2778,9 @@ INFO is a plist holding contextual information. See
2715 class (concat checkbox term)) 2778 class (concat checkbox term))
2716 "<dd>")))) 2779 "<dd>"))))
2717 (unless (eq type 'descriptive) checkbox) 2780 (unless (eq type 'descriptive) checkbox)
2718 (and contents (org-trim contents)) 2781 extra-newline
2782 (and (org-string-nw-p contents) (org-trim contents))
2783 extra-newline
2719 (pcase type 2784 (pcase type
2720 (`ordered "</li>") 2785 (`ordered "</li>")
2721 (`unordered "</li>") 2786 (`unordered "</li>")
@@ -2838,6 +2903,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
2838 2903
2839;;;; Link 2904;;;; Link
2840 2905
2906(defun org-html-image-link-filter (data _backend info)
2907 (org-export-insert-image-links data info org-html-inline-image-rules))
2908
2841(defun org-html-inline-image-p (link info) 2909(defun org-html-inline-image-p (link info)
2842 "Non-nil when LINK is meant to appear as an image. 2910 "Non-nil when LINK is meant to appear as an image.
2843INFO is a plist used as a communication channel. LINK is an 2911INFO is a plist used as a communication channel. LINK is an
@@ -3132,34 +3200,27 @@ the plist used as a communication channel."
3132 3200
3133;;;; Plain List 3201;;;; Plain List
3134 3202
3135;; FIXME Maybe arg1 is not needed because <li value="20"> already sets
3136;; the correct value for the item counter
3137(defun org-html-begin-plain-list (type &optional arg1)
3138 "Insert the beginning of the HTML list depending on TYPE.
3139When ARG1 is a string, use it as the start parameter for ordered
3140lists."
3141 (pcase type
3142 (`ordered
3143 (format "<ol class=\"org-ol\"%s>"
3144 (if arg1 (format " start=\"%d\"" arg1) "")))
3145 (`unordered "<ul class=\"org-ul\">")
3146 (`descriptive "<dl class=\"org-dl\">")))
3147
3148(defun org-html-end-plain-list (type)
3149 "Insert the end of the HTML list depending on TYPE."
3150 (pcase type
3151 (`ordered "</ol>")
3152 (`unordered "</ul>")
3153 (`descriptive "</dl>")))
3154
3155(defun org-html-plain-list (plain-list contents _info) 3203(defun org-html-plain-list (plain-list contents _info)
3156 "Transcode a PLAIN-LIST element from Org to HTML. 3204 "Transcode a PLAIN-LIST element from Org to HTML.
3157CONTENTS is the contents of the list. INFO is a plist holding 3205CONTENTS is the contents of the list. INFO is a plist holding
3158contextual information." 3206contextual information."
3159 (let ((type (org-element-property :type plain-list))) 3207 (let* ((type (pcase (org-element-property :type plain-list)
3160 (format "%s\n%s%s" 3208 (`ordered "ol")
3161 (org-html-begin-plain-list type) 3209 (`unordered "ul")
3162 contents (org-html-end-plain-list type)))) 3210 (`descriptive "dl")
3211 (other (error "Unknown HTML list type: %s" other))))
3212 (class (format "org-%s" type))
3213 (attributes (org-export-read-attribute :attr_html plain-list)))
3214 (format "<%s %s>\n%s</%s>"
3215 type
3216 (org-html--make-attribute-string
3217 (plist-put attributes :class
3218 (org-trim
3219 (mapconcat #'identity
3220 (list class (plist-get attributes :class))
3221 " "))))
3222 contents
3223 type)))
3163 3224
3164;;;; Plain Text 3225;;;; Plain Text
3165 3226
@@ -3267,7 +3328,7 @@ holding contextual information."
3267 #'number-to-string 3328 #'number-to-string
3268 (org-export-get-headline-number parent info) "-")))) 3329 (org-export-get-headline-number parent info) "-"))))
3269 ;; Build return value. 3330 ;; Build return value.
3270 (format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>" 3331 (format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>\n"
3271 class-num 3332 class-num
3272 (or (org-element-property :CUSTOM_ID parent) 3333 (or (org-element-property :CUSTOM_ID parent)
3273 section-number 3334 section-number
@@ -3317,11 +3378,14 @@ CONTENTS holds the contents of the item. INFO is a plist holding
3317contextual information." 3378contextual information."
3318 (if (org-export-read-attribute :attr_html src-block :textarea) 3379 (if (org-export-read-attribute :attr_html src-block :textarea)
3319 (org-html--textarea-block src-block) 3380 (org-html--textarea-block src-block)
3320 (let ((lang (org-element-property :language src-block)) 3381 (let* ((lang (org-element-property :language src-block))
3321 (code (org-html-format-code src-block info)) 3382 (code (org-html-format-code src-block info))
3322 (label (let ((lbl (and (org-element-property :name src-block) 3383 (label (let ((lbl (and (org-element-property :name src-block)
3323 (org-export-get-reference src-block info)))) 3384 (org-export-get-reference src-block info))))
3324 (if lbl (format " id=\"%s\"" lbl) "")))) 3385 (if lbl (format " id=\"%s\"" lbl) "")))
3386 (klipsify (and (plist-get info :html-klipsify-src)
3387 (member lang '("javascript" "js"
3388 "ruby" "scheme" "clojure" "php" "html")))))
3325 (if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code) 3389 (if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code)
3326 (format "<div class=\"org-src-container\">\n%s%s\n</div>" 3390 (format "<div class=\"org-src-container\">\n%s%s\n</div>"
3327 ;; Build caption. 3391 ;; Build caption.
@@ -3338,8 +3402,12 @@ contextual information."
3338 listing-number 3402 listing-number
3339 (org-trim (org-export-data caption info)))))) 3403 (org-trim (org-export-data caption info))))))
3340 ;; Contents. 3404 ;; Contents.
3341 (format "<pre class=\"src src-%s\"%s>%s</pre>" 3405 (let ((open (if org-html-keep-old-src "<pre" "<pre><code"))
3342 lang label code)))))) 3406 (close (if org-html-keep-old-src "</pre>" "</code></pre>")))
3407 (format "%s class=\"src src-%s\"%s%s>%s%s"
3408 open lang label (if (and klipsify (string= lang "html"))
3409 " data-editor-type=\"html\"" "")
3410 code close)))))))
3343 3411
3344;;;; Statistics Cookie 3412;;;; Statistics Cookie
3345 3413
diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el
index ecec7528623..4783f1158c7 100644
--- a/lisp/org/ox-icalendar.el
+++ b/lisp/org/ox-icalendar.el
@@ -341,7 +341,7 @@ A headline is blocked when either
341 (1- (length org-icalendar-date-time-format))) ?Z)) 341 (1- (length org-icalendar-date-time-format))) ?Z))
342 342
343(defvar org-agenda-default-appointment-duration) ; From org-agenda.el. 343(defvar org-agenda-default-appointment-duration) ; From org-agenda.el.
344(defun org-icalendar-convert-timestamp (timestamp keyword &optional end utc) 344(defun org-icalendar-convert-timestamp (timestamp keyword &optional end tz)
345 "Convert TIMESTAMP to iCalendar format. 345 "Convert TIMESTAMP to iCalendar format.
346 346
347TIMESTAMP is a timestamp object. KEYWORD is added in front of 347TIMESTAMP is a timestamp object. KEYWORD is added in front of
@@ -352,8 +352,11 @@ Also increase the hour by two (if time string contains a time),
352or the day by one (if it does not contain a time) when no 352or the day by one (if it does not contain a time) when no
353explicit ending time is specified. 353explicit ending time is specified.
354 354
355When optional argument UTC is non-nil, time will be expressed in 355When optional argument TZ is non-nil, timezone data time will be
356Universal Time, ignoring `org-icalendar-date-time-format'." 356added to the timestamp. It can be the string \"UTC\", to use UTC
357time, or a string in the IANA TZ database
358format (e.g. \"Europe/London\"). In either case, the value of
359`org-icalendar-date-time-format' will be ignored."
357 (let* ((year-start (org-element-property :year-start timestamp)) 360 (let* ((year-start (org-element-property :year-start timestamp))
358 (year-end (org-element-property :year-end timestamp)) 361 (year-end (org-element-property :year-end timestamp))
359 (month-start (org-element-property :month-start timestamp)) 362 (month-start (org-element-property :month-start timestamp))
@@ -387,8 +390,9 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
387 (concat 390 (concat
388 keyword 391 keyword
389 (format-time-string 392 (format-time-string
390 (cond (utc ":%Y%m%dT%H%M%SZ") 393 (cond ((string-equal tz "UTC") ":%Y%m%dT%H%M%SZ")
391 ((not with-time-p) ";VALUE=DATE:%Y%m%d") 394 ((not with-time-p) ";VALUE=DATE:%Y%m%d")
395 ((stringp tz) (concat ";TZID=" tz ":%Y%m%dT%H%M%S"))
392 (t (replace-regexp-in-string "%Z" 396 (t (replace-regexp-in-string "%Z"
393 org-icalendar-timezone 397 org-icalendar-timezone
394 org-icalendar-date-time-format 398 org-icalendar-date-time-format
@@ -396,7 +400,10 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
396 ;; Convert timestamp into internal time in order to use 400 ;; Convert timestamp into internal time in order to use
397 ;; `format-time-string' and fix any mistake (i.e. MI >= 60). 401 ;; `format-time-string' and fix any mistake (i.e. MI >= 60).
398 (encode-time 0 mi h d m y) 402 (encode-time 0 mi h d m y)
399 (and (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))) 403 (and (or (string-equal tz "UTC")
404 (and (null tz)
405 with-time-p
406 (org-icalendar-use-UTC-date-time-p)))
400 t))))) 407 t)))))
401 408
402(defun org-icalendar-dtstamp () 409(defun org-icalendar-dtstamp ()
@@ -530,7 +537,9 @@ inlinetask within the section."
530 (org-export-data 537 (org-export-data
531 (org-element-property :title entry) info)))) 538 (org-element-property :title entry) info))))
532 (loc (org-icalendar-cleanup-string 539 (loc (org-icalendar-cleanup-string
533 (org-element-property :LOCATION entry))) 540 (org-export-get-node-property
541 :LOCATION entry
542 (org-property-inherit-p "LOCATION"))))
534 ;; Build description of the entry from associated section 543 ;; Build description of the entry from associated section
535 ;; (headline) or contents (inlinetask). 544 ;; (headline) or contents (inlinetask).
536 (desc 545 (desc
@@ -545,7 +554,10 @@ inlinetask within the section."
545 contents 0 (min (length contents) 554 contents 0 (min (length contents)
546 org-icalendar-include-body)))) 555 org-icalendar-include-body))))
547 (org-icalendar-include-body (org-trim contents))))))) 556 (org-icalendar-include-body (org-trim contents)))))))
548 (cat (org-icalendar-get-categories entry info))) 557 (cat (org-icalendar-get-categories entry info))
558 (tz (org-export-get-node-property
559 :TIMEZONE entry
560 (org-property-inherit-p "TIMEZONE"))))
549 (concat 561 (concat
550 ;; Events: Delegate to `org-icalendar--vevent' to generate 562 ;; Events: Delegate to `org-icalendar--vevent' to generate
551 ;; "VEVENT" component from scheduled, deadline, or any 563 ;; "VEVENT" component from scheduled, deadline, or any
@@ -556,14 +568,14 @@ inlinetask within the section."
556 org-icalendar-use-deadline) 568 org-icalendar-use-deadline)
557 (org-icalendar--vevent 569 (org-icalendar--vevent
558 entry deadline (concat "DL-" uid) 570 entry deadline (concat "DL-" uid)
559 (concat "DL: " summary) loc desc cat))) 571 (concat "DL: " summary) loc desc cat tz)))
560 (let ((scheduled (org-element-property :scheduled entry))) 572 (let ((scheduled (org-element-property :scheduled entry)))
561 (and scheduled 573 (and scheduled
562 (memq (if todo-type 'event-if-todo 'event-if-not-todo) 574 (memq (if todo-type 'event-if-todo 'event-if-not-todo)
563 org-icalendar-use-scheduled) 575 org-icalendar-use-scheduled)
564 (org-icalendar--vevent 576 (org-icalendar--vevent
565 entry scheduled (concat "SC-" uid) 577 entry scheduled (concat "SC-" uid)
566 (concat "S: " summary) loc desc cat))) 578 (concat "S: " summary) loc desc cat tz)))
567 ;; When collecting plain timestamps from a headline and its 579 ;; When collecting plain timestamps from a headline and its
568 ;; title, skip inlinetasks since collection will happen once 580 ;; title, skip inlinetasks since collection will happen once
569 ;; ENTRY is one of them. 581 ;; ENTRY is one of them.
@@ -581,7 +593,7 @@ inlinetask within the section."
581 ((t) t))) 593 ((t) t)))
582 (let ((uid (format "TS%d-%s" (cl-incf counter) uid))) 594 (let ((uid (format "TS%d-%s" (cl-incf counter) uid)))
583 (org-icalendar--vevent 595 (org-icalendar--vevent
584 entry ts uid summary loc desc cat)))) 596 entry ts uid summary loc desc cat tz))))
585 info nil (and (eq type 'headline) 'inlinetask)) 597 info nil (and (eq type 'headline) 'inlinetask))
586 "")) 598 ""))
587 ;; Task: First check if it is appropriate to export it. If 599 ;; Task: First check if it is appropriate to export it. If
@@ -595,7 +607,7 @@ inlinetask within the section."
595 (not (org-icalendar-blocked-headline-p 607 (not (org-icalendar-blocked-headline-p
596 entry info)))) 608 entry info))))
597 ((t) (eq todo-type 'todo)))) 609 ((t) (eq todo-type 'todo))))
598 (org-icalendar--vtodo entry uid summary loc desc cat)) 610 (org-icalendar--vtodo entry uid summary loc desc cat tz))
599 ;; Diary-sexp: Collect every diary-sexp element within ENTRY 611 ;; Diary-sexp: Collect every diary-sexp element within ENTRY
600 ;; and its title, and transcode them. If ENTRY is 612 ;; and its title, and transcode them. If ENTRY is
601 ;; a headline, skip inlinetasks: they will be handled 613 ;; a headline, skip inlinetasks: they will be handled
@@ -626,7 +638,7 @@ inlinetask within the section."
626 contents)))) 638 contents))))
627 639
628(defun org-icalendar--vevent 640(defun org-icalendar--vevent
629 (entry timestamp uid summary location description categories) 641 (entry timestamp uid summary location description categories timezone)
630 "Create a VEVENT component. 642 "Create a VEVENT component.
631 643
632ENTRY is either a headline or an inlinetask element. TIMESTAMP 644ENTRY is either a headline or an inlinetask element. TIMESTAMP
@@ -635,7 +647,8 @@ is the unique identifier for the event. SUMMARY defines a short
635summary or subject for the event. LOCATION defines the intended 647summary or subject for the event. LOCATION defines the intended
636venue for the event. DESCRIPTION provides the complete 648venue for the event. DESCRIPTION provides the complete
637description of the event. CATEGORIES defines the categories the 649description of the event. CATEGORIES defines the categories the
638event belongs to. 650event belongs to. TIMEZONE specifies a time zone for this event
651only.
639 652
640Return VEVENT component as a string." 653Return VEVENT component as a string."
641 (org-icalendar-fold-string 654 (org-icalendar-fold-string
@@ -645,8 +658,8 @@ Return VEVENT component as a string."
645 (concat "BEGIN:VEVENT\n" 658 (concat "BEGIN:VEVENT\n"
646 (org-icalendar-dtstamp) "\n" 659 (org-icalendar-dtstamp) "\n"
647 "UID:" uid "\n" 660 "UID:" uid "\n"
648 (org-icalendar-convert-timestamp timestamp "DTSTART") "\n" 661 (org-icalendar-convert-timestamp timestamp "DTSTART" nil timezone) "\n"
649 (org-icalendar-convert-timestamp timestamp "DTEND" t) "\n" 662 (org-icalendar-convert-timestamp timestamp "DTEND" t timezone) "\n"
650 ;; RRULE. 663 ;; RRULE.
651 (when (org-element-property :repeater-type timestamp) 664 (when (org-element-property :repeater-type timestamp)
652 (format "RRULE:FREQ=%s;INTERVAL=%d\n" 665 (format "RRULE:FREQ=%s;INTERVAL=%d\n"
@@ -664,7 +677,7 @@ Return VEVENT component as a string."
664 "END:VEVENT")))) 677 "END:VEVENT"))))
665 678
666(defun org-icalendar--vtodo 679(defun org-icalendar--vtodo
667 (entry uid summary location description categories) 680 (entry uid summary location description categories timezone)
668 "Create a VTODO component. 681 "Create a VTODO component.
669 682
670ENTRY is either a headline or an inlinetask element. UID is the 683ENTRY is either a headline or an inlinetask element. UID is the
@@ -672,6 +685,7 @@ unique identifier for the task. SUMMARY defines a short summary
672or subject for the task. LOCATION defines the intended venue for 685or subject for the task. LOCATION defines the intended venue for
673the task. DESCRIPTION provides the complete description of the 686the task. DESCRIPTION provides the complete description of the
674task. CATEGORIES defines the categories the task belongs to. 687task. CATEGORIES defines the categories the task belongs to.
688TIMEZONE specifies a time zone for this TODO only.
675 689
676Return VTODO component as a string." 690Return VTODO component as a string."
677 (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled) 691 (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled)
@@ -690,11 +704,11 @@ Return VTODO component as a string."
690 (concat "BEGIN:VTODO\n" 704 (concat "BEGIN:VTODO\n"
691 "UID:TODO-" uid "\n" 705 "UID:TODO-" uid "\n"
692 (org-icalendar-dtstamp) "\n" 706 (org-icalendar-dtstamp) "\n"
693 (org-icalendar-convert-timestamp start "DTSTART") "\n" 707 (org-icalendar-convert-timestamp start "DTSTART" nil timezone) "\n"
694 (and (memq 'todo-due org-icalendar-use-deadline) 708 (and (memq 'todo-due org-icalendar-use-deadline)
695 (org-element-property :deadline entry) 709 (org-element-property :deadline entry)
696 (concat (org-icalendar-convert-timestamp 710 (concat (org-icalendar-convert-timestamp
697 (org-element-property :deadline entry) "DUE") 711 (org-element-property :deadline entry) "DUE" nil timezone)
698 "\n")) 712 "\n"))
699 "SUMMARY:" summary "\n" 713 "SUMMARY:" summary "\n"
700 (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) 714 (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
@@ -879,7 +893,7 @@ The file is stored under the name chosen in
879 "Export current agenda view to an iCalendar FILE. 893 "Export current agenda view to an iCalendar FILE.
880This function assumes major mode for current buffer is 894This function assumes major mode for current buffer is
881`org-agenda-mode'." 895`org-agenda-mode'."
882 (let* ((org-export-babel-evaluate) ;don't evaluate Babel blocks 896 (let* ((org-export-use-babel) ;don't evaluate Babel blocks
883 (contents 897 (contents
884 (org-export-string-as 898 (org-export-string-as
885 (with-output-to-string 899 (with-output-to-string
@@ -914,43 +928,46 @@ This function assumes major mode for current buffer is
914(defun org-icalendar--combine-files (&rest files) 928(defun org-icalendar--combine-files (&rest files)
915 "Combine entries from multiple files into an iCalendar file. 929 "Combine entries from multiple files into an iCalendar file.
916FILES is a list of files to build the calendar from." 930FILES is a list of files to build the calendar from."
917 (org-agenda-prepare-buffers files) 931 ;; At the end of the process, all buffers related to FILES are going
918 (unwind-protect 932 ;; to be killed. Make sure to only kill the ones opened in the
919 (progn 933 ;; process.
920 (with-temp-file org-icalendar-combined-agenda-file 934 (let ((org-agenda-new-buffers nil))
921 (insert 935 (unwind-protect
922 (org-icalendar--vcalendar 936 (progn
923 ;; Name. 937 (with-temp-file org-icalendar-combined-agenda-file
924 org-icalendar-combined-name 938 (insert
925 ;; Owner. 939 (org-icalendar--vcalendar
926 user-full-name 940 ;; Name.
927 ;; Timezone. 941 org-icalendar-combined-name
928 (or (org-string-nw-p org-icalendar-timezone) 942 ;; Owner.
929 (cadr (current-time-zone))) 943 user-full-name
930 ;; Description. 944 ;; Timezone.
931 org-icalendar-combined-description 945 (or (org-string-nw-p org-icalendar-timezone)
932 ;; Contents. 946 (cadr (current-time-zone)))
933 (concat 947 ;; Description.
934 ;; Agenda contents. 948 org-icalendar-combined-description
935 (mapconcat 949 ;; Contents.
936 (lambda (file) 950 (concat
937 (catch 'nextfile 951 ;; Agenda contents.
938 (org-check-agenda-file file) 952 (mapconcat
939 (with-current-buffer (org-get-agenda-file-buffer file) 953 (lambda (file)
940 ;; Create ID if necessary. 954 (catch 'nextfile
941 (when org-icalendar-store-UID 955 (org-check-agenda-file file)
942 (org-icalendar-create-uid file t)) 956 (with-current-buffer (org-get-agenda-file-buffer file)
943 (org-export-as 957 ;; Create ID if necessary.
944 'icalendar nil nil t 958 (when org-icalendar-store-UID
945 '(:ascii-charset utf-8 :ascii-links-to-notes nil))))) 959 (org-icalendar-create-uid file t))
946 files "") 960 (org-export-as
947 ;; BBDB anniversaries. 961 'icalendar nil nil t
948 (when (and org-icalendar-include-bbdb-anniversaries 962 '(:ascii-charset utf-8 :ascii-links-to-notes nil)))))
949 (require 'org-bbdb nil t)) 963 files "")
950 (with-output-to-string (org-bbdb-anniv-export-ical))))))) 964 ;; BBDB anniversaries.
951 (run-hook-with-args 'org-icalendar-after-save-hook 965 (when (and org-icalendar-include-bbdb-anniversaries
952 org-icalendar-combined-agenda-file)) 966 (require 'org-bbdb nil t))
953 (org-release-buffers org-agenda-new-buffers))) 967 (with-output-to-string (org-bbdb-anniv-export-ical)))))))
968 (run-hook-with-args 'org-icalendar-after-save-hook
969 org-icalendar-combined-agenda-file))
970 (org-release-buffers org-agenda-new-buffers))))
954 971
955 972
956(provide 'ox-icalendar) 973(provide 'ox-icalendar)
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
index f1a510e98aa..61b6b8cca92 100644
--- a/lisp/org/ox-latex.el
+++ b/lisp/org/ox-latex.el
@@ -102,7 +102,8 @@
102 :filters-alist '((:filter-options . org-latex-math-block-options-filter) 102 :filters-alist '((:filter-options . org-latex-math-block-options-filter)
103 (:filter-paragraph . org-latex-clean-invalid-line-breaks) 103 (:filter-paragraph . org-latex-clean-invalid-line-breaks)
104 (:filter-parse-tree org-latex-math-block-tree-filter 104 (:filter-parse-tree org-latex-math-block-tree-filter
105 org-latex-matrices-tree-filter) 105 org-latex-matrices-tree-filter
106 org-latex-image-link-filter)
106 (:filter-verse-block . org-latex-clean-invalid-line-breaks)) 107 (:filter-verse-block . org-latex-clean-invalid-line-breaks))
107 :options-alist 108 :options-alist
108 '((:latex-class "LATEX_CLASS" nil org-latex-default-class t) 109 '((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
@@ -726,7 +727,8 @@ environment."
726 :safe #'stringp) 727 :safe #'stringp)
727 728
728(defcustom org-latex-inline-image-rules 729(defcustom org-latex-inline-image-rules
729 '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'")) 730 `(("file" . ,(regexp-opt
731 '("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg"))))
730 "Rules characterizing image files that can be inlined into LaTeX. 732 "Rules characterizing image files that can be inlined into LaTeX.
731 733
732A rule consists in an association whose key is the type of link 734A rule consists in an association whose key is the type of link
@@ -863,7 +865,7 @@ The function should return the string to be exported.
863 865
864The default function simply returns the value of CONTENTS." 866The default function simply returns the value of CONTENTS."
865 :group 'org-export-latex 867 :group 'org-export-latex
866 :version "24.4" 868 :version "26.1"
867 :package-version '(Org . "8.3") 869 :package-version '(Org . "8.3")
868 :type 'function) 870 :type 'function)
869 871
@@ -954,7 +956,7 @@ parameter for the listings package. If the mode name and the
954listings name are the same, the language does not need an entry 956listings name are the same, the language does not need an entry
955in this list - but it does not hurt if it is present." 957in this list - but it does not hurt if it is present."
956 :group 'org-export-latex 958 :group 'org-export-latex
957 :version "24.4" 959 :version "26.1"
958 :package-version '(Org . "8.3") 960 :package-version '(Org . "8.3")
959 :type '(repeat 961 :type '(repeat
960 (list 962 (list
@@ -1310,14 +1312,19 @@ For non-floats, see `org-latex--wrap-label'."
1310 (t 1312 (t
1311 (format (if nonfloat "\\captionof{%s}%s{%s%s}\n" 1313 (format (if nonfloat "\\captionof{%s}%s{%s%s}\n"
1312 "\\caption%s%s{%s%s}\n") 1314 "\\caption%s%s{%s%s}\n")
1313 (if nonfloat 1315 (let ((type* (if (eq type 'latex-environment)
1314 (cl-case type 1316 (org-latex--environment-type element)
1315 (paragraph "figure") 1317 type)))
1316 (src-block (if (plist-get info :latex-listings) 1318 (if nonfloat
1317 "listing" 1319 (cl-case type*
1318 "figure")) 1320 (paragraph "figure")
1319 (t (symbol-name type))) 1321 (image "figure")
1320 "") 1322 (special-block "figure")
1323 (src-block (if (plist-get info :latex-listings)
1324 "listing"
1325 "figure"))
1326 (t (symbol-name type*)))
1327 ""))
1321 (if short (format "[%s]" (org-export-data short info)) "") 1328 (if short (format "[%s]" (org-export-data short info)) "")
1322 label 1329 label
1323 (org-export-data main info)))))) 1330 (org-export-data main info))))))
@@ -2250,24 +2257,62 @@ CONTENTS is nil. INFO is a plist holding contextual information."
2250 2257
2251;;;; Latex Environment 2258;;;; Latex Environment
2252 2259
2260(defun org-latex--environment-type (latex-environment)
2261 "Return the TYPE of LATEX-ENVIRONMENT.
2262
2263The TYPE is determined from the actual latex environment, and
2264could be a member of `org-latex-caption-above' or `math'."
2265 (let* ((latex-begin-re "\\\\begin{\\([A-Za-z0-9*]+\\)}")
2266 (value (org-remove-indentation
2267 (org-element-property :value latex-environment)))
2268 (env (or (and (string-match latex-begin-re value)
2269 (match-string 1 value))
2270 "")))
2271 (cond
2272 ((string-match-p org-latex-math-environments-re value) 'math)
2273 ((string-match-p
2274 (eval-when-compile
2275 (regexp-opt '("table" "longtable" "tabular" "tabu" "longtabu")))
2276 env)
2277 'table)
2278 ((string-match-p "figure" env) 'image)
2279 ((string-match-p
2280 (eval-when-compile
2281 (regexp-opt '("lstlisting" "listing" "verbatim" "minted")))
2282 env)
2283 'src-block)
2284 (t 'special-block))))
2285
2253(defun org-latex-latex-environment (latex-environment _contents info) 2286(defun org-latex-latex-environment (latex-environment _contents info)
2254 "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. 2287 "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX.
2255CONTENTS is nil. INFO is a plist holding contextual information." 2288CONTENTS is nil. INFO is a plist holding contextual information."
2256 (when (plist-get info :with-latex) 2289 (when (plist-get info :with-latex)
2257 (let ((value (org-remove-indentation 2290 (let* ((value (org-remove-indentation
2258 (org-element-property :value latex-environment)))) 2291 (org-element-property :value latex-environment)))
2259 (if (not (org-element-property :name latex-environment)) value 2292 (type (org-latex--environment-type latex-environment))
2293 (caption (if (eq type 'math)
2294 (org-latex--label latex-environment info nil t)
2295 (org-latex--caption/label-string latex-environment info)))
2296 (caption-above-p
2297 (memq type (append (plist-get info :latex-caption-above) '(math)))))
2298 (if (not (or (org-element-property :name latex-environment)
2299 (org-element-property :caption latex-environment)))
2300 value
2260 ;; Environment is labeled: label must be within the environment 2301 ;; Environment is labeled: label must be within the environment
2261 ;; (otherwise, a reference pointing to that element will count 2302 ;; (otherwise, a reference pointing to that element will count
2262 ;; the section instead). 2303 ;; the section instead). Also insert caption if `latex-environment'
2304 ;; is not a math environment.
2263 (with-temp-buffer 2305 (with-temp-buffer
2264 (insert value) 2306 (insert value)
2265 (goto-char (point-min)) 2307 (if caption-above-p
2266 (forward-line) 2308 (progn
2267 (insert (org-latex--label latex-environment info nil t)) 2309 (goto-char (point-min))
2310 (forward-line))
2311 (goto-char (point-max))
2312 (forward-line -1))
2313 (insert caption)
2268 (buffer-string)))))) 2314 (buffer-string))))))
2269 2315
2270
2271;;;; Latex Fragment 2316;;;; Latex Fragment
2272 2317
2273(defun org-latex-latex-fragment (latex-fragment _contents _info) 2318(defun org-latex-latex-fragment (latex-fragment _contents _info)
@@ -2291,6 +2336,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
2291 2336
2292;;;; Link 2337;;;; Link
2293 2338
2339(defun org-latex-image-link-filter (data _backend info)
2340 (org-export-insert-image-links data info org-latex-inline-image-rules))
2341
2294(defun org-latex--inline-image (link info) 2342(defun org-latex--inline-image (link info)
2295 "Return LaTeX code for an inline image. 2343 "Return LaTeX code for an inline image.
2296LINK is the link pointing to the inline image. INFO is a plist 2344LINK is the link pointing to the inline image. INFO is a plist
@@ -3300,8 +3348,7 @@ This function assumes TABLE has `org' as its `:type' property and
3300 (contents 3348 (contents
3301 (mapconcat 3349 (mapconcat
3302 (lambda (row) 3350 (lambda (row)
3303 ;; Ignore horizontal rules. 3351 (if (eq (org-element-property :type row) 'rule) "\\hline"
3304 (when (eq (org-element-property :type row) 'standard)
3305 ;; Return each cell unmodified. 3352 ;; Return each cell unmodified.
3306 (concat 3353 (concat
3307 (mapconcat 3354 (mapconcat
diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el
index e2fefa345cc..5ba52e7faf3 100644
--- a/lisp/org/ox-md.el
+++ b/lisp/org/ox-md.el
@@ -248,15 +248,42 @@ a communication channel."
248 "Non-nil when HEADLINE is being referred to. 248 "Non-nil when HEADLINE is being referred to.
249INFO is a plist used as a communication channel. Links and table 249INFO is a plist used as a communication channel. Links and table
250of contents can refer to headlines." 250of contents can refer to headlines."
251 (or (plist-get info :with-toc) 251 (unless (org-element-property :footnote-section-p headline)
252 (org-element-map (plist-get info :parse-tree) 'link 252 (or
253 (lambda (link) 253 ;; Global table of contents includes HEADLINE.
254 (eq headline 254 (and (plist-get info :with-toc)
255 (pcase (org-element-property :type link) 255 (memq headline
256 ((or "custom-id" "id") (org-export-resolve-id-link link info)) 256 (org-export-collect-headlines info (plist-get info :with-toc))))
257 ("fuzzy" (org-export-resolve-fuzzy-link link info)) 257 ;; A local table of contents includes HEADLINE.
258 (_ nil)))) 258 (cl-some
259 info t))) 259 (lambda (h)
260 (let ((section (car (org-element-contents h))))
261 (and
262 (eq 'section (org-element-type section))
263 (org-element-map section 'keyword
264 (lambda (keyword)
265 (when (equal "TOC" (org-element-property :key keyword))
266 (let ((case-fold-search t)
267 (value (org-element-property :value keyword)))
268 (and (string-match-p "\\<headlines\\>" value)
269 (let ((n (and
270 (string-match "\\<[0-9]+\\>" value)
271 (string-to-number (match-string 0 value))))
272 (local? (string-match-p "\\<local\\>" value)))
273 (memq headline
274 (org-export-collect-headlines
275 info n (and local? keyword))))))))
276 info t))))
277 (org-element-lineage headline))
278 ;; A link refers internally to HEADLINE.
279 (org-element-map (plist-get info :parse-tree) 'link
280 (lambda (link)
281 (eq headline
282 (pcase (org-element-property :type link)
283 ((or "custom-id" "id") (org-export-resolve-id-link link info))
284 ("fuzzy" (org-export-resolve-fuzzy-link link info))
285 (_ nil))))
286 info t))))
260 287
261(defun org-md--headline-title (style level title &optional anchor tags) 288(defun org-md--headline-title (style level title &optional anchor tags)
262 "Generate a headline title in the preferred Markdown headline style. 289 "Generate a headline title in the preferred Markdown headline style.
@@ -328,9 +355,19 @@ a communication channel."
328 "Transcode a KEYWORD element into Markdown format. 355 "Transcode a KEYWORD element into Markdown format.
329CONTENTS is nil. INFO is a plist used as a communication 356CONTENTS is nil. INFO is a plist used as a communication
330channel." 357channel."
331 (if (member (org-element-property :key keyword) '("MARKDOWN" "MD")) 358 (pcase (org-element-property :key keyword)
332 (org-element-property :value keyword) 359 ((or "MARKDOWN" "MD") (org-element-property :value keyword))
333 (org-export-with-backend 'html keyword contents info))) 360 ("TOC"
361 (let ((case-fold-search t)
362 (value (org-element-property :value keyword)))
363 (cond
364 ((string-match-p "\\<headlines\\>" value)
365 (let ((depth (and (string-match "\\<[0-9]+\\>" value)
366 (string-to-number (match-string 0 value))))
367 (local? (string-match-p "\\<local\\>" value)))
368 (org-remove-indentation
369 (org-md--build-toc info depth keyword local?)))))))
370 (_ (org-export-with-backend 'html keyword contents info))))
334 371
335 372
336;;;; Line Break 373;;;; Line Break
@@ -513,6 +550,61 @@ a communication channel."
513 550
514;;;; Template 551;;;; Template
515 552
553(defun org-md--build-toc (info &optional n keyword local)
554 "Return a table of contents.
555
556INFO is a plist used as a communication channel.
557
558Optional argument N, when non-nil, is an integer specifying the
559depth of the table.
560
561Optional argument KEYWORD specifies the TOC keyword, if any, from
562which the table of contents generation has been initiated.
563
564When optional argument LOCAL is non-nil, build a table of
565contents according to the current headline."
566 (concat
567 (unless local
568 (let ((style (plist-get info :md-headline-style))
569 (title (org-html--translate "Table of Contents" info)))
570 (org-md--headline-title style 1 title nil)))
571 (mapconcat
572 (lambda (headline)
573 (let* ((indentation
574 (make-string
575 (* 4 (1- (org-export-get-relative-level headline info)))
576 ?\s))
577 (number (format "%d."
578 (org-last
579 (org-export-get-headline-number headline info))))
580 (bullet (concat number (make-string (- 4 (length number)) ?\s)))
581 (title
582 (format "[%s](#%s)"
583 (org-export-data-with-backend
584 (org-export-get-alt-title headline info)
585 ;; Create an anonymous back-end that will
586 ;; ignore any footnote-reference, link,
587 ;; radio-target and target in table of
588 ;; contents.
589 (org-export-create-backend
590 :parent 'md
591 :transcoders '((footnote-reference . ignore)
592 (link . (lambda (object c i) c))
593 (radio-target . (lambda (object c i) c))
594 (target . ignore)))
595 info)
596 (or (org-element-property :CUSTOM_ID headline)
597 (org-export-get-reference headline info))))
598 (tags (and (plist-get info :with-tags)
599 (not (eq 'not-in-toc (plist-get info :with-tags)))
600 (let ((tags (org-export-get-tags headline info)))
601 (and tags
602 (format ":%s:"
603 (mapconcat #'identity tags ":")))))))
604 (concat indentation bullet title tags)))
605 (org-export-collect-headlines info n (and local keyword)) "\n")
606 "\n"))
607
516(defun org-md--footnote-formatted (footnote info) 608(defun org-md--footnote-formatted (footnote info)
517 "Formats a single footnote entry FOOTNOTE. 609 "Formats a single footnote entry FOOTNOTE.
518FOOTNOTE is a cons cell of the form (number . definition). 610FOOTNOTE is a cons cell of the form (number . definition).
@@ -549,7 +641,8 @@ holding export options."
549 (concat 641 (concat
550 ;; Table of contents. 642 ;; Table of contents.
551 (let ((depth (plist-get info :with-toc))) 643 (let ((depth (plist-get info :with-toc)))
552 (when depth (org-html-toc depth info))) 644 (when depth
645 (concat (org-md--build-toc info (and (wholenump depth) depth)) "\n")))
553 ;; Document contents. 646 ;; Document contents.
554 contents 647 contents
555 "\n" 648 "\n"
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
index f70f5706dba..f00fd99fc3e 100644
--- a/lisp/org/ox-odt.el
+++ b/lisp/org/ox-odt.el
@@ -85,7 +85,8 @@
85 :filters-alist '((:filter-parse-tree 85 :filters-alist '((:filter-parse-tree
86 . (org-odt--translate-latex-fragments 86 . (org-odt--translate-latex-fragments
87 org-odt--translate-description-lists 87 org-odt--translate-description-lists
88 org-odt--translate-list-tables))) 88 org-odt--translate-list-tables
89 org-odt--translate-image-links)))
89 :menu-entry 90 :menu-entry
90 '(?o "Export to ODT" 91 '(?o "Export to ODT"
91 ((?o "As ODT file" org-odt-export-to-odt) 92 ((?o "As ODT file" org-odt-export-to-odt)
@@ -655,7 +656,7 @@ The function should return the string to be exported.
655 656
656The default value simply returns the value of CONTENTS." 657The default value simply returns the value of CONTENTS."
657 :group 'org-export-odt 658 :group 'org-export-odt
658 :version "24.4" 659 :version "26.1"
659 :package-version '(Org . "8.3") 660 :package-version '(Org . "8.3")
660 :type 'function) 661 :type 'function)
661 662
@@ -1870,7 +1871,7 @@ See `org-odt-format-headline-function' for details."
1870 (let ((style (if (eq todo-type 'done) "OrgDone" "OrgTodo"))) 1871 (let ((style (if (eq todo-type 'done) "OrgDone" "OrgTodo")))
1871 (format "<text:span text:style-name=\"%s\">%s</text:span> " style todo))) 1872 (format "<text:span text:style-name=\"%s\">%s</text:span> " style todo)))
1872 (when priority 1873 (when priority
1873 (let* ((style (format "OrgPriority-%s" priority)) 1874 (let* ((style (format "OrgPriority-%c" priority))
1874 (priority (format "[#%c]" priority))) 1875 (priority (format "[#%c]" priority)))
1875 (format "<text:span text:style-name=\"%s\">%s</text:span> " 1876 (format "<text:span text:style-name=\"%s\">%s</text:span> "
1876 style priority))) 1877 style priority)))
@@ -3682,6 +3683,11 @@ contextual information."
3682 3683
3683;;; Filters 3684;;; Filters
3684 3685
3686;;; Images
3687
3688(defun org-odt--translate-image-links (data _backend info)
3689 (org-export-insert-image-links data info org-odt-inline-image-rules))
3690
3685;;;; LaTeX fragments 3691;;;; LaTeX fragments
3686 3692
3687(defun org-odt--translate-latex-fragments (tree _backend info) 3693(defun org-odt--translate-latex-fragments (tree _backend info)
@@ -3749,6 +3755,7 @@ contextual information."
3749 nil display-msg nil 3755 nil display-msg nil
3750 processing-type) 3756 processing-type)
3751 (goto-char (point-min)) 3757 (goto-char (point-min))
3758 (skip-chars-forward " \t\n")
3752 (org-element-link-parser)))) 3759 (org-element-link-parser))))
3753 (if (not (eq 'link (org-element-type link))) 3760 (if (not (eq 'link (org-element-type link)))
3754 (message "LaTeX Conversion failed.") 3761 (message "LaTeX Conversion failed.")
diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el
index 6c6a29a1f34..7db3a66ee8f 100644
--- a/lisp/org/ox-org.el
+++ b/lisp/org/ox-org.el
@@ -312,7 +312,8 @@ publishing directory.
312Return output file name." 312Return output file name."
313 (org-publish-org-to 'org filename ".org" plist pub-dir) 313 (org-publish-org-to 'org filename ".org" plist pub-dir)
314 (when (plist-get plist :htmlized-source) 314 (when (plist-get plist :htmlized-source)
315 (require 'htmlize) 315 (or (require 'htmlize nil t)
316 (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
316 (require 'ox-html) 317 (require 'ox-html)
317 (let* ((org-inhibit-startup t) 318 (let* ((org-inhibit-startup t)
318 (htmlize-output-type 'css) 319 (htmlize-output-type 'css)
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el
index bece11a2d1f..a975abc4871 100644
--- a/lisp/org/ox-publish.el
+++ b/lisp/org/ox-publish.el
@@ -46,9 +46,6 @@
46 46
47;;; Variables 47;;; Variables
48 48
49(defvar org-publish-temp-files nil
50 "Temporary list of files to be published.")
51
52;; Here, so you find the variable right before it's used the first time: 49;; Here, so you find the variable right before it's used the first time:
53(defvar org-publish-cache nil 50(defvar org-publish-cache nil
54 "This will cache timestamps and titles for files in publishing projects. 51 "This will cache timestamps and titles for files in publishing projects.
@@ -209,18 +206,12 @@ a site-map of files or summary page for a given project.
209 206
210 `:sitemap-filename' 207 `:sitemap-filename'
211 208
212 Filename for output of sitemap. Defaults to \"sitemap.org\". 209 Filename for output of site-map. Defaults to \"sitemap.org\".
213 210
214 `:sitemap-title' 211 `:sitemap-title'
215 212
216 Title of site-map page. Defaults to name of file. 213 Title of site-map page. Defaults to name of file.
217 214
218 `:sitemap-function'
219
220 Plugin function to use for generation of site-map. Defaults
221 to `org-publish-org-sitemap', which generates a plain list of
222 links to all files in the project.
223
224 `:sitemap-style' 215 `:sitemap-style'
225 216
226 Can be `list' (site-map is just an itemized list of the 217 Can be `list' (site-map is just an itemized list of the
@@ -228,19 +219,42 @@ a site-map of files or summary page for a given project.
228 structure of the source files is reflected in the site-map). 219 structure of the source files is reflected in the site-map).
229 Defaults to `tree'. 220 Defaults to `tree'.
230 221
231 `:sitemap-sans-extension' 222 `:sitemap-format-entry'
223
224 Plugin function used to format entries in the site-map. It
225 is called with three arguments: the file or directory name
226 relative to base directory, the site map style and the
227 current project. It has to return a string.
228
229 Defaults to `org-publish-sitemap-default-entry', which turns
230 file names into links and use document titles as
231 descriptions. For specific formatting needs, one can use
232 `org-publish-find-date', `org-publish-find-title' and
233 `org-publish-find-property', to retrieve additional
234 information about published documents.
232 235
233 Remove extension from site-map's file-names. Useful to have 236 `:sitemap-function'
234 cool URIs (see http://www.w3.org/Provider/Style/URI). 237
235 Defaults to nil. 238 Plugin function to use for generation of site-map. It is
239 called with two arguments: the title of the site-map, as
240 a string, and a representation of the files involved in the
241 project, as returned by `org-list-to-lisp'. The latter can
242 further be transformed using `org-list-to-generic',
243 `org-list-to-subtree' and alike. It has to return a string.
244
245 Defaults to `org-publish-sitemap-default', which generates
246 a plain list of links to all files in the project.
236 247
237If you create a site-map file, adjust the sorting like this: 248If you create a site-map file, adjust the sorting like this:
238 249
239 `:sitemap-sort-folders' 250 `:sitemap-sort-folders'
240 251
241 Where folders should appear in the site-map. Set this to 252 Where folders should appear in the site-map. Set this to
242 `first' (default) or `last' to display folders first or last, 253 `first' or `last' to display folders first or last,
243 respectively. Any other value will mix files and folders. 254 respectively. When set to `ignore' (default), folders are
255 ignored altogether. Any other value will mix files and
256 folders. This variable has no effect when site-map style is
257 `tree'.
244 258
245 `:sitemap-sort-files' 259 `:sitemap-sort-files'
246 260
@@ -302,17 +316,28 @@ You can overwrite this default per project in your
302 :group 'org-export-publish 316 :group 'org-export-publish
303 :type 'symbol) 317 :type 'symbol)
304 318
305(defcustom org-publish-sitemap-sort-folders 'first 319(defcustom org-publish-sitemap-sort-folders 'ignore
306 "A symbol, denoting if folders are sorted first in sitemaps. 320 "A symbol, denoting if folders are sorted first in site-maps.
307Possible values are `first', `last', and nil. 321
322Possible values are `first', `last', `ignore' and nil.
308If `first', folders will be sorted before files. 323If `first', folders will be sorted before files.
309If `last', folders are sorted to the end after the files. 324If `last', folders are sorted to the end after the files.
310Any other value will not mix files and folders. 325If `ignore', folders do not appear in the site-map.
326Any other value will mix files and folders.
311 327
312You can overwrite this default per project in your 328You can overwrite this default per project in your
313`org-publish-project-alist', using `:sitemap-sort-folders'." 329`org-publish-project-alist', using `:sitemap-sort-folders'.
330
331This variable is ignored when site-map style is `tree'."
314 :group 'org-export-publish 332 :group 'org-export-publish
315 :type 'symbol) 333 :type '(choice
334 (const :tag "Folders before files" first)
335 (const :tag "Folders after files" last)
336 (const :tag "No folder in site-map" ignore)
337 (const :tag "Mix folders and files" nil))
338 :version "26.1"
339 :package-version '(Org . "9.1")
340 :safe #'symbolp)
316 341
317(defcustom org-publish-sitemap-sort-ignore-case nil 342(defcustom org-publish-sitemap-sort-ignore-case nil
318 "Non-nil when site-map sorting should ignore case. 343 "Non-nil when site-map sorting should ignore case.
@@ -322,22 +347,6 @@ You can overwrite this default per project in your
322 :group 'org-export-publish 347 :group 'org-export-publish
323 :type 'boolean) 348 :type 'boolean)
324 349
325(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
326 "Format for printing a date in the sitemap.
327See `format-time-string' for allowed formatters."
328 :group 'org-export-publish
329 :type 'string)
330
331(defcustom org-publish-sitemap-file-entry-format "%t"
332 "Format string for site-map file entry.
333You could use brackets to delimit on what part the link will be.
334
335%t is the title.
336%a is the author.
337%d is the date formatted using `org-publish-sitemap-date-format'."
338 :group 'org-export-publish
339 :type 'string)
340
341 350
342 351
343;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 352;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -395,6 +404,15 @@ definition."
395 (plist-get properties property) 404 (plist-get properties property)
396 default))) 405 default)))
397 406
407(defun org-publish--expand-file-name (file project)
408 "Return full file name for FILE in PROJECT.
409When FILE is a relative file name, it is expanded according to
410project base directory. Always return the true name of the file,
411ignoring symlinks."
412 (file-truename
413 (if (file-name-absolute-p file) file
414 (expand-file-name file (org-publish-property :base-directory project)))))
415
398(defun org-publish-expand-projects (projects-alist) 416(defun org-publish-expand-projects (projects-alist)
399 "Expand projects in PROJECTS-ALIST. 417 "Expand projects in PROJECTS-ALIST.
400This splices all the components into the list." 418This splices all the components into the list."
@@ -402,144 +420,57 @@ This splices all the components into the list."
402 (while (setq p (pop rest)) 420 (while (setq p (pop rest))
403 (if (setq components (plist-get (cdr p) :components)) 421 (if (setq components (plist-get (cdr p) :components))
404 (setq rest (append 422 (setq rest (append
405 (mapcar (lambda (x) (assoc x org-publish-project-alist)) 423 (mapcar
406 components) 424 (lambda (x)
425 (or (assoc x org-publish-project-alist)
426 (user-error "Unknown component %S in project %S"
427 x (car p))))
428 components)
407 rest)) 429 rest))
408 (push p rtn))) 430 (push p rtn)))
409 (nreverse (delete-dups (delq nil rtn))))) 431 (nreverse (delete-dups (delq nil rtn)))))
410 432
411(defvar org-publish-sitemap-sort-files) 433(defun org-publish-get-base-files (project)
412(defvar org-publish-sitemap-sort-folders) 434 "Return a list of all files in PROJECT."
413(defvar org-publish-sitemap-ignore-case) 435 (let* ((base-dir (file-name-as-directory
414(defvar org-publish-sitemap-requested) 436 (org-publish-property :base-directory project)))
415(defvar org-publish-sitemap-date-format) 437 (extension (or (org-publish-property :base-extension project) "org"))
416(defvar org-publish-sitemap-file-entry-format) 438 (match (and (not (eq extension 'any))
417(defun org-publish-compare-directory-files (a b) 439 (concat "^[^\\.].*\\.\\(" extension "\\)$")))
418 "Predicate for `sort', that sorts folders and files for sitemap." 440 (base-files
419 (let ((retval t)) 441 (cl-remove-if #'file-directory-p
420 (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders) 442 (if (org-publish-property :recursive project)
421 ;; First we sort files: 443 (directory-files-recursively base-dir match)
422 (when org-publish-sitemap-sort-files 444 (directory-files base-dir t match t)))))
423 (pcase org-publish-sitemap-sort-files 445 (org-uniquify
424 (`alphabetically 446 (append
425 (let* ((adir (file-directory-p a)) 447 ;; Files from BASE-DIR. Apply exclusion filter before adding
426 (aorg (and (string-suffix-p ".org" a) (not adir))) 448 ;; included files.
427 (bdir (file-directory-p b)) 449 (let ((exclude-regexp (org-publish-property :exclude project)))
428 (borg (and (string-suffix-p ".org" b) (not bdir))) 450 (if exclude-regexp
429 (A (if aorg (concat (file-name-directory a) 451 (cl-remove-if
430 (org-publish-find-title a)) a)) 452 (lambda (f)
431 (B (if borg (concat (file-name-directory b) 453 ;; Match against relative names, yet BASE-DIR file
432 (org-publish-find-title b)) b))) 454 ;; names are absolute.
433 (setq retval (if org-publish-sitemap-ignore-case 455 (string-match exclude-regexp
434 (not (string-lessp (upcase B) (upcase A))) 456 (file-relative-name f base-dir)))
435 (not (string-lessp B A)))))) 457 base-files)
436 ((or `anti-chronologically `chronologically) 458 base-files))
437 (let* ((adate (org-publish-find-date a)) 459 ;; Sitemap file.
438 (bdate (org-publish-find-date b)) 460 (and (org-publish-property :auto-sitemap project)
439 (A (+ (lsh (car adate) 16) (cadr adate))) 461 (list (expand-file-name
440 (B (+ (lsh (car bdate) 16) (cadr bdate)))) 462 (or (org-publish-property :sitemap-filename project)
441 (setq retval 463 "sitemap.org")
442 (if (eq org-publish-sitemap-sort-files 'chronologically) 464 base-dir)))
443 (<= A B) 465 ;; Included files.
444 (>= A B))))))) 466 (mapcar (lambda (f) (expand-file-name f base-dir))
445 ;; Directory-wise wins: 467 (org-publish-property :include project))))))
446 (when org-publish-sitemap-sort-folders
447 ;; a is directory, b not:
448 (cond
449 ((and (file-directory-p a) (not (file-directory-p b)))
450 (setq retval (eq org-publish-sitemap-sort-folders 'first)))
451 ;; a is not a directory, but b is:
452 ((and (not (file-directory-p a)) (file-directory-p b))
453 (setq retval (eq org-publish-sitemap-sort-folders 'last))))))
454 retval))
455
456(defun org-publish-get-base-files-1
457 (base-dir &optional recurse match skip-file skip-dir)
458 "Set `org-publish-temp-files' with files from BASE-DIR directory.
459If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is
460non-nil, restrict this list to the files matching the regexp
461MATCH. If SKIP-FILE is non-nil, skip file matching the regexp
462SKIP-FILE. If SKIP-DIR is non-nil, don't check directories
463matching the regexp SKIP-DIR when recursing through BASE-DIR."
464 (let ((all-files (if (not recurse) (directory-files base-dir t match)
465 ;; If RECURSE is non-nil, we want all files
466 ;; matching MATCH and sub-directories.
467 (cl-remove-if-not
468 (lambda (file)
469 (or (file-directory-p file)
470 (and match (string-match match file))))
471 (directory-files base-dir t)))))
472 (dolist (f (if (not org-publish-sitemap-requested) all-files
473 (sort all-files #'org-publish-compare-directory-files)))
474 (let ((fd-p (file-directory-p f))
475 (fnd (file-name-nondirectory f)))
476 (if (and fd-p recurse
477 (not (string-match "^\\.+$" fnd))
478 (if skip-dir (not (string-match skip-dir fnd)) t))
479 (org-publish-get-base-files-1
480 f recurse match skip-file skip-dir)
481 (unless (or fd-p ; This is a directory.
482 (and skip-file (string-match skip-file fnd))
483 (not (file-exists-p (file-truename f)))
484 (not (string-match match fnd)))
485 (cl-pushnew f org-publish-temp-files)))))))
486
487(defun org-publish-get-base-files (project &optional exclude-regexp)
488 "Return a list of all files in PROJECT.
489If EXCLUDE-REGEXP is set, this will be used to filter out
490matching filenames."
491 (let* ((project-plist (cdr project))
492 (base-dir (file-name-as-directory
493 (plist-get project-plist :base-directory)))
494 (include-list (plist-get project-plist :include))
495 (recurse (plist-get project-plist :recursive))
496 (extension (or (plist-get project-plist :base-extension) "org"))
497 ;; sitemap-... variables are dynamically scoped for
498 ;; org-publish-compare-directory-files:
499 (org-publish-sitemap-requested
500 (plist-get project-plist :auto-sitemap))
501 (sitemap-filename
502 (or (plist-get project-plist :sitemap-filename) "sitemap.org"))
503 (org-publish-sitemap-sort-folders
504 (if (plist-member project-plist :sitemap-sort-folders)
505 (plist-get project-plist :sitemap-sort-folders)
506 org-publish-sitemap-sort-folders))
507 (org-publish-sitemap-sort-files
508 (cond ((plist-member project-plist :sitemap-sort-files)
509 (plist-get project-plist :sitemap-sort-files))
510 ;; For backward compatibility:
511 ((plist-member project-plist :sitemap-alphabetically)
512 (if (plist-get project-plist :sitemap-alphabetically)
513 'alphabetically nil))
514 (t org-publish-sitemap-sort-files)))
515 (org-publish-sitemap-ignore-case
516 (if (plist-member project-plist :sitemap-ignore-case)
517 (plist-get project-plist :sitemap-ignore-case)
518 org-publish-sitemap-sort-ignore-case))
519 (match (if (eq extension 'any) "^[^\\.]"
520 (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
521 ;; Make sure `org-publish-sitemap-sort-folders' has an accepted
522 ;; value.
523 (unless (memq org-publish-sitemap-sort-folders '(first last))
524 (setq org-publish-sitemap-sort-folders nil))
525
526 (setq org-publish-temp-files nil)
527 (when org-publish-sitemap-requested
528 (cl-pushnew (expand-file-name (concat base-dir sitemap-filename))
529 org-publish-temp-files))
530 (org-publish-get-base-files-1 base-dir recurse match
531 ;; FIXME distinguish exclude regexp
532 ;; for skip-file and skip-dir?
533 exclude-regexp exclude-regexp)
534 (dolist (f include-list org-publish-temp-files)
535 (cl-pushnew (expand-file-name (concat base-dir f))
536 org-publish-temp-files))))
537 468
538(defun org-publish-get-project-from-filename (filename &optional up) 469(defun org-publish-get-project-from-filename (filename &optional up)
539 "Return a project that FILENAME belongs to. 470 "Return a project that FILENAME belongs to.
540When UP is non-nil, return a meta-project (i.e., with a :components part) 471When UP is non-nil, return a meta-project (i.e., with a :components part)
541publishing FILENAME." 472publishing FILENAME."
542 (let* ((filename (expand-file-name filename)) 473 (let* ((filename (file-truename filename))
543 (project 474 (project
544 (cl-some 475 (cl-some
545 (lambda (p) 476 (lambda (p)
@@ -656,8 +587,7 @@ Return output file name."
656 587
657 588
658 589
659;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 590;;; Publishing files, sets of files
660;;; Publishing files, sets of files, and indices
661 591
662(defun org-publish-file (filename &optional project no-cache) 592(defun org-publish-file (filename &optional project no-cache)
663 "Publish file FILENAME from PROJECT. 593 "Publish file FILENAME from PROJECT.
@@ -672,7 +602,7 @@ files, when entire projects are published (see
672 (abbreviate-file-name filename)))) 602 (abbreviate-file-name filename))))
673 (project-plist (cdr project)) 603 (project-plist (cdr project))
674 (publishing-function 604 (publishing-function
675 (pcase (plist-get project-plist :publishing-function) 605 (pcase (org-publish-property :publishing-function project)
676 (`nil (user-error "No publishing function chosen")) 606 (`nil (user-error "No publishing function chosen"))
677 ((and f (pred listp)) f) 607 ((and f (pred listp)) f)
678 (f (list f)))) 608 (f (list f))))
@@ -711,185 +641,262 @@ files, when entire projects are published (see
711If `:auto-sitemap' is set, publish the sitemap too. If 641If `:auto-sitemap' is set, publish the sitemap too. If
712`:makeindex' is set, also produce a file \"theindex.org\"." 642`:makeindex' is set, also produce a file \"theindex.org\"."
713 (dolist (project (org-publish-expand-projects projects)) 643 (dolist (project (org-publish-expand-projects projects))
714 (let ((project-plist (cdr project))) 644 (let ((plist (cdr project)))
715 (let ((fun (plist-get project-plist :preparation-function))) 645 (let ((fun (org-publish-property :preparation-function project)))
716 (cond ((consp fun) (dolist (f fun) (funcall f project-plist))) 646 (cond
717 ((functionp fun) (funcall fun project-plist)))) 647 ((consp fun) (dolist (f fun) (funcall f plist)))
648 ((functionp fun) (funcall fun plist))))
718 ;; Each project uses its own cache file. 649 ;; Each project uses its own cache file.
719 (org-publish-initialize-cache (car project)) 650 (org-publish-initialize-cache (car project))
720 (when (plist-get project-plist :auto-sitemap) 651 (when (org-publish-property :auto-sitemap project)
721 (let ((sitemap-filename 652 (let ((sitemap-filename
722 (or (plist-get project-plist :sitemap-filename) 653 (or (org-publish-property :sitemap-filename project)
723 "sitemap.org")) 654 "sitemap.org")))
724 (sitemap-function 655 (org-publish-sitemap project sitemap-filename)))
725 (or (plist-get project-plist :sitemap-function)
726 #'org-publish-org-sitemap))
727 (org-publish-sitemap-date-format
728 (or (plist-get project-plist :sitemap-date-format)
729 org-publish-sitemap-date-format))
730 (org-publish-sitemap-file-entry-format
731 (or (plist-get project-plist :sitemap-file-entry-format)
732 org-publish-sitemap-file-entry-format)))
733 (funcall sitemap-function project sitemap-filename)))
734 ;; Publish all files from PROJECT except "theindex.org". Its 656 ;; Publish all files from PROJECT except "theindex.org". Its
735 ;; publishing will be deferred until "theindex.inc" is 657 ;; publishing will be deferred until "theindex.inc" is
736 ;; populated. 658 ;; populated.
737 (let ((theindex 659 (let ((theindex
738 (expand-file-name "theindex.org" 660 (expand-file-name "theindex.org"
739 (plist-get project-plist :base-directory))) 661 (org-publish-property :base-directory project))))
740 (exclude-regexp (plist-get project-plist :exclude))) 662 (dolist (file (org-publish-get-base-files project))
741 (dolist (file (org-publish-get-base-files project exclude-regexp))
742 (unless (file-equal-p file theindex) 663 (unless (file-equal-p file theindex)
743 (org-publish-file file project t))) 664 (org-publish-file file project t)))
744 ;; Populate "theindex.inc", if needed, and publish 665 ;; Populate "theindex.inc", if needed, and publish
745 ;; "theindex.org". 666 ;; "theindex.org".
746 (when (plist-get project-plist :makeindex) 667 (when (org-publish-property :makeindex project)
747 (org-publish-index-generate-theindex 668 (org-publish-index-generate-theindex
748 project (plist-get project-plist :base-directory)) 669 project (org-publish-property :base-directory project))
749 (org-publish-file theindex project t))) 670 (org-publish-file theindex project t)))
750 (let ((fun (plist-get project-plist :completion-function))) 671 (let ((fun (org-publish-property :completion-function project)))
751 (cond ((consp fun) (dolist (f fun) (funcall f project-plist))) 672 (cond
752 ((functionp fun) (funcall fun project-plist)))) 673 ((consp fun) (dolist (f fun) (funcall f plist)))
753 (org-publish-write-cache-file)))) 674 ((functionp fun) (funcall fun plist)))))
675 (org-publish-write-cache-file)))
754 676
755(defun org-publish-org-sitemap (project &optional sitemap-filename) 677
678;;; Site map generation
679
680(defun org-publish--sitemap-files-to-lisp (files project style format-entry)
681 "Represent FILES as a parsed plain list.
682FILES is the list of files in the site map. PROJECT is the
683current project. STYLE determines is either `list' or `tree'.
684FORMAT-ENTRY is a function called on each file which should
685return a string. Return value is a list as returned by
686`org-list-to-lisp'."
687 (let ((root (expand-file-name
688 (file-name-as-directory
689 (org-publish-property :base-directory project)))))
690 (pcase style
691 (`list
692 (cons 'unordered
693 (mapcar
694 (lambda (f)
695 (list (funcall format-entry
696 (file-relative-name f root)
697 style
698 project)))
699 files)))
700 (`tree
701 (letrec ((files-only (cl-remove-if #'directory-name-p files))
702 (directories (cl-remove-if-not #'directory-name-p files))
703 (subtree-to-list
704 (lambda (dir)
705 (cons 'unordered
706 (nconc
707 ;; Files in DIR.
708 (mapcar
709 (lambda (f)
710 (list (funcall format-entry
711 (file-relative-name f root)
712 style
713 project)))
714 (cl-remove-if-not
715 (lambda (f) (string= dir (file-name-directory f)))
716 files-only))
717 ;; Direct sub-directories.
718 (mapcar
719 (lambda (sub)
720 (list (funcall format-entry
721 (file-relative-name sub root)
722 style
723 project)
724 (funcall subtree-to-list sub)))
725 (cl-remove-if-not
726 (lambda (f)
727 (string=
728 dir
729 ;; Parent directory.
730 (file-name-directory (directory-file-name f))))
731 directories)))))))
732 (funcall subtree-to-list root)))
733 (_ (user-error "Unknown site-map style: `%s'" style)))))
734
735(defun org-publish-sitemap (project &optional sitemap-filename)
756 "Create a sitemap of pages in set defined by PROJECT. 736 "Create a sitemap of pages in set defined by PROJECT.
757Optionally set the filename of the sitemap with SITEMAP-FILENAME. 737Optionally set the filename of the sitemap with SITEMAP-FILENAME.
758Default for SITEMAP-FILENAME is `sitemap.org'." 738Default for SITEMAP-FILENAME is `sitemap.org'."
759 (let* ((project-plist (cdr project)) 739 (let* ((root (expand-file-name
760 (dir (file-name-as-directory 740 (file-name-as-directory
761 (plist-get project-plist :base-directory))) 741 (org-publish-property :base-directory project))))
762 (localdir (file-name-directory dir)) 742 (sitemap-filename (concat root (or sitemap-filename "sitemap.org")))
763 (indent-str (make-string 2 ?\s)) 743 (title (or (org-publish-property :sitemap-title project)
764 (exclude-regexp (plist-get project-plist :exclude)) 744 (concat "Sitemap for project " (car project))))
765 (files (nreverse 745 (style (or (org-publish-property :sitemap-style project)
766 (org-publish-get-base-files project exclude-regexp))) 746 'tree))
767 (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) 747 (sitemap-builder (or (org-publish-property :sitemap-function project)
768 (sitemap-title (or (plist-get project-plist :sitemap-title) 748 #'org-publish-sitemap-default))
769 (concat "Sitemap for project " (car project)))) 749 (format-entry (or (org-publish-property :sitemap-format-entry project)
770 (sitemap-style (or (plist-get project-plist :sitemap-style) 750 #'org-publish-sitemap-default-entry))
771 'tree)) 751 (sort-folders
772 (sitemap-sans-extension 752 (org-publish-property :sitemap-sort-folders project
773 (plist-get project-plist :sitemap-sans-extension)) 753 org-publish-sitemap-sort-folders))
774 (visiting (find-buffer-visiting sitemap-filename)) 754 (sort-files
775 file sitemap-buffer) 755 (org-publish-property :sitemap-sort-files project
776 (with-current-buffer 756 org-publish-sitemap-sort-files))
777 (let ((org-inhibit-startup t)) 757 (ignore-case
778 (setq sitemap-buffer 758 (org-publish-property :sitemap-ignore-case project
779 (or visiting (find-file sitemap-filename)))) 759 org-publish-sitemap-sort-ignore-case))
780 (erase-buffer) 760 (org-file-p (lambda (f) (equal "org" (file-name-extension f))))
781 (insert (concat "#+TITLE: " sitemap-title "\n\n")) 761 (sort-predicate
782 (while (setq file (pop files)) 762 (lambda (a b)
783 (let ((link (file-relative-name file dir)) 763 (let ((retval t))
784 (oldlocal localdir)) 764 ;; First we sort files:
785 (when sitemap-sans-extension 765 (pcase sort-files
786 (setq link (file-name-sans-extension link))) 766 (`alphabetically
787 ;; sitemap shouldn't list itself 767 (let ((A (if (funcall org-file-p a)
788 (unless (file-equal-p sitemap-filename file) 768 (concat (file-name-directory a)
789 (if (eq sitemap-style 'list) 769 (org-publish-find-title a project))
790 (message "Generating list-style sitemap for %s" sitemap-title) 770 a))
791 (message "Generating tree-style sitemap for %s" sitemap-title) 771 (B (if (funcall org-file-p b)
792 (setq localdir (concat (file-name-as-directory dir) 772 (concat (file-name-directory b)
793 (file-name-directory link))) 773 (org-publish-find-title b project))
794 (unless (string= localdir oldlocal) 774 b)))
795 (if (string= localdir dir) 775 (setq retval
796 (setq indent-str (make-string 2 ?\ )) 776 (if ignore-case
797 (let ((subdirs 777 (not (string-lessp (upcase B) (upcase A)))
798 (split-string 778 (not (string-lessp B A))))))
799 (directory-file-name 779 ((or `anti-chronologically `chronologically)
800 (file-name-directory 780 (let* ((adate (org-publish-find-date a project))
801 (file-relative-name localdir dir))) "/")) 781 (bdate (org-publish-find-date b project))
802 (subdir "") 782 (A (+ (lsh (car adate) 16) (cadr adate)))
803 (old-subdirs (split-string 783 (B (+ (lsh (car bdate) 16) (cadr bdate))))
804 (file-relative-name oldlocal dir) "/"))) 784 (setq retval
805 (setq indent-str (make-string 2 ?\ )) 785 (if (eq sort-files 'chronologically)
806 (while (string= (car old-subdirs) (car subdirs)) 786 (<= A B)
807 (setq indent-str (concat indent-str (make-string 2 ?\ ))) 787 (>= A B)))))
808 (pop old-subdirs) 788 (`nil nil)
809 (pop subdirs)) 789 (_ (user-error "Invalid sort value %s" sort-files)))
810 (dolist (d subdirs) 790 ;; Directory-wise wins:
811 (setq subdir (concat subdir d "/")) 791 (when (memq sort-folders '(first last))
812 (insert (concat indent-str " + " d "\n")) 792 ;; a is directory, b not:
813 (setq indent-str (make-string 793 (cond
814 (+ (length indent-str) 2) ?\ ))))))) 794 ((and (file-directory-p a) (not (file-directory-p b)))
815 ;; This is common to 'flat and 'tree 795 (setq retval (eq sort-folders 'first)))
816 (let ((entry 796 ;; a is not a directory, but b is:
817 (org-publish-format-file-entry 797 ((and (not (file-directory-p a)) (file-directory-p b))
818 org-publish-sitemap-file-entry-format file project-plist)) 798 (setq retval (eq sort-folders 'last)))))
819 (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) 799 retval))))
820 (cond ((string-match-p regexp entry) 800 (message "Generating sitemap for %s" title)
821 (string-match regexp entry) 801 (with-temp-file sitemap-filename
822 (insert (concat indent-str " + " (match-string 1 entry) 802 (insert
823 "[[file:" link "][" 803 (let ((files (remove sitemap-filename
824 (match-string 2 entry) 804 (org-publish-get-base-files project))))
825 "]]" (match-string 3 entry) "\n"))) 805 ;; Add directories, if applicable.
826 (t 806 (unless (and (eq style 'list) (eq sort-folders 'ignore))
827 (insert (concat indent-str " + [[file:" link "][" 807 (setq files
828 entry 808 (nconc (remove root (org-uniquify
829 "]]\n")))))))) 809 (mapcar #'file-name-directory files)))
830 (save-buffer)) 810 files)))
831 (or visiting (kill-buffer sitemap-buffer)))) 811 ;; Eventually sort all entries.
832 812 (when (or sort-files (not (memq sort-folders 'ignore)))
833(defun org-publish-format-file-entry (fmt file project-plist) 813 (setq files (sort files sort-predicate)))
834 (format-spec 814 (funcall sitemap-builder
835 fmt 815 title
836 `((?t . ,(org-publish-find-title file t)) 816 (org-publish--sitemap-files-to-lisp
837 (?d . ,(format-time-string org-publish-sitemap-date-format 817 files project style format-entry)))))))
838 (org-publish-find-date file))) 818
839 (?a . ,(or (plist-get project-plist :author) user-full-name))))) 819(defun org-publish-find-property (file property project &optional backend)
840 820 "Find the PROPERTY of FILE in project.
841(defun org-publish-find-title (file &optional reset) 821
842 "Find the title of FILE in project." 822PROPERTY is a keyword referring to an export option, as defined
843 (or 823in `org-export-options-alist' or in export back-ends. In the
844 (and (not reset) (org-publish-cache-get-file-property file :title nil t)) 824latter case, optional argument BACKEND has to be set to the
845 (let* ((org-inhibit-startup t) 825back-end where the option is defined, e.g.,
846 (visiting (find-buffer-visiting file)) 826
847 (buffer (or visiting (find-file-noselect file)))) 827 (org-publish-find-property file :subtitle 'latex)
848 (with-current-buffer buffer 828
849 (let ((title 829Return value may be a string or a list, depending on the type of
850 (let ((property 830PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'."
851 (plist-get 831 (let ((file (org-publish--expand-file-name file project)))
852 ;; protect local variables in open buffers 832 (when (and (file-readable-p file) (not (directory-name-p file)))
853 (if visiting 833 (let* ((org-inhibit-startup t)
854 (org-export-with-buffer-copy (org-export-get-environment)) 834 (visiting (find-buffer-visiting file))
855 (org-export-get-environment)) 835 (buffer (or visiting (find-file-noselect file))))
856 :title))) 836 (unwind-protect
857 (if property 837 (plist-get (with-current-buffer buffer
858 (org-no-properties (org-element-interpret-data property)) 838 (if (not visiting) (org-export-get-environment backend)
859 (file-name-nondirectory (file-name-sans-extension file)))))) 839 ;; Protect local variables in open buffers.
860 (unless visiting (kill-buffer buffer)) 840 (org-export-with-buffer-copy
861 (org-publish-cache-set-file-property file :title title) 841 (org-export-get-environment backend))))
862 title))))) 842 property)
863 843 (unless visiting (kill-buffer buffer)))))))
864(defun org-publish-find-date (file) 844
865 "Find the date of FILE in project. 845(defun org-publish-find-title (file project)
846 "Find the title of FILE in PROJECT."
847 (let ((file (org-publish--expand-file-name file project)))
848 (or (org-publish-cache-get-file-property file :title nil t)
849 (let* ((parsed-title (org-publish-find-property file :title project))
850 (title
851 (if parsed-title
852 ;; Remove property so that the return value is
853 ;; cache-able (i.e., it can be `read' back).
854 (org-no-properties
855 (org-element-interpret-data parsed-title))
856 (file-name-nondirectory (file-name-sans-extension file)))))
857 (org-publish-cache-set-file-property file :title title)
858 title))))
859
860(defun org-publish-find-date (file project)
861 "Find the date of FILE in PROJECT.
866This function assumes FILE is either a directory or an Org file. 862This function assumes FILE is either a directory or an Org file.
867If FILE is an Org file and provides a DATE keyword use it. In 863If FILE is an Org file and provides a DATE keyword use it. In
868any other case use the file system's modification time. Return 864any other case use the file system's modification time. Return
869time in `current-time' format." 865time in `current-time' format."
870 (if (file-directory-p file) (nth 5 (file-attributes file)) 866 (let ((file (org-publish--expand-file-name file project)))
871 (let* ((org-inhibit-startup t) 867 (if (file-directory-p file) (nth 5 (file-attributes file))
872 (visiting (find-buffer-visiting file)) 868 (let ((date (org-publish-find-property file :date project)))
873 (file-buf (or visiting (find-file-noselect file nil))) 869 ;; DATE is a secondary string. If it contains a time-stamp,
874 (date (plist-get 870 ;; convert it to internal format. Otherwise, use FILE
875 (with-current-buffer file-buf 871 ;; modification time.
876 (if visiting 872 (cond ((let ((ts (and (consp date) (assq 'timestamp date))))
877 (org-export-with-buffer-copy 873 (and ts
878 (org-export-get-environment)) 874 (let ((value (org-element-interpret-data ts)))
879 (org-export-get-environment))) 875 (and (org-string-nw-p value)
880 :date))) 876 (org-time-string-to-time value))))))
881 (unless visiting (kill-buffer file-buf)) 877 ((file-exists-p file) (nth 5 (file-attributes file)))
882 ;; DATE is a secondary string. If it contains a timestamp, 878 (t (error "No such file: \"%s\"" file)))))))
883 ;; convert it to internal format. Otherwise, use FILE 879
884 ;; modification time. 880(defun org-publish-sitemap-default-entry (entry style project)
885 (cond ((let ((ts (and (consp date) (assq 'timestamp date)))) 881 "Default format for site map ENTRY, as a string.
886 (and ts 882ENTRY is a file name. STYLE is the style of the sitemap.
887 (let ((value (org-element-interpret-data ts))) 883PROJECT is the current project."
888 (and (org-string-nw-p value) 884 (cond ((not (directory-name-p entry))
889 (org-time-string-to-time value)))))) 885 (format "[[file:%s][%s]]"
890 ((file-exists-p file) (nth 5 (file-attributes file))) 886 entry
891 (t (error "No such file: \"%s\"" file)))))) 887 (org-publish-find-title entry project)))
892 888 ((eq style 'tree)
889 ;; Return only last subdir.
890 (file-name-nondirectory (directory-file-name entry)))
891 (t entry)))
892
893(defun org-publish-sitemap-default (title list)
894 "Default site map, as a string.
895TITLE is the the title of the site map. LIST is an internal
896representation for the files to include, as returned by
897`org-list-to-lisp'. PROJECT is the current project."
898 (concat "#+TITLE: " title "\n\n"
899 (org-list-to-org list)))
893 900
894 901
895;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 902;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1033,8 +1040,7 @@ its CDR is a string."
1033 "Retrieve full index from cache and build \"theindex.org\". 1040 "Retrieve full index from cache and build \"theindex.org\".
1034PROJECT is the project the index relates to. DIRECTORY is the 1041PROJECT is the project the index relates to. DIRECTORY is the
1035publishing directory." 1042publishing directory."
1036 (let ((all-files (org-publish-get-base-files 1043 (let ((all-files (org-publish-get-base-files project))
1037 project (plist-get (cdr project) :exclude)))
1038 full-index) 1044 full-index)
1039 ;; Compile full index and sort it alphabetically. 1045 ;; Compile full index and sort it alphabetically.
1040 (dolist (file all-files 1046 (dolist (file all-files
diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el
index f70b7c4c824..b5903a52160 100644
--- a/lisp/org/ox-texinfo.el
+++ b/lisp/org/ox-texinfo.el
@@ -113,7 +113,7 @@
113 (:texinfo-link-with-unknown-path-format nil nil org-texinfo-link-with-unknown-path-format) 113 (:texinfo-link-with-unknown-path-format nil nil org-texinfo-link-with-unknown-path-format)
114 (:texinfo-tables-verbatim nil nil org-texinfo-tables-verbatim) 114 (:texinfo-tables-verbatim nil nil org-texinfo-tables-verbatim)
115 (:texinfo-table-scientific-notation nil nil org-texinfo-table-scientific-notation) 115 (:texinfo-table-scientific-notation nil nil org-texinfo-table-scientific-notation)
116 (:texinfo-def-table-markup nil nil org-texinfo-def-table-markup) 116 (:texinfo-table-default-markup nil nil org-texinfo-table-default-markup)
117 (:texinfo-text-markup-alist nil nil org-texinfo-text-markup-alist) 117 (:texinfo-text-markup-alist nil nil org-texinfo-text-markup-alist)
118 (:texinfo-format-drawer-function nil nil org-texinfo-format-drawer-function) 118 (:texinfo-format-drawer-function nil nil org-texinfo-format-drawer-function)
119 (:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function))) 119 (:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function)))
@@ -146,17 +146,19 @@ If nil it will default to `buffer-file-coding-system'."
146(defcustom org-texinfo-classes 146(defcustom org-texinfo-classes
147 '(("info" 147 '(("info"
148 "@documentencoding AUTO\n@documentlanguage AUTO" 148 "@documentencoding AUTO\n@documentlanguage AUTO"
149 ("@chapter %s" . "@unnumbered %s") 149 ("@chapter %s" "@unnumbered %s" "@appendix %s")
150 ("@section %s" . "@unnumberedsec %s") 150 ("@section %s" "@unnumberedsec %s" "@appendixsec %s")
151 ("@subsection %s" . "@unnumberedsubsec %s") 151 ("@subsection %s" "@unnumberedsubsec %s" "@appendixsubsec %s")
152 ("@subsubsection %s" . "@unnumberedsubsubsec %s"))) 152 ("@subsubsection %s" "@unnumberedsubsubsec %s" "@appendixsubsubsec %s")))
153 "Alist of Texinfo classes and associated header and structure. 153 "Alist of Texinfo classes and associated header and structure.
154If #+TEXINFO_CLASS is set in the buffer, use its value and the 154If #+TEXINFO_CLASS is set in the buffer, use its value and the
155associated information. Here is the structure of each cell: 155associated information. Here is the structure of a class
156definition:
156 157
157 (class-name 158 (class-name
158 header-string 159 header-string
159 (numbered-section . unnumbered-section) 160 (numbered-1 unnumbered-1 appendix-1)
161 (numbered-2 unnumbered-2 appendix-2)
160 ...) 162 ...)
161 163
162 164
@@ -188,25 +190,19 @@ The sectioning structure
188The sectioning structure of the class is given by the elements 190The sectioning structure of the class is given by the elements
189following the header string. For each sectioning level, a number 191following the header string. For each sectioning level, a number
190of strings is specified. A %s formatter is mandatory in each 192of strings is specified. A %s formatter is mandatory in each
191section string and will be replaced by the title of the section. 193section string and will be replaced by the title of the section."
192
193Instead of a list of sectioning commands, you can also specify
194a function name. That function will be called with two
195parameters, the reduced) level of the headline, and a predicate
196non-nil when the headline should be numbered. It must return
197a format string in which the section title will be added."
198 :group 'org-export-texinfo 194 :group 'org-export-texinfo
199 :version "24.4" 195 :version "26.1"
200 :package-version '(Org . "8.2") 196 :package-version '(Org . "9.1")
201 :type '(repeat 197 :type '(repeat
202 (list (string :tag "Texinfo class") 198 (list (string :tag "Texinfo class")
203 (string :tag "Texinfo header") 199 (string :tag "Texinfo header")
204 (repeat :tag "Levels" :inline t 200 (repeat :tag "Levels" :inline t
205 (choice 201 (choice
206 (cons :tag "Heading" 202 (list :tag "Heading"
207 (string :tag " numbered") 203 (string :tag " numbered")
208 (string :tag "unnumbered")) 204 (string :tag "unnumbered")
209 (function :tag "Hook computing sectioning")))))) 205 (string :tag " appendix")))))))
210 206
211;;;; Headline 207;;;; Headline
212 208
@@ -279,37 +275,42 @@ When nil, no transformation is made."
279 (string :tag "Format string") 275 (string :tag "Format string")
280 (const :tag "No formatting" nil))) 276 (const :tag "No formatting" nil)))
281 277
282(defcustom org-texinfo-def-table-markup "@samp" 278(defcustom org-texinfo-table-default-markup "@asis"
283 "Default markup for first column in two-column tables. 279 "Default markup for first column in two-column tables.
284 280
285This should an indicating command, e.g., \"@code\", \"@kbd\" or 281This should an indicating command, e.g., \"@code\", \"@kbd\" or
286\"@asis\". 282\"@samp\".
287 283
288It can be overridden locally using the \":indic\" attribute." 284It can be overridden locally using the \":indic\" attribute."
289 :group 'org-export-texinfo 285 :group 'org-export-texinfo
290 :type 'string) 286 :type 'string
287 :version "26.1"
288 :package-version '(Org . "9.1")
289 :safe #'stringp)
291 290
292;;;; Text markup 291;;;; Text markup
293 292
294(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}") 293(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}")
295 (code . code) 294 (code . code)
296 (italic . "@emph{%s}") 295 (italic . "@emph{%s}")
297 (verbatim . verb)) 296 (verbatim . samp))
298 "Alist of Texinfo expressions to convert text markup. 297 "Alist of Texinfo expressions to convert text markup.
299 298
300The key must be a symbol among `bold', `code', `italic', 299The key must be a symbol among `bold', `code', `italic',
301`strike-through', `underscore' and `verbatim'. The value is 300`strike-through', `underscore' and `verbatim'. The value is
302a formatting string to wrap fontified text with. 301a formatting string to wrap fontified text with.
303 302
304Value can also be set to the following symbols: `verb' and 303Value can also be set to the following symbols: `verb', `samp'
305`code'. For the former, Org will use \"@verb\" to create 304and `code'. With the first one, Org uses \"@verb\" to create
306a format string and select a delimiter character that isn't in 305a format string and selects a delimiter character that isn't in
307the string. For the latter, Org will use \"@code\" to typeset 306the string. For the other two, Org uses \"@samp\" or \"@code\"
308and try to protect special characters. 307to typeset and protects special characters.
309 308
310If no association can be found for a given markup, text will be 309When no association is found for a given markup, text is returned
311returned as-is." 310as-is."
312 :group 'org-export-texinfo 311 :group 'org-export-texinfo
312 :version "26.1"
313 :package-version '(Org . "9.1")
313 :type 'alist 314 :type 'alist
314 :options '(bold code italic strike-through underscore verbatim)) 315 :options '(bold code italic strike-through underscore verbatim))
315 316
@@ -350,7 +351,7 @@ The function should return the string to be exported."
350 351
351;;;; Compilation 352;;;; Compilation
352 353
353(defcustom org-texinfo-info-process '("makeinfo %f") 354(defcustom org-texinfo-info-process '("makeinfo --no-split %f")
354 "Commands to process a Texinfo file to an INFO file. 355 "Commands to process a Texinfo file to an INFO file.
355 356
356This is a list of strings, each of them will be given to the 357This is a list of strings, each of them will be given to the
@@ -360,6 +361,8 @@ base name (i.e. without directory and extension parts), %o by the
360base directory of the file and %O by the absolute file name of 361base directory of the file and %O by the absolute file name of
361the output file." 362the output file."
362 :group 'org-export-texinfo 363 :group 'org-export-texinfo
364 :version "26.1"
365 :package-version '(Org . "9.1")
363 :type '(repeat :tag "Shell command sequence" 366 :type '(repeat :tag "Shell command sequence"
364 (string :tag "Shell command"))) 367 (string :tag "Shell command")))
365 368
@@ -444,13 +447,12 @@ This is used to choose a separator for constructs like \\verb."
444INFO is a plist used as a communication channel. See 447INFO is a plist used as a communication channel. See
445`org-texinfo-text-markup-alist' for details." 448`org-texinfo-text-markup-alist' for details."
446 (pcase (cdr (assq markup org-texinfo-text-markup-alist)) 449 (pcase (cdr (assq markup org-texinfo-text-markup-alist))
447 ;; No format string: Return raw text. 450 (`nil text) ;no markup: return raw text
448 (`nil text) 451 (`code (format "@code{%s}" (org-texinfo--sanitize-content text)))
452 (`samp (format "@samp{%s}" (org-texinfo--sanitize-content text)))
449 (`verb 453 (`verb
450 (let ((separator (org-texinfo--find-verb-separator text))) 454 (let ((separator (org-texinfo--find-verb-separator text)))
451 (concat "@verb{" separator text separator "}"))) 455 (format "@verb{%s%s%s}" separator text separator)))
452 (`code
453 (format "@code{%s}" (replace-regexp-in-string "[@{}]" "@\\&" text)))
454 ;; Else use format string. 456 ;; Else use format string.
455 (fmt (format fmt text)))) 457 (fmt (format fmt text))))
456 458
@@ -786,8 +788,9 @@ holding contextual information."
786 "Transcode an EXAMPLE-BLOCK element from Org to Texinfo. 788 "Transcode an EXAMPLE-BLOCK element from Org to Texinfo.
787CONTENTS is nil. INFO is a plist holding contextual 789CONTENTS is nil. INFO is a plist holding contextual
788information." 790information."
789 (format "@verbatim\n%s@end verbatim" 791 (format "@example\n%s@end example"
790 (org-export-format-code-default example-block info))) 792 (org-texinfo--sanitize-content
793 (org-export-format-code-default example-block info))))
791 794
792;;; Export Block 795;;; Export Block
793 796
@@ -828,82 +831,75 @@ plist holding contextual information."
828 831
829;;;; Headline 832;;;; Headline
830 833
834(defun org-texinfo--structuring-command (headline info)
835 "Return Texinfo structuring command string for HEADLINE element.
836Return nil if HEADLINE is to be ignored, `plain-list' if it
837should be exported as a plain-list item. INFO is a plist holding
838contextual information."
839 (cond
840 ((org-element-property :footnote-section-p headline) nil)
841 ((org-not-nil (org-export-get-node-property :COPYING headline t)) nil)
842 ((org-export-low-level-p headline info) 'plain-list)
843 (t
844 (let ((class (plist-get info :texinfo-class)))
845 (pcase (assoc class (plist-get info :texinfo-classes))
846 (`(,_ ,_ . ,sections)
847 (pcase (nth (1- (org-export-get-relative-level headline info))
848 sections)
849 (`(,numbered ,unnumbered ,appendix)
850 (cond
851 ((org-not-nil (org-export-get-node-property :APPENDIX headline t))
852 appendix)
853 ((org-not-nil (org-export-get-node-property :INDEX headline t))
854 unnumbered)
855 ((org-export-numbered-headline-p headline info) numbered)
856 (t unnumbered)))
857 (`nil 'plain-list)
858 (_ (user-error "Invalid Texinfo class specification: %S" class))))
859 (_ (user-error "Invalid Texinfo class specification: %S" class)))))))
860
831(defun org-texinfo-headline (headline contents info) 861(defun org-texinfo-headline (headline contents info)
832 "Transcode a HEADLINE element from Org to Texinfo. 862 "Transcode a HEADLINE element from Org to Texinfo.
833CONTENTS holds the contents of the headline. INFO is a plist 863CONTENTS holds the contents of the headline. INFO is a plist
834holding contextual information." 864holding contextual information."
835 (let* ((class (plist-get info :texinfo-class)) 865 (let ((section-fmt (org-texinfo--structuring-command headline info)))
836 (level (org-export-get-relative-level headline info)) 866 (when section-fmt
837 (numberedp (org-export-numbered-headline-p headline info)) 867 (let* ((todo
838 (class-sectioning (assoc class (plist-get info :texinfo-classes))) 868 (and (plist-get info :with-todo-keywords)
839 ;; Find the index type, if any. 869 (let ((todo (org-element-property :todo-keyword headline)))
840 (index (org-element-property :INDEX headline)) 870 (and todo (org-export-data todo info)))))
841 ;; Create node info, to insert it before section formatting. 871 (todo-type (and todo (org-element-property :todo-type headline)))
842 ;; Use custom menu title if present. 872 (tags (and (plist-get info :with-tags)
843 (node (format "@node %s\n" (org-texinfo--get-node headline info))) 873 (org-export-get-tags headline info)))
844 ;; Section formatting will set two placeholders: one for the 874 (priority (and (plist-get info :with-priority)
845 ;; title and the other for the contents. 875 (org-element-property :priority headline)))
846 (section-fmt 876 (text (org-texinfo--sanitize-title
847 (if (org-not-nil (org-element-property :APPENDIX headline)) 877 (org-element-property :title headline) info))
848 "@appendix %s\n%s" 878 (full-text
849 (let ((sec (if (and (symbolp (nth 2 class-sectioning)) 879 (funcall (plist-get info :texinfo-format-headline-function)
850 (fboundp (nth 2 class-sectioning))) 880 todo todo-type priority text tags))
851 (funcall (nth 2 class-sectioning) level numberedp) 881 (contents
852 (nth (1+ level) class-sectioning)))) 882 (concat "\n"
853 (cond 883 (if (org-string-nw-p contents)
854 ;; No section available for that LEVEL. 884 (concat "\n" contents)
855 ((not sec) nil) 885 "")
856 ;; Section format directly returned by a function. 886 (let ((index (org-element-property :INDEX headline)))
857 ((stringp sec) sec) 887 (and (member index '("cp" "fn" "ky" "pg" "tp" "vr"))
858 ;; (numbered-section . unnumbered-section) 888 (format "\n@printindex %s\n" index))))))
859 ((not (consp (cdr sec))) 889 (cond
860 (concat (if (or index (not numberedp)) (cdr sec) (car sec)) 890 ((eq section-fmt 'plain-list)
861 "\n%s")))))) 891 (let ((numbered? (org-export-numbered-headline-p headline info)))
862 (todo 892 (concat (and (org-export-first-sibling-p headline info)
863 (and (plist-get info :with-todo-keywords) 893 (format "@%s\n" (if numbered? 'enumerate 'itemize)))
864 (let ((todo (org-element-property :todo-keyword headline))) 894 "@item\n" full-text "\n"
865 (and todo (org-export-data todo info))))) 895 contents
866 (todo-type (and todo (org-element-property :todo-type headline))) 896 (if (org-export-last-sibling-p headline info)
867 (tags (and (plist-get info :with-tags) 897 (format "@end %s" (if numbered? 'enumerate 'itemize))
868 (org-export-get-tags headline info))) 898 "\n"))))
869 (priority (and (plist-get info :with-priority) 899 (t
870 (org-element-property :priority headline))) 900 (concat (format "@node %s\n" (org-texinfo--get-node headline info))
871 (text (org-texinfo--sanitize-title 901 (format section-fmt full-text)
872 (org-element-property :title headline) info)) 902 contents)))))))
873 (full-text (funcall (plist-get info :texinfo-format-headline-function)
874 todo todo-type priority text tags))
875 (contents (if (org-string-nw-p contents) (concat "\n" contents) "")))
876 (cond
877 ;; Case 1: This is a footnote section: ignore it.
878 ((org-element-property :footnote-section-p headline) nil)
879 ;; Case 2: This is the `copying' section: ignore it
880 ;; This is used elsewhere.
881 ((org-not-nil (org-element-property :COPYING headline)) nil)
882 ;; Case 3: An index. If it matches one of the known indexes,
883 ;; print it as such following the contents, otherwise
884 ;; print the contents and leave the index up to the user.
885 (index
886 (concat node
887 (format
888 section-fmt
889 full-text
890 (concat contents
891 (and (member index '("cp" "fn" "ky" "pg" "tp" "vr"))
892 (concat "\n@printindex " index))))))
893 ;; Case 4: This is a deep sub-tree: export it as a list item.
894 ;; Also export as items headlines for which no section
895 ;; format has been found.
896 ((or (not section-fmt) (org-export-low-level-p headline info))
897 ;; Build the real contents of the sub-tree.
898 (concat (and (org-export-first-sibling-p headline info)
899 (format "@%s\n" (if numberedp 'enumerate 'itemize)))
900 "@item\n" full-text "\n"
901 contents
902 (if (org-export-last-sibling-p headline info)
903 (format "@end %s" (if numberedp 'enumerate 'itemize))
904 "\n")))
905 ;; Case 5: Standard headline. Export it as a section.
906 (t (concat node (format section-fmt full-text contents))))))
907 903
908(defun org-texinfo-format-headline-default-function 904(defun org-texinfo-format-headline-default-function
909 (todo _todo-type priority text tags) 905 (todo _todo-type priority text tags)
@@ -920,9 +916,9 @@ See `org-texinfo-format-headline-function' for details."
920 "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo. 916 "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo.
921CONTENTS holds the contents of the item. INFO is a plist holding 917CONTENTS holds the contents of the item. INFO is a plist holding
922contextual information." 918contextual information."
923 (let* ((code (org-element-property :value inline-src-block)) 919 (format "@code{%s}"
924 (separator (org-texinfo--find-verb-separator code))) 920 (org-texinfo--sanitize-content
925 (concat "@verb{" separator code separator "}"))) 921 (org-element-property :value inline-src-block))))
926 922
927;;;; Inlinetask 923;;;; Inlinetask
928 924
@@ -967,10 +963,26 @@ contextual information."
967 "Transcode an ITEM element from Org to Texinfo. 963 "Transcode an ITEM element from Org to Texinfo.
968CONTENTS holds the contents of the item. INFO is a plist holding 964CONTENTS holds the contents of the item. INFO is a plist holding
969contextual information." 965contextual information."
970 (format "@item%s\n%s" 966 (let* ((tag (org-element-property :tag item))
971 (let ((tag (org-element-property :tag item))) 967 (split (org-string-nw-p
972 (if tag (concat " " (org-export-data tag info)) "")) 968 (org-export-read-attribute :attr_texinfo
973 (or contents ""))) 969 (org-element-property :parent item)
970 :sep)))
971 (items (and tag
972 (let ((tag (org-export-data tag info)))
973 (if split
974 (split-string tag (regexp-quote split) t "[ \t\n]+")
975 (list tag))))))
976 (format "%s\n%s"
977 (pcase items
978 (`nil "@item")
979 (`(,item) (concat "@item " item))
980 (`(,item . ,items)
981 (concat "@item " item "\n"
982 (mapconcat (lambda (i) (concat "@itemx " i))
983 items
984 "\n"))))
985 (or contents ""))))
974 986
975;;;; Keyword 987;;;; Keyword
976 988
@@ -1073,14 +1085,8 @@ INFO is a plist holding contextual information. See
1073 (pcase (org-export-get-ordinal destination info) 1085 (pcase (org-export-get-ordinal destination info)
1074 ((and (pred integerp) n) (number-to-string n)) 1086 ((and (pred integerp) n) (number-to-string n))
1075 ((and (pred consp) n) (mapconcat #'number-to-string n ".")) 1087 ((and (pred consp) n) (mapconcat #'number-to-string n "."))
1076 (_ "???"))) 1088 (_ "???"))) ;cannot guess the description
1077 info))))) ;cannot guess the description 1089 info)))))
1078 ((equal type "info")
1079 (let* ((info-path (split-string path "[:#]"))
1080 (info-manual (car info-path))
1081 (info-node (or (cadr info-path) "Top"))
1082 (title (or desc "")))
1083 (format "@ref{%s,%s,,%s,}" info-node title info-manual)))
1084 ((string= type "mailto") 1090 ((string= type "mailto")
1085 (format "@email{%s}" 1091 (format "@email{%s}"
1086 (concat (org-texinfo--sanitize-content path) 1092 (concat (org-texinfo--sanitize-content path)
@@ -1210,13 +1216,10 @@ holding contextual information."
1210 (cached-entries (gethash scope cache 'no-cache))) 1216 (cached-entries (gethash scope cache 'no-cache)))
1211 (if (not (eq cached-entries 'no-cache)) cached-entries 1217 (if (not (eq cached-entries 'no-cache)) cached-entries
1212 (puthash scope 1218 (puthash scope
1213 (org-element-map (org-element-contents scope) 'headline 1219 (cl-remove-if
1214 (lambda (h) 1220 (lambda (h)
1215 (and (not (org-not-nil (org-element-property :COPYING h))) 1221 (org-not-nil (org-export-get-node-property :COPYING h t)))
1216 (not (org-element-property :footnote-section-p h)) 1222 (org-export-collect-headlines info 1 scope))
1217 (not (org-export-low-level-p h info))
1218 h))
1219 info nil 'headline)
1220 cache)))) 1223 cache))))
1221 1224
1222;;;; Node Property 1225;;;; Node Property
@@ -1246,7 +1249,7 @@ CONTENTS is the contents of the list. INFO is a plist holding
1246contextual information." 1249contextual information."
1247 (let* ((attr (org-export-read-attribute :attr_texinfo plain-list)) 1250 (let* ((attr (org-export-read-attribute :attr_texinfo plain-list))
1248 (indic (let ((i (or (plist-get attr :indic) 1251 (indic (let ((i (or (plist-get attr :indic)
1249 (plist-get info :texinfo-def-table-markup)))) 1252 (plist-get info :texinfo-table-default-markup))))
1250 ;; Allow indicating commands with missing @ sign. 1253 ;; Allow indicating commands with missing @ sign.
1251 (if (string-prefix-p "@" i) i (concat "@" i)))) 1254 (if (string-prefix-p "@" i) i (concat "@" i))))
1252 (table-type (plist-get attr :table-type)) 1255 (table-type (plist-get attr :table-type))
@@ -1570,6 +1573,7 @@ contextual information."
1570 1573
1571;;; Interactive functions 1574;;; Interactive functions
1572 1575
1576;;;###autoload
1573(defun org-texinfo-export-to-texinfo 1577(defun org-texinfo-export-to-texinfo
1574 (&optional async subtreep visible-only body-only ext-plist) 1578 (&optional async subtreep visible-only body-only ext-plist)
1575 "Export current buffer to a Texinfo file. 1579 "Export current buffer to a Texinfo file.
@@ -1604,6 +1608,7 @@ Return output file's name."
1604 (org-export-to-file 'texinfo outfile 1608 (org-export-to-file 'texinfo outfile
1605 async subtreep visible-only body-only ext-plist))) 1609 async subtreep visible-only body-only ext-plist)))
1606 1610
1611;;;###autoload
1607(defun org-texinfo-export-to-info 1612(defun org-texinfo-export-to-info
1608 (&optional async subtreep visible-only body-only ext-plist) 1613 (&optional async subtreep visible-only body-only ext-plist)
1609 "Export current buffer to Texinfo then process through to INFO. 1614 "Export current buffer to Texinfo then process through to INFO.
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 4e85066eec0..1c43577cddf 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -437,11 +437,7 @@ e.g. \"d:nil\"."
437 (repeat :tag "Specify names of drawers to ignore during export" 437 (repeat :tag "Specify names of drawers to ignore during export"
438 :inline t 438 :inline t
439 (string :tag "Drawer name")))) 439 (string :tag "Drawer name"))))
440 :safe (lambda (x) (or (booleanp x) 440 :safe (lambda (x) (or (booleanp x) (consp x))))
441 (and (listp x)
442 (or (cl-every #'stringp x)
443 (and (eq (nth 0 x) 'not)
444 (cl-every #'stringp (cdr x))))))))
445 441
446(defcustom org-export-with-email nil 442(defcustom org-export-with-email nil
447 "Non-nil means insert author email into the exported file. 443 "Non-nil means insert author email into the exported file.
@@ -598,7 +594,7 @@ properties to export, as strings.
598This option can also be set with the OPTIONS keyword, 594This option can also be set with the OPTIONS keyword,
599e.g. \"prop:t\"." 595e.g. \"prop:t\"."
600 :group 'org-export-general 596 :group 'org-export-general
601 :version "24.4" 597 :version "26.1"
602 :package-version '(Org . "8.3") 598 :package-version '(Org . "8.3")
603 :type '(choice 599 :type '(choice
604 (const :tag "All properties" t) 600 (const :tag "All properties" t)
@@ -883,6 +879,29 @@ HTML code while every other back-end will ignore it."
883 (cl-every #'stringp (mapcar #'car x)) 879 (cl-every #'stringp (mapcar #'car x))
884 (cl-every #'stringp (mapcar #'cdr x))))) 880 (cl-every #'stringp (mapcar #'cdr x)))))
885 881
882(defcustom org-export-global-macros nil
883 "Alist between macro names and expansion templates.
884
885This variable defines macro expansion templates available
886globally. Associations follow the pattern
887
888 (NAME . TEMPLATE)
889
890where NAME is a string beginning with a letter and consisting of
891alphanumeric characters only.
892
893TEMPLATE is the string to which the macro is going to be
894expanded. Inside, \"$1\", \"$2\"... are place-holders for
895macro's arguments. Moreover, if the template starts with
896\"(eval\", it will be parsed as an Elisp expression and evaluated
897accordingly."
898 :group 'org-export-general
899 :version "26.1"
900 :package-version '(Org . "9.1")
901 :type '(repeat
902 (cons (string :tag "Name")
903 (string :tag "Template"))))
904
886(defcustom org-export-coding-system nil 905(defcustom org-export-coding-system nil
887 "Coding system for the exported file." 906 "Coding system for the exported file."
888 :group 'org-export-general 907 :group 'org-export-general
@@ -1433,7 +1452,7 @@ for export. Return options as a plist."
1433 (parse 1452 (parse
1434 (org-element-parse-secondary-string 1453 (org-element-parse-secondary-string
1435 value (org-element-restriction 'keyword))) 1454 value (org-element-restriction 'keyword)))
1436 (split (org-split-string value)) 1455 (split (split-string value))
1437 (t value)))))))))))) 1456 (t value))))))))))))
1438 1457
1439(defun org-export--get-inbuffer-options (&optional backend) 1458(defun org-export--get-inbuffer-options (&optional backend)
@@ -1476,17 +1495,20 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
1476 (cond 1495 (cond
1477 ;; Options in `org-export-special-keywords'. 1496 ;; Options in `org-export-special-keywords'.
1478 ((equal key "SETUPFILE") 1497 ((equal key "SETUPFILE")
1479 (let ((file 1498 (let* ((uri (org-unbracket-string "\"" "\"" (org-trim val)))
1480 (expand-file-name 1499 (uri-is-url (org-file-url-p uri))
1481 (org-unbracket-string "\"" "\"" (org-trim val))))) 1500 (uri (if uri-is-url
1501 uri
1502 (expand-file-name uri))))
1482 ;; Avoid circular dependencies. 1503 ;; Avoid circular dependencies.
1483 (unless (member file files) 1504 (unless (member uri files)
1484 (with-temp-buffer 1505 (with-temp-buffer
1485 (setq default-directory 1506 (unless uri-is-url
1486 (file-name-directory file)) 1507 (setq default-directory
1487 (insert (org-file-contents file 'noerror)) 1508 (file-name-directory uri)))
1509 (insert (org-file-contents uri 'noerror))
1488 (let ((org-inhibit-startup t)) (org-mode)) 1510 (let ((org-inhibit-startup t)) (org-mode))
1489 (funcall get-options (cons file files)))))) 1511 (funcall get-options (cons uri files))))))
1490 ((equal key "OPTIONS") 1512 ((equal key "OPTIONS")
1491 (setq plist 1513 (setq plist
1492 (org-combine-plists 1514 (org-combine-plists
@@ -1538,7 +1560,7 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
1538 "\n" 1560 "\n"
1539 (org-trim val)))) 1561 (org-trim val))))
1540 (split `(,@(plist-get plist property) 1562 (split `(,@(plist-get plist property)
1541 ,@(org-split-string val))) 1563 ,@(split-string val)))
1542 ((t) val) 1564 ((t) val)
1543 (otherwise 1565 (otherwise
1544 (if (not (plist-member plist property)) val 1566 (if (not (plist-member plist property)) val
@@ -1624,17 +1646,22 @@ an alist where associations are (VARIABLE-NAME VALUE)."
1624 "BIND") 1646 "BIND")
1625 (push (read (format "(%s)" val)) alist) 1647 (push (read (format "(%s)" val)) alist)
1626 ;; Enter setup file. 1648 ;; Enter setup file.
1627 (let ((file (expand-file-name 1649 (let* ((uri (org-unbracket-string "\"" "\"" val))
1628 (org-unbracket-string "\"" "\"" val)))) 1650 (uri-is-url (org-file-url-p uri))
1629 (unless (member file files) 1651 (uri (if uri-is-url
1652 uri
1653 (expand-file-name uri))))
1654 ;; Avoid circular dependencies.
1655 (unless (member uri files)
1630 (with-temp-buffer 1656 (with-temp-buffer
1631 (setq default-directory 1657 (unless uri-is-url
1632 (file-name-directory file)) 1658 (setq default-directory
1659 (file-name-directory uri)))
1633 (let ((org-inhibit-startup t)) (org-mode)) 1660 (let ((org-inhibit-startup t)) (org-mode))
1634 (insert (org-file-contents file 'noerror)) 1661 (insert (org-file-contents uri 'noerror))
1635 (setq alist 1662 (setq alist
1636 (funcall collect-bind 1663 (funcall collect-bind
1637 (cons file files) 1664 (cons uri files)
1638 alist)))))))))) 1665 alist))))))))))
1639 alist))))) 1666 alist)))))
1640 ;; Return value in appropriate order of appearance. 1667 ;; Return value in appropriate order of appearance.
@@ -3010,13 +3037,15 @@ Return code as a string."
3010 (org-export-expand-include-keyword) 3037 (org-export-expand-include-keyword)
3011 (org-export--delete-comment-trees) 3038 (org-export--delete-comment-trees)
3012 (org-macro-initialize-templates) 3039 (org-macro-initialize-templates)
3013 (org-macro-replace-all org-macro-templates nil parsed-keywords) 3040 (org-macro-replace-all
3041 (append org-macro-templates org-export-global-macros)
3042 nil parsed-keywords)
3014 ;; Refresh buffer properties and radio targets after 3043 ;; Refresh buffer properties and radio targets after
3015 ;; potentially invasive previous changes. Likewise, do it 3044 ;; potentially invasive previous changes. Likewise, do it
3016 ;; again after executing Babel code. 3045 ;; again after executing Babel code.
3017 (org-set-regexps-and-options) 3046 (org-set-regexps-and-options)
3018 (org-update-radio-target-regexp) 3047 (org-update-radio-target-regexp)
3019 (when org-export-babel-evaluate 3048 (when org-export-use-babel
3020 (org-babel-exp-process-buffer) 3049 (org-babel-exp-process-buffer)
3021 (org-set-regexps-and-options) 3050 (org-set-regexps-and-options)
3022 (org-update-radio-target-regexp)) 3051 (org-update-radio-target-regexp))
@@ -3254,116 +3283,119 @@ storing and resolving footnotes. It is created automatically."
3254 ;; Expand INCLUDE keywords. 3283 ;; Expand INCLUDE keywords.
3255 (goto-char (point-min)) 3284 (goto-char (point-min))
3256 (while (re-search-forward include-re nil t) 3285 (while (re-search-forward include-re nil t)
3257 (let ((element (save-match-data (org-element-at-point)))) 3286 (unless (org-in-commented-heading-p)
3258 (when (eq (org-element-type element) 'keyword) 3287 (let ((element (save-match-data (org-element-at-point))))
3259 (beginning-of-line) 3288 (when (eq (org-element-type element) 'keyword)
3260 ;; Extract arguments from keyword's value. 3289 (beginning-of-line)
3261 (let* ((value (org-element-property :value element)) 3290 ;; Extract arguments from keyword's value.
3262 (ind (org-get-indentation)) 3291 (let* ((value (org-element-property :value element))
3263 location 3292 (ind (org-get-indentation))
3264 (file 3293 location
3265 (and (string-match 3294 (file
3266 "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value) 3295 (and (string-match
3267 (prog1 3296 "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
3268 (save-match-data 3297 (prog1
3269 (let ((matched (match-string 1 value))) 3298 (save-match-data
3270 (when (string-match "\\(::\\(.*?\\)\\)\"?\\'" 3299 (let ((matched (match-string 1 value)))
3271 matched) 3300 (when (string-match "\\(::\\(.*?\\)\\)\"?\\'"
3272 (setq location (match-string 2 matched)) 3301 matched)
3273 (setq matched 3302 (setq location (match-string 2 matched))
3274 (replace-match "" nil nil matched 1))) 3303 (setq matched
3275 (expand-file-name 3304 (replace-match "" nil nil matched 1)))
3276 (org-unbracket-string "\"" "\"" matched) 3305 (expand-file-name
3277 dir))) 3306 (org-unbracket-string "\"" "\"" matched)
3278 (setq value (replace-match "" nil nil value))))) 3307 dir)))
3279 (only-contents 3308 (setq value (replace-match "" nil nil value)))))
3280 (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?" 3309 (only-contents
3281 value) 3310 (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?"
3282 (prog1 (org-not-nil (match-string 1 value)) 3311 value)
3283 (setq value (replace-match "" nil nil value))))) 3312 (prog1 (org-not-nil (match-string 1 value))
3284 (lines 3313 (setq value (replace-match "" nil nil value)))))
3285 (and (string-match 3314 (lines
3286 ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" 3315 (and (string-match
3287 value) 3316 ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\""
3288 (prog1 (match-string 1 value) 3317 value)
3289 (setq value (replace-match "" nil nil value))))) 3318 (prog1 (match-string 1 value)
3290 (env (cond 3319 (setq value (replace-match "" nil nil value)))))
3291 ((string-match "\\<example\\>" value) 'literal) 3320 (env (cond
3292 ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value) 3321 ((string-match "\\<example\\>" value) 'literal)
3293 'literal) 3322 ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value)
3294 ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value) 3323 'literal)
3295 'literal))) 3324 ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
3296 ;; Minimal level of included file defaults to the child 3325 'literal)))
3297 ;; level of the current headline, if any, or one. It 3326 ;; Minimal level of included file defaults to the
3298 ;; only applies is the file is meant to be included as 3327 ;; child level of the current headline, if any, or
3299 ;; an Org one. 3328 ;; one. It only applies is the file is meant to be
3300 (minlevel 3329 ;; included as an Org one.
3301 (and (not env) 3330 (minlevel
3302 (if (string-match ":minlevel +\\([0-9]+\\)" value) 3331 (and (not env)
3303 (prog1 (string-to-number (match-string 1 value)) 3332 (if (string-match ":minlevel +\\([0-9]+\\)" value)
3304 (setq value (replace-match "" nil nil value))) 3333 (prog1 (string-to-number (match-string 1 value))
3305 (get-text-property (point) 3334 (setq value (replace-match "" nil nil value)))
3306 :org-include-induced-level)))) 3335 (get-text-property (point)
3307 (args (and (eq env 'literal) (match-string 1 value))) 3336 :org-include-induced-level))))
3308 (block (and (string-match "\\<\\(\\S-+\\)\\>" value) 3337 (args (and (eq env 'literal) (match-string 1 value)))
3309 (match-string 1 value)))) 3338 (block (and (string-match "\\<\\(\\S-+\\)\\>" value)
3310 ;; Remove keyword. 3339 (match-string 1 value))))
3311 (delete-region (point) (line-beginning-position 2)) 3340 ;; Remove keyword.
3312 (cond 3341 (delete-region (point) (line-beginning-position 2))
3313 ((not file) nil)
3314 ((not (file-readable-p file))
3315 (error "Cannot include file %s" file))
3316 ;; Check if files has already been parsed. Look after
3317 ;; inclusion lines too, as different parts of the same file
3318 ;; can be included too.
3319 ((member (list file lines) included)
3320 (error "Recursive file inclusion: %s" file))
3321 (t
3322 (cond 3342 (cond
3323 ((eq env 'literal) 3343 ((not file) nil)
3324 (insert 3344 ((not (file-readable-p file))
3325 (let ((ind-str (make-string ind ?\s)) 3345 (error "Cannot include file %s" file))
3326 (arg-str (if (stringp args) (format " %s" args) "")) 3346 ;; Check if files has already been parsed. Look after
3327 (contents 3347 ;; inclusion lines too, as different parts of the same
3328 (org-escape-code-in-string 3348 ;; file can be included too.
3329 (org-export--prepare-file-contents file lines)))) 3349 ((member (list file lines) included)
3330 (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n" 3350 (error "Recursive file inclusion: %s" file))
3331 ind-str block arg-str contents ind-str block))))
3332 ((stringp block)
3333 (insert
3334 (let ((ind-str (make-string ind ?\s))
3335 (contents
3336 (org-export--prepare-file-contents file lines)))
3337 (format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
3338 ind-str block contents ind-str block))))
3339 (t 3351 (t
3340 (insert 3352 (cond
3341 (with-temp-buffer 3353 ((eq env 'literal)
3342 (let ((org-inhibit-startup t) 3354 (insert
3343 (lines 3355 (let ((ind-str (make-string ind ?\s))
3344 (if location 3356 (arg-str (if (stringp args) (format " %s" args) ""))
3345 (org-export--inclusion-absolute-lines 3357 (contents
3346 file location only-contents lines) 3358 (org-escape-code-in-string
3347 lines))) 3359 (org-export--prepare-file-contents file lines))))
3348 (org-mode) 3360 (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n"
3349 (insert 3361 ind-str block arg-str contents ind-str block))))
3350 (org-export--prepare-file-contents 3362 ((stringp block)
3351 file lines ind minlevel 3363 (insert
3352 (or (gethash file file-prefix) 3364 (let ((ind-str (make-string ind ?\s))
3353 (puthash file (cl-incf current-prefix) file-prefix)) 3365 (contents
3354 footnotes))) 3366 (org-export--prepare-file-contents file lines)))
3355 (org-export-expand-include-keyword 3367 (format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
3356 (cons (list file lines) included) 3368 ind-str block contents ind-str block))))
3357 (file-name-directory file) 3369 (t
3358 footnotes) 3370 (insert
3359 (buffer-string))))) 3371 (with-temp-buffer
3360 ;; Expand footnotes after all files have been included. 3372 (let ((org-inhibit-startup t)
3361 ;; Footnotes are stored at end of buffer. 3373 (lines
3362 (unless included 3374 (if location
3363 (org-with-wide-buffer 3375 (org-export--inclusion-absolute-lines
3364 (goto-char (point-max)) 3376 file location only-contents lines)
3365 (maphash (lambda (k v) (insert (format "\n[fn:%s] %s\n" k v))) 3377 lines)))
3366 footnotes))))))))))) 3378 (org-mode)
3379 (insert
3380 (org-export--prepare-file-contents
3381 file lines ind minlevel
3382 (or
3383 (gethash file file-prefix)
3384 (puthash file (cl-incf current-prefix) file-prefix))
3385 footnotes)))
3386 (org-export-expand-include-keyword
3387 (cons (list file lines) included)
3388 (file-name-directory file)
3389 footnotes)
3390 (buffer-string)))))
3391 ;; Expand footnotes after all files have been
3392 ;; included. Footnotes are stored at end of buffer.
3393 (unless included
3394 (org-with-wide-buffer
3395 (goto-char (point-max))
3396 (maphash (lambda (k v)
3397 (insert (format "\n[fn:%s] %s\n" k v)))
3398 footnotes))))))))))))
3367 3399
3368(defun org-export--inclusion-absolute-lines (file location only-contents lines) 3400(defun org-export--inclusion-absolute-lines (file location only-contents lines)
3369 "Resolve absolute lines for an included file with file-link. 3401 "Resolve absolute lines for an included file with file-link.
@@ -4134,12 +4166,56 @@ the provided rules is non-nil. The default rule is
4134This only applies to links without a description." 4166This only applies to links without a description."
4135 (and (not (org-element-contents link)) 4167 (and (not (org-element-contents link))
4136 (let ((case-fold-search t)) 4168 (let ((case-fold-search t))
4137 (catch 'exit 4169 (cl-some (lambda (rule)
4138 (dolist (rule (or rules org-export-default-inline-image-rule)) 4170 (and (string= (org-element-property :type link) (car rule))
4139 (and (string= (org-element-property :type link) (car rule)) 4171 (string-match-p (cdr rule)
4140 (string-match-p (cdr rule) 4172 (org-element-property :path link))))
4141 (org-element-property :path link)) 4173 (or rules org-export-default-inline-image-rule)))))
4142 (throw 'exit t))))))) 4174
4175(defun org-export-insert-image-links (data info &optional rules)
4176 "Insert image links in DATA.
4177
4178Org syntax does not support nested links. Nevertheless, some
4179export back-ends support images as descriptions of links. Since
4180images are really links to image files, we need to make an
4181exception about links nesting.
4182
4183This function recognizes links whose contents are really images
4184and turn them into proper nested links. It is meant to be used
4185as a parse tree filter in back-ends supporting such constructs.
4186
4187DATA is a parse tree. INFO is the current state of the export
4188process, as a plist.
4189
4190A description is a valid images if it matches any rule in RULES,
4191if non-nil, or `org-export-default-inline-image-rule' otherwise.
4192See `org-export-inline-image-p' for more information about the
4193structure of RULES.
4194
4195Return modified DATA."
4196 (let ((link-re (format "\\`\\(?:%s\\|%s\\)\\'"
4197 org-plain-link-re
4198 org-angle-link-re))
4199 (case-fold-search t))
4200 (org-element-map data 'link
4201 (lambda (l)
4202 (let ((contents (org-element-interpret-data (org-element-contents l))))
4203 (when (and (org-string-nw-p contents)
4204 (string-match link-re contents))
4205 (let ((type (match-string 1 contents))
4206 (path (match-string 2 contents)))
4207 (when (cl-some (lambda (rule)
4208 (and (string= type (car rule))
4209 (string-match-p (cdr rule) path)))
4210 (or rules org-export-default-inline-image-rule))
4211 ;; Replace contents with image link.
4212 (org-element-adopt-elements
4213 (org-element-set-contents l nil)
4214 (with-temp-buffer
4215 (save-excursion (insert contents))
4216 (org-element-link-parser))))))))
4217 info nil nil t))
4218 data)
4143 4219
4144(defun org-export-resolve-coderef (ref info) 4220(defun org-export-resolve-coderef (ref info)
4145 "Resolve a code reference REF. 4221 "Resolve a code reference REF.
@@ -4246,12 +4322,10 @@ Assume LINK type is \"fuzzy\". White spaces are not
4246significant." 4322significant."
4247 (let* ((search-cells (org-export-string-to-search-cell 4323 (let* ((search-cells (org-export-string-to-search-cell
4248 (org-link-unescape (org-element-property :path link)))) 4324 (org-link-unescape (org-element-property :path link))))
4249 (link-cache 4325 (link-cache (or (plist-get info :resolve-fuzzy-link-cache)
4250 (or (plist-get info :resolve-fuzzy-link-cache) 4326 (let ((table (make-hash-table :test #'eq)))
4251 (plist-get (plist-put info 4327 (plist-put info :resolve-fuzzy-link-cache table)
4252 :resolve-fuzzy-link-cache 4328 table)))
4253 (make-hash-table :test #'equal))
4254 :resolve-fuzzy-link-cache)))
4255 (cached (gethash search-cells link-cache 'not-found))) 4329 (cached (gethash search-cells link-cache 'not-found)))
4256 (if (not (eq cached 'not-found)) cached 4330 (if (not (eq cached 'not-found)) cached
4257 (let ((matches 4331 (let ((matches
@@ -4655,19 +4729,20 @@ code."
4655All special columns will be ignored during export." 4729All special columns will be ignored during export."
4656 ;; The table has a special column when every first cell of every row 4730 ;; The table has a special column when every first cell of every row
4657 ;; has an empty value or contains a symbol among "/", "#", "!", "$", 4731 ;; has an empty value or contains a symbol among "/", "#", "!", "$",
4658 ;; "*" "_" and "^". Though, do not consider a first row containing 4732 ;; "*" "_" and "^". Though, do not consider a first column
4659 ;; only empty cells as special. 4733 ;; containing only empty cells as special.
4660 (let ((special-column-p 'empty)) 4734 (let ((special-column? 'empty))
4661 (catch 'exit 4735 (catch 'exit
4662 (dolist (row (org-element-contents table)) 4736 (dolist (row (org-element-contents table))
4663 (when (eq (org-element-property :type row) 'standard) 4737 (when (eq (org-element-property :type row) 'standard)
4664 (let ((value (org-element-contents 4738 (let ((value (org-element-contents
4665 (car (org-element-contents row))))) 4739 (car (org-element-contents row)))))
4666 (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) 4740 (cond ((member value
4667 (setq special-column-p 'special)) 4741 '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
4668 ((not value)) 4742 (setq special-column? 'special))
4743 ((null value))
4669 (t (throw 'exit nil)))))) 4744 (t (throw 'exit nil))))))
4670 (eq special-column-p 'special)))) 4745 (eq special-column? 'special))))
4671 4746
4672(defun org-export-table-has-header-p (table info) 4747(defun org-export-table-has-header-p (table info)
4673 "Non-nil when TABLE has a header. 4748 "Non-nil when TABLE has a header.
@@ -4675,26 +4750,28 @@ All special columns will be ignored during export."
4675INFO is a plist used as a communication channel. 4750INFO is a plist used as a communication channel.
4676 4751
4677A table has a header when it contains at least two row groups." 4752A table has a header when it contains at least two row groups."
4678 (let ((cache (or (plist-get info :table-header-cache) 4753 (let* ((cache (or (plist-get info :table-header-cache)
4679 (plist-get (setq info 4754 (let ((table (make-hash-table :test #'eq)))
4680 (plist-put info :table-header-cache 4755 (plist-put info :table-header-cache table)
4681 (make-hash-table :test 'eq))) 4756 table)))
4682 :table-header-cache)))) 4757 (cached (gethash table cache 'no-cache)))
4683 (or (gethash table cache) 4758 (if (not (eq cached 'no-cache)) cached
4684 (let ((rowgroup 1) row-flag) 4759 (let ((rowgroup 1) row-flag)
4685 (puthash 4760 (puthash table
4686 table 4761 (org-element-map table 'table-row
4687 (org-element-map table 'table-row 4762 (lambda (row)
4688 (lambda (row) 4763 (cond
4689 (cond 4764 ((> rowgroup 1) t)
4690 ((> rowgroup 1) t) 4765 ((and row-flag
4691 ((and row-flag (eq (org-element-property :type row) 'rule)) 4766 (eq (org-element-property :type row) 'rule))
4692 (cl-incf rowgroup) (setq row-flag nil)) 4767 (cl-incf rowgroup)
4693 ((and (not row-flag) (eq (org-element-property :type row) 4768 (setq row-flag nil))
4694 'standard)) 4769 ((and (not row-flag)
4695 (setq row-flag t) nil))) 4770 (eq (org-element-property :type row) 'standard))
4696 info 'first-match) 4771 (setq row-flag t)
4697 cache))))) 4772 nil)))
4773 info 'first-match)
4774 cache)))))
4698 4775
4699(defun org-export-table-row-is-special-p (table-row _) 4776(defun org-export-table-row-is-special-p (table-row _)
4700 "Non-nil if TABLE-ROW is considered special. 4777 "Non-nil if TABLE-ROW is considered special.
@@ -4735,21 +4812,24 @@ INFO is a plist used as the communication channel.
4735Return value is the group number, as an integer, or nil for 4812Return value is the group number, as an integer, or nil for
4736special rows and rows separators. First group is also table's 4813special rows and rows separators. First group is also table's
4737header." 4814header."
4738 (let ((cache (or (plist-get info :table-row-group-cache) 4815 (when (eq (org-element-property :type table-row) 'standard)
4739 (plist-get (setq info 4816 (let* ((cache (or (plist-get info :table-row-group-cache)
4740 (plist-put info :table-row-group-cache 4817 (let ((table (make-hash-table :test #'eq)))
4741 (make-hash-table :test 'eq))) 4818 (plist-put info :table-row-group-cache table)
4742 :table-row-group-cache)))) 4819 table)))
4743 (cond ((gethash table-row cache)) 4820 (cached (gethash table-row cache 'no-cache)))
4744 ((eq (org-element-property :type table-row) 'rule) nil) 4821 (if (not (eq cached 'no-cache)) cached
4745 (t (let ((group 0) row-flag) 4822 ;; First time a row is queried, populate cache with all the
4746 (org-element-map (org-export-get-parent table-row) 'table-row 4823 ;; rows from the table.
4747 (lambda (row) 4824 (let ((group 0) row-flag)
4748 (if (eq (org-element-property :type row) 'rule) 4825 (org-element-map (org-export-get-parent table-row) 'table-row
4749 (setq row-flag nil) 4826 (lambda (row)
4750 (unless row-flag (cl-incf group) (setq row-flag t))) 4827 (if (eq (org-element-property :type row) 'rule)
4751 (when (eq table-row row) (puthash table-row group cache))) 4828 (setq row-flag nil)
4752 info 'first-match)))))) 4829 (unless row-flag (cl-incf group) (setq row-flag t))
4830 (puthash row group cache)))
4831 info))
4832 (gethash table-row cache)))))
4753 4833
4754(defun org-export-table-cell-width (table-cell info) 4834(defun org-export-table-cell-width (table-cell info)
4755 "Return TABLE-CELL contents width. 4835 "Return TABLE-CELL contents width.
@@ -4764,10 +4844,9 @@ same column as TABLE-CELL, or nil."
4764 (columns (length cells)) 4844 (columns (length cells))
4765 (column (- columns (length (memq table-cell cells)))) 4845 (column (- columns (length (memq table-cell cells))))
4766 (cache (or (plist-get info :table-cell-width-cache) 4846 (cache (or (plist-get info :table-cell-width-cache)
4767 (plist-get (setq info 4847 (let ((table (make-hash-table :test #'eq)))
4768 (plist-put info :table-cell-width-cache 4848 (plist-put info :table-cell-width-cache table)
4769 (make-hash-table :test 'eq))) 4849 table)))
4770 :table-cell-width-cache)))
4771 (width-vector (or (gethash table cache) 4850 (width-vector (or (gethash table cache)
4772 (puthash table (make-vector columns 'empty) cache))) 4851 (puthash table (make-vector columns 'empty) cache)))
4773 (value (aref width-vector column))) 4852 (value (aref width-vector column)))
@@ -4808,10 +4887,9 @@ Possible values are `left', `right' and `center'."
4808 (columns (length cells)) 4887 (columns (length cells))
4809 (column (- columns (length (memq table-cell cells)))) 4888 (column (- columns (length (memq table-cell cells))))
4810 (cache (or (plist-get info :table-cell-alignment-cache) 4889 (cache (or (plist-get info :table-cell-alignment-cache)
4811 (plist-get (setq info 4890 (let ((table (make-hash-table :test #'eq)))
4812 (plist-put info :table-cell-alignment-cache 4891 (plist-put info :table-cell-alignment-cache table)
4813 (make-hash-table :test 'eq))) 4892 table)))
4814 :table-cell-alignment-cache)))
4815 (align-vector (or (gethash table cache) 4893 (align-vector (or (gethash table cache)
4816 (puthash table (make-vector columns nil) cache)))) 4894 (puthash table (make-vector columns nil) cache))))
4817 (or (aref align-vector column) 4895 (or (aref align-vector column)
@@ -5014,17 +5092,24 @@ INFO is a plist used as a communication channel."
5014(defun org-export-table-row-number (table-row info) 5092(defun org-export-table-row-number (table-row info)
5015 "Return TABLE-ROW number. 5093 "Return TABLE-ROW number.
5016INFO is a plist used as a communication channel. Return value is 5094INFO is a plist used as a communication channel. Return value is
5017zero-based and ignores separators. The function returns nil for 5095zero-indexed and ignores separators. The function returns nil
5018special columns and separators." 5096for special rows and separators."
5019 (when (and (eq (org-element-property :type table-row) 'standard) 5097 (when (eq (org-element-property :type table-row) 'standard)
5020 (not (org-export-table-row-is-special-p table-row info))) 5098 (let* ((cache (or (plist-get info :table-row-number-cache)
5021 (let ((number 0)) 5099 (let ((table (make-hash-table :test #'eq)))
5022 (org-element-map (org-export-get-parent-table table-row) 'table-row 5100 (plist-put info :table-row-number-cache table)
5023 (lambda (row) 5101 table)))
5024 (cond ((eq row table-row) number) 5102 (cached (gethash table-row cache 'no-cache)))
5025 ((eq (org-element-property :type row) 'standard) 5103 (if (not (eq cached 'no-cache)) cached
5026 (cl-incf number) nil))) 5104 ;; First time a row is queried, populate cache with all the
5027 info 'first-match)))) 5105 ;; rows from the table.
5106 (let ((number -1))
5107 (org-element-map (org-export-get-parent-table table-row) 'table-row
5108 (lambda (row)
5109 (when (eq (org-element-property :type row) 'standard)
5110 (puthash row (cl-incf number) cache)))
5111 info))
5112 (gethash table-row cache)))))
5028 5113
5029(defun org-export-table-dimensions (table info) 5114(defun org-export-table-dimensions (table info)
5030 "Return TABLE dimensions. 5115 "Return TABLE dimensions.
@@ -5197,7 +5282,19 @@ Return a list of src-block elements with a caption."
5197;; `org-export-smart-quotes-alist'. 5282;; `org-export-smart-quotes-alist'.
5198 5283
5199(defconst org-export-smart-quotes-alist 5284(defconst org-export-smart-quotes-alist
5200 '(("da" 5285 '(("ar"
5286 (primary-opening
5287 :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
5288 :texinfo "@guillemetleft{}")
5289 (primary-closing
5290 :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
5291 :texinfo "@guillemetright{}")
5292 (secondary-opening :utf-8 "‹" :html "&lsaquo;" :latex "\\guilsinglleft{}"
5293 :texinfo "@guilsinglleft{}")
5294 (secondary-closing :utf-8 "›" :html "&rsaquo;" :latex "\\guilsinglright{}"
5295 :texinfo "@guilsinglright{}")
5296 (apostrophe :utf-8 "’" :html "&rsquo;"))
5297 ("da"
5201 ;; one may use: »...«, "...", ›...‹, or '...'. 5298 ;; one may use: »...«, "...", ›...‹, or '...'.
5202 ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ 5299 ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
5203 ;; LaTeX quotes require Babel! 5300 ;; LaTeX quotes require Babel!
@@ -5304,8 +5401,19 @@ Return a list of src-block elements with a caption."
5304 (secondary-closing 5401 (secondary-closing
5305 :utf-8 "“" :html "&ldquo;" :latex "\\grqq{}" :texinfo "@quotedblleft{}") 5402 :utf-8 "“" :html "&ldquo;" :latex "\\grqq{}" :texinfo "@quotedblleft{}")
5306 (apostrophe :utf-8 "’" :html: "&#39;")) 5403 (apostrophe :utf-8 "’" :html: "&#39;"))
5404 ("sl"
5405 ;; Based on https://sl.wikipedia.org/wiki/Narekovaj
5406 (primary-opening :utf-8 "«" :html "&laquo;" :latex "{}<<"
5407 :texinfo "@guillemetleft{}")
5408 (primary-closing :utf-8 "»" :html "&raquo;" :latex ">>{}"
5409 :texinfo "@guillemetright{}")
5410 (secondary-opening
5411 :utf-8 "„" :html "&bdquo;" :latex "\\glqq{}" :texinfo "@quotedblbase{}")
5412 (secondary-closing
5413 :utf-8 "“" :html "&ldquo;" :latex "\\grqq{}" :texinfo "@quotedblleft{}")
5414 (apostrophe :utf-8 "’" :html "&rsquo;"))
5307 ("sv" 5415 ("sv"
5308 ;; based on https://sv.wikipedia.org/wiki/Citattecken 5416 ;; Based on https://sv.wikipedia.org/wiki/Citattecken
5309 (primary-opening :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’") 5417 (primary-opening :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
5310 (primary-closing :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’") 5418 (primary-closing :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
5311 (secondary-opening :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "`") 5419 (secondary-opening :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "`")
@@ -5521,6 +5629,7 @@ them."
5521 '(("%e %n: %c" 5629 '(("%e %n: %c"
5522 ("fr" :default "%e %n : %c" :html "%e&nbsp;%n&nbsp;: %c")) 5630 ("fr" :default "%e %n : %c" :html "%e&nbsp;%n&nbsp;: %c"))
5523 ("Author" 5631 ("Author"
5632 ("ar" :default "تأليف")
5524 ("ca" :default "Autor") 5633 ("ca" :default "Autor")
5525 ("cs" :default "Autor") 5634 ("cs" :default "Autor")
5526 ("da" :default "Forfatter") 5635 ("da" :default "Forfatter")
@@ -5541,11 +5650,13 @@ them."
5541 ("pl" :default "Autor") 5650 ("pl" :default "Autor")
5542 ("pt_BR" :default "Autor") 5651 ("pt_BR" :default "Autor")
5543 ("ru" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор") 5652 ("ru" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
5653 ("sl" :default "Avtor")
5544 ("sv" :html "F&ouml;rfattare") 5654 ("sv" :html "F&ouml;rfattare")
5545 ("uk" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор") 5655 ("uk" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
5546 ("zh-CN" :html "&#20316;&#32773;" :utf-8 "作者") 5656 ("zh-CN" :html "&#20316;&#32773;" :utf-8 "作者")
5547 ("zh-TW" :html "&#20316;&#32773;" :utf-8 "作者")) 5657 ("zh-TW" :html "&#20316;&#32773;" :utf-8 "作者"))
5548 ("Continued from previous page" 5658 ("Continued from previous page"
5659 ("ar" :default "تتمة الصفحة السابقة")
5549 ("de" :default "Fortsetzung von vorheriger Seite") 5660 ("de" :default "Fortsetzung von vorheriger Seite")
5550 ("es" :html "Contin&uacute;a de la p&aacute;gina anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior") 5661 ("es" :html "Contin&uacute;a de la p&aacute;gina anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior")
5551 ("fr" :default "Suite de la page précédente") 5662 ("fr" :default "Suite de la page précédente")
@@ -5554,8 +5665,10 @@ them."
5554 ("nl" :default "Vervolg van vorige pagina") 5665 ("nl" :default "Vervolg van vorige pagina")
5555 ("pt" :default "Continuação da página anterior") 5666 ("pt" :default "Continuação da página anterior")
5556 ("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077;)" 5667 ("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077;)"
5557 :utf-8 "(Продолжение)")) 5668 :utf-8 "(Продолжение)")
5669 ("sl" :default "Nadaljevanje s prejšnje strani"))
5558 ("Continued on next page" 5670 ("Continued on next page"
5671 ("ar" :default "التتمة في الصفحة التالية")
5559 ("de" :default "Fortsetzung nächste Seite") 5672 ("de" :default "Fortsetzung nächste Seite")
5560 ("es" :html "Contin&uacute;a en la siguiente p&aacute;gina" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página") 5673 ("es" :html "Contin&uacute;a en la siguiente p&aacute;gina" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página")
5561 ("fr" :default "Suite page suivante") 5674 ("fr" :default "Suite page suivante")
@@ -5564,8 +5677,12 @@ them."
5564 ("nl" :default "Vervolg op volgende pagina") 5677 ("nl" :default "Vervolg op volgende pagina")
5565 ("pt" :default "Continua na página seguinte") 5678 ("pt" :default "Continua na página seguinte")
5566 ("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077; &#1089;&#1083;&#1077;&#1076;&#1091;&#1077;&#1090;)" 5679 ("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077; &#1089;&#1083;&#1077;&#1076;&#1091;&#1077;&#1090;)"
5567 :utf-8 "(Продолжение следует)")) 5680 :utf-8 "(Продолжение следует)")
5681 ("sl" :default "Nadaljevanje na naslednji strani"))
5682 ("Created"
5683 ("sl" :default "Ustvarjeno"))
5568 ("Date" 5684 ("Date"
5685 ("ar" :default "بتاريخ")
5569 ("ca" :default "Data") 5686 ("ca" :default "Data")
5570 ("cs" :default "Datum") 5687 ("cs" :default "Datum")
5571 ("da" :default "Dato") 5688 ("da" :default "Dato")
@@ -5585,11 +5702,13 @@ them."
5585 ("pl" :default "Data") 5702 ("pl" :default "Data")
5586 ("pt_BR" :default "Data") 5703 ("pt_BR" :default "Data")
5587 ("ru" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата") 5704 ("ru" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
5705 ("sl" :default "Datum")
5588 ("sv" :default "Datum") 5706 ("sv" :default "Datum")
5589 ("uk" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата") 5707 ("uk" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
5590 ("zh-CN" :html "&#26085;&#26399;" :utf-8 "日期") 5708 ("zh-CN" :html "&#26085;&#26399;" :utf-8 "日期")
5591 ("zh-TW" :html "&#26085;&#26399;" :utf-8 "日期")) 5709 ("zh-TW" :html "&#26085;&#26399;" :utf-8 "日期"))
5592 ("Equation" 5710 ("Equation"
5711 ("ar" :default "معادلة")
5593 ("da" :default "Ligning") 5712 ("da" :default "Ligning")
5594 ("de" :default "Gleichung") 5713 ("de" :default "Gleichung")
5595 ("es" :ascii "Ecuacion" :html "Ecuaci&oacute;n" :default "Ecuación") 5714 ("es" :ascii "Ecuacion" :html "Ecuaci&oacute;n" :default "Ecuación")
@@ -5603,9 +5722,11 @@ them."
5603 ("pt_BR" :html "Equa&ccedil;&atilde;o" :default "Equação" :ascii "Equacao") 5722 ("pt_BR" :html "Equa&ccedil;&atilde;o" :default "Equação" :ascii "Equacao")
5604 ("ru" :html "&#1059;&#1088;&#1072;&#1074;&#1085;&#1077;&#1085;&#1080;&#1077;" 5723 ("ru" :html "&#1059;&#1088;&#1072;&#1074;&#1085;&#1077;&#1085;&#1080;&#1077;"
5605 :utf-8 "Уравнение") 5724 :utf-8 "Уравнение")
5725 ("sl" :default "Enačba")
5606 ("sv" :default "Ekvation") 5726 ("sv" :default "Ekvation")
5607 ("zh-CN" :html "&#26041;&#31243;" :utf-8 "方程")) 5727 ("zh-CN" :html "&#26041;&#31243;" :utf-8 "方程"))
5608 ("Figure" 5728 ("Figure"
5729 ("ar" :default "شكل")
5609 ("da" :default "Figur") 5730 ("da" :default "Figur")
5610 ("de" :default "Abbildung") 5731 ("de" :default "Abbildung")
5611 ("es" :default "Figura") 5732 ("es" :default "Figura")
@@ -5620,6 +5741,7 @@ them."
5620 ("sv" :default "Illustration") 5741 ("sv" :default "Illustration")
5621 ("zh-CN" :html "&#22270;" :utf-8 "图")) 5742 ("zh-CN" :html "&#22270;" :utf-8 "图"))
5622 ("Figure %d:" 5743 ("Figure %d:"
5744 ("ar" :default "شكل %d:")
5623 ("da" :default "Figur %d") 5745 ("da" :default "Figur %d")
5624 ("de" :default "Abbildung %d:") 5746 ("de" :default "Abbildung %d:")
5625 ("es" :default "Figura %d:") 5747 ("es" :default "Figura %d:")
@@ -5632,9 +5754,11 @@ them."
5632 ("nn" :default "Illustrasjon %d") 5754 ("nn" :default "Illustrasjon %d")
5633 ("pt_BR" :default "Figura %d:") 5755 ("pt_BR" :default "Figura %d:")
5634 ("ru" :html "&#1056;&#1080;&#1089;. %d.:" :utf-8 "Рис. %d.:") 5756 ("ru" :html "&#1056;&#1080;&#1089;. %d.:" :utf-8 "Рис. %d.:")
5757 ("sl" :default "Slika %d")
5635 ("sv" :default "Illustration %d") 5758 ("sv" :default "Illustration %d")
5636 ("zh-CN" :html "&#22270;%d&nbsp;" :utf-8 "图%d ")) 5759 ("zh-CN" :html "&#22270;%d&nbsp;" :utf-8 "图%d "))
5637 ("Footnotes" 5760 ("Footnotes"
5761 ("ar" :default "الهوامش")
5638 ("ca" :html "Peus de p&agrave;gina") 5762 ("ca" :html "Peus de p&agrave;gina")
5639 ("cs" :default "Pozn\xe1mky pod carou") 5763 ("cs" :default "Pozn\xe1mky pod carou")
5640 ("da" :default "Fodnoter") 5764 ("da" :default "Fodnoter")
@@ -5655,12 +5779,14 @@ them."
5655 ("pl" :default "Przypis") 5779 ("pl" :default "Przypis")
5656 ("pt_BR" :html "Notas de Rodap&eacute;" :default "Notas de Rodapé" :ascii "Notas de Rodape") 5780 ("pt_BR" :html "Notas de Rodap&eacute;" :default "Notas de Rodapé" :ascii "Notas de Rodape")
5657 ("ru" :html "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;" :utf-8 "Сноски") 5781 ("ru" :html "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;" :utf-8 "Сноски")
5782 ("sl" :default "Opombe")
5658 ("sv" :default "Fotnoter") 5783 ("sv" :default "Fotnoter")
5659 ("uk" :html "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;" 5784 ("uk" :html "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;"
5660 :utf-8 "Примітки") 5785 :utf-8 "Примітки")
5661 ("zh-CN" :html "&#33050;&#27880;" :utf-8 "脚注") 5786 ("zh-CN" :html "&#33050;&#27880;" :utf-8 "脚注")
5662 ("zh-TW" :html "&#33139;&#35387;" :utf-8 "腳註")) 5787 ("zh-TW" :html "&#33139;&#35387;" :utf-8 "腳註"))
5663 ("List of Listings" 5788 ("List of Listings"
5789 ("ar" :default "قائمة بالبرامج")
5664 ("da" :default "Programmer") 5790 ("da" :default "Programmer")
5665 ("de" :default "Programmauflistungsverzeichnis") 5791 ("de" :default "Programmauflistungsverzeichnis")
5666 ("es" :ascii "Indice de Listados de programas" :html "&Iacute;ndice de Listados de programas" :default "Índice de Listados de programas") 5792 ("es" :ascii "Indice de Listados de programas" :html "&Iacute;ndice de Listados de programas" :default "Índice de Listados de programas")
@@ -5671,8 +5797,10 @@ them."
5671 ("nb" :default "Dataprogrammer") 5797 ("nb" :default "Dataprogrammer")
5672 ("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1088;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1086;&#1082;" 5798 ("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1088;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1086;&#1082;"
5673 :utf-8 "Список распечаток") 5799 :utf-8 "Список распечаток")
5800 ("sl" :default "Seznam programskih izpisov")
5674 ("zh-CN" :html "&#20195;&#30721;&#30446;&#24405;" :utf-8 "代码目录")) 5801 ("zh-CN" :html "&#20195;&#30721;&#30446;&#24405;" :utf-8 "代码目录"))
5675 ("List of Tables" 5802 ("List of Tables"
5803 ("ar" :default "قائمة بالجداول")
5676 ("da" :default "Tabeller") 5804 ("da" :default "Tabeller")
5677 ("de" :default "Tabellenverzeichnis") 5805 ("de" :default "Tabellenverzeichnis")
5678 ("es" :ascii "Indice de tablas" :html "&Iacute;ndice de tablas" :default "Índice de tablas") 5806 ("es" :ascii "Indice de tablas" :html "&Iacute;ndice de tablas" :default "Índice de tablas")
@@ -5686,9 +5814,11 @@ them."
5686 ("pt_BR" :default "Índice de Tabelas" :ascii "Indice de Tabelas") 5814 ("pt_BR" :default "Índice de Tabelas" :ascii "Indice de Tabelas")
5687 ("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1090;&#1072;&#1073;&#1083;&#1080;&#1094;" 5815 ("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1090;&#1072;&#1073;&#1083;&#1080;&#1094;"
5688 :utf-8 "Список таблиц") 5816 :utf-8 "Список таблиц")
5817 ("sl" :default "Seznam tabel")
5689 ("sv" :default "Tabeller") 5818 ("sv" :default "Tabeller")
5690 ("zh-CN" :html "&#34920;&#26684;&#30446;&#24405;" :utf-8 "表格目录")) 5819 ("zh-CN" :html "&#34920;&#26684;&#30446;&#24405;" :utf-8 "表格目录"))
5691 ("Listing" 5820 ("Listing"
5821 ("ar" :default "برنامج")
5692 ("da" :default "Program") 5822 ("da" :default "Program")
5693 ("de" :default "Programmlisting") 5823 ("de" :default "Programmlisting")
5694 ("es" :default "Listado de programa") 5824 ("es" :default "Listado de programa")
@@ -5700,8 +5830,10 @@ them."
5700 ("pt_BR" :default "Listagem") 5830 ("pt_BR" :default "Listagem")
5701 ("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072;" 5831 ("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072;"
5702 :utf-8 "Распечатка") 5832 :utf-8 "Распечатка")
5833 ("sl" :default "Izpis programa")
5703 ("zh-CN" :html "&#20195;&#30721;" :utf-8 "代码")) 5834 ("zh-CN" :html "&#20195;&#30721;" :utf-8 "代码"))
5704 ("Listing %d:" 5835 ("Listing %d:"
5836 ("ar" :default "برنامج %d:")
5705 ("da" :default "Program %d") 5837 ("da" :default "Program %d")
5706 ("de" :default "Programmlisting %d") 5838 ("de" :default "Programmlisting %d")
5707 ("es" :default "Listado de programa %d") 5839 ("es" :default "Listado de programa %d")
@@ -5713,18 +5845,24 @@ them."
5713 ("pt_BR" :default "Listagem %d") 5845 ("pt_BR" :default "Listagem %d")
5714 ("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072; %d.:" 5846 ("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072; %d.:"
5715 :utf-8 "Распечатка %d.:") 5847 :utf-8 "Распечатка %d.:")
5848 ("sl" :default "Izpis programa %d")
5716 ("zh-CN" :html "&#20195;&#30721;%d&nbsp;" :utf-8 "代码%d ")) 5849 ("zh-CN" :html "&#20195;&#30721;%d&nbsp;" :utf-8 "代码%d "))
5717 ("References" 5850 ("References"
5851 ("ar" :default "المراجع")
5718 ("fr" :ascii "References" :default "Références") 5852 ("fr" :ascii "References" :default "Références")
5719 ("de" :default "Quellen") 5853 ("de" :default "Quellen")
5720 ("es" :default "Referencias")) 5854 ("es" :default "Referencias")
5855 ("sl" :default "Reference"))
5721 ("See figure %s" 5856 ("See figure %s"
5722 ("fr" :default "cf. figure %s" 5857 ("fr" :default "cf. figure %s"
5723 :html "cf.&nbsp;figure&nbsp;%s" :latex "cf.~figure~%s")) 5858 :html "cf.&nbsp;figure&nbsp;%s" :latex "cf.~figure~%s")
5859 ("sl" :default "Glej sliko %s"))
5724 ("See listing %s" 5860 ("See listing %s"
5725 ("fr" :default "cf. programme %s" 5861 ("fr" :default "cf. programme %s"
5726 :html "cf.&nbsp;programme&nbsp;%s" :latex "cf.~programme~%s")) 5862 :html "cf.&nbsp;programme&nbsp;%s" :latex "cf.~programme~%s")
5863 ("sl" :default "Glej izpis programa %s"))
5727 ("See section %s" 5864 ("See section %s"
5865 ("ar" :default "انظر قسم %s")
5728 ("da" :default "jævnfør afsnit %s") 5866 ("da" :default "jævnfør afsnit %s")
5729 ("de" :default "siehe Abschnitt %s") 5867 ("de" :default "siehe Abschnitt %s")
5730 ("es" :ascii "Vea seccion %s" :html "Vea secci&oacute;n %s" :default "Vea sección %s") 5868 ("es" :ascii "Vea seccion %s" :html "Vea secci&oacute;n %s" :default "Vea sección %s")
@@ -5735,11 +5873,14 @@ them."
5735 :ascii "Veja a secao %s") 5873 :ascii "Veja a secao %s")
5736 ("ru" :html "&#1057;&#1084;. &#1088;&#1072;&#1079;&#1076;&#1077;&#1083; %s" 5874 ("ru" :html "&#1057;&#1084;. &#1088;&#1072;&#1079;&#1076;&#1077;&#1083; %s"
5737 :utf-8 "См. раздел %s") 5875 :utf-8 "См. раздел %s")
5876 ("sl" :default "Glej poglavje %d")
5738 ("zh-CN" :html "&#21442;&#35265;&#31532;%s&#33410;" :utf-8 "参见第%s节")) 5877 ("zh-CN" :html "&#21442;&#35265;&#31532;%s&#33410;" :utf-8 "参见第%s节"))
5739 ("See table %s" 5878 ("See table %s"
5740 ("fr" :default "cf. tableau %s" 5879 ("fr" :default "cf. tableau %s"
5741 :html "cf.&nbsp;tableau&nbsp;%s" :latex "cf.~tableau~%s")) 5880 :html "cf.&nbsp;tableau&nbsp;%s" :latex "cf.~tableau~%s")
5881 ("sl" :default "Glej tabelo %s"))
5742 ("Table" 5882 ("Table"
5883 ("ar" :default "جدول")
5743 ("de" :default "Tabelle") 5884 ("de" :default "Tabelle")
5744 ("es" :default "Tabla") 5885 ("es" :default "Tabla")
5745 ("et" :default "Tabel") 5886 ("et" :default "Tabel")
@@ -5751,6 +5892,7 @@ them."
5751 :utf-8 "Таблица") 5892 :utf-8 "Таблица")
5752 ("zh-CN" :html "&#34920;" :utf-8 "表")) 5893 ("zh-CN" :html "&#34920;" :utf-8 "表"))
5753 ("Table %d:" 5894 ("Table %d:"
5895 ("ar" :default "جدول %d:")
5754 ("da" :default "Tabel %d") 5896 ("da" :default "Tabel %d")
5755 ("de" :default "Tabelle %d") 5897 ("de" :default "Tabelle %d")
5756 ("es" :default "Tabla %d") 5898 ("es" :default "Tabla %d")
@@ -5764,9 +5906,11 @@ them."
5764 ("pt_BR" :default "Tabela %d") 5906 ("pt_BR" :default "Tabela %d")
5765 ("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072; %d.:" 5907 ("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072; %d.:"
5766 :utf-8 "Таблица %d.:") 5908 :utf-8 "Таблица %d.:")
5909 ("sl" :default "Tabela %d")
5767 ("sv" :default "Tabell %d") 5910 ("sv" :default "Tabell %d")
5768 ("zh-CN" :html "&#34920;%d&nbsp;" :utf-8 "表%d ")) 5911 ("zh-CN" :html "&#34920;%d&nbsp;" :utf-8 "表%d "))
5769 ("Table of Contents" 5912 ("Table of Contents"
5913 ("ar" :default "قائمة المحتويات")
5770 ("ca" :html "&Iacute;ndex") 5914 ("ca" :html "&Iacute;ndex")
5771 ("cs" :default "Obsah") 5915 ("cs" :default "Obsah")
5772 ("da" :default "Indhold") 5916 ("da" :default "Indhold")
@@ -5788,11 +5932,13 @@ them."
5788 ("pt_BR" :html "&Iacute;ndice" :utf8 "Índice" :ascii "Indice") 5932 ("pt_BR" :html "&Iacute;ndice" :utf8 "Índice" :ascii "Indice")
5789 ("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;" 5933 ("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;"
5790 :utf-8 "Содержание") 5934 :utf-8 "Содержание")
5935 ("sl" :default "Kazalo")
5791 ("sv" :html "Inneh&aring;ll") 5936 ("sv" :html "Inneh&aring;ll")
5792 ("uk" :html "&#1047;&#1084;&#1110;&#1089;&#1090;" :utf-8 "Зміст") 5937 ("uk" :html "&#1047;&#1084;&#1110;&#1089;&#1090;" :utf-8 "Зміст")
5793 ("zh-CN" :html "&#30446;&#24405;" :utf-8 "目录") 5938 ("zh-CN" :html "&#30446;&#24405;" :utf-8 "目录")
5794 ("zh-TW" :html "&#30446;&#37636;" :utf-8 "目錄")) 5939 ("zh-TW" :html "&#30446;&#37636;" :utf-8 "目錄"))
5795 ("Unknown reference" 5940 ("Unknown reference"
5941 ("ar" :default "مرجع غير معرّف")
5796 ("da" :default "ukendt reference") 5942 ("da" :default "ukendt reference")
5797 ("de" :default "Unbekannter Verweis") 5943 ("de" :default "Unbekannter Verweis")
5798 ("es" :default "Referencia desconocida") 5944 ("es" :default "Referencia desconocida")
@@ -5803,6 +5949,7 @@ them."
5803 :ascii "Referencia desconhecida") 5949 :ascii "Referencia desconhecida")
5804 ("ru" :html "&#1053;&#1077;&#1080;&#1079;&#1074;&#1077;&#1089;&#1090;&#1085;&#1072;&#1103; &#1089;&#1089;&#1099;&#1083;&#1082;&#1072;" 5950 ("ru" :html "&#1053;&#1077;&#1080;&#1079;&#1074;&#1077;&#1089;&#1090;&#1085;&#1072;&#1103; &#1089;&#1089;&#1099;&#1083;&#1082;&#1072;"
5805 :utf-8 "Неизвестная ссылка") 5951 :utf-8 "Неизвестная ссылка")
5952 ("sl" :default "Neznana referenca")
5806 ("zh-CN" :html "&#26410;&#30693;&#24341;&#29992;" :utf-8 "未知引用"))) 5953 ("zh-CN" :html "&#26410;&#30693;&#24341;&#29992;" :utf-8 "未知引用")))
5807 "Dictionary for export engine. 5954 "Dictionary for export engine.
5808 5955
@@ -6090,29 +6237,37 @@ directory.
6090Return file name as a string." 6237Return file name as a string."
6091 (let* ((visited-file (buffer-file-name (buffer-base-buffer))) 6238 (let* ((visited-file (buffer-file-name (buffer-base-buffer)))
6092 (base-name 6239 (base-name
6093 ;; File name may come from EXPORT_FILE_NAME subtree 6240 (concat
6094 ;; property. 6241 (file-name-sans-extension
6095 (file-name-sans-extension 6242 (or
6096 (or (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective)) 6243 ;; Check EXPORT_FILE_NAME subtree property.
6097 ;; File name may be extracted from buffer's associated 6244 (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective))
6098 ;; file, if any. 6245 ;; Check #+EXPORT_FILE_NAME keyword.
6099 (and visited-file (file-name-nondirectory visited-file)) 6246 (org-with-point-at (point-min)
6100 ;; Can't determine file name on our own: Ask user. 6247 (catch :found
6101 (read-file-name 6248 (let ((case-fold-search t))
6102 "Output file: " pub-dir nil nil nil 6249 (while (re-search-forward
6103 (lambda (name) 6250 "^[ \t]*#\\+EXPORT_FILE_NAME:[ \t]+\\S-" nil t)
6104 (string= (file-name-extension name t) extension)))))) 6251 (let ((element (org-element-at-point)))
6252 (when (eq 'keyword (org-element-type element))
6253 (throw :found
6254 (org-element-property :value element))))))))
6255 ;; Extract from buffer's associated file, if any.
6256 (and visited-file (file-name-nondirectory visited-file))
6257 ;; Can't determine file name on our own: ask user.
6258 (read-file-name
6259 "Output file: " pub-dir nil nil nil
6260 (lambda (n) (string= extension (file-name-extension n t))))))
6261 extension))
6105 (output-file 6262 (output-file
6106 ;; Build file name. Enforce EXTENSION over whatever user 6263 ;; Build file name. Enforce EXTENSION over whatever user
6107 ;; may have come up with. PUB-DIR, if defined, always has 6264 ;; may have come up with. PUB-DIR, if defined, always has
6108 ;; precedence over any provided path. 6265 ;; precedence over any provided path.
6109 (cond 6266 (cond
6110 (pub-dir 6267 (pub-dir (concat (file-name-as-directory pub-dir)
6111 (concat (file-name-as-directory pub-dir) 6268 (file-name-nondirectory base-name)))
6112 (file-name-nondirectory base-name) 6269 ((file-name-absolute-p base-name) base-name)
6113 extension)) 6270 (t base-name))))
6114 ((file-name-absolute-p base-name) (concat base-name extension))
6115 (t (concat (file-name-as-directory ".") base-name extension)))))
6116 ;; If writing to OUTPUT-FILE would overwrite original file, append 6271 ;; If writing to OUTPUT-FILE would overwrite original file, append
6117 ;; EXTENSION another time to final name. 6272 ;; EXTENSION another time to final name.
6118 (if (and visited-file (file-equal-p visited-file output-file)) 6273 (if (and visited-file (file-equal-p visited-file output-file))