diff options
Diffstat (limited to 'lisp')
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. |
| 51 | May be either a command in the path, like gcc | 64 | May 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. | ||
| 67 | If 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. |
| 103 | The underlying process performed by the code block can be output | ||
| 104 | using 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. |
| 43 | When set to nil no code will be evaluated as part of the export | 43 | When set to nil no code will be evaluated as part of the export |
| 44 | process and no header arguments will be obeyed. When set to | 44 | process and no header arguments will be obeyed. Users who wish |
| 45 | `inline-only', only inline code blocks will be executed. Users | 45 | to avoid evaluating code on export should use the header argument |
| 46 | who wish to avoid evaluating code on export should use the header | 46 | `:eval never-export'." |
| 47 | argument `: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. | ||
| 42 | This 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. |
| 59 | This will typically be 'lua-mode." | 59 | This 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. | ||
| 51 | PARAMS is a property list of source block parameters, which may | ||
| 52 | contain multiple entries for the key `:var'. `:var' entries in PARAMS | ||
| 53 | are 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. | ||
| 63 | BODY is the content of the source block and PARAMS is a property list | ||
| 64 | of source block parameters. This function relies on the | ||
| 65 | `org-babel-expand-body:generic' function to extract `:var' entries | ||
| 66 | from PARAMS and on the `org-babel-variable-assignments:plantuml' | ||
| 67 | function 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. |
| 51 | This function is called by `org-babel-execute-src-block'." | 76 | This 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 | ||
| 43 | called 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 | |||
| 65 | Console.withOut(new java.io.OutputStream() {def write(b: Int){ | ||
| 66 | }}) { | ||
| 67 | str_result = { | ||
| 68 | %s | ||
| 69 | }.toString | ||
| 70 | } | ||
| 71 | |||
| 72 | print(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. | ||
| 79 | If RESULT-TYPE equals `output' then return standard output as a string. | ||
| 80 | If RESULT-TYPE equals `value' then return the value of the last statement | ||
| 81 | in 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 | ||
| 106 | then create. Return the initialized session. Sessions are not | ||
| 107 | supported 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 | ||
| 113 | If the session is `none', use nil for the session name, and | 127 | If the session is `none', use nil for the session name, and |
| 114 | org-babel-scheme-execute-with-geiser will use a temporary session." | 128 | org-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. | ||
| 188 | If the results look like a list or tuple, then convert them into an | ||
| 189 | Emacs-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. |
| 181 | This function is called by `org-babel-execute-src-block'" | 201 | This 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. |
| 121 | If in Cygwin environment, uses Cygwin specific function to | 153 | If 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 | |||
| 203 | SET COLSEP '|' | 249 | SET 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. | ||
| 51 | May be either a command in the path, like \"valac\" | ||
| 52 | or an absolute path name, like \"/usr/local/bin/valac\". | ||
| 53 | Parameters 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. | ||
| 75 | This 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. | ||
| 109 | This function does nothing as Vala is a compiled language with no | ||
| 110 | support 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. | ||
| 980 | When nil, only the days which actually have entries are shown. | ||
| 981 | When t, all days between the first and the last date are shown. | ||
| 982 | When an integer, show also empty dates, but if there is a gap of more than | ||
| 983 | N 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 | |||
| 1081 | expressions listed in `org-agenda-entry-text-exclude-regexps'.") | 1068 | expressions 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. |
| 1085 | Dynamically scoped.") | 1072 | Dynamically 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. |
| 1158 | Used by the daily/weekly agenda and by the timeline. This should be | 1145 | Used by the daily/weekly agenda. This should be a format string |
| 1159 | a format string understood by `format-time-string', or a function returning | 1146 | understood by `format-time-string', or a function returning the |
| 1160 | the formatted date as a string. The function must take a single argument, | 1147 | formatted date as a string. The function must take a single |
| 1161 | a calendar-style date list like (month day year)." | 1148 | argument, 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. |
| 1169 | This function makes sure that dates are aligned for easy reading." | 1156 | This 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? |
| 1228 | These days get the special face `org-agenda-date-weekend' in the agenda | 1215 | These days get the special face `org-agenda-date-weekend' in the agenda." |
| 1229 | and 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. |
| 1265 | When set to a list of strings, only show occurrences of repeating | 1251 | When set to the symbol `next' only the first future repeat is shown." |
| 1266 | stamps for these TODO keywords. When nil, only one occurrence is | 1252 | :group 'org-agenda-daily/weekly |
| 1267 | shown, 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 | |||
| 1264 | When nil, display SCHEDULED and DEADLINE dates at their base | ||
| 1265 | date, and in today's agenda, as a reminder. Display plain | ||
| 1266 | time-stamps, on the other hand, at every repeat date in the past | ||
| 1267 | in addition to the base date. | ||
| 1268 | |||
| 1269 | When non-nil, show a repeated entry at its latest repeat date, | ||
| 1270 | possibly being today even if it wasn't marked as done. This | ||
| 1271 | setting is useful if you do not always mark repeated entries as | ||
| 1272 | done and, yet, consider that reaching repeat date starts the task | ||
| 1273 | anew. | ||
| 1274 | |||
| 1275 | When set to a list of strings, prefer last repeats only for | ||
| 1276 | entries 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 | |||
| 1278 | this day and will be listed until it is marked done or for the | 1290 | this day and will be listed until it is marked done or for the |
| 1279 | number of days given here." | 1291 | number 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. | ||
| 1298 | When an item has deadline on a date, it shows up in the agenda on | ||
| 1299 | this day and will appear as a reminder until it is marked DONE or | ||
| 1300 | for 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 | |||
| 1421 | show headlines of level 1. When set to 0, the default | 1445 | show headlines of level 1. When set to 0, the default |
| 1422 | value, don't limit agenda view by outline level." | 1446 | value, 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. |
| 1460 | This is a list of three items. The first item is again a list. It contains | 1485 | This is a list of four items. The first item is again a list. It contains |
| 1461 | symbols specifying conditions when the grid should be displayed: | 1486 | symbols 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 | ||
| 1469 | The second item is a string which will be placed behind the grid time. | 1494 | The second item is a list of integers, indicating the times that |
| 1495 | should have a grid line. | ||
| 1470 | 1496 | ||
| 1471 | The third item is a list of integers, indicating the times that should have | 1497 | The third item is a string which will be placed right after the |
| 1472 | a grid line." | 1498 | times that have a grid line. |
| 1499 | |||
| 1500 | The fourth item is a string placed after the grid times. This | ||
| 1501 | will 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. |
| 1618 | An alist with five entries, each for the different agenda types. The | 1647 | An alist with five entries, each for the different agenda types. The |
| 1619 | keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'. | 1648 | keys of the sublists are `agenda', `todo', `search' and `tags'. |
| 1620 | The values are format strings. | 1649 | The values are format strings. |
| 1621 | 1650 | ||
| 1622 | This format works similar to a printf format, with the following meaning: | 1651 | This 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 | ||
| 1796 | This can be set to a list of agenda types in which the agenda | 1826 | This can be set to a list of agenda types in which the agenda |
| 1797 | must display the inherited tags. Available types are `todo', | 1827 | must display the inherited tags. Available types are `todo', |
| 1798 | `agenda', `search' and `timeline'. | 1828 | `agenda' and `search'. |
| 1799 | 1829 | ||
| 1800 | When set to nil, never show inherited tags in agenda lines." | 1830 | When 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 | ||
| 1813 | In tags/tags-todo/tags-tree agenda views, tag inheritance is | 1843 | In tags/tags-todo/tags-tree agenda views, tag inheritance is |
| @@ -1816,7 +1846,7 @@ controlled by `org-use-tag-inheritance'. In other agenda types, | |||
| 1816 | agenda entries. Still, you may want the agenda to be aware of | 1846 | agenda entries. Still, you may want the agenda to be aware of |
| 1817 | the inherited tags anyway, e.g. for later tag filtering. | 1847 | the inherited tags anyway, e.g. for later tag filtering. |
| 1818 | 1848 | ||
| 1819 | Allowed value are `todo', `search', `timeline' and `agenda'. | 1849 | Allowed value are `todo', `search' and `agenda'. |
| 1820 | 1850 | ||
| 1821 | This variable has no effect if `org-agenda-show-inherited-tags' | 1851 | This variable has no effect if `org-agenda-show-inherited-tags' |
| 1822 | is set to `always'. In that case, the agenda is aware of those | 1852 | is set to `always'. In that case, the agenda is aware of those |
| @@ -1825,7 +1855,8 @@ tags. | |||
| 1825 | The default value sets tags in every agenda type. Setting this | 1855 | The default value sets tags in every agenda type. Setting this |
| 1826 | option to nil will speed up non-tags agenda view a lot." | 1856 | option 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. |
| 1859 | If this number is positive, it specifies the column. If it is negative, | 1890 | If set to `auto', tags will be automatically aligned to the right |
| 1860 | it means that the tags should be flushright to that column. For example, | 1891 | edge of the window. |
| 1861 | -80 works well for a normal 80 character screen." | 1892 | |
| 1893 | If set to a positive number, tags will be left-aligned to that | ||
| 1894 | column. If set to a negative number, tags will be right-aligned | ||
| 1895 | to that column. For example, -80 works well for a normal 80 | ||
| 1896 | character 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 | |||
| 2683 | m Call `org-tags-view' to display headlines with tags matching | 2720 | m 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). |
| 2685 | M Like `m', but select only TODO entries, no ordinary headlines. | 2722 | M Like `m', but select only TODO entries, no ordinary headlines. |
| 2686 | L Create a timeline for the current buffer. | ||
| 2687 | e Export views to associated files. | 2723 | e Export views to associated files. |
| 2688 | s Search entries for keywords. | 2724 | s Search entries for keywords. |
| 2689 | S Search entries for keywords, only with TODO keywords. | 2725 | S 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 |
| 2906 | a Agenda for current week or day e Export agenda views | 2936 | a Agenda for current week or day > Remove restriction |
| 2907 | t List of all TODO entries T Entries with special TODO kwd | 2937 | t List of all TODO entries e Export agenda views |
| 2908 | m Match a TAGS/PROP/TODO query M Like m, but only TODO entries | 2938 | m Match a TAGS/PROP/TODO query T Entries with special TODO kwd |
| 2909 | s Search for keywords S Like s, but only TODO entries | 2939 | s Search for keywords M Like m, but only TODO entries |
| 2910 | L 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 | ||
| 3913 | the 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 | ||
| 3916 | text property `org-todo-blocked' to 'invisible, otherwise set it | ||
| 3917 | to 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. |
| 3892 | If this function returns nil, the current match should not be skipped. | 3942 | If 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 | |||
| 4023 | Only entries with a time stamp of today or later will be listed. | ||
| 4024 | |||
| 4025 | With `\\[universal-argument]' prefix, all unfinished TODO items will also be \ | ||
| 4026 | shown, | ||
| 4027 | under the current date. | ||
| 4028 | |||
| 4029 | If the buffer contains an active region, only check the region | ||
| 4030 | for 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. | ||
| 4118 | If NO-RANGES is non-nil, include only the start and end dates of a range, | ||
| 4119 | not every single day in the range. If FORCE-TODAY is non-nil, make | ||
| 4120 | sure that TODAY is included in the list. If INACTIVE is non-nil, also | ||
| 4121 | inactive time stamps (those in square brackets) are included. | ||
| 4122 | When 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 | ||
| 4466 | This command searches the agenda files, and in addition the files listed | 4371 | This command searches the agenda files, and in addition the files |
| 4467 | in `org-agenda-text-search-extra-files'." | 4372 | listed in `org-agenda-text-search-extra-files' unless a restriction lock |
| 4373 | is 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'.") | |||
| 4913 | This variable should not be set directly, but custom commands can bind it | 4829 | This variable should not be set directly, but custom commands can bind it |
| 4914 | in the options section.") | 4830 | in 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'. | ||
| 4918 | If yes, it returns the end position of this entry, causing agenda commands | ||
| 4919 | to skip the entry but continuing the search in the subtree. This is a | ||
| 4920 | function that can be put into `org-agenda-skip-function' for the duration | ||
| 4921 | of 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'. | ||
| 4930 | If yes, it returns the end position of this tree, causing agenda commands | ||
| 4931 | to 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'. | ||
| 4941 | If yes, it returns the end position of the current entry (NOT the tree), | ||
| 4942 | causing agenda commands to skip the entry but continuing the search in | ||
| 4943 | the subtree. This is a function that can be put into | ||
| 4944 | `org-agenda-skip-function' for the duration of a command. An important | ||
| 4945 | use 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. |
| 4955 | See `org-agenda-skip-if' for details." | 4834 | See `org-agenda-skip-if' for details." |
| @@ -4999,39 +4878,41 @@ keywords. Possible classes are: `todo', `done', `any'. | |||
| 4999 | If any of these conditions is met, this function returns the end point of | 4878 | If any of these conditions is met, this function returns the end point of |
| 5000 | the entity, causing the search to continue from there. This is a function | 4879 | the entity, causing the search to continue from there. This is a function |
| 5001 | that can be put into `org-agenda-skip-function' for the duration of a command." | 4880 | that 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 |
| 5041 | a list of TODO keywords, or a state symbol `todo' or `done' or | 4922 | a 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. |
| 5924 | See also the user option `org-agenda-clock-consistency-checks'." | 5813 | See 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. | ||
| 7093 | When called with a `\\[universal-argument]' prefix, restrict to | ||
| 7094 | the file which contains the item. | ||
| 7095 | Argument 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. |
| 7263 | If ERROR is non-nil, throw an error, otherwise just return nil. | 7181 | If ERROR is non-nil, throw an error, otherwise just return nil. |
| 7264 | Allowed types are `agenda' `timeline' `todo' `tags' `search'." | 7182 | Allowed 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. | ||
| 7346 | With 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'. | |||
| 8263 | With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \ | 8192 | With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \ |
| 8264 | log items, nothing else." | 8193 | log 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." | |||
| 9309 | The prefix ARG is passed to the `org-time-stamp' command and can therefore | 9241 | The prefix ARG is passed to the `org-time-stamp' command and can therefore |
| 9310 | be used to request time specification in the time stamp." | 9242 | be 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. |
| 9330 | ARG is passed through to `org-schedule'." | 9261 | ARG 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. |
| 9351 | ARG is passed through to `org-deadline'." | 9282 | ARG 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. |
| 9885 | The prefix arg is passed through to the command if possible." | 9816 | The 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. |
| 143 | If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get." | 145 | If \\='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 | ||
| 174 | a Select a file and attach it to the task, using `org-attach-method'. | 176 | a Select a file and attach it to the task, using `org-attach-method'. |
| 175 | c/m/l/y Attach a file using copy/move/link/symbolic-link method. | 177 | c/m/l/y Attach a file using copy/move/link/symbolic-link method. |
| 178 | u Attach a file from URL (downloading it). | ||
| 176 | n Create a new attachment, as an Emacs buffer. | 179 | n Create a new attachment, as an Emacs buffer. |
| 177 | z Synchronize the current task with its attachment | 180 | z 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. | |||
| 186 | D Delete all of a task's attachments. A safer way is | 189 | D 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 | ||
| 189 | s Set a specific attachment directory for this entry. | 192 | s Set a specific attachment directory for this entry or reset to default. |
| 190 | i Make children of the current entry inherit its attachment directory."))) | 193 | i 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. |
| 275 | The property defines the directory that is used for attachments | 280 | The property defines the directory that is used for attachments |
| 276 | of the entry." | 281 | of the entry. When called with `\\[universal-argument]', reset \ |
| 277 | (interactive) | 282 | the directory to |
| 278 | (let ((dir (org-entry-get nil "ATTACH_DIR"))) | 283 | the 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. |
| 368 | If VISIT-DIR is non-nil, visit the directory with dired. | 393 | If VISIT-DIR is non-nil, visit the directory with dired. |
| 369 | METHOD may be `cp', `mv', `ln', or `lns' default taken from | 394 | METHOD 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 | |||
| 144 | Anniversary descriptions include the point in time, when the | ||
| 145 | anniversary appears. This is, in its most general form, just the | ||
| 146 | date of the anniversary. Or more specific terms, like \"today\", | ||
| 147 | \"tomorrow\" or \"in n days\" are used to describe the time span. | ||
| 148 | |||
| 149 | If the anniversary happens in less than that number of days, the | ||
| 150 | specific description is used. Otherwise, the general one is | ||
| 151 | used." | ||
| 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. | ||
| 435 | The calculation of the anniversary description string is based on | ||
| 436 | the difference between the anniversary date, given as ANNIV-DATE, | ||
| 437 | and the date on which the entry appears in the agenda, given as | ||
| 438 | AGENDA-DATE. This makes it possible to have different entries | ||
| 439 | for the same event depending on if it occurs in the next few days | ||
| 440 | or 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'. | ||
| 243 | It should take a single argument, the bibtex entry (an alist as | ||
| 244 | returned by `org-bibtex-read'). The default value simply returns | ||
| 245 | the 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'. |
| 242 | This only has effect if `org-bibtex-prefix' is defined, so as to | 253 | This 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. | ||
| 89 | TEMPLATES is a template list, as in `org-capture-templates'. The | ||
| 90 | new format unifies all the date/week tree targets into one that | ||
| 91 | also 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, | |||
| 299 | you can escape ambiguous cases with a backward slash, e.g., \\%i." | 330 | you 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 | ||
| 565 | When called with a `C-0' (zero) prefix, insert a template at point. | 592 | When called with a `C-0' (zero) prefix, insert a template at point. |
| 566 | 593 | ||
| 594 | When called with a `C-1' (one) prefix, force prompting for a date when | ||
| 595 | a datetree entry is made. | ||
| 596 | |||
| 567 | ELisp programs can set KEYS to a string associated with a template | 597 | ELisp programs can set KEYS to a string associated with a template |
| 568 | in `org-capture-templates'. In this case, interactive selection | 598 | in `org-capture-templates'. In this case, interactive selection |
| 569 | will be bypassed. | 599 | will 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. |
| 871 | Store them in the capture property list." | 905 | Store 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. |
| 1015 | When FILE is a function, call it. When it is a form, evaluate | 1052 | When FILE is a function, call it. When it is a form, evaluate |
| 1016 | it. When it is a variable, retrieve the value. When it is | 1053 | it. When it is a variable, return its value. When it is |
| 1017 | a string, treat it as a file name, possibly expanding it | 1054 | a string, treat it as a file name, possibly expanding it |
| 1018 | according to `org-directory', and return it. If it is the empty | 1055 | according to `org-directory', and return it. If it is the empty |
| 1019 | string, however, return `org-default-notes-file'. In any other | 1056 | string, however, return `org-default-notes-file'. In any other |
| 1020 | case, raise an error." | 1057 | case, 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. |
| 1031 | FILE is a generalized file location, as handled by | 1068 | FILE 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." | |||
| 1523 | Lisp programs can force the template by setting KEYS to a string." | 1558 | Lisp 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. | ||
| 527 | Assume S in the English term to translate. Return S as-is if it | ||
| 528 | cannot 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) | 595 | Return marker position of the selected task. Raise an error if |
| 596 | there 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 | |||
| 668 | If not, show simply the clocked time like 01:50." | 678 | If 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. |
| 773 | Notification is shown only once." | 782 | Notification 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 | |||
| 1193 | the default behavior." | 1202 | the 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. |
| 1675 | UPDOWN tells whether to change `up' or `down'. | 1681 | UPDOWN tells whether to change `up' or `down'. |
| 1676 | Optional argument N tells to change by that many units." | 1682 | Optional 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. |
| 762 | Also sets `org-columns-top-level-marker' to the new position." | 761 | Also 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 | |||
| 940 | the current buffer." | 943 | the 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. | ||
| 1069 | A 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. | ||
| 1082 | An age is either computed from a given time-stamp, or indicated | 1066 | An age is either computed from a given time-stamp, or indicated |
| 1083 | as days/hours/minutes/seconds." | 1067 | as 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. |
| 1099 | If TIMES contains any time value expressed as a duration, return | 1085 | Return the result as a duration." |
| 1100 | the result as a duration. If it contains any H:M:S, use that | 1086 | (org-duration-from-minutes |
| 1101 | format 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. | ||
| 84 | This function works recursively. Files are returned in \"depth first\" | ||
| 85 | order, and files from each directory are sorted in alphabetical order. | ||
| 86 | Each file name appears in the returned list in its absolute form. | ||
| 87 | Optional argument INCLUDE-DIRECTORIES non-nil means also include in the | ||
| 88 | output 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 @@ | |||
| 107 | Counting starts at 1." | 150 | Counting 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. | ||
| 215 | Add key definitions to `minibuffer-local-map', which will be a | ||
| 216 | temporary 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. | ||
| 301 | You 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'. | ||
| 316 | If yes, it returns the end position of this entry, causing agenda commands | ||
| 317 | to skip the entry but continuing the search in the subtree. This is a | ||
| 318 | function that can be put into `org-agenda-skip-function' for the duration | ||
| 319 | of 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'. | ||
| 329 | If yes, it returns the end position of this tree, causing agenda commands | ||
| 330 | to 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'. | ||
| 341 | If yes, it returns the end position of the current entry (NOT the tree), | ||
| 342 | causing agenda commands to skip the entry but continuing the search in | ||
| 343 | the subtree. This is a function that can be put into | ||
| 344 | `org-agenda-skip-function' for the duration of a command. An important | ||
| 345 | use 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. |
| 370 | WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are | 451 | WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are |
| 371 | passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call | 452 | passed 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 |
| 373 | ignored in this case." | 454 | ignored 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. |
| 423 | Pass COLUMN and FORCE to `move-to-column'." | 504 | Pass 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 | |||
| 465 | effect, which variables to use depends on the Emacs version." | 546 | effect, 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'. | |||
| 501 | Implements `define-error' for older emacsen." | 582 | Implements `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 | |||
| 511 | attention to case differences." | 592 | attention 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. |
| 55 | If KEEP-RESTRICTION is non-nil, do not widen the buffer. | 55 | If KEEP-RESTRICTION is non-nil, do not widen the buffer. |
| 56 | When it is nil, the buffer will be widened to make sure an existing date | 56 | When it is nil, the buffer will be widened to make sure an existing date |
| 57 | tree can be found." | 57 | tree can be found. If it is the sympol `subtree-at-point', then the tree |
| 58 | will 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. |
| 85 | Compared to `org-datetree-find-date-create' this function creates | 94 | Compared to `org-datetree-find-date-create' this function creates |
| 86 | entries ordered by week instead of months. | 95 | entries ordered by week instead of months. |
| 87 | If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it | 96 | When it is nil, the buffer will be widened to make sure an existing date |
| 88 | is nil, the buffer will be widened to make sure an existing date | 97 | tree can be found. If it is the sympol `subtree-at-point', then the tree |
| 89 | tree can be found." | 98 | will 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. | ||
| 62 | See `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 | |||
| 73 | Each entry has the form (UNIT . MODIFIER). | ||
| 74 | |||
| 75 | In a duration string, a number followed by UNIT is multiplied by | ||
| 76 | the specified number of MODIFIER to obtain a duration in minutes. | ||
| 77 | |||
| 78 | For 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 | |||
| 87 | is meaningful if you work an average of 8 hours per day, 5 days | ||
| 88 | a week, 4 weeks a month and 10 months a year. | ||
| 89 | |||
| 90 | When setting this variable outside the Customize interface, make | ||
| 91 | sure 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 | |||
| 108 | The value can be set to, respectively, the symbols `h:mm:ss' or | ||
| 109 | `h:mm', which means a duration is expressed as, respectively, | ||
| 110 | a \"H:MM:SS\" or \"H:MM\" string. | ||
| 111 | |||
| 112 | Alternatively, the value can be a list of entries following the | ||
| 113 | pattern: | ||
| 114 | |||
| 115 | (UNIT . REQUIRED?) | ||
| 116 | |||
| 117 | UNIT is a unit string, as defined in `org-duration-units'. The | ||
| 118 | time duration is formatted using only the time components that | ||
| 119 | are specified here. | ||
| 120 | |||
| 121 | Units with a zero value are skipped, unless REQUIRED? is non-nil. | ||
| 122 | In that case, the unit is always used. | ||
| 123 | |||
| 124 | Eventually, the list can contain one of the following special | ||
| 125 | entries: | ||
| 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 | |||
| 141 | For example, | ||
| 142 | |||
| 143 | ((\"d\" . nil) (\"h\" . t) (\"min\" . t)) | ||
| 144 | |||
| 145 | means a duration longer than a day is expressed in days, hours | ||
| 146 | and minutes, whereas a duration shorter than a day is always | ||
| 147 | expressed in hours and minutes, even when shorter than an hour. | ||
| 148 | |||
| 149 | On the other hand, the value | ||
| 150 | |||
| 151 | ((\"d\" . nil) (\"min\" . nil)) | ||
| 152 | |||
| 153 | means a duration longer than a day is expressed in days and | ||
| 154 | minutes, whereas a duration shorter than a day is expressed | ||
| 155 | entirely in minutes, even when longer than an hour. | ||
| 156 | |||
| 157 | The following format | ||
| 158 | |||
| 159 | ((\"d\" . nil) (special . h:mm)) | ||
| 160 | |||
| 161 | means that any duration longer than a day is expressed with both | ||
| 162 | a \"d\" unit and a \"H:MM\" part, whereas a duration shorter than | ||
| 163 | a day is expressed only as a \"H:MM\" string. | ||
| 164 | |||
| 165 | Eventually, | ||
| 166 | |||
| 167 | ((\"d\" . nil) (\"h\" . nil) (special . 2)) | ||
| 168 | |||
| 169 | expresses a duration longer than a day as a decimal number, with | ||
| 170 | a 2-digits fractional part, of \"d\" unit. A duration shorter | ||
| 171 | than 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. | ||
| 201 | See `org-duration--h:mm:ss-re' to only match the latter. Hours | ||
| 202 | can 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. | ||
| 207 | See `org-duration--h:mm-re' to also support H:MM format. Hours | ||
| 208 | can use any number of digits.") | ||
| 209 | |||
| 210 | (defvar org-duration--unit-re nil | ||
| 211 | "Regexp matching a duration with an unit. | ||
| 212 | Allowed units are defined in `org-duration-units'. Match group | ||
| 213 | 1 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. | ||
| 217 | Allowed 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. | ||
| 221 | Allowed units are defined in `org-duration-units'. Match group | ||
| 222 | 1 contains units part. Match group 2 contains H:MM or H:MM:SS | ||
| 223 | part.") | ||
| 224 | |||
| 225 | (defun org-duration--modifier (unit &optional canonical) | ||
| 226 | "Return modifier associated to string UNIT. | ||
| 227 | When 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 | |||
| 272 | When optional argument CANONICAL is non-nil, ignore | ||
| 273 | `org-duration-units' and use standard time units value. | ||
| 274 | |||
| 275 | A bare number is translated into minutes. The empty string is | ||
| 276 | translated into 0.0. | ||
| 277 | |||
| 278 | Return value as a float. Raise an error if duration format is | ||
| 279 | not 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 | |||
| 309 | Format duration according to `org-duration-format' or FMT, when | ||
| 310 | non-nil. | ||
| 311 | |||
| 312 | When optional argument CANONICAL is non-nil, ignore | ||
| 313 | `org-duration-units' and use standard time units value. | ||
| 314 | |||
| 315 | Raise 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 | |||
| 422 | TIMES is a list of duration strings. | ||
| 423 | |||
| 424 | Return nil if any duration is expressed with units, as defined in | ||
| 425 | `org-duration-units'. Otherwise, if any duration is expressed | ||
| 426 | with \"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. |
| 463 | Class is either `element' or `object'. Optional argument PARENT | 462 | Class is either `element' or `object'. Optional argument PARENT |
| 464 | is the element or object containing DATUM. It defaults to the | 463 | is the element or object containing DATUM. It defaults to the |
| @@ -2703,7 +2702,7 @@ keywords. Otherwise, return nil. | |||
| 2703 | Assume point is at the first tilde marker." | 2702 | Assume 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 | |||
| 3720 | Assume point is at the first equal sign marker." | 3719 | Assume 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 | |||
| 4793 | with `org-element--cache-compare'. This cache is used in | 4787 | with `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. | ||
| 4798 | Key is an element, as returned by `org-element-at-point', and | ||
| 4799 | value is an alist where each association is: | ||
| 4800 | |||
| 4801 | (PARENT COMPLETEP . OBJECTS) | ||
| 4802 | |||
| 4803 | where PARENT is an element or object, COMPLETEP is a boolean, | ||
| 4804 | non-nil when all direct children of parent are already cached and | ||
| 4805 | OBJECTS is a list of such children, as objects, from farthest to | ||
| 4806 | closest. | ||
| 4807 | |||
| 4808 | In the following example, \\alpha, bold object and \\beta are | ||
| 4809 | contained within a paragraph | ||
| 4810 | |||
| 4811 | \\alpha *\\beta* | ||
| 4812 | |||
| 4813 | If the paragraph is completely parsed, OBJECTS-DATA will be | ||
| 4814 | |||
| 4815 | ((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT) | ||
| 4816 | (BOLD-OBJECT t ENTITY-OBJECT)) | ||
| 4817 | |||
| 4818 | whereas in a partially parsed paragraph, it could be | ||
| 4819 | |||
| 4820 | ((PARAGRAPH nil ENTITY-OBJECT)) | ||
| 4821 | |||
| 4822 | This 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." |
| 5062 | When optional argument DATA is non-nil, assume is it object data | 5028 | (when (org-element--cache-active-p) |
| 5063 | relative 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. |
| 5087 | Assume ELEMENT belongs to cache and that a cache is active." | 5046 | Assume 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" "¥" "¥") | 295 | ("yen" "\\textyen{}" nil "¥" "yen" "¥" "¥") |
| 296 | ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") | 296 | ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") |
| 297 | ("EUR" "\\texteuro{}" nil "€" "EUR" "EUR" "€") | 297 | ("EUR" "\\texteuro{}" nil "€" "EUR" "EUR" "€") |
| 298 | ("dollar" "\\$" nil "$" "$" "$" "$") | ||
| 299 | ("USD" "\\$" nil "$" "$" "$" "$") | ||
| 298 | 300 | ||
| 299 | "** Property Marks" | 301 | "** Property Marks" |
| 300 | ("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©") | 302 | ("copy" "\\textcopyright{}" nil "©" "(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 | ||
| 59 | Message-Ids to article numbers by querying the .overview file. | ||
| 60 | Normally, this translation is done by querying the IMAP server, | ||
| 61 | which is usually very fast. Unfortunately, some (maybe badly | ||
| 62 | configured) IMAP servers don't support this operation quickly. | ||
| 63 | So if following a link to a Gnus article takes ages, try setting | ||
| 64 | this 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 | |
| 83 | MESSAGE-ID is the message-id header field that identifies the | 68 | ;;; Implementation |
| 84 | message. 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. |
| 131 | See `org-link-parameters' for details about PATH, DESC and FORMAT." | 131 | See `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 | ||
| 2251 | Return t when things worked, nil when we are not in an item, or | 2251 | Return t when things worked, nil when we are not in an item, or |
| 2252 | item is invisible." | 2252 | item 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. | ||
| 3571 | LIST is as returned by `org-list-parse-list'. PARAMS is a property list | ||
| 3572 | with 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. |
| 3560 | LIST is as returned by `org-list-to-lisp'. PARAMS is a property | 3590 | LIST 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. | ||
| 330 | NAME is a string identifying the counter. | ||
| 331 | |||
| 332 | When non-nil, optional argument ACTION is a string. | ||
| 333 | |||
| 334 | If the string is \"-\", keep the NAME counter at its current | ||
| 335 | value, i.e. do not increment. | ||
| 336 | |||
| 337 | If the string represents an integer, set the counter to this number. | ||
| 338 | |||
| 339 | Any 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 | |||
| 51 | SEPARATORS is a regular expression. When nil, it defaults to | ||
| 52 | \"[ \f\t\n\r\v]+\". | ||
| 53 | |||
| 54 | Unlike to `split-string', matching SEPARATORS at the beginning | ||
| 55 | and 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. | ||
| 65 | This function takes into consideration `invisible' and `display' | ||
| 66 | text 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. | ||
| 128 | Unlike 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. |
| 50 | Otherwise return nil." | 134 | Otherwise 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. |
| 393 | SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" | 393 | SCHEDULED: 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> | ||
| 887 | The LaTeX environment is copied into a new buffer. Major mode is | ||
| 888 | set to the one associated to \"latex\" in `org-src-lang-modes', | ||
| 889 | or to `latex-mode' if there is none. | ||
| 890 | |||
| 891 | When done, exit with `\\[org-edit-src-exit]'. The edited text \ | ||
| 892 | will then replace | ||
| 893 | the 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 | |||
| 85 | In the optimized version, the table editor takes over all simple keys that | 87 | In the optimized version, the table editor takes over all simple keys that |
| 86 | normally just insert a character. In tables, the characters are inserted | 88 | normally just insert a character. In tables, the characters are inserted |
| 87 | in a way to minimize disturbing the table structure (i.e. in overwrite mode | 89 | in a way to minimize disturbing the table structure (i.e. in overwrite mode |
| 88 | for empty fields). Outside tables, the correct binding of the keys is | 90 | for empty fields). Outside tables, the correct binding of the keys is |
| 89 | restored. | 91 | restored. |
| 90 | 92 | ||
| 91 | The default for this option is t if the optimized version is also used in | 93 | Changing this variable requires a restart of Emacs to become |
| 92 | Org mode. See the variable `org-enable-table-editor' for details. Changing | 94 | effective." |
| 93 | this 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. |
| 209 | This only happens when typing immediately after a field motion | 210 | This only happens when typing immediately after a field motion |
| 210 | command (TAB, S-TAB or RET). | 211 | command (TAB, S-TAB or RET)." |
| 211 | Only 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." | |||
| 293 | The default value is `hours', and will output the results as a | 293 | The default value is `hours', and will output the results as a |
| 294 | number of hours. Other allowed values are `seconds', `minutes' and | 294 | number 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 |
| 296 | days." | 296 | days. `hh:mm' selects to use hours and minutes, ignoring seconds. |
| 297 | The `U' flag in a table formula will select this specific format for | ||
| 298 | a 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. | ||
| 309 | So 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. |
| 1332 | Only data lines count for this." | 1343 | Only 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. |
| 2005 | This is mainly useful for fields that contain hidden parts. When called | 2011 | This is mainly useful for fields that contain hidden parts. |
| 2006 | with a `\\[universal-argument]' prefix, just make the full field \ | 2012 | |
| 2007 | visible so that it can be | 2013 | When called with a `\\[universal-argument]' prefix, just make the full field |
| 2008 | edited in place." | 2014 | visible so that it can be edited in place. |
| 2015 | |||
| 2016 | When called with a `\\[universal-argument] \\[universal-argument]' prefix, \ | ||
| 2017 | toggle `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 | ||
| 2674 | This function can also be called from Lisp programs and offers | 2684 | This function can also be called from Lisp programs and offers |
| 2675 | additional arguments: EQUATION can be the formula to apply. If this | 2685 | additional arguments: EQUATION can be the formula to apply. If this |
| 2676 | argument is given, the user will not be prompted. SUPPRESS-ALIGN is | 2686 | argument is given, the user will not be prompted. |
| 2677 | used to speed-up recursive calls by by-passing unnecessary aligns. | 2687 | |
| 2688 | SUPPRESS-ALIGN is used to speed-up recursive calls by by-passing | ||
| 2689 | unnecessary aligns. | ||
| 2690 | |||
| 2678 | SUPPRESS-CONST suppresses the interpretation of constants in the | 2691 | SUPPRESS-CONST suppresses the interpretation of constants in the |
| 2679 | formula, assuming that this has been done already outside the function. | 2692 | formula, assuming that this has been done already outside the |
| 2680 | SUPPRESS-STORE means the formula should not be stored, either because | 2693 | function. |
| 2681 | it is already stored, or because it is a modified equation that should | 2694 | |
| 2682 | not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to | 2695 | SUPPRESS-STORE means the formula should not be stored, either |
| 2683 | `org-table-analyze'." | 2696 | because it is already stored, or because it is a modified |
| 2697 | equation that should not overwrite the stored one. | ||
| 2698 | |||
| 2699 | SUPPRESS-ANALYSIS prevents analyzing the table and checking | ||
| 2700 | location 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. |
| 7 | Inserted by installing Org mode or when a release is made." | 7 | Inserted 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. |
| 13 | Inserted by installing Org or when a release is made." | 13 | Inserted 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.") | |||
| 526 | An archived subtree does not open during visibility cycling, and does | 535 | An archived subtree does not open during visibility cycling, and does |
| 527 | not contribute to the agenda listings.") | 536 | not 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> |
| 532 | An entry can be toggled between COMMENT and normal with | 542 | An 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. | ||
| 1730 | When nil, such lines will be treated like ordinary lines. | ||
| 1731 | |||
| 1732 | When equal to the symbol `optimized', the table editor will be optimized to | ||
| 1733 | do 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. | ||
| 1740 | Optimization requires replacing the functions `self-insert-command', | ||
| 1741 | `delete-char', and `backward-delete-char' in Org buffers, with a | ||
| 1742 | slight (in fact: unnoticeable) speed impact for normal typing. Org is very | ||
| 1743 | good at guessing when a re-align will be necessary, but you can always | ||
| 1744 | force one with `\\[org-ctrl-c-ctrl-c]'. | ||
| 1745 | |||
| 1746 | If you would like to use the optimized version in Org mode, but the | ||
| 1747 | un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. | ||
| 1748 | |||
| 1749 | This variable can be used to turn on and off the table editor during a session, | ||
| 1750 | but in order to toggle optimization, a restart is required. | ||
| 1751 | |||
| 1752 | See 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. |
| 1761 | If this is set, then, like in the Emacs command loop, 20 consecutive | 1739 | If 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) | |||
| 1830 | as arguments." | 1807 | as 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. |
| 1952 | When nil, the link location will be used. This function must take | 1931 | This function must take two parameters: the first one is the |
| 1953 | two parameters: the first one is the link, the second one is the | 1932 | link, the second one is the description generated by |
| 1954 | description generated by `org-insert-link'. The function should | 1933 | `org-insert-link'. The function should return the description to |
| 1955 | return the description to use." | 1934 | use." |
| 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." | |||
| 2074 | A longer mouse click will still set point. Needs to be set | 2053 | A longer mouse click will still set point. Needs to be set |
| 2075 | before org.el is loaded." | 2054 | before 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) | |||
| 2554 | into the path. In this case, you can also stop the completion after | 2533 | into the path. In this case, you can also stop the completion after |
| 2555 | the file name, to get entries inserted as top level in the file. | 2534 | the file name, to get entries inserted as top level in the file. |
| 2556 | 2535 | ||
| 2557 | When `full-file-path', include the full file path." | 2536 | When `full-file-path', include the full file path. |
| 2537 | |||
| 2538 | When `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. | ||
| 3258 | This is also used when Org mode generates a time duration. | ||
| 3259 | |||
| 3260 | The value can be a single format string containing two | ||
| 3261 | %-sequences, which will be filled with the number of hours and | ||
| 3262 | minutes in that order. | ||
| 3263 | |||
| 3264 | Alternatively, the value can be a plist associating any of the | ||
| 3265 | keys :years, :months, :weeks, :days, :hours or :minutes with | ||
| 3266 | format strings. The time duration is formatted using only the | ||
| 3267 | time components that are needed and concatenating the results. | ||
| 3268 | If a time unit in absent, it falls back to the next smallest | ||
| 3269 | unit. | ||
| 3270 | |||
| 3271 | The keys :require-years, :require-months, :require-days, | ||
| 3272 | :require-weeks, :require-hours, :require-minutes are also | ||
| 3273 | meaningful. A non-nil value for these keys indicates that the | ||
| 3274 | corresponding time component should always be included, even if | ||
| 3275 | its value is 0. | ||
| 3276 | |||
| 3277 | |||
| 3278 | For example, | ||
| 3279 | |||
| 3280 | (:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\" | ||
| 3281 | :require-minutes t) | ||
| 3282 | |||
| 3283 | means durations longer than a day will be expressed in days, | ||
| 3284 | hours and minutes, and durations less than a day will always be | ||
| 3285 | expressed in hours and minutes (even for durations less than an | ||
| 3286 | hour). | ||
| 3287 | |||
| 3288 | The value | ||
| 3289 | |||
| 3290 | (:days \"%dd\" :minutes \"%dm\") | ||
| 3291 | |||
| 3292 | means durations longer than a day will be expressed in days and | ||
| 3293 | minutes, and durations less than a day will be expressed entirely | ||
| 3294 | in 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. | ||
| 3334 | See `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. | ||
| 3342 | E.g. by default, one day is considered to be a 8 hours effort, | ||
| 3343 | so a task that has been clocked for 16 hours will be displayed | ||
| 3344 | as during 2 days in the clock display or in the clocktable. | ||
| 3345 | |||
| 3346 | See `org-effort-durations' on how to set effort durations | ||
| 3347 | and `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, | ||
| 3356 | or when Org mode generates a time duration, if | ||
| 3357 | `org-time-clocksum-use-fractional' is enabled. | ||
| 3358 | |||
| 3359 | The value can be a single format string containing one | ||
| 3360 | %-sequence, which will be filled with the number of hours as | ||
| 3361 | a float. | ||
| 3362 | |||
| 3363 | Alternatively, the value can be a plist associating any of the | ||
| 3364 | keys :years, :months, :weeks, :days, :hours or :minutes with | ||
| 3365 | a format string. The time duration is formatted using the | ||
| 3366 | largest time unit which gives a non-zero integer part. If all | ||
| 3367 | specified formats have zero integer part, the smallest time unit | ||
| 3368 | is 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. |
| 3386 | This variable governs the display in sparse trees and in the agenda. | 3239 | This 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: | |||
| 4470 | 3 The leading marker like * or /, indicating the type of highlighting | 4323 | 3 The leading marker like * or /, indicating the type of highlighting |
| 4471 | 4 The text between the emphasis markers, not including the markers | 4324 | 4 The text between the emphasis markers, not including the markers |
| 4472 | 5 The character after the match, empty at the end of a line") | 4325 | 5 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. |
| 4538 | This is a list with five entries. Terminology: In an emphasis string | 4356 | This is a list with five entries. Terminology: In an emphasis string |
| 4539 | like \" *strong word* \", we call the initial space PREMATCH, the final | 4357 | like \" *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. |
| 4650 | If TABLE-TYPE is non-nil, also check for table.el-type tables. | 4468 | If TABLE-TYPE is non-nil, also check for table.el-type tables." |
| 4651 | If `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. |
| 4670 | Assume point is already in a table. If `org-enable-table-editor' | 4484 | Assume point is already in a table." |
| 4671 | is 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)) | 5256 | This 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 | |||
| 5270 | FILE can be a file name or URL. | ||
| 5271 | |||
| 5272 | If FILE is a URL, download the contents. If the URL contents are | ||
| 5273 | already cached in the `org--file-cache' hash table, the download step | ||
| 5274 | is skipped. | ||
| 5275 | |||
| 5276 | If NOERROR is non-nil, ignore the error when unable to read the FILE | ||
| 5277 | from file or URL. | ||
| 5278 | |||
| 5279 | If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version | ||
| 5280 | is 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. |
| 6041 | See also the `org-block' face." | 5907 | See 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." | |||
| 7837 | When NEXT is non-nil, check the next line instead." | 7699 | When 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. | ||
| 7704 | When optional argument PARENT is non-nil, consider parent | ||
| 7705 | headline 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 | ||
| 7843 | If point is at the beginning of a heading or a list item, insert | 7728 | If point is at the beginning of a heading, insert a new heading |
| 7844 | a new heading or a new item above the current one. When at the | 7729 | or a new headline above the current one. When at the beginning |
| 7845 | beginning of a regular line of text, turn it into a heading. | 7730 | of a regular line of text, turn it into a heading. |
| 7846 | 7731 | ||
| 7847 | If point is in the middle of a line, split it and create a new | 7732 | If point is in the middle of a line, split it and create a new |
| 7848 | headline/item with the text in the current line after point (see | 7733 | headline 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 |
| 7850 | a special case, on a headline, splitting can only happen on the | 7735 | a special case, on a headline, splitting can only happen on the |
| 7851 | title itself. E.g., this excludes breaking stars or tags. | 7736 | title itself. E.g., this excludes breaking stars or tags. |
| @@ -7869,186 +7754,107 @@ command. | |||
| 7869 | When optional argument TOP is non-nil, insert a level 1 heading, | 7754 | When optional argument TOP is non-nil, insert a level 1 heading, |
| 7870 | unconditionally." | 7755 | unconditionally." |
| 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. |
| 8020 | So this will delete or add empty lines." | 7823 | So 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. |
| 8031 | When NO-TAGS is non-nil, don't include tags. | 7836 | When NO-TAGS is non-nil, don't include tags. |
| 8032 | When NO-TODO is non-nil, don't include TODO keywords." | 7837 | When NO-TODO is non-nil, don't include TODO keywords. |
| 7838 | When NO-PRIORITY is non-nil, don't include priority cookie. | ||
| 7839 | When 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'. |
| 8277 | LEVEL is a current level, CHANGE is by how much the level should be | 8083 | LEVEL is a current level, CHANGE is by how much the level should |
| 8278 | modified. Even if CHANGE is nil, LEVEL may be returned modified because | 8084 | be modified. Even if CHANGE is nil, LEVEL may be returned |
| 8279 | even level numbers will become the next higher odd number." | 8085 | modified because even level numbers will become the next higher |
| 8086 | odd 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'. |
| 8981 | Optional argument WITH-CASE means sort case-sensitively." | 8788 | Optional 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 |
| 9266 | orgstruct(++)-mode." | 9069 | orgstruct(++)-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. | |||
| 10343 | A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ | 10146 | A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ |
| 10344 | prefix negates `org-keep-stored-link-after-insertion'. | 10147 | prefix negates `org-keep-stored-link-after-insertion'. |
| 10345 | 10148 | ||
| 10346 | If `org-make-link-description-function' is non-nil, this function will be | ||
| 10347 | called with the link target, and the result will be the default | ||
| 10348 | link description. | ||
| 10349 | |||
| 10350 | If the LINK-LOCATION parameter is non-nil, this value will be used as | 10149 | If the LINK-LOCATION parameter is non-nil, this value will be used as |
| 10351 | the link location instead of reading one interactively. | 10150 | the link location instead of reading one interactively. |
| 10352 | 10151 | ||
| 10353 | If the DEFAULT-DESCRIPTION parameter is non-nil, this value will be used | 10152 | If the DEFAULT-DESCRIPTION parameter is non-nil, this value will |
| 10354 | as the default description." | 10153 | be used as the default description. Otherwise, if |
| 10154 | `org-make-link-description-function' is non-nil, this function | ||
| 10155 | will be called with the link target, and the result will be the | ||
| 10156 | default 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: | |||
| 11019 | White spaces are not significant." | 10818 | White 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 | |||
| 12998 | Return the repeater, as a string, or nil. Also return nil when | ||
| 12999 | this function is called before first heading. | ||
| 13000 | |||
| 13001 | When optional argument TIMESTAMP is a string, extract the | ||
| 13002 | repeater 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 \ | ||
| 13274 | has been set" | 13103 | has 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 \ | ||
| 13294 | enough to shift date past today. Continue? " | 13124 | enough 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. | |||
| 14235 | As a special case, it can also be set to t (respectively nil) in | 14066 | As a special case, it can also be set to t (respectively nil) in |
| 14236 | order to match all (respectively none) headline. | 14067 | order to match all (respectively none) headline. |
| 14237 | 14068 | ||
| 14238 | When TODO-ONLY is non-nil, only lines with a not-done TODO | 14069 | When TODO-ONLY is non-nil, only lines with a TODO keyword are |
| 14239 | keyword are included in the output. | 14070 | included in the output. |
| 14240 | 14071 | ||
| 14241 | START-LEVEL can be a string with asterisks, reducing the scope to | 14072 | START-LEVEL can be a string with asterisks, reducing the scope to |
| 14242 | headlines matching this string." | 14073 | headlines 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. |
| 14879 | If ONOFF is `on' or `off', don't toggle but set to this state." | 14710 | If 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. |
| 16041 | VALUES should be a list of strings. Spaces will be protected." | 15866 | VALUES 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 | 17507 | The optional ZONE is omitted or nil for Emacs local time, t for |
| 17688 | (apply 'encode-time (org-parse-time-string s)) | 17508 | Universal Time, ‘wall’ for system wall clock time, or a string as |
| 17689 | (error (error "Bad timestamp `%s'%s\nError was: %s" | 17509 | in 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))) | 17514 | The optional ZONE is omitted or nil for Emacs local time, t for |
| 17515 | Universal Time, ‘wall’ for system wall clock time, or a string as | ||
| 17516 | in 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. |
| 17961 | With prefix ARG, change that many days." | 17781 | With 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. |
| 17970 | With prefix ARG, change that many days." | 17790 | With 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 | ||
| 17980 | When optional argument INACTIVE-OK is non-nil, also consider | 17800 | By default, the function only consider syntactically valid active |
| 17981 | inactive timestamps. | 17801 | timestamps. However, the caller may have a broader definition |
| 17802 | for timestamps. As a consequence, optional argument EXTENDED can | ||
| 17803 | be set to the following values | ||
| 17982 | 17804 | ||
| 17983 | When this function returns a non-nil value, match data is set | 17805 | `inactive' |
| 17984 | according to `org-ts-regexp3' or `org-ts-regexp2', depending on | 17806 | |
| 17985 | INACTIVE-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 | |||
| 17820 | For backward-compatibility with Org 9.0, every other non-nil | ||
| 17821 | value is equivalent to `inactive'. | ||
| 17822 | |||
| 17823 | When at a timestamp, return the position of the point as a symbol | ||
| 17824 | among `bracket', `after', `year', `month', `hour', `minute', | ||
| 17825 | `day' or a number of character from the last know part of the | ||
| 17826 | time stamp. | ||
| 17827 | |||
| 17828 | When 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 |
| 18042 | in the timestamp determines what will be changed. | 17896 | in the timestamp determines what will be changed. |
| 18043 | When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." | 17897 | When 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\"." | |||
| 18226 | If there is a time stamp in the current line, go to that date. | 18080 | If there is a time stamp in the current line, go to that date. |
| 18227 | A prefix ARG can be used to force the current date." | 18081 | A 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. |
| 18253 | If there is already a time stamp at the cursor position, update it." | 18104 | If 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. | ||
| 18286 | The 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. | ||
| 18378 | If the string is just a number, interpret it as minutes. | ||
| 18379 | In fact, the first hh:mm or number in the string will be taken, | ||
| 18380 | there can be extra stuff in the string. | ||
| 18381 | If 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 | |||
| 18448 | A bare number is interpreted as minutes, modifiers can be set by | ||
| 18449 | customizing `org-effort-durations' (which see). | ||
| 18450 | |||
| 18451 | Entries 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. | ||
| 19418 | COMMANDS 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. |
| 20084 | Hook functions are called in sequence until a valid handler is | 19821 | Hook functions are called in sequence until a valid handler is |
| 20085 | found. | 19822 | found. |
| @@ -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. | ||
| 20314 | COMMANDS 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. |
| 20322 | This uses the `org-mode-transpose-word-syntax-table' syntax | 20052 | This 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. |
| 20838 | Optional argument N tells to change by that many units." | 20559 | Optional 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. |
| 20847 | Optional argument N tells to change by that many units." | 20568 | Optional 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'. | |||
| 20938 | When in a source code block, call `org-edit-src-code'. | 20659 | When in a source code block, call `org-edit-src-code'. |
| 20939 | When in a fixed-width region, call `org-edit-fixed-width-region'. | 20660 | When in a fixed-width region, call `org-edit-fixed-width-region'. |
| 20940 | When in an export block, call `org-edit-export-block'. | 20661 | When in an export block, call `org-edit-export-block'. |
| 20662 | When in a LaTeX environment, call `org-edit-latex-environment'. | ||
| 20941 | When at an #+INCLUDE keyword, visit the included file. | 20663 | When at an #+INCLUDE keyword, visit the included file. |
| 20942 | When at a footnote reference, call `org-edit-footnote-reference' | 20664 | When at a footnote reference, call `org-edit-footnote-reference' |
| 20943 | On a link, call `ffap' to visit the link at point. | 20665 | On 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>\ |
| 21196 | Use `\\[org-edit-special]' to edit table.el tables")) | 20921 | Use `\\[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. |
| 21484 | Calls `org-insert-heading' or `org-table-wrap-region', depending | 21209 | Calls `org-insert-heading', `org-insert-item' or |
| 21485 | on context. See the individual commands for more information." | 21210 | `org-table-wrap-region', depending on context. When called with |
| 21486 | (interactive) | 21211 | an 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. | ||
| 22022 | This ignores character with invisibility property `org-link', and also | ||
| 22023 | characters with property `org-cwidth', because these will become invisible | ||
| 22024 | upon 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. |
| 22046 | If the string is shorter or has length MAXLENGTH, just return the | 21747 | If the string is shorter or has length MAXLENGTH, just return the |
| @@ -22166,7 +21867,7 @@ wrapped to the length of that word. | |||
| 22166 | IF WIDTH is nil and LINES is non-nil, the string is forced into at most that | 21867 | IF WIDTH is nil and LINES is non-nil, the string is forced into at most that |
| 22167 | many lines, whatever width that takes. | 21868 | many lines, whatever width that takes. |
| 22168 | The return value is a list of lines, without newlines at the end." | 21869 | The 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. | ||
| 22198 | SEPARATORS is a regular expression. | ||
| 22199 | No empty strings are returned if there are matches at the beginning | ||
| 22200 | and 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 | ||
| 23194 | This function only applies to comment blocks, comments, example | 22881 | This function only applies to comment blocks, comments, example |
| @@ -23203,126 +22890,160 @@ width for filling. | |||
| 23203 | 22890 | ||
| 23204 | For convenience, when point is at a plain list, an item or | 22891 | For convenience, when point is at a plain list, an item or |
| 23205 | a footnote definition, try to fill the first paragraph within." | 22892 | a 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 | |||
| 23000 | This function only applies to comment blocks, comments, example | ||
| 23001 | blocks and paragraphs. Also, as a special case, re-align table | ||
| 23002 | when point is at one. | ||
| 23003 | |||
| 23004 | For convenience, when point is at a plain list, an item or | ||
| 23005 | a footnote definition, try to fill the first paragraph within. | ||
| 23006 | |||
| 23007 | If JUSTIFY is non-nil (interactively, with prefix argument), | ||
| 23008 | justify as well. If `sentence-end-double-space' is non-nil, then | ||
| 23009 | period followed by one space does not end a sentence, so don't | ||
| 23010 | break a line there. The variable `fill-column' controls the | ||
| 23011 | width for filling. | ||
| 23012 | |||
| 23013 | The REGION argument is non-nil if called interactively; in that | ||
| 23014 | case, if Transient Mark mode is enabled and the mark is active, | ||
| 23015 | fill each of the elements in the active region, instead of just | ||
| 23016 | filling 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." | |||
| 23874 | This will call `forward-sentence' or `org-table-end-of-field', | 23595 | This will call `forward-sentence' or `org-table-end-of-field', |
| 23875 | depending on context." | 23596 | depending 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 | |||
| 346 | It only makes sense when export charset is `utf-8'. It is nil by | 345 | It only makes sense when export charset is `utf-8'. It is nil by |
| 347 | default since it requires ascii-art-to-unicode.el package. You | 346 | default since it requires \"ascii-art-to-unicode.el\" package, |
| 348 | can download it here: | 347 | available 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: | |||
| 404 | The function should return either the string to be exported or | 401 | The function should return either the string to be exported or |
| 405 | nil to ignore the inline task." | 402 | nil 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 | |||
| 1696 | to the function `org-html-htmlize-region-for-paste' will | 1743 | to the function `org-html-htmlize-region-for-paste' will |
| 1697 | produce code that uses these same face definitions." | 1744 | produce 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. |
| 1767 | INFO is a plist used as a communication channel." | 1815 | INFO 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 | "\"" """ (org-html-encode-plain-text str)))) | 1819 | "\"" """ (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 "‎")) |
| 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." | |||
| 1859 | INFO is a plist used as a communication channel." | 1910 | INFO 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. |
| 2843 | INFO is a plist used as a communication channel. LINK is an | 2911 | INFO 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. | ||
| 3139 | When ARG1 is a string, use it as the start parameter for ordered | ||
| 3140 | lists." | ||
| 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. |
| 3157 | CONTENTS is the contents of the list. INFO is a plist holding | 3205 | CONTENTS is the contents of the list. INFO is a plist holding |
| 3158 | contextual information." | 3206 | contextual 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 | |||
| 3317 | contextual information." | 3378 | contextual 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 | ||
| 347 | TIMESTAMP is a timestamp object. KEYWORD is added in front of | 347 | TIMESTAMP 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), | |||
| 352 | or the day by one (if it does not contain a time) when no | 352 | or the day by one (if it does not contain a time) when no |
| 353 | explicit ending time is specified. | 353 | explicit ending time is specified. |
| 354 | 354 | ||
| 355 | When optional argument UTC is non-nil, time will be expressed in | 355 | When optional argument TZ is non-nil, timezone data time will be |
| 356 | Universal Time, ignoring `org-icalendar-date-time-format'." | 356 | added to the timestamp. It can be the string \"UTC\", to use UTC |
| 357 | time, or a string in the IANA TZ database | ||
| 358 | format (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 | ||
| 632 | ENTRY is either a headline or an inlinetask element. TIMESTAMP | 644 | ENTRY is either a headline or an inlinetask element. TIMESTAMP |
| @@ -635,7 +647,8 @@ is the unique identifier for the event. SUMMARY defines a short | |||
| 635 | summary or subject for the event. LOCATION defines the intended | 647 | summary or subject for the event. LOCATION defines the intended |
| 636 | venue for the event. DESCRIPTION provides the complete | 648 | venue for the event. DESCRIPTION provides the complete |
| 637 | description of the event. CATEGORIES defines the categories the | 649 | description of the event. CATEGORIES defines the categories the |
| 638 | event belongs to. | 650 | event belongs to. TIMEZONE specifies a time zone for this event |
| 651 | only. | ||
| 639 | 652 | ||
| 640 | Return VEVENT component as a string." | 653 | Return 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 | ||
| 670 | ENTRY is either a headline or an inlinetask element. UID is the | 683 | ENTRY 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 | |||
| 672 | or subject for the task. LOCATION defines the intended venue for | 685 | or subject for the task. LOCATION defines the intended venue for |
| 673 | the task. DESCRIPTION provides the complete description of the | 686 | the task. DESCRIPTION provides the complete description of the |
| 674 | task. CATEGORIES defines the categories the task belongs to. | 687 | task. CATEGORIES defines the categories the task belongs to. |
| 688 | TIMEZONE specifies a time zone for this TODO only. | ||
| 675 | 689 | ||
| 676 | Return VTODO component as a string." | 690 | Return 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. |
| 880 | This function assumes major mode for current buffer is | 894 | This 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. |
| 916 | FILES is a list of files to build the calendar from." | 930 | FILES 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 | ||
| 732 | A rule consists in an association whose key is the type of link | 734 | A 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 | ||
| 864 | The default function simply returns the value of CONTENTS." | 866 | The 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 | |||
| 954 | listings name are the same, the language does not need an entry | 956 | listings name are the same, the language does not need an entry |
| 955 | in this list - but it does not hurt if it is present." | 957 | in 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 | |||
| 2263 | The TYPE is determined from the actual latex environment, and | ||
| 2264 | could 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. |
| 2255 | CONTENTS is nil. INFO is a plist holding contextual information." | 2288 | CONTENTS 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. |
| 2296 | LINK is the link pointing to the inline image. INFO is a plist | 2344 | LINK 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. |
| 249 | INFO is a plist used as a communication channel. Links and table | 249 | INFO is a plist used as a communication channel. Links and table |
| 250 | of contents can refer to headlines." | 250 | of 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. |
| 329 | CONTENTS is nil. INFO is a plist used as a communication | 356 | CONTENTS is nil. INFO is a plist used as a communication |
| 330 | channel." | 357 | channel." |
| 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 | |||
| 556 | INFO is a plist used as a communication channel. | ||
| 557 | |||
| 558 | Optional argument N, when non-nil, is an integer specifying the | ||
| 559 | depth of the table. | ||
| 560 | |||
| 561 | Optional argument KEYWORD specifies the TOC keyword, if any, from | ||
| 562 | which the table of contents generation has been initiated. | ||
| 563 | |||
| 564 | When optional argument LOCAL is non-nil, build a table of | ||
| 565 | contents 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. |
| 518 | FOOTNOTE is a cons cell of the form (number . definition). | 610 | FOOTNOTE 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 | ||
| 656 | The default value simply returns the value of CONTENTS." | 657 | The 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. | |||
| 312 | Return output file name." | 312 | Return 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 | ||
| 237 | If you create a site-map file, adjust the sorting like this: | 248 | If 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. |
| 307 | Possible values are `first', `last', and nil. | 321 | |
| 322 | Possible values are `first', `last', `ignore' and nil. | ||
| 308 | If `first', folders will be sorted before files. | 323 | If `first', folders will be sorted before files. |
| 309 | If `last', folders are sorted to the end after the files. | 324 | If `last', folders are sorted to the end after the files. |
| 310 | Any other value will not mix files and folders. | 325 | If `ignore', folders do not appear in the site-map. |
| 326 | Any other value will mix files and folders. | ||
| 311 | 327 | ||
| 312 | You can overwrite this default per project in your | 328 | You 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 | |||
| 331 | This 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. | ||
| 327 | See `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. | ||
| 333 | You 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. | ||
| 409 | When FILE is a relative file name, it is expanded according to | ||
| 410 | project base directory. Always return the true name of the file, | ||
| 411 | ignoring 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. |
| 400 | This splices all the components into the list." | 418 | This 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. | ||
| 459 | If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is | ||
| 460 | non-nil, restrict this list to the files matching the regexp | ||
| 461 | MATCH. If SKIP-FILE is non-nil, skip file matching the regexp | ||
| 462 | SKIP-FILE. If SKIP-DIR is non-nil, don't check directories | ||
| 463 | matching 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. | ||
| 489 | If EXCLUDE-REGEXP is set, this will be used to filter out | ||
| 490 | matching 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. |
| 540 | When UP is non-nil, return a meta-project (i.e., with a :components part) | 471 | When UP is non-nil, return a meta-project (i.e., with a :components part) |
| 541 | publishing FILENAME." | 472 | publishing 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 | |||
| 711 | If `:auto-sitemap' is set, publish the sitemap too. If | 641 | If `: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. | ||
| 682 | FILES is the list of files in the site map. PROJECT is the | ||
| 683 | current project. STYLE determines is either `list' or `tree'. | ||
| 684 | FORMAT-ENTRY is a function called on each file which should | ||
| 685 | return 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. |
| 757 | Optionally set the filename of the sitemap with SITEMAP-FILENAME. | 737 | Optionally set the filename of the sitemap with SITEMAP-FILENAME. |
| 758 | Default for SITEMAP-FILENAME is `sitemap.org'." | 738 | Default 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." | 822 | PROPERTY is a keyword referring to an export option, as defined |
| 843 | (or | 823 | in `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)) | 824 | latter case, optional argument BACKEND has to be set to the |
| 845 | (let* ((org-inhibit-startup t) | 825 | back-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 | 829 | Return value may be a string or a list, depending on the type of |
| 850 | (let ((property | 830 | PROPERTY, 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. | ||
| 866 | This function assumes FILE is either a directory or an Org file. | 862 | This function assumes FILE is either a directory or an Org file. |
| 867 | If FILE is an Org file and provides a DATE keyword use it. In | 863 | If FILE is an Org file and provides a DATE keyword use it. In |
| 868 | any other case use the file system's modification time. Return | 864 | any other case use the file system's modification time. Return |
| 869 | time in `current-time' format." | 865 | time 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 | 882 | ENTRY is a file name. STYLE is the style of the sitemap. |
| 887 | (let ((value (org-element-interpret-data ts))) | 883 | PROJECT 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. | ||
| 895 | TITLE is the the title of the site map. LIST is an internal | ||
| 896 | representation 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\". |
| 1034 | PROJECT is the project the index relates to. DIRECTORY is the | 1041 | PROJECT is the project the index relates to. DIRECTORY is the |
| 1035 | publishing directory." | 1042 | publishing 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. |
| 154 | If #+TEXINFO_CLASS is set in the buffer, use its value and the | 154 | If #+TEXINFO_CLASS is set in the buffer, use its value and the |
| 155 | associated information. Here is the structure of each cell: | 155 | associated information. Here is the structure of a class |
| 156 | definition: | ||
| 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 | |||
| 188 | The sectioning structure of the class is given by the elements | 190 | The sectioning structure of the class is given by the elements |
| 189 | following the header string. For each sectioning level, a number | 191 | following the header string. For each sectioning level, a number |
| 190 | of strings is specified. A %s formatter is mandatory in each | 192 | of strings is specified. A %s formatter is mandatory in each |
| 191 | section string and will be replaced by the title of the section. | 193 | section string and will be replaced by the title of the section." |
| 192 | |||
| 193 | Instead of a list of sectioning commands, you can also specify | ||
| 194 | a function name. That function will be called with two | ||
| 195 | parameters, the reduced) level of the headline, and a predicate | ||
| 196 | non-nil when the headline should be numbered. It must return | ||
| 197 | a 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 | ||
| 285 | This should an indicating command, e.g., \"@code\", \"@kbd\" or | 281 | This should an indicating command, e.g., \"@code\", \"@kbd\" or |
| 286 | \"@asis\". | 282 | \"@samp\". |
| 287 | 283 | ||
| 288 | It can be overridden locally using the \":indic\" attribute." | 284 | It 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 | ||
| 300 | The key must be a symbol among `bold', `code', `italic', | 299 | The 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 |
| 302 | a formatting string to wrap fontified text with. | 301 | a formatting string to wrap fontified text with. |
| 303 | 302 | ||
| 304 | Value can also be set to the following symbols: `verb' and | 303 | Value can also be set to the following symbols: `verb', `samp' |
| 305 | `code'. For the former, Org will use \"@verb\" to create | 304 | and `code'. With the first one, Org uses \"@verb\" to create |
| 306 | a format string and select a delimiter character that isn't in | 305 | a format string and selects a delimiter character that isn't in |
| 307 | the string. For the latter, Org will use \"@code\" to typeset | 306 | the string. For the other two, Org uses \"@samp\" or \"@code\" |
| 308 | and try to protect special characters. | 307 | to typeset and protects special characters. |
| 309 | 308 | ||
| 310 | If no association can be found for a given markup, text will be | 309 | When no association is found for a given markup, text is returned |
| 311 | returned as-is." | 310 | as-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 | ||
| 356 | This is a list of strings, each of them will be given to the | 357 | This 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 | |||
| 360 | base directory of the file and %O by the absolute file name of | 361 | base directory of the file and %O by the absolute file name of |
| 361 | the output file." | 362 | the 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." | |||
| 444 | INFO is a plist used as a communication channel. See | 447 | INFO 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. |
| 787 | CONTENTS is nil. INFO is a plist holding contextual | 789 | CONTENTS is nil. INFO is a plist holding contextual |
| 788 | information." | 790 | information." |
| 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. | ||
| 836 | Return nil if HEADLINE is to be ignored, `plain-list' if it | ||
| 837 | should be exported as a plain-list item. INFO is a plist holding | ||
| 838 | contextual 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. |
| 833 | CONTENTS holds the contents of the headline. INFO is a plist | 863 | CONTENTS holds the contents of the headline. INFO is a plist |
| 834 | holding contextual information." | 864 | holding 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. |
| 921 | CONTENTS holds the contents of the item. INFO is a plist holding | 917 | CONTENTS holds the contents of the item. INFO is a plist holding |
| 922 | contextual information." | 918 | contextual 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. |
| 968 | CONTENTS holds the contents of the item. INFO is a plist holding | 964 | CONTENTS holds the contents of the item. INFO is a plist holding |
| 969 | contextual information." | 965 | contextual 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 | |||
| 1246 | contextual information." | 1249 | contextual 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. | |||
| 598 | This option can also be set with the OPTIONS keyword, | 594 | This option can also be set with the OPTIONS keyword, |
| 599 | e.g. \"prop:t\"." | 595 | e.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 | |||
| 885 | This variable defines macro expansion templates available | ||
| 886 | globally. Associations follow the pattern | ||
| 887 | |||
| 888 | (NAME . TEMPLATE) | ||
| 889 | |||
| 890 | where NAME is a string beginning with a letter and consisting of | ||
| 891 | alphanumeric characters only. | ||
| 892 | |||
| 893 | TEMPLATE is the string to which the macro is going to be | ||
| 894 | expanded. Inside, \"$1\", \"$2\"... are place-holders for | ||
| 895 | macro's arguments. Moreover, if the template starts with | ||
| 896 | \"(eval\", it will be parsed as an Elisp expression and evaluated | ||
| 897 | accordingly." | ||
| 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 | |||
| 4134 | This only applies to links without a description." | 4166 | This 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 | |||
| 4178 | Org syntax does not support nested links. Nevertheless, some | ||
| 4179 | export back-ends support images as descriptions of links. Since | ||
| 4180 | images are really links to image files, we need to make an | ||
| 4181 | exception about links nesting. | ||
| 4182 | |||
| 4183 | This function recognizes links whose contents are really images | ||
| 4184 | and turn them into proper nested links. It is meant to be used | ||
| 4185 | as a parse tree filter in back-ends supporting such constructs. | ||
| 4186 | |||
| 4187 | DATA is a parse tree. INFO is the current state of the export | ||
| 4188 | process, as a plist. | ||
| 4189 | |||
| 4190 | A description is a valid images if it matches any rule in RULES, | ||
| 4191 | if non-nil, or `org-export-default-inline-image-rule' otherwise. | ||
| 4192 | See `org-export-inline-image-p' for more information about the | ||
| 4193 | structure of RULES. | ||
| 4194 | |||
| 4195 | Return 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 | |||
| 4246 | significant." | 4322 | significant." |
| 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." | |||
| 4655 | All special columns will be ignored during export." | 4729 | All 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." | |||
| 4675 | INFO is a plist used as a communication channel. | 4750 | INFO is a plist used as a communication channel. |
| 4676 | 4751 | ||
| 4677 | A table has a header when it contains at least two row groups." | 4752 | A 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. | |||
| 4735 | Return value is the group number, as an integer, or nil for | 4812 | Return value is the group number, as an integer, or nil for |
| 4736 | special rows and rows separators. First group is also table's | 4813 | special rows and rows separators. First group is also table's |
| 4737 | header." | 4814 | header." |
| 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. |
| 5016 | INFO is a plist used as a communication channel. Return value is | 5094 | INFO is a plist used as a communication channel. Return value is |
| 5017 | zero-based and ignores separators. The function returns nil for | 5095 | zero-indexed and ignores separators. The function returns nil |
| 5018 | special columns and separators." | 5096 | for 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 "«" :latex "\\guillemotleft{}" | ||
| 5288 | :texinfo "@guillemetleft{}") | ||
| 5289 | (primary-closing | ||
| 5290 | :utf-8 "»" :html "»" :latex "\\guillemotright{}" | ||
| 5291 | :texinfo "@guillemetright{}") | ||
| 5292 | (secondary-opening :utf-8 "‹" :html "‹" :latex "\\guilsinglleft{}" | ||
| 5293 | :texinfo "@guilsinglleft{}") | ||
| 5294 | (secondary-closing :utf-8 "›" :html "›" :latex "\\guilsinglright{}" | ||
| 5295 | :texinfo "@guilsinglright{}") | ||
| 5296 | (apostrophe :utf-8 "’" :html "’")) | ||
| 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 "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}") | 5402 | :utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}") |
| 5306 | (apostrophe :utf-8 "’" :html: "'")) | 5403 | (apostrophe :utf-8 "’" :html: "'")) |
| 5404 | ("sl" | ||
| 5405 | ;; Based on https://sl.wikipedia.org/wiki/Narekovaj | ||
| 5406 | (primary-opening :utf-8 "«" :html "«" :latex "{}<<" | ||
| 5407 | :texinfo "@guillemetleft{}") | ||
| 5408 | (primary-closing :utf-8 "»" :html "»" :latex ">>{}" | ||
| 5409 | :texinfo "@guillemetright{}") | ||
| 5410 | (secondary-opening | ||
| 5411 | :utf-8 "„" :html "„" :latex "\\glqq{}" :texinfo "@quotedblbase{}") | ||
| 5412 | (secondary-closing | ||
| 5413 | :utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}") | ||
| 5414 | (apostrophe :utf-8 "’" :html "’")) | ||
| 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 "”" :latex "’’" :texinfo "’’") | 5417 | (primary-opening :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") |
| 5310 | (primary-closing :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") | 5418 | (primary-closing :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") |
| 5311 | (secondary-opening :utf-8 "’" :html "’" :latex "’" :texinfo "`") | 5419 | (secondary-opening :utf-8 "’" :html "’" :latex "’" :texinfo "`") |
| @@ -5521,6 +5629,7 @@ them." | |||
| 5521 | '(("%e %n: %c" | 5629 | '(("%e %n: %c" |
| 5522 | ("fr" :default "%e %n : %c" :html "%e %n : %c")) | 5630 | ("fr" :default "%e %n : %c" :html "%e %n : %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 "Автор" :utf-8 "Автор") | 5652 | ("ru" :html "Автор" :utf-8 "Автор") |
| 5653 | ("sl" :default "Avtor") | ||
| 5544 | ("sv" :html "Författare") | 5654 | ("sv" :html "Författare") |
| 5545 | ("uk" :html "Автор" :utf-8 "Автор") | 5655 | ("uk" :html "Автор" :utf-8 "Автор") |
| 5546 | ("zh-CN" :html "作者" :utf-8 "作者") | 5656 | ("zh-CN" :html "作者" :utf-8 "作者") |
| 5547 | ("zh-TW" :html "作者" :utf-8 "作者")) | 5657 | ("zh-TW" :html "作者" :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úa de la página anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior") | 5661 | ("es" :html "Continúa de la pá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 "(Продолжение)" | 5667 | ("ru" :html "(Продолжение)" |
| 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úa en la siguiente página" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página") | 5673 | ("es" :html "Continúa en la siguiente pá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 "(Продолжение следует)" | 5679 | ("ru" :html "(Продолжение следует)" |
| 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 "Дата" :utf-8 "Дата") | 5704 | ("ru" :html "Дата" :utf-8 "Дата") |
| 5705 | ("sl" :default "Datum") | ||
| 5588 | ("sv" :default "Datum") | 5706 | ("sv" :default "Datum") |
| 5589 | ("uk" :html "Дата" :utf-8 "Дата") | 5707 | ("uk" :html "Дата" :utf-8 "Дата") |
| 5590 | ("zh-CN" :html "日期" :utf-8 "日期") | 5708 | ("zh-CN" :html "日期" :utf-8 "日期") |
| 5591 | ("zh-TW" :html "日期" :utf-8 "日期")) | 5709 | ("zh-TW" :html "日期" :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ón" :default "Ecuación") | 5714 | ("es" :ascii "Ecuacion" :html "Ecuación" :default "Ecuación") |
| @@ -5603,9 +5722,11 @@ them." | |||
| 5603 | ("pt_BR" :html "Equação" :default "Equação" :ascii "Equacao") | 5722 | ("pt_BR" :html "Equação" :default "Equação" :ascii "Equacao") |
| 5604 | ("ru" :html "Уравнение" | 5723 | ("ru" :html "Уравнение" |
| 5605 | :utf-8 "Уравнение") | 5724 | :utf-8 "Уравнение") |
| 5725 | ("sl" :default "Enačba") | ||
| 5606 | ("sv" :default "Ekvation") | 5726 | ("sv" :default "Ekvation") |
| 5607 | ("zh-CN" :html "方程" :utf-8 "方程")) | 5727 | ("zh-CN" :html "方程" :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 "图" :utf-8 "图")) | 5742 | ("zh-CN" :html "图" :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 "Рис. %d.:" :utf-8 "Рис. %d.:") | 5756 | ("ru" :html "Рис. %d.:" :utf-8 "Рис. %d.:") |
| 5757 | ("sl" :default "Slika %d") | ||
| 5635 | ("sv" :default "Illustration %d") | 5758 | ("sv" :default "Illustration %d") |
| 5636 | ("zh-CN" :html "图%d " :utf-8 "图%d ")) | 5759 | ("zh-CN" :html "图%d " :utf-8 "图%d ")) |
| 5637 | ("Footnotes" | 5760 | ("Footnotes" |
| 5761 | ("ar" :default "الهوامش") | ||
| 5638 | ("ca" :html "Peus de pàgina") | 5762 | ("ca" :html "Peus de pà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é" :default "Notas de Rodapé" :ascii "Notas de Rodape") | 5780 | ("pt_BR" :html "Notas de Rodapé" :default "Notas de Rodapé" :ascii "Notas de Rodape") |
| 5657 | ("ru" :html "Сноски" :utf-8 "Сноски") | 5781 | ("ru" :html "Сноски" :utf-8 "Сноски") |
| 5782 | ("sl" :default "Opombe") | ||
| 5658 | ("sv" :default "Fotnoter") | 5783 | ("sv" :default "Fotnoter") |
| 5659 | ("uk" :html "Примітки" | 5784 | ("uk" :html "Примітки" |
| 5660 | :utf-8 "Примітки") | 5785 | :utf-8 "Примітки") |
| 5661 | ("zh-CN" :html "脚注" :utf-8 "脚注") | 5786 | ("zh-CN" :html "脚注" :utf-8 "脚注") |
| 5662 | ("zh-TW" :html "腳註" :utf-8 "腳註")) | 5787 | ("zh-TW" :html "腳註" :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 "Índice de Listados de programas" :default "Índice de Listados de programas") | 5792 | ("es" :ascii "Indice de Listados de programas" :html "Í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 "Список распечаток" | 5798 | ("ru" :html "Список распечаток" |
| 5673 | :utf-8 "Список распечаток") | 5799 | :utf-8 "Список распечаток") |
| 5800 | ("sl" :default "Seznam programskih izpisov") | ||
| 5674 | ("zh-CN" :html "代码目录" :utf-8 "代码目录")) | 5801 | ("zh-CN" :html "代码目录" :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 "Índice de tablas" :default "Índice de tablas") | 5806 | ("es" :ascii "Indice de tablas" :html "Í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 "Список таблиц" | 5815 | ("ru" :html "Список таблиц" |
| 5688 | :utf-8 "Список таблиц") | 5816 | :utf-8 "Список таблиц") |
| 5817 | ("sl" :default "Seznam tabel") | ||
| 5689 | ("sv" :default "Tabeller") | 5818 | ("sv" :default "Tabeller") |
| 5690 | ("zh-CN" :html "表格目录" :utf-8 "表格目录")) | 5819 | ("zh-CN" :html "表格目录" :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 "Распечатка" | 5831 | ("ru" :html "Распечатка" |
| 5702 | :utf-8 "Распечатка") | 5832 | :utf-8 "Распечатка") |
| 5833 | ("sl" :default "Izpis programa") | ||
| 5703 | ("zh-CN" :html "代码" :utf-8 "代码")) | 5834 | ("zh-CN" :html "代码" :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 "Распечатка %d.:" | 5846 | ("ru" :html "Распечатка %d.:" |
| 5715 | :utf-8 "Распечатка %d.:") | 5847 | :utf-8 "Распечатка %d.:") |
| 5848 | ("sl" :default "Izpis programa %d") | ||
| 5716 | ("zh-CN" :html "代码%d " :utf-8 "代码%d ")) | 5849 | ("zh-CN" :html "代码%d " :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. figure %s" :latex "cf.~figure~%s")) | 5858 | :html "cf. figure %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. programme %s" :latex "cf.~programme~%s")) | 5862 | :html "cf. programme %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ón %s" :default "Vea sección %s") | 5868 | ("es" :ascii "Vea seccion %s" :html "Vea secció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 "См. раздел %s" | 5874 | ("ru" :html "См. раздел %s" |
| 5737 | :utf-8 "См. раздел %s") | 5875 | :utf-8 "См. раздел %s") |
| 5876 | ("sl" :default "Glej poglavje %d") | ||
| 5738 | ("zh-CN" :html "参见第%s节" :utf-8 "参见第%s节")) | 5877 | ("zh-CN" :html "参见第%s节" :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. tableau %s" :latex "cf.~tableau~%s")) | 5880 | :html "cf. tableau %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 "表" :utf-8 "表")) | 5893 | ("zh-CN" :html "表" :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 "Таблица %d.:" | 5907 | ("ru" :html "Таблица %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 "表%d " :utf-8 "表%d ")) | 5911 | ("zh-CN" :html "表%d " :utf-8 "表%d ")) |
| 5769 | ("Table of Contents" | 5912 | ("Table of Contents" |
| 5913 | ("ar" :default "قائمة المحتويات") | ||
| 5770 | ("ca" :html "Índex") | 5914 | ("ca" :html "Í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 "Índice" :utf8 "Índice" :ascii "Indice") | 5932 | ("pt_BR" :html "Índice" :utf8 "Índice" :ascii "Indice") |
| 5789 | ("ru" :html "Содержание" | 5933 | ("ru" :html "Содержание" |
| 5790 | :utf-8 "Содержание") | 5934 | :utf-8 "Содержание") |
| 5935 | ("sl" :default "Kazalo") | ||
| 5791 | ("sv" :html "Innehåll") | 5936 | ("sv" :html "Innehåll") |
| 5792 | ("uk" :html "Зміст" :utf-8 "Зміст") | 5937 | ("uk" :html "Зміст" :utf-8 "Зміст") |
| 5793 | ("zh-CN" :html "目录" :utf-8 "目录") | 5938 | ("zh-CN" :html "目录" :utf-8 "目录") |
| 5794 | ("zh-TW" :html "目錄" :utf-8 "目錄")) | 5939 | ("zh-TW" :html "目錄" :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 "Неизвестная ссылка" | 5950 | ("ru" :html "Неизвестная ссылка" |
| 5805 | :utf-8 "Неизвестная ссылка") | 5951 | :utf-8 "Неизвестная ссылка") |
| 5952 | ("sl" :default "Neznana referenca") | ||
| 5806 | ("zh-CN" :html "未知引用" :utf-8 "未知引用"))) | 5953 | ("zh-CN" :html "未知引用" :utf-8 "未知引用"))) |
| 5807 | "Dictionary for export engine. | 5954 | "Dictionary for export engine. |
| 5808 | 5955 | ||
| @@ -6090,29 +6237,37 @@ directory. | |||
| 6090 | Return file name as a string." | 6237 | Return 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)) |