diff options
| author | Rasmus <rasmus@gmx.us> | 2017-09-18 12:01:12 +0200 |
|---|---|---|
| committer | Rasmus <rasmus@gmx.us> | 2017-09-18 12:01:12 +0200 |
| commit | ab351d442d7bb4d17cbb43638aaed1775d8c0344 (patch) | |
| tree | 19da4c93526d3de543efe21a53ab2d098fb9f50b /lisp | |
| parent | 5490ccc5ebf39759dfd084bbd31f464701a3e775 (diff) | |
| download | emacs-ab351d442d7bb4d17cbb43638aaed1775d8c0344.tar.gz | |
Update Org to v9.1.1
Please see etc/ORG-NEWS for major changes.
Diffstat (limited to 'lisp')
51 files changed, 4652 insertions, 4087 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 @@ (defvar org-babel-default-header-args:C '()) +(defconst org-babel-header-args:C '((includes . :any) + (defines . :any) + (main . :any) + (flags . :any) + (cmdline . :any) + (libs . :any)) + "C/C++-specific header arguments.") + +(defconst org-babel-header-args:C++ + (append '((namespaces . :any)) + org-babel-header-args:C) + "C++-specific header arguments.") + (defcustom org-babel-C-compiler "gcc" "Command used to compile a C source code file into an executable. May be either a command in the path, like gcc @@ -196,15 +209,18 @@ its header arguments." (colnames (cdr (assq :colname-names params))) (main-p (not (string= (cdr (assq :main params)) "no"))) (includes (org-babel-read - (or (cdr (assq :includes params)) - (org-entry-get nil "includes" t)) + (cdr (assq :includes params)) nil)) (defines (org-babel-read - (or (cdr (assq :defines params)) - (org-entry-get nil "defines" t)) - nil))) + (cdr (assq :defines params)) + nil)) + (namespaces (org-babel-read + (cdr (assq :namespaces params)) + nil))) (when (stringp includes) (setq includes (split-string includes))) + (when (stringp namespaces) + (setq namespaces (split-string namespaces))) (when (stringp defines) (let ((y nil) (result (list t))) @@ -224,6 +240,11 @@ its header arguments." (mapconcat (lambda (inc) (format "#define %s" inc)) (if (listp defines) defines (list defines)) "\n") + ;; namespaces + (mapconcat + (lambda (inc) (format "using namespace %s;" inc)) + namespaces + "\n") ;; variables (mapconcat 'org-babel-C-var-to-C vars "\n") ;; 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'." (result-type (cdr (assq :result-type params))) (session (org-babel-R-initiate-session (cdr (assq :session params)) params)) - (colnames-p (cdr (assq :colnames params))) - (rownames-p (cdr (assq :rownames params))) (graphics-file (and (member "graphics" (assq :result-params params)) (org-babel-graphical-output-file params))) + (colnames-p (unless graphics-file (cdr (assq :colnames params)))) + (rownames-p (unless graphics-file (cdr (assq :rownames params)))) (full-body (let ((inside (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 @@ ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. -;; Author: Joel Boehland, Eric Schulte, Oleh Krehel +;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson ;; ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org @@ -43,19 +43,34 @@ (require 'ob) (declare-function cider-current-connection "ext:cider-client" (&optional type)) -(declare-function cider-current-session "ext:cider-client" ()) +(declare-function cider-current-ns "ext:cider-client" ()) +(declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2)) (declare-function nrepl-dict-get "ext:nrepl-client" (dict key)) +(declare-function nrepl-dict-put "ext:nrepl-client" (dict key value)) +(declare-function nrepl-request:eval "ext:nrepl-client" + (input callback connection &optional session ns line column additional-params)) (declare-function nrepl-sync-request:eval "ext:nrepl-client" (input connection session &optional ns)) (declare-function org-trim "org" (s &optional keep-lead)) (declare-function slime-eval "ext:slime" (sexp &optional package)) +(defvar nrepl-sync-request-timeout) + (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) (defvar org-babel-default-header-args:clojure '()) (defvar org-babel-header-args:clojure '((package . :any))) +(defcustom org-babel-clojure-sync-nrepl-timeout 10 + "Timeout value, in seconds, of a Clojure sync call. +If the value is nil, timeout is disabled." + :group 'org-babel + :type 'integer + :version "26.1" + :package-version '(Org . "9.1") + :safe #'wholenump) + (defcustom org-babel-clojure-backend (cond ((featurep 'cider) 'cider) (t 'slime)) @@ -84,21 +99,86 @@ body))) (defun org-babel-execute:clojure (body params) - "Execute a block of Clojure code with Babel." + "Execute a block of Clojure code with Babel. +The underlying process performed by the code block can be output +using the :show-process parameter." (let ((expanded (org-babel-expand-body:clojure body params)) - result) + (response (list 'dict)) + result) (cl-case org-babel-clojure-backend (cider (require 'cider) - (let ((result-params (cdr (assq :result-params params)))) - (setq result - (nrepl-dict-get - (nrepl-sync-request:eval - expanded (cider-current-connection) (cider-current-session)) - (if (or (member "output" result-params) - (member "pp" result-params)) - "out" - "value"))))) + (let ((result-params (cdr (assq :result-params params))) + (show (cdr (assq :show-process params)))) + (if (member show '(nil "no")) + ;; Run code without showing the process. + (progn + (setq response + (let ((nrepl-sync-request-timeout + org-babel-clojure-sync-nrepl-timeout)) + (nrepl-sync-request:eval expanded + (cider-current-connection) + (cider-current-ns)))) + (setq result + (concat + (nrepl-dict-get response + (if (or (member "output" result-params) + (member "pp" result-params)) + "out" + "value")) + (nrepl-dict-get response "ex") + (nrepl-dict-get response "root-ex") + (nrepl-dict-get response "err")))) + ;; Show the process in an output buffer/window. + (let ((process-buffer (switch-to-buffer-other-window + "*Clojure Show Process Sub Buffer*")) + status) + ;; Run the Clojure code in nREPL. + (nrepl-request:eval + expanded + (lambda (resp) + (when (member "out" resp) + ;; Print the output of the nREPL in the output buffer. + (princ (nrepl-dict-get resp "out") process-buffer)) + (when (member "ex" resp) + ;; In case there is an exception, then add it to the + ;; output buffer as well. + (princ (nrepl-dict-get resp "ex") process-buffer) + (princ (nrepl-dict-get resp "root-ex") process-buffer)) + (when (member "err" resp) + ;; In case there is an error, then add it to the + ;; output buffer as well. + (princ (nrepl-dict-get resp "err") process-buffer)) + (nrepl--merge response resp) + ;; Update the status of the nREPL output session. + (setq status (nrepl-dict-get response "status"))) + (cider-current-connection) + (cider-current-ns)) + + ;; Wait until the nREPL code finished to be processed. + (while (not (member "done" status)) + (nrepl-dict-put response "status" (remove "need-input" status)) + (accept-process-output nil 0.01) + (redisplay)) + + ;; Delete the show buffer & window when the processing is + ;; finalized. + (mapc #'delete-window + (get-buffer-window-list process-buffer nil t)) + (kill-buffer process-buffer) + + ;; Put the output or the value in the result section of + ;; the code block. + (setq result + (concat + (nrepl-dict-get response + (if (or (member "output" result-params) + (member "pp" result-params)) + "out" + "value")) + (nrepl-dict-get response "ex") + (nrepl-dict-get response "root-ex") + (nrepl-dict-get response "err"))))))) (slime (require 'slime) (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 @@ (declare-function org-reverse-string "org" (string)) (declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-show-context "org" (&optional key)) -(declare-function org-split-string "org" (string &optional separators)) (declare-function org-src-coderef-format "org-src" (element)) (declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-table-align "org-table" ()) @@ -179,6 +178,14 @@ This string must include a \"%s\" which will be replaced by the results." :package-version '(Org . "9.0") :safe #'booleanp) +(defcustom org-babel-uppercase-example-markers nil + "When non-nil, begin/end example markers will be inserted in upper case." + :group 'org-babel + :type 'boolean + :version "26.1" + :package-version '(Org . "9.1") + :safe #'booleanp) + (defun org-babel-noweb-wrap (&optional regexp) (concat org-babel-noweb-wrap-start (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") @@ -234,11 +241,9 @@ should be asked whether to allow evaluation." (query (or (equal eval "query") (and export (equal eval "query-export")) (if (functionp org-confirm-babel-evaluate) - (save-excursion - (goto-char (nth 5 info)) - (funcall org-confirm-babel-evaluate - ;; language, code block body - (nth 0 info) (nth 1 info))) + (funcall org-confirm-babel-evaluate + ;; Language, code block body. + (nth 0 info) (nth 1 info)) org-confirm-babel-evaluate)))) (cond (noeval nil) @@ -2348,7 +2353,7 @@ INFO may provide the values of these header arguments (in the ((assq :wrap (nth 2 info)) (let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS"))) (funcall wrap (concat "#+BEGIN_" name) - (concat "#+END_" (car (org-split-string name))) + (concat "#+END_" (car (split-string name))) nil nil (concat "{{{results(@@" name ":") "@@)}}}"))) ((member "html" result-params) (funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil @@ -2483,15 +2488,12 @@ file's directory then expand relative links." result) (if description (concat "[" description "]") "")))) -(defvar org-babel-capitalize-example-region-markers nil - "Make true to capitalize begin/end example markers inserted by code blocks.") - (defun org-babel-examplify-region (beg end &optional results-switches inline) "Comment out region using the inline `==' or `: ' org example quote." (interactive "*r") (let ((maybe-cap (lambda (str) - (if org-babel-capitalize-example-region-markers (upcase str) str)))) + (if org-babel-uppercase-example-markers (upcase str) str)))) (if inline (save-excursion (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 @@ (defvar org-src-preserve-indentation) -(defcustom org-export-babel-evaluate t - "Switch controlling code evaluation during export. +(defcustom org-export-use-babel t + "Switch controlling code evaluation and header processing during export. When set to nil no code will be evaluated as part of the export -process and no header arguments will be obeyed. When set to -`inline-only', only inline code blocks will be executed. Users -who wish to avoid evaluating code on export should use the header -argument `:eval never-export'." +process and no header arguments will be obeyed. Users who wish +to avoid evaluating code on export should use the header argument +`:eval never-export'." :group 'org-babel :version "24.1" :type '(choice (const :tag "Never" nil) - (const :tag "Only inline code" inline-only) - (const :tag "Always" t))) -(put 'org-export-babel-evaluate 'safe-local-variable #'null) + (const :tag "Always" t)) + :safe #'null) + (defmacro org-babel-exp--at-source (&rest body) "Evaluate BODY at the source of the Babel block at point. @@ -128,12 +127,10 @@ this template." (defun org-babel-exp-process-buffer () "Execute all Babel blocks in current buffer." (interactive) - (when org-export-babel-evaluate + (when org-export-use-babel (save-window-excursion (let ((case-fold-search t) - (regexp (if (eq org-export-babel-evaluate 'inline-only) - "\\(call\\|src\\)_" - "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")) + (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)") ;; Get a pristine copy of current buffer so Babel ;; references are properly resolved and source block ;; context is preserved. 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 @@ ;;; Code: (require 'ob) -(declare-function org-time-string-to-time "org" (s &optional buffer pos)) +(declare-function org-time-string-to-time "org" (s &optional zone)) (declare-function org-combine-plists "org" (&rest plists)) (declare-function orgtbl-to-generic "org-table" (table params)) (declare-function gnuplot-mode "ext:gnuplot-mode" ()) 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." (string :tag "Lilypond ") (string :tag "PDF Viewer ") (string :tag "MIDI Player")) - :version "24.3" + :version "24.4" :package-version '(Org . "8.2.7") :set (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 @@ (defcustom org-babel-lua-command "lua" "Name of the command for executing Lua code." - :version "24.5" + :version "26.1" :package-version '(Org . "8.3") :group 'org-babel :type 'string) @@ -58,21 +58,21 @@ "Preferred lua mode for use in running lua interactively. This will typically be 'lua-mode." :group 'org-babel - :version "24.5" + :version "26.1" :package-version '(Org . "8.3") :type 'symbol) (defcustom org-babel-lua-hline-to "None" "Replace hlines in incoming tables with this when translating to lua." :group 'org-babel - :version "24.5" + :version "26.1" :package-version '(Org . "8.3") :type 'string) (defcustom org-babel-lua-None-to 'hline "Replace 'None' in lua tables with this before returning." :group 'org-babel - :version "24.5" + :version "26.1" :package-version '(Org . "8.3") :type 'symbol) 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 @@ (defun org-babel-maxima-expand (body params) "Expand a block of Maxima code according to its header arguments." - (let ((vars (org-babel--get-vars params))) + (let ((vars (org-babel--get-vars params)) + (epilogue (cdr (assq :epilogue params))) + (prologue (cdr (assq :prologue params)))) (mapconcat 'identity (list + ;; Any code from the specified prologue at the start. + prologue ;; graphic output (let ((graphic-file (ignore-errors (org-babel-graphical-output-file params)))) (if graphic-file @@ -62,6 +66,8 @@ (mapconcat 'org-babel-maxima-var-to-maxima vars "\n") ;; body body + ;; Any code from the specified epilogue at the end. + epilogue "gnuplot_close ()$") "\n"))) 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 @@ :version "24.1" :type 'string) +(defun org-babel-variable-assignments:plantuml (params) + "Return a list of PlantUML statements assigning the block's variables. +PARAMS is a property list of source block parameters, which may +contain multiple entries for the key `:var'. `:var' entries in PARAMS +are expected to be scalar variables." + (mapcar + (lambda (pair) + (format "!define %s %s" + (car pair) + (replace-regexp-in-string "\"" "" (cdr pair)))) + (org-babel--get-vars params))) + +(defun org-babel-plantuml-make-body (body params) + "Return PlantUML input string. +BODY is the content of the source block and PARAMS is a property list +of source block parameters. This function relies on the +`org-babel-expand-body:generic' function to extract `:var' entries +from PARAMS and on the `org-babel-variable-assignments:plantuml' +function to convert variables to PlantUML assignments." + (concat + "@startuml\n" + (org-babel-expand-body:generic + body params (org-babel-variable-assignments:plantuml params)) + "\n@enduml")) + (defun org-babel-execute:plantuml (body params) "Execute a block of plantuml code with org-babel. This function is called by `org-babel-execute-src-block'." @@ -54,6 +79,7 @@ This function is called by `org-babel-execute-src-block'." (cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "plantuml-")) (java (or (cdr (assq :java params)) "")) + (full-body (org-babel-plantuml-make-body body params)) (cmd (if (string= "" org-plantuml-jar-path) (error "`org-plantuml-jar-path' is not set") (concat "java " java " -jar " @@ -85,7 +111,7 @@ This function is called by `org-babel-execute-src-block'." (org-babel-process-file-name out-file))))) (unless (file-exists-p org-plantuml-jar-path) (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) - (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) + (with-temp-file in-file (insert full-body)) (message "%s" cmd) (org-babel-eval cmd "") nil)) ;; signal that output has already been written to file 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 @@ (defvar geiser-impl--implementation) ; Defined in geiser-impl.el (defvar geiser-default-implementation) ; Defined in geiser-impl.el (defvar geiser-active-implementations) ; Defined in geiser-impl.el +(defvar geiser-debug-show-debug-p) ; Defined in geiser-debug.el +(defvar geiser-debug-jump-to-debug-p) ; Defined in geiser-debug.el +(defvar geiser-repl-use-other-window) ; Defined in geiser-repl.el +(defvar geiser-repl-window-allow-split) ; Defined in geiser-repl.el (declare-function run-geiser "ext:geiser-repl" (impl)) (declare-function geiser-mode "ext:geiser-mode" ()) (declare-function geiser-eval-region "ext:geiser-mode" (start end &optional and-go raw nomsg)) (declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg)) +(declare-function geiser-eval--retort-output "ext:geiser-eval" (ret)) +(declare-function geiser-eval--retort-result-str "ext:geiser-eval" (ret prefix)) + +(defcustom org-babel-scheme-null-to 'hline + "Replace `null' and empty lists in scheme tables with this before returning." + :group 'org-babel + :version "26.1" + :package-version '(Org . "9.1") + :type 'symbol) (defvar org-babel-default-header-args:scheme '() "Default header arguments for scheme code blocks.") (defun org-babel-expand-body:scheme (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (org-babel--get-vars params))) - (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) - vars "\n ") - ")\n" body ")") - body))) - - -(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal) + (let ((vars (org-babel--get-vars params)) + (prepends (cdr (assq :prologue params)))) + (concat (and prepends (concat prepends "\n")) + (if (null vars) body + (format "(let (%s)\n%s\n)" + (mapconcat + (lambda (var) + (format "%S" (print `(,(car var) ',(cdr var))))) + vars + "\n ") + body))))) + + +(defvar org-babel-scheme-repl-map (make-hash-table :test #'equal) "Map of scheme sessions to session names.") (defun org-babel-scheme-cleanse-repl-map () "Remove dead buffers from the REPL map." (maphash - (lambda (x y) - (when (not (buffer-name y)) - (remhash x org-babel-scheme-repl-map))) + (lambda (x y) (unless (buffer-name y) (remhash x org-babel-scheme-repl-map))) org-babel-scheme-repl-map)) (defun org-babel-scheme-get-session-buffer (session-name) @@ -112,12 +126,9 @@ If the session is unnamed (nil), generate a name. If the session is `none', use nil for the session name, and org-babel-scheme-execute-with-geiser will use a temporary session." - (let ((result - (cond ((not name) - (concat buffer " " (symbol-name impl) " REPL")) - ((string= name "none") nil) - (name)))) - result)) + (cond ((not name) (concat buffer " " (symbol-name impl) " REPL")) + ((string= name "none") nil) + (name))) (defmacro org-babel-scheme-capture-current-message (&rest body) "Capture current message in both interactive and noninteractive mode" @@ -145,37 +156,46 @@ is true; otherwise returns the last value." (with-temp-buffer (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl)) (newline) - (insert (if output - (format "(with-output-to-string (lambda () %s))" code) - code)) + (insert code) (geiser-mode) - (let ((repl-buffer (save-current-buffer - (org-babel-scheme-get-repl impl repl)))) - (when (not (eq impl (org-babel-scheme-get-buffer-impl - (current-buffer)))) - (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) - (org-babel-scheme-get-buffer-impl (current-buffer)) - (symbolp (org-babel-scheme-get-buffer-impl - (current-buffer))))) - (setq geiser-repl--repl repl-buffer) - (setq geiser-impl--implementation nil) - (setq result (org-babel-scheme-capture-current-message - (geiser-eval-region (point-min) (point-max)))) - (setq result - (if (and (stringp result) (equal (substring result 0 3) "=> ")) - (replace-regexp-in-string "^=> " "" result) - "\"An error occurred.\"")) - (when (not repl) - (save-current-buffer (set-buffer repl-buffer) - (geiser-repl-exit)) - (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) - (kill-buffer repl-buffer)) - (setq result (if (or (string= result "#<void>") - (string= result "#<unspecified>")) - nil - result)))) + (let ((geiser-repl-window-allow-split nil) + (geiser-repl-use-other-window nil)) + (let ((repl-buffer (save-current-buffer + (org-babel-scheme-get-repl impl repl)))) + (when (not (eq impl (org-babel-scheme-get-buffer-impl + (current-buffer)))) + (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) + (org-babel-scheme-get-buffer-impl (current-buffer)) + (symbolp (org-babel-scheme-get-buffer-impl + (current-buffer))))) + (setq geiser-repl--repl repl-buffer) + (setq geiser-impl--implementation nil) + (let ((geiser-debug-jump-to-debug-p nil) + (geiser-debug-show-debug-p nil)) + (let ((ret (geiser-eval-region (point-min) (point-max)))) + (setq result (if output + (geiser-eval--retort-output ret) + (geiser-eval--retort-result-str ret ""))))) + (when (not repl) + (save-current-buffer (set-buffer repl-buffer) + (geiser-repl-exit)) + (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) + (kill-buffer repl-buffer))))) result)) +(defun org-babel-scheme--table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If the results look like a list or tuple, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (let ((res (org-babel-script-escape results))) + (cond ((listp res) + (mapcar (lambda (el) + (if (or (null el) (eq el 'null)) + org-babel-scheme-null-to + el)) + res)) + (t res)))) + (defun org-babel-execute:scheme (body params) "Execute a block of Scheme code with org-babel. This function is called by `org-babel-execute-src-block'" @@ -184,24 +204,28 @@ This function is called by `org-babel-execute-src-block'" "^ ?\\*\\([^*]+\\)\\*" "\\1" (buffer-name source-buffer)))) (save-excursion - (org-babel-reassemble-table - (let* ((result-type (cdr (assq :result-type params))) - (impl (or (when (cdr (assq :scheme params)) - (intern (cdr (assq :scheme params)))) - geiser-default-implementation - (car geiser-active-implementations))) - (session (org-babel-scheme-make-session-name - source-buffer-name (cdr (assq :session params)) impl)) - (full-body (org-babel-expand-body:scheme body params))) - (org-babel-scheme-execute-with-geiser - full-body ; code - (string= result-type "output") ; output? - impl ; implementation - (and (not (string= session "none")) session))) ; session - (org-babel-pick-name (cdr (assq :colname-names params)) - (cdr (assq :colnames params))) - (org-babel-pick-name (cdr (assq :rowname-names params)) - (cdr (assq :rownames params))))))) + (let* ((result-type (cdr (assq :result-type params))) + (impl (or (when (cdr (assq :scheme params)) + (intern (cdr (assq :scheme params)))) + geiser-default-implementation + (car geiser-active-implementations))) + (session (org-babel-scheme-make-session-name + source-buffer-name (cdr (assq :session params)) impl)) + (full-body (org-babel-expand-body:scheme body params)) + (result + (org-babel-scheme-execute-with-geiser + full-body ; code + (string= result-type "output") ; output? + impl ; implementation + (and (not (string= session "none")) session)))) ; session + (let ((table + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params)))))) + (org-babel-scheme--table-or-string table)))))) (provide 'ob-scheme) 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 @@ ;; - colnames (default, nil, means "yes") ;; - result-params ;; - out-file +;; ;; The following are used but not really implemented for SQL: ;; - colname-names ;; - rownames ;; - rowname-names ;; +;; Engines supported: +;; - mysql +;; - dbi +;; - mssql +;; - sqsh +;; - postgresql +;; - oracle +;; - vertica +;; ;; TODO: ;; ;; - support for sessions -;; - support for more engines (currently only supports mysql) +;; - support for more engines ;; - what's a reasonable way to drop table data into SQL? ;; @@ -116,6 +126,28 @@ SQL Server on Windows and Linux platform." (when database (format "-d \"%s\"" database)))) " ")) +(defun org-babel-sql-dbstring-sqsh (host user password database) + "Make sqsh commmand line args for database connection. +\"sqsh\" is one method to access Sybase or MS SQL via Linux platform" + (mapconcat #'identity + (delq nil + (list (when host (format "-S \"%s\"" host)) + (when user (format "-U \"%s\"" user)) + (when password (format "-P \"%s\"" password)) + (when database (format "-D \"%s\"" database)))) + " ")) + +(defun org-babel-sql-dbstring-vertica (host port user password database) + "Make Vertica command line args for database connection. Pass nil to omit that arg." + (mapconcat #'identity + (delq nil + (list (when host (format "-h %s" host)) + (when port (format "-p %d" port)) + (when user (format "-U %s" user)) + (when password (format "-w %s" (shell-quote-argument password) )) + (when database (format "-d %s" database)))) + " ")) + (defun org-babel-sql-convert-standard-filename (file) "Convert FILE to OS standard file name. If in Cygwin environment, uses Cygwin specific function to @@ -179,6 +211,20 @@ footer=off -F \"\t\" %s -f %s -o %s %s" (org-babel-process-file-name in-file) (org-babel-process-file-name out-file) (or cmdline ""))) + (`sqsh (format "sqsh %s %s -i %s -o %s -m csv" + (or cmdline "") + (org-babel-sql-dbstring-sqsh + dbhost dbuser dbpassword database) + (org-babel-sql-convert-standard-filename + (org-babel-process-file-name in-file)) + (org-babel-sql-convert-standard-filename + (org-babel-process-file-name out-file)))) + (`vertica (format "vsql %s -f %s -o %s %s" + (org-babel-sql-dbstring-vertica + dbhost dbport dbuser dbpassword database) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) (`oracle (format "sqlplus -s %s < %s > %s" (org-babel-sql-dbstring-oracle @@ -203,18 +249,21 @@ SET MARKUP HTML OFF SPOOL OFF SET COLSEP '|' ") - (`mssql "SET NOCOUNT ON + ((or `mssql `sqsh) "SET NOCOUNT ON ") + (`vertica "\\a\n") (_ "")) - (org-babel-expand-body:sql body params))) + (org-babel-expand-body:sql body params) + ;; "sqsh" requires "go" inserted at EOF. + (if (string= engine "sqsh") "\ngo" ""))) (org-babel-eval command "") (org-babel-result-cond result-params (with-temp-buffer (progn (insert-file-contents-literally out-file) (buffer-string))) (with-temp-buffer (cond - ((memq (intern engine) '(dbi mysql postgresql)) + ((memq (intern engine) '(dbi mysql postgresql sqsh vertica)) ;; Add header row delimiter after column-names header in first line (cond (colnames-p @@ -239,7 +288,7 @@ SET COLSEP '|' (goto-char (point-max)) (forward-char -1)) (write-file out-file)))) - (org-table-import out-file '(16)) + (org-table-import out-file (if (string= engine "sqsh") '(4) '(16))) (org-babel-reassemble-table (mapcar (lambda (x) (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'." (if (listp val) (let ((data-file (org-babel-temp-file "sqlite-data-"))) (with-temp-file data-file - (insert (orgtbl-to-csv - val '(:fmt (lambda (el) (if (stringp el) - el - (format "%S" el))))))) + (insert (orgtbl-to-csv val nil))) data-file) (if (stringp val) val (format "%S" val)))) 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 @@ (require 'cl-lib) (require 'org-src) +(require 'org-macs) (declare-function make-directory "files" (dir &optional parents)) (declare-function org-at-heading-p "org" (&optional ignored)) (declare-function org-babel-update-block-body "ob-core" (new-body)) (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-before-first-heading-p "org" ()) -(declare-function org-edit-special "org" (&optional arg)) (declare-function org-element-at-point "org-element" ()) (declare-function org-element-type "org-element" (element)) (declare-function org-fill-template "org" (template alist)) @@ -45,7 +45,6 @@ (declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) (declare-function org-remove-indentation "org" (code &optional n)) (declare-function org-store-link "org" (arg)) -(declare-function org-string-nw-p "org-macs" (s)) (declare-function org-trim "org" (s &optional keep-lead)) (declare-function outline-previous-heading "outline" ()) (declare-function org-id-find "org-id" (id &optional markerp)) 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 :deadline List deadline due on that date. When the date is today, also list any deadlines past due, or due within - `org-deadline-warning-days'. `:deadline' must appear before - `:scheduled' if the setting of - `org-agenda-skip-scheduled-if-deadline-is-shown' is to have - any effect. + `org-deadline-warning-days'. :deadline* Same as above, but only include the deadline if it has an hour specification as [h]h:mm. @@ -327,12 +324,14 @@ the daily/weekly agenda, see `org-agenda-skip-function'.") (string)) (list :tag "Number of days in agenda" (const org-agenda-span) - (choice (const :tag "Day" day) - (const :tag "Week" week) - (const :tag "Fortnight" fortnight) - (const :tag "Month" month) - (const :tag "Year" year) - (integer :tag "Custom"))) + (list + (const :format "" quote) + (choice (const :tag "Day" day) + (const :tag "Week" week) + (const :tag "Fortnight" fortnight) + (const :tag "Month" month) + (const :tag "Year" year) + (integer :tag "Custom")))) (list :tag "Fixed starting date" (const org-agenda-start-day) (string :value "2007-11-01")) @@ -975,18 +974,6 @@ will only be dimmed." (const :tag "Dim to a gray face" t) (const :tag "Make invisible" invisible))) -(defcustom org-timeline-show-empty-dates 3 - "Non-nil means `org-timeline' also shows dates without an entry. -When nil, only the days which actually have entries are shown. -When t, all days between the first and the last date are shown. -When an integer, show also empty dates, but if there is a gap of more than -N days, just insert a special line indicating the size of the gap." - :group 'org-agenda-skip - :type '(choice - (const :tag "None" nil) - (const :tag "All" t) - (integer :tag "at most"))) - (defgroup org-agenda-startup nil "Options concerning initial settings in the Agenda in Org Mode." :tag "Org Agenda Startup" @@ -1081,7 +1068,7 @@ have been removed when this is called, as will any matches for regular expressions listed in `org-agenda-entry-text-exclude-regexps'.") (defvar org-agenda-include-inactive-timestamps nil - "Non-nil means include inactive time stamps in agenda and timeline. + "Non-nil means include inactive time stamps in agenda. Dynamically scoped.") (defgroup org-agenda-windows nil @@ -1155,17 +1142,17 @@ When nil, only the days which actually have entries are shown." (defcustom org-agenda-format-date 'org-agenda-format-date-aligned "Format string for displaying dates in the agenda. -Used by the daily/weekly agenda and by the timeline. This should be -a format string understood by `format-time-string', or a function returning -the formatted date as a string. The function must take a single argument, -a calendar-style date list like (month day year)." +Used by the daily/weekly agenda. This should be a format string +understood by `format-time-string', or a function returning the +formatted date as a string. The function must take a single +argument, a calendar-style date list like (month day year)." :group 'org-agenda-daily/weekly :type '(choice (string :tag "Format string") (function :tag "Function"))) (defun org-agenda-format-date-aligned (date) - "Format a DATE string for display in the daily/weekly agenda, or timeline. + "Format a DATE string for display in the daily/weekly agenda. This function makes sure that dates are aligned for easy reading." (require 'cal-iso) (let* ((dayname (calendar-day-name date)) @@ -1225,8 +1212,7 @@ For example, 9:30am would become 09:30 rather than 9:30." (defcustom org-agenda-weekend-days '(6 0) "Which days are weekend? -These days get the special face `org-agenda-date-weekend' in the agenda -and timeline buffers." +These days get the special face `org-agenda-date-weekend' in the agenda." :group 'org-agenda-daily/weekly :type '(set :greedy t (const :tag "Monday" 1) @@ -1260,17 +1246,43 @@ Custom commands can set this variable in the options section." :version "24.1" :type 'boolean) -(defcustom org-agenda-repeating-timestamp-show-all t - "Non-nil means show all occurrences of a repeating stamp in the agenda. -When set to a list of strings, only show occurrences of repeating -stamps for these TODO keywords. When nil, only one occurrence is -shown, either today or the nearest into the future." +(defcustom org-agenda-show-future-repeats t + "Non-nil shows repeated entries in the future part of the agenda. +When set to the symbol `next' only the first future repeat is shown." + :group 'org-agenda-daily/weekly + :type '(choice + (const :tag "Show all repeated entries" t) + (const :tag "Show next repeated entry" next) + (const :tag "Do not show repeated entries" nil)) + :version "26.1" + :package-version '(Org . "9.1") + :safe #'symbolp) + +(defcustom org-agenda-prefer-last-repeat nil + "Non-nil sets date for repeated entries to their last repeat. + +When nil, display SCHEDULED and DEADLINE dates at their base +date, and in today's agenda, as a reminder. Display plain +time-stamps, on the other hand, at every repeat date in the past +in addition to the base date. + +When non-nil, show a repeated entry at its latest repeat date, +possibly being today even if it wasn't marked as done. This +setting is useful if you do not always mark repeated entries as +done and, yet, consider that reaching repeat date starts the task +anew. + +When set to a list of strings, prefer last repeats only for +entries with these TODO keywords." :group 'org-agenda-daily/weekly :type '(choice - (const :tag "Show repeating stamps" t) - (repeat :tag "Show repeating stamps for these TODO keywords" - (string :tag "TODO Keyword")) - (const :tag "Don't show repeating stamps" nil))) + (const :tag "Prefer last repeat" t) + (const :tag "Prefer base date" nil) + (repeat :tag "Prefer last repeat for entries with these TODO keywords" + (string :tag "TODO keyword"))) + :version "26.1" + :package-version '(Org . "9.1") + :safe (lambda (x) (or (booleanp x) (consp x)))) (defcustom org-scheduled-past-days 10000 "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 this day and will be listed until it is marked done or for the number of days given here." :group 'org-agenda-daily/weekly - :type 'integer) + :type 'integer + :safe 'integerp) + +(defcustom org-deadline-past-days 10000 + "Number of days to warn about missed deadlines. +When an item has deadline on a date, it shows up in the agenda on +this day and will appear as a reminder until it is marked DONE or +for the number of days given here." + :group 'org-agenda-daily/weekly + :type 'integer + :version "26.1" + :package-version '(Org . "9.1") + :safe 'integerp) (defcustom org-agenda-log-mode-items '(closed clock) "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 show headlines of level 1. When set to 0, the default value, don't limit agenda view by outline level." :group 'org-agenda-search-view - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type 'integer) @@ -1453,11 +1477,12 @@ the variable `org-agenda-time-grid'." (defcustom org-agenda-time-grid '((daily today require-timed) - "----------------" - (800 1000 1200 1400 1600 1800 2000)) + (800 1000 1200 1400 1600 1800 2000) + "......" + "----------------") "The settings for time grid for agenda display. -This is a list of three items. The first item is again a list. It contains +This is a list of four items. The first item is again a list. It contains symbols specifying conditions when the grid should be displayed: daily if the agenda shows a single day @@ -1466,10 +1491,14 @@ symbols specifying conditions when the grid should be displayed: require-timed show grid only if at least one item has a time specification remove-match skip grid times already present in an entry -The second item is a string which will be placed behind the grid time. +The second item is a list of integers, indicating the times that +should have a grid line. -The third item is a list of integers, indicating the times that should have -a grid line." +The third item is a string which will be placed right after the +times that have a grid line. + +The fourth item is a string placed after the grid times. This +will align with agenda items" :group 'org-agenda-time-grid :type '(list @@ -1481,8 +1510,9 @@ a grid line." require-timed) (const :tag "Skip grid times already present in an entry" remove-match)) - (string :tag "Grid String") - (repeat :tag "Grid Times" (integer :tag "Time")))) + (repeat :tag "Grid Times" (integer :tag "Time")) + (string :tag "Grid String (after agenda times)") + (string :tag "Grid String (aligns with agenda items)"))) (defcustom org-agenda-show-current-time-in-grid t "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." (defcustom org-agenda-prefix-format '((agenda . " %i %-12:c%?-12t% s") - (timeline . " % s") (todo . " %i %-12:c") (tags . " %i %-12:c") (search . " %i %-12:c")) "Format specifications for the prefix of items in the agenda views. An alist with five entries, each for the different agenda types. The -keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'. +keys of the sublists are `agenda', `todo', `search' and `tags'. The values are format strings. 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." (string :tag "General format") (list :greedy t :tag "View dependent" (cons (const agenda) (string :tag "Format")) - (cons (const timeline) (string :tag "Format")) (cons (const todo) (string :tag "Format")) (cons (const tags) (string :tag "Format")) (cons (const search) (string :tag "Format")))) - :group 'org-agenda-line-format) + :group 'org-agenda-line-format + :version "26.1" + :package-version '(Org . "9.1")) (defvar org-prefix-format-compiled nil "The compiled prefix format and associated variables. @@ -1795,7 +1825,7 @@ given agenda type. This can be set to a list of agenda types in which the agenda must display the inherited tags. Available types are `todo', -`agenda', `search' and `timeline'. +`agenda' and `search'. When set to nil, never show inherited tags in agenda lines." :group 'org-agenda-line-format @@ -1807,7 +1837,7 @@ When set to nil, never show inherited tags in agenda lines." (repeat :tag "Show inherited tags only in selected agenda types" (symbol :tag "Agenda type")))) -(defcustom org-agenda-use-tag-inheritance '(todo search timeline agenda) +(defcustom org-agenda-use-tag-inheritance '(todo search agenda) "List of agenda view types where to use tag inheritance. 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, agenda entries. Still, you may want the agenda to be aware of the inherited tags anyway, e.g. for later tag filtering. -Allowed value are `todo', `search', `timeline' and `agenda'. +Allowed value are `todo', `search' and `agenda'. This variable has no effect if `org-agenda-show-inherited-tags' is set to `always'. In that case, the agenda is aware of those @@ -1825,7 +1855,8 @@ tags. The default value sets tags in every agenda type. Setting this option to nil will speed up non-tags agenda view a lot." :group 'org-agenda - :version "24.3" + :version "26.1" + :package-version '(Org . "9.1") :type '(choice (const :tag "Use tag inheritance in all agenda types" t) (repeat :tag "Use tag inheritance in selected agenda types" @@ -1854,13 +1885,21 @@ When this is the symbol `prefix', only remove tags when (defvaralias 'org-agenda-remove-tags-when-in-prefix 'org-agenda-remove-tags) -(defcustom org-agenda-tags-column -80 +(defcustom org-agenda-tags-column 'auto "Shift tags in agenda items to this column. -If this number is positive, it specifies the column. If it is negative, -it means that the tags should be flushright to that column. For example, --80 works well for a normal 80 character screen." +If set to `auto', tags will be automatically aligned to the right +edge of the window. + +If set to a positive number, tags will be left-aligned to that +column. If set to a negative number, tags will be right-aligned +to that column. For example, -80 works well for a normal 80 +character screen." :group 'org-agenda-line-format - :type 'integer) + :type '(choice + (const :tag "Automatically align to right edge of window" auto) + (integer :tag "Specific column" -80)) + :package-version '(Org . "9.1") + :version "26.1") (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) @@ -2259,7 +2298,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines) (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) (org-defkey org-agenda-mode-map "r" 'org-agenda-redo) -(org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t))) +(org-defkey org-agenda-mode-map "g" 'org-agenda-redo-all) (org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort) (org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort) (org-defkey org-agenda-mode-map "\C-c\C-x\C-e" @@ -2310,6 +2349,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "b" 'org-agenda-earlier) (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) (org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) +(org-defkey org-agenda-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock-from-agenda) (org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add) (org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract) @@ -2323,6 +2363,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category) (org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline) (org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) +(org-defkey org-agenda-mode-map "\C-c\C-x_" 'org-timer-stop) (define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note) (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) @@ -2340,7 +2381,7 @@ The following commands are available: ("Agenda Files") "--" ("Agenda Dates" - ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)] + ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)] ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)]) @@ -2386,7 +2427,7 @@ The following commands are available: "--" ["Show Logbook entries" org-agenda-log-mode :style toggle :selected org-agenda-show-log - :active (org-agenda-check-type nil 'agenda 'timeline) + :active (org-agenda-check-type nil 'agenda) :keys "v l (or just l)"] ["Include archived trees" org-agenda-archives-mode :style toggle :selected org-agenda-archives-mode :active t @@ -2443,13 +2484,13 @@ The following commands are available: ["Schedule" org-agenda-schedule t] ["Set Deadline" org-agenda-deadline t] "--" - ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] - ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] - ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"] - ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"] - ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"] - ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"] - ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) + ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)] + ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)] + ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"] + ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"] + ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"] + ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"] + ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)]) ("Clock and Effort" ["Clock in" org-agenda-clock-in t] ["Clock out" org-agenda-clock-out t] @@ -2465,12 +2506,12 @@ The following commands are available: ["Decrease Priority" org-agenda-priority-down t] ["Show Priority" org-show-priority t]) ("Calendar/Diary" - ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)] - ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)] - ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)] - ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)] - ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)] - ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)] + ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)] + ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)] + ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)] + ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)] + ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)] + ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)] "--" ["Create iCalendar File" org-icalendar-combine-agenda-files t]) "--" @@ -2606,8 +2647,7 @@ type." (const agenda) (const todo) (const tags) - (const search) - (const timeline)) + (const search)) (integer :tag "Max number of entries"))))) (defcustom org-agenda-max-todos nil @@ -2625,8 +2665,7 @@ type." (const agenda) (const todo) (const tags) - (const search) - (const timeline)) + (const search)) (integer :tag "Max number of TODOs"))))) (defcustom org-agenda-max-tags nil @@ -2644,8 +2683,7 @@ type." (const agenda) (const todo) (const tags) - (const search) - (const timeline)) + (const search)) (integer :tag "Max number of tagged entries"))))) (defcustom org-agenda-max-effort nil @@ -2663,8 +2701,7 @@ to limit entries to in this type." (const agenda) (const todo) (const tags) - (const search) - (const timeline)) + (const search)) (integer :tag "Max number of minutes"))))) (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 m Call `org-tags-view' to display headlines with tags matching a condition (the user is prompted for the condition). M Like `m', but select only TODO entries, no ordinary headlines. -L Create a timeline for the current buffer. e Export views to associated files. s Search entries for keywords. S Search entries for keywords, only with TODO keywords. @@ -2846,12 +2882,6 @@ Pressing `<' twice means to restrict to the current subtree or region (copy-sequence note)) nil 'face 'org-warning))))))) t t)) - ((equal org-keys "L") - (unless (derived-mode-p 'org-mode) - (user-error "This is not an Org file")) - (unless restriction - (put 'org-agenda-files 'org-restrict (list bfn)) - (org-call-with-arg 'org-timeline arg))) ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects)) ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files)) ((equal org-keys "!") (customize-variable 'org-stuck-projects)) @@ -2901,15 +2931,15 @@ Agenda views are separated by `org-agenda-block-separator'." (erase-buffer) (insert (eval-when-compile (let ((header - "Press key for an agenda command: < Buffer, subtree/region restriction --------------------------------- > Remove restriction -a Agenda for current week or day e Export agenda views -t List of all TODO entries T Entries with special TODO kwd -m Match a TAGS/PROP/TODO query M Like m, but only TODO entries -s Search for keywords S Like s, but only TODO entries -L Timeline for current buffer # List stuck projects (!=configure) -/ Multi-occur C Configure custom agenda commands -? Find :FLAGGED: entries * Toggle sticky agenda views + "Press key for an agenda command: +-------------------------------- < Buffer, subtree/region restriction +a Agenda for current week or day > Remove restriction +t List of all TODO entries e Export agenda views +m Match a TAGS/PROP/TODO query T Entries with special TODO kwd +s Search for keywords M Like m, but only TODO entries +/ Multi-occur S Like s, but only TODO entries +? Find :FLAGGED: entries C Configure custom agenda commands +* Toggle sticky agenda views # List stuck projects (!=configure) ") (start 0)) (while (string-match @@ -3344,6 +3374,7 @@ the agenda to write." (save-window-excursion (let ((bs (copy-sequence (buffer-string))) (extension (file-name-extension file)) + (default-directory (file-name-directory file)) beg content) (with-temp-buffer (rename-buffer org-agenda-write-buffer-name t) @@ -3374,7 +3405,8 @@ the agenda to write." (kill-buffer (current-buffer)) (message "Org file written to %s" file))) ((member extension '("html" "htm")) - (require 'htmlize) + (or (require 'htmlize nil t) + (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) (set-buffer (htmlize-buffer (current-buffer))) (when org-agenda-export-html-style ;; replace <style> section with org-agenda-export-html-style @@ -3858,35 +3890,53 @@ dimming them." (when (eq (overlay-get o 'org-type) 'org-blocked-todo) (delete-overlay o))) (save-excursion - (let ((inhibit-read-only t) - (org-depend-tag-blocked nil) - org-blocked-by-checkboxes) + (let ((inhibit-read-only t)) (goto-char (point-min)) (while (let ((pos (text-property-not-all - (point) (point-max) 'todo-state nil))) + (point) (point-max) 'org-todo-blocked nil))) (when pos (goto-char pos))) - (setq org-blocked-by-checkboxes nil) - (let ((marker (org-get-at-bol 'org-hd-marker))) - (when (and (markerp marker) - (with-current-buffer (marker-buffer marker) - (save-excursion (goto-char marker) - (org-entry-blocked-p)))) - ;; Entries blocked by checkboxes cannot be made invisible. - ;; See `org-agenda-dim-blocked-tasks' for details. - (let* ((really-invisible - (and (not org-blocked-by-checkboxes) - (or invisible (eq org-agenda-dim-blocked-tasks - 'invisible)))) - (ov (make-overlay (if really-invisible (line-end-position 0) - (line-beginning-position)) - (line-end-position)))) - (if really-invisible (overlay-put ov 'invisible t) - (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) - (overlay-put ov 'org-type 'org-blocked-todo)))) + (let* ((invisible (eq (org-get-at-bol 'org-todo-blocked) 'invisible)) + (ov (make-overlay (if invisible + (line-end-position 0) + (line-beginning-position)) + (line-end-position)))) + (if invisible + (overlay-put ov 'invisible t) + (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) + (overlay-put ov 'org-type 'org-blocked-todo)) (forward-line)))) (when (called-interactively-p 'interactive) (message "Dim or hide blocked tasks...done"))) +(defun org-agenda--mark-blocked-entry (entry) + "For ENTRY a string with the text property `org-hd-marker', if +the header at `org-hd-marker' is blocked according to +`org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is +'invisible and the header is not blocked by checkboxes, set the +text property `org-todo-blocked' to 'invisible, otherwise set it +to t." + (when (get-text-property 0 'todo-state entry) + (let ((entry-marker (get-text-property 0 'org-hd-marker entry)) + (org-blocked-by-checkboxes nil) + ;; Necessary so that `org-entry-blocked-p' does not change + ;; the buffer. + (org-depend-tag-blocked nil)) + (when entry-marker + (let ((blocked + (with-current-buffer (marker-buffer entry-marker) + (save-excursion + (goto-char entry-marker) + (org-entry-blocked-p))))) + (when blocked + (let ((really-invisible + (and (not org-blocked-by-checkboxes) + (eq org-agenda-dim-blocked-tasks 'invisible)))) + (put-text-property + 0 (length entry) 'org-todo-blocked + (if really-invisible 'invisible t) + entry))))))) + entry) + (defvar org-agenda-skip-function nil "Function to be called at each match during agenda construction. 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." 'org-agenda-date-weekend) (t 'org-agenda-date))) -;;; Agenda timeline - -(defvar org-agenda-only-exact-dates nil) ; dynamically scoped -(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list' - -(defun org-timeline (&optional dotodo) - "Show a time-sorted view of the entries in the current Org file. - -Only entries with a time stamp of today or later will be listed. - -With `\\[universal-argument]' prefix, all unfinished TODO items will also be \ -shown, -under the current date. - -If the buffer contains an active region, only check the region -for dates." - (interactive "P") - (let* ((dopast t) - (org-agenda-show-log-scoped org-agenda-show-log) - (org-agenda-show-log org-agenda-show-log-scoped) - (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) - (current-buffer)))) - (date (calendar-current-date)) - (beg (if (org-region-active-p) (region-beginning) (point-min))) - (end (if (org-region-active-p) (region-end) (point-max))) - (day-numbers (org-get-all-dates - beg end 'no-ranges - t org-agenda-show-log-scoped ; always include today - org-timeline-show-empty-dates)) - (org-deadline-warning-days 0) - (org-agenda-only-exact-dates t) - (today (org-today)) - (past t) - args - s e rtn d emptyp) - (setq org-agenda-redo-command - (list 'let - (list (list 'org-agenda-show-log 'org-agenda-show-log)) - (list 'org-switch-to-buffer-other-window (current-buffer)) - (list 'org-timeline (list 'quote dotodo)))) - (put 'org-agenda-redo-command 'org-lprops nil) - (if (not dopast) - ;; Remove past dates from the list of dates. - (setq day-numbers (delq nil (mapcar (lambda(x) - (if (>= x today) x nil)) - day-numbers)))) - (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry))) - (org-compile-prefix-format 'timeline) - (org-set-sorting-strategy 'timeline) - (if org-agenda-show-log-scoped (push :closed args)) - (push :timestamp args) - (push :deadline args) - (push :scheduled args) - (push :sexp args) - (if dotodo (push :todo args)) - (insert "Timeline of file " entry "\n") - (add-text-properties (point-min) (point) - (list 'face 'org-agenda-structure)) - (org-agenda-mark-header-line (point-min)) - (while (setq d (pop day-numbers)) - (if (and (listp d) (eq (car d) :omitted)) - (progn - (setq s (point)) - (insert (format "\n[... %d empty days omitted]\n\n" (cdr d))) - (put-text-property s (1- (point)) 'face 'org-agenda-structure)) - (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil)) - (if (and (>= d today) - dopast - past) - (progn - (setq past nil) - (insert (make-string 79 ?-) "\n"))) - (setq date (calendar-gregorian-from-absolute d)) - (setq s (point)) - (setq rtn (and (not emptyp) - (apply 'org-agenda-get-day-entries entry - date args))) - (if (or rtn (equal d today) org-timeline-show-empty-dates) - (progn - (insert - (if (stringp org-agenda-format-date) - (format-time-string org-agenda-format-date - (org-time-from-absolute date)) - (funcall org-agenda-format-date date)) - "\n") - (put-text-property s (1- (point)) 'face - (org-agenda-get-day-face date)) - (put-text-property s (1- (point)) 'org-date-line t) - (put-text-property s (1- (point)) 'org-agenda-date-header t) - (if (equal d today) - (put-text-property s (1- (point)) 'org-today t)) - (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\n")) - (put-text-property s (1- (point)) 'day d))))) - (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) - (point-min))) - (add-text-properties - (point-min) (point-max) - `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command)) - (org-agenda-finalize) - (setq buffer-read-only t))) - -(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re) - "Return a list of all relevant day numbers from BEG to END buffer positions. -If NO-RANGES is non-nil, include only the start and end dates of a range, -not every single day in the range. If FORCE-TODAY is non-nil, make -sure that TODAY is included in the list. If INACTIVE is non-nil, also -inactive time stamps (those in square brackets) are included. -When EMPTY is non-nil, also include days without any entries." - (let ((re (concat - (if pre-re pre-re "") - (if inactive org-ts-regexp-both org-ts-regexp))) - dates dates1 date day day1 day2 ts1 ts2 pos) - (if force-today - (setq dates (list (org-today)))) - (save-excursion - (goto-char beg) - (while (re-search-forward re end t) - (setq day (time-to-days (org-time-string-to-time - (substring (match-string 1) 0 10) - (current-buffer) (match-beginning 0)))) - (or (memq day dates) (push day dates))) - (unless no-ranges - (goto-char beg) - (while (re-search-forward org-tr-regexp end t) - (setq pos (match-beginning 0)) - (setq ts1 (substring (match-string 1) 0 10) - ts2 (substring (match-string 2) 0 10) - day1 (time-to-days (org-time-string-to-time - ts1 (current-buffer) pos)) - day2 (time-to-days (org-time-string-to-time - ts2 (current-buffer) pos))) - (while (< (setq day1 (1+ day1)) day2) - (or (memq day1 dates) (push day1 dates))))) - (setq dates (sort dates '<)) - (when empty - (while (setq day (pop dates)) - (setq day2 (car dates)) - (push day dates1) - (when (and day2 empty) - (if (or (eq empty t) - (and (numberp empty) (<= (- day2 day) empty))) - (while (< (setq day (1+ day)) day2) - (push (list day) dates1)) - (push (cons :omitted (- day2 day)) dates1)))) - (setq dates (nreverse dates1))) - dates))) +(defvar org-agenda-show-log-scoped) ;;; Agenda Daily/Weekly @@ -4463,8 +4368,9 @@ as a whole, to include whitespace. with a colon, this will mean that the (non-regexp) snippets of the Boolean search must match as full words. -This command searches the agenda files, and in addition the files listed -in `org-agenda-text-search-extra-files'." +This command searches the agenda files, and in addition the files +listed in `org-agenda-text-search-extra-files' unless a restriction lock +is active." (interactive "P") (if org-agenda-overriding-arguments (setq todo-only (car org-agenda-overriding-arguments) @@ -4520,7 +4426,7 @@ in `org-agenda-text-search-extra-files'." (if (or org-agenda-search-view-always-boolean (member (string-to-char words) '(?- ?+ ?\{))) (setq boolean t)) - (setq words (org-split-string words)) + (setq words (split-string words)) (let (www w) (while (setq w (pop words)) (while (and (string-match "\\\\\\'" w) words) @@ -4574,10 +4480,20 @@ in `org-agenda-text-search-extra-files'." (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" regexp)))) (setq files (org-agenda-files nil 'ifmode)) - (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) - (pop org-agenda-text-search-extra-files) - (setq files (org-add-archive-files files))) - (setq files (append files org-agenda-text-search-extra-files) + ;; Add `org-agenda-text-search-extra-files' unless there is some + ;; restriction. + (unless (get 'org-agenda-files 'org-restrict) + (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) + (pop org-agenda-text-search-extra-files) + (setq files (org-add-archive-files files)))) + ;; Uniquify files. However, let `org-check-agenda-file' handle + ;; non-existent ones. + (setq files (cl-remove-duplicates + (append files org-agenda-text-search-extra-files) + :test (lambda (a b) + (and (file-exists-p a) + (file-exists-p b) + (file-equal-p a b)))) rtnall nil) (while (setq file (pop files)) (setq ee nil) @@ -4632,12 +4548,12 @@ in `org-agenda-text-search-extra-files'." (point-at-bol) (if hdl-only (point-at-eol) end))) (mapc (lambda (wr) (when (string-match wr str) - (goto-char (1- end)) - (throw :skip t))) + (goto-char (1- end)) + (throw :skip t))) regexps-) (mapc (lambda (wr) (unless (string-match wr str) - (goto-char (1- end)) - (throw :skip t))) + (goto-char (1- end)) + (throw :skip t))) (if todo-only (cons (concat "^\\*+[ \t]+" org-not-done-regexp) @@ -4913,43 +4829,6 @@ used by user-defined selections using `org-agenda-skip-function'.") This variable should not be set directly, but custom commands can bind it in the options section.") -(defun org-agenda-skip-entry-when-regexp-matches () - "Check if the current entry contains match for `org-agenda-skip-regexp'. -If yes, it returns the end position of this entry, causing agenda commands -to skip the entry but continuing the search in the subtree. This is a -function that can be put into `org-agenda-skip-function' for the duration -of a command." - (let ((end (save-excursion (org-end-of-subtree t))) - skip) - (save-excursion - (setq skip (re-search-forward org-agenda-skip-regexp end t))) - (and skip end))) - -(defun org-agenda-skip-subtree-when-regexp-matches () - "Check if the current subtree contains match for `org-agenda-skip-regexp'. -If yes, it returns the end position of this tree, causing agenda commands -to skip this subtree. This is a function that can be put into -`org-agenda-skip-function' for the duration of a command." - (let ((end (save-excursion (org-end-of-subtree t))) - skip) - (save-excursion - (setq skip (re-search-forward org-agenda-skip-regexp end t))) - (and skip end))) - -(defun org-agenda-skip-entry-when-regexp-matches-in-subtree () - "Check if the current subtree contains match for `org-agenda-skip-regexp'. -If yes, it returns the end position of the current entry (NOT the tree), -causing agenda commands to skip the entry but continuing the search in -the subtree. This is a function that can be put into -`org-agenda-skip-function' for the duration of a command. An important -use of this function is for the stuck project list." - (let ((end (save-excursion (org-end-of-subtree t))) - (entry-end (save-excursion (outline-next-heading) (1- (point)))) - skip) - (save-excursion - (setq skip (re-search-forward org-agenda-skip-regexp end t))) - (and skip entry-end))) - (defun org-agenda-skip-entry-if (&rest conditions) "Skip entry if any of CONDITIONS is true. See `org-agenda-skip-if' for details." @@ -4999,39 +4878,41 @@ keywords. Possible classes are: `todo', `done', `any'. If any of these conditions is met, this function returns the end point of the entity, causing the search to continue from there. This is a function that can be put into `org-agenda-skip-function' for the duration of a command." - (let (beg end m) - (org-back-to-heading t) - (setq beg (point) - end (if subtree - (progn (org-end-of-subtree t) (point)) - (progn (outline-next-heading) (1- (point))))) - (goto-char beg) + (org-back-to-heading t) + (let* ((beg (point)) + (end (if subtree (save-excursion (org-end-of-subtree t) (point)) + (org-entry-end-position))) + (planning-end (if subtree end (line-end-position 2))) + m) (and - (or - (and (memq 'scheduled conditions) - (re-search-forward org-scheduled-time-regexp end t)) - (and (memq 'notscheduled conditions) - (not (re-search-forward org-scheduled-time-regexp end t))) - (and (memq 'deadline conditions) - (re-search-forward org-deadline-time-regexp end t)) - (and (memq 'notdeadline conditions) - (not (re-search-forward org-deadline-time-regexp end t))) - (and (memq 'timestamp conditions) - (re-search-forward org-ts-regexp end t)) - (and (memq 'nottimestamp conditions) - (not (re-search-forward org-ts-regexp end t))) - (and (setq m (memq 'regexp conditions)) - (stringp (nth 1 m)) - (re-search-forward (nth 1 m) end t)) - (and (setq m (memq 'notregexp conditions)) - (stringp (nth 1 m)) - (not (re-search-forward (nth 1 m) end t))) - (and (or - (setq m (memq 'nottodo conditions)) - (setq m (memq 'todo-unblocked conditions)) - (setq m (memq 'nottodo-unblocked conditions)) - (setq m (memq 'todo conditions))) - (org-agenda-skip-if-todo m end))) + (or (and (memq 'scheduled conditions) + (re-search-forward org-scheduled-time-regexp planning-end t)) + (and (memq 'notscheduled conditions) + (not + (save-excursion + (re-search-forward org-scheduled-time-regexp planning-end t)))) + (and (memq 'deadline conditions) + (re-search-forward org-deadline-time-regexp planning-end t)) + (and (memq 'notdeadline conditions) + (not + (save-excursion + (re-search-forward org-deadline-time-regexp planning-end t)))) + (and (memq 'timestamp conditions) + (re-search-forward org-ts-regexp end t)) + (and (memq 'nottimestamp conditions) + (not (save-excursion (re-search-forward org-ts-regexp end t)))) + (and (setq m (memq 'regexp conditions)) + (stringp (nth 1 m)) + (re-search-forward (nth 1 m) end t)) + (and (setq m (memq 'notregexp conditions)) + (stringp (nth 1 m)) + (not (save-excursion (re-search-forward (nth 1 m) end t)))) + (and (or + (setq m (memq 'nottodo conditions)) + (setq m (memq 'todo-unblocked conditions)) + (setq m (memq 'nottodo-unblocked conditions)) + (setq m (memq 'todo conditions))) + (org-agenda-skip-if-todo m end))) end))) (defun org-agenda-skip-if-todo (args end) @@ -5040,43 +4921,36 @@ ARGS is a list with first element either `todo', `nottodo', `todo-unblocked' or `nottodo-unblocked'. The remainder is either a list of TODO keywords, or a state symbol `todo' or `done' or `any'." - (let ((kw (car args)) - (arg (cadr args)) - todo-wds todo-re) - (setq todo-wds - (org-uniquify - (cond - ((listp arg) ;; list of keywords - (if (member "*" arg) - (mapcar 'substring-no-properties org-todo-keywords-1) - arg)) - ((symbolp arg) ;; keyword class name - (cond - ((eq arg 'todo) - (org-delete-all org-done-keywords - (mapcar 'substring-no-properties - org-todo-keywords-1))) - ((eq arg 'done) org-done-keywords) - ((eq arg 'any) - (mapcar 'substring-no-properties org-todo-keywords-1))))))) - (setq todo-re - (concat "^\\*+[ \t]+\\<\\(" - (mapconcat 'identity todo-wds "\\|") - "\\)\\>")) - (cond - ((eq kw 'todo) (re-search-forward todo-re end t)) - ((eq kw 'nottodo) (not (re-search-forward todo-re end t))) - ((eq kw 'todo-unblocked) - (catch 'unblocked - (while (re-search-forward todo-re end t) - (or (org-entry-blocked-p) (throw 'unblocked t))) - nil)) - ((eq kw 'nottodo-unblocked) - (catch 'unblocked - (while (re-search-forward todo-re end t) - (or (org-entry-blocked-p) (throw 'unblocked nil))) - t)) - ))) + (let ((todo-re + (concat "^\\*+[ \t]+" + (regexp-opt + (pcase args + (`(,_ todo) + (org-delete-all org-done-keywords + (copy-sequence org-todo-keywords-1))) + (`(,_ done) org-done-keywords) + (`(,_ any) org-todo-keywords-1) + (`(,_ ,(pred atom)) + (error "Invalid TODO class or type: %S" args)) + (`(,_ ,(pred (member "*"))) org-todo-keywords-1) + (`(,_ ,todo-list) todo-list)) + 'words)))) + (pcase args + (`(todo . ,_) + (let (case-fold-search) (re-search-forward todo-re end t))) + (`(nottodo . ,_) + (not (let (case-fold-search) (re-search-forward todo-re end t)))) + (`(todo-unblocked . ,_) + (catch :unblocked + (while (let (case-fold-search) (re-search-forward todo-re end t)) + (when (org-entry-blocked-p) (throw :unblocked t))) + nil)) + (`(nottodo-unblocked . ,_) + (catch :unblocked + (while (let (case-fold-search) (re-search-forward todo-re end t)) + (when (org-entry-blocked-p) (throw :unblocked nil))) + t)) + (`(,type . ,_) (error "Unknown TODO skip type: %S" type))))) ;;;###autoload (defun org-agenda-list-stuck-projects (&rest ignore) @@ -5639,9 +5513,6 @@ displayed in agenda view." (looking-at org-ts-regexp-both) (match-string 0)))) (todo-state (org-get-todo-state)) - (show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all))) (warntime (get-text-property (point) 'org-appt-warntime)) (done? (member todo-state org-done-keywords))) ;; Possibly skip done tasks. @@ -5650,22 +5521,39 @@ displayed in agenda view." ;; S-exp entry doesn't match current day: skip it. (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date))) (throw :skip nil)) - ;; When time-stamp doesn't match CURRENT but has a repeater, - ;; make sure it repeats on CURRENT. Furthermore, if - ;; SHOW-ALL is nil, ensure that repeats are only the first - ;; before and the first after today. - (when (and repeat - (if show-all - (/= current - (org-agenda--timestamp-to-absolute - repeat current 'future (current-buffer) pos)) - (and (/= current - (org-agenda--timestamp-to-absolute - repeat today 'past (current-buffer) pos)) - (/= current - (org-agenda--timestamp-to-absolute - repeat today 'future (current-buffer) pos))))) - (throw :skip nil)) + (when repeat + (let* ((past + ;; A repeating time stamp is shown at its base + ;; date and every repeated date up to TODAY. If + ;; `org-agenda-prefer-last-repeat' is non-nil, + ;; however, only the last repeat before today + ;; (inclusive) is shown. + (org-agenda--timestamp-to-absolute + repeat + (if (or (> current today) + (eq org-agenda-prefer-last-repeat t) + (member todo-state org-agenda-prefer-last-repeat)) + today + current) + 'past (current-buffer) pos)) + (future + ;; Display every repeated date past TODAY + ;; (exclusive) unless + ;; `org-agenda-show-future-repeats' is nil. If + ;; this variable is set to `next', only display + ;; the first repeated date after TODAY + ;; (exclusive). + (cond + ((<= current today) past) + ((not org-agenda-show-future-repeats) past) + (t + (let ((base (if (eq org-agenda-show-future-repeats 'next) + (1+ today) + current))) + (org-agenda--timestamp-to-absolute + repeat base 'future (current-buffer) pos)))))) + (when (and (/= current past) (/= current future)) + (throw :skip nil)))) (save-excursion (re-search-backward org-outline-regexp-bol nil t) ;; Possibly skip time-stamp when a deadline is set. @@ -5835,7 +5723,8 @@ then those holidays will be skipped." (list (if (memq 'closed items) (concat "\\<" org-closed-string)) (if (memq 'clock items) (concat "\\<" org-clock-string)) - (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?")))) + (if (memq 'state items) + (format "- State \"%s\".*?" org-todo-regexp))))) (parts-re (if parts (mapconcat 'identity parts "\\|") (error "`org-agenda-log-mode-items' is empty"))) (regexp (concat @@ -5923,8 +5812,7 @@ then those holidays will be skipped." "Add overlays, showing issues with clocking. See also the user option `org-agenda-clock-consistency-checks'." (interactive) - (let* ((org-time-clocksum-use-effort-durations nil) - (pl org-agenda-clock-consistency-checks) + (let* ((pl org-agenda-clock-consistency-checks) (re (concat "^[ \t]*" org-clock-string "[ \t]+" @@ -5932,14 +5820,14 @@ See also the user option `org-agenda-clock-consistency-checks'." "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second (tlstart 0.) (tlend 0.) - (maxtime (org-hh:mm-string-to-minutes + (maxtime (org-duration-to-minutes (or (plist-get pl :max-duration) "24:00"))) - (mintime (org-hh:mm-string-to-minutes + (mintime (org-duration-to-minutes (or (plist-get pl :min-duration) 0))) - (maxgap (org-hh:mm-string-to-minutes + (maxgap (org-duration-to-minutes ;; default 30:00 means never complain (or (plist-get pl :max-gap) "30:00"))) - (gapok (mapcar 'org-hh:mm-string-to-minutes + (gapok (mapcar #'org-duration-to-minutes (plist-get pl :gap-ok-around))) (def-face (or (plist-get pl :default-face) '((:background "DarkRed") (:foreground "white")))) @@ -5973,14 +5861,12 @@ See also the user option `org-agenda-clock-consistency-checks'." ((> dt (* 60 maxtime)) ;; a very long clocking chunk (setq issue (format "Clocking interval is very long: %s" - (org-minutes-to-clocksum-string - (floor (/ (float dt) 60.)))) + (org-duration-from-minutes (floor (/ dt 60.)))) face (or (plist-get pl :long-face) face))) ((< dt (* 60 mintime)) ;; a very short clocking chunk (setq issue (format "Clocking interval is very short: %s" - (org-minutes-to-clocksum-string - (floor (/ (float dt) 60.)))) + (org-duration-from-minutes (floor (/ dt 60.)))) face (or (plist-get pl :short-face) face))) ((and (> tlend 0) (< ts tlend)) ;; Two clock entries are overlapping @@ -6066,27 +5952,33 @@ specification like [h]h:mm." (pos (1- (match-beginning 1))) (todo-state (save-match-data (org-get-todo-state))) (done? (member todo-state org-done-keywords)) - (show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all))) - (sexp? (string-prefix-p "%%" s)) - ;; DEADLINE is the bare deadline date, i.e., without - ;; any repeater, or the last repeat if SHOW-ALL is - ;; non-nil. REPEAT is closest repeat after CURRENT, if - ;; all repeated time stamps are to be shown, or after - ;; TODAY otherwise. REPEAT only applies to future - ;; dates. - (deadline (cond - (sexp? (org-agenda--timestamp-to-absolute s current)) - (show-all (org-agenda--timestamp-to-absolute s)) - (t (org-agenda--timestamp-to-absolute - s today 'past (current-buffer) pos)))) - (repeat (cond (sexp? deadline) - ((< current today) deadline) - (t - (org-agenda--timestamp-to-absolute - s (if show-all current today) 'future - (current-buffer) pos)))) + (sexp? (string-prefix-p "%%" s)) + ;; DEADLINE is the deadline date for the entry. It is + ;; either the base date or the last repeat, according + ;; to `org-agenda-prefer-last-repeat'. + (deadline + (cond + (sexp? (org-agenda--timestamp-to-absolute s current)) + ((or (eq org-agenda-prefer-last-repeat t) + (member todo-state org-agenda-prefer-last-repeat)) + (org-agenda--timestamp-to-absolute + s today 'past (current-buffer) pos)) + (t (org-agenda--timestamp-to-absolute s)))) + ;; REPEAT is the future repeat closest from CURRENT, + ;; according to `org-agenda-show-future-repeats'. If + ;; the latter is nil, or if the time stamp has no + ;; repeat part, default to DEADLINE. + (repeat + (cond + (sexp? deadline) + ((<= current today) deadline) + ((not org-agenda-show-future-repeats) deadline) + (t + (let ((base (if (eq org-agenda-show-future-repeats 'next) + (1+ today) + current))) + (org-agenda--timestamp-to-absolute + s base 'future (current-buffer) pos))))) (diff (- deadline current)) (suppress-prewarning (let ((scheduled @@ -6111,17 +6003,17 @@ specification like [h]h:mm." (let ((org-deadline-warning-days suppress-prewarning)) (org-get-wdays s)) (org-get-wdays s)))) - ;; When to show a deadline in the calendar: if the - ;; expiration is within WDAYS warning time. Past-due - ;; deadlines are only shown on today agenda. - (when (cond ((= current deadline) nil) - ((< deadline today) - (and (not today?) - (or (< current today) (/= repeat current)))) - ((> deadline current) - (or (not today?) (> diff wdays))) - (t (/= repeat current))) - (throw :skip nil)) + (cond + ;; Only display deadlines at their base date, at future + ;; repeat occurrences or in today agenda. + ((= current deadline) nil) + ((= current repeat) nil) + ((not today?) (throw :skip nil)) + ;; Upcoming deadline: display within warning period WDAYS. + ((> deadline current) (when (> diff wdays) (throw :skip nil))) + ;; Overdue deadline: warn about it for + ;; `org-deadline-past-days' duration. + (t (when (< org-deadline-past-days (- diff)) (throw :skip nil)))) ;; Possibly skip done tasks. (when (and done? (or org-agenda-skip-deadline-if-done @@ -6131,8 +6023,8 @@ specification like [h]h:mm." (re-search-backward "^\\*+[ \t]+" nil t) (goto-char (match-end 0)) (let* ((category (org-get-category)) - (level - (make-string (org-reduced-level (org-outline-level)) ?\s)) + (level (make-string (org-reduced-level (org-outline-level)) + ?\s)) (head (buffer-substring (point) (line-end-position))) (inherited-tags (or (eq org-agenda-show-inherited-tags 'always) @@ -6154,23 +6046,16 @@ specification like [h]h:mm." (item (org-agenda-format-item ;; Insert appropriate suffixes before deadlines. + ;; Those only apply to today agenda. (pcase-let ((`(,now ,future ,past) org-agenda-deadline-leaders)) (cond - ;; Future (i.e., repeated) deadlines are - ;; displayed as new headlines. - ((> current today) now) - ;; When SHOW-ALL is nil, prefer repeated - ;; deadlines over reminders of past deadlines. - ((and (not show-all) (= repeat today)) now) - ((= deadline current) now) - ((< deadline current) (format past (- diff))) - (t (format future diff)))) - head level category tags - (and (or (= repeat current) (= deadline current)) - time))) + ((and today? (< deadline today)) (format past (- diff))) + ((and today? (> deadline today)) (format future diff)) + (t now))) + head level category tags time)) (face (org-agenda-deadline-face - (- 1 (/ (float (- deadline current)) (max wdays 1))))) + (- 1 (/ (float diff) (max wdays 1))))) (upcoming? (and today? (> deadline today))) (warntime (get-text-property (point) 'org-appt-warntime))) (org-add-props item props @@ -6184,9 +6069,7 @@ specification like [h]h:mm." ;; Overdue deadlines get the highest priority ;; increase, then imminent deadlines and eventually ;; more distant deadlines. - (let ((adjust (cond ((not today?) 0) - ((and (not show-all) (= repeat current)) 0) - (t (- diff))))) + (let ((adjust (if today? (- diff) 0))) (+ adjust (org-get-priority item))) 'todo-state todo-state 'type (if upcoming? "upcoming-deadline" "deadline") @@ -6236,28 +6119,33 @@ scheduled items with an hour specification like [h]h:mm." (pos (1- (match-beginning 1))) (todo-state (save-match-data (org-get-todo-state))) (donep (member todo-state org-done-keywords)) - (show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all))) (sexp? (string-prefix-p "%%" s)) - ;; SCHEDULE is the bare scheduled date, i.e., without - ;; any repeater if non-nil, or last repeat if SHOW-ALL - ;; is nil. REPEAT is the closest repeat after CURRENT, - ;; if all repeated time stamps are to be shown, or - ;; after TODAY otherwise. REPEAT only applies to - ;; future dates. - (schedule (cond - (sexp? (org-agenda--timestamp-to-absolute s current)) - (show-all (org-agenda--timestamp-to-absolute s)) - (t (org-agenda--timestamp-to-absolute - s today 'past (current-buffer) pos)))) - (repeat (cond - (sexp? schedule) - ((< current today) schedule) - (t - (org-agenda--timestamp-to-absolute - s (if show-all current today) 'future - (current-buffer) pos)))) + ;; SCHEDULE is the scheduled date for the entry. It is + ;; either the bare date or the last repeat, according + ;; to `org-agenda-prefer-last-repeat'. + (schedule + (cond + (sexp? (org-agenda--timestamp-to-absolute s current)) + ((or (eq org-agenda-prefer-last-repeat t) + (member todo-state org-agenda-prefer-last-repeat)) + (org-agenda--timestamp-to-absolute + s today 'past (current-buffer) pos)) + (t (org-agenda--timestamp-to-absolute s)))) + ;; REPEAT is the future repeat closest from CURRENT, + ;; according to `org-agenda-show-future-repeats'. If + ;; the latter is nil, or if the time stamp has no + ;; repeat part, default to SCHEDULE. + (repeat + (cond + (sexp? schedule) + ((<= current today) schedule) + ((not org-agenda-show-future-repeats) schedule) + (t + (let ((base (if (eq org-agenda-show-future-repeats 'next) + (1+ today) + current))) + (org-agenda--timestamp-to-absolute + s base 'future (current-buffer) pos))))) (diff (- current schedule)) (warntime (get-text-property (point) 'org-appt-warntime)) (pastschedp (< schedule today)) @@ -6300,9 +6188,9 @@ scheduled items with an hour specification like [h]h:mm." (when (or (and (> ddays 0) (< diff ddays)) (> diff org-scheduled-past-days) (> schedule current) - (and (< schedule current) - (not todayp) - (/= repeat current))) + (and (/= current schedule) + (/= current today) + (/= current repeat))) (throw :skip nil))) ;; Possibly skip done tasks. (when (and donep @@ -6318,7 +6206,9 @@ scheduled items with an hour specification like [h]h:mm." habitp)) nil) (`repeated-after-deadline - (>= repeat (time-to-days (org-get-deadline-time (point))))) + (let ((deadline (time-to-days + (org-get-deadline-time (point))))) + (and (<= schedule deadline) (> current deadline)))) (`not-today pastschedp) (`t t) (_ nil)) @@ -6345,8 +6235,8 @@ scheduled items with an hour specification like [h]h:mm." (memq 'agenda org-agenda-use-tag-inheritance))))) (tags (org-get-tags-at nil (not inherited-tags))) - (level - (make-string (org-reduced-level (org-outline-level)) ?\s)) + (level (make-string (org-reduced-level (org-outline-level)) + ?\s)) (head (buffer-substring (point) (line-end-position))) (time (cond @@ -6358,21 +6248,11 @@ scheduled items with an hour specification like [h]h:mm." (t 'time))) (item (org-agenda-format-item - (pcase-let ((`(,first ,next) org-agenda-scheduled-leaders)) - (cond - ;; If CURRENT is in the future, don't use past - ;; scheduled prefix. - ((> current today) first) - ;; SHOW-ALL focuses on future repeats. If one - ;; such repeat happens today, ignore late - ;; schedule reminder. However, still report - ;; such reminders when repeat happens later. - ((and (not show-all) (= repeat today)) first) - ;; Initial report. - ((= schedule current) first) - ;; Subsequent reminders. Count from base - ;; schedule. - (t (format next diff)))) + (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders)) + ;; Show a reminder of a past scheduled today. + (if (and todayp pastschedp) + (format past diff) + first)) head level category tags time nil habitp)) (face (cond ((and (not habitp) pastschedp) 'org-scheduled-previously) @@ -6419,8 +6299,26 @@ scheduled items with an hour specification like [h]h:mm." (end-time (match-string 2))) (setq s1 (match-string 1) s2 (match-string 2) - d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos)) - d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos))) + d1 (time-to-days + (condition-case err + (org-time-string-to-time s1) + (error + (error + "Bad timestamp %S at %d in buffer %S\nError was: %s" + s1 + pos + (current-buffer) + (error-message-string err))))) + d2 (time-to-days + (condition-case err + (org-time-string-to-time s2) + (error + (error + "Bad timestamp %S at %d in buffer %S\nError was: %s" + s2 + pos + (current-buffer) + (error-message-string err)))))) (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) ;; Only allow days between the limits, because the normal ;; date stamps will catch the limits. @@ -6555,6 +6453,7 @@ Any match of REMOVE-RE will be removed from TXT." (get-text-property 1 'effort txt))) ;; time, tag, effort are needed for the eval of the prefix format (tag (if tags (nth (1- (length tags)) tags) "")) + (time-grid-trailing-characters (nth 2 org-agenda-time-grid)) time (ts (if dotime (concat (if (stringp dotime) dotime "") @@ -6588,18 +6487,19 @@ Any match of REMOVE-RE will be removed from TXT." (if s1 (setq s1 (org-get-time-of-day s1 'string t))) (if s2 (setq s2 (org-get-time-of-day s2 'string t))) - ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set - (let (org-time-clocksum-use-effort-durations) - (when (and s1 (not s2) org-agenda-default-appointment-duration) - (setq s2 - (org-minutes-to-clocksum-string - (+ (org-hh:mm-string-to-minutes s1) - org-agenda-default-appointment-duration))))) + ;; Try to set s2 if s1 and + ;; `org-agenda-default-appointment-duration' are set + (when (and s1 (not s2) org-agenda-default-appointment-duration) + (setq s2 + (org-duration-from-minutes + (+ (org-duration-to-minutes s1 t) + org-agenda-default-appointment-duration) + nil t))) ;; Compute the duration (when s2 - (setq duration (- (org-hh:mm-string-to-minutes s2) - (org-hh:mm-string-to-minutes s1))))) + (setq duration (- (org-duration-to-minutes s2) + (org-duration-to-minutes s1))))) (when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt) ;; Tags are in the string @@ -6632,8 +6532,8 @@ Any match of REMOVE-RE will be removed from TXT." (s1 (concat (org-agenda-time-of-day-to-ampm-maybe s1) (if org-agenda-timegrid-use-ampm - "........ " - "......"))) + (concat time-grid-trailing-characters " ") + time-grid-trailing-characters))) (t "")) extra (or (and (not habitp) extra) "") category (if (symbolp category) (symbol-name category) category) @@ -6726,8 +6626,8 @@ TODAYP is t when the current agenda view is on today." (let* ((have (delq nil (mapcar (lambda (x) (get-text-property 1 'time-of-day x)) list))) - (string (nth 1 org-agenda-time-grid)) - (gridtimes (nth 2 org-agenda-time-grid)) + (string (nth 3 org-agenda-time-grid)) + (gridtimes (nth 1 org-agenda-time-grid)) (req (car org-agenda-time-grid)) (remove (member 'remove-match req)) new time) @@ -6910,6 +6810,8 @@ The optional argument TYPE tells the agenda type." (setq list (org-agenda-limit-entries list 'tags max-tags))) (when max-entries (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries))) + (when (and org-agenda-dim-blocked-tasks org-blocker-hook) + (setq list (mapcar #'org-agenda--mark-blocked-entry list))) (mapconcat 'identity list "\n"))) (defun org-agenda-limit-entries (list prop limit &optional fn) @@ -7186,6 +7088,22 @@ their type." 'help-echo "Agendas are currently limited to this subtree.") (delete-overlay org-agenda-restriction-lock-overlay) +(defun org-agenda-set-restriction-lock-from-agenda (arg) + "Set the restriction lock to the agenda item at point from within the agenda. +When called with a `\\[universal-argument]' prefix, restrict to +the file which contains the item. +Argument ARG is the prefix argument." + (interactive "P") + (unless (derived-mode-p 'org-agenda-mode) + (user-error "Not in an Org agenda buffer")) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (with-current-buffer buffer + (goto-char pos) + (org-agenda-set-restriction-lock arg)))) + ;;;###autoload (defun org-agenda-set-restriction-lock (&optional type) "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." (defun org-agenda-check-type (error &rest types) "Check if agenda buffer is of allowed type. If ERROR is non-nil, throw an error, otherwise just return nil. -Allowed types are `agenda' `timeline' `todo' `tags' `search'." - (if (not org-agenda-type) - (error "No Org agenda currently displayed") - (if (memq org-agenda-type types) - t - (if error - (error "Not allowed in %s-type agenda buffers" org-agenda-type) - nil)))) +Allowed types are `agenda' `todo' `tags' `search'." + (cond ((not org-agenda-type) + (error "No Org agenda currently displayed")) + ((memq org-agenda-type types) t) + (error + (error "Not allowed in %s-type agenda buffers" org-agenda-type)) + (t nil))) (defun org-agenda-Quit () "Exit the agenda, killing the agenda buffer. @@ -7424,6 +7341,17 @@ in the agenda." (org-goto-line line) (recenter window-line))) +(defun org-agenda-redo-all (&optional exhaustive) + "Rebuild all agenda views in the current buffer. +With a prefix argument, do so in all agenda buffers." + (interactive "P") + (if exhaustive + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (derived-mode-p 'org-agenda-mode) + (org-agenda-redo t)))) + (org-agenda-redo t))) + (defvar org-global-tags-completion-table nil) (defvar org-agenda-filter-form nil) (defvar org-agenda-filtered-by-category nil) @@ -7583,8 +7511,9 @@ also press `-' or `+' to switch between filtering and excluding." (unless char (while (not (memq char valid-char-list)) (message - "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit" - (if exclude "Exclude" "Filter") tag-chars + "%s by tag [%s ]:tag-char, [TAB]:tag, %s[/]:off, [+/-]:filter/exclude%s, [q]:quit" + (if exclude "Exclude" "Filter") + tag-chars (if org-agenda-auto-exclude-function "[RET], " "") (if expand "" ", no grouptag expand")) (setq char (read-char-exclusive)) @@ -7721,7 +7650,7 @@ E looks like \"+<2:25\"." ((equal op ??) op) (t '=))) (list 'org-agenda-compare-effort (list 'quote op) - (org-duration-string-to-minutes e)))) + (org-duration-to-minutes e)))) (defun org-agenda-compare-effort (op value) "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." (org-agenda-manipulate-query ?\})) (defun org-agenda-manipulate-query (char) (cond - ((memq org-agenda-type '(timeline agenda)) + ((eq org-agenda-type 'agenda) (let ((org-agenda-include-inactive-timestamps t)) (org-agenda-redo)) (message "Display now includes inactive timestamps as well")) @@ -7917,7 +7846,7 @@ Negative selection means regexp must not match for selection of an entry." (defun org-agenda-goto-today () "Go to today." (interactive) - (org-agenda-check-type t 'timeline 'agenda) + (org-agenda-check-type t 'agenda) (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) (curspan (nth 2 args)) (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." (?D (call-interactively 'org-agenda-toggle-diary)) (?\! (call-interactively 'org-agenda-toggle-deadlines)) (?\[ (let ((org-agenda-include-inactive-timestamps t)) - (org-agenda-check-type t 'timeline 'agenda) + (org-agenda-check-type t 'agenda) (org-agenda-redo)) (message "Display now includes inactive timestamps as well")) (?q (message "Abort")) @@ -8171,7 +8100,7 @@ so that the date SD will be in that range." (defun org-agenda-next-date-line (&optional arg) "Jump to the next line indicating a date in agenda buffer." (interactive "p") - (org-agenda-check-type t 'agenda 'timeline) + (org-agenda-check-type t 'agenda) (beginning-of-line 1) ;; This does not work if user makes date format that starts with a blank (if (looking-at "^\\S-") (forward-char 1)) @@ -8184,7 +8113,7 @@ so that the date SD will be in that range." (defun org-agenda-previous-date-line (&optional arg) "Jump to the previous line indicating a date in agenda buffer." (interactive "p") - (org-agenda-check-type t 'agenda 'timeline) + (org-agenda-check-type t 'agenda) (beginning-of-line 1) (if (not (re-search-backward "^\\S-" nil t arg)) (error "No previous date before this line in this buffer"))) @@ -8263,7 +8192,7 @@ configured in `org-agenda-log-mode-items'. With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \ log items, nothing else." (interactive "P") - (org-agenda-check-type t 'agenda 'timeline) + (org-agenda-check-type t 'agenda) (setq org-agenda-show-log (cond ((equal special '(16)) 'only) @@ -9040,7 +8969,11 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (defun org-agenda-align-tags (&optional line) "Align all tags in agenda items to `org-agenda-tags-column'." - (let ((inhibit-read-only t) l c) + (let ((inhibit-read-only t) + (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column) + (- (window-text-width)) + org-agenda-tags-column)) + l c) (save-excursion (goto-char (if line (point-at-bol) (point-min))) (while (re-search-forward "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" @@ -9225,7 +9158,7 @@ Called with a universal prefix arg, show the priority instead of setting it." (defun org-agenda-date-later (arg &optional what) "Change the date of this item to ARG day(s) later." (interactive "p") - (org-agenda-check-type t 'agenda 'timeline) + (org-agenda-check-type t 'agenda) (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) @@ -9236,8 +9169,7 @@ Called with a universal prefix arg, show the priority instead of setting it." (with-current-buffer buffer (widen) (goto-char pos) - (if (not (org-at-timestamp-p)) - (error "Cannot find time stamp")) + (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) (when (and org-agenda-move-date-from-past-immediately-to-today (equal arg 1) (or (not what) (eq what 'day)) @@ -9309,7 +9241,7 @@ Called with a universal prefix arg, show the priority instead of setting it." The prefix ARG is passed to the `org-time-stamp' command and can therefore be used to request time specification in the time stamp." (interactive "P") - (org-agenda-check-type t 'agenda 'timeline) + (org-agenda-check-type t 'agenda) (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) @@ -9319,8 +9251,7 @@ be used to request time specification in the time stamp." (with-current-buffer buffer (widen) (goto-char pos) - (if (not (org-at-timestamp-p t)) - (error "Cannot find time stamp")) + (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) (org-agenda-show-new-time marker org-last-changed-timestamp)) (message "Time stamp changed to %s" org-last-changed-timestamp))) @@ -9329,7 +9260,7 @@ be used to request time specification in the time stamp." "Schedule the item at point. ARG is passed through to `org-schedule'." (interactive "P") - (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) + (org-agenda-check-type t 'agenda 'todo 'tags 'search) (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) @@ -9350,7 +9281,7 @@ ARG is passed through to `org-schedule'." "Schedule the item at point. ARG is passed through to `org-deadline'." (interactive "P") - (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) + (org-agenda-check-type t 'agenda 'todo 'tags 'search) (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) @@ -9659,7 +9590,7 @@ entries in that Org file." (defun org-agenda-execute-calendar-command (cmd) "Execute a calendar command from the agenda with date from cursor." - (org-agenda-check-type t 'agenda 'timeline) + (org-agenda-check-type t 'agenda) (require 'diary-lib) (unless (get-text-property (min (1- (point-max)) (point)) 'day) (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." (defun org-agenda-goto-calendar () "Open the Emacs calendar with the date at the cursor." (interactive) - (org-agenda-check-type t 'agenda 'timeline) + (org-agenda-check-type t 'agenda) (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) (user-error "Don't know which date to open in calendar"))) (date (calendar-gregorian-from-absolute day)) @@ -9734,7 +9665,7 @@ This is a command that has to be installed in `calendar-mode-map'." (defun org-agenda-convert-date () (interactive) - (org-agenda-check-type t 'agenda 'timeline) + (org-agenda-check-type t 'agenda) (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) date s) (unless day @@ -9884,178 +9815,191 @@ bulk action." "Execute an remote-editing action on all marked entries. The prefix arg is passed through to the command if possible." (interactive "P") - ;; Make sure we have markers, and only valid ones + ;; Make sure we have markers, and only valid ones. (unless org-agenda-bulk-marked-entries (user-error "No entries are marked")) - (mapc - (lambda (m) - (unless (and (markerp m) - (marker-buffer m) - (buffer-live-p (marker-buffer m)) - (marker-position m)) - (user-error "Marker %s for bulk command is invalid" m))) - org-agenda-bulk-marked-entries) - - ;; Prompt for the bulk command - (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: "))) - (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile " - "[S]catter [f]unction " - (when org-agenda-bulk-custom-functions - (concat " Custom: [" - (mapconcat (lambda(f) (char-to-string (car f))) - org-agenda-bulk-custom-functions "") - "]")))) - (catch 'exit - (let* ((action (read-char-exclusive)) - (org-log-refile (if org-log-refile 'time nil)) - (entries (reverse org-agenda-bulk-marked-entries)) - (org-overriding-default-time - (if (get-text-property (point) 'org-agenda-date-header) - (org-get-cursor-date))) - redo-at-end - cmd rfloc state e tag pos (cnt 0) (cntskip 0)) - (cond - ((equal action ?p) - (let ((org-agenda-persistent-marks - (not org-agenda-persistent-marks))) - (org-agenda-bulk-action) - (throw 'exit nil))) - - ((equal action ?$) - (setq cmd '(org-agenda-archive))) - - ((equal action ?A) - (setq cmd '(org-agenda-archive-to-archive-sibling))) - - ((member action '(?r ?w)) - (setq rfloc (org-refile-get-location - "Refile to" - (marker-buffer (car entries)) - org-refile-allow-creating-parent-nodes)) - (if (nth 3 rfloc) - (setcar (nthcdr 3 rfloc) - (move-marker (make-marker) (nth 3 rfloc) - (or (get-file-buffer (nth 1 rfloc)) - (find-buffer-visiting (nth 1 rfloc)) - (error "This should not happen"))))) - - (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t) - redo-at-end t)) - - ((equal action ?t) - (setq state (completing-read + (dolist (m org-agenda-bulk-marked-entries) + (unless (and (markerp m) + (marker-buffer m) + (buffer-live-p (marker-buffer m)) + (marker-position m)) + (user-error "Marker %s for bulk command is invalid" m))) + + ;; Prompt for the bulk command. + (message + (concat (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ") + "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile " + "[S]catter [f]unction " + (and org-agenda-bulk-custom-functions + (format " Custom: [%s]" + (mapconcat (lambda (f) (char-to-string (car f))) + org-agenda-bulk-custom-functions + ""))))) + (catch 'exit + (let* ((org-log-refile (if org-log-refile 'time nil)) + (entries (reverse org-agenda-bulk-marked-entries)) + (org-overriding-default-time + (and (get-text-property (point) 'org-agenda-date-header) + (org-get-cursor-date))) + redo-at-end + cmd) + (pcase (read-char-exclusive) + (?p + (let ((org-agenda-persistent-marks + (not org-agenda-persistent-marks))) + (org-agenda-bulk-action) + (throw 'exit nil))) + + (?$ + (setq cmd #'org-agenda-archive)) + + (?A + (setq cmd #'org-agenda-archive-to-archive-sibling)) + + ((or ?r ?w) + (let ((refile-location + (org-refile-get-location + "Refile to" + (marker-buffer (car entries)) + org-refile-allow-creating-parent-nodes))) + (when (nth 3 refile-location) + (setcar (nthcdr 3 refile-location) + (move-marker + (make-marker) + (nth 3 refile-location) + (or (get-file-buffer (nth 1 refile-location)) + (find-buffer-visiting (nth 1 refile-location)) + (error "This should not happen"))))) + + (setq cmd `(lambda () (org-agenda-refile nil ',refile-location t))) + (setq redo-at-end t))) + + (?t + (let ((state (completing-read "Todo state: " (with-current-buffer (marker-buffer (car entries)) - (mapcar #'list org-todo-keywords-1)))) - (setq cmd `(let ((org-inhibit-blocking t) - (org-inhibit-logging 'note)) - (org-agenda-todo ,state)))) - - ((memq action '(?- ?+)) - (setq tag (completing-read + (mapcar #'list org-todo-keywords-1))))) + (setq cmd `(lambda () + (let ((org-inhibit-blocking t) + (org-inhibit-logging 'note)) + (org-agenda-todo ,state)))))) + + ((and (or ?- ?+) action) + (let ((tag (completing-read (format "Tag to %s: " (if (eq action ?+) "add" "remove")) (with-current-buffer (marker-buffer (car entries)) (delq nil (mapcar (lambda (x) (and (stringp (car x)) x)) - org-current-tag-alist))))) - (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) - - ((memq action '(?s ?d)) - (let* ((time - (unless arg - (org-read-date - nil nil nil - (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to") - org-overriding-default-time))) - (c1 (if (eq action ?s) 'org-agenda-schedule - 'org-agenda-deadline))) - ;; Make sure to not prompt for a note when bulk - ;; rescheduling as Org cannot cope with simultaneous - ;; notes. Besides, it could be annoying depending on the - ;; number of items re-scheduled. - (setq cmd `(eval '(let ((org-log-reschedule - (and org-log-reschedule 'time)) - (org-log-redeadline - (and org-log-redeadline 'time))) - (,c1 arg ,time)))))) - - ((equal action ?S) - (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) - (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type) - (let ((days (read-number - (format "Scatter tasks across how many %sdays: " - (if arg "week" "")) 7))) - (setq cmd - `(let ((distance (1+ (random ,days)))) - (if arg - (let ((dist distance) - (day-of-week - (calendar-day-of-week - (calendar-gregorian-from-absolute (org-today))))) - (dotimes (i (1+ dist)) - (while (member day-of-week org-agenda-weekend-days) - (cl-incf distance) - (cl-incf day-of-week) - (when (= day-of-week 7) - (setq day-of-week 0))) - (cl-incf day-of-week) - (when (= day-of-week 7) - (setq day-of-week 0))))) - ;; silently fail when try to replan a sexp entry - (condition-case nil - (let* ((date (calendar-gregorian-from-absolute - (+ (org-today) distance))) - (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) - (nth 2 date)))) - (org-agenda-schedule nil time)) - (error nil))))))) - - ((assoc action org-agenda-bulk-custom-functions) - (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions))) - redo-at-end t)) - - ((equal action ?f) - (setq cmd (list (intern - (completing-read "Function: " - obarray 'fboundp t nil nil))))) - - (t (user-error "Invalid bulk action"))) - - ;; Sort the markers, to make sure that parents are handled before children - (setq entries (sort entries - (lambda (a b) - (cond - ((equal (marker-buffer a) (marker-buffer b)) - (< (marker-position a) (marker-position b))) - (t - (string< (buffer-name (marker-buffer a)) - (buffer-name (marker-buffer b)))))))) - - ;; Now loop over all markers and apply cmd - (while (setq e (pop entries)) - (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e)) - (if (not pos) - (progn (message "Skipping removed entry at %s" e) - (setq cntskip (1+ cntskip))) - (goto-char pos) - (let (org-loop-over-headlines-in-active-region) - (eval cmd)) - ;; `post-command-hook' is not run yet. We make sure any - ;; pending log note is processed. - (when (or (memq 'org-add-log-note (default-value 'post-command-hook)) - (memq 'org-add-log-note post-command-hook)) - (org-add-log-note)) - (setq cnt (1+ cnt)))) + org-current-tag-alist)))))) + (setq cmd + `(lambda () + (org-agenda-set-tags ,tag + ,(if (eq action ?+) ''on ''off)))))) + + (?s + (let ((time + (and (not arg) + (org-read-date nil nil nil "(Re)Schedule to" + org-overriding-default-time)))) + ;; Make sure to not prompt for a note when bulk + ;; rescheduling as Org cannot cope with simultaneous notes. + ;; Besides, it could be annoying depending on the number of + ;; items re-scheduled. + (setq cmd + `(lambda () + (let ((org-log-reschedule (and org-log-reschedule 'time))) + (org-agenda-schedule arg ,time)))))) + (?d + (let ((time + (and (not arg) + (org-read-date nil nil nil "(Re)Set Deadline to" + org-overriding-default-time)))) + ;; Make sure to not prompt for a note when bulk + ;; rescheduling as Org cannot cope with simultaneous + ;; notes. Besides, it could be annoying depending on the + ;; number of items re-scheduled. + (setq cmd + `(lambda () + (let ((org-log-redeadline (and org-log-redeadline 'time))) + (org-agenda-deadline arg ,time)))))) + + (?S + (unless (org-agenda-check-type nil 'agenda 'todo) + (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)) + (let ((days (read-number + (format "Scatter tasks across how many %sdays: " + (if arg "week" "")) + 7))) + (setq cmd + `(lambda () + (let ((distance (1+ (random ,days)))) + (when arg + (let ((dist distance) + (day-of-week + (calendar-day-of-week + (calendar-gregorian-from-absolute (org-today))))) + (dotimes (i (1+ dist)) + (while (member day-of-week org-agenda-weekend-days) + (cl-incf distance) + (cl-incf day-of-week) + (when (= day-of-week 7) + (setq day-of-week 0))) + (cl-incf day-of-week) + (when (= day-of-week 7) + (setq day-of-week 0))))) + ;; Silently fail when try to replan a sexp entry. + (ignore-errors + (let* ((date (calendar-gregorian-from-absolute + (+ (org-today) distance))) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) + (nth 2 date)))) + (org-agenda-schedule nil time)))))))) + + (?f + (setq cmd + (intern + (completing-read "Function: " obarray #'fboundp t nil nil)))) + + (action + (pcase (assoc action org-agenda-bulk-custom-functions) + (`(,_ ,f) (setq cmd f) (setq redo-at-end t)) + (_ (user-error "Invalid bulk action: %c" action))))) + + ;; Sort the markers, to make sure that parents are handled + ;; before children. + (setq entries (sort entries + (lambda (a b) + (cond + ((eq (marker-buffer a) (marker-buffer b)) + (< (marker-position a) (marker-position b))) + (t + (string< (buffer-name (marker-buffer a)) + (buffer-name (marker-buffer b)))))))) + + ;; Now loop over all markers and apply CMD. + (let ((processed 0) + (skipped 0)) + (dolist (e entries) + (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e))) + (if (not pos) + (progn (message "Skipping removed entry at %s" e) + (cl-incf skipped)) + (goto-char pos) + (let (org-loop-over-headlines-in-active-region) (funcall cmd)) + ;; `post-command-hook' is not run yet. We make sure any + ;; pending log note is processed. + (when (or (memq 'org-add-log-note (default-value 'post-command-hook)) + (memq 'org-add-log-note post-command-hook)) + (org-add-log-note)) + (cl-incf processed)))) (when redo-at-end (org-agenda-redo)) - (unless org-agenda-persistent-marks - (org-agenda-bulk-unmark-all)) + (unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all)) (message "Acted on %d entries%s%s" - cnt - (if (= cntskip 0) + processed + (if (= skipped 0) "" (format ", skipped %d (disappeared before their turn)" - cntskip)) - (if (not org-agenda-persistent-marks) - "" " (kept marked)")))))) + skipped)) + (if (not org-agenda-persistent-marks) "" " (kept marked)")))))) (defun org-agenda-capture (&optional with-time) "Call `org-capture' with the date at point. @@ -10249,9 +10193,7 @@ to override `appt-message-warning-time'." "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) (concat (match-string 1 tod) ":" (match-string 2 tod)))) - (when (if (version< emacs-version "23.3") - (appt-add tod evt) - (appt-add tod evt wrn)) + (when (appt-add tod evt wrn) (setq cnt (1+ cnt)))))) entries) (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." (and (looking-at "[ \t\r\n]*") ;; datetree archives don't need so much spacing. (replace-match (if datetree-date "\n" "\n\n")))) - ;; No specific heading, just go to end of file. - (goto-char (point-max)) - ;; Subtree narrowing can let the buffer end on - ;; a headline. `org-paste-subtree' then deletes it. - ;; To prevent this, make sure visible part of buffer - ;; always terminates on a new line, while limiting - ;; number of blank lines in a date tree. - (unless (and datetree-date (bolp)) (insert "\n"))) + ;; No specific heading, just go to end of file, or to the + ;; beginning, depending on `org-archive-reversed-order'. + (if org-archive-reversed-order + (progn + (goto-char (point-min)) + (unless (org-at-heading-p) (outline-next-heading)) + (insert "\n") (backward-char 1)) + (goto-char (point-max)) + ;; Subtree narrowing can let the buffer end on + ;; a headline. `org-paste-subtree' then deletes it. + ;; To prevent this, make sure visible part of buffer + ;; always terminates on a new line, while limiting + ;; number of blank lines in a date tree. + (unless (and datetree-date (bolp)) (insert "\n")))) ;; Paste (org-paste-subtree (org-get-valid-level level (and heading 1))) ;; Shall we append inherited tags? 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 @@ (require 'org-id) (require 'vc-git) +(declare-function dired-dwim-target-directory "dired-aux") + (defgroup org-attach nil "Options concerning entry attachments in Org mode." :tag "Org Attach" @@ -142,7 +144,7 @@ When set to `query', ask the user instead." "Confirmation preference for automatically getting annex files. If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get." :group 'org-attach - :package-version '(Org . "9") + :package-version '(Org . "9.0") :version "26.1" :type '(choice (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." a Select a file and attach it to the task, using `org-attach-method'. c/m/l/y Attach a file using copy/move/link/symbolic-link method. +u Attach a file from URL (downloading it). n Create a new attachment, as an Emacs buffer. z Synchronize the current task with its attachment directory, in case you added attachments yourself. @@ -186,7 +189,7 @@ d Delete one attachment, you will be prompted for a file name. D Delete all of a task's attachments. A safer way is to open the directory in dired and delete from there. -s Set a specific attachment directory for this entry. +s Set a specific attachment directory for this entry or reset to default. i Make children of the current entry inherit its attachment directory."))) (org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) (message "Select command: [acmlzoOfFdD]") @@ -202,6 +205,8 @@ i Make children of the current entry inherit its attachment directory."))) (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) ((memq c '(?y ?\C-y)) (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) + ((memq c '(?u ?\C-u)) + (let ((org-attach-method 'url)) (call-interactively 'org-attach-url))) ((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new)) ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync)) ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open)) @@ -270,14 +275,30 @@ Throw an error if we cannot root the directory." (buffer-file-name (buffer-base-buffer)) (error "Need absolute `org-attach-directory' to attach in buffers without filename"))) -(defun org-attach-set-directory () - "Set the ATTACH_DIR property of the current entry. +(defun org-attach-set-directory (&optional arg) + "Set the ATTACH_DIR node property and ask to move files there. The property defines the directory that is used for attachments -of the entry." - (interactive) - (let ((dir (org-entry-get nil "ATTACH_DIR"))) - (setq dir (read-directory-name "Attachment directory: " dir)) - (org-entry-put nil "ATTACH_DIR" dir))) +of the entry. When called with `\\[universal-argument]', reset \ +the directory to +the default ID based one." + (interactive "P") + (let ((old (org-attach-dir)) + (new + (progn + (if arg (org-entry-delete nil "ATTACH_DIR") + (let ((dir (read-directory-name + "Attachment directory: " + (org-entry-get nil + "ATTACH_DIR" + (and org-attach-allow-inheritance t))))) + (org-entry-put nil "ATTACH_DIR" dir))) + (org-attach-dir t)))) + (unless (or (string= old new) + (not old)) + (when (yes-or-no-p "Copy over attachments from old directory? ") + (copy-directory old new t nil t)) + (when (yes-or-no-p (concat "Delete " old)) + (delete-directory old t))))) (defun org-attach-set-inherit () "Set the ATTACH_DIR_INHERIT property of the current entry. @@ -363,34 +384,47 @@ Only do this when `org-attach-store-link-p' is non-nil." (file-name-nondirectory file)) org-stored-links))) +(defun org-attach-url (url) + (interactive "MURL of the file to attach: \n") + (org-attach-attach url)) + (defun org-attach-attach (file &optional visit-dir method) "Move/copy/link FILE into the attachment directory of the current task. If VISIT-DIR is non-nil, visit the directory with dired. -METHOD may be `cp', `mv', `ln', or `lns' default taken from +METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from `org-attach-method'." - (interactive "fFile to keep as an attachment: \nP") + (interactive + (list + (read-file-name "File to keep as an attachment:" + (or (progn + (require 'dired-aux) + (dired-dwim-target-directory)) + default-directory)) + current-prefix-arg + nil)) (setq method (or method org-attach-method)) (let ((basename (file-name-nondirectory file))) (when (and org-attach-file-list-property (not org-attach-inherited)) (org-entry-add-to-multivalued-property (point) org-attach-file-list-property basename)) (let* ((attach-dir (org-attach-dir t)) - (fname (expand-file-name basename attach-dir))) + (fname (expand-file-name basename attach-dir))) (cond - ((eq method 'mv) (rename-file file fname)) - ((eq method 'cp) (copy-file file fname)) + ((eq method 'mv) (rename-file file fname)) + ((eq method 'cp) (copy-file file fname)) ((eq method 'ln) (add-name-to-file file fname)) - ((eq method 'lns) (make-symbolic-link file fname))) + ((eq method 'lns) (make-symbolic-link file fname)) + ((eq method 'url) (url-copy-file file fname))) (when org-attach-commit - (org-attach-commit)) + (org-attach-commit)) (org-attach-tag) (cond ((eq org-attach-store-link-p 'attached) - (org-attach-store-link fname)) - ((eq org-attach-store-link-p t) - (org-attach-store-link file))) + (org-attach-store-link fname)) + ((eq org-attach-store-link-p t) + (org-attach-store-link file))) (if visit-dir - (dired attach-dir) - (message "File \"%s\" is now a task attachment." basename))))) + (dired attach-dir) + (message "File %S is now a task attachment." basename))))) (defun org-attach-attach-cp () "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 @@ :group 'org-bbdb-anniversaries :require 'bbdb) +(defcustom org-bbdb-general-anniversary-description-after 7 + "When to switch anniversary descriptions to a more general format. + +Anniversary descriptions include the point in time, when the +anniversary appears. This is, in its most general form, just the +date of the anniversary. Or more specific terms, like \"today\", +\"tomorrow\" or \"in n days\" are used to describe the time span. + +If the anniversary happens in less than that number of days, the +specific description is used. Otherwise, the general one is +used." + :group 'org-bbdb-anniversaries + :version "26.1" + :package-version '(Org . "9.1") + :type 'integer + :require 'bbdb + :safe #'integerp) + (defcustom org-bbdb-anniversary-format-alist '(("birthday" . (lambda (name years suffix) @@ -412,7 +430,25 @@ This is used by Org to re-create the anniversary hash table." (mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i))) (number-sequence 0 (1- n))))) -;;;###autoload +(defun org-bbdb-anniversary-description (agenda-date anniv-date) + "Return a string used to incorporate into an agenda anniversary entry. +The calculation of the anniversary description string is based on +the difference between the anniversary date, given as ANNIV-DATE, +and the date on which the entry appears in the agenda, given as +AGENDA-DATE. This makes it possible to have different entries +for the same event depending on if it occurs in the next few days +or far away in the future." + (let ((delta (- (calendar-absolute-from-gregorian anniv-date) + (calendar-absolute-from-gregorian agenda-date)))) + + (cond + ((= delta 0) " -- today\\&") + ((= delta 1) " -- tomorrow\\&") + ((< delta org-bbdb-general-anniversary-description-after) (format " -- in %d days\\&" delta)) + ((pcase-let ((`(,month ,day ,year) anniv-date)) + (format " -- %d-%02d-%02d\\&" year month day)))))) + + (defun org-bbdb-anniversaries-future (&optional n) "Return list of anniversaries for today and the next n-1 days (default n=7)." (let ((n (or n 7))) @@ -425,19 +461,17 @@ must be positive")) ;; Function to annotate text of each element of l with the ;; anniversary date d. (annotate-descriptions - (lambda (d l) + (lambda (agenda-date d l) (mapcar (lambda (x) ;; The assumption here is that x is a bbdb link ;; of the form [[bbdb:name][description]]. ;; This function rather arbitrarily modifies ;; the description by adding the date to it in ;; a fixed format. - (string-match "]]" x) - (replace-match (format " -- %d-%02d-%02d\\&" - (nth 2 d) - (nth 0 d) - (nth 1 d)) - nil nil x)) + (let ((desc (org-bbdb-anniversary-description + agenda-date d))) + (string-match "]]" x) + (replace-match desc nil nil x))) l)))) ;; Map a function that generates anniversaries for each date ;; over the dates and nconc the results into a single list. When @@ -447,12 +481,13 @@ must be positive")) (apply #'nconc (mapcar (lambda (d) - (let ((date d)) + (let ((agenda-date date) + (date d)) ;; Rebind 'date' so that org-bbdb-anniversaries will ;; be fooled into giving us the list for the given ;; date and then annotate the descriptions for that ;; date. - (funcall annotate-descriptions d (org-bbdb-anniversaries)))) + (funcall annotate-descriptions agenda-date d (org-bbdb-anniversaries)))) dates))))) (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." :version "24.1" :type 'boolean) +(defcustom org-bibtex-headline-format-function + (lambda (entry) (cdr (assq :title entry))) + "Function returning the headline text for `org-bibtex-write'. +It should take a single argument, the bibtex entry (an alist as +returned by `org-bibtex-read'). The default value simply returns +the entry title." + :group 'org-bibtex + :version "26.1" + :package-version '(Org . "9.1") + :type 'function) + (defcustom org-bibtex-export-arbitrary-fields nil "When converting to bibtex allow fields not defined in `org-bibtex-fields'. This only has effect if `org-bibtex-prefix' is defined, so as to @@ -678,7 +689,7 @@ Return the number of saved entries." (val (lambda (field) (cdr (assoc field entry)))) (togtag (lambda (tag) (org-toggle-tag tag 'on)))) (org-insert-heading) - (insert (funcall val :title)) + (insert (funcall org-bibtex-headline-format-function entry)) (org-bibtex-put "TITLE" (funcall val :title)) (org-bibtex-put org-bibtex-type-property-name (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 @@ (declare-function org-decrypt-entry "org-crypt" ()) (declare-function org-encrypt-entry "org-crypt" ()) (declare-function org-table-analyze "org-table" ()) +(declare-function org-table-current-dline "org-table" ()) (declare-function org-table-goto-line "org-table" (N)) (defvar org-end-time-was-given) @@ -83,6 +84,36 @@ :tag "Org Capture" :group 'org) +(defun org-capture-upgrade-templates (templates) + "Update the template list to the new format. +TEMPLATES is a template list, as in `org-capture-templates'. The +new format unifies all the date/week tree targets into one that +also allows for an optional outline path to specify a target." + (let ((modified-templates + (mapcar + (lambda (entry) + (pcase entry + ;; Match templates with an obsolete "tree" target type. Replace + ;; it with common `file+olp-datetree'. Add new properties + ;; (i.e., `:time-prompt' and `:tree-type') if needed. + (`(,key ,desc ,type (file+datetree . ,path) ,tpl . ,props) + `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl ,@props)) + (`(,key ,desc ,type (file+datetree+prompt . ,path) ,tpl . ,props) + `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl + :time-prompt t ,@props)) + (`(,key ,desc ,type (file+weektree . ,path) ,tpl . ,props) + `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl + :tree-type week ,@props)) + (`(,key ,desc ,type (file+weektree+prompt . ,path) ,tpl . ,props) + `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl + :tree-type week :time-prompt t ,@props)) + ;; Other templates are left unchanged. + (_ entry))) + templates))) + (unless (equal modified-templates templates) + (message "Deprecated date/weektree capture templates changed to `file+olp+datetree'.")) + modified-templates)) + (defcustom org-capture-templates nil "Templates for the creation of new entries. @@ -124,8 +155,8 @@ target Specification of where the captured item should be placed. Most target specifications contain a file name. If that file name is the empty string, it defaults to `org-default-notes-file'. - A file can also be given as a variable, function, or Emacs Lisp - form. When an absolute path is not specified for a + A file can also be given as a variable or as a function called + with no argument. When an absolute path is not specified for a target, it is taken as relative to `org-directory'. Valid values are: @@ -140,22 +171,17 @@ target Specification of where the captured item should be placed. Fast configuration if the target heading is unique in the file (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...) - For non-unique headings, the full path is safer + For non-unique headings, the full outline path is safer (file+regexp \"path/to/file\" \"regexp to find location\") File to the entry matching regexp - (file+datetree \"path/to/file\") - Will create a heading in a date tree for today's date - - (file+datetree+prompt \"path/to/file\") - Will create a heading in a date tree, prompts for date - - (file+weektree \"path/to/file\") - Will create a heading in a week tree for today's date - - (file+weektree+prompt \"path/to/file\") - Will create a heading in a week tree, prompts for date + (file+olp+datetree \"path/to/file\" \"Level 1 heading\" ...) + Will create a heading in a date tree for today's date. + If no heading is given, the tree will be on top level. + To prompt for date instead of using TODAY, use the + :time-prompt property. To create a week-tree, use the + :tree-type property. (file+function \"path/to/file\" function-finding-location) A function to find the right location in the file @@ -213,6 +239,11 @@ properties are: When setting both to t, the current clock will run and the previous one will not be resumed. + :time-prompt Prompt for a date/time to be used for date/week trees + and when filling the template. + + :tree-type When `week', make a week tree instead of the month tree. + :unnarrowed Do not narrow the target buffer, simply show the full buffer. Default is to narrow it so that you only see the new stuff. @@ -299,6 +330,7 @@ When you need to insert a literal percent sign in the template, you can escape ambiguous cases with a backward slash, e.g., \\%i." :group 'org-capture :version "24.1" + :set (lambda (s v) (set s (org-capture-upgrade-templates v))) :type (let ((file-variants '(choice :tag "Filename " (file :tag "Literal") @@ -339,18 +371,11 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i." (const :format "" file+regexp) ,file-variants (regexp :tag " Regexp")) - (list :tag "File & Date tree" - (const :format "" file+datetree) - ,file-variants) - (list :tag "File & Date tree, prompt for date" - (const :format "" file+datetree+prompt) - ,file-variants) - (list :tag "File & Week tree" - (const :format "" file+weektree) - ,file-variants) - (list :tag "File & Week tree, prompt for date" - (const :format "" file+weektree+prompt) - ,file-variants) + (list :tag "File [ & Outline path ] & Date tree" + (const :format "" file+olp+datetree) + ,file-variants + (option (repeat :tag "Outline path" :inline t + (string :tag "Headline")))) (list :tag "File & function" (const :format "" file+function) ,file-variants @@ -379,8 +404,10 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i." ((const :format "%v " :clock-in) (const t)) ((const :format "%v " :clock-keep) (const t)) ((const :format "%v " :clock-resume) (const t)) + ((const :format "%v " :time-prompt) (const t)) + ((const :format "%v " :tree-type) (const week)) ((const :format "%v " :unnarrowed) (const t)) - ((const :format "%v " :table-line-pos) (const t)) + ((const :format "%v " :table-line-pos) (string)) ((const :format "%v " :kill-buffer) (const t))))))))) (defcustom org-capture-before-finalize-hook nil @@ -564,6 +591,9 @@ the last note stored. When called with a `C-0' (zero) prefix, insert a template at point. +When called with a `C-1' (one) prefix, force prompting for a date when +a datetree entry is made. + ELisp programs can set KEYS to a string associated with a template in `org-capture-templates'. In this case, interactive selection will be bypassed. @@ -581,7 +611,6 @@ of the day at point (if any) or the current HH:MM time." ((equal goto '(4)) (org-capture-goto-target)) ((equal goto '(16)) (org-capture-goto-last-stored)) (t - ;; FIXME: Are these needed? (let* ((orig-buf (current-buffer)) (annotation (if (and (boundp 'org-capture-link-is-already-stored) org-capture-link-is-already-stored) @@ -818,13 +847,17 @@ for `entry'-type templates")) (let* ((base (or (buffer-base-buffer) (current-buffer))) (pos (make-marker)) (org-capture-is-refiling t) - (kill-buffer (org-capture-get :kill-buffer 'local))) + (kill-buffer (org-capture-get :kill-buffer 'local)) + (jump-to-captured (org-capture-get :jump-to-captured 'local))) ;; Since `org-capture-finalize' may alter buffer contents (e.g., ;; empty lines) around entry, use a marker to refer to the ;; headline to be refiled. Place the marker in the base buffer, ;; as the current indirect one is going to be killed. (set-marker pos (save-excursion (org-back-to-heading t) (point)) base) - (org-capture-put :kill-buffer nil) + ;; `org-capture-finalize' calls `org-capture-goto-last-stored' too + ;; early. We want to wait for the refiling to be over, so we + ;; control when the latter function is called. + (org-capture-put :kill-buffer nil :jump-to-captured nil) (unwind-protect (progn (org-capture-finalize) @@ -833,7 +866,8 @@ for `entry'-type templates")) (org-with-wide-buffer (goto-char pos) (call-interactively 'org-refile)))) - (when kill-buffer (kill-buffer base))) + (when kill-buffer (kill-buffer base)) + (when jump-to-captured (org-capture-goto-last-stored))) (set-marker pos nil)))) (defun org-capture-kill () @@ -869,170 +903,171 @@ for `entry'-type templates")) (defun org-capture-set-target-location (&optional target) "Find TARGET buffer and position. Store them in the capture property list." - (let ((target-entry-p t) decrypted-hl-pos) - (setq target (or target (org-capture-get :target))) + (let ((target-entry-p t)) (save-excursion - (cond - ((eq (car target) 'file) - (set-buffer (org-capture-target-buffer (nth 1 target))) - (org-capture-put-target-region-and-position) - (widen) - (setq target-entry-p nil)) - - ((eq (car target) 'id) - (let ((loc (org-id-find (nth 1 target)))) - (if (not loc) - (error "Cannot find target ID \"%s\"" (nth 1 target)) - (set-buffer (org-capture-target-buffer (car loc))) + (pcase (or target (org-capture-get :target)) + (`(file ,path) + (set-buffer (org-capture-target-buffer path)) + (org-capture-put-target-region-and-position) + (widen) + (setq target-entry-p nil)) + (`(id ,id) + (pcase (org-id-find id) + (`(,path . ,position) + (set-buffer (org-capture-target-buffer path)) (widen) (org-capture-put-target-region-and-position) - (goto-char (cdr loc))))) - - ((eq (car target) 'file+headline) - (set-buffer (org-capture-target-buffer (nth 1 target))) - (unless (derived-mode-p 'org-mode) - (error - "Target buffer \"%s\" for file+headline should be in Org mode" - (current-buffer))) - (org-capture-put-target-region-and-position) - (widen) - (let ((hd (nth 2 target))) - (goto-char (point-min)) - (if (re-search-forward - (format org-complex-heading-regexp-format (regexp-quote hd)) - nil t) - (goto-char (point-at-bol)) - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (insert "* " hd "\n") - (beginning-of-line 0)))) - - ((eq (car target) 'file+olp) - (let ((m (org-find-olp - (cons (org-capture-expand-file (nth 1 target)) - (cddr target))))) - (set-buffer (marker-buffer m)) - (org-capture-put-target-region-and-position) - (widen) - (goto-char m))) - - ((eq (car target) 'file+regexp) - (set-buffer (org-capture-target-buffer (nth 1 target))) - (org-capture-put-target-region-and-position) - (widen) - (goto-char (point-min)) - (if (re-search-forward (nth 2 target) nil t) - (progn - (goto-char (if (org-capture-get :prepend) - (match-beginning 0) (match-end 0))) - (org-capture-put :exact-position (point)) - (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) - (error "No match for target regexp in file %s" (nth 1 target)))) - - ((memq (car target) '(file+datetree file+datetree+prompt file+weektree file+weektree+prompt)) - (require 'org-datetree) - (set-buffer (org-capture-target-buffer (nth 1 target))) - (unless (derived-mode-p 'org-mode) - (error "Target buffer \"%s\" for %s should be in Org mode" - (current-buffer) - (car target))) - (org-capture-put-target-region-and-position) - (widen) - ;; Make a date/week tree entry, with the current date (or - ;; yesterday, if we are extending dates for a couple of hours) - (funcall - (cond - ((memq (car target) '(file+weektree file+weektree+prompt)) - #'org-datetree-find-iso-week-create) - (t #'org-datetree-find-date-create)) - (calendar-gregorian-from-absolute - (cond - (org-overriding-default-time - ;; use the overriding default time - (time-to-days org-overriding-default-time)) - - ((memq (car target) '(file+datetree+prompt file+weektree+prompt)) - ;; prompt for date - (let ((prompt-time (org-read-date - nil t nil "Date for tree entry:" - (current-time)))) - (org-capture-put - :default-time - (cond ((and (or (not (boundp 'org-time-was-given)) - (not org-time-was-given)) - (not (= (time-to-days prompt-time) (org-today)))) - ;; Use 00:00 when no time is given for another date than today? - (apply #'encode-time - (append '(0 0 0) - (cl-cdddr (decode-time prompt-time))))) - ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer) - ;; Replace any time range by its start - (apply 'encode-time - (org-read-date-analyze - (replace-match "\\1 \\2" nil nil org-read-date-final-answer) - prompt-time (decode-time prompt-time)))) - (t prompt-time))) - (time-to-days prompt-time))) - (t - ;; current date, possibly corrected for late night workers - (org-today)))))) - - ((eq (car target) 'file+function) - (set-buffer (org-capture-target-buffer (nth 1 target))) - (org-capture-put-target-region-and-position) - (widen) - (funcall (nth 2 target)) - (org-capture-put :exact-position (point)) - (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) - - ((eq (car target) 'function) - (funcall (nth 1 target)) - (org-capture-put :exact-position (point)) - (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) - - ((eq (car target) 'clock) - (if (and (markerp org-clock-hd-marker) - (marker-buffer org-clock-hd-marker)) - (progn (set-buffer (marker-buffer org-clock-hd-marker)) - (org-capture-put-target-region-and-position) - (widen) - (goto-char org-clock-hd-marker)) - (error "No running clock that could be used as capture target"))) - - (t (error "Invalid capture target specification"))) - - (when (and (featurep 'org-crypt) (org-at-encrypted-entry-p)) - (org-decrypt-entry) - (setq decrypted-hl-pos - (save-excursion (and (org-back-to-heading t) (point))))) - - (org-capture-put :buffer (current-buffer) :pos (point) + (goto-char position)) + (_ (error "Cannot find target ID \"%s\"" id)))) + (`(file+headline ,path ,headline) + (set-buffer (org-capture-target-buffer path)) + (unless (derived-mode-p 'org-mode) + (error "Target buffer \"%s\" for file+headline not in Org mode" + (current-buffer))) + (org-capture-put-target-region-and-position) + (widen) + (goto-char (point-min)) + (if (re-search-forward (format org-complex-heading-regexp-format + (regexp-quote headline)) + nil t) + (goto-char (line-beginning-position)) + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (insert "* " headline "\n") + (beginning-of-line 0))) + (`(file+olp ,path . ,outline-path) + (let ((m (org-find-olp (cons (org-capture-expand-file path) + outline-path)))) + (set-buffer (marker-buffer m)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char m) + (set-marker m nil))) + (`(file+regexp ,path ,regexp) + (set-buffer (org-capture-target-buffer path)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char (point-min)) + (if (not (re-search-forward regexp nil t)) + (error "No match for target regexp in file %s" path) + (goto-char (if (org-capture-get :prepend) + (match-beginning 0) + (match-end 0))) + (org-capture-put :exact-position (point)) + (setq target-entry-p + (and (derived-mode-p 'org-mode) (org-at-heading-p))))) + (`(file+olp+datetree ,path . ,outline-path) + (let ((m (if outline-path + (org-find-olp (cons (org-capture-expand-file path) + outline-path)) + (set-buffer (org-capture-target-buffer path)) + (point-marker)))) + (set-buffer (marker-buffer m)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char m) + (set-marker m nil) + (require 'org-datetree) + (org-capture-put-target-region-and-position) + (widen) + ;; Make a date/week tree entry, with the current date (or + ;; yesterday, if we are extending dates for a couple of hours) + (funcall + (if (eq (org-capture-get :tree-type) 'week) + #'org-datetree-find-iso-week-create + #'org-datetree-find-date-create) + (calendar-gregorian-from-absolute + (cond + (org-overriding-default-time + ;; Use the overriding default time. + (time-to-days org-overriding-default-time)) + ((or (org-capture-get :time-prompt) + (equal current-prefix-arg 1)) + ;; Prompt for date. + (let ((prompt-time (org-read-date + nil t nil "Date for tree entry:" + (current-time)))) + (org-capture-put + :default-time + (cond ((and (or (not (boundp 'org-time-was-given)) + (not org-time-was-given)) + (not (= (time-to-days prompt-time) (org-today)))) + ;; Use 00:00 when no time is given for another + ;; date than today? + (apply #'encode-time + (append '(0 0 0) + (cl-cdddr (decode-time prompt-time))))) + ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" + org-read-date-final-answer) + ;; Replace any time range by its start. + (apply #'encode-time + (org-read-date-analyze + (replace-match "\\1 \\2" nil nil + org-read-date-final-answer) + prompt-time (decode-time prompt-time)))) + (t prompt-time))) + (time-to-days prompt-time))) + (t + ;; Current date, possibly corrected for late night + ;; workers. + (org-today)))) + ;; the following is the keep-restriction argument for + ;; org-datetree-find-date-create + (if outline-path 'subtree-at-point)))) + (`(file+function ,path ,function) + (set-buffer (org-capture-target-buffer path)) + (org-capture-put-target-region-and-position) + (widen) + (funcall function) + (org-capture-put :exact-position (point)) + (setq target-entry-p + (and (derived-mode-p 'org-mode) (org-at-heading-p)))) + (`(function ,fun) + (funcall fun) + (org-capture-put :exact-position (point)) + (setq target-entry-p + (and (derived-mode-p 'org-mode) (org-at-heading-p)))) + (`(clock) + (if (and (markerp org-clock-hd-marker) + (marker-buffer org-clock-hd-marker)) + (progn (set-buffer (marker-buffer org-clock-hd-marker)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char org-clock-hd-marker)) + (error "No running clock that could be used as capture target"))) + (target (error "Invalid capture target specification: %S" target))) + + (org-capture-put :buffer (current-buffer) + :pos (point) :target-entry-p target-entry-p - :decrypted decrypted-hl-pos)))) + :decrypted + (and (featurep 'org-crypt) + (org-at-encrypted-entry-p) + (save-excursion + (org-decrypt-entry) + (and (org-back-to-heading t) (point)))))))) (defun org-capture-expand-file (file) "Expand functions, symbols and file names for FILE. When FILE is a function, call it. When it is a form, evaluate -it. When it is a variable, retrieve the value. When it is +it. When it is a variable, return its value. When it is a string, treat it as a file name, possibly expanding it according to `org-directory', and return it. If it is the empty string, however, return `org-default-notes-file'. In any other case, raise an error." - (cond - ((equal file "") org-default-notes-file) - ((stringp file) (expand-file-name file org-directory)) - ((functionp file) (funcall file)) - ((and (symbolp file) (boundp file)) (symbol-value file)) - ((consp file) (eval file)) - (t file))) + (let ((location (cond ((equal file "") org-default-notes-file) + ((stringp file) (expand-file-name file org-directory)) + ((functionp file) (funcall file)) + ((and (symbolp file) (boundp file)) (symbol-value file)) + (t nil)))) + (or (org-string-nw-p location) + (error "Invalid file location: %S" location)))) (defun org-capture-target-buffer (file) "Get a buffer for FILE. FILE is a generalized file location, as handled by `org-capture-expand-file'." - (let ((file (or (org-string-nw-p (org-capture-expand-file file)) - org-default-notes-file - (error "No notes file specified, and no default available")))) + (let ((file (org-capture-expand-file file))) (or (org-find-base-buffer-visiting file) (progn (org-capture-put :new-buffer t) (find-file-noselect file))))) @@ -1062,7 +1097,7 @@ may have been stored before." (defun org-capture-place-entry () "Place the template as a new Org entry." (let ((reversed? (org-capture-get :prepend)) - level) + (level 1)) (when (org-capture-get :exact-position) (goto-char (org-capture-get :exact-position))) (cond @@ -1523,7 +1558,8 @@ is selected, only the bare key is returned." Lisp programs can force the template by setting KEYS to a string." (let ((org-capture-templates (or (org-contextualize-keys - org-capture-templates org-capture-templates-contexts) + (org-capture-upgrade-templates org-capture-templates) + org-capture-templates-contexts) '(("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a"))))) (if keys @@ -1651,7 +1687,7 @@ The template may still contain \"%?\" for cursor positioning." (let* ((inside-sexp? (org-capture-inside-embedded-elisp-p)) (replacement (pcase (string-to-char value) - (?< (format-time-string time-string)) + (?< (format-time-string time-string time)) (?: (or (plist-get org-store-link-plist (intern value)) "")) 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 @@ (defvar org-frame-title-format-backup frame-title-format) (defvar org-time-stamp-formats) -(defvar org-ts-what) (defgroup org-clock nil @@ -523,6 +522,16 @@ of a different task.") (define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto) (define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu) +(defun org-clock--translate (s language) + "Translate string S into using string LANGUAGE. +Assume S in the English term to translate. Return S as-is if it +cannot be translated." + (or (nth (pcase s + ("File" 1) ("L" 2) ("Timestamp" 3) ("Headline" 4) ("Time" 5) + ("ALL" 6) ("Total time" 7) ("File time" 8) ("Clock summary at" 9)) + (assoc-string language org-clock-clocktable-language-setup t)) + s)) + (defun org-clock-menu () (interactive) (popup-menu @@ -582,8 +591,9 @@ of a different task.") "Hook called in task selection just before prompting the user.") (defun org-clock-select-task (&optional prompt) - "Select a task that was recently associated with clocking." - (interactive) + "Select a task that was recently associated with clocking. +Return marker position of the selected task. Raise an error if +there is no recent clock to choose from." (let (och chl sel-list rpl (i 0) s) ;; Remove successive dups from the clock history to consider (dolist (c org-clock-history) @@ -668,20 +678,19 @@ If an effort estimate was defined for the current item, use If not, show simply the clocked time like 01:50." (let ((clocked-time (org-clock-get-clocked-time))) (if org-clock-effort - (let* ((effort-in-minutes - (org-duration-string-to-minutes org-clock-effort)) + (let* ((effort-in-minutes (org-duration-to-minutes org-clock-effort)) (work-done-str (propertize - (org-minutes-to-clocksum-string clocked-time) + (org-duration-from-minutes clocked-time) 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text)) 'org-mode-line-clock-overrun 'org-mode-line-clock))) - (effort-str (org-minutes-to-clocksum-string effort-in-minutes)) + (effort-str (org-duration-from-minutes effort-in-minutes)) (clockstr (propertize (concat " [%s/" effort-str "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") 'face 'org-mode-line-clock))) (format clockstr work-done-str)) - (propertize (concat " [" (org-minutes-to-clocksum-string clocked-time) + (propertize (concat " [" (org-duration-from-minutes clocked-time) "]" (format " (%s)" org-clock-heading)) 'face 'org-mode-line-clock)))) @@ -751,15 +760,15 @@ clocked item, and the value displayed in the mode line." ;; A string. See if it is a delta (setq sign (string-to-char value)) (if (member sign '(?- ?+)) - (setq current (org-duration-string-to-minutes current) + (setq current (org-duration-to-minutes current) value (substring value 1)) (setq current 0)) - (setq value (org-duration-string-to-minutes value)) + (setq value (org-duration-to-minutes value)) (if (equal ?- sign) (setq value (- current value)) (if (equal ?+ sign) (setq value (+ current value))))) (setq value (max 0 value) - org-clock-effort (org-minutes-to-clocksum-string value)) + org-clock-effort (org-duration-from-minutes value)) (org-entry-put org-clock-marker "Effort" org-clock-effort) (org-clock-update-mode-line) (message "Effort is now %s" org-clock-effort)) @@ -772,7 +781,7 @@ clocked item, and the value displayed in the mode line." "Show notification if we spent more time than we estimated before. Notification is shown only once." (when (org-clocking-p) - (let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort)) + (let ((effort-in-minutes (org-duration-to-minutes org-clock-effort)) (clocked-time (org-clock-get-clocked-time))) (if (setq org-clock-task-overrun (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 the default behavior." (interactive "P") (setq org-clock-notification-was-shown nil) - (org-refresh-properties - org-effort-property '((effort . identity) - (effort-minutes . org-duration-string-to-minutes))) + (org-refresh-effort-properties) (catch 'abort (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) (org-clocking-p))) @@ -1620,8 +1627,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (when org-clock-out-switch-to-state (save-excursion (org-back-to-heading t) - (let ((org-inhibit-logging t) - (org-clock-out-when-done nil)) + (let ((org-clock-out-when-done nil)) (cond ((functionp org-clock-out-switch-to-state) (let ((case-fold-search nil)) @@ -1636,7 +1642,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (org-todo org-clock-out-switch-to-state)))))) (force-mode-line-update) (message (concat "Clock stopped at %s after " - (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s") + (org-duration-from-minutes (+ (* 60 h) m)) "%s") te (if remove " => LINE REMOVED" "")) (run-hooks 'org-clock-out-hook) (unless (org-clocking-p) @@ -1674,11 +1680,11 @@ Optional argument N tells to change by that many units." "Change CLOCK timestamps synchronously at cursor. UPDOWN tells whether to change `up' or `down'. Optional argument N tells to change by that many units." - (setq org-ts-what nil) - (when (org-at-timestamp-p t) - (let ((tschange (if (eq updown 'up) 'org-timestamp-up - 'org-timestamp-down)) - ts1 begts1 ts2 begts2 updatets1 tdiff) + (let ((tschange (if (eq updown 'up) 'org-timestamp-up + 'org-timestamp-down)) + (timestamp? (org-at-timestamp-p 'lax)) + ts1 begts1 ts2 begts2 updatets1 tdiff) + (when timestamp? (save-excursion (move-beginning-of-line 1) (re-search-forward org-ts-regexp3 nil t) @@ -1690,24 +1696,24 @@ Optional argument N tells to change by that many units." (if (not ts2) ;; fall back on org-timestamp-up if there is only one (funcall tschange n) - ;; setq this so that (boundp 'org-ts-what is non-nil) (funcall tschange n) (let ((ts (if updatets1 ts2 ts1)) (begts (if updatets1 begts1 begts2))) (setq tdiff (time-subtract - (org-time-string-to-time org-last-changed-timestamp) - (org-time-string-to-time ts))) + (org-time-string-to-time org-last-changed-timestamp t) + (org-time-string-to-time ts t))) (save-excursion (goto-char begts) (org-timestamp-change (round (/ (float-time tdiff) - (cond ((eq org-ts-what 'minute) 60) - ((eq org-ts-what 'hour) 3600) - ((eq org-ts-what 'day) (* 24 3600)) - ((eq org-ts-what 'month) (* 24 3600 31)) - ((eq org-ts-what 'year) (* 24 3600 365.2))))) - org-ts-what 'updown))))))) + (pcase timestamp? + (`minute 60) + (`hour 3600) + (`day (* 24 3600)) + (`month (* 24 3600 31)) + (`year (* 24 3600 365.2))))) + timestamp? 'updown))))))) ;;;###autoload (defun org-clock-cancel () @@ -1942,7 +1948,7 @@ Use `\\[org-clock-remove-overlays]' to remove the subtree times." (cond (todayp " for today") (customp " (custom)") (t ""))) - (org-minutes-to-clocksum-string + (org-duration-from-minutes org-clock-file-total-minutes) " (%d hours and %d minutes)") h m))) @@ -1968,7 +1974,7 @@ will be easy to remove." ?\·) '(face shadow)) (org-add-props - (format " %9s " (org-minutes-to-clocksum-string time)) + (format " %9s " (org-duration-from-minutes time)) '(face org-clock-overlay)) "")) (overlay-put ov 'display tx) @@ -2376,6 +2382,7 @@ the currently selected interval size." (`file-with-archives (and buffer-file-name (org-add-archive-files (list buffer-file-name)))) + ((pred functionp) (funcall scope)) ((pred consp) scope) (_ (or (buffer-file-name) (current-buffer))))) (block (plist-get params :block)) @@ -2456,20 +2463,12 @@ from the dynamic block definition." ;; someone wants to write their own special formatter, this maybe ;; much easier because there can be a fixed format with a ;; well-defined number of columns... - (let* ((hlchars '((1 . "*") (2 . "/"))) - (lwords (assoc (or (plist-get params :lang) - (bound-and-true-p org-export-default-language) - "en") - org-clock-clocktable-language-setup)) + (let* ((lang (or (plist-get params :lang) "en")) (multifile (plist-get params :multifile)) (block (plist-get params :block)) (sort (plist-get params :sort)) (header (plist-get params :header)) - (ws (or (plist-get params :wstart) 1)) - (ms (or (plist-get params :mstart) 1)) (link (plist-get params :link)) - (org-time-clocksum-use-effort-durations - (plist-get params :effort-durations)) (maxlevel (or (plist-get params :maxlevel) 3)) (emph (plist-get params :emphasize)) (compact? (plist-get params :compact)) @@ -2494,49 +2493,40 @@ from the dynamic block definition." (indent (or compact? (plist-get params :indent))) (formula (plist-get params :formula)) (case-fold-search t) - range-text total-time recalc narrow-cut-p) + (total-time (apply #'+ (mapcar #'cadr tables))) + recalc narrow-cut-p) (when (and narrow (integerp narrow) link) ;; We cannot have both integer narrow and link. - (message - "Using hard narrowing in clocktable to allow for links") + (message "Using hard narrowing in clocktable to allow for links") (setq narrow (intern (format "%d!" narrow)))) - (when narrow - (cond - ((integerp narrow)) - ((and (symbolp narrow) - (string-match "\\`[0-9]+!\\'" (symbol-name narrow))) - (setq narrow-cut-p t - narrow (string-to-number (substring (symbol-name narrow) - 0 -1)))) - (t - (error "Invalid value %s of :narrow property in clock table" - narrow)))) - - (when block - ;; Get the range text for the header. - (setq range-text (nth 2 (org-clock-special-range block nil t ws ms)))) - - ;; Compute the total time. - (setq total-time (apply #'+ (mapcar #'cadr tables))) + (pcase narrow + ((or `nil (pred integerp)) nil) ;nothing to do + ((and (pred symbolp) + (guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow)))) + (setq narrow-cut-p t) + (setq narrow (string-to-number (symbol-name narrow)))) + (_ (error "Invalid value %s of :narrow property in clock table" narrow))) - ;; Now we need to output this tsuff. + ;; Now we need to output this table stuff. (goto-char ipos) ;; Insert the text *before* the actual table. (insert-before-markers (or header ;; Format the standard header. - (concat - "#+CAPTION: " - (nth 9 lwords) " [" - (substring - (format-time-string (cdr org-time-stamp-formats)) - 1 -1) - "]" - (if block (concat ", for " range-text ".") "") - "\n"))) + (format "#+CAPTION: %s %s%s\n" + (org-clock--translate "Clock summary at" lang) + (format-time-string (org-time-stamp-format t t)) + (if block + (let ((range-text + (nth 2 (org-clock-special-range + block nil t + (plist-get params :wstart) + (plist-get params :mstart))))) + (format ", for %s." range-text)) + "")))) ;; Insert the narrowing line (when (and narrow (integerp narrow) (not narrow-cut-p)) @@ -2545,36 +2535,45 @@ from the dynamic block definition." (if multifile "|" "") ;file column, maybe (if level? "|" "") ;level column, maybe (if timestamp "|" "") ;timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (format "<%d>| |\n" narrow))) ; headline and time columns + (if properties ;properties columns, maybe + (make-string (length properties) ?|) + "") + (format "<%d>| |\n" narrow))) ;headline and time columns ;; Insert the table header line (insert-before-markers - "|" ;table line starter - (if multifile (concat (nth 1 lwords) "|") "") ;file column, maybe - (if level? (concat (nth 2 lwords) "|") "") ;level column, maybe - (if timestamp (concat (nth 3 lwords) "|") "") ;timestamp column, maybe + "|" ;table line starter + (if multifile ;file column, maybe + (concat (org-clock--translate "File" lang) "|") + "") + (if level? ;level column, maybe + (concat (org-clock--translate "L" lang) "|") + "") + (if timestamp ;timestamp column, maybe + (concat (org-clock--translate "Timestamp" lang) "|") + "") (if properties ;properties columns, maybe (concat (mapconcat #'identity properties "|") "|") "") - (concat (nth 4 lwords) "|") ;headline - (concat (nth 5 lwords) "|") ;time column - (make-string (max 0 (1- time-columns)) ?|) ;other time columns + (concat (org-clock--translate "Headline" lang)"|") + (concat (org-clock--translate "Time" lang) "|") + (make-string (max 0 (1- time-columns)) ?|) ;other time columns (if (eq formula '%) "%|\n" "\n")) ;; Insert the total time in the table (insert-before-markers "|-\n" ;a hline "|" ;table line starter - (if multifile (concat "| " (nth 6 lwords) " ") "") + (if multifile (format "| %s " (org-clock--translate "ALL" lang)) "") ;file column, maybe - (if level? "|" "") ;level column, maybe - (if timestamp "|" "") ;timestamp column, maybe + (if level? "|" "") ;level column, maybe + (if timestamp "|" "") ;timestamp column, maybe (make-string (length properties) ?|) ;properties columns, maybe - (concat (format org-clock-total-time-cell-format (nth 7 lwords)) + (concat (format org-clock-total-time-cell-format + (org-clock--translate "Total time" lang)) "| ") (format org-clock-total-time-cell-format - (org-minutes-to-clocksum-string (or total-time 0))) ;time + (org-duration-from-minutes (or total-time 0))) ;time "|" (make-string (max 0 (1- time-columns)) ?|) (cond ((not (eq formula '%)) "") @@ -2595,7 +2594,7 @@ from the dynamic block definition." (insert-before-markers (format (concat "| %s %s | %s%s" (format org-clock-file-time-cell-format - (nth 8 lwords)) + (org-clock--translate "File time" lang)) " | *%s*|\n") (file-name-nondirectory file-name) (if level? "| " "") ;level column, maybe @@ -2603,7 +2602,7 @@ from the dynamic block definition." (if properties ;properties columns, maybe (make-string (length properties) ?|) "") - (org-minutes-to-clocksum-string file-time)))) ;time + (org-duration-from-minutes file-time)))) ;time ;; Get the list of node entries and iterate over it (when (> maxlevel 0) @@ -2619,15 +2618,18 @@ from the dynamic block definition." (org-shorten-string (match-string 3 headline) narrow)) (org-shorten-string headline narrow)))) - (let ((hlc (if emph (or (cdr (assoc level hlchars)) "") ""))) + (cl-flet ((format-field (f) (format (cond ((not emph) "%s |") + ((= level 1) "*%s* |") + ((= level 2) "/%s/ |") + (t "%s |")) + f))) (insert-before-markers "|" ;start the table line (if multifile "|" "") ;free space for file name column? (if level? (format "%d|" level) "") ;level, maybe (if timestamp (concat ts "|") "") ;timestamp, maybe (if properties ;properties columns, maybe - (concat (mapconcat (lambda (p) - (or (cdr (assoc p props)) "")) + (concat (mapconcat (lambda (p) (or (cdr (assoc p props)) "")) properties "|") "|") @@ -2635,10 +2637,10 @@ from the dynamic block definition." (if indent ;indentation (org-clocktable-indent-string level) "") - hlc headline hlc "|" ;headline + (format-field headline) ;; Empty fields for higher levels. (make-string (max 0 (1- (min time-columns level))) ?|) - hlc (org-minutes-to-clocksum-string time) hlc "|" ; time + (format-field (org-duration-from-minutes time)) (make-string (max 0 (- time-columns level)) ?|) (if (eq formula '%) (format "%.1f |" (* 100 (/ time (float total-time)))) @@ -2814,9 +2816,7 @@ PROPERTIES: The list properties specified in the `:properties' parameter (when (and time (> time 0) (org-at-heading-p)) (let ((level (org-reduced-level (org-current-level)))) (when (<= level maxlevel) - (let* ((headline (replace-regexp-in-string - (format "\\`%s[ \t]+" org-comment-string) "" - (nth 4 (org-heading-components)))) + (let* ((headline (org-get-heading t t t t)) (hdl (if (not link) headline (let ((search @@ -2834,11 +2834,9 @@ PROPERTIES: The list properties specified in the `:properties' parameter headline))))))) (tsp (and timestamp - (let ((p (org-entry-properties (point) 'special))) - (or (cdr (assoc "SCHEDULED" p)) - (cdr (assoc "DEADLINE" p)) - (cdr (assoc "TIMESTAMP" p)) - (cdr (assoc "TIMESTAMP_IA" p)))))) + (cl-some (lambda (p) (org-entry-get (point) p)) + '("SCHEDULED" "DEADLINE" "TIMESTAMP" + "TIMESTAMP_IA")))) (props (and properties (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." ;;; Column View -(defvar org-columns-overlays nil +(defvar-local org-columns-overlays nil "Holds the list of current column overlays.") -(defvar org-columns--time 0.0 - "Number of seconds since the epoch, as a floating point number.") - (defvar-local org-columns-current-fmt nil "Local variable, holds the currently active column format.") @@ -110,12 +107,15 @@ This is the compiled version of the format.") (defvar-local org-columns-current-maxwidths nil "Currently active maximum column widths, as a vector.") -(defvar org-columns-begin-marker (make-marker) +(defvar-local org-columns-begin-marker nil "Points to the position where last a column creation command was called.") -(defvar org-columns-top-level-marker (make-marker) +(defvar-local org-columns-top-level-marker nil "Points to the position where current columns region starts.") +(defvar org-columns--time 0.0 + "Number of seconds since the epoch, as a floating point number.") + (defvar org-columns-map (make-sparse-keymap) "The keymap valid in column display.") @@ -264,7 +264,7 @@ possible to override it with optional argument COMPILED-FMT." org-agenda-columns-add-appointments-to-effort-sum (string= p (upcase org-effort-property)) (get-text-property (point) 'duration) - (propertize (org-minutes-to-clocksum-string + (propertize (org-duration-from-minutes (get-text-property (point) 'duration)) 'face 'org-warning)) ""))) @@ -458,23 +458,22 @@ for the duration of the command.") (defun org-columns-remove-overlays () "Remove all currently active column overlays." (interactive) - (when (marker-buffer org-columns-begin-marker) - (with-current-buffer (marker-buffer org-columns-begin-marker) - (when (local-variable-p 'org-previous-header-line-format) - (setq header-line-format org-previous-header-line-format) - (kill-local-variable 'org-previous-header-line-format) - (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local)) - (move-marker org-columns-begin-marker nil) - (move-marker org-columns-top-level-marker nil) - (org-with-silent-modifications - (mapc 'delete-overlay org-columns-overlays) - (setq org-columns-overlays nil) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t)))) - (when org-columns-flyspell-was-active - (flyspell-mode 1)) - (when (local-variable-p 'org-colview-initial-truncate-line-value) - (setq truncate-lines org-colview-initial-truncate-line-value))))) + (when org-columns-overlays + (when (local-variable-p 'org-previous-header-line-format) + (setq header-line-format org-previous-header-line-format) + (kill-local-variable 'org-previous-header-line-format) + (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local)) + (set-marker org-columns-begin-marker nil) + (set-marker org-columns-top-level-marker nil) + (org-with-silent-modifications + (mapc #'delete-overlay org-columns-overlays) + (setq org-columns-overlays nil) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(read-only t)))) + (when org-columns-flyspell-was-active + (flyspell-mode 1)) + (when (local-variable-p 'org-colview-initial-truncate-line-value) + (setq truncate-lines org-colview-initial-truncate-line-value)))) (defun org-columns-compact-links (s) "Replace [[link][desc]] with [desc] or [link]." @@ -613,20 +612,20 @@ Where possible, use the standard interface for changing this line." (let* ((pom (or (org-get-at-bol 'org-marker) (org-get-at-bol 'org-hd-marker) (point))) - (key (get-char-property (point) 'org-columns-key)) - (key1 (concat key "_ALL")) - (allowed (org-entry-get pom key1 t)) - nval) + (key (concat (or (get-char-property (point) 'org-columns-key) + (user-error "No column to edit at point")) + "_ALL")) + (allowed (org-entry-get pom key t)) + (new-value (read-string "Allowed: " allowed))) ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.???? ;; FIXME: Write back to #+PROPERTY setting if that is needed. - (setq nval (read-string "Allowed: " allowed)) (org-entry-put (cond ((marker-position org-entry-property-inherited-from) org-entry-property-inherited-from) ((marker-position org-columns-top-level-marker) org-columns-top-level-marker) (t pom)) - key1 nval))) + key new-value))) (defun org-columns--call (fun) "Call function FUN while preserving heading visibility. @@ -760,6 +759,8 @@ current specifications. This function also sets (defun org-columns-goto-top-level () "Move to the beginning of the column view area. Also sets `org-columns-top-level-marker' to the new position." + (unless (markerp org-columns-top-level-marker) + (setq org-columns-top-level-marker (make-marker))) (goto-char (move-marker org-columns-top-level-marker @@ -782,7 +783,9 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." (interactive "P") (org-columns-remove-overlays) (when global (goto-char (point-min))) - (move-marker org-columns-begin-marker (point)) + (if (markerp org-columns-begin-marker) + (move-marker org-columns-begin-marker (point)) + (setq org-columns-begin-marker (point-marker))) (org-columns-goto-top-level) ;; Initialize `org-columns-current-fmt' and ;; `org-columns-current-fmt-compiled'. @@ -940,29 +943,28 @@ starting the current column display, or in a #+COLUMNS line of the current buffer." (let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))) (setq-local org-columns-current-fmt fmt) - (when (marker-position org-columns-top-level-marker) - (org-with-wide-buffer - (goto-char org-columns-top-level-marker) - (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS")) - (org-entry-put nil "COLUMNS" fmt) - (goto-char (point-min)) - (let ((case-fold-search t)) - ;; Try to replace the first COLUMNS keyword available. - (catch :found - (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t) - (let ((element (save-match-data (org-element-at-point)))) - (when (and (eq (org-element-type element) 'keyword) - (equal (org-element-property :key element) - "COLUMNS")) - (replace-match (concat " " fmt) t t nil 1) - (throw :found nil)))) - ;; No COLUMNS keyword in the buffer. Insert one at the - ;; beginning, right before the first heading, if any. - (goto-char (point-min)) - (unless (org-at-heading-p t) (outline-next-heading)) - (let ((inhibit-read-only t)) - (insert-before-markers "#+COLUMNS: " fmt "\n")))) - (setq-local org-columns-default-format fmt)))))) + (when org-columns-overlays + (org-with-point-at org-columns-top-level-marker + (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS")) + (org-entry-put nil "COLUMNS" fmt) + (goto-char (point-min)) + (let ((case-fold-search t)) + ;; Try to replace the first COLUMNS keyword available. + (catch :found + (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t) + (let ((element (save-match-data (org-element-at-point)))) + (when (and (eq (org-element-type element) 'keyword) + (equal (org-element-property :key element) + "COLUMNS")) + (replace-match (concat " " fmt) t t nil 1) + (throw :found nil)))) + ;; No COLUMNS keyword in the buffer. Insert one at the + ;; beginning, right before the first heading, if any. + (goto-char (point-min)) + (unless (org-at-heading-p t) (outline-next-heading)) + (let ((inhibit-read-only t)) + (insert-before-markers "#+COLUMNS: " fmt "\n")))) + (setq-local org-columns-default-format fmt)))))) (defun org-columns-update (property) "Recompute PROPERTY, and update the columns display for it." @@ -994,18 +996,17 @@ the current buffer." (defun org-columns-redo () "Construct the column display again." (interactive) - (message "Recomputing columns...") - (org-with-wide-buffer - (when (marker-position org-columns-begin-marker) - (goto-char org-columns-begin-marker)) - (org-columns-remove-overlays) - (if (derived-mode-p 'org-mode) - ;; Since we already know the columns format, provide it instead - ;; of computing again. - (call-interactively #'org-columns org-columns-current-fmt) - (org-agenda-redo) - (call-interactively #'org-agenda-columns))) - (message "Recomputing columns...done")) + (when org-columns-overlays + (message "Recomputing columns...") + (org-with-point-at org-columns-begin-marker + (org-columns-remove-overlays) + (if (derived-mode-p 'org-mode) + ;; Since we already know the columns format, provide it + ;; instead of computing again. + (call-interactively #'org-columns org-columns-current-fmt) + (org-agenda-redo) + (call-interactively #'org-agenda-columns))) + (message "Recomputing columns...done"))) (defun org-columns-uncompile-format (compiled) "Turn the compiled columns format back into a string representation. @@ -1060,63 +1061,40 @@ This function updates `org-columns-current-fmt-compiled'." ;;;; Column View Summary -(defconst org-columns--duration-re - (concat "[0-9.]+ *" (regexp-opt (mapcar #'car org-effort-durations))) - "Regexp matching a duration.") - -(defun org-columns--time-to-seconds (s) - "Turn time string S into a number of seconds. -A time is expressed as HH:MM, HH:MM:SS, or with units defined in -`org-effort-durations'. Plain numbers are considered as hours." - (cond - ((string-match-p org-columns--duration-re s) - (* 60 (org-duration-string-to-minutes s))) - ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\'" s) - (+ (* 3600 (string-to-number (match-string 1 s))) - (* 60 (string-to-number (match-string 2 s))) - (if (match-end 3) (string-to-number (match-string 3 s)) 0))) - (t (* 3600 (string-to-number s))))) - -(defun org-columns--age-to-seconds (s) - "Turn age string S into a number of seconds. +(defun org-columns--age-to-minutes (s) + "Turn age string S into a number of minutes. An age is either computed from a given time-stamp, or indicated -as days/hours/minutes/seconds." +as a canonical duration, i.e., using units defined in +`org-duration-canonical-units'." (cond ((string-match-p org-ts-regexp s) - (floor - (- org-columns--time - (float-time (apply #'encode-time (org-parse-time-string s nil t)))))) - ;; Match own output for computations in upper levels. - ((string-match "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" s) - (+ (* 86400 (string-to-number (match-string 1 s))) - (* 3600 (string-to-number (match-string 2 s))) - (* 60 (string-to-number (match-string 3 s))) - (string-to-number (match-string 4 s)))) + (/ (- org-columns--time + (float-time (apply #'encode-time (org-parse-time-string s nil t)))) + 60)) + ((org-duration-p s) (org-duration-to-minutes s t)) ;skip user units (t (user-error "Invalid age: %S" s)))) +(defun org-columns--format-age (minutes) + "Format MINUTES float as an age string." + (org-duration-from-minutes minutes + '(("d" . nil) ("h" . nil) ("min" . nil)) + t)) ;ignore user's custom units + (defun org-columns--summary-apply-times (fun times) "Apply FUN to time values TIMES. -If TIMES contains any time value expressed as a duration, return -the result as a duration. If it contains any H:M:S, use that -format instead. Otherwise, use H:M format." - (let* ((hms-flag nil) - (duration-flag nil) - (seconds - (apply fun - (mapcar - (lambda (time) - (cond - (duration-flag) - ((string-match-p org-columns--duration-re time) - (setq duration-flag t)) - (hms-flag) - ((string-match-p "\\`[0-9]+:[0-9]+:[0-9]+\\'" time) - (setq hms-flag t))) - (org-columns--time-to-seconds time)) - times)))) - (cond (duration-flag (org-minutes-to-clocksum-string (/ seconds 60.0))) - (hms-flag (format-seconds "%h:%.2m:%.2s" seconds)) - (t (format-seconds "%h:%.2m" seconds))))) +Return the result as a duration." + (org-duration-from-minutes + (apply fun + (mapcar (lambda (time) + ;; Unlike to `org-duration-to-minutes' standard + ;; behavior, we want to consider plain numbers as + ;; hours. As a consequence, we treat them + ;; differently. + (if (string-match-p "\\`[0-9]+\\(?:\\.[0-9]*\\)?\\'" time) + (* 60 (string-to-number time)) + (org-duration-to-minutes time))) + times)) + (org-duration-h:mm-only-p times))) (defun org-columns--compute-spec (spec &optional update) "Update tree according to SPEC. @@ -1283,21 +1261,18 @@ When PRINTF is non-nil, use it to format the result." (defun org-columns--summary-min-age (ages _) "Compute the minimum time among AGES." - (format-seconds - "%dd %.2hh %mm %ss" - (apply #'min (mapcar #'org-columns--age-to-seconds ages)))) + (org-columns--format-age + (apply #'min (mapcar #'org-columns--age-to-minutes ages)))) (defun org-columns--summary-max-age (ages _) "Compute the maximum time among AGES." - (format-seconds - "%dd %.2hh %mm %ss" - (apply #'max (mapcar #'org-columns--age-to-seconds ages)))) + (org-columns--format-age + (apply #'max (mapcar #'org-columns--age-to-minutes ages)))) (defun org-columns--summary-mean-age (ages _) "Compute the minimum time among AGES." - (format-seconds - "%dd %.2hh %mm %ss" - (/ (apply #'+ (mapcar #'org-columns--age-to-seconds ages)) + (org-columns--format-age + (/ (apply #'+ (mapcar #'org-columns--age-to-minutes ages)) (float (length ages))))) (defun org-columns--summary-estimate (estimates _) @@ -1515,7 +1490,9 @@ PARAMS is a property list of parameters: "Turn on or update column view in the agenda." (interactive) (org-columns-remove-overlays) - (move-marker org-columns-begin-marker (point)) + (if (markerp org-columns-begin-marker) + (move-marker org-columns-begin-marker (point)) + (setq org-columns-begin-marker (point-marker))) (let* ((org-columns--time (float-time (current-time))) (fmt (cond @@ -1634,26 +1611,23 @@ This will add overlays to the date lines, to show the summary for each day." (defun org-agenda-colview-compute (fmt) "Compute the relevant columns in the contributing source buffers." - (let ((files org-agenda-contributing-files) - (org-columns-begin-marker (make-marker)) - (org-columns-top-level-marker (make-marker))) - (dolist (f files) - (let ((b (find-buffer-visiting f))) - (with-current-buffer (or (buffer-base-buffer b) b) - (org-with-wide-buffer - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) - (goto-char (point-min)) - (org-columns-get-format-and-top-level) - (dolist (spec fmt) - (let ((prop (car spec))) - (cond - ((equal prop "CLOCKSUM") (org-clock-sum)) - ((equal prop "CLOCKSUM_T") (org-clock-sum-today)) - ((and (nth 3 spec) - (let ((a (assoc prop org-columns-current-fmt-compiled))) - (equal (nth 3 a) (nth 3 spec)))) - (org-columns-compute prop))))))))))) + (dolist (file org-agenda-contributing-files) + (let ((b (find-buffer-visiting file))) + (with-current-buffer (or (buffer-base-buffer b) b) + (org-with-wide-buffer + (org-with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (goto-char (point-min)) + (org-columns-get-format-and-top-level) + (dolist (spec fmt) + (let ((prop (car spec))) + (cond + ((equal prop "CLOCKSUM") (org-clock-sum)) + ((equal prop "CLOCKSUM_T") (org-clock-sum-today)) + ((and (nth 3 spec) + (let ((a (assoc prop org-columns-current-fmt-compiled))) + (equal (nth 3 a) (nth 3 spec)))) + (org-columns-compute prop)))))))))) (provide 'org-colview) diff --git a/lisp/org/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 @@ (declare-function org-at-table.el-p "org" (&optional table-type)) (declare-function org-element-at-point "org-element" ()) (declare-function org-element-type "org-element" (element)) +(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-link-set-parameters "org" (type &rest rest)) (declare-function org-table-end (&optional table-type)) +(declare-function outline-next-heading "outline" ()) (declare-function table--at-cell-p "table" (position &optional object at-column)) (defvar org-table-any-border-regexp) @@ -44,9 +46,8 @@ (defvar org-table-tab-recognizes-table.el) (defvar org-table1-hline-regexp) -;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-' -;; prefix, `find-tag' is replaced with `xref-find-definition' and -;; `x-get-selection' with `gui-get-selection'. +;;; Emacs < 25.1 compatibility + (when (< emacs-major-version 25) (defalias 'outline-hide-entry 'hide-entry) (defalias 'outline-hide-sublevels 'hide-sublevels) @@ -66,6 +67,48 @@ (decode-time time) (decode-time time zone))) +(unless (fboundp 'directory-name-p) + (defun directory-name-p (name) + "Return non-nil if NAME ends with a directory separator character." + (let ((len (length name)) + (lastc ?.)) + (if (> len 0) + (setq lastc (aref name (1- len)))) + (or (= lastc ?/) + (and (memq system-type '(windows-nt ms-dos)) + (= lastc ?\\)))))) + +(unless (fboundp 'directory-files-recursively) + (defun directory-files-recursively (dir regexp &optional include-directories) + "Return list of all files under DIR that have file names matching REGEXP. +This function works recursively. Files are returned in \"depth first\" +order, and files from each directory are sorted in alphabetical order. +Each file name appears in the returned list in its absolute form. +Optional argument INCLUDE-DIRECTORIES non-nil means also include in the +output directories whose names match REGEXP." + (let ((result nil) + (files nil) + ;; When DIR is "/", remote file names like "/method:" could + ;; also be offered. We shall suppress them. + (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir))))) + (dolist (file (sort (file-name-all-completions "" dir) + 'string<)) + (unless (member file '("./" "../")) + (if (directory-name-p file) + (let* ((leaf (substring file 0 (1- (length file)))) + (full-file (expand-file-name leaf dir))) + ;; Don't follow symlinks to other directories. + (unless (file-symlink-p full-file) + (setq result + (nconc result (directory-files-recursively + full-file regexp include-directories)))) + (when (and include-directories + (string-match regexp leaf)) + (setq result (nconc result (list full-file))))) + (when (string-match regexp file) + (push (expand-file-name file dir) files))))) + (nconc result (nreverse files))))) + ;;; Obsolete aliases (remove them after the next major release). @@ -89,7 +132,7 @@ (defmacro org-re (s) "Replace posix classes in regular expression S." (declare (debug (form)) - (obsolete "you can safely remove it." "Org 9.0")) + (obsolete "you can safely remove it." "Org 9.0")) s) ;;;; Functions from cl-lib that Org used to have its own implementation of. @@ -107,8 +150,8 @@ Counting starts at 1." (cl-subseq list (1- start) end)) (make-obsolete 'org-sublist - "use cl-subseq (note the 0-based counting)." - "Org 9.0") + "use cl-subseq (note the 0-based counting)." + "Org 9.0") ;;;; Functions available since Emacs 24.3 @@ -126,25 +169,15 @@ Counting starts at 1." ;;;; Functions and variables from previous releases now obsolete. (define-obsolete-function-alias 'org-element-remove-indentation 'org-remove-indentation "Org 9.0") -(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics - 'org-checkbox-hierarchical-statistics "Org 8.0") -(define-obsolete-variable-alias 'org-description-max-indent - 'org-list-description-max-indent "Org 8.0") (define-obsolete-variable-alias 'org-latex-create-formula-image-program 'org-preview-latex-default-process "Org 9.0") (define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory - 'org-preview-latex-image-directory "Org 9.0") + 'org-preview-latex-image-directory "Org 9.0") (define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0") (define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0") (define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3") -(define-obsolete-function-alias 'org-speed-command-default-hook - 'org-speed-command-activate "Org 8.0") -(define-obsolete-function-alias 'org-babel-speed-command-hook - 'org-babel-speed-command-activate "Org 8.0") (define-obsolete-function-alias 'org-image-file-name-regexp 'image-file-name-regexp "Org 9.0") -(define-obsolete-function-alias 'org-get-legal-level - 'org-get-valid-level "Org 7.8") (define-obsolete-function-alias 'org-completing-read-no-i 'completing-read "Org 9.0") (define-obsolete-function-alias 'org-icompleting-read @@ -156,47 +189,27 @@ Counting starts at 1." 'org-agenda-ignore-properties "Org 9.0") (define-obsolete-function-alias 'org-preview-latex-fragment 'org-toggle-latex-fragment "Org 8.3") -(define-obsolete-function-alias 'org-display-inline-modification-hook - 'org-display-inline-remove-overlay "Org 8.0") (define-obsolete-function-alias 'org-export-get-genealogy 'org-element-lineage "Org 9.0") (define-obsolete-variable-alias 'org-latex-with-hyperref 'org-latex-hyperref-template "Org 9.0") -(define-obsolete-variable-alias 'org-link-to-org-use-id - 'org-id-link-to-org-use-id "Org 8.0") (define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0") -(define-obsolete-variable-alias 'org-clock-modeline-total - 'org-clock-mode-line-total "Org 8.0") -(define-obsolete-function-alias 'org-protocol-unhex-compound - 'org-link-unescape-compound "Org 7.8") -(define-obsolete-function-alias 'org-protocol-unhex-string - 'org-link-unescape "Org 7.8") -(define-obsolete-function-alias 'org-protocol-unhex-single-byte-sequence - 'org-link-unescape-single-byte-sequence "Org 7.8") (define-obsolete-variable-alias 'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "Org 8.2") -(define-obsolete-variable-alias 'org-alphabetical-lists - 'org-list-allow-alphabetical "Org 8.0") (define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0") -(define-obsolete-variable-alias 'org-agenda-menu-two-column - 'org-agenda-menu-two-columns "Org 8.0") -(define-obsolete-variable-alias 'org-finalize-agenda-hook - 'org-agenda-finalize-hook "Org 8.0") -(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "Org 7.8") -(define-obsolete-function-alias 'org-agenda-post-command-hook - 'org-agenda-update-agenda-type "Org 8.0") (define-obsolete-function-alias 'org-agenda-todayp 'org-agenda-today-p "Org 9.0") (define-obsolete-function-alias 'org-babel-examplize-region 'org-babel-examplify-region "Org 9.0") +(define-obsolete-variable-alias 'org-babel-capitalize-example-region-markers + 'org-babel-uppercase-example-markers "Org 9.1") + (define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0") -(define-obsolete-variable-alias 'org-html-style-include-scripts - 'org-html-head-include-scripts "Org 8.0") -(define-obsolete-variable-alias 'org-html-style-include-default - 'org-html-head-include-default-style "Org 8.0") (define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") (define-obsolete-function-alias 'org-insert-columns-dblock 'org-columns-insert-dblock "Org 9.0") +(define-obsolete-variable-alias 'org-export-babel-evaluate + 'org-export-use-babel "Org 9.1") (define-obsolete-function-alias 'org-activate-bracket-links 'org-activate-links "Org 9.0") (define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0") @@ -207,18 +220,8 @@ Counting starts at 1." (save-match-data (eq 'fixed-width (org-element-type (org-element-at-point))))) (make-obsolete 'org-in-fixed-width-region-p - "use `org-element' library" - "Org 9.0") - -(defcustom org-read-date-minibuffer-setup-hook nil - "Hook to be used to set up keys for the date/time interface. -Add key definitions to `minibuffer-local-map', which will be a -temporary copy." - :group 'org-time - :type 'hook) -(make-obsolete-variable - 'org-read-date-minibuffer-setup-hook - "set `org-read-date-minibuffer-local-map' instead." "Org 8.0") + "use `org-element' library" + "Org 9.0") (defun org-compatible-face (inherits specs) "Make a compatible face specification. @@ -267,26 +270,23 @@ See `org-link-parameters' for documentation on the other parameters." (when (and org-table-tab-recognizes-table.el (org-at-table.el-p)) (beginning-of-line) (unless (or (looking-at org-table-dataline-regexp) - (not (looking-at org-table1-hline-regexp))) + (not (looking-at org-table1-hline-regexp))) (forward-line) (when (looking-at org-table-any-border-regexp) - (forward-line -2))) + (forward-line -2))) (if (re-search-forward "|" (org-table-end t) t) - (progn - (require 'table) - (if (table--at-cell-p (point)) t - (message "recognizing table.el table...") - (table-recognize-table) - (message "recognizing table.el table...done"))) + (progn + (require 'table) + (if (table--at-cell-p (point)) t + (message "recognizing table.el table...") + (table-recognize-table) + (message "recognizing table.el table...done"))) (error "This should not happen")))) ;; Not used by Org core since commit 6d1e3082, Feb 2010. (make-obsolete 'org-table-recognize-table.el - "please notify the org mailing list if you use this function." - "Org 9.0") - -(define-obsolete-function-alias - 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string "Org 8.0") + "please notify the org mailing list if you use this function." + "Org 9.0") (defun org-remove-angle-brackets (s) (org-unbracket-string "<" ">" s)) @@ -296,9 +296,91 @@ See `org-link-parameters' for documentation on the other parameters." (org-unbracket-string "\"" "\"" s)) (make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0") +(defcustom org-publish-sitemap-file-entry-format "%t" + "Format string for site-map file entry. +You could use brackets to delimit on what part the link will be. + +%t is the title. +%a is the author. +%d is the date formatted using `org-publish-sitemap-date-format'." + :group 'org-export-publish + :type 'string) +(make-obsolete-variable + 'org-publish-sitemap-file-entry-format + "set `:sitemap-format-entry' in `org-publish-project-alist' instead." + "Org 9.1") + +(defvar org-agenda-skip-regexp) +(defun org-agenda-skip-entry-when-regexp-matches () + "Check if the current entry contains match for `org-agenda-skip-regexp'. +If yes, it returns the end position of this entry, causing agenda commands +to skip the entry but continuing the search in the subtree. This is a +function that can be put into `org-agenda-skip-function' for the duration +of a command." + (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1")) + (let ((end (save-excursion (org-end-of-subtree t))) + skip) + (save-excursion + (setq skip (re-search-forward org-agenda-skip-regexp end t))) + (and skip end))) + +(defun org-agenda-skip-subtree-when-regexp-matches () + "Check if the current subtree contains match for `org-agenda-skip-regexp'. +If yes, it returns the end position of this tree, causing agenda commands +to skip this subtree. This is a function that can be put into +`org-agenda-skip-function' for the duration of a command." + (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1")) + (let ((end (save-excursion (org-end-of-subtree t))) + skip) + (save-excursion + (setq skip (re-search-forward org-agenda-skip-regexp end t))) + (and skip end))) + +(defun org-agenda-skip-entry-when-regexp-matches-in-subtree () + "Check if the current subtree contains match for `org-agenda-skip-regexp'. +If yes, it returns the end position of the current entry (NOT the tree), +causing agenda commands to skip the entry but continuing the search in +the subtree. This is a function that can be put into +`org-agenda-skip-function' for the duration of a command. An important +use of this function is for the stuck project list." + (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1")) + (let ((end (save-excursion (org-end-of-subtree t))) + (entry-end (save-excursion (outline-next-heading) (1- (point)))) + skip) + (save-excursion + (setq skip (re-search-forward org-agenda-skip-regexp end t))) + (and skip entry-end))) + +(define-obsolete-function-alias 'org-minutes-to-clocksum-string + 'org-duration-from-minutes "Org 9.1") + +(define-obsolete-function-alias 'org-hh:mm-string-to-minutes + 'org-duration-to-minutes "Org 9.1") + +(define-obsolete-function-alias 'org-duration-string-to-minutes + 'org-duration-to-minutes "Org 9.1") + +(make-obsolete-variable 'org-time-clocksum-format + "set `org-duration-format' instead." "Org 9.1") + +(make-obsolete-variable 'org-time-clocksum-use-fractional + "set `org-duration-format' instead." "Org 9.1") + +(make-obsolete-variable 'org-time-clocksum-fractional-format + "set `org-duration-format' instead." "Org 9.1") + +(make-obsolete-variable 'org-time-clocksum-use-effort-durations + "set `org-duration-units' instead." "Org 9.1") + (define-obsolete-function-alias 'org-babel-number-p 'org-babel--string-to-number "Org 9.0") +(define-obsolete-variable-alias 'org-usenet-links-prefer-google + 'org-gnus-prefer-web-links "Org 9.1") + +(define-obsolete-variable-alias 'org-texinfo-def-table-markup + 'org-texinfo-table-default-markup "Org 9.1") + ;;; The function was made obsolete by commit 65399674d5 of 2013-02-22. ;;; This make-obsolete call was added 2016-09-01. (make-obsolete 'org-capture-import-remember-templates @@ -306,7 +388,6 @@ See `org-link-parameters' for documentation on the other parameters." "Org 9.0") - ;;;; Obsolete link types (eval-after-load 'org @@ -320,40 +401,40 @@ See `org-link-parameters' for documentation on the other parameters." (defun org-version-check (version feature level) (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) - (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) - (rmaj (or (nth 0 v1) 99)) - (rmin (or (nth 1 v1) 99)) - (rbld (or (nth 2 v1) 99)) - (maj (or (nth 0 v2) 0)) - (min (or (nth 1 v2) 0)) - (bld (or (nth 2 v2) 0))) + (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) + (rmaj (or (nth 0 v1) 99)) + (rmin (or (nth 1 v1) 99)) + (rbld (or (nth 2 v1) 99)) + (maj (or (nth 0 v2) 0)) + (min (or (nth 1 v2) 0)) + (bld (or (nth 2 v2) 0))) (if (or (< maj rmaj) - (and (= maj rmaj) - (< min rmin)) - (and (= maj rmaj) - (= min rmin) - (< bld rbld))) - (if (eq level :predicate) - ;; just return if we have the version - nil - (let ((msg (format "Emacs %s or greater is recommended for %s" - version feature))) - (display-warning 'org msg level) - t)) + (and (= maj rmaj) + (< min rmin)) + (and (= maj rmaj) + (= min rmin) + (< bld rbld))) + (if (eq level :predicate) + ;; just return if we have the version + nil + (let ((msg (format "Emacs %s or greater is recommended for %s" + version feature))) + (display-warning 'org msg level) + t)) t))) (defun org-get-x-clipboard (value) "Get the value of the X or Windows clipboard." (cond ((and (eq window-system 'x) - (fboundp 'gui-get-selection)) ;Silence byte-compiler. - (org-no-properties - (ignore-errors - (or (gui-get-selection value 'UTF8_STRING) - (gui-get-selection value 'COMPOUND_TEXT) - (gui-get-selection value 'STRING) - (gui-get-selection value 'TEXT))))) - ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) - (w32-get-clipboard-data)))) + (fboundp 'gui-get-selection)) ;Silence byte-compiler. + (org-no-properties + (ignore-errors + (or (gui-get-selection value 'UTF8_STRING) + (gui-get-selection value 'COMPOUND_TEXT) + (gui-get-selection value 'STRING) + (gui-get-selection value 'TEXT))))) + ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) + (w32-get-clipboard-data)))) (defun org-add-props (string plist &rest props) "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." (put 'org-add-props 'lisp-indent-function 2) (defun org-fit-window-to-buffer (&optional window max-height min-height - shrink-only) + shrink-only) "Fit WINDOW to the buffer, but only if it is not a side-by-side window. WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call `shrink-window-if-larger-than-buffer' instead, the height limit is ignored in this case." (cond ((if (fboundp 'window-full-width-p) - (not (window-full-width-p window)) - ;; do nothing if another window would suffer - (> (frame-width) (window-width window)))) - ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) - (fit-window-to-buffer window max-height min-height)) - ((fboundp 'shrink-window-if-larger-than-buffer) - (shrink-window-if-larger-than-buffer window))) + (not (window-full-width-p window)) + ;; do nothing if another window would suffer + (> (frame-width) (window-width window)))) + ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) + (fit-window-to-buffer window max-height min-height)) + ((fboundp 'shrink-window-if-larger-than-buffer) + (shrink-window-if-larger-than-buffer window))) (or window (selected-window))) ;; `set-transient-map' is only in Emacs >= 24.4 @@ -400,7 +481,7 @@ Unlike to `use-region-p', this function also checks (defun org-cursor-to-region-beginning () (when (and (org-region-active-p) - (> (point) (region-beginning))) + (> (point) (region-beginning))) (exchange-point-and-mark))) ;;; Invisibility compatibility @@ -410,8 +491,8 @@ Unlike to `use-region-p', this function also checks (if (fboundp 'remove-from-invisibility-spec) (remove-from-invisibility-spec arg) (if (consp buffer-invisibility-spec) - (setq buffer-invisibility-spec - (delete arg buffer-invisibility-spec))))) + (setq buffer-invisibility-spec + (delete arg buffer-invisibility-spec))))) (defun org-in-invisibility-spec-p (arg) "Is ARG a member of `buffer-invisibility-spec'?" @@ -422,9 +503,9 @@ Unlike to `use-region-p', this function also checks "Move to column COLUMN. Pass COLUMN and FORCE to `move-to-column'." (let ((buffer-invisibility-spec - (if (listp buffer-invisibility-spec) - (remove '(org-filtered) buffer-invisibility-spec) - buffer-invisibility-spec))) + (if (listp buffer-invisibility-spec) + (remove '(org-filtered) buffer-invisibility-spec) + buffer-invisibility-spec))) (move-to-column column force))) (defmacro org-find-library-dir (library) @@ -436,12 +517,12 @@ Pass COLUMN and FORCE to `move-to-column'." (while (string-match "\n" s start) (setq start (match-end 0) n (1+ n))) (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n)) - (setq n (1- n))) + (setq n (1- n))) n)) (defun org-kill-new (string &rest args) (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t) - string) + string) (apply 'kill-new string args)) ;; `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 effect, which variables to use depends on the Emacs version." (if (org-version-check "24.2.50" "" :predicate) `(let (pop-up-frames display-buffer-alist) - ,@body) + ,@body) `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) ,@body))) @@ -473,19 +554,19 @@ effect, which variables to use depends on the Emacs version." (defmacro org-check-version () "Try very hard to provide sensible version strings." (let* ((org-dir (org-find-library-dir "org")) - (org-version.el (concat org-dir "org-version.el")) - (org-fixup.el (concat org-dir "../mk/org-fixup.el"))) + (org-version.el (concat org-dir "org-version.el")) + (org-fixup.el (concat org-dir "../mk/org-fixup.el"))) (if (require 'org-version org-version.el 'noerror) - '(progn - (autoload 'org-release "org-version.el") - (autoload 'org-git-version "org-version.el")) + '(progn + (autoload 'org-release "org-version.el") + (autoload 'org-git-version "org-version.el")) (if (require 'org-fixup org-fixup.el 'noerror) - '(org-fixup) - ;; provide fallback definitions and complain - (warn "Could not define org version correctly. Check installation!") - '(progn - (defun org-release () "N/A") - (defun org-git-version () "N/A !!check installation!!")))))) + '(org-fixup) + ;; provide fallback definitions and complain + (warn "Could not define org version correctly. Check installation!") + '(progn + (defun org-release () "N/A") + (defun org-git-version () "N/A !!check installation!!")))))) (defmacro org-with-silent-modifications (&rest body) (if (fboundp 'with-silent-modifications) @@ -501,7 +582,7 @@ an error is signaled without being caught by a `condition-case'. Implements `define-error' for older emacsen." (if (fboundp 'define-error) (define-error name message) (put name 'error-conditions - (copy-sequence (cons name (get 'error 'error-conditions)))))) + (copy-sequence (cons name (get 'error 'error-conditions)))))) (unless (fboundp 'string-suffix-p) ;; From Emacs subr.el. @@ -511,8 +592,8 @@ If IGNORE-CASE is non-nil, the comparison is done without paying attention to case differences." (let ((start-pos (- (length string) (length suffix)))) (and (>= start-pos 0) - (eq t (compare-strings suffix nil nil - string start-pos nil ignore-case)))))) + (eq t (compare-strings suffix nil nil + string start-pos nil ignore-case)))))) (provide 'org-compat) 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'." "Find or create an entry for date D. If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it is nil, the buffer will be widened to make sure an existing date -tree can be found." +tree can be found. If it is the sympol `subtree-at-point', then the tree +will be built under the headline at point." (setq-local org-datetree-base-level 1) - (or keep-restriction (widen)) (save-restriction - (let ((prop (org-find-property "DATE_TREE"))) - (when prop - (goto-char prop) - (setq-local org-datetree-base-level - (org-get-valid-level (org-current-level) 1)) - (org-narrow-to-subtree))) + (if (eq keep-restriction 'subtree-at-point) + (progn + (unless (org-at-heading-p) (error "Not at heading")) + (widen) + (org-narrow-to-subtree) + (setq-local org-datetree-base-level + (org-get-valid-level (org-current-level) 1))) + (unless keep-restriction (widen)) + ;; Support the old way of tree placement, using a property + (let ((prop (org-find-property "DATE_TREE"))) + (when prop + (goto-char prop) + (setq-local org-datetree-base-level + (org-get-valid-level (org-current-level) 1)) + (org-narrow-to-subtree)))) (goto-char (point-min)) (let ((year (calendar-extract-year d)) (month (calendar-extract-month d)) @@ -84,18 +93,26 @@ tree can be found." "Find or create an ISO week entry for date D. Compared to `org-datetree-find-date-create' this function creates entries ordered by week instead of months. -If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it -is nil, the buffer will be widened to make sure an existing date -tree can be found." +When it is nil, the buffer will be widened to make sure an existing date +tree can be found. If it is the sympol `subtree-at-point', then the tree +will be built under the headline at point." (setq-local org-datetree-base-level 1) - (or keep-restriction (widen)) (save-restriction - (let ((prop (org-find-property "WEEK_TREE"))) - (when prop - (goto-char prop) - (setq-local org-datetree-base-level - (org-get-valid-level (org-current-level) 1)) - (org-narrow-to-subtree))) + (if (eq keep-restriction 'subtree-at-point) + (progn + (unless (org-at-heading-p) (error "Not at heading")) + (widen) + (org-narrow-to-subtree) + (setq-local org-datetree-base-level + (org-get-valid-level (org-current-level) 1))) + (unless keep-restriction (widen)) + ;; Support the old way of tree placement, using a property + (let ((prop (org-find-property "WEEK_TREE"))) + (when prop + (goto-char prop) + (setq-local org-datetree-base-level + (org-get-valid-level (org-current-level) 1)) + (org-narrow-to-subtree)))) (goto-char (point-min)) (require 'cal-iso) (let* ((year (calendar-extract-year d)) 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.") (italic ,@standard-set) (item ,@standard-set-no-line-break) (keyword ,@(remq 'footnote-reference standard-set)) - ;; Ignore all links excepted plain links and angular links in - ;; a link description. Also ignore radio-targets and line - ;; breaks. + ;; Ignore all links in a link description. Also ignore + ;; radio-targets and line breaks. (link bold code entity export-snippet inline-babel-call inline-src-block - italic latex-fragment macro simple-link statistics-cookie - strike-through subscript superscript underline verbatim) + italic latex-fragment macro statistics-cookie strike-through + subscript superscript underline verbatim) (paragraph ,@standard-set) ;; Remove any variable object from radio target as it would ;; prevent it from being properly recognized. @@ -458,7 +457,7 @@ Return value is the property name, as a keyword, or nil." (and (memq object (org-element-property p parent)) (throw 'exit p)))))) -(defun org-element-class (datum &optional parent) +(defsubst org-element-class (datum &optional parent) "Return class for ELEMENT, as a symbol. Class is either `element' or `object'. Optional argument PARENT is the element or object containing DATUM. It defaults to the @@ -2703,7 +2702,7 @@ keywords. Otherwise, return nil. Assume point is at the first tilde marker." (save-excursion (unless (bolp) (backward-char 1)) - (when (looking-at org-emph-re) + (when (looking-at org-verbatim-re) (let ((begin (match-beginning 2)) (value (match-string-no-properties 4)) (post-blank (progn (goto-char (match-end 2)) @@ -3720,7 +3719,7 @@ and cdr is a plist with `:value', `:begin', `:end' and Assume point is at the first equal sign marker." (save-excursion (unless (bolp) (backward-char 1)) - (when (looking-at org-emph-re) + (when (looking-at org-verbatim-re) (let ((begin (match-beginning 2)) (value (match-string-no-properties 4)) (post-blank (progn (goto-char (match-end 2)) @@ -4389,8 +4388,7 @@ to an appropriate container (e.g., a paragraph)." (org-element-target-parser))) (or (and (memq 'timestamp restriction) (org-element-timestamp-parser)) - (and (or (memq 'link restriction) - (memq 'simple-link restriction)) + (and (memq 'link restriction) (org-element-link-parser))))) (?\\ (if (eq (aref result 1) ?\\) @@ -4411,8 +4409,7 @@ to an appropriate container (e.g., a paragraph)." (and (memq 'statistics-cookie restriction) (org-element-statistics-cookie-parser))))) ;; This is probably a plain link. - (_ (and (or (memq 'link restriction) - (memq 'simple-link restriction)) + (_ (and (memq 'link restriction) (org-element-link-parser))))))) (or (eobp) (forward-char)))) (cond (found) @@ -4759,9 +4756,6 @@ indentation removed from its contents." ;; associated to a key, obtained with `org-element--cache-key'. This ;; mechanism is robust enough to preserve total order among elements ;; even when the tree is only partially synchronized. -;; -;; Objects contained in an element are stored in a hash table, -;; `org-element--cache-objects'. (defvar org-element-use-cache nil @@ -4793,34 +4787,6 @@ Each node of the tree contains an element. Comparison is done with `org-element--cache-compare'. This cache is used in `org-element-at-point'.") -(defvar org-element--cache-objects nil - "Hash table used as to cache objects. -Key is an element, as returned by `org-element-at-point', and -value is an alist where each association is: - - (PARENT COMPLETEP . OBJECTS) - -where PARENT is an element or object, COMPLETEP is a boolean, -non-nil when all direct children of parent are already cached and -OBJECTS is a list of such children, as objects, from farthest to -closest. - -In the following example, \\alpha, bold object and \\beta are -contained within a paragraph - - \\alpha *\\beta* - -If the paragraph is completely parsed, OBJECTS-DATA will be - - ((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT) - (BOLD-OBJECT t ENTITY-OBJECT)) - -whereas in a partially parsed paragraph, it could be - - ((PARAGRAPH nil ENTITY-OBJECT)) - -This cache is used in `org-element-context'.") - (defvar org-element--cache-sync-requests nil "List of pending synchronization requests. @@ -5057,36 +5023,28 @@ the cache." (`nil lower) (_ upper)))) -(defun org-element--cache-put (element &optional data) - "Store ELEMENT in current buffer's cache, if allowed. -When optional argument DATA is non-nil, assume is it object data -relative to ELEMENT and store it in the objects cache." - (cond ((not (org-element--cache-active-p)) nil) - ((not data) - (when org-element--cache-sync-requests - ;; During synchronization, first build an appropriate key - ;; for the new element so `avl-tree-enter' can insert it at - ;; the right spot in the cache. - (let ((keys (org-element--cache-find - (org-element-property :begin element) 'both))) - (puthash element - (org-element--cache-generate-key - (and (car keys) (org-element--cache-key (car keys))) - (cond ((cdr keys) (org-element--cache-key (cdr keys))) - (org-element--cache-sync-requests - (aref (car org-element--cache-sync-requests) 0)))) - org-element--cache-sync-keys))) - (avl-tree-enter org-element--cache element)) - ;; Headlines are not stored in cache, so objects in titles are - ;; not stored either. - ((eq (org-element-type element) 'headline) nil) - (t (puthash element data org-element--cache-objects)))) +(defun org-element--cache-put (element) + "Store ELEMENT in current buffer's cache, if allowed." + (when (org-element--cache-active-p) + (when org-element--cache-sync-requests + ;; During synchronization, first build an appropriate key for + ;; the new element so `avl-tree-enter' can insert it at the + ;; right spot in the cache. + (let ((keys (org-element--cache-find + (org-element-property :begin element) 'both))) + (puthash element + (org-element--cache-generate-key + (and (car keys) (org-element--cache-key (car keys))) + (cond ((cdr keys) (org-element--cache-key (cdr keys))) + (org-element--cache-sync-requests + (aref (car org-element--cache-sync-requests) 0)))) + org-element--cache-sync-keys))) + (avl-tree-enter org-element--cache element))) (defsubst org-element--cache-remove (element) "Remove ELEMENT from cache. Assume ELEMENT belongs to cache and that a cache is active." - (avl-tree-delete org-element--cache element) - (remhash element org-element--cache-objects)) + (avl-tree-delete org-element--cache element)) ;;;; Synchronization @@ -5342,11 +5300,7 @@ request." (throw 'interrupt nil)) ;; Shift element. (unless (zerop offset) - (org-element--cache-shift-positions data offset) - ;; Shift associated objects data, if any. - (dolist (object-data (gethash data org-element--cache-objects)) - (dolist (object (cddr object-data)) - (org-element--cache-shift-positions object offset)))) + (org-element--cache-shift-positions data offset)) (let ((begin (org-element-property :begin data))) ;; Update PARENT and re-parent DATA, only when ;; necessary. Propagate new structures for lists. @@ -5712,7 +5666,6 @@ buffers." (when (and org-element-use-cache (derived-mode-p 'org-mode)) (setq-local org-element--cache (avl-tree-create #'org-element--cache-compare)) - (setq-local org-element--cache-objects (make-hash-table :test #'eq)) (setq-local org-element--cache-sync-keys (make-hash-table :weakness 'key :test #'eq)) (setq-local org-element--cache-change-warning nil) @@ -5869,114 +5822,54 @@ Providing it allows for quicker computation." (or (< pos cend) (and (= pos cend) (eobp)))) (narrow-to-region cbeg cend) (throw 'objects-forbidden element)))) - ;; At a planning line, if point is at a timestamp, return it, - ;; otherwise, return element. - ((eq type 'planning) - (dolist (p '(:closed :deadline :scheduled)) - (let ((timestamp (org-element-property p element))) - (when (and timestamp - (<= (org-element-property :begin timestamp) pos) - (> (org-element-property :end timestamp) pos)) - (throw 'objects-forbidden timestamp)))) - ;; All other locations cannot contain objects: bail out. - (throw 'objects-forbidden element)) (t (throw 'objects-forbidden element))) (goto-char (point-min)) (let ((restriction (org-element-restriction type)) (parent element) - (cache (cond ((not (org-element--cache-active-p)) nil) - (org-element--cache-objects - (gethash element org-element--cache-objects)) - (t (org-element-cache-reset) nil))) - next object-data last) - (prog1 - (catch 'exit - (while t - ;; When entering PARENT for the first time, get list - ;; of objects within known so far. Store it in - ;; OBJECT-DATA. - (unless next - (let ((data (assq parent cache))) - (if data (setq object-data data) - (push (setq object-data (list parent nil)) cache)))) - ;; Find NEXT object for analysis. - (catch 'found - ;; If NEXT is non-nil, we already exhausted the - ;; cache so we can parse buffer to find the object - ;; after it. - (if next (setq next (org-element--object-lex restriction)) - ;; Otherwise, check if cache can help us. - (let ((objects (cddr object-data)) - (completep (nth 1 object-data))) - (cond - ((and (not objects) completep) (throw 'exit parent)) - ((not objects) - (setq next (org-element--object-lex restriction))) - (t - (let ((cache-limit - (org-element-property :end (car objects)))) - (if (>= cache-limit pos) - ;; Cache contains the information needed. - (dolist (object objects (throw 'exit parent)) - (when (<= (org-element-property :begin object) - pos) - (if (>= (org-element-property :end object) - pos) - (throw 'found (setq next object)) - (throw 'exit parent)))) - (goto-char cache-limit) - (setq next - (org-element--object-lex restriction)))))))) - ;; If we have a new object to analyze, store it in - ;; cache. Otherwise record that there is nothing - ;; more to parse in this element at this depth. - (if next - (progn (org-element-put-property next :parent parent) - (push next (cddr object-data))) - (setcar (cdr object-data) t))) - ;; Process NEXT, if any, in order to know if we need - ;; to skip it, return it or move into it. - (if (or (not next) (> (org-element-property :begin next) pos)) - (throw 'exit (or last parent)) - (let ((end (org-element-property :end next)) - (cbeg (org-element-property :contents-begin next)) - (cend (org-element-property :contents-end next))) - (cond - ;; Skip objects ending before point. Also skip - ;; objects ending at point unless it is also the - ;; end of buffer, since we want to return the - ;; innermost object. - ((and (<= end pos) (/= (point-max) end)) - (goto-char end) - ;; For convenience, when object ends at POS, - ;; without any space, store it in LAST, as we - ;; will return it if no object starts here. - (when (and (= end pos) - (not (memq (char-before) '(?\s ?\t)))) - (setq last next))) - ;; If POS is within a container object, move - ;; into that object. - ((and cbeg cend - (>= pos cbeg) - (or (< pos cend) - ;; At contents' end, if there is no - ;; space before point, also move into - ;; object, for consistency with - ;; convenience feature above. - (and (= pos cend) - (or (= (point-max) pos) - (not (memq (char-before pos) - '(?\s ?\t))))))) - (goto-char cbeg) - (narrow-to-region (point) cend) - (setq parent next - restriction (org-element-restriction next) - next nil - object-data nil)) - ;; Otherwise, return NEXT. - (t (throw 'exit next))))))) - ;; Store results in cache, if applicable. - (org-element--cache-put element cache))))))) + last) + (catch 'exit + (while t + (let ((next (org-element--object-lex restriction))) + (when next (org-element-put-property next :parent parent)) + ;; Process NEXT, if any, in order to know if we need to + ;; skip it, return it or move into it. + (if (or (not next) (> (org-element-property :begin next) pos)) + (throw 'exit (or last parent)) + (let ((end (org-element-property :end next)) + (cbeg (org-element-property :contents-begin next)) + (cend (org-element-property :contents-end next))) + (cond + ;; Skip objects ending before point. Also skip + ;; objects ending at point unless it is also the + ;; end of buffer, since we want to return the + ;; innermost object. + ((and (<= end pos) (/= (point-max) end)) + (goto-char end) + ;; For convenience, when object ends at POS, + ;; without any space, store it in LAST, as we + ;; will return it if no object starts here. + (when (and (= end pos) + (not (memq (char-before) '(?\s ?\t)))) + (setq last next))) + ;; If POS is within a container object, move into + ;; that object. + ((and cbeg cend + (>= pos cbeg) + (or (< pos cend) + ;; At contents' end, if there is no + ;; space before point, also move into + ;; object, for consistency with + ;; convenience feature above. + (and (= pos cend) + (or (= (point-max) pos) + (not (memq (char-before pos) + '(?\s ?\t))))))) + (goto-char cbeg) + (narrow-to-region (point) cend) + (setq parent next) + (setq restriction (org-element-restriction next))) + ;; Otherwise, return NEXT. + (t (throw 'exit next))))))))))))) (defun org-element-lineage (blob &optional types with-self) "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'." ("yen" "\\textyen{}" nil "¥" "yen" "¥" "¥") ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") ("EUR" "\\texteuro{}" nil "€" "EUR" "EUR" "€") + ("dollar" "\\$" nil "$" "$" "$" "$") + ("USD" "\\$" nil "$" "$" "$" "$") "** Property Marks" ("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 @@ (require 'org) (require 'gnus-util) -(eval-when-compile (require 'gnus-sum)) -;; Declare external functions and variables + +;;; Declare external functions and variables (declare-function message-fetch-field "message" (header &optional not-all)) -(declare-function message-narrow-to-head-1 "message" nil) -(declare-function gnus-summary-last-subject "gnus-sum" nil) (declare-function nnvirtual-map-article "nnvirtual" (article)) -;; Customization variables - -(defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links) + +;;; Customization variables (defcustom org-gnus-prefer-web-links nil "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." :group 'org-link-store :type 'boolean) -(defcustom org-gnus-nnimap-query-article-no-from-file nil - "If non-nil, `org-gnus-follow-link' will try to translate -Message-Ids to article numbers by querying the .overview file. -Normally, this translation is done by querying the IMAP server, -which is usually very fast. Unfortunately, some (maybe badly -configured) IMAP servers don't support this operation quickly. -So if following a link to a Gnus article takes ages, try setting -this variable to t." - :group 'org-link-store - :version "24.1" - :type 'boolean) - (defcustom org-gnus-no-server nil "Should Gnus be started using `gnus-no-server'?" :group 'org-gnus @@ -73,30 +58,14 @@ this variable to t." :package-version '(Org . "8.0") :type 'boolean) -;; Install the link type -(org-link-set-parameters "gnus" :follow #'org-gnus-open :store #'org-gnus-store-link) + +;;; Install the link type -;; Implementation - -(defun org-gnus-nnimap-cached-article-number (group server message-id) - "Return cached article number (uid) of message in GROUP on SERVER. -MESSAGE-ID is the message-id header field that identifies the -message. If the uid is not cached, return nil." - (with-temp-buffer - (let ((nov (and (fboundp 'nnimap-group-overview-filename) - ;; nnimap-group-overview-filename was removed from - ;; Gnus in September 2010, and therefore should - ;; only be present in Emacs 23.1. - (nnimap-group-overview-filename group server)))) - (when (and nov (file-exists-p nov)) - (mm-insert-file-contents nov) - (set-buffer-modified-p nil) - (goto-char (point-min)) - (catch 'found - (while (search-forward message-id nil t) - (let ((hdr (split-string (thing-at-point 'line) "\t"))) - (if (string= (nth 4 hdr) message-id) - (throw 'found (nth 0 hdr)))))))))) +(org-link-set-parameters "gnus" + :follow #'org-gnus-open + :store #'org-gnus-store-link) + +;;; Implementation (defun org-gnus-group-link (group) "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 (defun org-gnus-store-link () "Store a link to a Gnus folder or message." - (cond - ((eq major-mode 'gnus-group-mode) - (let* ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus - (gnus-group-group-name)) ; version - ((fboundp 'gnus-group-name) - (gnus-group-name)) - (t "???"))) - desc link) - (when group - (org-store-link-props :type "gnus" :group group) - (setq desc (org-gnus-group-link group) - link desc) - (org-add-link-props :link link :description desc) - link))) - - ((memq major-mode '(gnus-summary-mode gnus-article-mode)) - (let* ((group gnus-newsgroup-name) - (header (with-current-buffer gnus-summary-buffer - (gnus-summary-article-header))) - (from (mail-header-from header)) - (message-id (org-unbracket-string "<" ">" (mail-header-id header))) - (date (org-trim (mail-header-date header))) - (subject (copy-sequence (mail-header-subject header))) - (to (cdr (assq 'To (mail-header-extra header)))) - newsgroups x-no-archive desc link) - (cl-case (car (gnus-find-method-for-group gnus-newsgroup-name)) - (nnvirtual - (setq group (car (nnvirtual-map-article - (gnus-summary-article-number))))) - (nnir - (setq group (nnir-article-group (gnus-summary-article-number))))) - ;; Remove text properties of subject string to avoid Emacs bug - ;; #3506 - (set-text-properties 0 (length subject) nil subject) - - ;; Fetching an article is an expensive operation; newsgroup and - ;; x-no-archive are only needed for web links. - (when (org-xor current-prefix-arg org-gnus-prefer-web-links) - ;; Make sure the original article buffer is up-to-date - (save-window-excursion (gnus-summary-select-article)) - (setq to (or to (gnus-fetch-original-field "To")) - newsgroups (gnus-fetch-original-field "Newsgroups") - x-no-archive (gnus-fetch-original-field "x-no-archive"))) - (org-store-link-props :type "gnus" :from from :date date :subject subject - :message-id message-id :group group :to to) - (setq desc (org-email-link-description) - link (org-gnus-article-link - group newsgroups message-id x-no-archive)) - (org-add-link-props :link link :description desc) - link)) - ((eq major-mode 'message-mode) - (setq org-store-link-plist nil) ; reset - (save-excursion - (save-restriction - (message-narrow-to-headers) - (and (not (message-fetch-field "Message-ID")) - (message-generate-headers '(Message-ID))) - (goto-char (point-min)) - (re-search-forward "^Message-ID: *.*$" nil t) - (put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil) - (let ((gcc (car (last - (message-unquote-tokens - (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,"))))) - (id (org-unbracket-string "<" ">" (mail-fetch-field "Message-ID"))) - (to (mail-fetch-field "To")) - (from (mail-fetch-field "From")) - (subject (mail-fetch-field "Subject")) - desc link - newsgroup xarchive) ; those are always nil for gcc - (and (not gcc) - (error "Can not create link: No Gcc header found")) - (org-store-link-props :type "gnus" :from from :subject subject - :message-id id :group gcc :to to) - (setq desc (org-email-link-description) - link (org-gnus-article-link - gcc newsgroup id xarchive)) - (org-add-link-props :link link :description desc) - link)))))) + (pcase major-mode + (`gnus-group-mode + (let ((group (gnus-group-group-name))) + (when group + (org-store-link-props :type "gnus" :group group) + (let ((description (org-gnus-group-link group))) + (org-add-link-props :link description :description description) + description)))) + ((or `gnus-summary-mode `gnus-article-mode) + (let* ((group + (pcase (gnus-find-method-for-group gnus-newsgroup-name) + (`(nnvirtual . ,_) + (car (nnvirtual-map-article (gnus-summary-article-number)))) + (`(nnir . ,_) + (nnir-article-group (gnus-summary-article-number))) + (_ gnus-newsgroup-name))) + (header (with-current-buffer gnus-summary-buffer + (gnus-summary-article-header))) + (from (mail-header-from header)) + (message-id (org-unbracket-string "<" ">" (mail-header-id header))) + (date (org-trim (mail-header-date header))) + ;; Remove text properties of subject string to avoid Emacs + ;; bug #3506. + (subject (org-no-properties + (copy-sequence (mail-header-subject header)))) + (to (cdr (assq 'To (mail-header-extra header)))) + newsgroups x-no-archive) + ;; Fetching an article is an expensive operation; newsgroup and + ;; x-no-archive are only needed for web links. + (when (org-xor current-prefix-arg org-gnus-prefer-web-links) + ;; Make sure the original article buffer is up-to-date. + (save-window-excursion (gnus-summary-select-article)) + (setq to (or to (gnus-fetch-original-field "To"))) + (setq newsgroups (gnus-fetch-original-field "Newsgroups")) + (setq x-no-archive (gnus-fetch-original-field "x-no-archive"))) + (org-store-link-props :type "gnus" :from from :date date :subject subject + :message-id message-id :group group :to to) + (let ((link (org-gnus-article-link + group newsgroups message-id x-no-archive)) + (description (org-email-link-description))) + (org-add-link-props :link link :description description) + link))) + (`message-mode + (setq org-store-link-plist nil) ;reset + (save-excursion + (save-restriction + (message-narrow-to-headers) + (unless (message-fetch-field "Message-ID") + (message-generate-headers '(Message-ID))) + (goto-char (point-min)) + (re-search-forward "^Message-ID:" nil t) + (put-text-property (line-beginning-position) (line-end-position) + 'message-deletable nil) + (let ((gcc (org-last (message-unquote-tokens + (message-tokenize-header + (mail-fetch-field "gcc" nil t) " ,")))) + (id (org-unbracket-string "<" ">" + (mail-fetch-field "Message-ID"))) + (to (mail-fetch-field "To")) + (from (mail-fetch-field "From")) + (subject (mail-fetch-field "Subject")) + newsgroup xarchive) ;those are always nil for gcc + (unless gcc (error "Can not create link: No Gcc header found")) + (org-store-link-props :type "gnus" :from from :subject subject + :message-id id :group gcc :to to) + (let ((link (org-gnus-article-link gcc newsgroup id xarchive)) + (description (org-email-link-description))) + (org-add-link-props :link link :description description) + link))))))) (defun org-gnus-open-nntp (path) "Follow the nntp: link specified by PATH." @@ -230,64 +190,51 @@ If `org-store-link' was called with a prefix arg the meaning of (defun org-gnus-open (path) "Follow the Gnus message or folder link specified by PATH." - (let (group article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in Gnus link")) - (setq group (match-string 1 path) - article (match-string 3 path)) - (when group - (setq group (org-no-properties group))) - (when article - (setq article (org-no-properties article))) + (unless (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path) + (error "Error in Gnus link %S" path)) + (let ((group (match-string-no-properties 1 path)) + (article (match-string-no-properties 3 path))) (org-gnus-follow-link group article))) (defun org-gnus-follow-link (&optional group article) "Follow a Gnus link to GROUP and ARTICLE." (require 'gnus) (funcall (cdr (assq 'gnus org-link-frame-setup))) - (if gnus-other-frame-object (select-frame gnus-other-frame-object)) - (setq group (org-no-properties group)) - (setq article (org-no-properties article)) - (cond ((and group article) - (gnus-activate-group group) - (condition-case nil - (let* ((method (gnus-find-method-for-group group)) - (backend (car method)) - (server (cadr method))) - (cond - ((eq backend 'nndoc) - (if (gnus-group-read-group t nil group) + (when gnus-other-frame-object (select-frame gnus-other-frame-object)) + (let ((group (org-no-properties group)) + (article (org-no-properties article))) + (cond + ((and group article) + (gnus-activate-group group) + (condition-case nil + (let ((msg "Couldn't follow Gnus link. Summary couldn't be opened.")) + (pcase (gnus-find-method-for-group group) + (`(nndoc . ,_) + (if (gnus-group-read-group t nil group) + (gnus-summary-goto-article article nil t) + (message msg))) + (_ + (let ((articles 1) + group-opened) + (while (and (not group-opened) + ;; Stop on integer overflows. + (> articles 0)) + (setq group-opened (gnus-group-read-group articles t group)) + (setq articles (if (< articles 16) + (1+ articles) + (* articles 2)))) + (if group-opened (gnus-summary-goto-article article nil t) - (message "Couldn't follow gnus link. %s" - "The summary couldn't be opened."))) - (t - (let ((articles 1) - group-opened) - (when (and (eq backend 'nnimap) - org-gnus-nnimap-query-article-no-from-file) - (setq article - (or (org-gnus-nnimap-cached-article-number - (nth 1 (split-string group ":")) - server (concat "<" article ">")) article))) - (while (and (not group-opened) - ;; stop on integer overflows - (> articles 0)) - (setq group-opened (gnus-group-read-group - articles t group) - articles (if (< articles 16) - (1+ articles) - (* articles 2)))) - (if group-opened - (gnus-summary-goto-article article nil t) - (message "Couldn't follow gnus link. %s" - "The summary couldn't be opened.")))))) - (quit (message "Couldn't follow gnus link. %s" - "The linked group is empty.")))) - (group (gnus-group-jump-to-group group)))) + (message msg)))))) + (quit + (message "Couldn't follow Gnus link. The linked group is empty.")))) + (group (gnus-group-jump-to-group group))))) (defun org-gnus-no-new-news () "Like `\\[gnus]' but doesn't check for new news." - (if (not (gnus-alive-p)) (if org-gnus-no-server (gnus-no-server) (gnus)))) + (cond ((gnus-alive-p) nil) + (org-gnus-no-server (gnus-no-server)) + (t (gnus)))) (provide 'org-gnus) 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." (if pom (goto-char pom)) (cl-assert (org-is-habit-p (point))) (let* ((scheduled (org-get-scheduled-time (point))) - (scheduled-repeat (org-get-repeat org-scheduled-string)) + (scheduled-repeat (org-get-repeat (org-entry-get (point) "SCHEDULED"))) (end (org-entry-end-position)) (habit-entry (org-no-properties (nth 4 (org-heading-components)))) 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." (defun org-info-export (path desc format) "Export an info link. See `org-link-parameters' for details about PATH, DESC and FORMAT." - (when (eq format 'html) - (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" path) - (string-match "\\(.*\\)" path)) - (let ((filename (match-string 1 path)) - (node (or (match-string 2 path) "Top"))) - (format "<a href=\"%s#%s\">%s</a>" - (org-info-map-html-url filename) - (org-info--expand-node-name node) - (or desc path))))) + (let* ((parts (split-string path "[#:]:?")) + (manual (car parts)) + (node (or (nth 1 parts) "Top"))) + (pcase format + (`html + (format "<a href=\"%s#%s\">%s</a>" + (org-info-map-html-url manual) + (org-info--expand-node-name node) + (or desc path))) + (`texinfo + (let ((title (or desc ""))) + (format "@ref{%s,%s,,%s,}" node title manual))) + (_ nil)))) (provide 'org-info) 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 @@ ;; - spurious macro arguments or invalid macro templates ;; - special properties in properties drawer ;; - obsolete syntax for PROPERTIES drawers +;; - Invalid EFFORT property value ;; - missing definition for footnote references ;; - missing reference for footnote definitions ;; - non-footnote definitions in footnote section @@ -242,6 +243,10 @@ :description "Report obsolete syntax for properties drawers" :categories '(obsolete properties)) (make-org-lint-checker + :name 'invalid-effort-property + :description "Report invalid duration in EFFORT property" + :categories '(properties)) + (make-org-lint-checker :name 'undefined-footnote-reference :description "Report missing definition for footnote references" :categories '(footnote)) @@ -348,7 +353,7 @@ called with one argument, the key used for comparison." (org-lint--collect-duplicates ast 'target - (lambda (target) (org-split-string (org-element-property :value target))) + (lambda (target) (split-string (org-element-property :value target))) (lambda (target _) (org-element-property :begin target)) (lambda (key) (format "Duplicate target <<%s>>" (mapconcat #'identity key " "))))) @@ -542,6 +547,16 @@ Use :header-args: instead" "Incorrect contents for PROPERTIES drawer" "Incorrect location for PROPERTIES drawer")))))))) +(defun org-lint-invalid-effort-property (ast) + (org-element-map ast 'node-property + (lambda (p) + (when (equal "EFFORT" (org-element-property :key p)) + (let ((value (org-element-property :value p))) + (and (org-string-nw-p value) + (not (org-duration-p value)) + (list (org-element-property :begin p) + (format "Invalid effort duration format: %S" value)))))))) + (defun org-lint-link-to-local-file (ast) (org-element-map ast 'link (lambda (l) @@ -985,7 +1000,7 @@ Use \"export %s\" instead" (unless (memq allowed-values '(:any nil)) (let ((values (cdr header)) groups-alist) - (dolist (v (if (stringp values) (org-split-string values) + (dolist (v (if (stringp values) (split-string values) (list values))) (let ((valid-value nil)) (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 @@ (declare-function org-remove-indentation "org" (code &optional n)) (declare-function org-show-subtree "org" ()) (declare-function org-sort-remove-invisible "org" (S)) -(declare-function org-time-string-to-seconds "org" (s)) +(declare-function org-time-string-to-seconds "org" (s &optional zone)) (declare-function org-timer-hms-to-secs "org-timer" (hms)) (declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-trim "org" (s &optional keep-lead)) @@ -2250,6 +2250,7 @@ If CHECKBOX is non-nil, add a checkbox next to the bullet. Return t when things worked, nil when we are not in an item, or item is invisible." + (interactive "P") (let ((itemp (org-in-item-p)) (pos (point))) ;; If cursor isn't is a list or if list is invisible, return nil. @@ -3324,23 +3325,28 @@ Valid parameters are: Strings to start or end a list item, and to start a list item with a counter. They can also be set to a function returning - a string or nil, which will be called with the depth of the - item, counting from 1. + a string or nil, which will be called with two arguments: the + type of list and the depth of the item, counting from 1. :icount Strings to start a list item with a counter. It can also be set to a function returning a string or nil, which will be - called with two arguments: the depth of the item, counting from - 1, and the counter. Its value, when non-nil, has precedence - over `:istart'. + called with three arguments: the type of list, the depth of the + item, counting from 1, and the counter. Its value, when + non-nil, has precedence over `:istart'. :isep String used to separate items. It can also be set to a function returning a string or nil, which will be called with - the depth of the items, counting from 1. It always start on - a new line. + two arguments: the type of list and the depth of the item, + counting from 1. It always start on a new line. + +:ifmt + + Function to be applied to the contents of every item. It is + called with two arguments: the type of list and the contents. :cbon, :cboff, :cbtrans @@ -3471,6 +3477,7 @@ PARAMS is a plist used to tweak the behavior of the transcoder." (iend (plist-get params :iend)) (isep (plist-get params :isep)) (icount (plist-get params :icount)) + (ifmt (plist-get params :ifmt)) (cboff (plist-get params :cboff)) (cbon (plist-get params :cbon)) (cbtrans (plist-get params :cbtrans)) @@ -3484,9 +3491,9 @@ PARAMS is a plist used to tweak the behavior of the transcoder." (tag (org-element-property :tag item)) (depth (org-list--depth item)) (separator (and (org-export-get-next-element item info) - (org-list--generic-eval isep depth))) - (closing (pcase (org-list--generic-eval iend depth) - ((or `nil `"") "\n") + (org-list--generic-eval isep type depth))) + (closing (pcase (org-list--generic-eval iend type depth) + ((or `nil "") "\n") ((and (guard separator) s) (if (equal (substring s -1) "\n") s (concat s "\n"))) (s s)))) @@ -3503,10 +3510,10 @@ PARAMS is a plist used to tweak the behavior of the transcoder." ;; Build output. (concat (let ((c (org-element-property :counter item))) - (if c (org-list--generic-eval icount depth c) - (org-list--generic-eval istart depth))) + (if (and c icount) (org-list--generic-eval icount type depth c) + (org-list--generic-eval istart type depth))) (let ((body - (if (or istart iend icount cbon cboff cbtrans (not backend) + (if (or istart iend icount ifmt cbon cboff cbtrans (not backend) (and (eq type 'descriptive) (or dtstart dtend ddstart ddend))) (concat @@ -3522,7 +3529,11 @@ PARAMS is a plist used to tweak the behavior of the transcoder." (org-element-interpret-data tag)) dtend)) (and tag ddstart) - (if (= (length contents) 0) "" (substring contents 0 -1)) + (let ((contents + (if (= (length contents) 0) "" + (substring contents 0 -1)))) + (if ifmt (org-list--generic-eval ifmt type contents) + contents)) (and tag ddend)) (org-export-with-backend backend item contents info)))) ;; Remove final newline. @@ -3555,6 +3566,25 @@ PARAMS is a property list with overruling parameters for (require 'ox-texinfo) (org-list-to-generic list (org-combine-plists '(:backend texinfo) params))) +(defun org-list-to-org (list &optional params) + "Convert LIST into an Org plain list. +LIST is as returned by `org-list-parse-list'. PARAMS is a property list +with overruling parameters for `org-list-to-generic'." + (let* ((make-item + (lambda (type _depth &optional c) + (concat (if (eq type 'ordered) "1. " "- ") + (and c (format "[@%d] " c))))) + (defaults + (list :istart make-item + :icount make-item + :ifmt (lambda (_type contents) + (replace-regexp-in-string "\n" "\n " contents)) + :dtend " :: " + :cbon "[X] " + :cboff "[ ] " + :cbtrans "[-] "))) + (org-list-to-generic list (org-combine-plists defaults params)))) + (defun org-list-to-subtree (list &optional params) "Convert LIST into an Org subtree. 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'." (org-previous-line-empty-p))))) (level (org-reduced-level (or (org-current-level) 0))) (make-stars - (lambda (depth) + (lambda (_type depth &optional _count) ;; Return the string for the heading, depending on DEPTH ;; of current sub-list. (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 @@ ;; Along with macros defined through #+MACRO: keyword, default ;; templates include the following hard-coded macros: -;; {{{time(format-string)}}}, {{{property(node-property)}}}, -;; {{{input-file}}} and {{{modification-time(format-string)}}}. +;; {{{time(format-string)}}}, +;; {{{property(node-property)}}}, +;; {{{input-file}}}, +;; {{{modification-time(format-string)}}}, +;; {{{n(counter,action}}}. ;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}}, ;; {{{email}}} and {{{title}}} macros. @@ -52,9 +55,11 @@ (declare-function org-element-macro-parser "org-element" ()) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) -(declare-function org-file-contents "org" (file &optional noerror)) +(declare-function org-file-contents "org" (file &optional noerror nocache)) +(declare-function org-file-url-p "org" (file)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-mode "org" ()) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function vc-backend "vc-hooks" (f)) (declare-function vc-call "vc-hooks" (fun file &rest args) t) (declare-function vc-exec-after "vc-dispatcher" (code)) @@ -99,16 +104,21 @@ Return an alist containing all macro templates found." (if old-cell (setcdr old-cell template) (push (cons name template) templates)))) ;; Enter setup file. - (let ((file (expand-file-name - (org-unbracket-string "\"" "\"" val)))) - (unless (member file files) + (let* ((uri (org-unbracket-string "\"" "\"" (org-trim val))) + (uri-is-url (org-file-url-p uri)) + (uri (if uri-is-url + uri + (expand-file-name uri)))) + ;; Avoid circular dependencies. + (unless (member uri files) (with-temp-buffer - (setq default-directory - (file-name-directory file)) + (unless uri-is-url + (setq default-directory + (file-name-directory uri))) (org-mode) - (insert (org-file-contents file 'noerror)) + (insert (org-file-contents uri 'noerror)) (setq templates - (funcall collect-macros (cons file files) + (funcall collect-macros (cons uri files) templates))))))))))) templates)))) (funcall collect-macros nil nil))) @@ -126,7 +136,7 @@ function installs the following ones: \"property\", (let ((old-template (assoc (car cell) templates))) (if old-template (setcdr old-template (cdr cell)) (push cell templates)))))) - ;; Install hard-coded macros. + ;; Install "property", "time" macros. (mapc update-templates (list (cons "property" "(eval (save-excursion @@ -140,6 +150,7 @@ function installs the following ones: \"property\", l))))) (org-entry-get nil \"$1\" 'selective)))") (cons "time" "(eval (format-time-string \"$1\"))"))) + ;; Install "input-file", "modification-time" macros. (let ((visited-file (buffer-file-name (buffer-base-buffer)))) (when (and visited-file (file-exists-p visited-file)) (mapc update-templates @@ -149,6 +160,10 @@ function installs the following ones: \"property\", (prin1-to-string visited-file) (prin1-to-string (nth 5 (file-attributes visited-file))))))))) + ;; Initialize and install "n" macro. + (org-macro--counter-initialize) + (funcall update-templates + (cons "n" "(eval (org-macro--counter-increment \"$1\" \"$2\"))")) (setq org-macro-templates templates))) (defun org-macro-expand (macro templates) @@ -276,6 +291,9 @@ Return a list of arguments, as strings. This is the opposite of s nil t) "\000")) + +;;; Helper functions and variables for internal macros + (defun org-macro--vc-modified-time (file) (save-window-excursion (when (vc-backend file) @@ -300,6 +318,38 @@ Return a list of arguments, as strings. This is the opposite of (kill-buffer buf)) date)))) +(defvar org-macro--counter-table nil + "Hash table containing counter value per name.") + +(defun org-macro--counter-initialize () + "Initialize `org-macro--counter-table'." + (setq org-macro--counter-table (make-hash-table :test #'equal))) + +(defun org-macro--counter-increment (name &optional action) + "Increment counter NAME. +NAME is a string identifying the counter. + +When non-nil, optional argument ACTION is a string. + +If the string is \"-\", keep the NAME counter at its current +value, i.e. do not increment. + +If the string represents an integer, set the counter to this number. + +Any other non-empty string resets the counter to 1." + (let ((name-trimmed (org-trim name)) + (action-trimmed (when (org-string-nw-p action) + (org-trim action)))) + (puthash name-trimmed + (cond ((not (org-string-nw-p action-trimmed)) + (1+ (gethash name-trimmed org-macro--counter-table 0))) + ((string= "-" action-trimmed) + (gethash name-trimmed org-macro--counter-table 1)) + ((string-match-p "\\`[0-9]+\\'" action-trimmed) + (string-to-number action-trimmed)) + (t 1)) + org-macro--counter-table))) + (provide 'org-macro) ;;; 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." (string-match-p "[^ \r\t\n]" s) s)) +(defun org-split-string (string &optional separators) + "Splits STRING into substrings at SEPARATORS. + +SEPARATORS is a regular expression. When nil, it defaults to +\"[ \f\t\n\r\v]+\". + +Unlike to `split-string', matching SEPARATORS at the beginning +and end of string are ignored." + (let ((separators (or separators "[ \f\t\n\r\v]+"))) + (when (string-match (concat "\\`" separators) string) + (setq string (replace-match "" nil nil string))) + (when (string-match (concat separators "\\'") string) + (setq string (replace-match "" nil nil string))) + (split-string string separators))) + +(defun org-string-display (string) + "Return STRING as it is displayed in the current buffer. +This function takes into consideration `invisible' and `display' +text properties." + (let* ((build-from-parts + (lambda (s property filter) + ;; Build a new string out of string S. On every group of + ;; contiguous characters with the same PROPERTY value, + ;; call FILTER on the properties list at the beginning of + ;; the group. If it returns a string, replace the + ;; characters in the group with it. Otherwise, preserve + ;; those characters. + (let ((len (length s)) + (new "") + (i 0) + (cursor 0)) + (while (setq i (text-property-not-all i len property nil s)) + (let ((end (next-single-property-change i property s len)) + (value (funcall filter (text-properties-at i s)))) + (when value + (setq new (concat new (substring s cursor i) value)) + (setq cursor end)) + (setq i end))) + (concat new (substring s cursor))))) + (prune-invisible + (lambda (s) + (funcall build-from-parts s 'invisible + (lambda (props) + ;; If `invisible' property in PROPS means text + ;; is to be invisible, return the empty string. + ;; Otherwise return nil so that the part is + ;; skipped. + (and (or (eq t buffer-invisibility-spec) + (assoc-string (plist-get props 'invisible) + buffer-invisibility-spec)) + ""))))) + (replace-display + (lambda (s) + (funcall build-from-parts s 'display + (lambda (props) + ;; If there is any string specification in + ;; `display' property return it. Also attach + ;; other text properties on the part to that + ;; string (face...). + (let* ((display (plist-get props 'display)) + (value (if (stringp display) display + (cl-some #'stringp display)))) + (when value + (apply + #'propertize + ;; Displayed string could contain + ;; invisible parts, but no nested display. + (funcall prune-invisible value) + (plist-put props + 'display + (and (not (stringp display)) + (cl-remove-if #'stringp + display))))))))))) + ;; `display' property overrides `invisible' one. So we first + ;; replace characters with `display' property. Then we remove + ;; invisible characters. + (funcall prune-invisible (funcall replace-display string)))) + +(defun org-string-width (string) + "Return width of STRING when displayed in the current buffer. +Unlike to `string-width', this function takes into consideration +`invisible' and `display' text properties." + (string-width (org-string-display string))) + (defun org-not-nil (v) "If V not nil, and also not the string \"nil\", then return V. 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." (defun org-mouse-delete-timestamp () "Deletes the current timestamp as well as the preceding keyword. SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" - (when (or (org-at-date-range-p) (org-at-timestamp-p)) - (replace-match "") ; delete the timestamp + (when (or (org-at-date-range-p) (org-at-timestamp-p 'lax)) + (replace-match "") ;delete the timestamp (skip-chars-backward " :A-Z") (when (looking-at " *[A-Z][A-Z]+:") (replace-match "")))) @@ -516,7 +516,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ["Check Phrase ..." org-occur] "--" ["Display Agenda" org-agenda-list t] - ["Display Timeline" org-timeline t] ["Display TODO List" org-todo-list t] ("Display Tags" ,@(org-mouse-keyword-menu @@ -715,7 +714,7 @@ This means, between the beginning of line and the point." (org-tags-sparse-tree nil ,(match-string 1))] "--" ,@(org-mouse-tag-menu)))) - ((org-at-timestamp-p) + ((org-at-timestamp-p 'lax) (popup-menu '(nil ["Show Day" org-open-at-point t] @@ -1044,21 +1043,21 @@ This means, between the beginning of line and the point." org-agenda-undo-list)] ["Rebuild Buffer" org-agenda-redo t] ["New Diary Entry" - org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t] + org-agenda-diary-entry (org-agenda-check-type nil 'agenda) t] "--" ["Goto Today" org-agenda-goto-today - (org-agenda-check-type nil 'agenda 'timeline) t] + (org-agenda-check-type nil 'agenda) t] ["Display Calendar" org-agenda-goto-calendar - (org-agenda-check-type nil 'agenda 'timeline) t] + (org-agenda-check-type nil 'agenda) t] ("Calendar Commands" ["Phases of the Moon" org-agenda-phases-of-moon - (org-agenda-check-type nil 'agenda 'timeline)] + (org-agenda-check-type nil 'agenda)] ["Sunrise/Sunset" org-agenda-sunrise-sunset - (org-agenda-check-type nil 'agenda 'timeline)] + (org-agenda-check-type nil 'agenda)] ["Holidays" org-agenda-holidays - (org-agenda-check-type nil 'agenda 'timeline)] + (org-agenda-check-type nil 'agenda)] ["Convert" org-agenda-convert-date - (org-agenda-check-type nil 'agenda 'timeline)] + (org-agenda-check-type nil 'agenda)] "--" ["Create iCalendar file" org-icalendar-combine-agenda-files t]) "--" @@ -1071,7 +1070,7 @@ This means, between the beginning of line and the point." "--" ["Show Logbook entries" org-agenda-log-mode :style toggle :selected org-agenda-show-log - :active (org-agenda-check-type nil 'agenda 'timeline)] + :active (org-agenda-check-type nil 'agenda)] ["Include Diary" org-agenda-toggle-diary :style toggle :selected org-agenda-include-diary :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: :working-suffix \".org\" :base-url \"http://localhost/org/\" :working-directory \"/home/user/org/\" - :rewrites ((\"org/?$\" . \"index.php\"))))) + :rewrites ((\"org/?$\" . \"index.php\"))) + (\"Hugo based blog\" + :base-url \"https://www.site.com/\" + :working-directory \"~/site/content/post/\" + :online-suffix \".html\" + :working-suffix \".md\" + :rewrites ((\"\\(https://site.com/[0-9]+/[0-9]+/[0-9]+/\\)\" . \".md\"))))) + The last line tells `org-protocol-open-source' to open /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: ;; Try to match a rewritten URL and map it to ;; a real file. Compare redirects without ;; suffix. - (when (string-match-p (car rewrite) f1) - (throw 'result (concat wdir (cdr rewrite)))))))) + (when (string-match (car rewrite) f1) + (let ((replacement + (concat (directory-file-name + (replace-match "" nil nil f1 1)) + (cdr rewrite)))) + (throw 'result (concat wdir replacement)))))))) ;; -- end of redirects -- (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." (skip-chars-backward " \r\t\n") (line-beginning-position 1)) (org-element-property :value datum))) - ((memq type '(fixed-width table)) + ((memq type '(fixed-width latex-environment table)) (let ((beg (org-element-property :post-affiliated datum)) (end (progn (goto-char (org-element-property :end datum)) (skip-chars-backward " \r\t\n") @@ -881,6 +881,28 @@ Throw an error when not at such a table." (table-recognize) t)) +(defun org-edit-latex-environment () + "Edit LaTeX environment at point. +\\<org-src-mode-map> +The LaTeX environment is copied into a new buffer. Major mode is +set to the one associated to \"latex\" in `org-src-lang-modes', +or to `latex-mode' if there is none. + +When done, exit with `\\[org-edit-src-exit]'. The edited text \ +will then replace +the LaTeX environment in the Org mode buffer." + (interactive) + (let ((element (org-element-at-point))) + (unless (and (eq (org-element-type element) 'latex-environment) + (org-src--on-datum-p element)) + (user-error "Not in a LaTeX environment")) + (org-src--edit-element + element + (org-src--construct-edit-buffer-name (buffer-name) "LaTeX environment") + (org-src--get-lang-mode "latex") + t) + t)) + (defun org-edit-export-block () "Edit export block at point. \\<org-src-mode-map> @@ -898,7 +920,10 @@ Throw an error when not at an export block." (unless (and (eq (org-element-type element) 'export-block) (org-src--on-datum-p element)) (user-error "Not in an export block")) - (let* ((type (downcase (org-element-property :type element))) + (let* ((type (downcase (or (org-element-property :type element) + ;; Missing export-block type. Fallback + ;; to default mode. + "fundamental"))) (mode (org-src--get-lang-mode type))) (unless (functionp mode) (error "No such language mode: %s" mode)) (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 @@ (declare-function calc-eval "calc" (str &optional separator &rest args)) -(defvar orgtbl-mode) ; defined below -(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized (defvar constants-unit-system) +(defvar org-element-use-cache) (defvar org-export-filters-alist) (defvar org-table-follow-field-mode) +(defvar orgtbl-mode) ; defined below +(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized (defvar sort-fold-case) (defvar orgtbl-after-send-table-hook nil @@ -80,17 +81,17 @@ are not run.") (defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ") -(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) +(defcustom orgtbl-optimized t "Non-nil means use the optimized table editor version for `orgtbl-mode'. + In the optimized version, the table editor takes over all simple keys that normally just insert a character. In tables, the characters are inserted in a way to minimize disturbing the table structure (i.e. in overwrite mode for empty fields). Outside tables, the correct binding of the keys is restored. -The default for this option is t if the optimized version is also used in -Org mode. See the variable `org-enable-table-editor' for details. Changing -this variable requires a restart of Emacs to become effective." +Changing this variable requires a restart of Emacs to become +effective." :group 'org-table :type 'boolean) @@ -207,8 +208,7 @@ removal/insertion." (defcustom org-table-auto-blank-field t "Non-nil means automatically blank table field when starting to type into it. This only happens when typing immediately after a field motion -command (TAB, S-TAB or RET). -Only relevant when `org-enable-table-editor' is equal to `optimized'." +command (TAB, S-TAB or RET)." :group 'org-table-editing :type 'boolean) @@ -293,13 +293,25 @@ relies on the variables to be present in the list." The default value is `hours', and will output the results as a number of hours. Other allowed values are `seconds', `minutes' and `days', and the output will be a fraction of seconds, minutes or -days." +days. `hh:mm' selects to use hours and minutes, ignoring seconds. +The `U' flag in a table formula will select this specific format for +a single formula." :group 'org-table-calculation :version "24.1" :type '(choice (symbol :tag "Seconds" 'seconds) (symbol :tag "Minutes" 'minutes) (symbol :tag "Hours " 'hours) - (symbol :tag "Days " 'days))) + (symbol :tag "Days " 'days) + (symbol :tag "HH:MM " 'hh:mm))) + +(defcustom org-table-duration-hour-zero-padding t + "Non-nil means hours in table duration computations should be zero-padded. +So this is about 08:32:34 versus 8:33:34." + :group 'org-table-calculation + :version "26.1" + :package-version '(Org . "9.1") + :type 'boolean + :safe #'booleanp) (defcustom org-table-formula-field-format "%s" "Format for fields which contain the result of a formula. @@ -796,7 +808,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; Find fields that are wider than FMAX, and shorten them. (when fmax (dolist (x column) - (when (> (org-string-width x) fmax) + (when (> (string-width x) fmax) (org-add-props x nil 'help-echo (concat @@ -824,7 +836,7 @@ edit. Full value is:\n" (list 'display org-narrow-column-arrow) x)))))) ;; Get the maximum width for each column - (push (apply #'max (or fmax 1) 1 (mapcar #'org-string-width column)) + (push (or fmax (apply #'max 1 (mapcar #'org-string-width column))) lengths) ;; Get the fraction of numbers among non-empty cells to ;; decide about alignment of the column. @@ -1018,20 +1030,23 @@ Before doing so, re-align the table if necessary." (interactive) (org-table-justify-field-maybe) (org-table-maybe-recalculate-line) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (if (org-at-table-hline-p) - (end-of-line 1)) - (condition-case nil - (progn - (re-search-backward "|" (org-table-begin)) - (re-search-backward "|" (org-table-begin))) - (error (user-error "Cannot move to previous table field"))) - (while (looking-at "|\\(-\\|[ \t]*$\\)") - (re-search-backward "|" (org-table-begin))) - (if (looking-at "| ?") - (goto-char (match-end 0)))) + (when (and org-table-automatic-realign + org-table-may-need-update) + (org-table-align)) + (when (org-at-table-hline-p) + (end-of-line)) + (let ((start (org-table-begin)) + (origin (point))) + (condition-case nil + (progn + (search-backward "|" start nil 2) + (while (looking-at-p "|\\(?:-\\|[ \t]*$\\)") + (search-backward "|" start))) + (error + (goto-char origin) + (user-error "Cannot move to previous table field")))) + (when (looking-at "| ?") + (goto-char (match-end 0)))) (defun org-table-beginning-of-field (&optional n) "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." txt txt-up inc) (org-table-check-inside-data-field) (if (not non-empty) - (save-excursion - (setq txt - (catch 'exit - (while (progn (beginning-of-line 1) - (re-search-backward org-table-dataline-regexp - beg t)) - (org-table-goto-column colpos t) - (if (and (looking-at - "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") - (<= (setq n (1- n)) 0)) - (throw 'exit (match-string 1)))))) - (setq field-up - (catch 'exit - (while (progn (beginning-of-line 1) - (re-search-backward org-table-dataline-regexp - beg t)) - (org-table-goto-column colpos t) - (if (and (looking-at - "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") - (<= (setq n (1- n)) 0)) - (throw 'exit (match-string 1)))))) - (setq non-empty-up (and field-up (string-match "[^ \t]" field-up)))) + (save-excursion + (setq txt + (catch 'exit + (while (progn (beginning-of-line 1) + (re-search-backward org-table-dataline-regexp + beg t)) + (org-table-goto-column colpos t) + (if (and (looking-at + "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") + (<= (setq n (1- n)) 0)) + (throw 'exit (match-string 1)))))) + (setq field-up + (catch 'exit + (while (progn (beginning-of-line 1) + (re-search-backward org-table-dataline-regexp + beg t)) + (org-table-goto-column colpos t) + (if (and (looking-at + "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") + (<= (setq n (1- n)) 0)) + (throw 'exit (match-string 1)))))) + (setq non-empty-up (and field-up (string-match "[^ \t]" field-up)))) ;; Above field was not empty, go down to the next row (setq txt (org-trim field)) (org-table-next-row) @@ -1169,7 +1184,7 @@ to a number. In the case of a timestamp, increment by days." (setq txt (calc-eval (concat txt "+" (number-to-string inc))))) (insert txt) (org-move-to-column col) - (if (and org-table-copy-increment (org-at-timestamp-p t)) + (if (and org-table-copy-increment (org-at-timestamp-p 'lax)) (org-timestamp-up-day inc) (org-table-maybe-recalculate-line)) (org-table-align) @@ -1317,22 +1332,15 @@ value." (defun org-table-current-column () "Find out which column we are in." (interactive) - (when (called-interactively-p 'any) (org-table-check-inside-data-field)) (save-excursion (let ((column 0) (pos (point))) (beginning-of-line) (while (search-forward "|" pos t) (cl-incf column)) - (when (called-interactively-p 'interactive) - (message "In table column %d" column)) column))) -;;;###autoload (defun org-table-current-dline () "Find out what table data line we are in. Only data lines count for this." - (interactive) - (when (called-interactively-p 'any) - (org-table-check-inside-data-field)) (save-excursion (let ((c 0) (pos (line-beginning-position))) @@ -1340,8 +1348,6 @@ Only data lines count for this." (while (<= (point) pos) (when (looking-at org-table-dataline-regexp) (cl-incf c)) (forward-line)) - (when (called-interactively-p 'any) - (message "This is table line %d" c)) c))) ;;;###autoload @@ -1734,8 +1740,9 @@ function is being called interactively." (cond ((string-match org-ts-regexp-both f) (float-time (org-time-string-to-time (match-string 0 f)))) - ((string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" f) - (org-hh:mm-string-to-minutes f)) + ((org-duration-p f) (org-duration-to-minutes f)) + ((string-match "\\<[0-9]+:[0-9]\\{2\\}\\>" f) + (org-duration-to-minutes (match-string 0 f))) (t 0)))) ((?f ?F) (or getkey-func @@ -1827,7 +1834,6 @@ lines." (user-error "First cut/copy a region to paste!")) (org-table-check-inside-data-field) (let* ((column (org-table-current-column)) - (org-enable-table-editor t) (org-table-automatic-realign nil)) (org-table-save-field (dolist (row org-table-clip) @@ -2002,11 +2008,15 @@ blank, and the content is appended to the field above." ;;;###autoload (defun org-table-edit-field (arg) "Edit table field in a different window. -This is mainly useful for fields that contain hidden parts. When called -with a `\\[universal-argument]' prefix, just make the full field \ -visible so that it can be -edited in place." +This is mainly useful for fields that contain hidden parts. + +When called with a `\\[universal-argument]' prefix, just make the full field +visible so that it can be edited in place. + +When called with a `\\[universal-argument] \\[universal-argument]' prefix, \ +toggle `org-table-follow-field-mode'." (interactive "P") + (unless (org-at-table-p) (user-error "Not at a table")) (cond ((equal arg '(16)) (org-table-follow-field-mode (if org-table-follow-field-mode -1 1))) @@ -2673,17 +2683,25 @@ For details, see the Org mode manual. This function can also be called from Lisp programs and offers additional arguments: EQUATION can be the formula to apply. If this -argument is given, the user will not be prompted. SUPPRESS-ALIGN is -used to speed-up recursive calls by by-passing unnecessary aligns. +argument is given, the user will not be prompted. + +SUPPRESS-ALIGN is used to speed-up recursive calls by by-passing +unnecessary aligns. + SUPPRESS-CONST suppresses the interpretation of constants in the -formula, assuming that this has been done already outside the function. -SUPPRESS-STORE means the formula should not be stored, either because -it is already stored, or because it is a modified equation that should -not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to -`org-table-analyze'." +formula, assuming that this has been done already outside the +function. + +SUPPRESS-STORE means the formula should not be stored, either +because it is already stored, or because it is a modified +equation that should not overwrite the stored one. + +SUPPRESS-ANALYSIS prevents analyzing the table and checking +location of point." (interactive "P") - (org-table-check-inside-data-field) - (or suppress-analysis (org-table-analyze)) + (unless suppress-analysis + (org-table-check-inside-data-field) + (org-table-analyze)) (if (equal arg '(16)) (let ((eq (org-table-current-field-formula))) (org-table-get-field nil eq) @@ -2722,15 +2740,14 @@ not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to (?s . sci) (?e . eng)))) n)))) (setq fmt (replace-match "" t t fmt))) - (if (string-match "T" fmt) - (setq duration t numbers t - duration-output-format nil - fmt (replace-match "" t t fmt))) - (if (string-match "t" fmt) - (setq duration t - duration-output-format org-table-duration-custom-format - numbers t - fmt (replace-match "" t t fmt))) + (if (string-match "[tTU]" fmt) + (let ((ff (match-string 0 fmt))) + (setq duration t numbers t + duration-output-format + (cond ((equal ff "T") nil) + ((equal ff "t") org-table-duration-custom-format) + ((equal ff "U") 'hh:mm)) + fmt (replace-match "" t t fmt)))) (if (string-match "N" fmt) (setq numbers t fmt (replace-match "" t t fmt))) @@ -2918,7 +2935,14 @@ $1-> %s\n" orig formula form0 form)) (when (consp ev) (setq fmt nil ev "#ERROR")) (org-table-justify-field-maybe (format org-table-formula-field-format - (if fmt (format fmt (string-to-number ev)) ev))) + (cond + ((not (stringp ev)) ev) + (fmt (format fmt (string-to-number ev))) + ;; Replace any active time stamp in the result with + ;; an inactive one. Dates in tables are likely + ;; piece of regular data, not meant to appear in the + ;; agenda. + (t (replace-regexp-in-string org-ts-regexp "[\\1]" ev))))) (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) (call-interactively 'org-return) (setq ndown 0))) @@ -3751,7 +3775,17 @@ minutes or seconds." (format "%.1f" (/ (float secs0) 60))) ((eq output-format 'seconds) (format "%d" secs0)) - (t (format-seconds "%.2h:%.2m:%.2s" secs0))))) + ((eq output-format 'hh:mm) + ;; Ignore seconds + (substring (format-seconds + (if org-table-duration-hour-zero-padding + "%.2h:%.2m:%.2s" "%h:%.2m:%.2s") + secs0) + 0 -3)) + (t (format-seconds + (if org-table-duration-hour-zero-padding + "%.2h:%.2m:%.2s" "%h:%.2m:%.2s") + secs0))))) (if (< secs 0) (concat "-" res) res))) (defun org-table-fedit-convert-buffer (function) @@ -4867,7 +4901,8 @@ This may be either a string or a function of two arguments: ;; Initialize communication channel in INFO. (with-temp-buffer (let ((org-inhibit-startup t)) (org-mode)) - (let ((standard-output (current-buffer))) + (let ((standard-output (current-buffer)) + (org-element-use-cache nil)) (dolist (e table) (cond ((eq e 'hline) (princ "|--\n")) ((consp e) @@ -4991,9 +5026,12 @@ information." ((plist-member params :hline) (org-table--generic-apply (plist-get params :hline) ":hline")) (backend `(org-export-with-backend ',backend row nil info))) - (let ((headerp (org-export-table-row-in-header-p row info)) - (lastp (not (org-export-get-next-element row info))) - (last-header-p (org-export-table-row-ends-header-p row info))) + (let ((headerp ,(and (or hlfmt hlstart hlend) + '(org-export-table-row-in-header-p row info))) + (last-header-p + ,(and (or hllfmt hllstart hllend) + '(org-export-table-row-ends-header-p row info))) + (lastp (not (org-export-get-next-element row info)))) (when contents ;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or ;; `:hllfmt' to CONTENTS. Otherwise, fallback on @@ -5070,25 +5108,33 @@ information." (sep (plist-get params :sep)) (hsep (plist-get params :hsep))) `(lambda (cell contents info) - (let ((headerp (org-export-table-row-in-header-p - (org-export-get-parent-element cell) info)) - (column (1+ (cdr (org-export-table-cell-address cell info))))) - ;; Make sure that contents are exported as Org data when :raw - ;; parameter is non-nil. - ,(when (and backend (plist-get params :raw)) - `(setq contents - ;; Since we don't know what are the pseudo object - ;; types defined in backend, we cannot pass them to - ;; `org-element-interpret-data'. As a consequence, - ;; they will be treated as pseudo elements, and - ;; will have newlines appended instead of spaces. - ;; Therefore, we must make sure :post-blank value - ;; is really turned into spaces. - (replace-regexp-in-string - "\n" " " - (org-trim - (org-element-interpret-data - (org-element-contents cell)))))) + ;; Make sure that contents are exported as Org data when :raw + ;; parameter is non-nil. + ,(when (and backend (plist-get params :raw)) + `(setq contents + ;; Since we don't know what are the pseudo object + ;; types defined in backend, we cannot pass them to + ;; `org-element-interpret-data'. As a consequence, + ;; they will be treated as pseudo elements, and will + ;; have newlines appended instead of spaces. + ;; Therefore, we must make sure :post-blank value is + ;; really turned into spaces. + (replace-regexp-in-string + "\n" " " + (org-trim + (org-element-interpret-data + (org-element-contents cell)))))) + + (let ((headerp ,(and (or hfmt hsep) + '(org-export-table-row-in-header-p + (org-export-get-parent-element cell) info))) + (column + ;; Call costly `org-export-table-cell-address' only if + ;; absolutely necessary, i.e., if one + ;; of :fmt :efmt :hmft has a "plist type" value. + ,(and (cl-some (lambda (v) (integerp (car-safe v))) + (list efmt hfmt fmt)) + '(1+ (cdr (org-export-table-cell-address cell info)))))) (when contents ;; Check if we can apply `:efmt' on CONTENTS. ,(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." (if (numberp org-timer-default-timer) (number-to-string org-timer-default-timer) org-timer-default-timer)) - (effort-minutes (ignore-errors (org-get-at-eol 'effort-minutes 1))) + (effort-minutes (ignore-errors (floor (org-get-at-eol 'effort-minutes 1)))) (minutes (or (and (numberp opt) (number-to-string opt)) (and (not (equal opt '(64))) 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 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.0.10")) + (let ((org-release "9.1.1")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of org-mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.0.10")) + (let ((org-git-version "release_9.1.1-37-gb1e8b5")) org-git-version)) (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.") (declare-function org-clock-update-time-maybe "org-clock" ()) (declare-function org-clocking-buffer "org-clock" ()) (declare-function org-clocktable-shift "org-clock" (dir n)) +(declare-function + org-duration-from-minutes "org-duration" (minutes &optional fmt canonical)) (declare-function org-element-at-point "org-element" ()) (declare-function org-element-cache-refresh "org-element" (pos)) (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.") (declare-function org-table-next-row "org-table" ()) (declare-function org-table-paste-rectangle "org-table" ()) (declare-function org-table-recalculate "org-table" (&optional all noalign)) +(declare-function + org-table-sort-lines "org-table" + (&optional with-case sorting-type getkey-func compare-func interactive?)) (declare-function org-table-wrap-region "org-table" (arg)) (declare-function org-tags-view "org-agenda" (&optional todo-only match)) (declare-function orgtbl-ascii-plot "org-table" (&optional ask)) @@ -177,6 +182,8 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist)) (declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?)) +(defvar ffap-url-regexp) ;Silence byte-compiler + (defsubst org-uniquify (list) "Non-destructively remove duplicate elements from LIST." (let ((res (copy-sequence list))) (delete-dups res))) @@ -265,11 +272,13 @@ requirements) is loaded." (const :tag "CSS" css) (const :tag "Ditaa" ditaa) (const :tag "Dot" dot) + (const :tag "Ebnf2ps" ebnf2ps) (const :tag "Emacs Lisp" emacs-lisp) (const :tag "Forth" forth) (const :tag "Fortran" fortran) (const :tag "Gnuplot" gnuplot) (const :tag "Haskell" haskell) + (const :tag "hledger" hledger) (const :tag "IO" io) (const :tag "J" J) (const :tag "Java" java) @@ -299,7 +308,7 @@ requirements) is loaded." (const :tag "Sql" sql) (const :tag "Sqlite" sqlite) (const :tag "Stan" stan) - (const :tag "ebnf2ps" ebnf2ps)) + (const :tag "Vala" vala)) :value-type (boolean :tag "Activate" :value t))) ;;;; Customization variables @@ -526,11 +535,12 @@ but the stars and the body are.") An archived subtree does not open during visibility cycling, and does not contribute to the agenda listings.") -(defconst org-comment-string "COMMENT" - "Entries starting with this keyword will never be exported. +(eval-and-compile + (defconst org-comment-string "COMMENT" + "Entries starting with this keyword will never be exported. \\<org-mode-map> An entry can be toggled between COMMENT and normal with -`\\[org-toggle-comment]'.") +`\\[org-toggle-comment]'.")) ;;;; LaTeX Environments and Fragments @@ -713,7 +723,6 @@ For export specific modules, see also `org-export-backends'." (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) (const :tag "C bookmark: Org links to bookmarks" org-bookmark) - (const :tag "C bullets: Add overlays to headlines stars" org-bullets) (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) (const :tag "C collector: Collect properties into tables" org-collector) @@ -1725,37 +1734,6 @@ This also applied for speedbar access." :tag "Org Table" :group 'org) -(defcustom org-enable-table-editor 'optimized - "Non-nil means lines starting with \"|\" are handled by the table editor. -When nil, such lines will be treated like ordinary lines. - -When equal to the symbol `optimized', the table editor will be optimized to -do the following: -- Automatic overwrite mode in front of whitespace in table fields. - This makes the structure of the table stay in tact as long as the edited - field does not exceed the column width. -- Minimize the number of realigns. Normally, the table is aligned each time - TAB or RET are pressed to move to another field. With optimization this - happens only if changes to a field might have changed the column width. -Optimization requires replacing the functions `self-insert-command', -`delete-char', and `backward-delete-char' in Org buffers, with a -slight (in fact: unnoticeable) speed impact for normal typing. Org is very -good at guessing when a re-align will be necessary, but you can always -force one with `\\[org-ctrl-c-ctrl-c]'. - -If you would like to use the optimized version in Org mode, but the -un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. - -This variable can be used to turn on and off the table editor during a session, -but in order to toggle optimization, a restart is required. - -See also the variable `org-table-auto-blank-field'." - :group 'org-table - :type '(choice - (const :tag "off" nil) - (const :tag "on" t) - (const :tag "on, optimized" optimized))) - (defcustom org-self-insert-cluster-for-undo nil "Non-nil means cluster self-insert commands for undo when possible. If this is set, then, like in the Emacs command loop, 20 consecutive @@ -1789,7 +1767,6 @@ The value of this is taken from the #+LINK lines.") ("http" :follow (lambda (path) (browse-url (concat "http:" path)))) ("https" :follow (lambda (path) (browse-url (concat "https:" path)))) ("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path)))) - ("message" :follow (lambda (path) (browse-url (concat "message:" path)))) ("news" :follow (lambda (path) (browse-url (concat "news:" path)))) ("shell" :follow org--open-shell-link)) "An alist of properties that defines all the links in Org mode. @@ -1830,7 +1807,9 @@ activation. The function must accept (link-start link-end path bracketp) as arguments." :group 'org-link :type '(alist :tag "Link display parameters" - :value-type plist)) + :value-type plist) + :version "26.1" + :package-version '(Org . "9.1")) (defun org-link-get-parameter (type key) "Get TYPE link property for KEY. @@ -1949,10 +1928,10 @@ in the Org buffer so that the change takes effect." (defcustom org-make-link-description-function nil "Function to use for generating link descriptions from links. -When nil, the link location will be used. This function must take -two parameters: the first one is the link, the second one is the -description generated by `org-insert-link'. The function should -return the description to use." +This function must take two parameters: the first one is the +link, the second one is the description generated by +`org-insert-link'. The function should return the description to +use." :group 'org-link :type '(choice (const nil) (function))) @@ -2074,7 +2053,7 @@ In tables, the special behavior of RET has precedence." A longer mouse click will still set point. Needs to be set before org.el is loaded." :group 'org-link-follow - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (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) into the path. In this case, you can also stop the completion after the file name, to get entries inserted as top level in the file. -When `full-file-path', include the full file path." +When `full-file-path', include the full file path. + +When `buffer-name', use the buffer name." :group 'org-refile :type '(choice (const :tag "Not" nil) (const :tag "Yes" t) (const :tag "Start with file name" file) - (const :tag "Start with full file path" full-file-path))) + (const :tag "Start with full file path" full-file-path) + (const :tag "Start with buffer name" buffer-name))) (defcustom org-outline-path-complete-in-steps t "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." (concat "[" (substring f 1 -1) "]") f))) -(defcustom org-time-clocksum-format - '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t) - "The format string used when creating CLOCKSUM lines. -This is also used when Org mode generates a time duration. - -The value can be a single format string containing two -%-sequences, which will be filled with the number of hours and -minutes in that order. - -Alternatively, the value can be a plist associating any of the -keys :years, :months, :weeks, :days, :hours or :minutes with -format strings. The time duration is formatted using only the -time components that are needed and concatenating the results. -If a time unit in absent, it falls back to the next smallest -unit. - -The keys :require-years, :require-months, :require-days, -:require-weeks, :require-hours, :require-minutes are also -meaningful. A non-nil value for these keys indicates that the -corresponding time component should always be included, even if -its value is 0. - - -For example, - - (:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\" - :require-minutes t) - -means durations longer than a day will be expressed in days, -hours and minutes, and durations less than a day will always be -expressed in hours and minutes (even for durations less than an -hour). - -The value - - (:days \"%dd\" :minutes \"%dm\") - -means durations longer than a day will be expressed in days and -minutes, and durations less than a day will be expressed entirely -in minutes (even for durations longer than an hour)." - :group 'org-time - :group 'org-clock - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice (string :tag "Format string") - (set :tag "Plist" - (group :inline t (const :tag "Years" :years) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show years" :require-years) - (const t)) - (group :inline t (const :tag "Months" :months) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show months" :require-months) - (const t)) - (group :inline t (const :tag "Weeks" :weeks) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show weeks" :require-weeks) - (const t)) - (group :inline t (const :tag "Days" :days) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show days" :require-days) - (const t)) - (group :inline t (const :tag "Hours" :hours) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show hours" :require-hours) - (const t)) - (group :inline t (const :tag "Minutes" :minutes) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show minutes" :require-minutes) - (const t))))) - -(defcustom org-time-clocksum-use-fractional nil - "When non-nil, `\\[org-clock-display]' uses fractional times. -See `org-time-clocksum-format' for more on time clock formats." - :group 'org-time - :group 'org-clock - :version "24.3" - :type 'boolean) - -(defcustom org-time-clocksum-use-effort-durations nil - "When non-nil, `\\[org-clock-display]' uses effort durations. -E.g. by default, one day is considered to be a 8 hours effort, -so a task that has been clocked for 16 hours will be displayed -as during 2 days in the clock display or in the clocktable. - -See `org-effort-durations' on how to set effort durations -and `org-time-clocksum-format' for more on time clock formats." - :group 'org-time - :group 'org-clock - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-time-clocksum-fractional-format "%.2f" - "The format string used when creating CLOCKSUM lines, -or when Org mode generates a time duration, if -`org-time-clocksum-use-fractional' is enabled. - -The value can be a single format string containing one -%-sequence, which will be filled with the number of hours as -a float. - -Alternatively, the value can be a plist associating any of the -keys :years, :months, :weeks, :days, :hours or :minutes with -a format string. The time duration is formatted using the -largest time unit which gives a non-zero integer part. If all -specified formats have zero integer part, the smallest time unit -is used." - :group 'org-time - :type '(choice (string :tag "Format string") - (set (group :inline t (const :tag "Years" :years) - (string :tag "Format string")) - (group :inline t (const :tag "Months" :months) - (string :tag "Format string")) - (group :inline t (const :tag "Weeks" :weeks) - (string :tag "Format string")) - (group :inline t (const :tag "Days" :days) - (string :tag "Format string")) - (group :inline t (const :tag "Hours" :hours) - (string :tag "Format string")) - (group :inline t (const :tag "Minutes" :minutes) - (string :tag "Format string"))))) - (defcustom org-deadline-warning-days 14 "Number of days before expiration during which a deadline becomes active. This variable governs the display in sparse trees and in the agenda. @@ -3795,7 +3648,7 @@ and the clock summary: ((\"Remaining\" (lambda(value) (let ((clocksum (org-clock-sum-current-item)) - (effort (org-duration-string-to-minutes + (effort (org-duration-to-minutes (org-entry-get (point) \"Effort\")))) (org-minutes-to-clocksum-string (- effort clocksum))))))" :group 'org-properties @@ -4470,8 +4323,10 @@ After a match, the match groups contain these elements: 3 The leading marker like * or /, indicating the type of highlighting 4 The text between the emphasis markers, not including the markers 5 The character after the match, empty at the end of a line") + (defvar org-verbatim-re nil "Regular expression for matching verbatim text.") + (defvar org-emphasis-regexp-components) ; defined just below (defvar org-emphasis-alist) ; defined just below (defun org-set-emph-re (var val) @@ -4480,60 +4335,23 @@ After a match, the match groups contain these elements: (when (and (boundp 'org-emphasis-alist) (boundp 'org-emphasis-regexp-components) org-emphasis-alist org-emphasis-regexp-components) - (let* ((e org-emphasis-regexp-components) - (pre (car e)) - (post (nth 1 e)) - (border (nth 2 e)) - (body (nth 3 e)) - (nl (nth 4 e)) - (body1 (concat body "*?")) - (markers (mapconcat 'car org-emphasis-alist "")) - (vmarkers (mapconcat - (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) "")) - org-emphasis-alist ""))) - ;; make sure special characters appear at the right position in the class - (if (string-match "\\^" markers) - (setq markers (concat (replace-match "" t t markers) "^"))) - (if (string-match "-" markers) - (setq markers (concat (replace-match "" t t markers) "-"))) - (if (string-match "\\^" vmarkers) - (setq vmarkers (concat (replace-match "" t t vmarkers) "^"))) - (if (string-match "-" vmarkers) - (setq vmarkers (concat (replace-match "" t t vmarkers) "-"))) - (if (> nl 0) - (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," - (int-to-string nl) "\\}"))) - ;; Make the regexp - (setq org-emph-re - (concat "\\([" pre "]\\|^\\)" - "\\(" - "\\([" markers "]\\)" - "\\(" - "[^" border "]\\|" - "[^" border "]" - body1 - "[^" border "]" - "\\)" - "\\3\\)" - "\\([" post "]\\|$\\)")) - (setq org-verbatim-re - (concat "\\([" pre "]\\|^\\)" - "\\(" - "\\([" vmarkers "]\\)" - "\\(" - "[^" border "]\\|" - "[^" border "]" - body1 - "[^" border "]" - "\\)" - "\\3\\)" - "\\([" post "]\\|$\\)"))))) + (pcase-let* + ((`(,pre ,post ,border ,body ,nl) org-emphasis-regexp-components) + (body (if (<= nl 0) body + (format "%s*?\\(?:\n%s*?\\)\\{0,%d\\}" body body nl))) + (template + (format (concat "\\([%s]\\|^\\)" ;before markers + "\\(\\([%%s]\\)\\([^%s]\\|[^%s]%s[^%s]\\)\\3\\)" + "\\([%s]\\|$\\)") ;after markers + pre border border body border post))) + (setq org-emph-re (format template "*/_+")) + (setq org-verbatim-re (format template "=~"))))) ;; This used to be a defcustom (Org <8.0) but allowing the users to ;; set this option proved cumbersome. See this message/thread: ;; http://article.gmane.org/gmane.emacs.orgmode/68681 (defvar org-emphasis-regexp-components - '(" \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1) + '("- \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1) "Components used to build the regular expression for emphasis. This is a list with five entries. Terminology: In an emphasis string like \" *strong word* \", we call the initial space PREMATCH, the final @@ -4647,32 +4465,24 @@ This is needed for font-lock setup.") (defun org-at-table-p (&optional table-type) "Non-nil if the cursor is inside an Org table. -If TABLE-TYPE is non-nil, also check for table.el-type tables. -If `org-enable-table-editor' is nil, return nil unconditionally." - (and - org-enable-table-editor - (save-excursion - (beginning-of-line) - (looking-at-p (if table-type "[ \t]*[|+]" "[ \t]*|"))) - (or (not (derived-mode-p 'org-mode)) - (let ((e (org-element-lineage (org-element-at-point) '(table) t))) - (and e (or table-type (eq (org-element-property :type e) 'org))))))) +If TABLE-TYPE is non-nil, also check for table.el-type tables." + (and (org-match-line (if table-type "[ \t]*[|+]" "[ \t]*|")) + (or (not (derived-mode-p 'org-mode)) + (let ((e (org-element-lineage (org-element-at-point) '(table) t))) + (and e (or table-type + (eq 'org (org-element-property :type e)))))))) (defun org-at-table.el-p () "Non-nil when point is at a table.el table." - (and (save-excursion (beginning-of-line) (looking-at "[ \t]*[|+]")) + (and (org-match-line "[ \t]*[|+]") (let ((element (org-element-at-point))) (and (eq (org-element-type element) 'table) (eq (org-element-property :type element) 'table.el))))) (defun org-at-table-hline-p () "Non-nil when point is inside a hline in a table. -Assume point is already in a table. If `org-enable-table-editor' -is nil, return nil unconditionally." - (and org-enable-table-editor - (save-excursion - (beginning-of-line) - (looking-at org-table-hline-regexp)))) +Assume point is already in a table." + (org-match-line org-table-hline-regexp)) (defun org-table-map-tables (function &optional quietly) "Apply FUNCTION to the start of all tables in the buffer." @@ -5275,7 +5085,7 @@ Return value contains the following keys: `archive', `category', ((equal key "CONSTANTS") (let* ((constants (assq 'constants alist)) (store (cdr constants))) - (dolist (pair (org-split-string value)) + (dolist (pair (split-string value)) (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" pair) (let* ((name (match-string 1 pair)) @@ -5290,7 +5100,7 @@ Return value contains the following keys: `archive', `category', (let ((old (assq 'filetags alist)) (new (apply #'nconc (mapcar (lambda (x) (org-split-string x ":")) - (org-split-string value))))) + (split-string value))))) (if old (setcdr old (append new (cdr old))) (push (cons 'filetags new) alist))))) ((equal key "LINK") @@ -5306,7 +5116,7 @@ Return value contains the following keys: `archive', `category', (push (cons 'scripts (read (match-string 1 value))) alist))) ((equal key "PRIORITIES") (push (cons 'priorities - (let ((prio (org-split-string value))) + (let ((prio (split-string value))) (if (< (length prio) 3) '(?A ?C ?B) (mapcar #'string-to-char prio)))) alist)) @@ -5323,8 +5133,8 @@ Return value contains the following keys: `archive', `category', (let ((startup (assq 'startup alist))) (if startup (setcdr startup - (append (cdr startup) (org-split-string value))) - (push (cons 'startup (org-split-string value)) alist)))) + (append (cdr startup) (split-string value))) + (push (cons 'startup (split-string value)) alist)))) ((equal key "TAGS") (let ((tag-cell (assq 'tags alist))) (if tag-cell @@ -5333,7 +5143,7 @@ Return value contains the following keys: `archive', `category', ((member key '("TODO" "SEQ_TODO" "TYP_TODO")) (let ((todo (assq 'todo alist)) (value (cons (if (equal key "TYP_TODO") 'type 'sequence) - (org-split-string value)))) + (split-string value)))) (if todo (push value (cdr todo)) (push (list 'todo value) alist)))) ((equal key "SETUPFILE") @@ -5441,17 +5251,62 @@ a string, summarizing TAGS, as a list of strings." (setq current-group (list tag)))) (_ nil))))) -(defun org-file-contents (file &optional noerror) - "Return the contents of FILE, as a string." - (if (and file (file-readable-p file)) +(defvar org--file-cache (make-hash-table :test #'equal) + "Hash table to store contents of files referenced via a URL. +This is the cache of file URLs read using `org-file-contents'.") + +(defun org-reset-file-cache () + "Reset the cache of files downloaded by `org-file-contents'." + (clrhash org--file-cache)) + +(defun org-file-url-p (file) + "Non-nil if FILE is a URL." + (require 'ffap) + (string-match-p ffap-url-regexp file)) + +(defun org-file-contents (file &optional noerror nocache) + "Return the contents of FILE, as a string. + +FILE can be a file name or URL. + +If FILE is a URL, download the contents. If the URL contents are +already cached in the `org--file-cache' hash table, the download step +is skipped. + +If NOERROR is non-nil, ignore the error when unable to read the FILE +from file or URL. + +If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version +is available. This option applies only if FILE is a URL." + (let* ((is-url (org-file-url-p file)) + (cache (and is-url + (not nocache) + (gethash file org--file-cache)))) + (cond + (cache) + (is-url + (with-current-buffer (url-retrieve-synchronously file) + (goto-char (point-min)) + ;; Move point to after the url-retrieve header. + (search-forward "\n\n" nil :move) + ;; Search for the success code only in the url-retrieve header. + (if (save-excursion (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror)) + ;; Update the cache `org--file-cache' and return contents. + (puthash file + (buffer-substring-no-properties (point) (point-max)) + org--file-cache) + (funcall (if noerror #'message #'user-error) + "Unable to fetch file from %S" + file)))) + (t (with-temp-buffer - (insert-file-contents file) - (buffer-string)) - (funcall (if noerror 'message 'error) - "Cannot read file \"%s\"%s" - file - (let ((from (buffer-file-name (buffer-base-buffer)))) - (if from (concat " (referenced in file \"" from "\")") ""))))) + (condition-case err + (progn + (insert-file-contents file) + (buffer-string)) + (file-error + (funcall (if noerror #'message #'user-error) + (error-message-string err))))))))) (defun org-extract-log-state-settings (x) "Extract the log state setting from a TODO keyword string. @@ -5697,10 +5552,13 @@ The following commands are available: ;; Update `customize-package-emacs-version-alist' (add-to-list 'customize-package-emacs-version-alist - '(Org ("6.21b" . "23.1") ("6.33x" . "23.2") - ("7.8.11" . "24.1") ("7.9.4" . "24.3") - ("8.2.6" . "24.4") ("8.2.10" . "24.5") - ("9.0" . "26.1"))) + '(Org ("8.0" . "24.4") + ("8.1" . "24.4") + ("8.2" . "24.4") + ("8.2.7" . "24.4") + ("8.3" . "26.1") + ("9.0" . "26.1") + ("9.1" . "26.1"))) (defvar org-mode-transpose-word-syntax-table (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." (defun org-do-emphasis-faces (limit) "Run through the buffer and emphasize strings." - (let (rtn a) - (while (and (not rtn) (re-search-forward org-emph-re limit t)) - (let* ((border (char-after (match-beginning 3))) - (bre (regexp-quote (char-to-string border)))) - (when (and (not (= border (char-after (match-beginning 4)))) - (not (string-match-p (concat bre ".*" bre) - (replace-regexp-in-string - "\n" " " - (substring (match-string 2) 1 -1))))) - (setq rtn t) - (setq a (assoc (match-string 3) org-emphasis-alist)) - (font-lock-prepend-text-property (match-beginning 2) (match-end 2) - 'face - (nth 1 a)) - (and (nth 2 a) - (org-remove-flyspell-overlays-in - (match-beginning 0) (match-end 0))) - (add-text-properties (match-beginning 2) (match-end 2) - '(font-lock-multiline t org-emphasis t)) - (when org-hide-emphasis-markers - (add-text-properties (match-end 4) (match-beginning 5) - '(invisible org-link)) - (add-text-properties (match-beginning 3) (match-end 3) - '(invisible org-link))))) - (goto-char (1+ (match-beginning 0)))) - rtn)) + (let ((quick-re (format "\\([%s]\\|^\\)\\([~=*/_+]\\)" + (car org-emphasis-regexp-components)))) + (catch :exit + (while (re-search-forward quick-re limit t) + (let* ((marker (match-string 2)) + (verbatim? (member marker '("~" "=")))) + (when (save-excursion + (goto-char (match-beginning 0)) + ;; Do not match headline stars. Do not consider + ;; stars of a headline as closing marker for bold + ;; markup either. Do not match table hlines. + (and + (not (looking-at-p org-outline-regexp-bol)) + (not (and (equal marker "+") + (org-match-line + "^[ \t]*\\(|[-+]+|?\\|\\+[-+]+\\+\\)[ \t]*$"))) + (looking-at (if verbatim? org-verbatim-re org-emph-re)) + (not (string-match-p + (concat org-outline-regexp-bol "\\'") + (match-string 0))))) + (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist))) + (font-lock-prepend-text-property + (match-beginning 2) (match-end 2) 'face face) + (when verbatim? + (org-remove-flyspell-overlays-in + (match-beginning 0) (match-end 0))) + (add-text-properties (match-beginning 2) (match-end 2) + '(font-lock-multiline t org-emphasis t)) + (when org-hide-emphasis-markers + (add-text-properties (match-end 4) (match-beginning 5) + '(invisible org-link)) + (add-text-properties (match-beginning 3) (match-end 3) + '(invisible org-link))) + (throw :exit t)))))))) (defun org-emphasize (&optional char) "Insert or change an emphasis, i.e. a font like bold or italic. @@ -6040,7 +5906,7 @@ This includes angle, plain, and bracket links." "When non-nil, fontify code in code blocks. See also the `org-block' face." :type 'boolean - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :group 'org-appearance :group 'org-babel) @@ -6752,17 +6618,13 @@ and subscripts." (nth (if table-p 3 1) org-script-display) (nth (if table-p 2 0) org-script-display))) (add-text-properties (match-beginning 2) (match-end 2) - (list 'invisible t - 'org-dwidth t 'org-dwidth-n 1)) - (if (and (eq (char-after (match-beginning 3)) ?{) - (eq (char-before (match-end 3)) ?})) - (progn - (add-text-properties - (match-beginning 3) (1+ (match-beginning 3)) - (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)) - (add-text-properties - (1- (match-end 3)) (match-end 3) - (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))))) + (list 'invisible t)) + (when (and (eq (char-after (match-beginning 3)) ?{) + (eq (char-before (match-end 3)) ?})) + (add-text-properties (match-beginning 3) (1+ (match-beginning 3)) + (list 'invisible t)) + (add-text-properties (1- (match-end 3)) (match-end 3) + (list 'invisible t)))) t))) ;;;; Visibility cycling, including org-goto and indirect buffer @@ -7837,15 +7699,38 @@ When NEXT is non-nil, check the next line instead." When NEXT is non-nil, check the next line instead." (org--line-empty-p 2)) +(defun org--blank-before-heading-p (&optional parent) + "Non-nil when an empty line should precede a new heading here. +When optional argument PARENT is non-nil, consider parent +headline instead of current one." + (pcase (assq 'heading org-blank-before-new-entry) + (`(heading . auto) + (save-excursion + (org-with-limited-levels + (unless (and (org-before-first-heading-p) + (not (outline-next-heading))) + (org-back-to-heading t) + (when parent (org-up-heading-safe)) + (cond ((not (bobp)) + (org-previous-line-empty-p)) + ((outline-next-heading) + (org-previous-line-empty-p)) + ;; Ignore trailing spaces on last buffer line. + ((progn (skip-chars-backward " \t") (bolp)) + (org-previous-line-empty-p)) + (t nil)))))) + (`(heading . ,value) value) + (_ nil))) + (defun org-insert-heading (&optional arg invisible-ok top) "Insert a new heading or an item with the same depth at point. -If point is at the beginning of a heading or a list item, insert -a new heading or a new item above the current one. When at the -beginning of a regular line of text, turn it into a heading. +If point is at the beginning of a heading, insert a new heading +or a new headline above the current one. When at the beginning +of a regular line of text, turn it into a heading. If point is in the middle of a line, split it and create a new -headline/item with the text in the current line after point (see +headline with the text in the current line after point (see `org-M-RET-may-split-line' on how to modify this behavior). As a special case, on a headline, splitting can only happen on the title itself. E.g., this excludes breaking stars or tags. @@ -7869,186 +7754,107 @@ command. When optional argument TOP is non-nil, insert a level 1 heading, unconditionally." (interactive "P") - (let ((itemp (and (not top) (org-in-item-p))) - (may-split (org-get-alist-option org-M-RET-may-split-line 'headline)) - (respect-content (or org-insert-heading-respect-content - (equal arg '(4)))) - (initial-content "")) - + (let* ((blank? (org--blank-before-heading-p (equal arg '(16)))) + (level (org-current-level)) + (stars (make-string (if (and level (not top)) level 1) ?*))) (cond - - ((or (= (buffer-size) 0) - (and (not (save-excursion - (and (ignore-errors (org-back-to-heading invisible-ok)) - (org-at-heading-p)))) - (or arg (not itemp)))) - ;; At beginning of buffer or so high up that only a heading - ;; makes sense. - (cond ((and (bolp) (not respect-content)) (insert "* ")) - ((not respect-content) - (unless may-split (end-of-line)) - (insert "\n* ")) - ((re-search-forward org-outline-regexp-bol nil t) - (beginning-of-line) - (insert "* \n") - (backward-char)) - (t (goto-char (point-max)) - (insert "\n* "))) - (run-hooks 'org-insert-heading-hook)) - - ((and itemp (not (member arg '((4) (16)))) (org-insert-item))) - + ((or org-insert-heading-respect-content + (member arg '((4) (16))) + (and (not invisible-ok) + (invisible-p (max (1- (point)) (point-min))))) + ;; Position point at the location of insertion. + (if (not level) ;before first headline + (org-with-limited-levels (outline-next-heading)) + ;; Make sure we end up on a visible headline if INVISIBLE-OK + ;; is nil. + (org-with-limited-levels (org-back-to-heading invisible-ok)) + (cond ((equal arg '(16)) + (org-up-heading-safe) + (org-end-of-subtree t t)) + (t + (org-end-of-subtree t t)))) + (unless (bolp) (insert "\n")) ;ensure final newline + (unless (and blank? (org-previous-line-empty-p)) + (org-N-empty-lines-before-current (if blank? 1 0))) + (insert stars " \n") + (forward-char -1)) + ;; At a headline... + ((org-at-heading-p) + (cond ((bolp) + (when blank? (save-excursion (insert "\n"))) + (save-excursion (insert stars " \n")) + (unless (and blank? (org-previous-line-empty-p)) + (org-N-empty-lines-before-current (if blank? 1 0))) + (end-of-line)) + ((and (org-get-alist-option org-M-RET-may-split-line 'headline) + (org-match-line org-complex-heading-regexp) + (org-pos-in-match-range (point) 4)) + ;; Grab the text that should moved to the new headline. + ;; Preserve tags. + (let ((split (delete-and-extract-region (point) (match-end 4)))) + (if (looking-at "[ \t]*$") (replace-match "") + (org-set-tags nil t)) + (end-of-line) + (when blank? (insert "\n")) + (insert "\n" stars " ") + (when (org-string-nw-p split) (insert split)) + (when (eobp) (save-excursion (insert "\n"))))) + (t + (end-of-line) + (when blank? (insert "\n")) + (insert "\n" stars " ") + (when (eobp) (save-excursion (insert "\n")))))) + ;; On regular text, turn line into a headline or split, if + ;; appropriate. + ((bolp) + (insert stars " ") + (unless (and blank? (org-previous-line-empty-p)) + (org-N-empty-lines-before-current (if blank? 1 0)))) (t - ;; Maybe move at the end of the subtree - (when (equal arg '(16)) - (org-up-heading-safe) - (org-end-of-subtree t)) - ;; Insert a heading - (save-restriction - (widen) - (let* ((level nil) - (on-heading (org-at-heading-p)) - (empty-line-p (if on-heading - (org-previous-line-empty-p) - ;; We will decide later - nil)) - ;; Get a level string to fall back on. - (fix-level - (if (org-before-first-heading-p) "*" - (save-excursion - (org-back-to-heading t) - (when (org-previous-line-empty-p) (setq empty-line-p t)) - (looking-at org-outline-regexp) - (make-string (1- (length (match-string 0))) ?*)))) - (stars - (save-excursion - (condition-case nil - (if top "* " - (org-back-to-heading invisible-ok) - (when (and (not on-heading) - (featurep 'org-inlinetask) - (integerp org-inlinetask-min-level) - (>= (length (match-string 0)) - org-inlinetask-min-level)) - ;; Find a heading level before the inline - ;; task. - (while (and (setq level (org-up-heading-safe)) - (>= level org-inlinetask-min-level))) - (if (org-at-heading-p) - (org-back-to-heading invisible-ok) - (error "This should not happen"))) - (unless (and (save-excursion - (save-match-data - (org-backward-heading-same-level - 1 invisible-ok)) - (= (point) (match-beginning 0))) - (not (org-next-line-empty-p))) - (setq empty-line-p (or empty-line-p - (org-previous-line-empty-p)))) - (match-string 0)) - (error (or fix-level "* "))))) - (blank-a (cdr (assq 'heading org-blank-before-new-entry))) - (blank (if (eq blank-a 'auto) empty-line-p blank-a))) - - ;; If we insert after content, move there and clean up - ;; whitespace. - (when respect-content - (if (not (org-before-first-heading-p)) - (org-end-of-subtree nil t) - (re-search-forward org-outline-regexp-bol) - (beginning-of-line 0)) - (skip-chars-backward " \r\t\n") - (and (not (looking-back "^\\*+" (line-beginning-position))) - (looking-at "[ \t]+") (replace-match "")) - (unless (eobp) (forward-char 1)) - (when (looking-at "^\\*") - (unless (bobp) (backward-char 1)) - (insert "\n"))) - - ;; If we are splitting, grab the text that should be moved - ;; to the new headline. - (when may-split - (if (org-at-heading-p) - ;; This is a heading: split intelligently (keeping - ;; tags). - (let ((pos (point))) - (beginning-of-line) - (let ((case-fold-search nil)) - (unless (looking-at org-complex-heading-regexp) - (error "This should not happen"))) - (when (and (match-beginning 4) - (> pos (match-beginning 4)) - (< pos (match-end 4))) - (setq initial-content (buffer-substring pos (match-end 4))) - (goto-char pos) - (delete-region (point) (match-end 4)) - (if (looking-at "[ \t]*$") - (replace-match "") - (insert (make-string (length initial-content) ?\s))) - (setq initial-content (org-trim initial-content))) - (goto-char pos)) - ;; A normal line. - (setq initial-content - (org-trim - (delete-and-extract-region (point) (line-end-position)))))) - - ;; If we are at the beginning of the line, insert before it. - ;; Otherwise, after it. - (cond - ((and (bolp) (looking-at "[ \t]*$"))) - ((bolp) (save-excursion (insert "\n"))) - (t (end-of-line) - (insert "\n"))) - - ;; Insert the new heading - (insert stars) - (just-one-space) - (insert initial-content) - (unless (and blank (org-previous-line-empty-p)) - (org-N-empty-lines-before-current (if blank 1 0))) - ;; Adjust visibility, which may be messed up if we removed - ;; blank lines while previous entry was hidden. - (let ((bol (line-beginning-position))) - (dolist (o (overlays-at (1- bol))) - (when (and (eq (overlay-get o 'invisible) 'outline) - (eq (overlay-end o) bol)) - (move-overlay o (overlay-start o) (1- bol))))) - (run-hooks 'org-insert-heading-hook))))))) - -(defun org-N-empty-lines-before-current (N) + (unless (org-get-alist-option org-M-RET-may-split-line 'headline) + (end-of-line)) + (insert "\n" stars " ") + (unless (and blank? (org-previous-line-empty-p)) + (org-N-empty-lines-before-current (if blank? 1 0)))))) + (run-hooks 'org-insert-heading-hook)) + +(defun org-N-empty-lines-before-current (n) "Make the number of empty lines before current exactly N. So this will delete or add empty lines." - (save-excursion + (let ((column (current-column))) (beginning-of-line) - (let ((p (point))) - (skip-chars-backward " \r\t\n") - (unless (bolp) (forward-line)) - (delete-region (point) p)) - (when (> N 0) (insert (make-string N ?\n))))) - -(defun org-get-heading (&optional no-tags no-todo) + (unless (bobp) + (let ((start (save-excursion + (skip-chars-backward " \r\t\n") + (line-end-position)))) + (delete-region start (line-end-position 0)))) + (insert (make-string n ?\n)) + (move-to-column column))) + +(defun org-get-heading (&optional no-tags no-todo no-priority no-comment) "Return the heading of the current entry, without the stars. When NO-TAGS is non-nil, don't include tags. -When NO-TODO is non-nil, don't include TODO keywords." +When NO-TODO is non-nil, don't include TODO keywords. +When NO-PRIORITY is non-nil, don't include priority cookie. +When NO-COMMENT is non-nil, don't include COMMENT string." (save-excursion (org-back-to-heading t) (let ((case-fold-search nil)) - (cond - ((and no-tags no-todo) - (looking-at org-complex-heading-regexp) - ;; Return value has to be a string, but match group 4 is - ;; optional. - (or (match-string 4) "")) - (no-tags - (looking-at (concat org-outline-regexp - "\\(.*?\\)" - "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$")) - (match-string 1)) - (no-todo - (looking-at org-todo-line-regexp) - (match-string 3)) - (t (looking-at org-heading-regexp) - (match-string 2)))))) + (looking-at org-complex-heading-regexp) + (let ((todo (and (not no-todo) (match-string 2))) + (priority (and (not no-priority) (match-string 3))) + (headline (pcase (match-string 4) + (`nil "") + ((and (guard no-comment) h) + (replace-regexp-in-string + (eval-when-compile + (format "\\`%s[ \t]+" org-comment-string)) + "" h)) + (h h))) + (tags (and (not no-tags) (match-string 5)))) + (mapconcat #'identity + (delq nil (list todo priority headline tags)) + " "))))) (defvar orgstruct-mode) ; defined below @@ -8273,13 +8079,14 @@ time to headlines when structure editing, based on the value of (if org-odd-levels-only 2 1)) (defun org-get-valid-level (level &optional change) - "Rectify a level change under the influence of `org-odd-levels-only' -LEVEL is a current level, CHANGE is by how much the level should be -modified. Even if CHANGE is nil, LEVEL may be returned modified because -even level numbers will become the next higher odd number." + "Rectify a level change under the influence of `org-odd-levels-only'. +LEVEL is a current level, CHANGE is by how much the level should +be modified. Even if CHANGE is nil, LEVEL may be returned +modified because even level numbers will become the next higher +odd number. Returns values greater than 0." (if org-odd-levels-only (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) - ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) + ((> change 0) (1+ (* 2 (/ (+ (1- level) (* 2 change)) 2)))) ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) (max 1 (+ level (or change 0))))) @@ -8976,29 +8783,25 @@ with the original repeater." ;;; Outline Sorting -(defun org-sort (with-case) +(defun org-sort (&optional with-case) "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'. Optional argument WITH-CASE means sort case-sensitively." (interactive "P") - (cond - ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case)) - ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case)) - (t - (org-call-with-arg 'org-sort-entries with-case)))) + (org-call-with-arg + (cond ((org-at-table-p) #'org-table-sort-lines) + ((org-at-item-p) #'org-sort-list) + (t #'org-sort-entries)) + with-case)) (defun org-sort-remove-invisible (s) - "Remove invisible links from string S." + "Remove invisible part of links and emphasis markers from string S." (remove-text-properties 0 (length s) org-rm-props s) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (if (match-end 2) - (match-string 3 s) - (match-string 1 s)) - t t s))) - (let ((st (format " %s " s))) - (while (string-match org-emph-re st) - (setq st (replace-match (format " %s " (match-string 4 st)) t t st))) - (setq s (substring st 1 -1))) - s) + (replace-regexp-in-string + org-verbatim-re (lambda (m) (format "%s " (match-string 4 m))) + (replace-regexp-in-string + org-emph-re (lambda (m) (format " %s " (match-string 4 m))) + (org-link-display-format s) + t t) t t)) (defvar org-priority-regexp) ; defined later in the file @@ -9141,7 +8944,7 @@ function is being called interactively." ;; The clock marker is lost when using `sort-subr'; mark ;; the clock with temporary `:org-clock-marker-backup' ;; text property. - (when (and (eq (org-clocking-buffer) (current-buffer)) + (when (and (eq (org-clock-is-active) (current-buffer)) (<= start (marker-position org-clock-marker)) (>= end (marker-position org-clock-marker))) (org-with-silent-modifications @@ -9265,7 +9068,7 @@ function is being called interactively." "Regexp that matches the custom prefix of Org headlines in orgstruct(++)-mode." :group 'org - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type 'regexp) ;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) @@ -9730,7 +9533,7 @@ sub-tree if optional argument INHERIT is non-nil." (org-refresh-properties org-effort-property '((effort . identity) - (effort-minutes . org-duration-string-to-minutes)))) + (effort-minutes . org-duration-to-minutes)))) ;;;; Link Stuff @@ -10113,7 +9916,7 @@ according to FMT (default from `org-email-link-description-format')." (org-back-to-heading t) (org-element-property :raw-value (org-element-at-point)))))) (lines org-context-in-file-links)) - (or string (setq s (concat "*" s))) ; Add * for headlines + (unless string (setq s (concat "*" s))) ;Add * for headlines (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) (when (and string (integerp lines) (> lines 0)) (let ((slines (org-split-string s "\n"))) @@ -10122,7 +9925,7 @@ according to FMT (default from `org-email-link-description-format')." 'identity (reverse (nthcdr (- (length slines) lines) (reverse slines))) "\n"))))) - (mapconcat 'identity (org-split-string s "[ \t]+") " "))) + (mapconcat #'identity (split-string s) " "))) (defun org-make-link-string (link &optional description) "Make a link with brackets, consisting of LINK and DESCRIPTION." @@ -10343,15 +10146,14 @@ the current directory or below. A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ prefix negates `org-keep-stored-link-after-insertion'. -If `org-make-link-description-function' is non-nil, this function will be -called with the link target, and the result will be the default -link description. - If the LINK-LOCATION parameter is non-nil, this value will be used as the link location instead of reading one interactively. -If the DEFAULT-DESCRIPTION parameter is non-nil, this value will be used -as the default description." +If the DEFAULT-DESCRIPTION parameter is non-nil, this value will +be used as the default description. Otherwise, if +`org-make-link-description-function' is non-nil, this function +will be called with the link target, and the result will be the +default link description." (interactive "P") (let* ((wcf (current-window-configuration)) (origbuf (current-buffer)) @@ -10485,17 +10287,19 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (when (equal desc origpath) (setq desc path))))) - (if org-make-link-description-function - (setq desc - (or (condition-case nil - (funcall org-make-link-description-function link desc) - (error (progn (message "Can't get link description from `%s'" - (symbol-name org-make-link-description-function)) - (sit-for 2) nil))) - (read-string "Description: " default-description))) - (if default-description (setq desc default-description) - (setq desc (or (and auto-desc desc) - (read-string "Description: " desc))))) + (unless auto-desc + (let ((initial-input + (cond + (default-description) + ((not org-make-link-description-function) desc) + (t (condition-case nil + (funcall org-make-link-description-function link desc) + (error + (message "Can't get link description from `%s'" + (symbol-name org-make-link-description-function)) + (sit-for 2) + nil)))))) + (setq desc (read-string "Description: " initial-input)))) (unless (string-match "\\S-" desc) (setq desc nil)) (when remove (apply 'delete-region remove)) @@ -10831,13 +10635,8 @@ a timestamp or a link." (user-error "No link found")) ((eq type 'timestamp) (org-follow-timestamp-link)) ((eq type 'link) - ;; When link is located within the description of another - ;; link (e.g., an inline image), always open the parent - ;; link. - (let* ((link (let ((up (org-element-property :parent context))) - (if (eq (org-element-type up) 'link) up context))) - (type (org-element-property :type link)) - (path (org-link-unescape (org-element-property :path link)))) + (let ((type (org-element-property :type context)) + (path (org-link-unescape (org-element-property :path context)))) ;; Switch back to REFERENCE-BUFFER needed when called in ;; a temporary buffer through `org-open-link-from-string'. (with-current-buffer (or reference-buffer (current-buffer)) @@ -10852,8 +10651,8 @@ a timestamp or a link." ;; ("open" function called with a single argument). ;; If no such function is found, fallback to ;; `org-open-file'. - (let* ((option (org-element-property :search-option link)) - (app (org-element-property :application link)) + (let* ((option (org-element-property :search-option context)) + (app (org-element-property :application context)) (dedicated-function (org-link-get-parameter (if app (concat type "+" app) type) @@ -10884,15 +10683,15 @@ a timestamp or a link." (org-with-wide-buffer (if (equal type "radio") (org-search-radio-target - (org-element-property :path link)) + (org-element-property :path context)) (org-link-search (if (member type '("custom-id" "coderef")) - (org-element-property :raw-link link) + (org-element-property :raw-link context) path) ;; Prevent fuzzy links from matching ;; themselves. (and (equal type "fuzzy") - (+ 2 (org-element-property :begin link))))) + (+ 2 (org-element-property :begin context))))) (point)))) (unless (and (<= (point-min) destination) (>= (point-max) destination)) @@ -11019,7 +10818,7 @@ the window configuration before `org-open-at-point' was called using: White spaces are not significant." (let ((re (format "<<<%s>>>" (mapconcat #'regexp-quote - (org-split-string target "[ \t\n]+") + (split-string target) "[ \t]+\\(?:\n[ \t]*\\)?"))) (origin (point))) (goto-char (point-min)) @@ -11143,7 +10942,8 @@ of matched result, which is either `dedicated' or `fuzzy'." org-comment-string (mapconcat #'regexp-quote words ".+"))) (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]") - (comment-re (format "\\`%s[ \t]+" org-comment-string))) + (comment-re (eval-when-compile + (format "\\`%s[ \t]+" org-comment-string)))) (goto-char (point-min)) (catch :found (while (re-search-forward title-re nil t) @@ -11152,7 +10952,7 @@ of matched result, which is either `dedicated' or `fuzzy'." (replace-regexp-in-string cookie-re "" (replace-regexp-in-string - comment-re "" (org-get-heading t t))))) + comment-re "" (org-get-heading t t t))))) (throw :found t))) nil))) (beginning-of-line) @@ -11303,7 +11103,7 @@ or to another Org file, automatically push the old position onto the ring." (format "*Org Agenda(a:%s)" (concat (substring t1 0 10) "--" (substring t2 0 10))))) (org-agenda-list nil tt1 (1+ (- tt2 tt1)))))) - ((org-at-timestamp-p t) + ((org-at-timestamp-p 'lax) (let ((org-agenda-buffer-tmp-name (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10)))) (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." (search (concat file "::" search)) (t file))) (dlink (downcase link)) - (old-buffer (current-buffer)) - (old-pos (point)) - (old-mode major-mode) (ext (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile) (match-string 1 dfile))) + (save-position-maybe + (let ((old-buffer (current-buffer)) + (old-pos (point)) + (old-mode major-mode)) + (lambda () + (and (derived-mode-p 'org-mode) + (eq old-mode 'org-mode) + (or (not (eq old-buffer (current-buffer))) + (not (eq old-pos (point)))) + (org-mark-ring-push old-pos old-buffer))))) cmd link-match-data) (cond ((member in-emacs '((16) system)) @@ -11440,7 +11247,12 @@ If the file does not exist, an error is thrown." (widen) (cond (line (org-goto-line line) (when (derived-mode-p 'org-mode) (org-reveal))) - (search (org-link-search search)))) + (search (condition-case err + (org-link-search search) + ;; Save position before error-ing out so user + ;; can easily move back to the original buffer. + (error (funcall save-position-maybe) + (error (nth 1 err))))))) ((functionp cmd) (save-match-data (set-match-data link-match-data) @@ -11449,23 +11261,18 @@ If the file does not exist, an error is thrown." ;; FIXME: Remove this check when most default installations ;; of Emacs have at least Org 9.0. ((debug wrong-number-of-arguments wrong-type-argument - invalid-function) + invalid-function) (user-error "Please see Org News for version 9.0 about \ `org-file-apps'--Lisp error: %S" cmd))))) ((consp cmd) ;; FIXME: Remove this check when most default installations of - ;; Emacs have at least Org 9.0. - ;; Heads-up instead of silently fall back to - ;; `org-link-frame-setup' for an old usage of `org-file-apps' - ;; with sexp instead of a function for `cmd'. + ;; Emacs have at least Org 9.0. Heads-up instead of silently + ;; fall back to `org-link-frame-setup' for an old usage of + ;; `org-file-apps' with sexp instead of a function for `cmd'. (user-error "Please see Org News for version 9.0 about \ `org-file-apps'--Error: Deprecated usage of %S" cmd)) (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) - (and (derived-mode-p 'org-mode) - (eq old-mode 'org-mode) - (or (not (eq old-buffer (current-buffer))) - (not (eq old-pos (point)))) - (org-mark-ring-push old-pos old-buffer)))) + (funcall save-position-maybe))) (defun org-file-apps-entry-match-against-dlink-p (entry) "This function returns non-nil if `entry' uses a regular @@ -11663,6 +11470,10 @@ order.") (setq f (and f (expand-file-name f))) (when (eq org-refile-use-outline-path 'file) (push (list (file-name-nondirectory f) f nil nil) tgs)) + (when (eq org-refile-use-outline-path 'buffer-name) + (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs)) + (when (eq org-refile-use-outline-path 'full-file-path) + (push (list (file-truename (buffer-file-name (buffer-base-buffer))) f nil nil) tgs)) (org-with-wide-buffer (goto-char (point-min)) (setq org-outline-path-cache nil) @@ -11682,7 +11493,7 @@ order.") (target (if (not org-refile-use-outline-path) heading (mapconcat - #'org-protect-slash + #'identity (append (pcase org-refile-use-outline-path (`file (list (file-name-nondirectory @@ -11691,8 +11502,13 @@ order.") (`full-file-path (list (buffer-file-name (buffer-base-buffer)))) + (`buffer-name + (list (buffer-name + (buffer-base-buffer)))) (_ nil)) - (org-get-outline-path t t)) + (mapcar (lambda (s) (replace-regexp-in-string + "/" "\\/" s nil t)) + (org-get-outline-path t t))) "/")))) (push (list target f re (org-refile-marker (point))) tgs))) @@ -11705,9 +11521,6 @@ order.") (message "Getting targets...done") (delete-dups (nreverse targets)))) -(defun org-protect-slash (s) - (replace-regexp-in-string "/" "\\/" s nil t)) - (defun org--get-outline-path-1 (&optional use-cache) "Return outline path to current headline. @@ -11967,7 +11780,6 @@ prefix argument (`C-u C-u C-u C-c C-w')." (if pos (progn (goto-char pos) - (looking-at org-outline-regexp) (setq level (org-get-valid-level (funcall outline-level) 1)) (goto-char (if reversed @@ -12332,6 +12144,7 @@ keywords relative to each registered export back-end." ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE") ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM") ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER") + ("C" "#+BEGIN_COMMENT\n?\n#+END_COMMENT") ("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT") ("L" "#+LaTeX: ") ("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 (setq org-log-done nil org-log-repeat nil org-todo-log-states nil) - (dolist (w (org-split-string value)) + (dolist (w (split-string value)) (let (a) (cond ((setq a (assoc w org-startup-options)) @@ -13179,16 +12992,27 @@ on INACTIVE-OK." (throw 'exit t))) nil))) -(defun org-get-repeat (&optional tagline) - "Check if there is a deadline/schedule with repeater in this entry." +(defun org-get-repeat (&optional timestamp) + "Check if there is a time-stamp with repeater in this entry. + +Return the repeater, as a string, or nil. Also return nil when +this function is called before first heading. + +When optional argument TIMESTAMP is a string, extract the +repeater from there instead." (save-match-data - (save-excursion - (org-back-to-heading t) - (and (re-search-forward (if tagline - (concat tagline "\\s-*" org-repeat-re) - org-repeat-re) - (org-entry-end-position) t) - (match-string-no-properties 1))))) + (cond (timestamp + (and (string-match org-repeat-re timestamp) + (match-string-no-properties 1 timestamp))) + ((org-before-first-heading-p) nil) + (t + (save-excursion + (org-back-to-heading t) + (let ((end (org-entry-end-position))) + (catch :repeat + (while (re-search-forward org-repeat-re end t) + (when (save-match-data (org-at-timestamp-p 'agenda)) + (throw :repeat (match-string-no-properties 1))))))))))) (defvar org-last-changed-timestamp) (defvar org-last-inserted-timestamp) @@ -13210,110 +13034,117 @@ This function is run automatically after each state change to a DONE state." (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year))) (msg "Entry repeats: ") (org-log-done nil) - (org-todo-log-states nil)) - (when (and repeat (not (zerop (string-to-number (substring repeat 1))))) - (when (eq org-log-repeat t) (setq org-log-repeat 'state)) - (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective) - org-todo-repeat-to-state))) - (org-todo (cond ((and to-state (member to-state org-todo-keywords-1)) - to-state) - ((eq interpret 'type) org-last-state) - (head) - (t 'none)))) - (when (or org-log-repeat (org-entry-get nil "CLOCK")) - (org-entry-put nil "LAST_REPEAT" (format-time-string - (org-time-stamp-format t t)))) - (when org-log-repeat - (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) - (memq 'org-add-log-note post-command-hook)) - ;; We are already setup for some record. - (when (eq org-log-repeat 'note) - ;; Make sure we take a note, not only a time stamp. - (setq org-log-note-how 'note)) - ;; Set up for taking a record. - (org-add-log-setup 'state - (or done-word (car org-done-keywords)) - org-last-state - org-log-repeat))) - (org-back-to-heading t) - (org-add-planning-info nil nil 'closed) - (let ((end (save-excursion (outline-next-heading) (point))) - (planning-re (regexp-opt - (list org-scheduled-string org-deadline-string)))) - (while (re-search-forward org-ts-regexp end t) - (let* ((ts (match-string 0)) - (planning? (org-at-planning-p)) - (type (if (not planning?) "Plain:" - (save-excursion - (re-search-backward - planning-re (line-beginning-position) t) - (match-string 0))))) - (cond - ;; Ignore fake time-stamps (e.g., within comments). - ((and (not planning?) - (not (org-at-property-p)) - (not (eq 'timestamp - (org-element-type (save-excursion - (backward-char) - (org-element-context))))))) - ;; Time-stamps without a repeater are usually skipped. - ;; However, a SCHEDULED time-stamp without one is - ;; removed, as it is considered as no longer relevant. - ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)) - (when (equal type org-scheduled-string) - (org-remove-timestamp-with-keyword type))) - (t - (let ((n (string-to-number (match-string 2 ts))) - (what (match-string 3 ts))) - (when (equal what "w") (setq n (* n 7) what "d")) - (when (and (equal what "h") - (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" - ts))) - (user-error - "Cannot repeat in Repeat in %d hour(s) because no hour \ + (org-todo-log-states nil) + (end (copy-marker (org-entry-end-position)))) + (unwind-protect + (when (and repeat (not (zerop (string-to-number (substring repeat 1))))) + (when (eq org-log-repeat t) (setq org-log-repeat 'state)) + (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective) + org-todo-repeat-to-state))) + (org-todo (cond + ((and to-state (member to-state org-todo-keywords-1)) + to-state) + ((eq interpret 'type) org-last-state) + (head) + (t 'none)))) + (org-back-to-heading t) + (org-add-planning-info nil nil 'closed) + ;; When `org-log-repeat' is non-nil or entry contains + ;; a clock, set LAST_REPEAT property. + (when (or org-log-repeat + (catch :clock + (save-excursion + (while (re-search-forward org-clock-line-re end t) + (when (org-at-clock-log-p) (throw :clock t)))))) + (org-entry-put nil "LAST_REPEAT" (format-time-string + (org-time-stamp-format t t) + (current-time)))) + (when org-log-repeat + (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) + (memq 'org-add-log-note post-command-hook)) + ;; We are already setup for some record. + (when (eq org-log-repeat 'note) + ;; Make sure we take a note, not only a time stamp. + (setq org-log-note-how 'note)) + ;; Set up for taking a record. + (org-add-log-setup 'state + (or done-word (car org-done-keywords)) + org-last-state + org-log-repeat))) + (let ((planning-re (regexp-opt + (list org-scheduled-string org-deadline-string)))) + (while (re-search-forward org-ts-regexp end t) + (let* ((ts (match-string 0)) + (planning? (org-at-planning-p)) + (type (if (not planning?) "Plain:" + (save-excursion + (re-search-backward + planning-re (line-beginning-position) t) + (match-string 0))))) + (cond + ;; Ignore fake time-stamps (e.g., within comments). + ((not (org-at-timestamp-p 'agenda))) + ;; Time-stamps without a repeater are usually + ;; skipped. However, a SCHEDULED time-stamp without + ;; one is removed, as they are no longer relevant. + ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" + ts)) + (when (equal type org-scheduled-string) + (org-remove-timestamp-with-keyword type))) + (t + (let ((n (string-to-number (match-string 2 ts))) + (what (match-string 3 ts))) + (when (equal what "w") (setq n (* n 7) what "d")) + (when (and (equal what "h") + (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" + ts))) + (user-error + "Cannot repeat in Repeat in %d hour(s) because no hour \ has been set" - n)) - ;; Preparation, see if we need to modify the start - ;; date for the change. - (when (match-end 1) - (let ((time (save-match-data (org-time-string-to-time ts)))) - (cond - ((equal (match-string 1 ts) ".") - ;; Shift starting date to today - (org-timestamp-change - (- (org-today) (time-to-days time)) - 'day)) - ((equal (match-string 1 ts) "+") - (let ((nshiftmax 10) - (nshift 0)) - (while (or (= nshift 0) - (not (time-less-p (current-time) time))) - (when (= (cl-incf nshift) nshiftmax) - (or (y-or-n-p - (format "%d repeater intervals were not \ + n)) + ;; Preparation, see if we need to modify the start + ;; date for the change. + (when (match-end 1) + (let ((time (save-match-data + (org-time-string-to-time ts)))) + (cond + ((equal (match-string 1 ts) ".") + ;; Shift starting date to today + (org-timestamp-change + (- (org-today) (time-to-days time)) + 'day)) + ((equal (match-string 1 ts) "+") + (let ((nshiftmax 10) + (nshift 0)) + (while (or (= nshift 0) + (not (time-less-p (current-time) time))) + (when (= (cl-incf nshift) nshiftmax) + (or (y-or-n-p + (format "%d repeater intervals were not \ enough to shift date past today. Continue? " - nshift)) - (user-error "Abort"))) - (org-timestamp-change n (cdr (assoc what whata))) - (org-at-timestamp-p t) + nshift)) + (user-error "Abort"))) + (org-timestamp-change n (cdr (assoc what whata))) + (org-in-regexp org-ts-regexp3) + (setq ts (match-string 1)) + (setq time + (save-match-data + (org-time-string-to-time ts))))) + (org-timestamp-change (- n) (cdr (assoc what whata))) + ;; Rematch, so that we have everything in place + ;; for the real shift. + (org-in-regexp org-ts-regexp3) (setq ts (match-string 1)) - (setq time - (save-match-data - (org-time-string-to-time ts))))) - (org-timestamp-change (- n) (cdr (assoc what whata))) - ;; Rematch, so that we have everything in place - ;; for the real shift. - (org-at-timestamp-p t) - (setq ts (match-string 1)) - (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" - ts))))) - (save-excursion - (org-timestamp-change n (cdr (assoc what whata)) nil t)) - (setq msg - (concat - msg type " " org-last-changed-timestamp " ")))))))) - (setq org-log-post-message msg) - (message "%s" msg)))) + (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" + ts))))) + (save-excursion + (org-timestamp-change n (cdr (assoc what whata)) nil t)) + (setq msg + (concat + msg type " " org-last-changed-timestamp " ")))))))) + (setq org-log-post-message msg) + (message "%s" msg)) + (set-marker end nil)))) (defun org-show-todo-tree (arg) "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." (setq txt (replace-match "" t t txt))) (when (string-match "\\s-+\\'" txt) (setq txt (replace-match "" t t txt))) - (setq lines (org-split-string txt "\n")) + (setq lines (and (not (equal "" txt)) (org-split-string txt "\n"))) (when (org-string-nw-p note) (setq note (org-replace-escapes @@ -14235,8 +14066,8 @@ for inclusion. See `org-make-tags-matcher' for more information. As a special case, it can also be set to t (respectively nil) in order to match all (respectively none) headline. -When TODO-ONLY is non-nil, only lines with a not-done TODO -keyword are included in the output. +When TODO-ONLY is non-nil, only lines with a TODO keyword are +included in the output. START-LEVEL can be a string with asterisks, reducing the scope to headlines matching this string." @@ -14321,7 +14152,7 @@ headlines matching this string." (when (and ;; eval matcher only when the todo condition is OK - (and (or (not todo-only) (member todo org-not-done-keywords)) + (and (or (not todo-only) (member todo org-todo-keywords-1)) (if (functionp matcher) (let ((case-fold-search t) (org-trust-scanner-tags t)) (funcall matcher todo tags-list level)) @@ -14335,7 +14166,7 @@ headlines matching this string." ;; Check if timestamps are deselecting this entry (or (not todo-only) - (and (member todo org-not-done-keywords) + (and (member todo org-todo-keywords-1) (or (not org-agenda-tags-todo-honor-ignore-options) (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))) @@ -14877,34 +14708,32 @@ ignore inherited ones." (defun org-toggle-tag (tag &optional onoff) "Toggle the tag TAG for the current line. If ONOFF is `on' or `off', don't toggle but set to this state." - (let (res current) - (save-excursion - (org-back-to-heading t) - (if (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$" - (point-at-eol) t) - (progn - (setq current (match-string 1)) - (replace-match "")) - (setq current "")) - (setq current (nreverse (org-split-string current ":"))) - (cond - ((eq onoff 'on) - (setq res t) - (or (member tag current) (push tag current))) - ((eq onoff 'off) - (or (not (member tag current)) (setq current (delete tag current)))) - (t (if (member tag current) - (setq current (delete tag current)) - (setq res t) - (push tag current)))) - (end-of-line 1) + (save-excursion + (org-back-to-heading t) + (let ((current + (when (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$" + (line-end-position) t) + (let ((tags (match-string 1))) + ;; Clear current tags. + (replace-match "") + ;; Reverse the tags list so any new tag is appended to + ;; the current list of tags. + (nreverse (org-split-string tags ":"))))) + res) + (pcase onoff + (`off (setq current (delete tag current))) + ((or `on (guard (not (member tag current)))) + (setq res t) + (cl-pushnew tag current :test #'equal)) + (_ (setq current (delete tag current)))) + (end-of-line) (if current (progn - (insert " :" (mapconcat 'identity (nreverse current) ":") ":") + (insert " :" (mapconcat #'identity (nreverse current) ":") ":") (org-set-tags nil t)) (delete-horizontal-space)) - (run-hooks 'org-after-tags-change-hook)) - res)) + (run-hooks 'org-after-tags-change-hook) + res))) (defun org--align-tags-here (to-col) "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." (setq rtn (catch 'exit (while t - (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" + (message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s" (if (not groups) "no " "") (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) (setq c (let ((inhibit-quit t)) (read-char-exclusive))) @@ -15634,7 +15463,6 @@ See `org-property-re' for match data, if applicable." (defun org-property-action () "Do an action on properties." (interactive) - (unless (org-at-property-p) (user-error "Not at a property")) (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") (let ((c (read-char-exclusive))) (cl-case c @@ -15696,7 +15524,7 @@ When INCREMENT is non-nil, set the property to the next allowed value." (org-entry-put nil prop val)) (org-refresh-property '((effort . identity) - (effort-minutes . org-duration-string-to-minutes)) + (effort-minutes . org-duration-to-minutes)) val) (when (equal heading (bound-and-true-p org-clock-current-task)) (setq org-clock-effort (get-text-property (point-at-bol) 'effort)) @@ -15734,8 +15562,7 @@ strings." (when (or (not specific) (string= specific "CLOCKSUM")) (let ((clocksum (get-text-property (point) :org-clock-minutes))) (when clocksum - (push (cons "CLOCKSUM" - (org-minutes-to-clocksum-string clocksum)) + (push (cons "CLOCKSUM" (org-duration-from-minutes clocksum)) props))) (when specific (throw 'exit props))) (when (or (not specific) (string= specific "CLOCKSUM_T")) @@ -15743,7 +15570,7 @@ strings." :org-clock-minutes-today))) (when clocksumt (push (cons "CLOCKSUM_T" - (org-minutes-to-clocksum-string clocksumt)) + (org-duration-from-minutes clocksumt)) props))) (when specific (throw 'exit props))) (when (or (not specific) (string= specific "ITEM")) @@ -16006,44 +15833,41 @@ non-nil when a property was removed." (defun org-entry-add-to-multivalued-property (pom property value) "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM." (let* ((old (org-entry-get pom property)) - (values (and old (org-split-string old "[ \t]")))) + (values (and old (split-string old)))) (setq value (org-entry-protect-space value)) (unless (member value values) (setq values (append values (list value))) - (org-entry-put pom property - (mapconcat 'identity values " "))))) + (org-entry-put pom property (mapconcat #'identity values " "))))) (defun org-entry-remove-from-multivalued-property (pom property value) "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM." (let* ((old (org-entry-get pom property)) - (values (and old (org-split-string old "[ \t]")))) + (values (and old (split-string old)))) (setq value (org-entry-protect-space value)) (when (member value values) (setq values (delete value values)) - (org-entry-put pom property - (mapconcat 'identity values " "))))) + (org-entry-put pom property (mapconcat #'identity values " "))))) (defun org-entry-member-in-multivalued-property (pom property value) "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?" (let* ((old (org-entry-get pom property)) - (values (and old (org-split-string old "[ \t]")))) + (values (and old (split-string old)))) (setq value (org-entry-protect-space value)) (member value values))) (defun org-entry-get-multivalued-property (pom property) "Return a list of values in a multivalued property." (let* ((value (org-entry-get pom property)) - (values (and value (org-split-string value "[ \t]")))) - (mapcar 'org-entry-restore-space values))) + (values (and value (split-string value)))) + (mapcar #'org-entry-restore-space values))) (defun org-entry-put-multivalued-property (pom property &rest values) "Set multivalued PROPERTY at point-or-marker POM to VALUES. VALUES should be a list of strings. Spaces will be protected." - (org-entry-put pom property - (mapconcat 'org-entry-protect-space values " ")) + (org-entry-put pom property (mapconcat #'org-entry-protect-space values " ")) (let* ((value (org-entry-get pom property)) - (values (and value (org-split-string value "[ \t]")))) - (mapcar 'org-entry-restore-space values))) + (values (and value (split-string value)))) + (mapcar #'org-entry-restore-space values))) (defun org-entry-protect-space (s) "Protect spaces and newline in string S." @@ -16578,7 +16402,7 @@ completion." (when (equal prop org-effort-property) (org-refresh-property '((effort . identity) - (effort-minutes . org-duration-string-to-minutes)) + (effort-minutes . org-duration-to-minutes)) nval) (when (string= org-clock-current-task heading) (setq org-clock-effort nval) @@ -16607,6 +16431,8 @@ only headings." end found flevel) (unless buffer (error "File not found :%s" file)) (with-current-buffer buffer + (unless (derived-mode-p 'org-mode) + (error "Buffer %s needs to be in Org mode" buffer)) (org-with-wide-buffer (goto-char (point-min)) (dolist (heading path) @@ -16679,7 +16505,6 @@ Return the position where this entry starts, or nil if there is no such entry." (defvar org-last-changed-timestamp nil) (defvar org-last-inserted-timestamp nil "The last time stamp inserted with `org-insert-time-stamp'.") -(defvar org-ts-what) ; dynamically scoped parameter (defun org-time-stamp (arg &optional inactive) "Prompt for a date/time and insert a time stamp. @@ -16703,7 +16528,7 @@ non-nil." (let* ((ts (cond ((org-at-date-range-p t) (match-string (if (< (point) (- (match-beginning 2) 2)) 1 2))) - ((org-at-timestamp-p t) (match-string 0)))) + ((org-at-timestamp-p 'lax) (match-string 0)))) ;; Default time is either the timestamp at point or today. ;; When entering a range, only the range start is considered. (default-time (if (not ts) (current-time) @@ -16731,9 +16556,9 @@ non-nil." (ts ;; Make sure we're on a timestamp. When in the middle of a date ;; range, move arbitrarily to range end. - (unless (org-at-timestamp-p t) + (unless (org-at-timestamp-p 'lax) (skip-chars-forward "-") - (org-at-timestamp-p t)) + (org-at-timestamp-p 'lax)) (replace-match "") (setq org-last-changed-timestamp (org-insert-time-stamp @@ -17411,24 +17236,19 @@ The command returns the inserted time stamp." (defun org-display-custom-time (beg end) "Overlay modified time stamp format over timestamp between BEG and END." (let* ((ts (buffer-substring beg end)) - t1 w1 with-hm tf time str w2 (off 0)) + t1 with-hm tf time str (off 0)) (save-match-data (setq t1 (org-parse-time-string ts t)) (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) (setq off (- (match-end 0) (match-beginning 0))))) (setq end (- end off)) - (setq w1 (- end beg) - with-hm (and (nth 1 t1) (nth 2 t1)) + (setq with-hm (and (nth 1 t1) (nth 2 t1)) tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats) time (org-fix-decoded-time t1) str (org-add-props (format-time-string (substring tf 1 -1) (apply 'encode-time time)) - nil 'mouse-face 'highlight) - w2 (length str)) - (unless (= w2 w1) - (add-text-properties (1+ beg) (+ 2 beg) - (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) + nil 'mouse-face 'highlight)) (put-text-property beg end 'display str))) (defun org-fix-decoded-time (time) @@ -17547,8 +17367,8 @@ both scheduled and deadline timestamps." 'timestamp) (org-at-planning-p)) (time-less-p - (org-time-string-to-time match) - (org-time-string-to-time d))))))) + (org-time-string-to-time match t) + (org-time-string-to-time d t))))))) (message "%d entries before %s" (org-occur regexp nil callback) d))) @@ -17569,8 +17389,8 @@ both scheduled and deadline timestamps." 'timestamp) (org-at-planning-p)) (not (time-less-p - (org-time-string-to-time match) - (org-time-string-to-time d)))))))) + (org-time-string-to-time match t) + (org-time-string-to-time d t)))))))) (message "%d entries after %s" (org-occur regexp nil callback) d))) @@ -17593,11 +17413,11 @@ both scheduled and deadline timestamps." 'timestamp) (org-at-planning-p)) (not (time-less-p - (org-time-string-to-time match) - (org-time-string-to-time start-date))) + (org-time-string-to-time match t) + (org-time-string-to-time start-date t))) (time-less-p - (org-time-string-to-time match) - (org-time-string-to-time end-date)))))))) + (org-time-string-to-time match t) + (org-time-string-to-time end-date t)))))))) (message "%d entries between %s and %s" (org-occur regexp nil callback) start-date end-date))) @@ -17682,19 +17502,19 @@ days in order to avoid rounding problems." (push m l)) (apply 'format fmt (nreverse l)))) -(defun org-time-string-to-time (s &optional buffer pos) - "Convert a timestamp string into internal time." - (condition-case errdata - (apply 'encode-time (org-parse-time-string s)) - (error (error "Bad timestamp `%s'%s\nError was: %s" - s (if (not (and buffer pos)) - "" - (format-message " at %d in buffer `%s'" pos buffer)) - (cdr errdata))))) +(defun org-time-string-to-time (s &optional zone) + "Convert timestamp string S into internal time. +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, ‘wall’ for system wall clock time, or a string as +in the TZ environment variable." + (apply #'encode-time (org-parse-time-string s nil zone))) -(defun org-time-string-to-seconds (s) - "Convert a timestamp string to a number of seconds." - (float-time (org-time-string-to-time s))) +(defun org-time-string-to-seconds (s &optional zone) + "Convert a timestamp string S into a number of seconds. +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, ‘wall’ for system wall clock time, or a string as +in the TZ environment variable." + (float-time (org-time-string-to-time s zone))) (org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp") @@ -17960,7 +17780,7 @@ With prefix ARG, change by that many units." "Increase the date in the time stamp by one day. With prefix ARG, change that many days." (interactive "p") - (if (and (not (org-at-timestamp-p t)) + (if (and (not (org-at-timestamp-p 'lax)) (org-at-heading-p)) (org-todo 'up) (org-timestamp-change (prefix-numeric-value arg) 'day 'updown))) @@ -17969,54 +17789,89 @@ With prefix ARG, change that many days." "Decrease the date in the time stamp by one day. With prefix ARG, change that many days." (interactive "p") - (if (and (not (org-at-timestamp-p t)) + (if (and (not (org-at-timestamp-p 'lax)) (org-at-heading-p)) (org-todo 'down) (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown)) -(defun org-at-timestamp-p (&optional inactive-ok) +(defun org-at-timestamp-p (&optional extended) "Non-nil if point is inside a timestamp. -When optional argument INACTIVE-OK is non-nil, also consider -inactive timestamps. +By default, the function only consider syntactically valid active +timestamps. However, the caller may have a broader definition +for timestamps. As a consequence, optional argument EXTENDED can +be set to the following values -When this function returns a non-nil value, match data is set -according to `org-ts-regexp3' or `org-ts-regexp2', depending on -INACTIVE-OK." - (interactive) - (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2)) + `inactive' + + Include also syntactically valid inactive timestamps. + + `agenda' + + Include timestamps allowed in Agenda, i.e., those in + properties drawers, planning lines and clock lines. + + `lax' + + Ignore context. The function matches any part of the + document looking like a timestamp. This includes comments, + example blocks... + +For backward-compatibility with Org 9.0, every other non-nil +value is equivalent to `inactive'. + +When at a timestamp, return the position of the point as a symbol +among `bracket', `after', `year', `month', `hour', `minute', +`day' or a number of character from the last know part of the +time stamp. + +When matching, the match groups are the following: + group 1: year + group 2: month + group 3: day number + group 4: day name + group 5: hours, if any + group 6: minutes, if any" + (let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2)) (pos (point)) - (ans (or (looking-at tsr) - (save-excursion - (skip-chars-backward "^[<\n\r\t") - (when (> (point) (point-min)) (backward-char 1)) - (and (looking-at tsr) - (> (- (match-end 0) pos) -1)))))) - (and ans - (boundp 'org-ts-what) - (setq org-ts-what - (cond - ((= pos (match-beginning 0)) 'bracket) - ;; Point is considered to be "on the bracket" whether - ;; it's really on it or right after it. - ((= pos (1- (match-end 0))) 'bracket) - ((= pos (match-end 0)) 'after) - ((org-pos-in-match-range pos 2) 'year) - ((org-pos-in-match-range pos 3) 'month) - ((org-pos-in-match-range pos 7) 'hour) - ((org-pos-in-match-range pos 8) 'minute) - ((or (org-pos-in-match-range pos 4) - (org-pos-in-match-range pos 5)) 'day) - ((and (> pos (or (match-end 8) (match-end 5))) - (< pos (match-end 0))) - (- pos (or (match-end 8) (match-end 5)))) - (t 'day)))) - ans)) + (match? + (let ((boundaries (org-in-regexp regexp))) + (save-match-data + (cond ((null boundaries) nil) + ((eq extended 'lax) t) + (t + (or (and (eq extended 'agenda) + (or (org-at-planning-p) + (org-at-property-p) + (and (bound-and-true-p + org-agenda-include-inactive-timestamps) + (org-at-clock-log-p)))) + (eq 'timestamp + (save-excursion + (when (= pos (cdr boundaries)) (forward-char -1)) + (org-element-type (org-element-context))))))))))) + (cond + ((not match?) nil) + ((= pos (match-beginning 0)) 'bracket) + ;; Distinguish location right before the closing bracket from + ;; right after it. + ((= pos (1- (match-end 0))) 'bracket) + ((= pos (match-end 0)) 'after) + ((org-pos-in-match-range pos 2) 'year) + ((org-pos-in-match-range pos 3) 'month) + ((org-pos-in-match-range pos 7) 'hour) + ((org-pos-in-match-range pos 8) 'minute) + ((or (org-pos-in-match-range pos 4) + (org-pos-in-match-range pos 5)) 'day) + ((and (> pos (or (match-end 8) (match-end 5))) + (< pos (match-end 0))) + (- pos (or (match-end 8) (match-end 5)))) + (t 'day)))) (defun org-toggle-timestamp-type () "Toggle the type (<active> or [inactive]) of a time stamp." (interactive) - (when (org-at-timestamp-p t) + (when (org-at-timestamp-p 'lax) (let ((beg (match-beginning 0)) (end (match-end 0)) (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]")))) (save-excursion @@ -18027,11 +17882,10 @@ INACTIVE-OK." (message "Timestamp is now %sactive" (if (equal (char-after beg) ?<) "" "in"))))) -(defun org-at-clock-log-p nil - "Is the cursor on the clock log line?" - (save-excursion - (beginning-of-line) - (looking-at org-clock-line-re))) +(defun org-at-clock-log-p () + "Non-nil if point is on a clock log line." + (and (org-match-line org-clock-line-re) + (eq (org-element-type (save-match-data (org-element-at-point))) 'clock))) (defvar org-clock-history) ; defined in org-clock.el (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', `year', `minute', `second'. If WHAT is not given, the cursor position in the timestamp determines what will be changed. When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." - (let ((origin (point)) origin-cat + (let ((origin (point)) + (timestamp? (org-at-timestamp-p 'lax)) + origin-cat with-hm inactive (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) - org-ts-what extra rem ts time time0 fixnext clrgx) - (unless (org-at-timestamp-p t) - (user-error "Not at a timestamp")) - (if (and (not what) (eq org-ts-what 'bracket)) + (unless timestamp? (user-error "Not at a timestamp")) + (if (and (not what) (eq timestamp? 'bracket)) (org-toggle-timestamp-type) ;; Point isn't on brackets. Remember the part of the time-stamp ;; the point was in. Indeed, size of time-stamps may change, ;; but point must be kept in the same category nonetheless. - (setq origin-cat org-ts-what) - (when (and (not what) (not (eq org-ts-what 'day)) + (setq origin-cat timestamp?) + (when (and (not what) (not (eq timestamp? 'day)) org-display-custom-times (get-text-property (point) 'display) (not (get-text-property (1- (point)) 'display))) - (setq org-ts-what 'day)) - (setq org-ts-what (or what org-ts-what) + (setq timestamp? 'day)) + (setq timestamp? (or what timestamp?) inactive (= (char-after (match-beginning 0)) ?\[) ts (match-string 0)) (replace-match "") @@ -18074,7 +17928,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (setq with-hm t)) (setq time0 (org-parse-time-string ts)) (when (and updown - (eq org-ts-what 'minute) + (eq timestamp? 'minute) (not current-prefix-arg)) ;; This looks like s-up and s-down. Change by one rounding step. (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) @@ -18084,21 +17938,21 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (setq time (apply #'encode-time (or (car time0) 0) - (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) - (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) - (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) - (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) - (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) + (+ (if (eq timestamp? 'minute) n 0) (nth 1 time0)) + (+ (if (eq timestamp? 'hour) n 0) (nth 2 time0)) + (+ (if (eq timestamp? 'day) n 0) (nth 3 time0)) + (+ (if (eq timestamp? 'month) n 0) (nth 4 time0)) + (+ (if (eq timestamp? 'year) n 0) (nth 5 time0)) (nthcdr 6 time0))) - (when (and (member org-ts-what '(hour minute)) + (when (and (memq timestamp? '(hour minute)) extra (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) (setq extra (org-modify-ts-extra extra - (if (eq org-ts-what 'hour) 2 5) + (if (eq timestamp? 'hour) 2 5) n dm))) - (when (integerp org-ts-what) - (setq extra (org-modify-ts-extra extra org-ts-what n dm))) + (when (integerp timestamp?) + (setq extra (org-modify-ts-extra extra timestamp? n dm))) (when (eq what 'calendar) (let ((cal-date (org-get-date-from-calendar))) (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month @@ -18165,14 +18019,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (when (re-search-forward clrgx nil t) (goto-char (match-beginning 1)) (let (org-clock-adjust-closest) - (org-timestamp-change n org-ts-what updown)) + (org-timestamp-change n timestamp? updown)) (message "Clock adjusted in %s for heading: %s" (file-name-nondirectory (buffer-file-name)) (org-get-heading t t))))))))) ;; Try to recenter the calendar window, if any. (when (and org-calendar-follow-timestamp-change (get-buffer-window "*Calendar*" t) - (memq org-ts-what '(day month year))) + (memq timestamp? '(day month year))) (org-recenter-calendar (time-to-days time)))))) (defun org-modify-ts-extra (s pos n dm) @@ -18226,17 +18080,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." If there is a time stamp in the current line, go to that date. A prefix ARG can be used to force the current date." (interactive "P") - (let ((tsr org-ts-regexp) diff - (calendar-move-hook nil) + (let ((calendar-move-hook nil) (calendar-view-holidays-initially-flag nil) - (calendar-view-diary-initially-flag nil)) - (when (or (org-at-timestamp-p) - (save-excursion - (beginning-of-line 1) - (looking-at (concat ".*" tsr)))) + (calendar-view-diary-initially-flag nil) + diff) + (when (or (org-at-timestamp-p 'lax) + (org-match-line (concat ".*" org-ts-regexp))) (let ((d1 (time-to-days (current-time))) - (d2 (time-to-days - (org-time-string-to-time (match-string 1))))) + (d2 (time-to-days (org-time-string-to-time (match-string 1))))) (setq diff (- d2 d1)))) (calendar) (calendar-goto-today) @@ -18252,7 +18103,7 @@ A prefix ARG can be used to force the current date." "Insert time stamp corresponding to cursor date in *Calendar* buffer. If there is already a time stamp at the cursor position, update it." (interactive) - (if (org-at-timestamp-p t) + (if (org-at-timestamp-p 'lax) (org-timestamp-change 0 'calendar) (let ((cal-date (org-get-date-from-calendar))) (org-insert-time-stamp @@ -18281,113 +18132,6 @@ effort string \"2hours\" is equivalent to 120 minutes." :type '(alist :key-type (string :tag "Modifier") :value-type (number :tag "Minutes"))) -(defun org-minutes-to-clocksum-string (m) - "Format number of minutes as a clocksum string. -The format is determined by `org-time-clocksum-format', -`org-time-clocksum-use-fractional' and -`org-time-clocksum-fractional-format' and -`org-time-clocksum-use-effort-durations'." - (let ((clocksum "") - (m (round m)) ; Don't allow fractions of minutes - h d w mo y fmt n) - (setq h (if org-time-clocksum-use-effort-durations - (cdr (assoc "h" org-effort-durations)) 60) - d (if org-time-clocksum-use-effort-durations - (/ (cdr (assoc "d" org-effort-durations)) h) 24) - w (if org-time-clocksum-use-effort-durations - (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7) - mo (if org-time-clocksum-use-effort-durations - (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30) - y (if org-time-clocksum-use-effort-durations - (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365)) - ;; fractional format - (if org-time-clocksum-use-fractional - (cond - ;; single format string - ((stringp org-time-clocksum-fractional-format) - (format org-time-clocksum-fractional-format (/ m (float h)))) - ;; choice of fractional formats for different time units - ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years)) - (> (/ (truncate m) (* y d h)) 0)) - (format fmt (/ m (* y d (float h))))) - ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months)) - (> (/ (truncate m) (* mo d h)) 0)) - (format fmt (/ m (* mo d (float h))))) - ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks)) - (> (/ (truncate m) (* w d h)) 0)) - (format fmt (/ m (* w d (float h))))) - ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days)) - (> (/ (truncate m) (* d h)) 0)) - (format fmt (/ m (* d (float h))))) - ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours)) - (> (/ (truncate m) h) 0)) - (format fmt (/ m (float h)))) - ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes)) - (format fmt m)) - ;; fall back to smallest time unit with a format - ((setq fmt (plist-get org-time-clocksum-fractional-format :hours)) - (format fmt (/ m (float h)))) - ((setq fmt (plist-get org-time-clocksum-fractional-format :days)) - (format fmt (/ m (* d (float h))))) - ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks)) - (format fmt (/ m (* w d (float h))))) - ((setq fmt (plist-get org-time-clocksum-fractional-format :months)) - (format fmt (/ m (* mo d (float h))))) - ((setq fmt (plist-get org-time-clocksum-fractional-format :years)) - (format fmt (/ m (* y d (float h)))))) - ;; standard (non-fractional) format, with single format string - (if (stringp org-time-clocksum-format) - (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n))) - ;; separate formats components - (and (setq fmt (plist-get org-time-clocksum-format :years)) - (or (> (setq n (/ (truncate m) (* y d h))) 0) - (plist-get org-time-clocksum-format :require-years)) - (setq clocksum (concat clocksum (format fmt n)) - m (- m (* n y d h)))) - (and (setq fmt (plist-get org-time-clocksum-format :months)) - (or (> (setq n (/ (truncate m) (* mo d h))) 0) - (plist-get org-time-clocksum-format :require-months)) - (setq clocksum (concat clocksum (format fmt n)) - m (- m (* n mo d h)))) - (and (setq fmt (plist-get org-time-clocksum-format :weeks)) - (or (> (setq n (/ (truncate m) (* w d h))) 0) - (plist-get org-time-clocksum-format :require-weeks)) - (setq clocksum (concat clocksum (format fmt n)) - m (- m (* n w d h)))) - (and (setq fmt (plist-get org-time-clocksum-format :days)) - (or (> (setq n (/ (truncate m) (* d h))) 0) - (plist-get org-time-clocksum-format :require-days)) - (setq clocksum (concat clocksum (format fmt n)) - m (- m (* n d h)))) - (and (setq fmt (plist-get org-time-clocksum-format :hours)) - (or (> (setq n (/ (truncate m) h)) 0) - (plist-get org-time-clocksum-format :require-hours)) - (setq clocksum (concat clocksum (format fmt n)) - m (- m (* n h)))) - (and (setq fmt (plist-get org-time-clocksum-format :minutes)) - (or (> m 0) (plist-get org-time-clocksum-format :require-minutes)) - (setq clocksum (concat clocksum (format fmt m)))) - ;; return formatted time duration - clocksum)))) - -(defun org-hours-to-clocksum-string (n) - (org-minutes-to-clocksum-string (* n 60))) - -(defun org-hh:mm-string-to-minutes (s) - "Convert a string H:MM to a number of minutes. -If the string is just a number, interpret it as minutes. -In fact, the first hh:mm or number in the string will be taken, -there can be extra stuff in the string. -If no number is found, the return value is 0." - (cond - ((integerp s) s) - ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s) - (+ (* (string-to-number (match-string 1 s)) 60) - (string-to-number (match-string 2 s)))) - ((string-match "\\([0-9]+\\)" s) - (string-to-number (match-string 1 s))) - (t 0))) - (defcustom org-image-actual-width t "Should we use the actual width of images when inlining them? @@ -18442,26 +18186,6 @@ The value is a list, with zero or more of the symbols `effort', `appt', :package-version '(Org . "8.3") :group 'org-agenda) -(defun org-duration-string-to-minutes (s &optional output-to-string) - "Convert a duration string S to minutes. - -A bare number is interpreted as minutes, modifiers can be set by -customizing `org-effort-durations' (which see). - -Entries containing a colon are interpreted as H:MM by -`org-hh:mm-string-to-minutes'." - (let ((result 0) - (re (concat "\\([0-9.]+\\) *\\(" - (regexp-opt (mapcar 'car org-effort-durations)) - "\\)"))) - (while (string-match re s) - (cl-incf result (* (cdr (assoc (match-string 2 s) org-effort-durations)) - (string-to-number (match-string 1 s)))) - (setq s (replace-match "" nil t s))) - (setq result (floor result)) - (cl-incf result (org-hh:mm-string-to-minutes s)) - (if output-to-string (number-to-string result) result))) - ;;;; Files (defun org-save-all-org-buffers () @@ -19592,17 +19316,26 @@ boundaries." (when (fboundp 'clear-image-cache) (clear-image-cache))) (org-with-wide-buffer (goto-char (or beg (point-min))) - (let ((case-fold-search t) - (file-extension-re (image-file-name-regexp))) - (while (re-search-forward "[][]\\[\\(?:file\\|[./~]\\)" end t) + (let* ((case-fold-search t) + (file-extension-re (image-file-name-regexp)) + (link-abbrevs (mapcar #'car + (append org-link-abbrev-alist-local + org-link-abbrev-alist))) + ;; Check absolute, relative file names and explicit + ;; "file:" links. Also check link abbreviations since + ;; some might expand to "file" links. + (file-types-re (format "[][]\\[\\(?:file\\|[./~]%s\\)" + (and link-abbrevs + (format "\\|\\(?:%s:\\)" + (regexp-opt link-abbrevs)))))) + (while (re-search-forward file-types-re end t) (let ((link (save-match-data (org-element-context)))) - ;; Check if we're at an inline image. - (when (and (equal (org-element-property :type link) "file") + ;; Check if we're at an inline image, i.e., an image file + ;; link without a description (unless INCLUDE-LINKED is + ;; non-nil). + (when (and (equal "file" (org-element-property :type link)) (or include-linked - (not (org-element-property :contents-begin link))) - (let ((parent (org-element-property :parent link))) - (or (not (eq (org-element-type parent) 'link)) - (not (cdr (org-element-contents parent))))) + (null (org-element-contents link))) (string-match-p file-extension-re (org-element-property :path link))) (let ((file (expand-file-name @@ -19650,23 +19383,13 @@ boundaries." nil :width width))) (when image - (let* ((link - ;; If inline image is the description - ;; of another link, be sure to - ;; consider the latter as the one to - ;; apply the overlay on. - (let ((parent - (org-element-property :parent link))) - (if (eq (org-element-type parent) 'link) - parent - link))) - (ov (make-overlay - (org-element-property :begin link) - (progn - (goto-char - (org-element-property :end link)) - (skip-chars-backward " \t") - (point))))) + (let ((ov (make-overlay + (org-element-property :begin link) + (progn + (goto-char + (org-element-property :end link)) + (skip-chars-backward " \t") + (point))))) (overlay-put ov 'display image) (overlay-put ov 'face 'default) (overlay-put ov 'org-image-overlay t) @@ -19690,6 +19413,14 @@ boundaries." ;;;; Key bindings +(defun org-remap (map &rest commands) + "In MAP, remap the functions given in COMMANDS. +COMMANDS is a list of alternating OLDDEF NEWDEF command names." + (let (new old) + (while commands + (setq old (pop commands) new (pop commands)) + (org-defkey map (vector 'remap old) new)))) + ;; Outline functions from `outline-mode-prefix-map' ;; that can be remapped in Org: (define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree) @@ -19742,6 +19473,7 @@ boundaries." (org-defkey org-mode-map [(tab)] 'org-cycle) (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) (org-defkey org-mode-map "\M-\t" #'pcomplete) + ;; The following line is necessary under Suse GNU/Linux (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab) (org-defkey org-mode-map [(shift tab)] 'org-shifttab) @@ -19750,6 +19482,7 @@ boundaries." (org-defkey org-mode-map [(shift return)] 'org-table-copy-down) (org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading) (org-defkey org-mode-map [(meta return)] 'org-meta-return) +(org-defkey org-mode-map (kbd "M-RET") #'org-meta-return) ;; Cursor keys with modifiers (org-defkey org-mode-map [(meta left)] 'org-metaleft) @@ -19814,8 +19547,13 @@ boundaries." (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown)) ;; All the other keys +(org-remap org-mode-map + 'self-insert-command 'org-self-insert-command + 'delete-char 'org-delete-char + 'delete-backward-char 'org-delete-backward-char) +(org-defkey org-mode-map "|" 'org-force-self-insert) -(org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up. +(org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up. (org-defkey org-mode-map "\C-c\C-r" 'org-reveal) (if (boundp 'narrow-map) (org-defkey narrow-map "s" 'org-narrow-to-subtree) @@ -19854,7 +19592,6 @@ boundaries." (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved (org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) -(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) (org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift) (org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible) (org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content) @@ -20079,7 +19816,7 @@ Use `org-speed-commands-user' for further customization." (cdr (assoc keys org-babel-key-bindings)))) (defcustom org-speed-command-hook - '(org-speed-command-default-hook org-babel-speed-command-hook) + '(org-speed-command-activate org-babel-speed-command-activate) "Hook for activating speed commands at strategic locations. Hook functions are called in sequence until a valid handler is found. @@ -20243,6 +19980,7 @@ because, in this case the deletion might narrow the column." (org-check-before-invisible-edit 'delete-backward) (if (and (org-at-table-p) (eq N 1) + (not (org-region-active-p)) (string-match "|" (buffer-substring (point-at-bol) (point))) (looking-at ".*?|")) (let ((pos (point)) @@ -20309,14 +20047,6 @@ because, in this case the deletion might narrow the column." (put 'org-self-insert-command 'pabbrev-expand-after-command t) (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) -(defun org-remap (map &rest commands) - "In MAP, remap the functions given in COMMANDS. -COMMANDS is a list of alternating OLDDEF NEWDEF command names." - (let (new old) - (while commands - (setq old (pop commands) new (pop commands)) - (org-defkey map (vector 'remap old) new)))) - (defun org-transpose-words () "Transpose words for Org. This uses the `org-mode-transpose-word-syntax-table' syntax @@ -20327,15 +20057,6 @@ word constituents." (call-interactively 'transpose-words))) (org-remap org-mode-map 'transpose-words 'org-transpose-words) -(when (eq org-enable-table-editor 'optimized) - ;; If the user wants maximum table support, we need to hijack - ;; some standard editing functions - (org-remap org-mode-map - 'self-insert-command 'org-self-insert-command - 'delete-char 'org-delete-char - 'delete-backward-char 'org-delete-backward-char) - (org-defkey org-mode-map "|" 'org-force-self-insert)) - (defvar org-ctrl-c-ctrl-c-hook nil "Hook for functions attaching themselves to `C-c C-c'. @@ -20696,7 +20417,7 @@ depending on context. See the individual commands for more information." ((run-hook-with-args-until-success 'org-shiftup-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'previous-line)) - ((org-at-timestamp-p t) + ((org-at-timestamp-p 'lax) (call-interactively (if org-edit-timestamp-down-means-later 'org-timestamp-down 'org-timestamp-up))) ((and (not (eq org-support-shift-select 'always)) @@ -20720,7 +20441,7 @@ depending on context. See the individual commands for more information." ((run-hook-with-args-until-success 'org-shiftdown-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'next-line)) - ((org-at-timestamp-p t) + ((org-at-timestamp-p 'lax) (call-interactively (if org-edit-timestamp-down-means-later 'org-timestamp-up 'org-timestamp-down))) ((and (not (eq org-support-shift-select 'always)) @@ -20749,7 +20470,7 @@ Depending on context, this does one of the following: ((run-hook-with-args-until-success 'org-shiftright-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'forward-char)) - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) + ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-up-day)) ((and (not (eq org-support-shift-select 'always)) (org-at-heading-p)) (let ((org-inhibit-logging @@ -20785,7 +20506,7 @@ Depending on context, this does one of the following: ((run-hook-with-args-until-success 'org-shiftleft-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'backward-char)) - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) + ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-down-day)) ((and (not (eq org-support-shift-select 'always)) (org-at-heading-p)) (let ((org-inhibit-logging @@ -20837,7 +20558,7 @@ Depending on context, this does one of the following: "Change timestamps synchronously up in CLOCK log lines. Optional argument N tells to change by that many units." (interactive "P") - (if (and (org-at-clock-log-p) (org-at-timestamp-p t)) + (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax)) (let (org-support-shift-select) (org-clock-timestamps-up n)) (user-error "Not at a clock log"))) @@ -20846,7 +20567,7 @@ Optional argument N tells to change by that many units." "Change timestamps synchronously down in CLOCK log lines. Optional argument N tells to change by that many units." (interactive "P") - (if (and (org-at-clock-log-p) (org-at-timestamp-p t)) + (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax)) (let (org-support-shift-select) (org-clock-timestamps-down n)) (user-error "Not at a clock log"))) @@ -20938,6 +20659,7 @@ When at a table, call the formula editor with `org-table-edit-formulas'. When in a source code block, call `org-edit-src-code'. When in a fixed-width region, call `org-edit-fixed-width-region'. When in an export block, call `org-edit-export-block'. +When in a LaTeX environment, call `org-edit-latex-environment'. When at an #+INCLUDE keyword, visit the included file. When at a footnote reference, call `org-edit-footnote-reference' On a link, call `ffap' to visit the link at point. @@ -20965,7 +20687,9 @@ Otherwise, return a user error." (format "[[%s]]" (expand-file-name (let ((value (org-element-property :value element))) - (cond ((not (org-string-nw-p value)) + (cond ((org-file-url-p value) + (user-error "The file is specified as a URL, cannot be edited")) + ((not (org-string-nw-p value)) (user-error "No file to edit")) ((string-match "\\`\"\\(.*?\\)\"" value) (match-string 1 value)) @@ -20982,6 +20706,7 @@ Otherwise, return a user error." (`example-block (org-edit-src-code)) (`export-block (org-edit-export-block)) (`fixed-width (org-edit-fixed-width-region)) + (`latex-environment (org-edit-latex-environment)) (_ ;; No notable element at point. Though, we may be at a link or ;; a footnote reference, which are objects. Thus, scan deeper. @@ -21194,22 +20919,21 @@ This command does many different things, depending on context: (if (eq (org-element-property :type context) 'table.el) (message "%s" (substitute-command-keys "\\<org-mode-map>\ Use `\\[org-edit-special]' to edit table.el tables")) - (let ((org-enable-table-editor t)) - (if (or (eq type 'table) - ;; Check if point is at a TBLFM line. - (and (eq type 'table-row) - (= (point) (org-element-property :end context)))) - (save-excursion - (if (org-at-TBLFM-p) - (progn (require 'org-table) - (org-table-calc-current-TBLFM)) - (goto-char (org-element-property :contents-begin context)) - (org-call-with-arg 'org-table-recalculate (or arg t)) - (orgtbl-send-table 'maybe))) - (org-table-maybe-eval-formula) - (cond (arg (call-interactively #'org-table-recalculate)) - ((org-table-maybe-recalculate-line)) - (t (org-table-align))))))) + (if (or (eq type 'table) + ;; Check if point is at a TBLFM line. + (and (eq type 'table-row) + (= (point) (org-element-property :end context)))) + (save-excursion + (if (org-at-TBLFM-p) + (progn (require 'org-table) + (org-table-calc-current-TBLFM)) + (goto-char (org-element-property :contents-begin context)) + (org-call-with-arg 'org-table-recalculate (or arg t)) + (orgtbl-send-table 'maybe))) + (org-table-maybe-eval-formula) + (cond (arg (call-interactively #'org-table-recalculate)) + ((org-table-maybe-recalculate-line)) + (t (org-table-align)))))) (`timestamp (org-timestamp-change 0 'day)) ((and `nil (guard (org-at-heading-p))) ;; When point is on an unsupported object type, we can miss @@ -21228,7 +20952,8 @@ Use `\\[org-edit-special]' to edit table.el tables")) (funcall major-mode) (hack-local-variables) (when (and indent-status (not (bound-and-true-p org-indent-mode))) - (org-indent-mode -1))) + (org-indent-mode -1)) + (org-reset-file-cache)) (message "%s restarted" major-mode)) (defun org-kill-note-or-show-branches () @@ -21479,15 +21204,18 @@ number of stars to add." (forward-line))))))) (unless toggled (message "Cannot toggle heading from here")))) -(defun org-meta-return (&optional _arg) +(defun org-meta-return (&optional arg) "Insert a new heading or wrap a region in a table. -Calls `org-insert-heading' or `org-table-wrap-region', depending -on context. See the individual commands for more information." - (interactive) +Calls `org-insert-heading', `org-insert-item' or +`org-table-wrap-region', depending on context. When called with +an argument, unconditionally call `org-insert-heading'." + (interactive "P") (org-check-before-invisible-edit 'insert) (or (run-hook-with-args-until-success 'org-metareturn-hook) - (call-interactively (if (org-at-table-p) #'org-table-wrap-region - #'org-insert-heading)))) + (call-interactively (cond (arg #'org-insert-heading) + ((org-at-table-p) #'org-table-wrap-region) + ((org-in-item-p) #'org-insert-item) + (t #'org-insert-heading))))) ;;; Menu entries @@ -21549,8 +21277,7 @@ on context. See the individual commands for more information." :style toggle :selected (bound-and-true-p org-table-overlay-coordinates)] "--" - ["Create" org-table-create (and (not (org-at-table-p)) - org-enable-table-editor)] + ["Create" org-table-create (not (org-at-table-p))] ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] ["Import from File" org-table-import (not (org-at-table-p))] ["Export to File" org-table-export (org-at-table-p)] @@ -21676,10 +21403,10 @@ on context. See the individual commands for more information." ["Timestamp" org-time-stamp (not (org-before-first-heading-p))] ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))] ("Change Date" - ["1 Day Later" org-shiftright (org-at-timestamp-p)] - ["1 Day Earlier" org-shiftleft (org-at-timestamp-p)] - ["1 ... Later" org-shiftup (org-at-timestamp-p)] - ["1 ... Earlier" org-shiftdown (org-at-timestamp-p)]) + ["1 Day Later" org-shiftright (org-at-timestamp-p 'lax)] + ["1 Day Earlier" org-shiftleft (org-at-timestamp-p 'lax)] + ["1 ... Later" org-shiftup (org-at-timestamp-p 'lax)] + ["1 ... Earlier" org-shiftdown (org-at-timestamp-p 'lax)]) ["Compute Time Range" org-evaluate-time-range t] ["Schedule Item" org-schedule (not (org-before-first-heading-p))] ["Deadline" org-deadline (not (org-before-first-heading-p))] @@ -21721,7 +21448,6 @@ on context. See the individual commands for more information." ("Special views current file" ["TODO Tree" org-show-todo-tree t] ["Check Deadlines" org-check-deadlines t] - ["Timeline" org-timeline t] ["Tags/Property tree" org-match-sparse-tree t]) "--" ["Export/Publish..." org-export-dispatch t] @@ -21966,10 +21692,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (defun org-in-verbatim-emphasis () (save-match-data - (and (org-in-regexp org-emph-re 2) + (and (org-in-regexp org-verbatim-re 2) (>= (point) (match-beginning 3)) - (<= (point) (match-end 4)) - (member (match-string 3) '("=" "~"))))) + (<= (point) (match-end 4))))) (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." @@ -22017,30 +21742,6 @@ If DELETE is non-nil, delete all those overlays." (interactive "p") (self-insert-command N)) -(defun org-string-width (s) - "Compute width of string, ignoring invisible characters. -This ignores character with invisibility property `org-link', and also -characters with property `org-cwidth', because these will become invisible -upon the next fontification round." - (let (b l) - (when (or (eq t buffer-invisibility-spec) - (assq 'org-link buffer-invisibility-spec)) - (while (setq b (text-property-any 0 (length s) - 'invisible 'org-link s)) - (setq s (concat (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) - (length s))))))) - (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) - (setq s (concat (substring s 0 b) - (substring s (or (next-single-property-change - b 'org-cwidth s) - (length s)))))) - (setq l (string-width s) b -1) - (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) - (setq l (- l (get-text-property b 'org-dwidth-n s)))) - l)) - (defun org-shorten-string (s maxlength) "Shorten string S so that it is no longer than MAXLENGTH characters. If the string is shorter or has length MAXLENGTH, just return the @@ -22166,7 +21867,7 @@ wrapped to the length of that word. IF WIDTH is nil and LINES is non-nil, the string is forced into at most that many lines, whatever width that takes. The return value is a list of lines, without newlines at the end." - (let* ((words (org-split-string string "[ \t\n]+")) + (let* ((words (split-string string)) (maxword (apply 'max (mapcar 'org-string-width words))) w ll) (cond (width @@ -22193,29 +21894,6 @@ The return value is a list of lines, without newlines at the end." (setq lines (push line lines))) (nreverse lines))) -(defun org-split-string (string &optional separators) - "Splits STRING into substrings at SEPARATORS. -SEPARATORS is a regular expression. -No empty strings are returned if there are matches at the beginning -and end of string." - ;; FIXME: why not use (split-string STRING SEPARATORS t)? - (let ((start 0) notfirst list) - (while (and (string-match (or separators "[ \f\t\n\r\v]+") string - (if (and notfirst - (= start (match-beginning 0)) - (< start (length string))) - (1+ start) start)) - (< (match-beginning 0) (length string))) - (setq notfirst t) - (or (eq (match-beginning 0) 0) - (and (eq (match-beginning 0) (match-end 0)) - (eq (match-beginning 0) start)) - (push (substring string start (match-beginning 0)) list)) - (setq start (match-end 0))) - (or (eq start (length string)) - (push (substring string start) list)) - (nreverse list))) - (defun org-quote-vert (s) "Replace \"|\" with \"\\vert\"." (while (string-match "|" s) @@ -22696,7 +22374,8 @@ it for output." (?o . ,(shell-quote-argument out-dir)) (?O . ,(shell-quote-argument output)))))) (dolist (command process) - (shell-command (format-spec command spec) log-buf)))) + (shell-command (format-spec command spec) log-buf)) + (when log-buf (with-current-buffer log-buf (compilation-mode))))) (_ (error "No valid command to process %S%s" source err-msg)))) ;; Check for process failure. Output file is expected to be ;; located in the same directory as SOURCE. @@ -23094,6 +22773,7 @@ assumed to be significant there." (org-uniquify (append fill-nobreak-predicate '(org-fill-line-break-nobreak-p + org-fill-n-macro-as-item-nobreak-p org-fill-paragraph-with-timestamp-nobreak-p))))) (let ((paragraph-ending (substring org-element-paragraph-separate 1))) (setq-local paragraph-start paragraph-ending) @@ -23113,9 +22793,15 @@ assumed to be significant there." (defun org-fill-paragraph-with-timestamp-nobreak-p () "Non-nil when a new line at point would split a timestamp." - (and (org-at-timestamp-p t) + (and (org-at-timestamp-p 'lax) (not (looking-at org-ts-regexp-both)))) +(defun org-fill-n-macro-as-item-nobreak-p () + "Non-nil when a new line at point would create a new list." + ;; During export, a "n" macro followed by a dot or a closing + ;; parenthesis can end up being parsed as a new list item. + (looking-at-p "[ \t]*{{{n\\(?:([^\n)]*)\\)?}}}[.)]\\(?:$\\| \\)")) + (declare-function message-in-body-p "message" ()) (defvar orgtbl-line-start-regexp) ; From org-table.el (defun org-adaptive-fill-function () @@ -23188,7 +22874,8 @@ matches in paragraphs or comments, use it." (declare-function message-goto-body "message" ()) (defvar message-cite-prefix-regexp) ; From message.el -(defun org-fill-paragraph (&optional justify) + +(defun org-fill-element (&optional justify) "Fill element at point, when applicable. This function only applies to comment blocks, comments, example @@ -23203,126 +22890,160 @@ width for filling. For convenience, when point is at a plain list, an item or a footnote definition, try to fill the first paragraph within." - (interactive) - (if (and (derived-mode-p 'message-mode) - (or (not (message-in-body-p)) - (save-excursion (move-beginning-of-line 1) - (looking-at message-cite-prefix-regexp)))) - ;; First ensure filling is correct in message-mode. - (let ((fill-paragraph-function - (cl-cadadr (assq 'fill-paragraph-function org-fb-vars))) - (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars))) - (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars))) - (paragraph-separate - (cl-cadadr (assq 'paragraph-separate org-fb-vars)))) - (fill-paragraph nil)) - (with-syntax-table org-mode-transpose-word-syntax-table - ;; Move to end of line in order to get the first paragraph - ;; within a plain list or a footnote definition. - (let ((element (save-excursion - (end-of-line) - (or (ignore-errors (org-element-at-point)) - (user-error "An element cannot be parsed line %d" - (line-number-at-pos (point))))))) - ;; First check if point is in a blank line at the beginning of - ;; the buffer. In that case, ignore filling. - (cl-case (org-element-type element) - ;; Use major mode filling function is src blocks. - (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) - ;; Align Org tables, leave table.el tables as-is. - (table-row (org-table-align) t) - (table - (when (eq (org-element-property :type element) 'org) + (with-syntax-table org-mode-transpose-word-syntax-table + ;; Move to end of line in order to get the first paragraph within + ;; a plain list or a footnote definition. + (let ((element (save-excursion (end-of-line) (org-element-at-point)))) + ;; First check if point is in a blank line at the beginning of + ;; the buffer. In that case, ignore filling. + (cl-case (org-element-type element) + ;; Use major mode filling function is src blocks. + (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) + ;; Align Org tables, leave table.el tables as-is. + (table-row (org-table-align) t) + (table + (when (eq (org-element-property :type element) 'org) + (save-excursion + (goto-char (org-element-property :post-affiliated element)) + (org-table-align))) + t) + (paragraph + ;; Paragraphs may contain `line-break' type objects. + (let ((beg (max (point-min) + (org-element-property :contents-begin element))) + (end (min (point-max) + (org-element-property :contents-end element)))) + ;; Do nothing if point is at an affiliated keyword. + (if (< (line-end-position) beg) t + (when (derived-mode-p 'message-mode) + ;; In `message-mode', do not fill following citation + ;; in current paragraph nor text before message body. + (let ((body-start (save-excursion (message-goto-body)))) + (when body-start (setq beg (max body-start beg)))) + (when (save-excursion + (re-search-forward + (concat "^" message-cite-prefix-regexp) end t)) + (setq end (match-beginning 0)))) + ;; Fill paragraph, taking line breaks into account. (save-excursion - (goto-char (org-element-property :post-affiliated element)) - (org-table-align))) - t) - (paragraph - ;; Paragraphs may contain `line-break' type objects. - (let ((beg (max (point-min) - (org-element-property :contents-begin element))) - (end (min (point-max) - (org-element-property :contents-end element)))) - ;; Do nothing if point is at an affiliated keyword. - (if (< (line-end-position) beg) t - (when (derived-mode-p 'message-mode) - ;; In `message-mode', do not fill following citation - ;; in current paragraph nor text before message body. - (let ((body-start (save-excursion (message-goto-body)))) - (when body-start (setq beg (max body-start beg)))) - (when (save-excursion - (re-search-forward - (concat "^" message-cite-prefix-regexp) end t)) - (setq end (match-beginning 0)))) - ;; Fill paragraph, taking line breaks into account. - (save-excursion - (goto-char beg) - (let ((cuts (list beg))) - (while (re-search-forward "\\\\\\\\[ \t]*\n" end t) - (when (eq 'line-break - (org-element-type - (save-excursion (backward-char) - (org-element-context)))) - (push (point) cuts))) - (dolist (c (delq end cuts)) - (fill-region-as-paragraph c end justify) - (setq end c)))) - t))) - ;; Contents of `comment-block' type elements should be - ;; filled as plain text, but only if point is within block - ;; markers. - (comment-block - (let* ((case-fold-search t) - (beg (save-excursion - (goto-char (org-element-property :begin element)) - (re-search-forward "^[ \t]*#\\+begin_comment" nil t) - (forward-line) - (point))) - (end (save-excursion - (goto-char (org-element-property :end element)) - (re-search-backward "^[ \t]*#\\+end_comment" nil t) - (line-beginning-position)))) - (if (or (< (point) beg) (> (point) end)) t - (fill-region-as-paragraph - (save-excursion (end-of-line) - (re-search-backward "^[ \t]*$" beg 'move) - (line-beginning-position)) - (save-excursion (beginning-of-line) - (re-search-forward "^[ \t]*$" end 'move) - (line-beginning-position)) - justify)))) - ;; Fill comments. - (comment - (let ((begin (org-element-property :post-affiliated element)) - (end (org-element-property :end element))) - (when (and (>= (point) begin) (<= (point) end)) - (let ((begin (save-excursion - (end-of-line) - (if (re-search-backward "^[ \t]*#[ \t]*$" begin t) - (progn (forward-line) (point)) - begin))) - (end (save-excursion + (goto-char beg) + (let ((cuts (list beg))) + (while (re-search-forward "\\\\\\\\[ \t]*\n" end t) + (when (eq 'line-break + (org-element-type + (save-excursion (backward-char) + (org-element-context)))) + (push (point) cuts))) + (dolist (c (delq end cuts)) + (fill-region-as-paragraph c end justify) + (setq end c)))) + t))) + ;; Contents of `comment-block' type elements should be + ;; filled as plain text, but only if point is within block + ;; markers. + (comment-block + (let* ((case-fold-search t) + (beg (save-excursion + (goto-char (org-element-property :begin element)) + (re-search-forward "^[ \t]*#\\+begin_comment" nil t) + (forward-line) + (point))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (re-search-backward "^[ \t]*#\\+end_comment" nil t) + (line-beginning-position)))) + (if (or (< (point) beg) (> (point) end)) t + (fill-region-as-paragraph + (save-excursion (end-of-line) + (re-search-backward "^[ \t]*$" beg 'move) + (line-beginning-position)) + (save-excursion (beginning-of-line) + (re-search-forward "^[ \t]*$" end 'move) + (line-beginning-position)) + justify)))) + ;; Fill comments. + (comment + (let ((begin (org-element-property :post-affiliated element)) + (end (org-element-property :end element))) + (when (and (>= (point) begin) (<= (point) end)) + (let ((begin (save-excursion (end-of-line) - (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) - (1- (line-beginning-position)) - (skip-chars-backward " \r\t\n") - (line-end-position))))) - ;; Do not fill comments when at a blank line. - (when (> end begin) - (let ((fill-prefix - (save-excursion - (beginning-of-line) - (looking-at "[ \t]*#") - (let ((comment-prefix (match-string 0))) - (goto-char (match-end 0)) - (if (looking-at adaptive-fill-regexp) - (concat comment-prefix (match-string 0)) - (concat comment-prefix " ")))))) - (save-excursion - (fill-region-as-paragraph begin end justify)))))) - t)) - ;; Ignore every other element. - (otherwise t)))))) + (if (re-search-backward "^[ \t]*#[ \t]*$" begin t) + (progn (forward-line) (point)) + begin))) + (end (save-excursion + (end-of-line) + (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) + (1- (line-beginning-position)) + (skip-chars-backward " \r\t\n") + (line-end-position))))) + ;; Do not fill comments when at a blank line. + (when (> end begin) + (let ((fill-prefix + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*#") + (let ((comment-prefix (match-string 0))) + (goto-char (match-end 0)) + (if (looking-at adaptive-fill-regexp) + (concat comment-prefix (match-string 0)) + (concat comment-prefix " ")))))) + (save-excursion + (fill-region-as-paragraph begin end justify)))))) + t)) + ;; Ignore every other element. + (otherwise t))))) + +(defun org-fill-paragraph (&optional justify region) + "Fill element at point, when applicable. + +This function only applies to comment blocks, comments, example +blocks and paragraphs. Also, as a special case, re-align table +when point is at one. + +For convenience, when point is at a plain list, an item or +a footnote definition, try to fill the first paragraph within. + +If JUSTIFY is non-nil (interactively, with prefix argument), +justify as well. If `sentence-end-double-space' is non-nil, then +period followed by one space does not end a sentence, so don't +break a line there. The variable `fill-column' controls the +width for filling. + +The REGION argument is non-nil if called interactively; in that +case, if Transient Mark mode is enabled and the mark is active, +fill each of the elements in the active region, instead of just +filling the current element." + (interactive (progn + (barf-if-buffer-read-only) + (list (if current-prefix-arg 'full) t))) + (cond + ((and (derived-mode-p 'message-mode) + (or (not (message-in-body-p)) + (save-excursion (move-beginning-of-line 1) + (looking-at message-cite-prefix-regexp)))) + ;; First ensure filling is correct in message-mode. + (let ((fill-paragraph-function + (cl-cadadr (assq 'fill-paragraph-function org-fb-vars))) + (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars))) + (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars))) + (paragraph-separate + (cl-cadadr (assq 'paragraph-separate org-fb-vars)))) + (fill-paragraph nil))) + ((and region transient-mark-mode mark-active + (not (eq (region-beginning) (region-end)))) + (let ((origin (point-marker)) + (start (region-beginning))) + (unwind-protect + (progn + (goto-char (region-end)) + (while (> (point) start) + (org-backward-paragraph) + (org-fill-element justify))) + (goto-char origin) + (set-marker origin nil)))) + (t (org-fill-element justify)))) +(org-remap org-mode-map 'fill-paragraph 'org-fill-paragraph) (defun org-auto-fill-function () "Auto-fill function." @@ -23475,7 +23196,7 @@ region only contains such lines." ;; Org comments syntax is quite complex. It requires the entire line ;; to be just a comment. Also, even with the right syntax at the -;; beginning of line, some some elements (i.e. verse-block or +;; beginning of line, some elements (e.g., verse-block or ;; example-block) don't accept comments. Usual Emacs comment commands ;; cannot cope with those requirements. Therefore, Org replaces them. @@ -23874,23 +23595,28 @@ depending on context." This will call `forward-sentence' or `org-table-end-of-field', depending on context." (interactive) - (let* ((element (org-element-at-point)) - (contents-end (org-element-property :contents-end element)) - (table (org-element-lineage element '(table) t))) - (if (and table - (>= (point) (org-element-property :contents-begin table)) - (< (point) contents-end)) - (call-interactively #'org-table-end-of-field) + (if (and (org-at-heading-p) + (save-restriction (skip-chars-forward " \t") (not (eolp)))) (save-restriction - (when (and contents-end - (> (point-max) contents-end) - ;; Skip blank lines between elements. - (< (org-element-property :end element) - (save-excursion (goto-char contents-end) - (skip-chars-forward " \r\t\n")))) - (narrow-to-region (org-element-property :contents-begin element) - contents-end)) - (call-interactively #'forward-sentence))))) + (narrow-to-region (line-beginning-position) (line-end-position)) + (call-interactively #'forward-sentence)) + (let* ((element (org-element-at-point)) + (contents-end (org-element-property :contents-end element)) + (table (org-element-lineage element '(table) t))) + (if (and table + (>= (point) (org-element-property :contents-begin table)) + (< (point) contents-end)) + (call-interactively #'org-table-end-of-field) + (save-restriction + (when (and contents-end + (> (point-max) contents-end) + ;; Skip blank lines between elements. + (< (org-element-property :end element) + (save-excursion (goto-char contents-end) + (skip-chars-forward " \r\t\n")))) + (narrow-to-region (org-element-property :contents-begin element) + contents-end)) + (call-interactively #'forward-sentence)))))) (define-key org-mode-map "\M-a" 'org-backward-sentence) (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." :type 'boolean) (defcustom org-ascii-table-use-ascii-art nil - "Non-nil means table.el tables are turned into ascii-art. - + "Non-nil means \"table.el\" tables are turned into ASCII art. It only makes sense when export charset is `utf-8'. It is nil by -default since it requires ascii-art-to-unicode.el package. You -can download it here: - - http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." +default since it requires \"ascii-art-to-unicode.el\" package, +available through, e.g., GNU ELPA." :group 'org-export-ascii :version "24.4" :package-version '(Org . "8.0") @@ -404,7 +401,7 @@ The function must accept nine parameters: The function should return either the string to be exported or nil to ignore the inline task." :group 'org-export-ascii - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type 'function) 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." ;; Options, if any. (let* ((beamer-opt (org-element-property :BEAMER_OPT headline)) (options - ;; Collect options from default value and headline's - ;; properties. Also add a label for links. - (append - (org-split-string - (plist-get info :beamer-frame-default-options) ",") - (and beamer-opt - (org-split-string - ;; Remove square brackets if user provided - ;; them. - (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt) - (match-string 1 beamer-opt)) - ",")) - ;; Provide an automatic label for the frame - ;; unless the user specified one. Also refrain - ;; from labeling `allowframebreaks' frames; this - ;; is not allowed by beamer. - (unless (and beamer-opt - (or (string-match "\\(^\\|,\\)label=" beamer-opt) - (string-match "allowframebreaks" beamer-opt))) - (list - (let ((label (org-beamer--get-label headline info))) - ;; Labels containing colons need to be - ;; wrapped within braces. - (format (if (string-match-p ":" label) - "label={%s}" - "label=%s") - label))))))) + ;; Collect nonempty options from default value and + ;; headline's properties. Also add a label for + ;; links. + (cl-remove-if-not 'org-string-nw-p + (append + (org-split-string + (plist-get info :beamer-frame-default-options) ",") + (and beamer-opt + (org-split-string + ;; Remove square brackets if user provided + ;; them. + (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt) + (match-string 1 beamer-opt)) + ",")) + ;; Provide an automatic label for the frame + ;; unless the user specified one. Also refrain + ;; from labeling `allowframebreaks' frames; this + ;; is not allowed by beamer. + (unless (and beamer-opt + (or (string-match "\\(^\\|,\\)label=" beamer-opt) + (string-match "allowframebreaks" beamer-opt))) + (list + (let ((label (org-beamer--get-label headline info))) + ;; Labels containing colons need to be + ;; wrapped within braces. + (format (if (string-match-p ":" label) + "label={%s}" + "label=%s") + label)))))))) ;; Change options list into a string. (org-beamer--normalize-argument (mapconcat @@ -933,9 +935,9 @@ value." org-beamer-environments-default))) ((and (equal property "BEAMER_col") (not (org-entry-get nil (concat property "_ALL") 'inherit))) - ;; If no allowed values for BEAMER_col have been defined, - ;; supply some - (org-split-string org-beamer-column-widths " ")))) + ;; If no allowed values for BEAMER_col have been defined, supply + ;; some. + (split-string org-beamer-column-widths " ")))) (add-hook 'org-property-allowed-value-functions '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 @@ (verbatim . org-html-verbatim) (verse-block . org-html-verse-block)) :filters-alist '((:filter-options . org-html-infojs-install-script) + (:filter-parse-tree . org-html-image-link-filter) (:filter-final-output . org-html-final-function)) :menu-entry '(?h "Export to HTML" @@ -170,6 +171,11 @@ (:html-table-row-open-tag nil nil org-html-table-row-open-tag) (:html-table-row-close-tag nil nil org-html-table-row-close-tag) (:html-xml-declaration nil nil org-html-xml-declaration) + (:html-klipsify-src nil nil org-html-klipsify-src) + (:html-klipse-css nil nil org-html-klipse-css) + (:html-klipse-js nil nil org-html-klipse-js) + (:html-klipse-keep-old-src nil nil org-html-keep-old-src) + (:html-klipse-selection-script nil nil org-html-klipse-selection-script) (:infojs-opt "INFOJS_OPT" nil nil) ;; Redefine regular options. (:creator "CREATOR" nil org-html-creator-string) @@ -332,6 +338,7 @@ for the JavaScript code in this tag. pre.src-fortran:before { content: 'Fortran'; } pre.src-gnuplot:before { content: 'gnuplot'; } pre.src-haskell:before { content: 'Haskell'; } + pre.src-hledger:before { content: 'hledger'; } pre.src-java:before { content: 'Java'; } pre.src-js:before { content: 'Javascript'; } pre.src-latex:before { content: 'LaTeX'; } @@ -1532,6 +1539,46 @@ https://developer.mozilla.org/en-US/docs/Mozilla/Mobile/Viewport_meta_tag" (const "true") (const "false")))))) +;; Handle source code blocks with Klipse + +(defcustom org-html-klipsify-src nil + "When non-nil, source code blocks are editable in exported presentation." + :group 'org-export-html + :package-version '(Org . "9.1") + :type 'boolean) + +(defcustom org-html-klipse-css + "https://storage.googleapis.com/app.klipse.tech/css/codemirror.css" + "Location of the codemirror CSS file for use with klipse." + :group 'org-export-html + :package-version '(Org . "9.1") + :type 'string) + +(defcustom org-html-klipse-js + "https://storage.googleapis.com/app.klipse.tech/plugin_prod/js/klipse_plugin.min.js" + "Location of the klipse javascript file." + :group 'org-export-html + :type 'string) + +(defcustom org-html-klipse-selection-script + "window.klipse_settings = {selector_eval_html: '.src-html', + selector_eval_js: '.src-js', + selector_eval_python_client: '.src-python', + selector_eval_scheme: '.src-scheme', + selector: '.src-clojure', + selector_eval_ruby: '.src-ruby'};" + "Javascript snippet to activate klipse." + :group 'org-export-html + :package-version '(Org . "9.1") + :type 'string) + +(defcustom org-html-keep-old-src nil + "When non-nil, use <pre class=\"\"> instead of <pre><code class=\"\">." + :group 'org-export-html + :package-version '(Org . "9.1") + :type 'boolean) + + ;;;; Todos (defcustom org-html-todo-kwd-class-prefix "" @@ -1543,7 +1590,7 @@ CSS classes, then this prefix can be very useful." :group 'org-export-html :type 'string) - + ;;; Internal Functions (defun org-html-xhtml-p (info) @@ -1696,7 +1743,8 @@ If you then set `org-html-htmlize-output-type' to `css', calls to the function `org-html-htmlize-region-for-paste' will produce code that uses these same face definitions." (interactive) - (require 'htmlize) + (or (require 'htmlize nil t) + (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) (and (get-buffer "*html*") (kill-buffer "*html*")) (with-temp-buffer (let ((fl (face-list)) @@ -1765,27 +1813,30 @@ INFO is a plist used as a communication channel." (defun org-html--build-meta-info (info) "Return meta tags for exported document. INFO is a plist used as a communication channel." - (let ((protect-string - (lambda (str) - (replace-regexp-in-string - "\"" """ (org-html-encode-plain-text str)))) - (title (org-export-data (plist-get info :title) info)) - (author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth - ;; Return raw Org syntax, skipping non - ;; exportable objects. - (org-element-interpret-data - (org-element-map auth - (cons 'plain-text org-element-all-objects) - 'identity info)))))) - (description (plist-get info :description)) - (keywords (plist-get info :keywords)) - (charset (or (and org-html-coding-system - (fboundp 'coding-system-get) - (coding-system-get org-html-coding-system - 'mime-charset)) - "iso-8859-1"))) + (let* ((protect-string + (lambda (str) + (replace-regexp-in-string + "\"" """ (org-html-encode-plain-text str)))) + (title (org-export-data (plist-get info :title) info)) + ;; Set title to an invisible character instead of leaving it + ;; empty, which is invalid. + (title (if (org-string-nw-p title) title "‎")) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth + ;; Return raw Org syntax, skipping non + ;; exportable objects. + (org-element-interpret-data + (org-element-map auth + (cons 'plain-text org-element-all-objects) + 'identity info)))))) + (description (plist-get info :description)) + (keywords (plist-get info :keywords)) + (charset (or (and org-html-coding-system + (fboundp 'coding-system-get) + (coding-system-get org-html-coding-system + 'mime-charset)) + "iso-8859-1"))) (concat (when (plist-get info :time-stamp-file) (format-time-string @@ -1859,7 +1910,7 @@ INFO is a plist used as a communication channel." INFO is a plist used as a communication channel." (when (and (memq (plist-get info :with-latex) '(mathjax t)) (org-element-map (plist-get info :parse-tree) - '(latex-fragment latex-environment) 'identity info t)) + '(latex-fragment latex-environment) #'identity info t nil t)) (let ((template (plist-get info :html-mathjax-template)) (options (plist-get info :html-mathjax-options)) (in-buffer (or (plist-get info :html-mathjax) ""))) @@ -2021,7 +2072,8 @@ holding export options." (format "<%s id=\"%s\">\n" (nth 1 div) (nth 2 div))) ;; Document title. (when (plist-get info :with-title) - (let ((title (plist-get info :title)) + (let ((title (and (plist-get info :with-title) + (plist-get info :title))) (subtitle (plist-get info :subtitle)) (html5-fancy (org-html--html5-fancy-p info))) (when title @@ -2042,6 +2094,13 @@ holding export options." (format "</%s>\n" (nth 1 (assq 'content (plist-get info :html-divs)))) ;; Postamble. (org-html--build-pre/postamble 'postamble info) + ;; Possibly use the Klipse library live code blocks. + (if (plist-get info :html-klipsify-src) + (concat "<script>" (plist-get info :html-klipse-selection-script) + "</script><script src=\"" + org-html-klipse-js + "\"></script><link rel=\"stylesheet\" type=\"text/css\" href=\"" + org-html-klipse-css "\"/>")) ;; Closing document. "</body>\n</html>")) @@ -2107,7 +2166,9 @@ is the language used for CODE, as a string, or nil." ;; Simple transcoding. (org-html-encode-plain-text code)) ;; Case 2: No htmlize or an inferior version of htmlize - ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste))) + ((not (and (or (require 'htmlize nil t) + (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) + (fboundp 'htmlize-region-for-paste))) ;; Emit a warning. (message "Cannot fontify src block (htmlize.el >= 1.34 required)") ;; Simple transcoding. @@ -2552,21 +2613,22 @@ holding contextual information." (cdr ids) ""))) (if (org-export-low-level-p headline info) ;; This is a deep sub-tree: export it as a list item. - (let* ((type (if numberedp 'ordered 'unordered)) - (itemized-body - (org-html-format-list-item - contents type nil info nil + (let* ((html-type (if numberedp "ol" "ul"))) + (concat + (and (org-export-first-sibling-p headline info) + (apply #'format "<%s class=\"org-%s\">\n" + (make-list 2 html-type))) + (org-html-format-list-item + contents (if numberedp 'ordered 'unordered) + nil info nil (concat (org-html--anchor preferred-id nil nil info) extra-ids - full-text)))) - (concat (and (org-export-first-sibling-p headline info) - (org-html-begin-plain-list type)) - itemized-body - (and (org-export-last-sibling-p headline info) - (org-html-end-plain-list type)))) + full-text)) "\n" + (and (org-export-last-sibling-p headline info) + (format "</%s>\n" html-type)))) + ;; Standard headline. Export it as a section. (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline)) (first-content (car (org-element-contents headline)))) - ;; Standard headline. Export it as a section. (format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n" (org-html--container headline info) (concat "outline-container-" @@ -2692,7 +2754,8 @@ INFO is a plist holding contextual information. See (symbol-name checkbox)) "")) (checkbox (concat (org-html-checkbox checkbox info) (and checkbox " "))) - (br (org-html-close-tag "br" nil info))) + (br (org-html-close-tag "br" nil info)) + (extra-newline (if (and (org-string-nw-p contents) headline) "\n" ""))) (concat (pcase type (`ordered @@ -2715,7 +2778,9 @@ INFO is a plist holding contextual information. See class (concat checkbox term)) "<dd>")))) (unless (eq type 'descriptive) checkbox) - (and contents (org-trim contents)) + extra-newline + (and (org-string-nw-p contents) (org-trim contents)) + extra-newline (pcase type (`ordered "</li>") (`unordered "</li>") @@ -2838,6 +2903,9 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Link +(defun org-html-image-link-filter (data _backend info) + (org-export-insert-image-links data info org-html-inline-image-rules)) + (defun org-html-inline-image-p (link info) "Non-nil when LINK is meant to appear as an image. INFO is a plist used as a communication channel. LINK is an @@ -3132,34 +3200,27 @@ the plist used as a communication channel." ;;;; Plain List -;; FIXME Maybe arg1 is not needed because <li value="20"> already sets -;; the correct value for the item counter -(defun org-html-begin-plain-list (type &optional arg1) - "Insert the beginning of the HTML list depending on TYPE. -When ARG1 is a string, use it as the start parameter for ordered -lists." - (pcase type - (`ordered - (format "<ol class=\"org-ol\"%s>" - (if arg1 (format " start=\"%d\"" arg1) ""))) - (`unordered "<ul class=\"org-ul\">") - (`descriptive "<dl class=\"org-dl\">"))) - -(defun org-html-end-plain-list (type) - "Insert the end of the HTML list depending on TYPE." - (pcase type - (`ordered "</ol>") - (`unordered "</ul>") - (`descriptive "</dl>"))) - (defun org-html-plain-list (plain-list contents _info) "Transcode a PLAIN-LIST element from Org to HTML. CONTENTS is the contents of the list. INFO is a plist holding contextual information." - (let ((type (org-element-property :type plain-list))) - (format "%s\n%s%s" - (org-html-begin-plain-list type) - contents (org-html-end-plain-list type)))) + (let* ((type (pcase (org-element-property :type plain-list) + (`ordered "ol") + (`unordered "ul") + (`descriptive "dl") + (other (error "Unknown HTML list type: %s" other)))) + (class (format "org-%s" type)) + (attributes (org-export-read-attribute :attr_html plain-list))) + (format "<%s %s>\n%s</%s>" + type + (org-html--make-attribute-string + (plist-put attributes :class + (org-trim + (mapconcat #'identity + (list class (plist-get attributes :class)) + " ")))) + contents + type))) ;;;; Plain Text @@ -3267,7 +3328,7 @@ holding contextual information." #'number-to-string (org-export-get-headline-number parent info) "-")))) ;; Build return value. - (format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>" + (format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>\n" class-num (or (org-element-property :CUSTOM_ID parent) section-number @@ -3317,11 +3378,14 @@ CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (if (org-export-read-attribute :attr_html src-block :textarea) (org-html--textarea-block src-block) - (let ((lang (org-element-property :language src-block)) + (let* ((lang (org-element-property :language src-block)) (code (org-html-format-code src-block info)) (label (let ((lbl (and (org-element-property :name src-block) (org-export-get-reference src-block info)))) - (if lbl (format " id=\"%s\"" lbl) "")))) + (if lbl (format " id=\"%s\"" lbl) ""))) + (klipsify (and (plist-get info :html-klipsify-src) + (member lang '("javascript" "js" + "ruby" "scheme" "clojure" "php" "html"))))) (if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code) (format "<div class=\"org-src-container\">\n%s%s\n</div>" ;; Build caption. @@ -3338,8 +3402,12 @@ contextual information." listing-number (org-trim (org-export-data caption info)))))) ;; Contents. - (format "<pre class=\"src src-%s\"%s>%s</pre>" - lang label code)))))) + (let ((open (if org-html-keep-old-src "<pre" "<pre><code")) + (close (if org-html-keep-old-src "</pre>" "</code></pre>"))) + (format "%s class=\"src src-%s\"%s%s>%s%s" + open lang label (if (and klipsify (string= lang "html")) + " data-editor-type=\"html\"" "") + code close))))))) ;;;; Statistics Cookie 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 (1- (length org-icalendar-date-time-format))) ?Z)) (defvar org-agenda-default-appointment-duration) ; From org-agenda.el. -(defun org-icalendar-convert-timestamp (timestamp keyword &optional end utc) +(defun org-icalendar-convert-timestamp (timestamp keyword &optional end tz) "Convert TIMESTAMP to iCalendar format. 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), or the day by one (if it does not contain a time) when no explicit ending time is specified. -When optional argument UTC is non-nil, time will be expressed in -Universal Time, ignoring `org-icalendar-date-time-format'." +When optional argument TZ is non-nil, timezone data time will be +added to the timestamp. It can be the string \"UTC\", to use UTC +time, or a string in the IANA TZ database +format (e.g. \"Europe/London\"). In either case, the value of +`org-icalendar-date-time-format' will be ignored." (let* ((year-start (org-element-property :year-start timestamp)) (year-end (org-element-property :year-end timestamp)) (month-start (org-element-property :month-start timestamp)) @@ -387,8 +390,9 @@ Universal Time, ignoring `org-icalendar-date-time-format'." (concat keyword (format-time-string - (cond (utc ":%Y%m%dT%H%M%SZ") + (cond ((string-equal tz "UTC") ":%Y%m%dT%H%M%SZ") ((not with-time-p) ";VALUE=DATE:%Y%m%d") + ((stringp tz) (concat ";TZID=" tz ":%Y%m%dT%H%M%S")) (t (replace-regexp-in-string "%Z" org-icalendar-timezone org-icalendar-date-time-format @@ -396,7 +400,10 @@ Universal Time, ignoring `org-icalendar-date-time-format'." ;; Convert timestamp into internal time in order to use ;; `format-time-string' and fix any mistake (i.e. MI >= 60). (encode-time 0 mi h d m y) - (and (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))) + (and (or (string-equal tz "UTC") + (and (null tz) + with-time-p + (org-icalendar-use-UTC-date-time-p))) t))))) (defun org-icalendar-dtstamp () @@ -530,7 +537,9 @@ inlinetask within the section." (org-export-data (org-element-property :title entry) info)))) (loc (org-icalendar-cleanup-string - (org-element-property :LOCATION entry))) + (org-export-get-node-property + :LOCATION entry + (org-property-inherit-p "LOCATION")))) ;; Build description of the entry from associated section ;; (headline) or contents (inlinetask). (desc @@ -545,7 +554,10 @@ inlinetask within the section." contents 0 (min (length contents) org-icalendar-include-body)))) (org-icalendar-include-body (org-trim contents))))))) - (cat (org-icalendar-get-categories entry info))) + (cat (org-icalendar-get-categories entry info)) + (tz (org-export-get-node-property + :TIMEZONE entry + (org-property-inherit-p "TIMEZONE")))) (concat ;; Events: Delegate to `org-icalendar--vevent' to generate ;; "VEVENT" component from scheduled, deadline, or any @@ -556,14 +568,14 @@ inlinetask within the section." org-icalendar-use-deadline) (org-icalendar--vevent entry deadline (concat "DL-" uid) - (concat "DL: " summary) loc desc cat))) + (concat "DL: " summary) loc desc cat tz))) (let ((scheduled (org-element-property :scheduled entry))) (and scheduled (memq (if todo-type 'event-if-todo 'event-if-not-todo) org-icalendar-use-scheduled) (org-icalendar--vevent entry scheduled (concat "SC-" uid) - (concat "S: " summary) loc desc cat))) + (concat "S: " summary) loc desc cat tz))) ;; When collecting plain timestamps from a headline and its ;; title, skip inlinetasks since collection will happen once ;; ENTRY is one of them. @@ -581,7 +593,7 @@ inlinetask within the section." ((t) t))) (let ((uid (format "TS%d-%s" (cl-incf counter) uid))) (org-icalendar--vevent - entry ts uid summary loc desc cat)))) + entry ts uid summary loc desc cat tz)))) info nil (and (eq type 'headline) 'inlinetask)) "")) ;; Task: First check if it is appropriate to export it. If @@ -595,7 +607,7 @@ inlinetask within the section." (not (org-icalendar-blocked-headline-p entry info)))) ((t) (eq todo-type 'todo)))) - (org-icalendar--vtodo entry uid summary loc desc cat)) + (org-icalendar--vtodo entry uid summary loc desc cat tz)) ;; Diary-sexp: Collect every diary-sexp element within ENTRY ;; and its title, and transcode them. If ENTRY is ;; a headline, skip inlinetasks: they will be handled @@ -626,7 +638,7 @@ inlinetask within the section." contents)))) (defun org-icalendar--vevent - (entry timestamp uid summary location description categories) + (entry timestamp uid summary location description categories timezone) "Create a VEVENT component. 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 summary or subject for the event. LOCATION defines the intended venue for the event. DESCRIPTION provides the complete description of the event. CATEGORIES defines the categories the -event belongs to. +event belongs to. TIMEZONE specifies a time zone for this event +only. Return VEVENT component as a string." (org-icalendar-fold-string @@ -645,8 +658,8 @@ Return VEVENT component as a string." (concat "BEGIN:VEVENT\n" (org-icalendar-dtstamp) "\n" "UID:" uid "\n" - (org-icalendar-convert-timestamp timestamp "DTSTART") "\n" - (org-icalendar-convert-timestamp timestamp "DTEND" t) "\n" + (org-icalendar-convert-timestamp timestamp "DTSTART" nil timezone) "\n" + (org-icalendar-convert-timestamp timestamp "DTEND" t timezone) "\n" ;; RRULE. (when (org-element-property :repeater-type timestamp) (format "RRULE:FREQ=%s;INTERVAL=%d\n" @@ -664,7 +677,7 @@ Return VEVENT component as a string." "END:VEVENT")))) (defun org-icalendar--vtodo - (entry uid summary location description categories) + (entry uid summary location description categories timezone) "Create a VTODO component. 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 or subject for the task. LOCATION defines the intended venue for the task. DESCRIPTION provides the complete description of the task. CATEGORIES defines the categories the task belongs to. +TIMEZONE specifies a time zone for this TODO only. Return VTODO component as a string." (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled) @@ -690,11 +704,11 @@ Return VTODO component as a string." (concat "BEGIN:VTODO\n" "UID:TODO-" uid "\n" (org-icalendar-dtstamp) "\n" - (org-icalendar-convert-timestamp start "DTSTART") "\n" + (org-icalendar-convert-timestamp start "DTSTART" nil timezone) "\n" (and (memq 'todo-due org-icalendar-use-deadline) (org-element-property :deadline entry) (concat (org-icalendar-convert-timestamp - (org-element-property :deadline entry) "DUE") + (org-element-property :deadline entry) "DUE" nil timezone) "\n")) "SUMMARY:" summary "\n" (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) @@ -879,7 +893,7 @@ The file is stored under the name chosen in "Export current agenda view to an iCalendar FILE. This function assumes major mode for current buffer is `org-agenda-mode'." - (let* ((org-export-babel-evaluate) ;don't evaluate Babel blocks + (let* ((org-export-use-babel) ;don't evaluate Babel blocks (contents (org-export-string-as (with-output-to-string @@ -914,43 +928,46 @@ This function assumes major mode for current buffer is (defun org-icalendar--combine-files (&rest files) "Combine entries from multiple files into an iCalendar file. FILES is a list of files to build the calendar from." - (org-agenda-prepare-buffers files) - (unwind-protect - (progn - (with-temp-file org-icalendar-combined-agenda-file - (insert - (org-icalendar--vcalendar - ;; Name. - org-icalendar-combined-name - ;; Owner. - user-full-name - ;; Timezone. - (or (org-string-nw-p org-icalendar-timezone) - (cadr (current-time-zone))) - ;; Description. - org-icalendar-combined-description - ;; Contents. - (concat - ;; Agenda contents. - (mapconcat - (lambda (file) - (catch 'nextfile - (org-check-agenda-file file) - (with-current-buffer (org-get-agenda-file-buffer file) - ;; Create ID if necessary. - (when org-icalendar-store-UID - (org-icalendar-create-uid file t)) - (org-export-as - 'icalendar nil nil t - '(:ascii-charset utf-8 :ascii-links-to-notes nil))))) - files "") - ;; BBDB anniversaries. - (when (and org-icalendar-include-bbdb-anniversaries - (require 'org-bbdb nil t)) - (with-output-to-string (org-bbdb-anniv-export-ical))))))) - (run-hook-with-args 'org-icalendar-after-save-hook - org-icalendar-combined-agenda-file)) - (org-release-buffers org-agenda-new-buffers))) + ;; At the end of the process, all buffers related to FILES are going + ;; to be killed. Make sure to only kill the ones opened in the + ;; process. + (let ((org-agenda-new-buffers nil)) + (unwind-protect + (progn + (with-temp-file org-icalendar-combined-agenda-file + (insert + (org-icalendar--vcalendar + ;; Name. + org-icalendar-combined-name + ;; Owner. + user-full-name + ;; Timezone. + (or (org-string-nw-p org-icalendar-timezone) + (cadr (current-time-zone))) + ;; Description. + org-icalendar-combined-description + ;; Contents. + (concat + ;; Agenda contents. + (mapconcat + (lambda (file) + (catch 'nextfile + (org-check-agenda-file file) + (with-current-buffer (org-get-agenda-file-buffer file) + ;; Create ID if necessary. + (when org-icalendar-store-UID + (org-icalendar-create-uid file t)) + (org-export-as + 'icalendar nil nil t + '(:ascii-charset utf-8 :ascii-links-to-notes nil))))) + files "") + ;; BBDB anniversaries. + (when (and org-icalendar-include-bbdb-anniversaries + (require 'org-bbdb nil t)) + (with-output-to-string (org-bbdb-anniv-export-ical))))))) + (run-hook-with-args 'org-icalendar-after-save-hook + org-icalendar-combined-agenda-file)) + (org-release-buffers org-agenda-new-buffers)))) (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 @@ :filters-alist '((:filter-options . org-latex-math-block-options-filter) (:filter-paragraph . org-latex-clean-invalid-line-breaks) (:filter-parse-tree org-latex-math-block-tree-filter - org-latex-matrices-tree-filter) + org-latex-matrices-tree-filter + org-latex-image-link-filter) (:filter-verse-block . org-latex-clean-invalid-line-breaks)) :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t) @@ -726,7 +727,8 @@ environment." :safe #'stringp) (defcustom org-latex-inline-image-rules - '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'")) + `(("file" . ,(regexp-opt + '("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg")))) "Rules characterizing image files that can be inlined into LaTeX. 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. The default function simply returns the value of CONTENTS." :group 'org-export-latex - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type 'function) @@ -954,7 +956,7 @@ parameter for the listings package. If the mode name and the listings name are the same, the language does not need an entry in this list - but it does not hurt if it is present." :group 'org-export-latex - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type '(repeat (list @@ -1310,14 +1312,19 @@ For non-floats, see `org-latex--wrap-label'." (t (format (if nonfloat "\\captionof{%s}%s{%s%s}\n" "\\caption%s%s{%s%s}\n") - (if nonfloat - (cl-case type - (paragraph "figure") - (src-block (if (plist-get info :latex-listings) - "listing" - "figure")) - (t (symbol-name type))) - "") + (let ((type* (if (eq type 'latex-environment) + (org-latex--environment-type element) + type))) + (if nonfloat + (cl-case type* + (paragraph "figure") + (image "figure") + (special-block "figure") + (src-block (if (plist-get info :latex-listings) + "listing" + "figure")) + (t (symbol-name type*))) + "")) (if short (format "[%s]" (org-export-data short info)) "") label (org-export-data main info)))))) @@ -2250,24 +2257,62 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Latex Environment +(defun org-latex--environment-type (latex-environment) + "Return the TYPE of LATEX-ENVIRONMENT. + +The TYPE is determined from the actual latex environment, and +could be a member of `org-latex-caption-above' or `math'." + (let* ((latex-begin-re "\\\\begin{\\([A-Za-z0-9*]+\\)}") + (value (org-remove-indentation + (org-element-property :value latex-environment))) + (env (or (and (string-match latex-begin-re value) + (match-string 1 value)) + ""))) + (cond + ((string-match-p org-latex-math-environments-re value) 'math) + ((string-match-p + (eval-when-compile + (regexp-opt '("table" "longtable" "tabular" "tabu" "longtabu"))) + env) + 'table) + ((string-match-p "figure" env) 'image) + ((string-match-p + (eval-when-compile + (regexp-opt '("lstlisting" "listing" "verbatim" "minted"))) + env) + 'src-block) + (t 'special-block)))) + (defun org-latex-latex-environment (latex-environment _contents info) "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (when (plist-get info :with-latex) - (let ((value (org-remove-indentation - (org-element-property :value latex-environment)))) - (if (not (org-element-property :name latex-environment)) value + (let* ((value (org-remove-indentation + (org-element-property :value latex-environment))) + (type (org-latex--environment-type latex-environment)) + (caption (if (eq type 'math) + (org-latex--label latex-environment info nil t) + (org-latex--caption/label-string latex-environment info))) + (caption-above-p + (memq type (append (plist-get info :latex-caption-above) '(math))))) + (if (not (or (org-element-property :name latex-environment) + (org-element-property :caption latex-environment))) + value ;; Environment is labeled: label must be within the environment ;; (otherwise, a reference pointing to that element will count - ;; the section instead). + ;; the section instead). Also insert caption if `latex-environment' + ;; is not a math environment. (with-temp-buffer (insert value) - (goto-char (point-min)) - (forward-line) - (insert (org-latex--label latex-environment info nil t)) + (if caption-above-p + (progn + (goto-char (point-min)) + (forward-line)) + (goto-char (point-max)) + (forward-line -1)) + (insert caption) (buffer-string)))))) - ;;;; Latex Fragment (defun org-latex-latex-fragment (latex-fragment _contents _info) @@ -2291,6 +2336,9 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Link +(defun org-latex-image-link-filter (data _backend info) + (org-export-insert-image-links data info org-latex-inline-image-rules)) + (defun org-latex--inline-image (link info) "Return LaTeX code for an inline image. 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 (contents (mapconcat (lambda (row) - ;; Ignore horizontal rules. - (when (eq (org-element-property :type row) 'standard) + (if (eq (org-element-property :type row) 'rule) "\\hline" ;; Return each cell unmodified. (concat (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." "Non-nil when HEADLINE is being referred to. INFO is a plist used as a communication channel. Links and table of contents can refer to headlines." - (or (plist-get info :with-toc) - (org-element-map (plist-get info :parse-tree) 'link - (lambda (link) - (eq headline - (pcase (org-element-property :type link) - ((or "custom-id" "id") (org-export-resolve-id-link link info)) - ("fuzzy" (org-export-resolve-fuzzy-link link info)) - (_ nil)))) - info t))) + (unless (org-element-property :footnote-section-p headline) + (or + ;; Global table of contents includes HEADLINE. + (and (plist-get info :with-toc) + (memq headline + (org-export-collect-headlines info (plist-get info :with-toc)))) + ;; A local table of contents includes HEADLINE. + (cl-some + (lambda (h) + (let ((section (car (org-element-contents h)))) + (and + (eq 'section (org-element-type section)) + (org-element-map section 'keyword + (lambda (keyword) + (when (equal "TOC" (org-element-property :key keyword)) + (let ((case-fold-search t) + (value (org-element-property :value keyword))) + (and (string-match-p "\\<headlines\\>" value) + (let ((n (and + (string-match "\\<[0-9]+\\>" value) + (string-to-number (match-string 0 value)))) + (local? (string-match-p "\\<local\\>" value))) + (memq headline + (org-export-collect-headlines + info n (and local? keyword)))))))) + info t)))) + (org-element-lineage headline)) + ;; A link refers internally to HEADLINE. + (org-element-map (plist-get info :parse-tree) 'link + (lambda (link) + (eq headline + (pcase (org-element-property :type link) + ((or "custom-id" "id") (org-export-resolve-id-link link info)) + ("fuzzy" (org-export-resolve-fuzzy-link link info)) + (_ nil)))) + info t)))) (defun org-md--headline-title (style level title &optional anchor tags) "Generate a headline title in the preferred Markdown headline style. @@ -328,9 +355,19 @@ a communication channel." "Transcode a KEYWORD element into Markdown format. CONTENTS is nil. INFO is a plist used as a communication channel." - (if (member (org-element-property :key keyword) '("MARKDOWN" "MD")) - (org-element-property :value keyword) - (org-export-with-backend 'html keyword contents info))) + (pcase (org-element-property :key keyword) + ((or "MARKDOWN" "MD") (org-element-property :value keyword)) + ("TOC" + (let ((case-fold-search t) + (value (org-element-property :value keyword))) + (cond + ((string-match-p "\\<headlines\\>" value) + (let ((depth (and (string-match "\\<[0-9]+\\>" value) + (string-to-number (match-string 0 value)))) + (local? (string-match-p "\\<local\\>" value))) + (org-remove-indentation + (org-md--build-toc info depth keyword local?))))))) + (_ (org-export-with-backend 'html keyword contents info)))) ;;;; Line Break @@ -513,6 +550,61 @@ a communication channel." ;;;; Template +(defun org-md--build-toc (info &optional n keyword local) + "Return a table of contents. + +INFO is a plist used as a communication channel. + +Optional argument N, when non-nil, is an integer specifying the +depth of the table. + +Optional argument KEYWORD specifies the TOC keyword, if any, from +which the table of contents generation has been initiated. + +When optional argument LOCAL is non-nil, build a table of +contents according to the current headline." + (concat + (unless local + (let ((style (plist-get info :md-headline-style)) + (title (org-html--translate "Table of Contents" info))) + (org-md--headline-title style 1 title nil))) + (mapconcat + (lambda (headline) + (let* ((indentation + (make-string + (* 4 (1- (org-export-get-relative-level headline info))) + ?\s)) + (number (format "%d." + (org-last + (org-export-get-headline-number headline info)))) + (bullet (concat number (make-string (- 4 (length number)) ?\s))) + (title + (format "[%s](#%s)" + (org-export-data-with-backend + (org-export-get-alt-title headline info) + ;; Create an anonymous back-end that will + ;; ignore any footnote-reference, link, + ;; radio-target and target in table of + ;; contents. + (org-export-create-backend + :parent 'md + :transcoders '((footnote-reference . ignore) + (link . (lambda (object c i) c)) + (radio-target . (lambda (object c i) c)) + (target . ignore))) + info) + (or (org-element-property :CUSTOM_ID headline) + (org-export-get-reference headline info)))) + (tags (and (plist-get info :with-tags) + (not (eq 'not-in-toc (plist-get info :with-tags))) + (let ((tags (org-export-get-tags headline info))) + (and tags + (format ":%s:" + (mapconcat #'identity tags ":"))))))) + (concat indentation bullet title tags))) + (org-export-collect-headlines info n (and local keyword)) "\n") + "\n")) + (defun org-md--footnote-formatted (footnote info) "Formats a single footnote entry FOOTNOTE. FOOTNOTE is a cons cell of the form (number . definition). @@ -549,7 +641,8 @@ holding export options." (concat ;; Table of contents. (let ((depth (plist-get info :with-toc))) - (when depth (org-html-toc depth info))) + (when depth + (concat (org-md--build-toc info (and (wholenump depth) depth)) "\n"))) ;; Document contents. contents "\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 @@ :filters-alist '((:filter-parse-tree . (org-odt--translate-latex-fragments org-odt--translate-description-lists - org-odt--translate-list-tables))) + org-odt--translate-list-tables + org-odt--translate-image-links))) :menu-entry '(?o "Export to ODT" ((?o "As ODT file" org-odt-export-to-odt) @@ -655,7 +656,7 @@ The function should return the string to be exported. The default value simply returns the value of CONTENTS." :group 'org-export-odt - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type 'function) @@ -1870,7 +1871,7 @@ See `org-odt-format-headline-function' for details." (let ((style (if (eq todo-type 'done) "OrgDone" "OrgTodo"))) (format "<text:span text:style-name=\"%s\">%s</text:span> " style todo))) (when priority - (let* ((style (format "OrgPriority-%s" priority)) + (let* ((style (format "OrgPriority-%c" priority)) (priority (format "[#%c]" priority))) (format "<text:span text:style-name=\"%s\">%s</text:span> " style priority))) @@ -3682,6 +3683,11 @@ contextual information." ;;; Filters +;;; Images + +(defun org-odt--translate-image-links (data _backend info) + (org-export-insert-image-links data info org-odt-inline-image-rules)) + ;;;; LaTeX fragments (defun org-odt--translate-latex-fragments (tree _backend info) @@ -3749,6 +3755,7 @@ contextual information." nil display-msg nil processing-type) (goto-char (point-min)) + (skip-chars-forward " \t\n") (org-element-link-parser)))) (if (not (eq 'link (org-element-type link))) (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. Return output file name." (org-publish-org-to 'org filename ".org" plist pub-dir) (when (plist-get plist :htmlized-source) - (require 'htmlize) + (or (require 'htmlize nil t) + (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) (require 'ox-html) (let* ((org-inhibit-startup t) (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 @@ ;;; Variables -(defvar org-publish-temp-files nil - "Temporary list of files to be published.") - ;; Here, so you find the variable right before it's used the first time: (defvar org-publish-cache nil "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. `:sitemap-filename' - Filename for output of sitemap. Defaults to \"sitemap.org\". + Filename for output of site-map. Defaults to \"sitemap.org\". `:sitemap-title' Title of site-map page. Defaults to name of file. - `:sitemap-function' - - Plugin function to use for generation of site-map. Defaults - to `org-publish-org-sitemap', which generates a plain list of - links to all files in the project. - `:sitemap-style' 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. structure of the source files is reflected in the site-map). Defaults to `tree'. - `:sitemap-sans-extension' + `:sitemap-format-entry' + + Plugin function used to format entries in the site-map. It + is called with three arguments: the file or directory name + relative to base directory, the site map style and the + current project. It has to return a string. + + Defaults to `org-publish-sitemap-default-entry', which turns + file names into links and use document titles as + descriptions. For specific formatting needs, one can use + `org-publish-find-date', `org-publish-find-title' and + `org-publish-find-property', to retrieve additional + information about published documents. - Remove extension from site-map's file-names. Useful to have - cool URIs (see http://www.w3.org/Provider/Style/URI). - Defaults to nil. + `:sitemap-function' + + Plugin function to use for generation of site-map. It is + called with two arguments: the title of the site-map, as + a string, and a representation of the files involved in the + project, as returned by `org-list-to-lisp'. The latter can + further be transformed using `org-list-to-generic', + `org-list-to-subtree' and alike. It has to return a string. + + Defaults to `org-publish-sitemap-default', which generates + a plain list of links to all files in the project. If you create a site-map file, adjust the sorting like this: `:sitemap-sort-folders' Where folders should appear in the site-map. Set this to - `first' (default) or `last' to display folders first or last, - respectively. Any other value will mix files and folders. + `first' or `last' to display folders first or last, + respectively. When set to `ignore' (default), folders are + ignored altogether. Any other value will mix files and + folders. This variable has no effect when site-map style is + `tree'. `:sitemap-sort-files' @@ -302,17 +316,28 @@ You can overwrite this default per project in your :group 'org-export-publish :type 'symbol) -(defcustom org-publish-sitemap-sort-folders 'first - "A symbol, denoting if folders are sorted first in sitemaps. -Possible values are `first', `last', and nil. +(defcustom org-publish-sitemap-sort-folders 'ignore + "A symbol, denoting if folders are sorted first in site-maps. + +Possible values are `first', `last', `ignore' and nil. If `first', folders will be sorted before files. If `last', folders are sorted to the end after the files. -Any other value will not mix files and folders. +If `ignore', folders do not appear in the site-map. +Any other value will mix files and folders. You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-folders'." +`org-publish-project-alist', using `:sitemap-sort-folders'. + +This variable is ignored when site-map style is `tree'." :group 'org-export-publish - :type 'symbol) + :type '(choice + (const :tag "Folders before files" first) + (const :tag "Folders after files" last) + (const :tag "No folder in site-map" ignore) + (const :tag "Mix folders and files" nil)) + :version "26.1" + :package-version '(Org . "9.1") + :safe #'symbolp) (defcustom org-publish-sitemap-sort-ignore-case nil "Non-nil when site-map sorting should ignore case. @@ -322,22 +347,6 @@ You can overwrite this default per project in your :group 'org-export-publish :type 'boolean) -(defcustom org-publish-sitemap-date-format "%Y-%m-%d" - "Format for printing a date in the sitemap. -See `format-time-string' for allowed formatters." - :group 'org-export-publish - :type 'string) - -(defcustom org-publish-sitemap-file-entry-format "%t" - "Format string for site-map file entry. -You could use brackets to delimit on what part the link will be. - -%t is the title. -%a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." - :group 'org-export-publish - :type 'string) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -395,6 +404,15 @@ definition." (plist-get properties property) default))) +(defun org-publish--expand-file-name (file project) + "Return full file name for FILE in PROJECT. +When FILE is a relative file name, it is expanded according to +project base directory. Always return the true name of the file, +ignoring symlinks." + (file-truename + (if (file-name-absolute-p file) file + (expand-file-name file (org-publish-property :base-directory project))))) + (defun org-publish-expand-projects (projects-alist) "Expand projects in PROJECTS-ALIST. This splices all the components into the list." @@ -402,144 +420,57 @@ This splices all the components into the list." (while (setq p (pop rest)) (if (setq components (plist-get (cdr p) :components)) (setq rest (append - (mapcar (lambda (x) (assoc x org-publish-project-alist)) - components) + (mapcar + (lambda (x) + (or (assoc x org-publish-project-alist) + (user-error "Unknown component %S in project %S" + x (car p)))) + components) rest)) (push p rtn))) (nreverse (delete-dups (delq nil rtn))))) -(defvar org-publish-sitemap-sort-files) -(defvar org-publish-sitemap-sort-folders) -(defvar org-publish-sitemap-ignore-case) -(defvar org-publish-sitemap-requested) -(defvar org-publish-sitemap-date-format) -(defvar org-publish-sitemap-file-entry-format) -(defun org-publish-compare-directory-files (a b) - "Predicate for `sort', that sorts folders and files for sitemap." - (let ((retval t)) - (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders) - ;; First we sort files: - (when org-publish-sitemap-sort-files - (pcase org-publish-sitemap-sort-files - (`alphabetically - (let* ((adir (file-directory-p a)) - (aorg (and (string-suffix-p ".org" a) (not adir))) - (bdir (file-directory-p b)) - (borg (and (string-suffix-p ".org" b) (not bdir))) - (A (if aorg (concat (file-name-directory a) - (org-publish-find-title a)) a)) - (B (if borg (concat (file-name-directory b) - (org-publish-find-title b)) b))) - (setq retval (if org-publish-sitemap-ignore-case - (not (string-lessp (upcase B) (upcase A))) - (not (string-lessp B A)))))) - ((or `anti-chronologically `chronologically) - (let* ((adate (org-publish-find-date a)) - (bdate (org-publish-find-date b)) - (A (+ (lsh (car adate) 16) (cadr adate))) - (B (+ (lsh (car bdate) 16) (cadr bdate)))) - (setq retval - (if (eq org-publish-sitemap-sort-files 'chronologically) - (<= A B) - (>= A B))))))) - ;; Directory-wise wins: - (when org-publish-sitemap-sort-folders - ;; a is directory, b not: - (cond - ((and (file-directory-p a) (not (file-directory-p b))) - (setq retval (eq org-publish-sitemap-sort-folders 'first))) - ;; a is not a directory, but b is: - ((and (not (file-directory-p a)) (file-directory-p b)) - (setq retval (eq org-publish-sitemap-sort-folders 'last)))))) - retval)) - -(defun org-publish-get-base-files-1 - (base-dir &optional recurse match skip-file skip-dir) - "Set `org-publish-temp-files' with files from BASE-DIR directory. -If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is -non-nil, restrict this list to the files matching the regexp -MATCH. If SKIP-FILE is non-nil, skip file matching the regexp -SKIP-FILE. If SKIP-DIR is non-nil, don't check directories -matching the regexp SKIP-DIR when recursing through BASE-DIR." - (let ((all-files (if (not recurse) (directory-files base-dir t match) - ;; If RECURSE is non-nil, we want all files - ;; matching MATCH and sub-directories. - (cl-remove-if-not - (lambda (file) - (or (file-directory-p file) - (and match (string-match match file)))) - (directory-files base-dir t))))) - (dolist (f (if (not org-publish-sitemap-requested) all-files - (sort all-files #'org-publish-compare-directory-files))) - (let ((fd-p (file-directory-p f)) - (fnd (file-name-nondirectory f))) - (if (and fd-p recurse - (not (string-match "^\\.+$" fnd)) - (if skip-dir (not (string-match skip-dir fnd)) t)) - (org-publish-get-base-files-1 - f recurse match skip-file skip-dir) - (unless (or fd-p ; This is a directory. - (and skip-file (string-match skip-file fnd)) - (not (file-exists-p (file-truename f))) - (not (string-match match fnd))) - (cl-pushnew f org-publish-temp-files))))))) - -(defun org-publish-get-base-files (project &optional exclude-regexp) - "Return a list of all files in PROJECT. -If EXCLUDE-REGEXP is set, this will be used to filter out -matching filenames." - (let* ((project-plist (cdr project)) - (base-dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (include-list (plist-get project-plist :include)) - (recurse (plist-get project-plist :recursive)) - (extension (or (plist-get project-plist :base-extension) "org")) - ;; sitemap-... variables are dynamically scoped for - ;; org-publish-compare-directory-files: - (org-publish-sitemap-requested - (plist-get project-plist :auto-sitemap)) - (sitemap-filename - (or (plist-get project-plist :sitemap-filename) "sitemap.org")) - (org-publish-sitemap-sort-folders - (if (plist-member project-plist :sitemap-sort-folders) - (plist-get project-plist :sitemap-sort-folders) - org-publish-sitemap-sort-folders)) - (org-publish-sitemap-sort-files - (cond ((plist-member project-plist :sitemap-sort-files) - (plist-get project-plist :sitemap-sort-files)) - ;; For backward compatibility: - ((plist-member project-plist :sitemap-alphabetically) - (if (plist-get project-plist :sitemap-alphabetically) - 'alphabetically nil)) - (t org-publish-sitemap-sort-files))) - (org-publish-sitemap-ignore-case - (if (plist-member project-plist :sitemap-ignore-case) - (plist-get project-plist :sitemap-ignore-case) - org-publish-sitemap-sort-ignore-case)) - (match (if (eq extension 'any) "^[^\\.]" - (concat "^[^\\.].*\\.\\(" extension "\\)$")))) - ;; Make sure `org-publish-sitemap-sort-folders' has an accepted - ;; value. - (unless (memq org-publish-sitemap-sort-folders '(first last)) - (setq org-publish-sitemap-sort-folders nil)) - - (setq org-publish-temp-files nil) - (when org-publish-sitemap-requested - (cl-pushnew (expand-file-name (concat base-dir sitemap-filename)) - org-publish-temp-files)) - (org-publish-get-base-files-1 base-dir recurse match - ;; FIXME distinguish exclude regexp - ;; for skip-file and skip-dir? - exclude-regexp exclude-regexp) - (dolist (f include-list org-publish-temp-files) - (cl-pushnew (expand-file-name (concat base-dir f)) - org-publish-temp-files)))) +(defun org-publish-get-base-files (project) + "Return a list of all files in PROJECT." + (let* ((base-dir (file-name-as-directory + (org-publish-property :base-directory project))) + (extension (or (org-publish-property :base-extension project) "org")) + (match (and (not (eq extension 'any)) + (concat "^[^\\.].*\\.\\(" extension "\\)$"))) + (base-files + (cl-remove-if #'file-directory-p + (if (org-publish-property :recursive project) + (directory-files-recursively base-dir match) + (directory-files base-dir t match t))))) + (org-uniquify + (append + ;; Files from BASE-DIR. Apply exclusion filter before adding + ;; included files. + (let ((exclude-regexp (org-publish-property :exclude project))) + (if exclude-regexp + (cl-remove-if + (lambda (f) + ;; Match against relative names, yet BASE-DIR file + ;; names are absolute. + (string-match exclude-regexp + (file-relative-name f base-dir))) + base-files) + base-files)) + ;; Sitemap file. + (and (org-publish-property :auto-sitemap project) + (list (expand-file-name + (or (org-publish-property :sitemap-filename project) + "sitemap.org") + base-dir))) + ;; Included files. + (mapcar (lambda (f) (expand-file-name f base-dir)) + (org-publish-property :include project)))))) (defun org-publish-get-project-from-filename (filename &optional up) "Return a project that FILENAME belongs to. When UP is non-nil, return a meta-project (i.e., with a :components part) publishing FILENAME." - (let* ((filename (expand-file-name filename)) + (let* ((filename (file-truename filename)) (project (cl-some (lambda (p) @@ -656,8 +587,7 @@ Return output file name." -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Publishing files, sets of files, and indices +;;; Publishing files, sets of files (defun org-publish-file (filename &optional project no-cache) "Publish file FILENAME from PROJECT. @@ -672,7 +602,7 @@ files, when entire projects are published (see (abbreviate-file-name filename)))) (project-plist (cdr project)) (publishing-function - (pcase (plist-get project-plist :publishing-function) + (pcase (org-publish-property :publishing-function project) (`nil (user-error "No publishing function chosen")) ((and f (pred listp)) f) (f (list f)))) @@ -711,185 +641,262 @@ files, when entire projects are published (see If `:auto-sitemap' is set, publish the sitemap too. If `:makeindex' is set, also produce a file \"theindex.org\"." (dolist (project (org-publish-expand-projects projects)) - (let ((project-plist (cdr project))) - (let ((fun (plist-get project-plist :preparation-function))) - (cond ((consp fun) (dolist (f fun) (funcall f project-plist))) - ((functionp fun) (funcall fun project-plist)))) + (let ((plist (cdr project))) + (let ((fun (org-publish-property :preparation-function project))) + (cond + ((consp fun) (dolist (f fun) (funcall f plist))) + ((functionp fun) (funcall fun plist)))) ;; Each project uses its own cache file. (org-publish-initialize-cache (car project)) - (when (plist-get project-plist :auto-sitemap) + (when (org-publish-property :auto-sitemap project) (let ((sitemap-filename - (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (sitemap-function - (or (plist-get project-plist :sitemap-function) - #'org-publish-org-sitemap)) - (org-publish-sitemap-date-format - (or (plist-get project-plist :sitemap-date-format) - org-publish-sitemap-date-format)) - (org-publish-sitemap-file-entry-format - (or (plist-get project-plist :sitemap-file-entry-format) - org-publish-sitemap-file-entry-format))) - (funcall sitemap-function project sitemap-filename))) + (or (org-publish-property :sitemap-filename project) + "sitemap.org"))) + (org-publish-sitemap project sitemap-filename))) ;; Publish all files from PROJECT except "theindex.org". Its ;; publishing will be deferred until "theindex.inc" is ;; populated. (let ((theindex (expand-file-name "theindex.org" - (plist-get project-plist :base-directory))) - (exclude-regexp (plist-get project-plist :exclude))) - (dolist (file (org-publish-get-base-files project exclude-regexp)) + (org-publish-property :base-directory project)))) + (dolist (file (org-publish-get-base-files project)) (unless (file-equal-p file theindex) (org-publish-file file project t))) ;; Populate "theindex.inc", if needed, and publish ;; "theindex.org". - (when (plist-get project-plist :makeindex) + (when (org-publish-property :makeindex project) (org-publish-index-generate-theindex - project (plist-get project-plist :base-directory)) + project (org-publish-property :base-directory project)) (org-publish-file theindex project t))) - (let ((fun (plist-get project-plist :completion-function))) - (cond ((consp fun) (dolist (f fun) (funcall f project-plist))) - ((functionp fun) (funcall fun project-plist)))) - (org-publish-write-cache-file)))) + (let ((fun (org-publish-property :completion-function project))) + (cond + ((consp fun) (dolist (f fun) (funcall f plist))) + ((functionp fun) (funcall fun plist))))) + (org-publish-write-cache-file))) -(defun org-publish-org-sitemap (project &optional sitemap-filename) + +;;; Site map generation + +(defun org-publish--sitemap-files-to-lisp (files project style format-entry) + "Represent FILES as a parsed plain list. +FILES is the list of files in the site map. PROJECT is the +current project. STYLE determines is either `list' or `tree'. +FORMAT-ENTRY is a function called on each file which should +return a string. Return value is a list as returned by +`org-list-to-lisp'." + (let ((root (expand-file-name + (file-name-as-directory + (org-publish-property :base-directory project))))) + (pcase style + (`list + (cons 'unordered + (mapcar + (lambda (f) + (list (funcall format-entry + (file-relative-name f root) + style + project))) + files))) + (`tree + (letrec ((files-only (cl-remove-if #'directory-name-p files)) + (directories (cl-remove-if-not #'directory-name-p files)) + (subtree-to-list + (lambda (dir) + (cons 'unordered + (nconc + ;; Files in DIR. + (mapcar + (lambda (f) + (list (funcall format-entry + (file-relative-name f root) + style + project))) + (cl-remove-if-not + (lambda (f) (string= dir (file-name-directory f))) + files-only)) + ;; Direct sub-directories. + (mapcar + (lambda (sub) + (list (funcall format-entry + (file-relative-name sub root) + style + project) + (funcall subtree-to-list sub))) + (cl-remove-if-not + (lambda (f) + (string= + dir + ;; Parent directory. + (file-name-directory (directory-file-name f)))) + directories))))))) + (funcall subtree-to-list root))) + (_ (user-error "Unknown site-map style: `%s'" style))))) + +(defun org-publish-sitemap (project &optional sitemap-filename) "Create a sitemap of pages in set defined by PROJECT. Optionally set the filename of the sitemap with SITEMAP-FILENAME. Default for SITEMAP-FILENAME is `sitemap.org'." - (let* ((project-plist (cdr project)) - (dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (localdir (file-name-directory dir)) - (indent-str (make-string 2 ?\s)) - (exclude-regexp (plist-get project-plist :exclude)) - (files (nreverse - (org-publish-get-base-files project exclude-regexp))) - (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) - (sitemap-title (or (plist-get project-plist :sitemap-title) - (concat "Sitemap for project " (car project)))) - (sitemap-style (or (plist-get project-plist :sitemap-style) - 'tree)) - (sitemap-sans-extension - (plist-get project-plist :sitemap-sans-extension)) - (visiting (find-buffer-visiting sitemap-filename)) - file sitemap-buffer) - (with-current-buffer - (let ((org-inhibit-startup t)) - (setq sitemap-buffer - (or visiting (find-file sitemap-filename)))) - (erase-buffer) - (insert (concat "#+TITLE: " sitemap-title "\n\n")) - (while (setq file (pop files)) - (let ((link (file-relative-name file dir)) - (oldlocal localdir)) - (when sitemap-sans-extension - (setq link (file-name-sans-extension link))) - ;; sitemap shouldn't list itself - (unless (file-equal-p sitemap-filename file) - (if (eq sitemap-style 'list) - (message "Generating list-style sitemap for %s" sitemap-title) - (message "Generating tree-style sitemap for %s" sitemap-title) - (setq localdir (concat (file-name-as-directory dir) - (file-name-directory link))) - (unless (string= localdir oldlocal) - (if (string= localdir dir) - (setq indent-str (make-string 2 ?\ )) - (let ((subdirs - (split-string - (directory-file-name - (file-name-directory - (file-relative-name localdir dir))) "/")) - (subdir "") - (old-subdirs (split-string - (file-relative-name oldlocal dir) "/"))) - (setq indent-str (make-string 2 ?\ )) - (while (string= (car old-subdirs) (car subdirs)) - (setq indent-str (concat indent-str (make-string 2 ?\ ))) - (pop old-subdirs) - (pop subdirs)) - (dolist (d subdirs) - (setq subdir (concat subdir d "/")) - (insert (concat indent-str " + " d "\n")) - (setq indent-str (make-string - (+ (length indent-str) 2) ?\ ))))))) - ;; This is common to 'flat and 'tree - (let ((entry - (org-publish-format-file-entry - org-publish-sitemap-file-entry-format file project-plist)) - (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) - (cond ((string-match-p regexp entry) - (string-match regexp entry) - (insert (concat indent-str " + " (match-string 1 entry) - "[[file:" link "][" - (match-string 2 entry) - "]]" (match-string 3 entry) "\n"))) - (t - (insert (concat indent-str " + [[file:" link "][" - entry - "]]\n")))))))) - (save-buffer)) - (or visiting (kill-buffer sitemap-buffer)))) - -(defun org-publish-format-file-entry (fmt file project-plist) - (format-spec - fmt - `((?t . ,(org-publish-find-title file t)) - (?d . ,(format-time-string org-publish-sitemap-date-format - (org-publish-find-date file))) - (?a . ,(or (plist-get project-plist :author) user-full-name))))) - -(defun org-publish-find-title (file &optional reset) - "Find the title of FILE in project." - (or - (and (not reset) (org-publish-cache-get-file-property file :title nil t)) - (let* ((org-inhibit-startup t) - (visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file)))) - (with-current-buffer buffer - (let ((title - (let ((property - (plist-get - ;; protect local variables in open buffers - (if visiting - (org-export-with-buffer-copy (org-export-get-environment)) - (org-export-get-environment)) - :title))) - (if property - (org-no-properties (org-element-interpret-data property)) - (file-name-nondirectory (file-name-sans-extension file)))))) - (unless visiting (kill-buffer buffer)) - (org-publish-cache-set-file-property file :title title) - title))))) - -(defun org-publish-find-date (file) - "Find the date of FILE in project. + (let* ((root (expand-file-name + (file-name-as-directory + (org-publish-property :base-directory project)))) + (sitemap-filename (concat root (or sitemap-filename "sitemap.org"))) + (title (or (org-publish-property :sitemap-title project) + (concat "Sitemap for project " (car project)))) + (style (or (org-publish-property :sitemap-style project) + 'tree)) + (sitemap-builder (or (org-publish-property :sitemap-function project) + #'org-publish-sitemap-default)) + (format-entry (or (org-publish-property :sitemap-format-entry project) + #'org-publish-sitemap-default-entry)) + (sort-folders + (org-publish-property :sitemap-sort-folders project + org-publish-sitemap-sort-folders)) + (sort-files + (org-publish-property :sitemap-sort-files project + org-publish-sitemap-sort-files)) + (ignore-case + (org-publish-property :sitemap-ignore-case project + org-publish-sitemap-sort-ignore-case)) + (org-file-p (lambda (f) (equal "org" (file-name-extension f)))) + (sort-predicate + (lambda (a b) + (let ((retval t)) + ;; First we sort files: + (pcase sort-files + (`alphabetically + (let ((A (if (funcall org-file-p a) + (concat (file-name-directory a) + (org-publish-find-title a project)) + a)) + (B (if (funcall org-file-p b) + (concat (file-name-directory b) + (org-publish-find-title b project)) + b))) + (setq retval + (if ignore-case + (not (string-lessp (upcase B) (upcase A))) + (not (string-lessp B A)))))) + ((or `anti-chronologically `chronologically) + (let* ((adate (org-publish-find-date a project)) + (bdate (org-publish-find-date b project)) + (A (+ (lsh (car adate) 16) (cadr adate))) + (B (+ (lsh (car bdate) 16) (cadr bdate)))) + (setq retval + (if (eq sort-files 'chronologically) + (<= A B) + (>= A B))))) + (`nil nil) + (_ (user-error "Invalid sort value %s" sort-files))) + ;; Directory-wise wins: + (when (memq sort-folders '(first last)) + ;; a is directory, b not: + (cond + ((and (file-directory-p a) (not (file-directory-p b))) + (setq retval (eq sort-folders 'first))) + ;; a is not a directory, but b is: + ((and (not (file-directory-p a)) (file-directory-p b)) + (setq retval (eq sort-folders 'last))))) + retval)))) + (message "Generating sitemap for %s" title) + (with-temp-file sitemap-filename + (insert + (let ((files (remove sitemap-filename + (org-publish-get-base-files project)))) + ;; Add directories, if applicable. + (unless (and (eq style 'list) (eq sort-folders 'ignore)) + (setq files + (nconc (remove root (org-uniquify + (mapcar #'file-name-directory files))) + files))) + ;; Eventually sort all entries. + (when (or sort-files (not (memq sort-folders 'ignore))) + (setq files (sort files sort-predicate))) + (funcall sitemap-builder + title + (org-publish--sitemap-files-to-lisp + files project style format-entry))))))) + +(defun org-publish-find-property (file property project &optional backend) + "Find the PROPERTY of FILE in project. + +PROPERTY is a keyword referring to an export option, as defined +in `org-export-options-alist' or in export back-ends. In the +latter case, optional argument BACKEND has to be set to the +back-end where the option is defined, e.g., + + (org-publish-find-property file :subtitle 'latex) + +Return value may be a string or a list, depending on the type of +PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'." + (let ((file (org-publish--expand-file-name file project))) + (when (and (file-readable-p file) (not (directory-name-p file))) + (let* ((org-inhibit-startup t) + (visiting (find-buffer-visiting file)) + (buffer (or visiting (find-file-noselect file)))) + (unwind-protect + (plist-get (with-current-buffer buffer + (if (not visiting) (org-export-get-environment backend) + ;; Protect local variables in open buffers. + (org-export-with-buffer-copy + (org-export-get-environment backend)))) + property) + (unless visiting (kill-buffer buffer))))))) + +(defun org-publish-find-title (file project) + "Find the title of FILE in PROJECT." + (let ((file (org-publish--expand-file-name file project))) + (or (org-publish-cache-get-file-property file :title nil t) + (let* ((parsed-title (org-publish-find-property file :title project)) + (title + (if parsed-title + ;; Remove property so that the return value is + ;; cache-able (i.e., it can be `read' back). + (org-no-properties + (org-element-interpret-data parsed-title)) + (file-name-nondirectory (file-name-sans-extension file))))) + (org-publish-cache-set-file-property file :title title) + title)))) + +(defun org-publish-find-date (file project) + "Find the date of FILE in PROJECT. This function assumes FILE is either a directory or an Org file. If FILE is an Org file and provides a DATE keyword use it. In any other case use the file system's modification time. Return time in `current-time' format." - (if (file-directory-p file) (nth 5 (file-attributes file)) - (let* ((org-inhibit-startup t) - (visiting (find-buffer-visiting file)) - (file-buf (or visiting (find-file-noselect file nil))) - (date (plist-get - (with-current-buffer file-buf - (if visiting - (org-export-with-buffer-copy - (org-export-get-environment)) - (org-export-get-environment))) - :date))) - (unless visiting (kill-buffer file-buf)) - ;; DATE is a secondary string. If it contains a timestamp, - ;; convert it to internal format. Otherwise, use FILE - ;; modification time. - (cond ((let ((ts (and (consp date) (assq 'timestamp date)))) - (and ts - (let ((value (org-element-interpret-data ts))) - (and (org-string-nw-p value) - (org-time-string-to-time value)))))) - ((file-exists-p file) (nth 5 (file-attributes file))) - (t (error "No such file: \"%s\"" file)))))) - + (let ((file (org-publish--expand-file-name file project))) + (if (file-directory-p file) (nth 5 (file-attributes file)) + (let ((date (org-publish-find-property file :date project))) + ;; DATE is a secondary string. If it contains a time-stamp, + ;; convert it to internal format. Otherwise, use FILE + ;; modification time. + (cond ((let ((ts (and (consp date) (assq 'timestamp date)))) + (and ts + (let ((value (org-element-interpret-data ts))) + (and (org-string-nw-p value) + (org-time-string-to-time value)))))) + ((file-exists-p file) (nth 5 (file-attributes file))) + (t (error "No such file: \"%s\"" file))))))) + +(defun org-publish-sitemap-default-entry (entry style project) + "Default format for site map ENTRY, as a string. +ENTRY is a file name. STYLE is the style of the sitemap. +PROJECT is the current project." + (cond ((not (directory-name-p entry)) + (format "[[file:%s][%s]]" + entry + (org-publish-find-title entry project))) + ((eq style 'tree) + ;; Return only last subdir. + (file-name-nondirectory (directory-file-name entry))) + (t entry))) + +(defun org-publish-sitemap-default (title list) + "Default site map, as a string. +TITLE is the the title of the site map. LIST is an internal +representation for the files to include, as returned by +`org-list-to-lisp'. PROJECT is the current project." + (concat "#+TITLE: " title "\n\n" + (org-list-to-org list))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1033,8 +1040,7 @@ its CDR is a string." "Retrieve full index from cache and build \"theindex.org\". PROJECT is the project the index relates to. DIRECTORY is the publishing directory." - (let ((all-files (org-publish-get-base-files - project (plist-get (cdr project) :exclude))) + (let ((all-files (org-publish-get-base-files project)) full-index) ;; Compile full index and sort it alphabetically. (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 @@ (:texinfo-link-with-unknown-path-format nil nil org-texinfo-link-with-unknown-path-format) (:texinfo-tables-verbatim nil nil org-texinfo-tables-verbatim) (:texinfo-table-scientific-notation nil nil org-texinfo-table-scientific-notation) - (:texinfo-def-table-markup nil nil org-texinfo-def-table-markup) + (:texinfo-table-default-markup nil nil org-texinfo-table-default-markup) (:texinfo-text-markup-alist nil nil org-texinfo-text-markup-alist) (:texinfo-format-drawer-function nil nil org-texinfo-format-drawer-function) (: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'." (defcustom org-texinfo-classes '(("info" "@documentencoding AUTO\n@documentlanguage AUTO" - ("@chapter %s" . "@unnumbered %s") - ("@section %s" . "@unnumberedsec %s") - ("@subsection %s" . "@unnumberedsubsec %s") - ("@subsubsection %s" . "@unnumberedsubsubsec %s"))) + ("@chapter %s" "@unnumbered %s" "@appendix %s") + ("@section %s" "@unnumberedsec %s" "@appendixsec %s") + ("@subsection %s" "@unnumberedsubsec %s" "@appendixsubsec %s") + ("@subsubsection %s" "@unnumberedsubsubsec %s" "@appendixsubsubsec %s"))) "Alist of Texinfo classes and associated header and structure. If #+TEXINFO_CLASS is set in the buffer, use its value and the -associated information. Here is the structure of each cell: +associated information. Here is the structure of a class +definition: (class-name header-string - (numbered-section . unnumbered-section) + (numbered-1 unnumbered-1 appendix-1) + (numbered-2 unnumbered-2 appendix-2) ...) @@ -188,25 +190,19 @@ The sectioning structure The sectioning structure of the class is given by the elements following the header string. For each sectioning level, a number of strings is specified. A %s formatter is mandatory in each -section string and will be replaced by the title of the section. - -Instead of a list of sectioning commands, you can also specify -a function name. That function will be called with two -parameters, the reduced) level of the headline, and a predicate -non-nil when the headline should be numbered. It must return -a format string in which the section title will be added." +section string and will be replaced by the title of the section." :group 'org-export-texinfo - :version "24.4" - :package-version '(Org . "8.2") + :version "26.1" + :package-version '(Org . "9.1") :type '(repeat (list (string :tag "Texinfo class") (string :tag "Texinfo header") (repeat :tag "Levels" :inline t (choice - (cons :tag "Heading" + (list :tag "Heading" (string :tag " numbered") - (string :tag "unnumbered")) - (function :tag "Hook computing sectioning")))))) + (string :tag "unnumbered") + (string :tag " appendix"))))))) ;;;; Headline @@ -279,37 +275,42 @@ When nil, no transformation is made." (string :tag "Format string") (const :tag "No formatting" nil))) -(defcustom org-texinfo-def-table-markup "@samp" +(defcustom org-texinfo-table-default-markup "@asis" "Default markup for first column in two-column tables. This should an indicating command, e.g., \"@code\", \"@kbd\" or -\"@asis\". +\"@samp\". It can be overridden locally using the \":indic\" attribute." :group 'org-export-texinfo - :type 'string) + :type 'string + :version "26.1" + :package-version '(Org . "9.1") + :safe #'stringp) ;;;; Text markup (defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}") (code . code) (italic . "@emph{%s}") - (verbatim . verb)) + (verbatim . samp)) "Alist of Texinfo expressions to convert text markup. The key must be a symbol among `bold', `code', `italic', `strike-through', `underscore' and `verbatim'. The value is a formatting string to wrap fontified text with. -Value can also be set to the following symbols: `verb' and -`code'. For the former, Org will use \"@verb\" to create -a format string and select a delimiter character that isn't in -the string. For the latter, Org will use \"@code\" to typeset -and try to protect special characters. +Value can also be set to the following symbols: `verb', `samp' +and `code'. With the first one, Org uses \"@verb\" to create +a format string and selects a delimiter character that isn't in +the string. For the other two, Org uses \"@samp\" or \"@code\" +to typeset and protects special characters. -If no association can be found for a given markup, text will be -returned as-is." +When no association is found for a given markup, text is returned +as-is." :group 'org-export-texinfo + :version "26.1" + :package-version '(Org . "9.1") :type 'alist :options '(bold code italic strike-through underscore verbatim)) @@ -350,7 +351,7 @@ The function should return the string to be exported." ;;;; Compilation -(defcustom org-texinfo-info-process '("makeinfo %f") +(defcustom org-texinfo-info-process '("makeinfo --no-split %f") "Commands to process a Texinfo file to an INFO file. 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 base directory of the file and %O by the absolute file name of the output file." :group 'org-export-texinfo + :version "26.1" + :package-version '(Org . "9.1") :type '(repeat :tag "Shell command sequence" (string :tag "Shell command"))) @@ -444,13 +447,12 @@ This is used to choose a separator for constructs like \\verb." INFO is a plist used as a communication channel. See `org-texinfo-text-markup-alist' for details." (pcase (cdr (assq markup org-texinfo-text-markup-alist)) - ;; No format string: Return raw text. - (`nil text) + (`nil text) ;no markup: return raw text + (`code (format "@code{%s}" (org-texinfo--sanitize-content text))) + (`samp (format "@samp{%s}" (org-texinfo--sanitize-content text))) (`verb (let ((separator (org-texinfo--find-verb-separator text))) - (concat "@verb{" separator text separator "}"))) - (`code - (format "@code{%s}" (replace-regexp-in-string "[@{}]" "@\\&" text))) + (format "@verb{%s%s%s}" separator text separator))) ;; Else use format string. (fmt (format fmt text)))) @@ -786,8 +788,9 @@ holding contextual information." "Transcode an EXAMPLE-BLOCK element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." - (format "@verbatim\n%s@end verbatim" - (org-export-format-code-default example-block info))) + (format "@example\n%s@end example" + (org-texinfo--sanitize-content + (org-export-format-code-default example-block info)))) ;;; Export Block @@ -828,82 +831,75 @@ plist holding contextual information." ;;;; Headline +(defun org-texinfo--structuring-command (headline info) + "Return Texinfo structuring command string for HEADLINE element. +Return nil if HEADLINE is to be ignored, `plain-list' if it +should be exported as a plain-list item. INFO is a plist holding +contextual information." + (cond + ((org-element-property :footnote-section-p headline) nil) + ((org-not-nil (org-export-get-node-property :COPYING headline t)) nil) + ((org-export-low-level-p headline info) 'plain-list) + (t + (let ((class (plist-get info :texinfo-class))) + (pcase (assoc class (plist-get info :texinfo-classes)) + (`(,_ ,_ . ,sections) + (pcase (nth (1- (org-export-get-relative-level headline info)) + sections) + (`(,numbered ,unnumbered ,appendix) + (cond + ((org-not-nil (org-export-get-node-property :APPENDIX headline t)) + appendix) + ((org-not-nil (org-export-get-node-property :INDEX headline t)) + unnumbered) + ((org-export-numbered-headline-p headline info) numbered) + (t unnumbered))) + (`nil 'plain-list) + (_ (user-error "Invalid Texinfo class specification: %S" class)))) + (_ (user-error "Invalid Texinfo class specification: %S" class))))))) + (defun org-texinfo-headline (headline contents info) "Transcode a HEADLINE element from Org to Texinfo. CONTENTS holds the contents of the headline. INFO is a plist holding contextual information." - (let* ((class (plist-get info :texinfo-class)) - (level (org-export-get-relative-level headline info)) - (numberedp (org-export-numbered-headline-p headline info)) - (class-sectioning (assoc class (plist-get info :texinfo-classes))) - ;; Find the index type, if any. - (index (org-element-property :INDEX headline)) - ;; Create node info, to insert it before section formatting. - ;; Use custom menu title if present. - (node (format "@node %s\n" (org-texinfo--get-node headline info))) - ;; Section formatting will set two placeholders: one for the - ;; title and the other for the contents. - (section-fmt - (if (org-not-nil (org-element-property :APPENDIX headline)) - "@appendix %s\n%s" - (let ((sec (if (and (symbolp (nth 2 class-sectioning)) - (fboundp (nth 2 class-sectioning))) - (funcall (nth 2 class-sectioning) level numberedp) - (nth (1+ level) class-sectioning)))) - (cond - ;; No section available for that LEVEL. - ((not sec) nil) - ;; Section format directly returned by a function. - ((stringp sec) sec) - ;; (numbered-section . unnumbered-section) - ((not (consp (cdr sec))) - (concat (if (or index (not numberedp)) (cdr sec) (car sec)) - "\n%s")))))) - (todo - (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - (text (org-texinfo--sanitize-title - (org-element-property :title headline) info)) - (full-text (funcall (plist-get info :texinfo-format-headline-function) - todo todo-type priority text tags)) - (contents (if (org-string-nw-p contents) (concat "\n" contents) ""))) - (cond - ;; Case 1: This is a footnote section: ignore it. - ((org-element-property :footnote-section-p headline) nil) - ;; Case 2: This is the `copying' section: ignore it - ;; This is used elsewhere. - ((org-not-nil (org-element-property :COPYING headline)) nil) - ;; Case 3: An index. If it matches one of the known indexes, - ;; print it as such following the contents, otherwise - ;; print the contents and leave the index up to the user. - (index - (concat node - (format - section-fmt - full-text - (concat contents - (and (member index '("cp" "fn" "ky" "pg" "tp" "vr")) - (concat "\n@printindex " index)))))) - ;; Case 4: This is a deep sub-tree: export it as a list item. - ;; Also export as items headlines for which no section - ;; format has been found. - ((or (not section-fmt) (org-export-low-level-p headline info)) - ;; Build the real contents of the sub-tree. - (concat (and (org-export-first-sibling-p headline info) - (format "@%s\n" (if numberedp 'enumerate 'itemize))) - "@item\n" full-text "\n" - contents - (if (org-export-last-sibling-p headline info) - (format "@end %s" (if numberedp 'enumerate 'itemize)) - "\n"))) - ;; Case 5: Standard headline. Export it as a section. - (t (concat node (format section-fmt full-text contents)))))) + (let ((section-fmt (org-texinfo--structuring-command headline info))) + (when section-fmt + (let* ((todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-texinfo--sanitize-title + (org-element-property :title headline) info)) + (full-text + (funcall (plist-get info :texinfo-format-headline-function) + todo todo-type priority text tags)) + (contents + (concat "\n" + (if (org-string-nw-p contents) + (concat "\n" contents) + "") + (let ((index (org-element-property :INDEX headline))) + (and (member index '("cp" "fn" "ky" "pg" "tp" "vr")) + (format "\n@printindex %s\n" index)))))) + (cond + ((eq section-fmt 'plain-list) + (let ((numbered? (org-export-numbered-headline-p headline info))) + (concat (and (org-export-first-sibling-p headline info) + (format "@%s\n" (if numbered? 'enumerate 'itemize))) + "@item\n" full-text "\n" + contents + (if (org-export-last-sibling-p headline info) + (format "@end %s" (if numbered? 'enumerate 'itemize)) + "\n")))) + (t + (concat (format "@node %s\n" (org-texinfo--get-node headline info)) + (format section-fmt full-text) + contents))))))) (defun org-texinfo-format-headline-default-function (todo _todo-type priority text tags) @@ -920,9 +916,9 @@ See `org-texinfo-format-headline-function' for details." "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((code (org-element-property :value inline-src-block)) - (separator (org-texinfo--find-verb-separator code))) - (concat "@verb{" separator code separator "}"))) + (format "@code{%s}" + (org-texinfo--sanitize-content + (org-element-property :value inline-src-block)))) ;;;; Inlinetask @@ -967,10 +963,26 @@ contextual information." "Transcode an ITEM element from Org to Texinfo. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (format "@item%s\n%s" - (let ((tag (org-element-property :tag item))) - (if tag (concat " " (org-export-data tag info)) "")) - (or contents ""))) + (let* ((tag (org-element-property :tag item)) + (split (org-string-nw-p + (org-export-read-attribute :attr_texinfo + (org-element-property :parent item) + :sep))) + (items (and tag + (let ((tag (org-export-data tag info))) + (if split + (split-string tag (regexp-quote split) t "[ \t\n]+") + (list tag)))))) + (format "%s\n%s" + (pcase items + (`nil "@item") + (`(,item) (concat "@item " item)) + (`(,item . ,items) + (concat "@item " item "\n" + (mapconcat (lambda (i) (concat "@itemx " i)) + items + "\n")))) + (or contents "")))) ;;;; Keyword @@ -1073,14 +1085,8 @@ INFO is a plist holding contextual information. See (pcase (org-export-get-ordinal destination info) ((and (pred integerp) n) (number-to-string n)) ((and (pred consp) n) (mapconcat #'number-to-string n ".")) - (_ "???"))) - info))))) ;cannot guess the description - ((equal type "info") - (let* ((info-path (split-string path "[:#]")) - (info-manual (car info-path)) - (info-node (or (cadr info-path) "Top")) - (title (or desc ""))) - (format "@ref{%s,%s,,%s,}" info-node title info-manual))) + (_ "???"))) ;cannot guess the description + info))))) ((string= type "mailto") (format "@email{%s}" (concat (org-texinfo--sanitize-content path) @@ -1210,13 +1216,10 @@ holding contextual information." (cached-entries (gethash scope cache 'no-cache))) (if (not (eq cached-entries 'no-cache)) cached-entries (puthash scope - (org-element-map (org-element-contents scope) 'headline - (lambda (h) - (and (not (org-not-nil (org-element-property :COPYING h))) - (not (org-element-property :footnote-section-p h)) - (not (org-export-low-level-p h info)) - h)) - info nil 'headline) + (cl-remove-if + (lambda (h) + (org-not-nil (org-export-get-node-property :COPYING h t))) + (org-export-collect-headlines info 1 scope)) cache)))) ;;;; Node Property @@ -1246,7 +1249,7 @@ CONTENTS is the contents of the list. INFO is a plist holding contextual information." (let* ((attr (org-export-read-attribute :attr_texinfo plain-list)) (indic (let ((i (or (plist-get attr :indic) - (plist-get info :texinfo-def-table-markup)))) + (plist-get info :texinfo-table-default-markup)))) ;; Allow indicating commands with missing @ sign. (if (string-prefix-p "@" i) i (concat "@" i)))) (table-type (plist-get attr :table-type)) @@ -1570,6 +1573,7 @@ contextual information." ;;; Interactive functions +;;;###autoload (defun org-texinfo-export-to-texinfo (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to a Texinfo file. @@ -1604,6 +1608,7 @@ Return output file's name." (org-export-to-file 'texinfo outfile async subtreep visible-only body-only ext-plist))) +;;;###autoload (defun org-texinfo-export-to-info (&optional async subtreep visible-only body-only ext-plist) "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\"." (repeat :tag "Specify names of drawers to ignore during export" :inline t (string :tag "Drawer name")))) - :safe (lambda (x) (or (booleanp x) - (and (listp x) - (or (cl-every #'stringp x) - (and (eq (nth 0 x) 'not) - (cl-every #'stringp (cdr x)))))))) + :safe (lambda (x) (or (booleanp x) (consp x)))) (defcustom org-export-with-email nil "Non-nil means insert author email into the exported file. @@ -598,7 +594,7 @@ properties to export, as strings. This option can also be set with the OPTIONS keyword, e.g. \"prop:t\"." :group 'org-export-general - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (const :tag "All properties" t) @@ -883,6 +879,29 @@ HTML code while every other back-end will ignore it." (cl-every #'stringp (mapcar #'car x)) (cl-every #'stringp (mapcar #'cdr x))))) +(defcustom org-export-global-macros nil + "Alist between macro names and expansion templates. + +This variable defines macro expansion templates available +globally. Associations follow the pattern + + (NAME . TEMPLATE) + +where NAME is a string beginning with a letter and consisting of +alphanumeric characters only. + +TEMPLATE is the string to which the macro is going to be +expanded. Inside, \"$1\", \"$2\"... are place-holders for +macro's arguments. Moreover, if the template starts with +\"(eval\", it will be parsed as an Elisp expression and evaluated +accordingly." + :group 'org-export-general + :version "26.1" + :package-version '(Org . "9.1") + :type '(repeat + (cons (string :tag "Name") + (string :tag "Template")))) + (defcustom org-export-coding-system nil "Coding system for the exported file." :group 'org-export-general @@ -1433,7 +1452,7 @@ for export. Return options as a plist." (parse (org-element-parse-secondary-string value (org-element-restriction 'keyword))) - (split (org-split-string value)) + (split (split-string value)) (t value)))))))))))) (defun org-export--get-inbuffer-options (&optional backend) @@ -1476,17 +1495,20 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." (cond ;; Options in `org-export-special-keywords'. ((equal key "SETUPFILE") - (let ((file - (expand-file-name - (org-unbracket-string "\"" "\"" (org-trim val))))) + (let* ((uri (org-unbracket-string "\"" "\"" (org-trim val))) + (uri-is-url (org-file-url-p uri)) + (uri (if uri-is-url + uri + (expand-file-name uri)))) ;; Avoid circular dependencies. - (unless (member file files) + (unless (member uri files) (with-temp-buffer - (setq default-directory - (file-name-directory file)) - (insert (org-file-contents file 'noerror)) + (unless uri-is-url + (setq default-directory + (file-name-directory uri))) + (insert (org-file-contents uri 'noerror)) (let ((org-inhibit-startup t)) (org-mode)) - (funcall get-options (cons file files)))))) + (funcall get-options (cons uri files)))))) ((equal key "OPTIONS") (setq plist (org-combine-plists @@ -1538,7 +1560,7 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." "\n" (org-trim val)))) (split `(,@(plist-get plist property) - ,@(org-split-string val))) + ,@(split-string val))) ((t) val) (otherwise (if (not (plist-member plist property)) val @@ -1624,17 +1646,22 @@ an alist where associations are (VARIABLE-NAME VALUE)." "BIND") (push (read (format "(%s)" val)) alist) ;; Enter setup file. - (let ((file (expand-file-name - (org-unbracket-string "\"" "\"" val)))) - (unless (member file files) + (let* ((uri (org-unbracket-string "\"" "\"" val)) + (uri-is-url (org-file-url-p uri)) + (uri (if uri-is-url + uri + (expand-file-name uri)))) + ;; Avoid circular dependencies. + (unless (member uri files) (with-temp-buffer - (setq default-directory - (file-name-directory file)) + (unless uri-is-url + (setq default-directory + (file-name-directory uri))) (let ((org-inhibit-startup t)) (org-mode)) - (insert (org-file-contents file 'noerror)) + (insert (org-file-contents uri 'noerror)) (setq alist (funcall collect-bind - (cons file files) + (cons uri files) alist)))))))))) alist))))) ;; Return value in appropriate order of appearance. @@ -3010,13 +3037,15 @@ Return code as a string." (org-export-expand-include-keyword) (org-export--delete-comment-trees) (org-macro-initialize-templates) - (org-macro-replace-all org-macro-templates nil parsed-keywords) + (org-macro-replace-all + (append org-macro-templates org-export-global-macros) + nil parsed-keywords) ;; Refresh buffer properties and radio targets after ;; potentially invasive previous changes. Likewise, do it ;; again after executing Babel code. (org-set-regexps-and-options) (org-update-radio-target-regexp) - (when org-export-babel-evaluate + (when org-export-use-babel (org-babel-exp-process-buffer) (org-set-regexps-and-options) (org-update-radio-target-regexp)) @@ -3254,116 +3283,119 @@ storing and resolving footnotes. It is created automatically." ;; Expand INCLUDE keywords. (goto-char (point-min)) (while (re-search-forward include-re nil t) - (let ((element (save-match-data (org-element-at-point)))) - (when (eq (org-element-type element) 'keyword) - (beginning-of-line) - ;; Extract arguments from keyword's value. - (let* ((value (org-element-property :value element)) - (ind (org-get-indentation)) - location - (file - (and (string-match - "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value) - (prog1 - (save-match-data - (let ((matched (match-string 1 value))) - (when (string-match "\\(::\\(.*?\\)\\)\"?\\'" - matched) - (setq location (match-string 2 matched)) - (setq matched - (replace-match "" nil nil matched 1))) - (expand-file-name - (org-unbracket-string "\"" "\"" matched) - dir))) - (setq value (replace-match "" nil nil value))))) - (only-contents - (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?" - value) - (prog1 (org-not-nil (match-string 1 value)) - (setq value (replace-match "" nil nil value))))) - (lines - (and (string-match - ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" - value) - (prog1 (match-string 1 value) - (setq value (replace-match "" nil nil value))))) - (env (cond - ((string-match "\\<example\\>" value) 'literal) - ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value) - 'literal) - ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value) - 'literal))) - ;; Minimal level of included file defaults to the child - ;; level of the current headline, if any, or one. It - ;; only applies is the file is meant to be included as - ;; an Org one. - (minlevel - (and (not env) - (if (string-match ":minlevel +\\([0-9]+\\)" value) - (prog1 (string-to-number (match-string 1 value)) - (setq value (replace-match "" nil nil value))) - (get-text-property (point) - :org-include-induced-level)))) - (args (and (eq env 'literal) (match-string 1 value))) - (block (and (string-match "\\<\\(\\S-+\\)\\>" value) - (match-string 1 value)))) - ;; Remove keyword. - (delete-region (point) (line-beginning-position 2)) - (cond - ((not file) nil) - ((not (file-readable-p file)) - (error "Cannot include file %s" file)) - ;; Check if files has already been parsed. Look after - ;; inclusion lines too, as different parts of the same file - ;; can be included too. - ((member (list file lines) included) - (error "Recursive file inclusion: %s" file)) - (t + (unless (org-in-commented-heading-p) + (let ((element (save-match-data (org-element-at-point)))) + (when (eq (org-element-type element) 'keyword) + (beginning-of-line) + ;; Extract arguments from keyword's value. + (let* ((value (org-element-property :value element)) + (ind (org-get-indentation)) + location + (file + (and (string-match + "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value) + (prog1 + (save-match-data + (let ((matched (match-string 1 value))) + (when (string-match "\\(::\\(.*?\\)\\)\"?\\'" + matched) + (setq location (match-string 2 matched)) + (setq matched + (replace-match "" nil nil matched 1))) + (expand-file-name + (org-unbracket-string "\"" "\"" matched) + dir))) + (setq value (replace-match "" nil nil value))))) + (only-contents + (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?" + value) + (prog1 (org-not-nil (match-string 1 value)) + (setq value (replace-match "" nil nil value))))) + (lines + (and (string-match + ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" + value) + (prog1 (match-string 1 value) + (setq value (replace-match "" nil nil value))))) + (env (cond + ((string-match "\\<example\\>" value) 'literal) + ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value) + 'literal) + ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value) + 'literal))) + ;; Minimal level of included file defaults to the + ;; child level of the current headline, if any, or + ;; one. It only applies is the file is meant to be + ;; included as an Org one. + (minlevel + (and (not env) + (if (string-match ":minlevel +\\([0-9]+\\)" value) + (prog1 (string-to-number (match-string 1 value)) + (setq value (replace-match "" nil nil value))) + (get-text-property (point) + :org-include-induced-level)))) + (args (and (eq env 'literal) (match-string 1 value))) + (block (and (string-match "\\<\\(\\S-+\\)\\>" value) + (match-string 1 value)))) + ;; Remove keyword. + (delete-region (point) (line-beginning-position 2)) (cond - ((eq env 'literal) - (insert - (let ((ind-str (make-string ind ?\s)) - (arg-str (if (stringp args) (format " %s" args) "")) - (contents - (org-escape-code-in-string - (org-export--prepare-file-contents file lines)))) - (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n" - ind-str block arg-str contents ind-str block)))) - ((stringp block) - (insert - (let ((ind-str (make-string ind ?\s)) - (contents - (org-export--prepare-file-contents file lines))) - (format "%s#+BEGIN_%s\n%s%s#+END_%s\n" - ind-str block contents ind-str block)))) + ((not file) nil) + ((not (file-readable-p file)) + (error "Cannot include file %s" file)) + ;; Check if files has already been parsed. Look after + ;; inclusion lines too, as different parts of the same + ;; file can be included too. + ((member (list file lines) included) + (error "Recursive file inclusion: %s" file)) (t - (insert - (with-temp-buffer - (let ((org-inhibit-startup t) - (lines - (if location - (org-export--inclusion-absolute-lines - file location only-contents lines) - lines))) - (org-mode) - (insert - (org-export--prepare-file-contents - file lines ind minlevel - (or (gethash file file-prefix) - (puthash file (cl-incf current-prefix) file-prefix)) - footnotes))) - (org-export-expand-include-keyword - (cons (list file lines) included) - (file-name-directory file) - footnotes) - (buffer-string))))) - ;; Expand footnotes after all files have been included. - ;; Footnotes are stored at end of buffer. - (unless included - (org-with-wide-buffer - (goto-char (point-max)) - (maphash (lambda (k v) (insert (format "\n[fn:%s] %s\n" k v))) - footnotes))))))))))) + (cond + ((eq env 'literal) + (insert + (let ((ind-str (make-string ind ?\s)) + (arg-str (if (stringp args) (format " %s" args) "")) + (contents + (org-escape-code-in-string + (org-export--prepare-file-contents file lines)))) + (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n" + ind-str block arg-str contents ind-str block)))) + ((stringp block) + (insert + (let ((ind-str (make-string ind ?\s)) + (contents + (org-export--prepare-file-contents file lines))) + (format "%s#+BEGIN_%s\n%s%s#+END_%s\n" + ind-str block contents ind-str block)))) + (t + (insert + (with-temp-buffer + (let ((org-inhibit-startup t) + (lines + (if location + (org-export--inclusion-absolute-lines + file location only-contents lines) + lines))) + (org-mode) + (insert + (org-export--prepare-file-contents + file lines ind minlevel + (or + (gethash file file-prefix) + (puthash file (cl-incf current-prefix) file-prefix)) + footnotes))) + (org-export-expand-include-keyword + (cons (list file lines) included) + (file-name-directory file) + footnotes) + (buffer-string))))) + ;; Expand footnotes after all files have been + ;; included. Footnotes are stored at end of buffer. + (unless included + (org-with-wide-buffer + (goto-char (point-max)) + (maphash (lambda (k v) + (insert (format "\n[fn:%s] %s\n" k v))) + footnotes)))))))))))) (defun org-export--inclusion-absolute-lines (file location only-contents lines) "Resolve absolute lines for an included file with file-link. @@ -4134,12 +4166,56 @@ the provided rules is non-nil. The default rule is This only applies to links without a description." (and (not (org-element-contents link)) (let ((case-fold-search t)) - (catch 'exit - (dolist (rule (or rules org-export-default-inline-image-rule)) - (and (string= (org-element-property :type link) (car rule)) - (string-match-p (cdr rule) - (org-element-property :path link)) - (throw 'exit t))))))) + (cl-some (lambda (rule) + (and (string= (org-element-property :type link) (car rule)) + (string-match-p (cdr rule) + (org-element-property :path link)))) + (or rules org-export-default-inline-image-rule))))) + +(defun org-export-insert-image-links (data info &optional rules) + "Insert image links in DATA. + +Org syntax does not support nested links. Nevertheless, some +export back-ends support images as descriptions of links. Since +images are really links to image files, we need to make an +exception about links nesting. + +This function recognizes links whose contents are really images +and turn them into proper nested links. It is meant to be used +as a parse tree filter in back-ends supporting such constructs. + +DATA is a parse tree. INFO is the current state of the export +process, as a plist. + +A description is a valid images if it matches any rule in RULES, +if non-nil, or `org-export-default-inline-image-rule' otherwise. +See `org-export-inline-image-p' for more information about the +structure of RULES. + +Return modified DATA." + (let ((link-re (format "\\`\\(?:%s\\|%s\\)\\'" + org-plain-link-re + org-angle-link-re)) + (case-fold-search t)) + (org-element-map data 'link + (lambda (l) + (let ((contents (org-element-interpret-data (org-element-contents l)))) + (when (and (org-string-nw-p contents) + (string-match link-re contents)) + (let ((type (match-string 1 contents)) + (path (match-string 2 contents))) + (when (cl-some (lambda (rule) + (and (string= type (car rule)) + (string-match-p (cdr rule) path))) + (or rules org-export-default-inline-image-rule)) + ;; Replace contents with image link. + (org-element-adopt-elements + (org-element-set-contents l nil) + (with-temp-buffer + (save-excursion (insert contents)) + (org-element-link-parser)))))))) + info nil nil t)) + data) (defun org-export-resolve-coderef (ref info) "Resolve a code reference REF. @@ -4246,12 +4322,10 @@ Assume LINK type is \"fuzzy\". White spaces are not significant." (let* ((search-cells (org-export-string-to-search-cell (org-link-unescape (org-element-property :path link)))) - (link-cache - (or (plist-get info :resolve-fuzzy-link-cache) - (plist-get (plist-put info - :resolve-fuzzy-link-cache - (make-hash-table :test #'equal)) - :resolve-fuzzy-link-cache))) + (link-cache (or (plist-get info :resolve-fuzzy-link-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :resolve-fuzzy-link-cache table) + table))) (cached (gethash search-cells link-cache 'not-found))) (if (not (eq cached 'not-found)) cached (let ((matches @@ -4655,19 +4729,20 @@ code." All special columns will be ignored during export." ;; The table has a special column when every first cell of every row ;; has an empty value or contains a symbol among "/", "#", "!", "$", - ;; "*" "_" and "^". Though, do not consider a first row containing - ;; only empty cells as special. - (let ((special-column-p 'empty)) + ;; "*" "_" and "^". Though, do not consider a first column + ;; containing only empty cells as special. + (let ((special-column? 'empty)) (catch 'exit (dolist (row (org-element-contents table)) (when (eq (org-element-property :type row) 'standard) (let ((value (org-element-contents (car (org-element-contents row))))) - (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) - (setq special-column-p 'special)) - ((not value)) + (cond ((member value + '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) + (setq special-column? 'special)) + ((null value)) (t (throw 'exit nil)))))) - (eq special-column-p 'special)))) + (eq special-column? 'special)))) (defun org-export-table-has-header-p (table info) "Non-nil when TABLE has a header. @@ -4675,26 +4750,28 @@ All special columns will be ignored during export." INFO is a plist used as a communication channel. A table has a header when it contains at least two row groups." - (let ((cache (or (plist-get info :table-header-cache) - (plist-get (setq info - (plist-put info :table-header-cache - (make-hash-table :test 'eq))) - :table-header-cache)))) - (or (gethash table cache) - (let ((rowgroup 1) row-flag) - (puthash - table - (org-element-map table 'table-row - (lambda (row) - (cond - ((> rowgroup 1) t) - ((and row-flag (eq (org-element-property :type row) 'rule)) - (cl-incf rowgroup) (setq row-flag nil)) - ((and (not row-flag) (eq (org-element-property :type row) - 'standard)) - (setq row-flag t) nil))) - info 'first-match) - cache))))) + (let* ((cache (or (plist-get info :table-header-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-header-cache table) + table))) + (cached (gethash table cache 'no-cache))) + (if (not (eq cached 'no-cache)) cached + (let ((rowgroup 1) row-flag) + (puthash table + (org-element-map table 'table-row + (lambda (row) + (cond + ((> rowgroup 1) t) + ((and row-flag + (eq (org-element-property :type row) 'rule)) + (cl-incf rowgroup) + (setq row-flag nil)) + ((and (not row-flag) + (eq (org-element-property :type row) 'standard)) + (setq row-flag t) + nil))) + info 'first-match) + cache))))) (defun org-export-table-row-is-special-p (table-row _) "Non-nil if TABLE-ROW is considered special. @@ -4735,21 +4812,24 @@ INFO is a plist used as the communication channel. Return value is the group number, as an integer, or nil for special rows and rows separators. First group is also table's header." - (let ((cache (or (plist-get info :table-row-group-cache) - (plist-get (setq info - (plist-put info :table-row-group-cache - (make-hash-table :test 'eq))) - :table-row-group-cache)))) - (cond ((gethash table-row cache)) - ((eq (org-element-property :type table-row) 'rule) nil) - (t (let ((group 0) row-flag) - (org-element-map (org-export-get-parent table-row) 'table-row - (lambda (row) - (if (eq (org-element-property :type row) 'rule) - (setq row-flag nil) - (unless row-flag (cl-incf group) (setq row-flag t))) - (when (eq table-row row) (puthash table-row group cache))) - info 'first-match)))))) + (when (eq (org-element-property :type table-row) 'standard) + (let* ((cache (or (plist-get info :table-row-group-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-row-group-cache table) + table))) + (cached (gethash table-row cache 'no-cache))) + (if (not (eq cached 'no-cache)) cached + ;; First time a row is queried, populate cache with all the + ;; rows from the table. + (let ((group 0) row-flag) + (org-element-map (org-export-get-parent table-row) 'table-row + (lambda (row) + (if (eq (org-element-property :type row) 'rule) + (setq row-flag nil) + (unless row-flag (cl-incf group) (setq row-flag t)) + (puthash row group cache))) + info)) + (gethash table-row cache))))) (defun org-export-table-cell-width (table-cell info) "Return TABLE-CELL contents width. @@ -4764,10 +4844,9 @@ same column as TABLE-CELL, or nil." (columns (length cells)) (column (- columns (length (memq table-cell cells)))) (cache (or (plist-get info :table-cell-width-cache) - (plist-get (setq info - (plist-put info :table-cell-width-cache - (make-hash-table :test 'eq))) - :table-cell-width-cache))) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-cell-width-cache table) + table))) (width-vector (or (gethash table cache) (puthash table (make-vector columns 'empty) cache))) (value (aref width-vector column))) @@ -4808,10 +4887,9 @@ Possible values are `left', `right' and `center'." (columns (length cells)) (column (- columns (length (memq table-cell cells)))) (cache (or (plist-get info :table-cell-alignment-cache) - (plist-get (setq info - (plist-put info :table-cell-alignment-cache - (make-hash-table :test 'eq))) - :table-cell-alignment-cache))) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-cell-alignment-cache table) + table))) (align-vector (or (gethash table cache) (puthash table (make-vector columns nil) cache)))) (or (aref align-vector column) @@ -5014,17 +5092,24 @@ INFO is a plist used as a communication channel." (defun org-export-table-row-number (table-row info) "Return TABLE-ROW number. INFO is a plist used as a communication channel. Return value is -zero-based and ignores separators. The function returns nil for -special columns and separators." - (when (and (eq (org-element-property :type table-row) 'standard) - (not (org-export-table-row-is-special-p table-row info))) - (let ((number 0)) - (org-element-map (org-export-get-parent-table table-row) 'table-row - (lambda (row) - (cond ((eq row table-row) number) - ((eq (org-element-property :type row) 'standard) - (cl-incf number) nil))) - info 'first-match)))) +zero-indexed and ignores separators. The function returns nil +for special rows and separators." + (when (eq (org-element-property :type table-row) 'standard) + (let* ((cache (or (plist-get info :table-row-number-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-row-number-cache table) + table))) + (cached (gethash table-row cache 'no-cache))) + (if (not (eq cached 'no-cache)) cached + ;; First time a row is queried, populate cache with all the + ;; rows from the table. + (let ((number -1)) + (org-element-map (org-export-get-parent-table table-row) 'table-row + (lambda (row) + (when (eq (org-element-property :type row) 'standard) + (puthash row (cl-incf number) cache))) + info)) + (gethash table-row cache))))) (defun org-export-table-dimensions (table info) "Return TABLE dimensions. @@ -5197,7 +5282,19 @@ Return a list of src-block elements with a caption." ;; `org-export-smart-quotes-alist'. (defconst org-export-smart-quotes-alist - '(("da" + '(("ar" + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "‹" :html "‹" :latex "\\guilsinglleft{}" + :texinfo "@guilsinglleft{}") + (secondary-closing :utf-8 "›" :html "›" :latex "\\guilsinglright{}" + :texinfo "@guilsinglright{}") + (apostrophe :utf-8 "’" :html "’")) + ("da" ;; one may use: »...«, "...", ›...‹, or '...'. ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ ;; LaTeX quotes require Babel! @@ -5304,8 +5401,19 @@ Return a list of src-block elements with a caption." (secondary-closing :utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}") (apostrophe :utf-8 "’" :html: "'")) + ("sl" + ;; Based on https://sl.wikipedia.org/wiki/Narekovaj + (primary-opening :utf-8 "«" :html "«" :latex "{}<<" + :texinfo "@guillemetleft{}") + (primary-closing :utf-8 "»" :html "»" :latex ">>{}" + :texinfo "@guillemetright{}") + (secondary-opening + :utf-8 "„" :html "„" :latex "\\glqq{}" :texinfo "@quotedblbase{}") + (secondary-closing + :utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}") + (apostrophe :utf-8 "’" :html "’")) ("sv" - ;; based on https://sv.wikipedia.org/wiki/Citattecken + ;; Based on https://sv.wikipedia.org/wiki/Citattecken (primary-opening :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") (primary-closing :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") (secondary-opening :utf-8 "’" :html "’" :latex "’" :texinfo "`") @@ -5521,6 +5629,7 @@ them." '(("%e %n: %c" ("fr" :default "%e %n : %c" :html "%e %n : %c")) ("Author" + ("ar" :default "تأليف") ("ca" :default "Autor") ("cs" :default "Autor") ("da" :default "Forfatter") @@ -5541,11 +5650,13 @@ them." ("pl" :default "Autor") ("pt_BR" :default "Autor") ("ru" :html "Автор" :utf-8 "Автор") + ("sl" :default "Avtor") ("sv" :html "Författare") ("uk" :html "Автор" :utf-8 "Автор") ("zh-CN" :html "作者" :utf-8 "作者") ("zh-TW" :html "作者" :utf-8 "作者")) ("Continued from previous page" + ("ar" :default "تتمة الصفحة السابقة") ("de" :default "Fortsetzung von vorheriger Seite") ("es" :html "Continúa de la página anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior") ("fr" :default "Suite de la page précédente") @@ -5554,8 +5665,10 @@ them." ("nl" :default "Vervolg van vorige pagina") ("pt" :default "Continuação da página anterior") ("ru" :html "(Продолжение)" - :utf-8 "(Продолжение)")) + :utf-8 "(Продолжение)") + ("sl" :default "Nadaljevanje s prejšnje strani")) ("Continued on next page" + ("ar" :default "التتمة في الصفحة التالية") ("de" :default "Fortsetzung nächste Seite") ("es" :html "Continúa en la siguiente página" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página") ("fr" :default "Suite page suivante") @@ -5564,8 +5677,12 @@ them." ("nl" :default "Vervolg op volgende pagina") ("pt" :default "Continua na página seguinte") ("ru" :html "(Продолжение следует)" - :utf-8 "(Продолжение следует)")) + :utf-8 "(Продолжение следует)") + ("sl" :default "Nadaljevanje na naslednji strani")) + ("Created" + ("sl" :default "Ustvarjeno")) ("Date" + ("ar" :default "بتاريخ") ("ca" :default "Data") ("cs" :default "Datum") ("da" :default "Dato") @@ -5585,11 +5702,13 @@ them." ("pl" :default "Data") ("pt_BR" :default "Data") ("ru" :html "Дата" :utf-8 "Дата") + ("sl" :default "Datum") ("sv" :default "Datum") ("uk" :html "Дата" :utf-8 "Дата") ("zh-CN" :html "日期" :utf-8 "日期") ("zh-TW" :html "日期" :utf-8 "日期")) ("Equation" + ("ar" :default "معادلة") ("da" :default "Ligning") ("de" :default "Gleichung") ("es" :ascii "Ecuacion" :html "Ecuación" :default "Ecuación") @@ -5603,9 +5722,11 @@ them." ("pt_BR" :html "Equação" :default "Equação" :ascii "Equacao") ("ru" :html "Уравнение" :utf-8 "Уравнение") + ("sl" :default "Enačba") ("sv" :default "Ekvation") ("zh-CN" :html "方程" :utf-8 "方程")) ("Figure" + ("ar" :default "شكل") ("da" :default "Figur") ("de" :default "Abbildung") ("es" :default "Figura") @@ -5620,6 +5741,7 @@ them." ("sv" :default "Illustration") ("zh-CN" :html "图" :utf-8 "图")) ("Figure %d:" + ("ar" :default "شكل %d:") ("da" :default "Figur %d") ("de" :default "Abbildung %d:") ("es" :default "Figura %d:") @@ -5632,9 +5754,11 @@ them." ("nn" :default "Illustrasjon %d") ("pt_BR" :default "Figura %d:") ("ru" :html "Рис. %d.:" :utf-8 "Рис. %d.:") + ("sl" :default "Slika %d") ("sv" :default "Illustration %d") ("zh-CN" :html "图%d " :utf-8 "图%d ")) ("Footnotes" + ("ar" :default "الهوامش") ("ca" :html "Peus de pàgina") ("cs" :default "Pozn\xe1mky pod carou") ("da" :default "Fodnoter") @@ -5655,12 +5779,14 @@ them." ("pl" :default "Przypis") ("pt_BR" :html "Notas de Rodapé" :default "Notas de Rodapé" :ascii "Notas de Rodape") ("ru" :html "Сноски" :utf-8 "Сноски") + ("sl" :default "Opombe") ("sv" :default "Fotnoter") ("uk" :html "Примітки" :utf-8 "Примітки") ("zh-CN" :html "脚注" :utf-8 "脚注") ("zh-TW" :html "腳註" :utf-8 "腳註")) ("List of Listings" + ("ar" :default "قائمة بالبرامج") ("da" :default "Programmer") ("de" :default "Programmauflistungsverzeichnis") ("es" :ascii "Indice de Listados de programas" :html "Índice de Listados de programas" :default "Índice de Listados de programas") @@ -5671,8 +5797,10 @@ them." ("nb" :default "Dataprogrammer") ("ru" :html "Список распечаток" :utf-8 "Список распечаток") + ("sl" :default "Seznam programskih izpisov") ("zh-CN" :html "代码目录" :utf-8 "代码目录")) ("List of Tables" + ("ar" :default "قائمة بالجداول") ("da" :default "Tabeller") ("de" :default "Tabellenverzeichnis") ("es" :ascii "Indice de tablas" :html "Índice de tablas" :default "Índice de tablas") @@ -5686,9 +5814,11 @@ them." ("pt_BR" :default "Índice de Tabelas" :ascii "Indice de Tabelas") ("ru" :html "Список таблиц" :utf-8 "Список таблиц") + ("sl" :default "Seznam tabel") ("sv" :default "Tabeller") ("zh-CN" :html "表格目录" :utf-8 "表格目录")) ("Listing" + ("ar" :default "برنامج") ("da" :default "Program") ("de" :default "Programmlisting") ("es" :default "Listado de programa") @@ -5700,8 +5830,10 @@ them." ("pt_BR" :default "Listagem") ("ru" :html "Распечатка" :utf-8 "Распечатка") + ("sl" :default "Izpis programa") ("zh-CN" :html "代码" :utf-8 "代码")) ("Listing %d:" + ("ar" :default "برنامج %d:") ("da" :default "Program %d") ("de" :default "Programmlisting %d") ("es" :default "Listado de programa %d") @@ -5713,18 +5845,24 @@ them." ("pt_BR" :default "Listagem %d") ("ru" :html "Распечатка %d.:" :utf-8 "Распечатка %d.:") + ("sl" :default "Izpis programa %d") ("zh-CN" :html "代码%d " :utf-8 "代码%d ")) ("References" + ("ar" :default "المراجع") ("fr" :ascii "References" :default "Références") ("de" :default "Quellen") - ("es" :default "Referencias")) + ("es" :default "Referencias") + ("sl" :default "Reference")) ("See figure %s" ("fr" :default "cf. figure %s" - :html "cf. figure %s" :latex "cf.~figure~%s")) + :html "cf. figure %s" :latex "cf.~figure~%s") + ("sl" :default "Glej sliko %s")) ("See listing %s" ("fr" :default "cf. programme %s" - :html "cf. programme %s" :latex "cf.~programme~%s")) + :html "cf. programme %s" :latex "cf.~programme~%s") + ("sl" :default "Glej izpis programa %s")) ("See section %s" + ("ar" :default "انظر قسم %s") ("da" :default "jævnfør afsnit %s") ("de" :default "siehe Abschnitt %s") ("es" :ascii "Vea seccion %s" :html "Vea sección %s" :default "Vea sección %s") @@ -5735,11 +5873,14 @@ them." :ascii "Veja a secao %s") ("ru" :html "См. раздел %s" :utf-8 "См. раздел %s") + ("sl" :default "Glej poglavje %d") ("zh-CN" :html "参见第%s节" :utf-8 "参见第%s节")) ("See table %s" ("fr" :default "cf. tableau %s" - :html "cf. tableau %s" :latex "cf.~tableau~%s")) + :html "cf. tableau %s" :latex "cf.~tableau~%s") + ("sl" :default "Glej tabelo %s")) ("Table" + ("ar" :default "جدول") ("de" :default "Tabelle") ("es" :default "Tabla") ("et" :default "Tabel") @@ -5751,6 +5892,7 @@ them." :utf-8 "Таблица") ("zh-CN" :html "表" :utf-8 "表")) ("Table %d:" + ("ar" :default "جدول %d:") ("da" :default "Tabel %d") ("de" :default "Tabelle %d") ("es" :default "Tabla %d") @@ -5764,9 +5906,11 @@ them." ("pt_BR" :default "Tabela %d") ("ru" :html "Таблица %d.:" :utf-8 "Таблица %d.:") + ("sl" :default "Tabela %d") ("sv" :default "Tabell %d") ("zh-CN" :html "表%d " :utf-8 "表%d ")) ("Table of Contents" + ("ar" :default "قائمة المحتويات") ("ca" :html "Índex") ("cs" :default "Obsah") ("da" :default "Indhold") @@ -5788,11 +5932,13 @@ them." ("pt_BR" :html "Índice" :utf8 "Índice" :ascii "Indice") ("ru" :html "Содержание" :utf-8 "Содержание") + ("sl" :default "Kazalo") ("sv" :html "Innehåll") ("uk" :html "Зміст" :utf-8 "Зміст") ("zh-CN" :html "目录" :utf-8 "目录") ("zh-TW" :html "目錄" :utf-8 "目錄")) ("Unknown reference" + ("ar" :default "مرجع غير معرّف") ("da" :default "ukendt reference") ("de" :default "Unbekannter Verweis") ("es" :default "Referencia desconocida") @@ -5803,6 +5949,7 @@ them." :ascii "Referencia desconhecida") ("ru" :html "Неизвестная ссылка" :utf-8 "Неизвестная ссылка") + ("sl" :default "Neznana referenca") ("zh-CN" :html "未知引用" :utf-8 "未知引用"))) "Dictionary for export engine. @@ -6090,29 +6237,37 @@ directory. Return file name as a string." (let* ((visited-file (buffer-file-name (buffer-base-buffer))) (base-name - ;; File name may come from EXPORT_FILE_NAME subtree - ;; property. - (file-name-sans-extension - (or (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective)) - ;; File name may be extracted from buffer's associated - ;; file, if any. - (and visited-file (file-name-nondirectory visited-file)) - ;; Can't determine file name on our own: Ask user. - (read-file-name - "Output file: " pub-dir nil nil nil - (lambda (name) - (string= (file-name-extension name t) extension)))))) + (concat + (file-name-sans-extension + (or + ;; Check EXPORT_FILE_NAME subtree property. + (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective)) + ;; Check #+EXPORT_FILE_NAME keyword. + (org-with-point-at (point-min) + (catch :found + (let ((case-fold-search t)) + (while (re-search-forward + "^[ \t]*#\\+EXPORT_FILE_NAME:[ \t]+\\S-" nil t) + (let ((element (org-element-at-point))) + (when (eq 'keyword (org-element-type element)) + (throw :found + (org-element-property :value element)))))))) + ;; Extract from buffer's associated file, if any. + (and visited-file (file-name-nondirectory visited-file)) + ;; Can't determine file name on our own: ask user. + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (n) (string= extension (file-name-extension n t)))))) + extension)) (output-file ;; Build file name. Enforce EXTENSION over whatever user ;; may have come up with. PUB-DIR, if defined, always has ;; precedence over any provided path. (cond - (pub-dir - (concat (file-name-as-directory pub-dir) - (file-name-nondirectory base-name) - extension)) - ((file-name-absolute-p base-name) (concat base-name extension)) - (t (concat (file-name-as-directory ".") base-name extension))))) + (pub-dir (concat (file-name-as-directory pub-dir) + (file-name-nondirectory base-name))) + ((file-name-absolute-p base-name) base-name) + (t base-name)))) ;; If writing to OUTPUT-FILE would overwrite original file, append ;; EXTENSION another time to final name. (if (and visited-file (file-equal-p visited-file output-file)) |